aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Convert.hs
diff options
context:
space:
mode:
authorDr. ERDI Gergo <gergo@erdi.hu>2014-11-20 22:35:38 +0800
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-12-12 07:07:30 +0000
commita197615a032f14f20761a7dec21ea098297eda31 (patch)
tree2fec80f94924cd0d8dd44110a054ceb93a3217f6 /haddock-api/src/Haddock/Convert.hs
parentd5950c8a95dc46fe2702d04f724145c73355043e (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.hs21
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)