Skip to content
GitLab
Commit 7d928687 authored by Ryan Scott's avatar Ryan Scott
Browse files

Merge branch 'ghc-8.10' into 'master' 

Patch libraries to work with GHC 8.9

See merge request !8
parents 17725f0b 1e5114d2
Hide whitespace changes
Inline Side-by-side
patches/file-embed-0.0.11.patch 0 → 100644
View file @ 7d928687
commit b521da0ed2a96984ec3620bf88624b3074e0bcf7
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Jul 3 13:33:55 2019 -0400
Adapt to template-haskell-2.16.*
diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
index bbd83ee..2fcd48b 100644
--- a/Data/FileEmbed.hs
+++ b/Data/FileEmbed.hs
@@ -143,7 +143,11 @@ pairToExp _root (path, bs) = do
qAddDependentFile $ _root ++ '/' : path
#endif
exp' <- bsToExp bs
- return $! TupE [LitE $ StringL path, exp']
+ return $! TupE $!
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [LitE $ StringL path, exp']
bsToExp :: B.ByteString -> Q Exp
#if MIN_VERSION_template_haskell(2, 5, 0)
patches/free-5.1.1.patch 0 → 100644
View file @ 7d928687
commit ef04b7e2b26461c3278a76dc2e1e093ce55d6d02
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Wed Jul 3 13:20:47 2019 -0400
Adapt to building with template-haskell-2.16.*
diff --git a/src/Control/Monad/Free/TH.hs b/src/Control/Monad/Free/TH.hs
index 1a5ace9..856bb39 100644
--- a/src/Control/Monad/Free/TH.hs
+++ b/src/Control/Monad/Free/TH.hs
@@ -112,7 +112,13 @@ mkArg (VarT n) t
, "in a constructor's argument type: `" ++ pprint t ++ "'" ]
let tup = foldl AppT (TupleT $ length ts) ts
xs <- mapM (const $ newName "x") ts
- return $ Captured tup (LamE (map VarP xs) (TupE (map VarE xs)))
+ return $ Captured tup (LamE (map VarP xs) (TupE (map
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . VarE)
+#else
+ VarE
+#endif
+ xs)))
_ -> fail $ unlines
[ "expected a type variable `" ++ pprint n ++ "'"
, "or a type like (a1 -> ... -> aN -> " ++ pprint n ++ ")"
patches/haskell-src-meta-0.8.2.patch 0 → 100644
View file @ 7d928687
diff -ru haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Syntax/Translate.hs haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Syntax/Translate.hs
--- haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-02-26 21:44:20.000000000 -0500
+++ haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Syntax/Translate.hs 2019-07-03 13:56:24.764549867 -0400
@@ -85,11 +85,23 @@
instance (ToExp a) => ToExp [a] where
toExp = ListE . fmap toExp
instance (ToExp a, ToExp b) => ToExp (a,b) where
- toExp (a,b) = TupE [toExp a, toExp b]
+ toExp (a,b) = TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [toExp a, toExp b]
instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where
- toExp (a,b,c) = TupE [toExp a, toExp b, toExp c]
+ toExp (a,b,c) = TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [toExp a, toExp b, toExp c]
instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where
- toExp (a,b,c,d) = TupE [toExp a, toExp b, toExp c, toExp d]
+ toExp (a,b,c,d) = TupE $
+#if MIN_VERSION_template_haskell(2,16,0)
+ map Just
+#endif
+ [toExp a, toExp b, toExp c, toExp d]
instance ToPat Lit where
@@ -250,8 +262,20 @@
toExp (Hs.Case _ e alts) = CaseE (toExp e) (map toMatch alts)
toExp (Hs.Do _ ss) = DoE (map toStmt ss)
toExp e@(Hs.MDo _ _) = noTH "toExp" e
- toExp (Hs.Tuple _ Hs.Boxed xs) = TupE (fmap toExp xs)
- toExp (Hs.Tuple _ Hs.Unboxed xs) = UnboxedTupE (fmap toExp xs)
+ toExp (Hs.Tuple _ Hs.Boxed xs) = TupE (fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . toExp)
+#else
+ toExp
+#endif
+ xs)
+ toExp (Hs.Tuple _ Hs.Unboxed xs) = UnboxedTupE (fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . toExp)
+#else
+ toExp
+#endif
+ xs)
toExp e@Hs.TupleSection{} = noTH "toExp" e
toExp (Hs.List _ xs) = ListE (fmap toExp xs)
toExp (Hs.Paren _ e) = ParensE (toExp e)
diff -ru haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Utils.hs haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Utils.hs
--- haskell-src-meta-0.8.2.orig/src/Language/Haskell/Meta/Utils.hs 2019-02-26 21:44:20.000000000 -0500
+++ haskell-src-meta-0.8.2/src/Language/Haskell/Meta/Utils.hs 2019-07-03 13:57:37.549286480 -0400
@@ -338,7 +338,13 @@
in replicateM n (newName "a")
>>= \ns -> return (Just (LamE
[ConP dConN (fmap VarP ns)]
- (TupE $ fmap VarE ns)))
+ (TupE $ fmap
+#if MIN_VERSION_template_haskell(2,16,0)
+ (Just . VarE)
+#else
+ VarE
+#endif
+ ns)))
fromDataConI _ = return Nothing
fromTyConI :: Info -> Maybe Dec
patches/kind-generics-0.3.0.0.patch 0 → 100644
View file @ 7d928687
diff -ru kind-generics-0.3.0.0.orig/src/Generics/Kind.hs kind-generics-0.3.0.0/src/Generics/Kind.hs
--- kind-generics-0.3.0.0.orig/src/Generics/Kind.hs 2018-12-04 09:04:47.000000000 -0500
+++ kind-generics-0.3.0.0/src/Generics/Kind.hs 2019-07-03 13:39:40.002441920 -0400
@@ -75,7 +75,7 @@
-- > instance GenericK E LoT0 where
-- > type RepK E = Exists (*) (Field Var0)
data Exists k (f :: LoT (k -> d) -> *) (x :: LoT d) where
- Exists :: forall (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
+ Exists :: forall k (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d)
.{ unExists :: f (t ':&&: x) } -> Exists k f x
deriving instance (forall t. Show (f (t ':&&: x))) => Show (Exists k f x)
patches/lens-4.17.1.patch
View file @ 7d928687
commit 53e1d423703c3cbce05d73250af107517b235c83
commit 324c0e7a0d9c510b474f9bbc60f358de4566e48a
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Apr 26 13:38:18 2019 -0400
Date: Wed Jul 3 13:21:45 2019 -0400
Allow building with template-haskell-2.15.0.0
Adapt to building with template-haskell-2.15.*/2.16.*
diff --git a/src/Control/Lens/Internal/TH.hs b/src/Control/Lens/Internal/TH.hs
index 6ea63da2..185e47ae 100644
......@@ -66,7 +66,7 @@ index dc7cead1..eff0a99b 100644
data DataDecl = DataDecl
{ dataContext :: Cxt -- ^ Datatype context.
diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs
index 9d1b0c88..9a7dbe18 100644
index 9d1b0c88..8d5b8a35 100644
--- a/src/Language/Haskell/TH/Lens.hs
+++ b/src/Language/Haskell/TH/Lens.hs
@@ -4,6 +4,10 @@
......@@ -200,3 +200,37 @@ index 9d1b0c88..9a7dbe18 100644
#endif
_InfixL :: Prism' FixityDirection ()
@@ -1837,7 +1901,15 @@ _TupE
= prism' reviewer remitter
where
reviewer = TupE
- remitter (TupE x) = Just x
+#if MIN_VERSION_template_haskell(2,16,0)
+ . map Just
+#endif
+ remitter (TupE x) =
+#if MIN_VERSION_template_haskell(2,16,0)
+ sequence x
+#else
+ Just x
+#endif
remitter _ = Nothing
_UnboxedTupE :: Prism' Exp [Exp]
@@ -1845,7 +1917,15 @@ _UnboxedTupE
= prism' reviewer remitter
where
reviewer = UnboxedTupE
- remitter (UnboxedTupE x) = Just x
+#if MIN_VERSION_template_haskell(2,16,0)
+ . map Just
+#endif
+ remitter (UnboxedTupE x) =
+#if MIN_VERSION_template_haskell(2,16,0)
+ sequence x
+#else
+ Just x
+#endif
remitter _ = Nothing
#if MIN_VERSION_template_haskell(2,12,0)
patches/th-desugar-1.9.patch
View file @ 7d928687
commit 04372a6db858203713074dd3b38b68efa17bedee
commit 8fd994fad31d160a025ce3274438b0eb4cb21539
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 15 19:09:33 2019 -0400
Date: Wed Jul 3 14:15:40 2019 -0400
Adapt to base-4.13.0.0
Adapt to base-4.13.*/template-haskell-2.{15.*,16.*}
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
index 0f185a1..5e2bea4 100644
index 0cc2f44..69a8014 100644
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -21,6 +21,7 @@ import Language.Haskell.TH.ExpandSyns ( expandSyns )
......@@ -16,69 +16,30 @@ index 0f185a1..5e2bea4 100644
import Control.Monad.Zip
import Control.Monad.Writer hiding (forM_, mapM)
import Data.Foldable hiding (notElem)
@@ -1211,7 +1212,7 @@ reorderFieldsPat :: DsMonad q => Name -> [VarStrictType] -> [FieldPat] -> PatM q
reorderFieldsPat con_name field_decs field_pats =
reorderFields' dsPat con_name field_decs field_pats (repeat DWildPa)
-reorderFields' :: (Applicative m, Monad m)
+reorderFields' :: (Applicative m, Fail.MonadFail m)
=> (a -> m da)
-> Name -- ^ The name of the constructor (used for error reporting)
-> [VarStrictType] -> [(Name, a)]
@@ -1297,7 +1298,7 @@ strictToBang = id
#endif
-- | Convert a 'DType' to a 'DPred'.
-dTypeToDPred :: Monad q => DType -> q DPred
+dTypeToDPred :: Fail.MonadFail q => DType -> q DPred
dTypeToDPred (DForallT tvbs cxt ty)
= DForallPr tvbs cxt `liftM` dTypeToDPred ty
dTypeToDPred (DAppT t1 t2) = liftM2 DAppPr (dTypeToDPred t1) (return t2)
diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
index 3729601..4a74ce5 100644
--- a/Language/Haskell/TH/Desugar/Util.hs
+++ b/Language/Haskell/TH/Desugar/Util.hs
@@ -36,6 +36,7 @@ import Language.Haskell.TH hiding ( cxt )
import Language.Haskell.TH.Syntax
import Control.Monad ( replicateM )
+import qualified Control.Monad.Fail as Fail
import qualified Data.Set as S
import Data.Foldable
import Data.Generics hiding ( Fixity )
@@ -104,7 +105,7 @@ stripPlainTV_maybe (PlainTV n) = Just n
stripPlainTV_maybe _ = Nothing
-- | Report that a certain TH construct is impossible
-impossible :: Monad q => String -> q a
+impossible :: Fail.MonadFail q => String -> q a
impossible err = fail (err ++ "\n This should not happen in Haskell.\n Please email rae@cs.brynmawr.edu with your code if you see this.")
-- | Extract a 'Name' from a 'TyVarBndr'
@@ -330,7 +331,7 @@ mapMaybeM f (x:xs) = do
Nothing -> ys
Just z -> z : ys
-expectJustM :: Monad m => String -> Maybe a -> m a
+expectJustM :: Fail.MonadFail m => String -> Maybe a -> m a
expectJustM _ (Just x) = return x
expectJustM err Nothing = fail err
commit c98e9a910fa97ee43719748ef1c7cd9d32e578e1
Author: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri Mar 15 19:07:41 2019 -0400
Allow building with template-haskell-2.15.0.0
Adapted from
https://github.com/goldfirere/th-desugar/commit/9b9a6f0bdb6becd3f5ae896ddb539069131f7ba0
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
index 0cc2f44..0f185a1 100644
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -714,24 +714,40 @@ dsDec (FamilyD DataFam n tvbs m_k) =
@@ -72,10 +73,20 @@ dsExp (LamCaseE matches) = do
matches' <- dsMatches x matches
return $ DLamE [x] (DCaseE (DVarE x) matches')
dsExp (TupE exps) = do
- exps' <- mapM dsExp exps
+ exps' <-
+#if MIN_VERSION_template_haskell(2,16,0)
+ mapMaybeM (mapM dsExp) exps
+#else
+ mapM dsExp exps
+#endif
return $ foldl DAppE (DConE $ tupleDataName (length exps)) exps'
dsExp (UnboxedTupE exps) =
- foldl DAppE (DConE $ unboxedTupleDataName (length exps)) <$> mapM dsExp exps
+ foldl DAppE (DConE $ unboxedTupleDataName (length exps)) <$>
+#if MIN_VERSION_template_haskell(2,16,0)
+ mapMaybeM (mapM dsExp) exps
+#else
+ mapM dsExp exps
+#endif
dsExp (CondE e1 e2 e3) =
dsExp (CaseE e1 [ Match (ConP 'True []) (NormalB e2) []
, Match (ConP 'False []) (NormalB e3) [] ])
@@ -714,24 +725,40 @@ dsDec (FamilyD DataFam n tvbs m_k) =
(:[]) <$> (DDataFamilyD n <$> mapM dsTvb tvbs <*> mapM dsType m_k)
#endif
#if __GLASGOW_HASKELL__ > 710
......@@ -135,7 +96,7 @@ index 0cc2f44..0f185a1 100644
#else
dsDec (DataInstD cxt n tys cons derivings) = do
tys' <- mapM dsType tys
@@ -755,7 +771,20 @@ dsDec (TySynInstD n lhs rhs) = (:[]) <$> (DTySynInstD n <$>
@@ -755,7 +782,20 @@ dsDec (TySynInstD n lhs rhs) = (:[]) <$> (DTySynInstD n <$>
(DTySynEqn <$> mapM dsType lhs
<*> dsType rhs))
#else
......@@ -156,7 +117,7 @@ index 0cc2f44..0f185a1 100644
#if __GLASGOW_HASKELL__ > 710
dsDec (ClosedTypeFamilyD tfHead eqns) =
(:[]) <$> (DClosedTypeFamilyD <$> dsTypeFamilyHead tfHead
@@ -961,7 +990,11 @@ dsPragma (SpecialiseP n ty m_inl phases) = DSpecialiseP n <$> dsType ty
@@ -961,7 +1001,11 @@ dsPragma (SpecialiseP n ty m_inl phases) = DSpecialiseP n <$> dsType ty
<*> pure m_inl
<*> pure phases
dsPragma (SpecialiseInstP ty) = DSpecialiseInstP <$> dsType ty
......@@ -169,7 +130,7 @@ index 0cc2f44..0f185a1 100644
<*> dsExp lhs
<*> dsExp rhs
<*> pure phases
@@ -983,7 +1016,14 @@ dsRuleBndr (TypedRuleVar n ty) = DTypedRuleVar n <$> dsType ty
@@ -983,7 +1027,14 @@ dsRuleBndr (TypedRuleVar n ty) = DTypedRuleVar n <$> dsType ty
#if __GLASGOW_HASKELL__ >= 707
-- | Desugar a @TySynEqn@. (Available only with GHC 7.8+)
dsTySynEqn :: DsMonad q => TySynEqn -> q DTySynEqn
......@@ -184,6 +145,24 @@ index 0cc2f44..0f185a1 100644
#endif
-- | Desugar clauses to a function definition
@@ -1171,7 +1222,7 @@ reorderFieldsPat :: DsMonad q => Name -> [VarStrictType] -> [FieldPat] -> PatM q
reorderFieldsPat con_name field_decs field_pats =
reorderFields' dsPat con_name field_decs field_pats (repeat DWildPa)
-reorderFields' :: (Applicative m, Monad m)
+reorderFields' :: (Applicative m, Fail.MonadFail m)
=> (a -> m da)
-> Name -- ^ The name of the constructor (used for error reporting)
-> [VarStrictType] -> [(Name, a)]
@@ -1257,7 +1308,7 @@ strictToBang = id
#endif
-- | Convert a 'DType' to a 'DPred'.
-dTypeToDPred :: Monad q => DType -> q DPred
+dTypeToDPred :: Fail.MonadFail q => DType -> q DPred
dTypeToDPred (DForallT tvbs cxt ty)
= DForallPr tvbs cxt `liftM` dTypeToDPred ty
dTypeToDPred (DAppT t1 t2) = liftM2 DAppPr (dTypeToDPred t1) (return t2)
diff --git a/Language/Haskell/TH/Desugar/Reify.hs b/Language/Haskell/TH/Desugar/Reify.hs
index d04c297..e2bd3ae 100644
--- a/Language/Haskell/TH/Desugar/Reify.hs
......@@ -321,7 +300,7 @@ index bb257c3..2289faa 100644
clauseToTH :: DClause -> Clause
diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
index 2fe6283..3729601 100644
index 2fe6283..4a74ce5 100644
--- a/Language/Haskell/TH/Desugar/Util.hs
+++ b/Language/Haskell/TH/Desugar/Util.hs
@@ -27,7 +27,7 @@ module Language.Haskell.TH.Desugar.Util (
......@@ -333,7 +312,33 @@ index 2fe6283..3729601 100644
) where
import Prelude hiding (mapM, foldl, concatMap, any)
@@ -394,3 +394,12 @@ uniStarKindName = ''(Kind.★)
@@ -36,6 +36,7 @@ import Language.Haskell.TH hiding ( cxt )
import Language.Haskell.TH.Syntax
import Control.Monad ( replicateM )
+import qualified Control.Monad.Fail as Fail
import qualified Data.Set as S
import Data.Foldable
import Data.Generics hiding ( Fixity )
@@ -104,7 +105,7 @@ stripPlainTV_maybe (PlainTV n) = Just n
stripPlainTV_maybe _ = Nothing
-- | Report that a certain TH construct is impossible
-impossible :: Monad q => String -> q a
+impossible :: Fail.MonadFail q => String -> q a
impossible err = fail (err ++ "\n This should not happen in Haskell.\n Please email rae@cs.brynmawr.edu with your code if you see this.")
-- | Extract a 'Name' from a 'TyVarBndr'
@@ -330,7 +331,7 @@ mapMaybeM f (x:xs) = do
Nothing -> ys
Just z -> z : ys
-expectJustM :: Monad m => String -> Maybe a -> m a
+expectJustM :: Fail.MonadFail m => String -> Maybe a -> m a
expectJustM _ (Just x) = return x
expectJustM err Nothing = fail err
@@ -394,3 +395,12 @@ uniStarKindName = ''(Kind.★)
uniStarKindName = starKindName
#endif
#endif
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment