add .doc class to documentation blocks

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