diff options
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 48 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 5 |
2 files changed, 24 insertions, 29 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index e204a9da..e3f28824 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -597,9 +597,8 @@ ppHtmlModuleMiniSynopsis odir _doctitle iface unicode = do thetitle (toHtml $ moduleString mdl) +++ styleSheet +++ (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ - body << thediv ! [ theclass "outer" ] << ( - (thediv ! [theclass "mini-topbar"] - << toHtml (moduleString mdl)) +++ + miniBody << + (divModuleHeader << sectionName << moduleString mdl +++ miniSynopsis mdl iface unicode) createDirectoryIfMissing True odir writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString html) @@ -654,38 +653,29 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode miniSynopsis :: Module -> Interface -> Bool -> Html miniSynopsis mdl iface unicode = - thediv ! [ theclass "mini-synopsis" ] - << hsep (map (processForMiniSynopsis mdl unicode) $ exports) + divInterface << mapMaybe (processForMiniSynopsis mdl unicode) exports where exports = numberSectionHeadings (ifaceRnExportItems iface) -processForMiniSynopsis :: Module -> Bool -> ExportItem DocName -> Html +processForMiniSynopsis :: Module -> Bool -> ExportItem DocName -> Maybe Html processForMiniSynopsis mdl unicode (ExportDecl (L _loc decl0) _doc _ _insts) = - thediv ! [theclass "decl" ] << - case decl0 of - TyClD d@(TyFamily{}) -> ppTyFamHeader True False d unicode - TyClD d@(TyData{tcdTyPats = ps}) - | Nothing <- ps -> keyword "data" <+> ppTyClBinderWithVarsMini mdl d - | Just _ <- ps -> keyword "data" <+> keyword "instance" - <+> ppTyClBinderWithVarsMini mdl d - TyClD d@(TySynonym{tcdTyPats = ps}) - | Nothing <- ps -> keyword "type" <+> ppTyClBinderWithVarsMini mdl d - | Just _ <- ps -> keyword "type" <+> keyword "instance" - <+> ppTyClBinderWithVarsMini mdl d - TyClD d@(ClassDecl {}) -> - keyword "class" <+> ppTyClBinderWithVarsMini mdl d + ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of + TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of + (TyFamily{}) -> Just $ ppTyFamHeader True False d unicode + (TyData{tcdTyPats = ps}) + | Nothing <- ps -> Just $ keyword "data" <+> b + | Just _ <- ps -> Just $ keyword "data" <+> keyword "instance" <+> b + (TySynonym{tcdTyPats = ps}) + | Nothing <- ps -> Just $ keyword "type" <+> b + | Just _ <- ps -> Just $ keyword "type" <+> keyword "instance" <+> b + (ClassDecl {}) -> Just $ keyword "class" <+> b + _ -> Nothing SigD (TypeSig (L _ n) (L _ _)) -> - let nm = docNameOcc n - in ppNameMini mdl nm - _ -> noHtml + Just $ ppNameMini mdl (docNameOcc n) + _ -> Nothing processForMiniSynopsis _ _ (ExportGroup lvl _id txt) = - let heading - | lvl == 1 = h1 - | lvl == 2 = h2 - | lvl >= 3 = h3 - | otherwise = error "bad group level" - in heading << docToHtml txt -processForMiniSynopsis _ _ _ = noHtml + Just $ groupTag lvl << docToHtml txt +processForMiniSynopsis _ _ _ = Nothing ppNameMini :: Module -> OccName -> Html ppNameMini mdl nm = diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 86e75740..d7f9c1c8 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -11,6 +11,8 @@ -- Portability : portable ----------------------------------------------------------------------------- module Haddock.Backends.Xhtml.Layout ( + miniBody, + divPackageHeader, divModuleHeader, divFooter, divTableOfContents, divDescription, divSynposis, divInterface, @@ -46,6 +48,9 @@ import GHC -- Sections of the document +miniBody :: Html -> Html +miniBody = body ! [identifier "mini"] + divPackageHeader, divModuleHeader, divFooter :: Html -> Html divPackageHeader = thediv ! [identifier "package-header"] divModuleHeader = thediv ! [identifier "module-header"] |