From 2b87648737ad5b07e30d9bb03f7c4e3953566c24 Mon Sep 17 00:00:00 2001 From: Tobias Brandt Date: Fri, 27 Aug 2010 07:01:21 +0000 Subject: adding the option to fully qualify identifiers --- src/Haddock/Backends/Xhtml.hs | 58 ++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 28 deletions(-) (limited to 'src/Haddock/Backends/Xhtml.hs') diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 71a96bf9..452fdfa0 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -66,11 +66,13 @@ 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 -> IO () ppHtml doctitle maybe_package ifaces odir prologue themes maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url unicode = do + maybe_contents_url maybe_index_url unicode + quali = do let visible_ifaces = filter visible ifaces visible i = OptHide `notElem` ifaceOptions i @@ -88,7 +90,7 @@ ppHtml doctitle maybe_package ifaces odir prologue mapM_ (ppHtmlModule odir doctitle themes maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url unicode) visible_ifaces + maybe_contents_url maybe_index_url unicode quali) visible_ifaces copyHtmlBits :: FilePath -> FilePath -> Themes -> IO () @@ -448,11 +450,11 @@ ppHtmlIndex odir doctitle _maybe_package themes ppHtmlModule :: FilePath -> String -> Themes -> SourceURLs -> WikiURLs - -> Maybe String -> Maybe String -> Bool + -> Maybe String -> Maybe String -> Bool -> Qualification -> Interface -> IO () ppHtmlModule odir doctitle themes maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url unicode iface = do + maybe_contents_url maybe_index_url unicode quali iface = do let mdl = ifaceMod iface mdl_str = moduleString mdl @@ -462,30 +464,30 @@ ppHtmlModule odir doctitle themes maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url << [ divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)), - ifaceToHtml maybe_source_url maybe_wiki_url iface unicode + ifaceToHtml maybe_source_url maybe_wiki_url iface unicode quali ] createDirectoryIfMissing True odir writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString html) - ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode + ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode quali ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes - -> Interface -> Bool -> IO () -ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode = do + -> Interface -> Bool -> Qualification -> IO () +ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode quali = do let mdl = ifaceMod iface html = headHtml (moduleString mdl) Nothing themes +++ miniBody << (divModuleHeader << sectionName << moduleString mdl +++ - miniSynopsis mdl iface unicode) + miniSynopsis mdl iface unicode quali) createDirectoryIfMissing True odir writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString html) -ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Html -ifaceToHtml maybe_source_url maybe_wiki_url iface unicode - = ppModuleContents exports +++ +ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html +ifaceToHtml maybe_source_url maybe_wiki_url iface unicode quali + = ppModuleContents quali exports +++ description +++ synopsis +++ divInterface (maybe_doc_hdr +++ bdy) @@ -505,7 +507,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode = case ifaceRnDoc iface of Nothing -> noHtml Just doc -> divDescription $ - sectionName << "Description" +++ docSection doc + sectionName << "Description" +++ docSection quali doc -- omit the synopsis if there are no documentation annotations at all synopsis @@ -514,7 +516,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode = divSynposis $ paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++ shortDeclList ( - mapMaybe (processExport True linksInfo unicode) exports + mapMaybe (processExport True linksInfo unicode quali) exports ) ! (collapseSection "syn" False "" ++ collapseToggle "syn") -- if the documentation doesn't begin with a section header, then @@ -527,20 +529,21 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode bdy = foldr (+++) noHtml $ - mapMaybe (processExport False linksInfo unicode) exports + mapMaybe (processExport False linksInfo unicode quali) exports linksInfo = (maybe_source_url, maybe_wiki_url) -miniSynopsis :: Module -> Interface -> Bool -> Html -miniSynopsis mdl iface unicode = - divInterface << mapMaybe (processForMiniSynopsis mdl unicode) exports +miniSynopsis :: Module -> Interface -> Bool -> Qualification -> Html +miniSynopsis mdl iface unicode quali = + divInterface << mapMaybe (processForMiniSynopsis mdl unicode quali) exports where exports = numberSectionHeadings (ifaceRnExportItems iface) -processForMiniSynopsis :: Module -> Bool -> ExportItem DocName -> Maybe Html -processForMiniSynopsis mdl unicode (ExportDecl (L _loc decl0) _doc _ _insts) = +processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName + -> Maybe Html +processForMiniSynopsis mdl unicode _ (ExportDecl (L _loc decl0) _doc _ _insts) = ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of (TyFamily{}) -> Just $ ppTyFamHeader True False d unicode @@ -555,9 +558,9 @@ processForMiniSynopsis mdl unicode (ExportDecl (L _loc decl0) _doc _ _insts) = SigD (TypeSig (L _ n) (L _ _)) -> Just $ ppNameMini mdl (docNameOcc n) _ -> Nothing -processForMiniSynopsis _ _ (ExportGroup lvl _id txt) = - Just $ groupTag lvl << docToHtml txt -processForMiniSynopsis _ _ _ = Nothing +processForMiniSynopsis _ _ quali (ExportGroup lvl _id txt) = + Just $ groupTag lvl << docToHtml quali txt +processForMiniSynopsis _ _ _ _ = Nothing ppNameMini :: Module -> OccName -> Html @@ -574,8 +577,8 @@ ppTyClBinderWithVarsMini mdl decl = in ppTypeApp n ns (ppNameMini mdl . docNameOcc) ppTyName -ppModuleContents :: [ExportItem DocName] -> Html -ppModuleContents exports +ppModuleContents :: Qualification -> [ExportItem DocName] -> Html +ppModuleContents quali exports | null sections = noHtml | otherwise = contentsDiv where @@ -591,8 +594,7 @@ ppModuleContents exports | lev <= n = ( [], items ) | otherwise = ( html:secs, rest2 ) where - html = linkedAnchor (groupId id0) - << docToHtml doc +++ mk_subsections ssecs + html = linkedAnchor id0 << docToHtml doc +++ mk_subsections ssecs (ssecs, rest1) = process lev rest (secs, rest2) = process n rest1 process n (_ : rest) = process n rest @@ -615,7 +617,7 @@ numberSectionHeadings exports = go 1 exports processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) -> Maybe Html processExport summary _ _ (ExportGroup lev id0 doc) - = nothingIf summary $ groupHeading lev id0 << docToHtml doc + = nothingIf summary $ groupTag lev ! [identifier id0] << docToHtml doc processExport summary links unicode (ExportDecl decl doc subdocs insts) = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode processExport summary _ _ (ExportNoDecl y []) -- cgit v1.2.3