aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorIsaac Dupree <id@isaac.cedarswampstudios.org>2009-07-20 15:37:18 +0000
committerIsaac Dupree <id@isaac.cedarswampstudios.org>2009-07-20 15:37:18 +0000
commit1e116a2c7c6f729775e99183778a2909df046622 (patch)
tree97112b7a3e385eb00f100f37078878dadacdbf93 /src/Haddock/Backends
parent686ae19c4fb3d17e2d01335764b44126329e75cd (diff)
Implement GADT records in HTML backend
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Html.hs30
1 files changed, 24 insertions, 6 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index e0e12164..25991eb8 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -1330,16 +1330,27 @@ ppShortConstr summary con unicode = case con_res con of
ResTyH98 -> case con_details con of
PrefixCon args -> header_ unicode +++ hsep (ppBinder summary occ : map (ppLParendType unicode) args)
RecCon fields -> header_ unicode +++ ppBinder summary occ <+>
- braces (vanillaTable << aboves (map (ppShortField summary unicode) fields))
+ doRecordFields fields
InfixCon arg1 arg2 -> header_ unicode +++
hsep [ppLParendType unicode arg1, ppBinder summary occ, ppLParendType unicode arg2]
ResTyGADT resTy -> case con_details con of
+ -- prefix & infix could use hsConDeclArgTys if it seemed to
+ -- simplify the code.
PrefixCon args -> doGADTCon args resTy
- RecCon _ -> error "GADT records not suported"
+ -- display GADT records with the new syntax,
+ -- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
+ -- (except each field gets its own line in docs, to match
+ -- non-GADT records)
+ RecCon fields -> ppBinder summary occ <+> dcolon unicode <+> hsep [
+ ppForAll forall ltvs lcontext unicode,
+ doRecordFields fields,
+ arrow unicode <+> ppLType unicode resTy ]
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
where
+ doRecordFields fields = braces (vanillaTable <<
+ aboves (map (ppShortField summary unicode) fields))
doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
ppForAll forall ltvs lcontext unicode,
ppLType unicode (foldr mkFunTy resTy args) ]
@@ -1353,6 +1364,7 @@ ppShortConstr summary con unicode = case con_res con of
forall = con_explicit con
mkFunTy a b = noLoc (HsFunTy a b)
+-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Bool -> Html
ppConstrHdr forall tvs ctxt unicode
= (if null tvs then noHtml else ppForall)
@@ -1374,20 +1386,26 @@ ppSideBySideConstr unicode (L _ con) = case con_res con of
RecCon fields ->
argBox (header_ unicode +++ ppBinder False occ) <->
- maybeRDocBox mbLDoc </>
- (tda [theclass "body"] << spacedTable1 <<
- aboves (map (ppSideBySideField unicode) fields))
+ maybeRDocBox mbLDoc
+ </>
+ doRecordFields fields
InfixCon arg1 arg2 ->
argBox (hsep [header_ unicode+++ppLParendType unicode arg1, ppBinder False occ, ppLParendType unicode arg2])
<-> maybeRDocBox mbLDoc
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
- RecCon _ -> error "GADT records not supported"
+ cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy
+ </> doRecordFields fields
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
where
+ doRecordFields fields =
+ (tda [theclass "body"] << spacedTable1 <<
+ aboves (map (ppSideBySideField unicode) fields))
doGADTCon args resTy = argBox (ppBinder False occ <+> dcolon unicode <+> hsep [
ppForAll forall ltvs (con_cxt con) unicode,
ppLType unicode (foldr mkFunTy resTy args) ]