diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2018-11-09 08:13:35 -0800 | 
|---|---|---|
| committer | Alec Theriault <alec.theriault@gmail.com> | 2018-11-09 08:13:35 -0800 | 
| commit | e44f4637472ebcd818089e96338e0b4705b4f649 (patch) | |
| tree | 1b894bc2df3421c421e4a845c6ad72c821ac2b03 /haddock-api | |
| parent | 63abb6c197ae513eac6d171c589b129feb004413 (diff) | |
| parent | 8a491e437f1c8379b66a420f8584c1761b45aa7e (diff) | |
Merge branch 'ghc-8.6' into wip/new-ocean
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock.hs | 27 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 10 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml.hs | 27 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Options.hs | 5 | 
6 files changed, 45 insertions, 30 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index dbfba0f4..7a2df3a2 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -268,9 +268,9 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do      allIfaces        = map toInstalledIface ifaces ++ installedIfaces      allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ] -    pkgMod           = ifaceMod (head ifaces) -    pkgKey           = moduleUnitId pkgMod -    pkgStr           = Just (unitIdString pkgKey) +    pkgMod           = fmap ifaceMod (listToMaybe ifaces) +    pkgKey           = fmap moduleUnitId pkgMod +    pkgStr           = fmap unitIdString pkgKey      pkgNameVer       = modulePackageInfo dflags flags pkgMod      pkgName          = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer)      sincePkg         = case sinceQual of @@ -289,16 +289,22 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do      pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap      pkgSrcMap' -      | Flag_HyperlinkedSource `elem` flags = -          Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap -      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap +      | Flag_HyperlinkedSource `elem` flags +      , Just k <- pkgKey +      = Map.insert k hypSrcModuleNameUrlFormat pkgSrcMap +      | Just srcNameUrl <- srcEntity +      , Just k <- pkgKey +      = Map.insert k srcNameUrl pkgSrcMap        | otherwise = pkgSrcMap      -- TODO: Get these from the interface files as with srcMap      pkgSrcLMap' -      | Flag_HyperlinkedSource `elem` flags = -          Map.singleton pkgKey hypSrcModuleLineUrlFormat -      | Just path <- srcLEntity = Map.singleton pkgKey path +      | Flag_HyperlinkedSource `elem` flags +      , Just k <- pkgKey +      = Map.singleton k hypSrcModuleLineUrlFormat +      | Just path <- srcLEntity +      , Just k <- pkgKey +      = Map.singleton k path        | otherwise = Map.empty      sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap') @@ -375,7 +381,8 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do                 visibleIfaces odir        _ -> putStrLn . unlines $            [ "haddock: Unable to find a package providing module " -            ++ moduleNameString (moduleName pkgMod) ++ ", skipping Hoogle." +            ++ maybe "<no-mod>" (moduleNameString . moduleName) pkgMod +            ++ ", skipping Hoogle."            , ""            , "         Perhaps try specifying the desired package explicitly"              ++ " using the --package-name" diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 4e0e6eba..613c6deb 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -243,8 +243,8 @@ ppDocGroup lev doc = sec lev <> braces doc  -- | Given a declaration, extract out the names being declared  declNames :: LHsDecl DocNameI -          -> ( LaTeX           -- ^ to print before each name in an export list -             , [DocName]       -- ^ names being declared +          -> ( LaTeX           --   to print before each name in an export list +             , [DocName]       --   names being declared               )  declNames (L _ decl) = case decl of    TyClD _ d  -> (empty, [tcdName d]) @@ -444,9 +444,9 @@ ppLPatSig doc docnames ty unicode  -- arguments as needed.  ppTypeOrFunSig :: HsType DocNameI                 -> DocForDecl DocName  -- ^ documentation -               -> ( LaTeX             -- ^ first-line (no-argument docs only) -                  , LaTeX             -- ^ first-line (argument docs only) -                  , LaTeX             -- ^ type prefix (argument docs only) +               -> ( LaTeX             --   first-line (no-argument docs only) +                  , LaTeX             --   first-line (argument docs only) +                  , LaTeX             --   type prefix (argument docs only)                    )                 -> Bool                -- ^ unicode                 -> LaTeX diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 202fcdf1..46d94b37 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -121,19 +121,26 @@ copyHtmlBits odir libdir themes withQuickjump = do  headHtml :: String -> Themes -> Maybe String -> Html  headHtml docTitle themes mathjax_url = -  header << [ -    meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"], -    meta ! [ XHtml.name "viewport", content "width=device-width, initial-scale=1"], -    thetitle << docTitle, -    styleSheet themes, -    thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml, -    thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml, -    script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml, -    script ! [src mjUrl, thetype "text/javascript"] << noHtml +  header << +    [ meta ! [ httpequiv "Content-Type", content "text/html; charset=UTF-8"] +    , meta ! [ XHtml.name "viewport", content "width=device-width, initial-scale=1"] +    , thetitle << docTitle +    , styleSheet themes +    , thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << noHtml +    , thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml +    , script ! [src haddockJsFile, emptyAttr "async", thetype "text/javascript"] << noHtml +    , script ! [thetype "text/x-mathjax-config"] << primHtml mjConf +    , script ! [src mjUrl, thetype "text/javascript"] << noHtml      ]    where      fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" -    mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url +    mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url +    mjConf = unwords [ "MathJax.Hub.Config({" +                     ,   "tex2jax: {" +                     ,     "processClass: \"mathjax\"," +                     ,     "ignoreClass: \".*\"" +                     ,   "}" +                     , "});" ]  srcButton :: SourceURLs -> Maybe Interface -> Maybe Html  srcButton (Just src_base_url, _, _, _) Nothing = diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index ed323a90..38aa7b7e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -69,8 +69,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {                                    then namedAnchor aname << ""                                    else noHtml,    markupPic                  = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)), -  markupMathInline           = \mathjax -> toHtml ("\\(" ++ mathjax ++ "\\)"), -  markupMathDisplay          = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"), +  markupMathInline           = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\(" ++ mathjax ++ "\\)"), +  markupMathDisplay          = \mathjax -> thespan ! [theclass "mathjax"] << toHtml ("\\[" ++ mathjax ++ "\\]"),    markupProperty             = pre . toHtml,    markupExample              = examplesToHtml,    markupHeader               = \(Header l t) -> makeHeader l t, diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c4df2090..a4408434 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -85,7 +85,7 @@ createInterface tm flags modMap instIfaceMap = do        !instances     = modInfoInstances mi        !fam_instances = md_fam_insts md        !exportedNames = modInfoExportsWithSelectors mi -      (pkgNameFS, _) = modulePackageInfo dflags flags mdl +      (pkgNameFS, _) = modulePackageInfo dflags flags (Just mdl)        pkgName        = fmap (unpackFS . (\(PackageName n) -> n)) pkgNameFS        (TcGblEnv { tcg_rdr_env = gre diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index b5e987d8..bdc98406 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -371,9 +371,10 @@ modulePackageInfo :: DynFlags                    -> [Flag] -- ^ Haddock flags are checked as they may contain                              -- the package name or version provided by the user                              -- which we prioritise -                  -> Module +                  -> Maybe Module                    -> (Maybe PackageName, Maybe Data.Version.Version) -modulePackageInfo dflags flags modu = +modulePackageInfo _dflags _flags Nothing = (Nothing, Nothing) +modulePackageInfo dflags flags (Just modu) =    ( optPackageName flags    <|> fmap packageName pkgDb    , optPackageVersion flags <|> fmap packageVersion pkgDb    )  | 
