56 lines
2.1 KiB
Diff
56 lines
2.1 KiB
Diff
|
From 24e6f45408083745080ff2f3710f58209041113c Mon Sep 17 00:00:00 2001
|
||
|
|
From: Luite Stegeman <stegeman@gmail.com>
|
||
|
|
Date: Sun, 28 Dec 2014 21:33:22 +0100
|
||
|
|
Subject: [PATCH] updates for GHC 7.10 and Template Haskell 2.10
|
||
|
|
|
||
|
|
---
|
||
|
|
haskell-src-meta.cabal | 4 ++--
|
||
|
|
src/Language/Haskell/Meta/Syntax/Translate.hs | 6 ++++++
|
||
|
|
src/Language/Haskell/Meta/Utils.hs | 5 ++++-
|
||
|
|
3 files changed, 12 insertions(+), 3 deletions(-)
|
||
|
|
|
||
|
|
diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs
|
||
|
|
index 189d32e..36a08f1 100644
|
||
|
|
--- a/src/Language/Haskell/Meta/Syntax/Translate.hs
|
||
|
|
+++ b/src/Language/Haskell/Meta/Syntax/Translate.hs
|
||
|
|
@@ -384,9 +384,15 @@ a .->. b = AppT (AppT ArrowT a) b
|
||
|
|
toCxt :: Hs.Context -> Cxt
|
||
|
|
toCxt = fmap toPred
|
||
|
|
where
|
||
|
|
+#if MIN_VERSION_template_haskell(2,10,0)
|
||
|
|
+ toPred (Hs.ClassA n ts) = foldl' AppT (ConT (toName n)) (fmap toType ts)
|
||
|
|
+ toPred (Hs.InfixA t1 n t2) = foldl' AppT (ConT (toName n)) (fmap toType [t1,t2])
|
||
|
|
+ toPred (Hs.EqualP t1 t2) = foldl' AppT EqualityT (fmap toType [t1,t2])
|
||
|
|
+#else
|
||
|
|
toPred (Hs.ClassA n ts) = ClassP (toName n) (fmap toType ts)
|
||
|
|
toPred (Hs.InfixA t1 n t2) = ClassP (toName n) (fmap toType [t1, t2])
|
||
|
|
toPred (Hs.EqualP t1 t2) = EqualP (toType t1) (toType t2)
|
||
|
|
+#endif
|
||
|
|
toPred a@Hs.IParam{} = noTH "toCxt" a
|
||
|
|
|
||
|
|
foldAppT :: Type -> [Type] -> Type
|
||
|
|
diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs
|
||
|
|
index 36f7e96..d194f3e 100644
|
||
|
|
--- a/src/Language/Haskell/Meta/Utils.hs
|
||
|
|
+++ b/src/Language/Haskell/Meta/Utils.hs
|
||
|
|
@@ -166,6 +166,9 @@ renameT env new (ForallT ns cxt t) =
|
||
|
|
unVarT (VarT n) = PlainTV n
|
||
|
|
renamePreds = renameThings renamePred
|
||
|
|
|
||
|
|
+#if MIN_VERSION_template_haskell(2,10,0)
|
||
|
|
+ renamePred = renameT
|
||
|
|
+#else
|
||
|
|
renamePred env new (ClassP n ts) = let
|
||
|
|
(ts', env', new') = renameTs env new [] ts
|
||
|
|
in (ClassP (normaliseName n) ts', env', new')
|
||
|
|
@@ -174,7 +177,7 @@ renameT env new (ForallT ns cxt t) =
|
||
|
|
(t1', env1, new1) = renameT env new t1
|
||
|
|
(t2', env2, new2) = renameT env1 new1 t2
|
||
|
|
in (EqualP t1' t2', env2, new2)
|
||
|
|
-
|
||
|
|
+#endif
|
||
|
|
|
||
|
|
-- | Remove qualification, etc.
|
||
|
|
normaliseName :: Name -> Name
|
||
|
|
|