From ab2ec30f12e283f4d28d1aa52b0980c96b0a7036 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Wed, 14 Jul 2010 21:54:58 +0000
Subject: methods and associated types in new layout scheme

---
 src/Haddock/Backends/Xhtml/Decl.hs   | 14 ++------------
 src/Haddock/Backends/Xhtml/Layout.hs | 29 ++++++++++++++++++-----------
 2 files changed, 20 insertions(+), 23 deletions(-)

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 6e0c5601..ef7d01d4 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -366,23 +366,13 @@ ppClassDecl summary links instances loc mbDoc subdocs
 
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
     
-    atBit
-      | null ats = noHtml
-      | otherwise = atHdr +++ (
-          thediv ! [theclass "subdecl"] <<
-          concatHtml [ ppAssocType summary links doc at unicode
+    atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode
                       | at <- ats
                       , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]
-          )
 
-    methodBit
-      | null lsigs = noHtml
-      | otherwise = methHdr +++ (
-          thediv ! [theclass "subdecl"] <<
-          concatHtml [ ppFunSig summary links loc doc n typ unicode
+    methodBit = subMethods [ ppFunSig summary links loc doc n typ unicode
                       | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs
                       , let doc = lookupAnySubdoc n subdocs ]
-          )
 
     instancesBit = ppInstances instances nm unicode
     
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 205f659c..d9b1c250 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -21,13 +21,14 @@ module Haddock.Backends.Xhtml.Layout (
   
   SubDecl,
   subArguments,
+  subAssociatedTypes,
   subConstructors,
   subFields,
   subInstances,
+  subMethods,
   
   topDeclElem, declElem,
   
-  atHdr, methHdr,
   argBox, vanillaTable, vanillaTable2  
 ) where
 
@@ -98,23 +99,34 @@ subTable decls = Just $ table << aboves (concatMap subRow decls)
        <->
        td << nonEmpty (fmap docToHtml mdoc))
       : map (cell . (td <<)) subs
-      
 
-subArguments :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subBlock :: [Html] -> Maybe Html
+subBlock [] = Nothing
+subBlock hs = Just $ toHtml hs
+
+
+subArguments :: [SubDecl] -> Html
 subArguments = divSubDecls "arguments" "Arguments" . subTable
 
-subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subAssociatedTypes :: [Html] -> Html
+subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock
+
+subConstructors :: [SubDecl] -> Html
 subConstructors = divSubDecls "constructors" "Constructors" . subTable
 
-subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subFields :: [SubDecl] -> Html
 subFields = divSubDecls "fields" "Fields" . subTable
 
-subInstances :: String -> [(Html, Maybe (Doc DocName), [Html])] -> Html
+subInstances :: String -> [SubDecl] -> Html
 subInstances id_ = divSubDecls "instances" instCaption . instTable
   where
     instCaption = collapsebutton id_ +++ " Instances"
     instTable = (collapsed thediv id_ `fmap`) . subTable
 
+subMethods :: [Html] -> Html
+subMethods = divSubDecls "methods" "Methods" . subBlock
+
+
 -- a box for displaying code
 declElem :: Html -> Html
 declElem = paragraph ! [theclass "src"]
@@ -162,8 +174,3 @@ argBox html = tda [theclass "arg"] << html
 vanillaTable, vanillaTable2 :: Html -> Html
 vanillaTable  = table ! [theclass "vanilla",  cellspacing 0, cellpadding 0]
 vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0]
-
-
-methHdr, atHdr :: Html
-methHdr    = h5 << "Methods"
-atHdr      = h5 << "Associated Types"
-- 
cgit v1.2.3