diff options
Diffstat (limited to 'src/HaddockHtml.hs')
| -rw-r--r-- | src/HaddockHtml.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 7f05d42f..06ff5db2 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -17,6 +17,7 @@ import FiniteMap import List ( sortBy ) import Char ( toUpper, toLower ) import Monad ( when ) +import IOExts import Html import qualified Html @@ -461,15 +462,14 @@ keepDecl _ = False -- ----------------------------------------------------------------------------- -- Data & newtype declarations -ppShortDataDecl doc_map summary is_newty +ppShortDataDecl :: Bool -> Bool -> HsDecl -> Html +ppShortDataDecl summary is_newty (HsDataDecl loc ctx nm args [con] drv) = - declBox ( -- single constructor special case - ppHsDataHeader summary is_newty nm args - <+> equals <+> ppShortConstr summary con - ) -ppShortDataDecl doc_map summary is_newty + ppHsDataHeader summary is_newty nm args + <+> equals <+> ppShortConstr summary con +ppShortDataDecl summary is_newty (HsDataDecl loc ctx nm args cons drv) = - declBox << vanillaTable << ( + vanillaTable << ( aboves ( (declBox (ppHsDataHeader summary is_newty nm args) : zipWith do_constr ('=':repeat '|') cons @@ -488,8 +488,9 @@ ppHsDataDecl doc_map summary is_newty (HsDataDecl loc ctx nm args [] drv) = -- The rest of the cases: ppHsDataDecl doc_map summary is_newty decl@(HsDataDecl loc ctx nm args cons drv) - | summary || (isNothing doc && all constr_has_no_doc cons) - = ppShortDataDecl doc_map summary is_newty decl + | summary || no_constr_docs + = declWithDoc summary (lookupFM doc_map nm) + (ppShortDataDecl summary is_newty decl) | otherwise = td << vanillaTable << (header </> datadoc </> constrs) @@ -512,10 +513,15 @@ ppHsDataDecl doc_map summary is_newty decl@(HsDataDecl loc ctx nm args cons drv) Just c = declMainBinder decl doc = lookupFM doc_map c + no_constr_docs = all constr_has_no_doc cons + constr_has_no_doc (HsConDecl _ nm _ _) = isNothing (lookupFM doc_map nm) - constr_has_no_doc (HsRecDecl _ nm _ _) - = isNothing (lookupFM doc_map nm) + constr_has_no_doc (HsRecDecl _ nm fields _) + = isNothing (lookupFM doc_map nm) && all field_has_no_doc fields + + field_has_no_doc (HsFieldDecl nms _ _) + = trace (show nms ++ show (map (isNothing . lookupFM doc_map) nms)) $ all isNothing (map (lookupFM doc_map) nms) ppShortConstr :: Bool -> HsConDecl -> Html |