diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml.hs | 19 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 16 |
2 files changed, 21 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 0a11ca08..46d94b37 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 ) @@ -121,16 +122,19 @@ 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 ! [ 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.5/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\"," @@ -183,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 << ( @@ -327,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 @@ -635,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/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 |