better interface to subDecls

1 files changed, 35 insertions, 38 deletions

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 1245ff62..ffee5bd7 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -480,7 +480,7 @@ ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode
         ResTyGADT _ -> keyword "where"
         _ -> empty                         
 
-    constrBit = subDecls "Constructors" 
+    constrBit = subConstructors 
       (map (ppSideBySideConstr subdocs unicode) cons)
 
     instancesBit = ppInstances instances docname unicode
@@ -553,45 +553,41 @@ ppConstrHdr forall tvs ctxt unicode
       Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> toHtml ". "
       Implicit -> empty
 
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LConDecl DocName -> (Html, Maybe Html)
-ppSideBySideConstr subdocs unicode (L _ con) = case con_res con of 
- 
-  ResTyH98 -> case con_details con of 
-
-    PrefixCon args -> 
-      (hsep ((header_ unicode +++ ppBinder False occ)
-        : map (ppLParendType unicode) args), 
-      fmap docToHtml mbDoc)
-
-    RecCon fields -> 
-      (header_ unicode +++ ppBinder False occ,
-      fmap docToHtml mbDoc `with` (Just $ doRecordFields fields))
-
-    InfixCon arg1 arg2 -> 
-      (hsep [header_ unicode+++ppLParendType unicode arg1,
-        ppBinder False occ,
-        ppLParendType unicode arg2],
-      fmap docToHtml mbDoc)
- 
-  ResTyGADT resTy -> case con_details con of
-    -- prefix & infix could also use hsConDeclArgTys if it seemed to
-    -- simplify the code.
-    PrefixCon args -> doGADTCon args resTy Nothing
-    cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy
-                                          (Just $ doRecordFields fields)
-    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy Nothing
-
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LConDecl DocName -> SubDecl
+ppSideBySideConstr subdocs unicode (L _ con) = (decl, mbDoc, fieldPart)
  where 
-    doRecordFields fields = subDecls "Fields" 
+    decl = case con_res con of 
+      ResTyH98 -> case con_details con of 
+        PrefixCon args -> 
+          hsep ((header_ unicode +++ ppBinder False occ)
+            : map (ppLParendType unicode) args)
+    
+        RecCon _ -> header_ unicode +++ ppBinder False occ
+    
+        InfixCon arg1 arg2 -> 
+          hsep [header_ unicode+++ppLParendType unicode arg1,
+            ppBinder False occ,
+            ppLParendType unicode arg2]
+                 
+      ResTyGADT resTy -> case con_details con of
+        -- prefix & infix could also use hsConDeclArgTys if it seemed to
+        -- simplify the code.
+        PrefixCon args -> doGADTCon args resTy
+        cd@(RecCon _) -> doGADTCon (hsConDeclArgTys cd) resTy
+        InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
+
+    fieldPart = case con_details con of 
+        RecCon fields -> [doRecordFields fields]
+        _ -> []
+
+    doRecordFields fields = subFields 
       (map (ppSideBySideField subdocs unicode) fields)
-    doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Maybe Html -> (Html, Maybe Html)
-    doGADTCon args resTy fieldsHtml =
-      (ppBinder False occ <+> dcolon unicode
+    doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
+    doGADTCon args resTy =
+      ppBinder False occ <+> dcolon unicode
         <+> hsep [ppForAll forall ltvs (con_cxt con) unicode,
-                  ppLType unicode (foldr mkFunTy resTy args) ],
-       fmap docToHtml mbDoc `with` fieldsHtml)
+                  ppLType unicode (foldr mkFunTy resTy args) ]
 
-    with a  = maybe a (\b -> Just $ a +++ b)
     header_ = ppConstrHdr forall tyVars context
     occ     = docNameOcc . unLoc . con_name $ con
     ltvs    = con_qvars con
@@ -604,10 +600,11 @@ ppSideBySideConstr subdocs unicode (L _ con) = case con_res con of
     mbDoc = join $ fmap fst $ lookup (unLoc $ con_name con) subdocs
     mkFunTy a b = noLoc (HsFunTy a b)
 
-ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  (Html, Maybe Html)
+ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  SubDecl
 ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
   (ppBinder False (docNameOcc name) <+> dcolon unicode <+> ppLType unicode ltype,
-    fmap docToHtml mbDoc)
+    mbDoc,
+    [])
   where
     -- don't use cd_fld_doc for same reason we don't use con_doc above
     mbDoc = join $ fmap fst $ lookup name subdocs