diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-10-31 22:13:26 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-10-31 22:14:43 +0000 |
commit | 0413c544b60c063ef286777d3008c4e33b4afbcd (patch) | |
tree | dc78cd20cc9f41c5495afb4b14a3c5798b07d9a1 /haddock-api | |
parent | b2d4b230c2446d241fd8730cd158e4fe6b7305df (diff) | |
parent | 987b5062482e20a032fb6358e655265b0b7a3cd2 (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')
-rw-r--r-- | haddock-api/haddock-api.cabal | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 69 |
2 files changed, 33 insertions, 38 deletions
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index b2199c68..dc3e8c69 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -36,7 +36,7 @@ library Haskell2010 build-depends: - base >= 4.3 && < 4.9 + base >= 4.3 && < 4.10 , bytestring , filepath , directory 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) |