aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2015-09-23 18:43:18 +0200
committerBen Gamari <ben@smart-cactus.org>2015-10-28 14:33:06 +0100
commit174f23631a0a8de7dc0f3cd67c393a5ca88c4a2b (patch)
tree17f9fa542f6c996e2db4406afe3621f2c46956f2 /haddock-api/src/Haddock
parent18de4f2f992d3ed41eb83cb073e63304f0271dca (diff)
Account for Typeable changes
The treatment of type families changed.
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Convert.hs69
1 files changed, 32 insertions, 37 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 6f0684dc..4cb42597 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -141,7 +141,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
-- | Turn type constructors into type class declarations
synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl Name)
-synifyTyCon coax tc
+synifyTyCon _coax tc
| isFunTyCon tc || isPrimTyCon tc
= return $
DataDecl { tcdLName = synifyName tc
@@ -164,42 +164,37 @@ synifyTyCon coax tc
, dd_derivs = Nothing }
, tcdFVs = placeHolderNamesTc }
- | isTypeFamilyTyCon tc
- = case famTyConFlav_maybe tc of
- Just rhs ->
- let resultVar = famTcResVar tc
- info = case rhs of
- OpenSynFamilyTyCon -> return OpenTypeFamily
- ClosedSynFamilyTyCon mb -> case mb of
- Just (CoAxiom { co_ax_branches = branches })
- -> return $ ClosedTypeFamily $ Just $
- map (noLoc . synifyAxBranch tc) (fromBranches branches)
- Nothing -> return $ ClosedTypeFamily $ Just []
- BuiltInSynFamTyCon {}
- -> return $ ClosedTypeFamily $ Just []
- AbstractClosedSynFamilyTyCon {}
- -> return $ ClosedTypeFamily Nothing
- in info >>= \i ->
- return (FamDecl (FamilyDecl { fdInfo = i
- , fdLName = synifyName tc
- , fdTyVars = synifyTyVars (tyConTyVars tc)
- , fdResultSig =
- synifyFamilyResultSig resultVar (tyConResKind tc)
- , fdInjectivityAnn =
- synifyInjectivityAnn resultVar (tyConTyVars tc)
- (familyTyConInjectivityInfo tc)
- }))
- Nothing -> Left "synifyTyCon: impossible open type synonym?"
-
- | isDataFamilyTyCon tc
- = --(why no "isOpenAlgTyCon"?)
- case algTyConRhs tc of
- DataFamilyTyCon -> return $
- FamDecl (FamilyDecl DataFamily (synifyName tc)
- (synifyTyVars (tyConTyVars tc))
- (noLoc NoSig) -- always kind '*'
- Nothing) -- no injectivity
- _ -> Left "synifyTyCon: impossible open data type?"
+synifyTyCon _coax tc
+ | Just flav <- famTyConFlav_maybe tc
+ = case flav of
+ -- Type families
+ OpenSynFamilyTyCon -> mkFamDecl OpenTypeFamily
+ ClosedSynFamilyTyCon mb
+ | Just (CoAxiom { co_ax_branches = branches }) <- mb
+ -> mkFamDecl $ ClosedTypeFamily $ Just
+ $ map (noLoc . synifyAxBranch tc) (fromBranches branches)
+ | otherwise
+ -> mkFamDecl $ ClosedTypeFamily $ Just []
+ BuiltInSynFamTyCon {}
+ -> mkFamDecl $ ClosedTypeFamily $ Just []
+ AbstractClosedSynFamilyTyCon {}
+ -> mkFamDecl $ ClosedTypeFamily Nothing
+ DataFamilyTyCon {}
+ -> mkFamDecl DataFamily
+ where
+ resultVar = famTcResVar tc
+ mkFamDecl i = return $ FamDecl $
+ FamilyDecl { fdInfo = i
+ , fdLName = synifyName tc
+ , fdTyVars = synifyTyVars (tyConTyVars tc)
+ , fdResultSig =
+ synifyFamilyResultSig resultVar (tyConResKind tc)
+ , fdInjectivityAnn =
+ synifyInjectivityAnn resultVar (tyConTyVars tc)
+ (familyTyConInjectivityInfo tc)
+ }
+
+synifyTyCon coax tc
| Just ty <- synTyConRhs_maybe tc
= return $ SynDecl { tcdLName = synifyName tc
, tcdTyVars = synifyTyVars (tyConTyVars tc)