diff options
| author | Adam Gundry <adam@well-typed.com> | 2015-05-04 15:32:59 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2015-12-14 15:10:58 +0000 |
| commit | b731a89153266e29f160a76f3ebaaa3a4621f199 (patch) | |
| tree | 2d1c0b5bc516dea66c7ca00f112f96cabe69aaed | |
| parent | 20e56de6316d6e251975aa5a4ce39d48e5bf6798 (diff) | |
Track API changes to support empty closed type familes
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 16 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 2 |
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) |