From a7aad74a978e2e1d313c23863c7a91983bbc4848 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Sun, 18 Jul 2010 06:12:22 +0000
Subject: add .doc class to documentation blocks
---
src/Haddock/Backends/Xhtml.hs | 6 +++---
src/Haddock/Backends/Xhtml/Decl.hs | 12 ++++++------
src/Haddock/Backends/Xhtml/DocMarkup.hs | 19 +++++++++++++++----
src/Haddock/Backends/Xhtml/Layout.hs | 4 ++--
4 files changed, 26 insertions(+), 15 deletions(-)
(limited to 'src/Haddock')
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
--
cgit v1.2.3