From cd869b6a41463f6fd0c979bafe09ce06cbc05ee2 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Wed, 14 Jul 2010 07:04:10 +0000
Subject: made subDecl tables looks just so

---
 src/Haddock/Backends/Xhtml/Layout.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 80dd5ec8..3c695042 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -80,17 +80,29 @@ subDlist :: [SubDecl] -> Maybe Html
 subDlist [] = Nothing
 subDlist decls = Just $ dlist << map subEntry decls
   where
-    subEntry (decl, mdoc, subs) = Just $
+    subEntry (decl, mdoc, subs) =
       dterm ! [theclass "src"] << decl
-      +++ ddef << (fmap docToHtml mdoc `with` subs)
+      +++
+      ddef << (fmap docToHtml mdoc `with` subs)
+      
     Nothing  `with` [] = spaceHtml
     ma       `with` bs = ma +++ bs
 
+subTable :: [SubDecl] -> Maybe Html
+subTable [] = Nothing
+subTable decls = Just $ table << aboves (concatMap subRow decls)
+  where
+    subRow (decl, mdoc, subs) =
+      (td ! [theclass "src"] << decl
+       <->
+       td << nonEmpty (fmap docToHtml mdoc))
+      : map (cell . (td <<)) subs
+      
 subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html
-subConstructors = divSubDecls "constructors" "Constructors" . subDlist
+subConstructors = divSubDecls "constructors" "Constructors" . subTable
 
 subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html
-subFields = divSubDecls "fields" "Fields" . subDlist
+subFields = divSubDecls "fields" "Fields" . subTable
 
 
 -- a box for displaying code
-- 
cgit v1.2.3