diff options
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 12 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 19 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 4 |
4 files changed, 26 insertions, 15 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 24499f39..786a4996 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -294,7 +294,7 @@ ppHtmlContents odir doctitle ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> Html ppPrologue _ Nothing = noHtml ppPrologue title (Just doc) = - divDescription << (h1 << title +++ rdrDocToHtml doc) + docElement divDescription << (h1 << title +++ rdrDocToHtml doc) ppModuleTree :: [ModuleTree] -> Html ppModuleTree ts = @@ -543,7 +543,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode = case ifaceRnDoc iface of Nothing -> noHtml Just doc -> divDescription $ - sectionName << "Description" +++ docToHtml doc + sectionName << "Description" +++ docSection doc -- omit the synopsis if there are no documentation annotations at all synopsis @@ -654,7 +654,7 @@ processExport summary _ _ (ExportNoDecl y []) processExport summary _ _ (ExportNoDecl y subs) = processDeclOneLiner summary $ ppDocName y +++ parenList (map ppDocName subs) processExport summary _ _ (ExportDoc doc) - = nothingIf summary $ docToHtml doc + = nothingIf summary $ docSection doc processExport summary _ _ (ExportModule mdl) = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl "" diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 211395bd..d9cd4d5d 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -65,9 +65,9 @@ ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> DocName -> HsType DocName -> DocForDecl DocName -> (Html, Html, Html) -> Bool -> Html ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep) unicode | summary = pref1 - | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocToHtml doc + | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocSection doc | otherwise = topDeclElem links loc docname pref2 +++ - subArguments (do_args 0 sep typ) +++ maybeDocToHtml doc + subArguments (do_args 0 sep typ) +++ maybeDocSection doc where argDoc n = Map.lookup n argDocs @@ -160,7 +160,7 @@ ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> ppTyFam summary associated links loc mbDoc decl unicode | summary = ppTyFamHeader True associated decl unicode - | otherwise = header_ +++ maybeDocToHtml mbDoc +++ instancesBit + | otherwise = header_ +++ maybeDocSection mbDoc +++ instancesBit where docname = tcdName decl @@ -200,7 +200,7 @@ ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> ppTyInst summary associated links loc mbDoc decl unicode | summary = ppTyInstHeader True associated decl unicode - | otherwise = header_ +++ maybeDocToHtml mbDoc + | otherwise = header_ +++ maybeDocSection mbDoc where docname = tcdName decl @@ -355,7 +355,7 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan ppClassDecl summary links instances loc mbDoc subdocs decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode | summary = ppShortClassDecl summary links decl loc subdocs unicode - | otherwise = classheader +++ maybeDocToHtml mbDoc + | otherwise = classheader +++ maybeDocSection mbDoc +++ atBit +++ methodBit +++ instancesBit where classheader @@ -433,7 +433,7 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode | summary = ppShortDataDecl summary links loc dataDecl unicode - | otherwise = header_ +++ maybeDocToHtml mbDoc +++ constrBit +++ instancesBit + | otherwise = header_ +++ maybeDocSection mbDoc +++ constrBit +++ instancesBit where docname = unLoc . tcdLName $ dataDecl diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index 0d4593a3..6563f914 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -11,9 +11,11 @@ -- Portability : portable ----------------------------------------------------------------------------- module Haddock.Backends.Xhtml.DocMarkup ( - docToHtml, maybeDocToHtml, + docToHtml, rdrDocToHtml, - origDocToHtml + origDocToHtml, + + docElement, docSection, maybeDocSection, ) where import Haddock.Backends.Xhtml.Names @@ -85,8 +87,17 @@ rdrDocToHtml :: Doc RdrName -> Html rdrDocToHtml = markup fmt . cleanup where fmt = parHtmlMarkup ppRdrName isRdrTc -maybeDocToHtml :: Maybe (Doc DocName) -> Html -maybeDocToHtml = maybe noHtml docToHtml + + +docElement :: (ADDATTRS a) => a -> a +docElement = (! [theclass "doc"]) + +docSection :: Doc DocName -> Html +docSection = (docElement thediv <<) . docToHtml + +maybeDocSection :: Maybe (Doc DocName) -> Html +maybeDocSection = maybe noHtml docSection + cleanup :: Doc a -> Doc a cleanup = markup fmtUnParagraphLists diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 0b4af0c0..ade5a266 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -109,7 +109,7 @@ subDlist decls = Just $ dlist << map subEntry decls subEntry (decl, mdoc, subs) = dterm ! [theclass "src"] << decl +++ - ddef << (fmap docToHtml mdoc `with` subs) + docElement ddef << (fmap docToHtml mdoc `with` subs) Nothing `with` [] = spaceHtml ma `with` bs = ma +++ bs @@ -122,7 +122,7 @@ subTable decls = Just $ table << aboves (concatMap subRow decls) subRow (decl, mdoc, subs) = (td ! [theclass "src"] << decl <-> - td << nonEmpty (fmap docToHtml mdoc)) + docElement td << nonEmpty (fmap docToHtml mdoc)) : map (cell . (td <<)) subs subBlock :: [Html] -> Maybe Html |