change to new page structure

3 files changed, 74 insertions, 28 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index c8a64ece..dc24acbd 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -152,7 +152,7 @@ copyHtmlBits odir libdir maybe_css = do
 
 footer :: Html
 footer =
-  thediv ! [theclass "bottom"] << paragraph << (
+  divFooter << paragraph << (
     "Produced by " +++ 
     (anchor ! [href projectUrl] << toHtml projectName) +++
     (" version " ++ projectVersion)
@@ -194,8 +194,8 @@ simpleHeader :: String -> Maybe String -> Maybe String
              -> SourceURLs -> WikiURLs -> Html
 simpleHeader doctitle maybe_contents_url maybe_index_url
   maybe_source_url maybe_wiki_url = 
-  thediv ! [theclass "package-header"] << (
-    paragraph ! [theclass "caption"] << doctitle +++
+  divPackageHeader << (
+    sectionName << nonEmpty doctitle +++
     unordList (catMaybes [ 
       srcButton maybe_source_url Nothing,
       wikiButton maybe_wiki_url Nothing,
@@ -210,8 +210,8 @@ pageHeader :: String -> Interface -> String
 pageHeader mdl iface doctitle
            maybe_source_url maybe_wiki_url
            maybe_contents_url maybe_index_url =
-  thediv ! [theclass "package-header"] << (
-    paragraph ! [theclass "caption"] << (doctitle +++ spaceHtml) +++
+  divPackageHeader << (
+    sectionName << nonEmpty doctitle +++
     unordList (catMaybes [ 
         srcButton maybe_source_url (Just iface),
         wikiButton maybe_wiki_url (Just $ ifaceMod iface),
@@ -219,8 +219,8 @@ pageHeader mdl iface doctitle
         indexButton maybe_index_url
         ]) ! [theclass "links"]
    ) +++
-  thediv ! [theclass "module-header"] << (
-    paragraph ! [theclass "caption"] << mdl +++
+  divModuleHeader << (
+    sectionName << mdl +++
     moduleInfo iface
   )
 
@@ -606,8 +606,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
   = ppModuleContents exports +++
     description +++
     synopsis +++
-    maybe_doc_hdr +++
-    bdy
+    divInterface (maybe_doc_hdr +++ bdy)
   where
     exports = numberSectionHeadings (ifaceRnExportItems iface)
 
@@ -623,16 +622,18 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
     description
           = case ifaceRnDoc iface of
               Nothing -> noHtml
-              Just doc -> h1 << toHtml "Description" +++ docToHtml doc
+              Just doc -> divDescription $
+                            sectionName << "Description" +++ docToHtml doc
 
         -- omit the synopsis if there are no documentation annotations at all
     synopsis
       | no_doc_at_all = noHtml
       | otherwise
-      = h1 << "Synopsis" +++
-        unordList (
-            mapMaybe (processExport True linksInfo unicode) exports
-        ) ! [theclass "synopsis"]
+      = divSynposis $
+            sectionName << "Synopsis" +++
+            shortDeclList (
+                mapMaybe (processExport True linksInfo unicode) exports
+            )
 
         -- if the documentation doesn't begin with a section header, then
         -- add one ("Documentation").
@@ -644,8 +645,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
 
     bdy =
       foldr (+++) noHtml $
-        map (thediv ! [theclass "decldoc"]) $
-          mapMaybe (processExport False linksInfo unicode) exports
+        mapMaybe (processExport False linksInfo unicode) exports
           
     linksInfo = (maybe_source_url, maybe_wiki_url)
 
@@ -702,8 +702,8 @@ ppModuleContents exports
   | null sections = noHtml
   | otherwise     = contentsDiv
  where
-  contentsDiv = thediv ! [theclass "table-of-contents"] << (
-    paragraph ! [theclass "caption"] << "Contents" +++
+  contentsDiv = divTableOfContents << (
+    sectionName << "Contents" +++
     unordList sections)
     
   (sections, _leftovers{-should be []-}) = process 0 exports
@@ -737,20 +737,28 @@ processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) -> Maybe Html
 processExport summary _ _ (ExportGroup lev id0 doc)
   = nothingIf summary $ groupTag lev << namedAnchor id0 << docToHtml doc
 processExport summary links unicode (ExportDecl decl doc subdocs insts)
-  = Just $ ppDecl summary links decl doc insts subdocs unicode
-processExport _ _ _ (ExportNoDecl y [])
-  = Just $ ppDocName y
-processExport _ _ _ (ExportNoDecl y subs)
-  = Just $ ppDocName y +++ parenList (map ppDocName subs)
+  = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode
+processExport summary _ _ (ExportNoDecl y [])
+  = processDeclOneLiner summary $ ppDocName y
+processExport summary _ _ (ExportNoDecl y subs)
+  = processDeclOneLiner summary $ ppDocName y +++ parenList (map ppDocName subs)
 processExport summary _ _ (ExportDoc doc)
   = nothingIf summary $ docToHtml doc
-processExport _ _ _ (ExportModule mdl)
-  = Just $ toHtml "module" <+> ppModule mdl ""
+processExport summary _ _ (ExportModule mdl)
+  = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl ""
 
 nothingIf :: Bool -> a -> Maybe a
 nothingIf True _ = Nothing
 nothingIf False a = Just a
 
+processDecl :: Bool -> Html -> Maybe Html
+processDecl True = Just
+processDecl False = Just . divTopDecl
+
+processDeclOneLiner :: Bool -> Html -> Maybe Html
+processDeclOneLiner True = Just
+processDeclOneLiner False = Just . divTopDecl . declElem
+
 groupTag :: Int -> Html -> Html
 groupTag lev
   | lev == 1  = h1
@@ -760,4 +768,3 @@ groupTag lev
 
 
 
-
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index ac6f5021..86c722b7 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -11,6 +11,14 @@
 -- Portability :  portable
 -----------------------------------------------------------------------------
 module Haddock.Backends.Xhtml.Layout (
+  divPackageHeader, divModuleHeader, divFooter,
+  divTableOfContents, divDescription, divSynposis, divInterface, 
+  
+  sectionName,
+  
+  shortDeclList,
+  divTopDecl, 
+  
   topDeclElem, declElem,
   
   instHdr, atHdr, methHdr, constrHdr,
@@ -29,10 +37,36 @@ import Text.XHtml hiding ( name, title, p, quote )
 import FastString            ( unpackFS )
 import GHC
 
+-- Sections of the document
+
+divPackageHeader, divModuleHeader, divFooter :: Html -> Html
+divPackageHeader = thediv ! [identifier "package-header"]
+divModuleHeader  = thediv ! [identifier "module-header"]
+divFooter        = thediv ! [identifier "footer"]
+
+divTableOfContents, divDescription, divSynposis, divInterface :: Html -> Html
+divTableOfContents = thediv ! [identifier "table-of-contents"]
+divDescription     = thediv ! [identifier "description"]
+divSynposis        = thediv ! [identifier "synopsis"]
+divInterface       = thediv ! [identifier "interface"]
+
+-- | The name of a section, used directly after opening a section
+sectionName :: Html -> Html
+sectionName = paragraph ! [theclass "caption"]
+
+
+-- | Declaration containers 
+
+shortDeclList :: [Html] -> Html
+shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
+
+divTopDecl :: Html -> Html
+divTopDecl = thediv ! [theclass "top"]
+
 
 -- a box for displaying code
 declElem :: Html -> Html
-declElem = paragraph ! [theclass "decl"]
+declElem = paragraph ! [theclass "src"]
 
 -- a box for top level documented names
 -- it adds a source and wiki link at the right hand side of the box
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index 9e13acd6..826b69f1 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -16,7 +16,7 @@ module Haddock.Backends.Xhtml.Util (
   namedAnchor, linkedAnchor,
   spliceURL,
   
-  (<+>), char, empty,
+  (<+>), char, empty, nonEmpty,
   keyword, punctuate,
   
   braces, brackets, pabrackets, parens, parenList, ubxParenList,
@@ -110,6 +110,11 @@ char c = toHtml [c]
 empty :: Html
 empty  = noHtml
 
+-- | ensure content contains at least something (a non-breaking space)
+nonEmpty :: (HTML a) => a -> Html
+nonEmpty a = if isNoHtml h then spaceHtml else h
+    where h = toHtml a
+
 
 quote :: Html -> Html
 quote h = char '`' +++ h +++ '`'