aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock.hs27
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs10
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs27
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs4
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs2
-rw-r--r--haddock-api/src/Haddock/Options.hs5
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
)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 04:58:43 +0000