aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs21
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs10
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs39
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs16
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs16
6 files changed, 64 insertions, 42 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index d6a6a12d..73a200f0 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -118,10 +118,14 @@ commaSeparate dflags = showSDocUnqual dflags . interpp'SP
ppExport :: DynFlags -> ExportItem GhcRn -> [String]
ppExport dflags ExportDecl { expItemDecl = L _ decl
- , expItemMbDoc = (dc, _)
+ , expItemPats = bundledPats
+ , expItemMbDoc = mbDoc
, expItemSubDocs = subdocs
, expItemFixities = fixities
- } = ppDocumentation dflags dc ++ f decl ++ ppFixities
+ } = concat [ ppDocumentation dflags dc ++ f d
+ | (d, (dc, _)) <- (decl, mbDoc) : bundledPats
+ ] ++
+ ppFixities
where
f (TyClD _ d@DataDecl{}) = ppData dflags d subdocs
f (TyClD _ d@SynDecl{}) = ppSynonym dflags d
@@ -136,12 +140,13 @@ ppExport dflags ExportDecl { expItemDecl = L _ decl
ppExport _ _ = []
ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
-ppSigWithDoc dflags (TypeSig _ names sig) subdocs
- = concatMap mkDocSig names
- where
- mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)]
-
-ppSigWithDoc _ _ _ = []
+ppSigWithDoc dflags sig subdocs = case sig of
+ TypeSig _ names t -> concatMap (mkDocSig "" (hsSigWcType t)) names
+ PatSynSig _ names t -> concatMap (mkDocSig "pattern " (hsSigType t)) names
+ _ -> []
+ where
+ mkDocSig leader typ n = mkSubdoc dflags n subdocs
+ [leader ++ pp_sig dflags [n] typ]
ppSig :: DynFlags -> Sig GhcRn -> [String]
ppSig dflags x = ppSigWithDoc dflags x []
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index d5b2f325..69b43eca 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 f5fc4c3e..db29c7cf 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -33,6 +33,7 @@ import Haddock.Version
import Haddock.Utils
import Haddock.Utils.Json
import Text.XHtml hiding ( name, title, p, quote )
+import qualified Text.XHtml as XHtml
import Haddock.GhcUtils
import Control.Monad ( when, unless )
@@ -120,17 +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"],
- thetitle << docTitle,
- styleSheet themes,
- thelink ! [ rel "stylesheet", thetype "text/css", href quickJumpCssFile] << 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
- mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url
-
+ fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700"
+ 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 =
@@ -177,13 +187,13 @@ bodyHtml doctitle iface
pageContent =
body << [
divPackageHeader << [
+ nonEmptySectionName << doctitle,
unordList (catMaybes [
srcButton maybe_source_url iface,
wikiButton maybe_wiki_url (ifaceMod <$> iface),
contentsButton maybe_contents_url,
indexButton maybe_index_url])
- ! [theclass "links", identifier "page-menu"],
- nonEmptySectionName << doctitle
+ ! [theclass "links", identifier "page-menu"]
],
divContent << pageContent,
divFooter << paragraph << (
@@ -321,6 +331,7 @@ mkNode pkg qual ss p (Node s leaf _pkg srcPkg short ts) =
cBtn = case (ts, leaf) of
(_:_, Just _) -> thespan ! collapseControl p "" << spaceHtml
+ ([] , Just _) -> thespan ! [theclass "noexpander"] << spaceHtml
(_, _ ) -> noHtml
-- We only need an explicit collapser button when the module name
-- is also a leaf, and so is a link to a module page. Indeed, the
@@ -629,9 +640,9 @@ ppModuleContents pkg qual exports orphan
| null sections && not orphan = noHtml
| otherwise = contentsDiv
where
- contentsDiv = divTableOfContents << (
- sectionName << "Contents" +++
- unordList (sections ++ orphanSection))
+ contentsDiv = divTableOfContents << (divContentsList << (
+ (sectionName << "Contents") ! [ strAttr "onclick" "window.scrollTo(0,0)" ] +++
+ unordList (sections ++ orphanSection)))
(sections, _leftovers{-should be []-}) = process 0 exports
orphanSection
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 12e65716..9df6acc0 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -122,12 +122,12 @@ ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI
ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
splice unicode pkg qual emptyCtxts
| summary = pref1
- | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc
+ | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curname pkg qual doc
| otherwise = topDeclElem links loc splice docnames pref2
+++ subArguments pkg qual (ppSubSigLike unicode qual typ argDocs [] sep emptyCtxts)
- +++ docSection curName pkg qual doc
+ +++ docSection curname pkg qual doc
where
- curName = getName <$> listToMaybe docnames
+ curname = getName <$> listToMaybe docnames
-- This splits up a type signature along `->` and adds docs (when they exist) to
@@ -290,10 +290,11 @@ ppFamDecl :: Bool -- ^ is a summary
-> Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppFamDecl summary associated links instances fixities loc doc decl splice unicode pkg qual
| summary = ppFamHeader True associated decl unicode qual
- | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit
+ | otherwise = header_ +++ docSection curname pkg qual doc +++ instancesBit
where
docname = unLoc $ fdLName decl
+ curname = Just $ getName docname
header_ = topDeclElem links loc splice [docname] $
ppFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
@@ -528,9 +529,11 @@ ppClassDecl summary links instances fixities loc d subdocs
, tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
splice unicode pkg qual
| summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual
- | otherwise = classheader +++ docSection Nothing pkg qual d
+ | otherwise = classheader +++ docSection curname pkg qual d
+++ minimalBit +++ atBit +++ methodBit +++ instancesBit
where
+ curname = Just $ getName nm
+
sigs = map unLoc lsigs
classheader
@@ -759,10 +762,11 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
splice unicode pkg qual
| summary = ppShortDataDecl summary False dataDecl pats unicode qual
- | otherwise = header_ +++ docSection Nothing pkg qual doc +++ constrBit +++ patternBit +++ instancesBit
+ | otherwise = header_ +++ docSection curname pkg qual doc +++ constrBit +++ patternBit +++ instancesBit
where
docname = tcdName dataDecl
+ curname = Just $ getName docname
cons = dd_cons (tcdDataDefn dataDecl)
isH98 = case unLoc (head cons) of
ConDeclH98 {} -> True
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 42643ed0..09aabc0c 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/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 1c44ffda..25d8b07a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -15,7 +15,7 @@ module Haddock.Backends.Xhtml.Layout (
divPackageHeader, divContent, divModuleHeader, divFooter,
divTableOfContents, divDescription, divSynopsis, divInterface,
- divIndex, divAlphabet, divModuleList,
+ divIndex, divAlphabet, divModuleList, divContentsList,
sectionName,
nonEmptySectionName,
@@ -74,13 +74,13 @@ sectionName = paragraph ! [theclass "caption"]
-- If it would have otherwise been empty, then give it the class ".empty".
nonEmptySectionName :: Html -> Html
nonEmptySectionName c
- | isNoHtml c = paragraph ! [theclass "caption empty"] $ spaceHtml
- | otherwise = paragraph ! [theclass "caption"] $ c
+ | isNoHtml c = thespan ! [theclass "caption empty"] $ spaceHtml
+ | otherwise = thespan ! [theclass "caption"] $ c
divPackageHeader, divContent, divModuleHeader, divFooter,
divTableOfContents, divDescription, divSynopsis, divInterface,
- divIndex, divAlphabet, divModuleList
+ divIndex, divAlphabet, divModuleList, divContentsList
:: Html -> Html
divPackageHeader = sectionDiv "package-header"
@@ -88,6 +88,7 @@ divContent = sectionDiv "content"
divModuleHeader = sectionDiv "module-header"
divFooter = sectionDiv "footer"
divTableOfContents = sectionDiv "table-of-contents"
+divContentsList = sectionDiv "contents-list"
divDescription = sectionDiv "description"
divSynopsis = sectionDiv "synopsis"
divInterface = sectionDiv "interface"
@@ -195,17 +196,18 @@ subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html
subEquations pkg qual = divSubDecls "equations" "Equations" . subTable pkg qual
--- | Generate sub table for instance declarations, with source
+-- | Generate collapsible sub table for instance declarations, with source
subInstances :: Maybe Package -> Qualification
-> String -- ^ Class name, used for anchor generation
-> LinksInfo -> Bool
-> [(SubDecl, Maybe Module, Located DocName)] -> Html
subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable
where
- wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents))
+ wrap contents = subSection (hdr +++ collapseDetails id_ DetailsOpen (summary +++ contents))
instTable = subTableSrc pkg qual lnks splice
subSection = thediv ! [theclass "subs instances"]
- summary = thesummary << "Instances"
+ hdr = h4 ! collapseControl id_ "instances" << "Instances"
+ summary = thesummary ! [ theclass "hide-when-js-enabled" ] << "Instances details"
id_ = makeAnchorId $ "i:" ++ nm
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 00:37:33 +0000