diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml.hs')
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 43 |
1 files changed, 17 insertions, 26 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 52bde5b6..c68b7cbc 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -66,7 +66,7 @@ ppHtml :: String -> Maybe String -- ^ The contents URL (--use-contents) -> Maybe String -- ^ The index URL (--use-index) -> Bool -- ^ Whether to use unicode in output (--use-unicode) - -> Qualification -- ^ How to qualify names + -> QualOption -- ^ How to qualify names -> Bool -- ^ Output pretty html (newlines and indenting) -> IO () @@ -83,7 +83,7 @@ ppHtml doctitle maybe_package ifaces odir prologue themes maybe_index_url maybe_source_url maybe_wiki_url (map toInstalledIface visible_ifaces) False -- we don't want to display the packages in a single-package contents - prologue debug qual + prologue debug (makeContentsQual qual) when (isNothing maybe_index_url) $ ppHtmlIndex odir doctitle maybe_package @@ -175,7 +175,7 @@ bodyHtml doctitle iface contentsButton maybe_contents_url, indexButton maybe_index_url]) ! [theclass "links", identifier "page-menu"], - nonEmpty sectionName << doctitle + nonEmptySectionName << doctitle ], divContent << pageContent, divFooter << paragraph << ( @@ -431,7 +431,7 @@ ppHtmlIndex odir doctitle _maybe_package themes indexLinks nm entries many_entities -> td ! [ theclass "src" ] << toHtml str <-> td << spaceHtml </> - aboves (map doAnnotatedEntity (zip [1..] many_entities)) + aboves (zipWith (curry doAnnotatedEntity) [1..] many_entities) doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable doAnnotatedEntity (j,(nm,entries)) @@ -461,18 +461,16 @@ ppHtmlIndex odir doctitle _maybe_package themes ppHtmlModule :: FilePath -> String -> Themes -> SourceURLs -> WikiURLs - -> Maybe String -> Maybe String -> Bool -> Qualification + -> Maybe String -> Maybe String -> Bool -> QualOption -> Bool -> Interface -> IO () ppHtmlModule odir doctitle themes maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url unicode qual debug iface = do let mdl = ifaceMod iface + aliases = ifaceModuleAliases iface mdl_str = moduleString mdl - real_qual = case qual of - LocalQual Nothing -> LocalQual (Just mdl) - RelativeQual Nothing -> RelativeQual (Just mdl) - _ -> qual + real_qual = makeModuleQual qual aliases mdl html = headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++ bodyHtml doctitle (Just iface) @@ -484,8 +482,7 @@ ppHtmlModule odir doctitle themes createDirectoryIfMissing True odir writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html) - ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode qual debug - + ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode real_qual debug ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes -> Interface -> Bool -> Qualification -> Bool -> IO () @@ -511,18 +508,16 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual -- todo: if something has only sub-docs, or fn-args-docs, should -- it be measured here and thus prevent omitting the synopsis? - has_doc (ExportDecl _ doc _ _) = isJust (fst doc) + has_doc (ExportDecl _ (Documentation mDoc mWarning, _) _ _) = isJust mDoc || isJust mWarning has_doc (ExportNoDecl _ _) = False has_doc (ExportModule _) = False has_doc _ = True no_doc_at_all = not (any has_doc exports) - description - = case ifaceRnDoc iface of - Nothing -> noHtml - Just doc -> divDescription $ - sectionName << "Description" +++ docSection qual doc + description | isNoHtml doc = doc + | otherwise = divDescription $ sectionName << "Description" +++ doc + where doc = docSection qual (ifaceRnDoc iface) -- omit the synopsis if there are no documentation annotations at all synopsis @@ -539,7 +534,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual maybe_doc_hdr = case exports of [] -> noHtml - ExportGroup _ _ _ : _ -> noHtml + ExportGroup {} : _ -> noHtml _ -> h1 << "Documentation" bdy = @@ -562,12 +557,8 @@ processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of (TyFamily{}) -> [ppTyFamHeader True False d unicode qual] - (TyData{tcdTyPats = ps}) - | Nothing <- ps -> [keyword "data" <+> b] - | Just _ <- ps -> [keyword "data" <+> keyword "instance" <+> b] - (TySynonym{tcdTyPats = ps}) - | Nothing <- ps -> [keyword "type" <+> b] - | Just _ <- ps -> [keyword "type" <+> keyword "instance" <+> b] + (TyDecl{ tcdTyDefn = TyData {} }) -> [keyword "data" <+> b] + (TyDecl{ tcdTyDefn = TySynonym {} }) -> [keyword "type" <+> b] (ClassDecl {}) -> [keyword "class" <+> b] _ -> [] SigD (TypeSig lnames (L _ _)) -> @@ -621,7 +612,7 @@ ppModuleContents qual exports -- we need to assign a unique id to each section heading so we can hyperlink -- them from the contents: numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName] -numberSectionHeadings exports = go 1 exports +numberSectionHeadings = go 1 where go :: Int -> [ExportItem DocName] -> [ExportItem DocName] go _ [] = [] go n (ExportGroup lev _ doc : es) @@ -642,7 +633,7 @@ processExport summary _ _ qual (ExportNoDecl y subs) = processDeclOneLiner summary $ ppDocName qual y +++ parenList (map (ppDocName qual) subs) processExport summary _ _ qual (ExportDoc doc) - = nothingIf summary $ docSection qual doc + = nothingIf summary $ docSection_ qual doc processExport summary _ _ _ (ExportModule mdl) = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl |