diff options
author | Dr. ERDI Gergo <gergo@erdi.hu> | 2014-11-20 22:35:38 +0800 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-12-12 07:07:30 +0000 |
commit | a197615a032f14f20761a7dec21ea098297eda31 (patch) | |
tree | 2fec80f94924cd0d8dd44110a054ceb93a3217f6 /haddock-api/src/Haddock/Convert.hs | |
parent | d5950c8a95dc46fe2702d04f724145c73355043e (diff) |
Update Haddock to new pattern synonym type signature syntax
Conflicts:
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
haddock-api/src/Haddock/Convert.hs
Diffstat (limited to 'haddock-api/src/Haddock/Convert.hs')
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 21 |
1 files changed, 7 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 91581c7a..3b454feb 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -16,7 +16,6 @@ module Haddock.Convert where -- Some other functions turned out to be useful for converting -- instance heads, which aren't TyThings, so just export everything. - import Bag ( emptyBag ) import BasicTypes ( TupleSort(..) ) import Class @@ -36,7 +35,7 @@ import PrelNames (ipClassName) import SrcLoc ( Located, noLoc, unLoc ) import TcType ( tcSplitSigmaTy ) import TyCon -import Type(isStrLitTy) +import Type (isStrLitTy, mkFunTys) import TypeRep import TysPrim ( alphaTyVars ) import TysWiredIn ( listTyConName, eqTyCon ) @@ -44,6 +43,7 @@ import Unique ( getUnique ) import Var + -- the main function here! yay! tyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl Name)) tyThingToLHsDecl t = case t of @@ -98,21 +98,14 @@ tyThingToLHsDecl t = case t of (synifyType ImplicitizeForAll (dataConUserType dc))) AConLike (PatSynCon ps) -> -#if MIN_VERSION_ghc(7,8,3) - let (_, _, req_theta, prov_theta, _, res_ty) = patSynSig ps -#else - let (_, _, (req_theta, prov_theta)) = patSynSig ps -#endif + let (univ_tvs, ex_tvs, req_theta, prov_theta, arg_tys, res_ty) = patSynSig ps + qtvs = univ_tvs ++ ex_tvs + ty = mkFunTys arg_tys res_ty in allOK . SigD $ PatSynSig (synifyName ps) -#if MIN_VERSION_ghc(7,8,3) - (fmap (synifyType WithinType) (patSynTyDetails ps)) - (synifyType WithinType res_ty) -#else - (fmap (synifyType WithinType) (patSynTyDetails ps)) - (synifyType WithinType (patSynType ps)) -#endif + (Implicit, synifyTyVars qtvs) (synifyCtx req_theta) (synifyCtx prov_theta) + (synifyType WithinType ty) where withErrs e x = return (e, x) allOK x = return (mempty, x) |