From 21d6bb713fac1fbbc988a9939d7b0b1edc7a5f64 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Wed, 14 Jul 2010 16:00:54 +0000
Subject: convert args to SubDecl format

---
 src/Haddock/Backends/Xhtml/Decl.hs   | 34 +++++++++++++---------------------
 src/Haddock/Backends/Xhtml/Layout.hs |  5 +++++
 2 files changed, 18 insertions(+), 21 deletions(-)

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index ffee5bd7..f5aa4fcf 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -67,40 +67,32 @@ ppTypeOrFunSig summary links loc docname typ (doc, argDocs) (pref1, pref2, sep)
   | summary = declElem pref1
   | Map.null argDocs = topDeclElem links loc docname pref1 +++ maybeDocToHtml doc
   | otherwise = topDeclElem links loc docname pref2 +++
-    (vanillaTable <<  (
-      do_args 0 sep typ </>
-        (case doc of
-          Just d -> ndocBox (docToHtml d)
-          Nothing -> emptyTable)
-        ))
+      subArguments (do_args 0 sep typ) +++ maybeDocToHtml doc
   where 
-    argDocHtml n = case Map.lookup n argDocs of
-                    Just adoc -> docToHtml adoc
-                    Nothing -> noHtml
+    argDoc n = Map.lookup n argDocs
 
     do_largs n leader (L _ t) = do_args n leader t  
-    do_args :: Int -> Html -> (HsType DocName) -> HtmlTable
+    do_args :: Int -> Html -> (HsType DocName) -> [SubDecl]
     do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
-      = (argBox (
-          leader <+> 
+      = (leader <+> 
           hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
-          ppLContextNoArrow lctxt unicode)
-            <-> rdocBox noHtml) </> 
-            do_largs n (darrow unicode) ltype
+          ppLContextNoArrow lctxt unicode,
+          Nothing, [])
+        : do_largs n (darrow unicode) ltype
     do_args n leader (HsForAllTy Implicit _ lctxt ltype)
       | not (null (unLoc lctxt))
-      = (argBox (leader <+> ppLContextNoArrow lctxt unicode)
-          <-> rdocBox noHtml) </> 
-          do_largs n (darrow unicode) ltype
+      = (leader <+> ppLContextNoArrow lctxt unicode,
+          Nothing, [])
+        : do_largs n (darrow unicode) ltype
       -- if we're not showing any 'forall' or class constraints or
       -- anything, skip having an empty line for the context.
       | otherwise
       = do_largs n leader ltype
     do_args n leader (HsFunTy lt r)
-      = (argBox (leader <+> ppLFunLhType unicode lt) <-> rdocBox (argDocHtml n))
-          </> do_largs (n+1) (arrow unicode) r
+      = (leader <+> ppLFunLhType unicode lt, argDoc n, [])
+        : do_largs (n+1) (arrow unicode) r
     do_args n leader t
-      = argBox (leader <+> ppType unicode t) <-> rdocBox (argDocHtml n)
+      = (leader <+> ppType unicode t, argDoc n, []) : []
 
 
 ppTyVars :: [LHsTyVarBndr DocName] -> [Html]
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 3c695042..440d8e1e 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -20,6 +20,7 @@ module Haddock.Backends.Xhtml.Layout (
   divTopDecl,
   
   SubDecl,
+  subArguments,
   subConstructors, subFields,
   
   topDeclElem, declElem,
@@ -98,6 +99,10 @@ subTable decls = Just $ table << aboves (concatMap subRow decls)
        td << nonEmpty (fmap docToHtml mdoc))
       : map (cell . (td <<)) subs
       
+
+subArguments :: [(Html, Maybe (Doc DocName), [Html])] -> Html
+subArguments = divSubDecls "arguments" "Arguments" . subTable
+
 subConstructors :: [(Html, Maybe (Doc DocName), [Html])] -> Html
 subConstructors = divSubDecls "constructors" "Constructors" . subTable
 
-- 
cgit v1.2.3