aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2015-05-04 15:32:59 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2015-12-14 15:10:58 +0000
commitb731a89153266e29f160a76f3ebaaa3a4621f199 (patch)
tree2d1c0b5bc516dea66c7ca00f112f96cabe69aaed
parent20e56de6316d6e251975aa5a4ce39d48e5bf6798 (diff)
Track API changes to support empty closed type familes
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--haddock-api/src/Haddock/Convert.hs16
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs2
3 files changed, 13 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3ac443a4..651060c1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -287,9 +287,9 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
instancesBit
- | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
+ | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl
, not summary
- = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
+ = subEquations qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
| otherwise
= ppInstances links (OriginFamily docname) instances splice unicode qual
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 2bd111d6..dd577319 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -132,7 +132,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
(TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch
, tfid_fvs = placeHolderNamesTc }))
- | Just ax' <- isClosedSynFamilyTyCon_maybe tc
+ | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc
, getUnique ax' == getUnique ax -- without the getUniques, type error
= synifyTyCon (Just ax) tc >>= return . TyClD
@@ -169,11 +169,15 @@ synifyTyCon coax tc
Just rhs ->
let info = case rhs of
OpenSynFamilyTyCon -> return OpenTypeFamily
- ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches }) ->
- return $ ClosedTypeFamily
- (brListMap (noLoc . synifyAxBranch tc) branches)
- BuiltInSynFamTyCon {} -> return $ ClosedTypeFamily []
- AbstractClosedSynFamilyTyCon {} -> return $ ClosedTypeFamily []
+ ClosedSynFamilyTyCon mb -> case mb of
+ Just (CoAxiom { co_ax_branches = branches })
+ -> return $ ClosedTypeFamily $ Just $
+ brListMap (noLoc . synifyAxBranch tc) branches
+ Nothing -> return $ ClosedTypeFamily $ Just []
+ BuiltInSynFamTyCon {}
+ -> return $ ClosedTypeFamily $ Just []
+ AbstractClosedSynFamilyTyCon {}
+ -> return $ ClosedTypeFamily Nothing
in info >>= \i ->
return (FamDecl
(FamilyDecl { fdInfo = i
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 9d848122..110c9a42 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -362,7 +362,7 @@ renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
renameFamilyInfo DataFamily = return DataFamily
renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
renameFamilyInfo (ClosedTypeFamily eqns)
- = do { eqns' <- mapM renameLTyFamInstEqn eqns
+ = do { eqns' <- mapM (mapM renameLTyFamInstEqn) eqns
; return $ ClosedTypeFamily eqns' }
renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName)