Commit 4e378c6a authored by Ben Gamari's avatar Ben Gamari 🐢

Drop lens-4.17.1 patch

parent b67fba28
diff --git a/lens.cabal b/lens.cabal
index 453d09e..5dd6a3b 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -1,6 +1,7 @@
name: lens
category: Data, Lenses, Generics
version: 4.17.1
+x-revision: 2
license: BSD2
cabal-version: 1.18
license-file: LICENSE
@@ -199,7 +200,7 @@ library
base-orphans >= 0.5.2 && < 1,
bifunctors >= 5.1 && < 6,
bytestring >= 0.9.1.10 && < 0.11,
- call-stack >= 0.1 && < 0.2,
+ call-stack >= 0.1 && < 0.3,
comonad >= 4 && < 6,
contravariant >= 1.3 && < 2,
containers >= 0.4.0 && < 0.7,
@@ -207,7 +208,7 @@ library
filepath >= 1.2.0.0 && < 1.5,
free >= 4 && < 6,
ghc-prim,
- hashable >= 1.1.2.3 && < 1.3,
+ hashable >= 1.1.2.3 && < 1.4,
kan-extensions >= 5 && < 6,
exceptions >= 0.1.1 && < 1,
mtl >= 2.0.1 && < 2.3,
diff --git a/src/Control/Lens/Internal/TH.hs b/src/Control/Lens/Internal/TH.hs
index 6ea63da..185e47a 100644
--- a/src/Control/Lens/Internal/TH.hs
+++ b/src/Control/Lens/Internal/TH.hs
@@ -46,7 +46,9 @@ import Paths_lens (version)
-- | Compatibility shim for recent changes to template haskell's 'tySynInstD'
tySynInstD' :: Name -> [TypeQ] -> TypeQ -> DecQ
-#if MIN_VERSION_template_haskell(2,9,0)
+#if MIN_VERSION_template_haskell(2,15,0)
+tySynInstD' fam ts r = tySynInstD (tySynEqn Nothing (foldl appT (conT fam) ts) r)
+#elif MIN_VERSION_template_haskell(2,9,0)
tySynInstD' fam ts r = tySynInstD fam (tySynEqn ts r)
#else
tySynInstD' = tySynInstD
diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
index dc7cead..eff0a99 100644
--- a/src/Control/Lens/TH.hs
+++ b/src/Control/Lens/TH.hs
@@ -512,11 +512,16 @@ makeDataDecl dec = case deNewtype dec of
, fullType = apps $ ConT tyName
, constructors = cons
}
+#if MIN_VERSION_template_haskell(2,15,0)
+ DataInstD ctx _ fnArgs _ cons _
+#else
DataInstD ctx familyName args
#if MIN_VERSION_template_haskell(2,11,0)
_
#endif
- cons _ -> Just DataDecl
+ cons _
+#endif
+ -> Just DataDecl
{ dataContext = ctx
, tyConName = Nothing
, dataParameters = map PlainTV vars
@@ -533,8 +538,23 @@ makeDataDecl dec = case deNewtype dec of
--
-- has 2 type parameters: a and b.
vars = toList $ setOf typeVars args
+
+#if MIN_VERSION_template_haskell(2,15,0)
+ (familyName, args) =
+ case unAppsT fnArgs of
+ (ConT familyName', args') -> (familyName', args')
+ (_, _) -> error $ "Illegal data instance LHS: " ++ pprint fnArgs
+#endif
_ -> Nothing
+#if MIN_VERSION_template_haskell(2,15,0)
+unAppsT :: Type -> (Type, [Type])
+unAppsT = go []
+ where
+ go xs (AppT l x) = go (x : xs) l
+ go xs ty = (ty, xs)
+#endif
+
-- | A data, newtype, data instance or newtype instance declaration.
data DataDecl = DataDecl
{ dataContext :: Cxt -- ^ Datatype context.
diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs
index 0e174d2..b748e05 100644
--- a/src/Data/Data/Lens.hs
+++ b/src/Data/Data/Lens.hs
@@ -13,6 +13,7 @@
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
+{-# OPTIONS_GHC -fbyte-code #-}
{-# OPTIONS_GHC -fno-full-laziness #-}
-----------------------------------------------------------------------------
-- |
diff --git a/src/Language/Haskell/TH/Lens.hs b/src/Language/Haskell/TH/Lens.hs
index 9d1b0c8..8d5b8a3 100644
--- a/src/Language/Haskell/TH/Lens.hs
+++ b/src/Language/Haskell/TH/Lens.hs
@@ -4,6 +4,10 @@
#endif
{-# LANGUAGE Rank2Types #-}
+#if MIN_VERSION_template_haskell(2,15,0)
+{-# LANGUAGE PatternGuards #-}
+#endif
+
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-trustworthy-safe #-}
#endif
@@ -492,8 +496,14 @@ instance HasTypes Foreign where
#if MIN_VERSION_template_haskell(2,9,0)
instance HasTypes TySynEqn where
+# if MIN_VERSION_template_haskell(2,15,0)
+ types f (TySynEqn mtvbs lhs rhs) = TySynEqn mtvbs
+ <$> types f lhs
+ <*> types f rhs
+# else
types f (TySynEqn lhss rhs) = TySynEqn <$> traverse (types f) lhss
<*> types f rhs
+# endif
#endif
instance HasTypes t => HasTypes [t] where
@@ -1015,8 +1025,16 @@ _TySynInstD :: Prism' Dec (Name, TySynEqn)
_TySynInstD
= prism' reviewer remitter
where
+# if MIN_VERSION_template_haskell(2,15,0)
+ reviewer (_x, y)
+ = TySynInstD y
+ remitter (TySynInstD eqn@(TySynEqn _ lhs _))
+ | (ConT n, _) <- unAppsT lhs
+ = Just (n, eqn)
+# else
reviewer (x, y) = TySynInstD x y
remitter (TySynInstD x y) = Just (x, y)
+# endif
remitter _ = Nothing
_RoleAnnotD :: Prism' Dec (Name, [Role])
@@ -1110,16 +1128,32 @@ _DataInstD :: DataPrism' [Type] [Con]
_DataInstD
= prism' reviewer remitter
where
+# if MIN_VERSION_template_haskell(2,15,0)
+ reviewer (x, y, z, w, u, v)
+ = DataInstD x Nothing (Prelude.foldl AppT (ConT y) z) w u v
+ remitter (DataInstD x y z w u v)
+ | (ConT n, ts) <- unAppsT z
+ = Just (x, n, ts, w, u, v)
+# else
reviewer (x, y, z, w, u, v) = DataInstD x y z w u v
remitter (DataInstD x y z w u v) = Just (x, y, z, w, u, v)
+# endif
remitter _ = Nothing
_NewtypeInstD :: DataPrism' [Type] Con
_NewtypeInstD
= prism' reviewer remitter
where
+# if MIN_VERSION_template_haskell(2,15,0)
+ reviewer (x, y, z, w, u, v)
+ = NewtypeInstD x Nothing (Prelude.foldl AppT (ConT y) z) w u v
+ remitter (NewtypeInstD x _y z w u v)
+ | (ConT n, ts) <- unAppsT z
+ = Just (x, n, ts, w, u, v)
+# else
reviewer (x, y, z, w, u, v) = NewtypeInstD x y z w u v
remitter (NewtypeInstD x y z w u v) = Just (x, y, z, w, u, v)
+# endif
remitter _ = Nothing
_DataFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind)
@@ -1546,8 +1580,16 @@ _RuleP :: Prism' Pragma (String, [RuleBndr], Exp, Exp, Phases)
_RuleP
= prism' reviewer remitter
where
- reviewer (x, y, z, w, u) = RuleP x y z w u
- remitter (RuleP x y z w u) = Just (x, y, z, w, u)
+ reviewer (x, y, z, w, u) = RuleP x
+# if MIN_VERSION_template_haskell(2,15,0)
+ Nothing
+# endif
+ y z w u
+ remitter (RuleP x
+# if MIN_VERSION_template_haskell(2,15,0)
+ _
+# endif
+ y z w u) = Just (x, y, z, w, u)
remitter _ = Nothing
#if MIN_VERSION_template_haskell(2,9,0)
@@ -1715,13 +1757,35 @@ _DataFam
#if MIN_VERSION_template_haskell(2,9,0)
tySynEqnPatterns :: Lens' TySynEqn [Type]
tySynEqnPatterns = lens g s where
+# if MIN_VERSION_template_haskell(2,15,0)
+ g (TySynEqn _ nxs _) = xs
+ where
+ (_n, xs) = unAppsT nxs
+ s (TySynEqn mtvbs nxs y) xs = TySynEqn mtvbs (Prelude.foldl AppT n xs) y
+ where
+ (n, _xs) = unAppsT nxs
+# else
g (TySynEqn xs _) = xs
s (TySynEqn _ y) xs = TySynEqn xs y
+# endif
tySynEqnResult :: Lens' TySynEqn Type
tySynEqnResult = lens g s where
+# if MIN_VERSION_template_haskell(2,15,0)
+ g (TySynEqn _ _ x) = x
+ s (TySynEqn mtvbs xs _) = TySynEqn mtvbs xs
+# else
g (TySynEqn _ x) = x
s (TySynEqn xs _) = TySynEqn xs
+# endif
+#endif
+
+#if MIN_VERSION_template_haskell(2,15,0)
+unAppsT :: Type -> (Type, [Type])
+unAppsT = go []
+ where
+ go xs (AppT l x) = go (x : xs) l
+ go xs ty = (ty, xs)
#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)
Markdown is supported
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