aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-10-31 22:13:26 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-10-31 22:14:43 +0000
commit0413c544b60c063ef286777d3008c4e33b4afbcd (patch)
treedc78cd20cc9f41c5495afb4b14a3c5798b07d9a1 /haddock-api/src
parentb2d4b230c2446d241fd8730cd158e4fe6b7305df (diff)
parent987b5062482e20a032fb6358e655265b0b7a3cd2 (diff)
Merge remote-tracking branch 'origin/ghc-head' into wip/spj-wildcard-refactor
Conflicts: haddock-api/src/Haddock/Convert.hs
Diffstat (limited to 'haddock-api/src')
-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 952650c1..38851b16 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -133,7 +133,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
@@ -156,42 +156,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)