From c59b5c80365e65a11a63a2375b0331b4637e6a09 Mon Sep 17 00:00:00 2001
From: Ross Paterson <ross@soi.city.ac.uk>
Date: Fri, 18 Feb 2022 11:11:15 +0000
Subject: [PATCH] Restrict deriving (Generic) to GHC >= 7.4

Although this is available in GHC 7.2, GHC.Generics is not declared
Trustworthy in that version.
---
 Control/Applicative/Backwards.hs       | 4 ++--
 Control/Applicative/Lift.hs            | 4 ++--
 Control/Monad/Trans/Accum.hs           | 4 ++--
 Control/Monad/Trans/Cont.hs            | 4 ++--
 Control/Monad/Trans/Except.hs          | 4 ++--
 Control/Monad/Trans/Identity.hs        | 4 ++--
 Control/Monad/Trans/Maybe.hs           | 4 ++--
 Control/Monad/Trans/RWS/CPS.hs         | 4 ++--
 Control/Monad/Trans/RWS/Lazy.hs        | 4 ++--
 Control/Monad/Trans/RWS/Strict.hs      | 4 ++--
 Control/Monad/Trans/Reader.hs          | 4 ++--
 Control/Monad/Trans/Select.hs          | 4 ++--
 Control/Monad/Trans/State/Lazy.hs      | 4 ++--
 Control/Monad/Trans/State/Strict.hs    | 4 ++--
 Control/Monad/Trans/Writer/CPS.hs      | 4 ++--
 Control/Monad/Trans/Writer/Lazy.hs     | 4 ++--
 Control/Monad/Trans/Writer/Strict.hs   | 4 ++--
 Data/Functor/Constant.hs               | 4 ++--
 Data/Functor/Reverse.hs                | 4 ++--
 legacy/pre709/Data/Functor/Identity.hs | 4 ++--
 legacy/pre711/Data/Functor/Compose.hs  | 4 ++--
 legacy/pre711/Data/Functor/Product.hs  | 4 ++--
 legacy/pre711/Data/Functor/Sum.hs      | 4 ++--
 23 files changed, 46 insertions(+), 46 deletions(-)

diff --git a/Control/Applicative/Backwards.hs b/Control/Applicative/Backwards.hs
index 80987fc..bc77993 100644
--- a/Control/Applicative/Backwards.hs
+++ b/Control/Applicative/Backwards.hs
@@ -31,7 +31,7 @@ import Data.Functor.Classes
 #if MIN_VERSION_base(4,12,0)
 import Data.Functor.Contravariant
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -47,7 +47,7 @@ import Data.Traversable (Traversable(traverse, sequenceA))
 newtype Backwards f a = Backwards { forwards :: f a }
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Applicative/Lift.hs b/Control/Applicative/Lift.hs
index ef363cd..db907d5 100644
--- a/Control/Applicative/Lift.hs
+++ b/Control/Applicative/Lift.hs
@@ -41,7 +41,7 @@ import Data.Foldable (Foldable(foldMap))
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -50,7 +50,7 @@ import GHC.Generics
 data Lift f a = Pure a | Other (f a)
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Accum.hs b/Control/Monad/Trans/Accum.hs
index d39a7a3..e5b7b88 100644
--- a/Control/Monad/Trans/Accum.hs
+++ b/Control/Monad/Trans/Accum.hs
@@ -71,7 +71,7 @@ import Control.Monad.Signatures
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -134,7 +134,7 @@ mapAccum f = mapAccumT (Identity . f . runIdentity)
 --
 --  * a writer monad transformer with the extra ability to read all previous output.
 newtype AccumT w m a = AccumT (w -> m (a, w))
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Cont.hs b/Control/Monad/Trans/Cont.hs
index 6cef3c6..ea9db74 100644
--- a/Control/Monad/Trans/Cont.hs
+++ b/Control/Monad/Trans/Cont.hs
@@ -59,7 +59,7 @@ import Control.Applicative
 #if MIN_VERSION_base(4,9,0)
 import qualified Control.Monad.Fail as Fail
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -140,7 +140,7 @@ shift f = shiftT (f . (runIdentity .))
 -- 'ContT' is not a functor on the category of monads, and many operations
 -- cannot be lifted through it.
 newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Except.hs b/Control/Monad/Trans/Except.hs
index 0e6f7fc..67e55e9 100644
--- a/Control/Monad/Trans/Except.hs
+++ b/Control/Monad/Trans/Except.hs
@@ -74,7 +74,7 @@ import Data.Foldable (Foldable(foldMap))
 import Data.Monoid (Monoid(mempty, mappend))
 import Data.Traversable (Traversable(traverse))
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -128,7 +128,7 @@ withExcept = withExceptT
 newtype ExceptT e m a = ExceptT (m (Either e a))
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Identity.hs b/Control/Monad/Trans/Identity.hs
index f930777..62c143c 100644
--- a/Control/Monad/Trans/Identity.hs
+++ b/Control/Monad/Trans/Identity.hs
@@ -55,7 +55,7 @@ import Data.Foldable
 import Data.Traversable (Traversable(traverse))
 #endif
 import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -63,7 +63,7 @@ import GHC.Generics
 newtype IdentityT f a = IdentityT { runIdentityT :: f a }
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Maybe.hs b/Control/Monad/Trans/Maybe.hs
index 91eda17..3ddfd8c 100644
--- a/Control/Monad/Trans/Maybe.hs
+++ b/Control/Monad/Trans/Maybe.hs
@@ -65,7 +65,7 @@ import Data.Maybe (fromMaybe)
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -80,7 +80,7 @@ import GHC.Generics
 newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/RWS/CPS.hs b/Control/Monad/Trans/RWS/CPS.hs
index e382378..67060f6 100644
--- a/Control/Monad/Trans/RWS/CPS.hs
+++ b/Control/Monad/Trans/RWS/CPS.hs
@@ -83,7 +83,7 @@ import Data.Monoid
 #if MIN_VERSION_base(4,9,0)
 import qualified Control.Monad.Fail as Fail
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -149,7 +149,7 @@ withRWS = withRWST
 -- collecting an output of type @w@ and updating a state of type @s@
 -- to an inner monad @m@.
 newtype RWST r w s m a = RWST { unRWST :: r -> s -> w -> m (a, s, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/RWS/Lazy.hs b/Control/Monad/Trans/RWS/Lazy.hs
index ff78313..a1d23b6 100644
--- a/Control/Monad/Trans/RWS/Lazy.hs
+++ b/Control/Monad/Trans/RWS/Lazy.hs
@@ -80,7 +80,7 @@ import Control.Monad.Fix
 #if !(MIN_VERSION_base(4,8,0))
 import Data.Monoid
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -143,7 +143,7 @@ withRWS = withRWST
 -- collecting an output of type @w@ and updating a state of type @s@
 -- to an inner monad @m@.
 newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 -- | Evaluate a computation with the given initial state and environment,
diff --git a/Control/Monad/Trans/RWS/Strict.hs b/Control/Monad/Trans/RWS/Strict.hs
index 98453e3..93aee57 100644
--- a/Control/Monad/Trans/RWS/Strict.hs
+++ b/Control/Monad/Trans/RWS/Strict.hs
@@ -83,7 +83,7 @@ import Control.Monad.Fix
 #if !(MIN_VERSION_base(4,8,0))
 import Data.Monoid
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -146,7 +146,7 @@ withRWS = withRWST
 -- collecting an output of type @w@ and updating a state of type @s@
 -- to an inner monad @m@.
 newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Reader.hs b/Control/Monad/Trans/Reader.hs
index d27ab59..fd9419d 100644
--- a/Control/Monad/Trans/Reader.hs
+++ b/Control/Monad/Trans/Reader.hs
@@ -67,7 +67,7 @@ import Control.Monad.Zip (MonadZip(mzipWith))
 #if (MIN_VERSION_base(4,2,0)) && !(MIN_VERSION_base(4,8,0))
 import Data.Functor ((<$))
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -119,7 +119,7 @@ withReader = withReaderT
 newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Select.hs b/Control/Monad/Trans/Select.hs
index 1438d37..f822139 100644
--- a/Control/Monad/Trans/Select.hs
+++ b/Control/Monad/Trans/Select.hs
@@ -54,7 +54,7 @@ import Control.Monad
 import qualified Control.Monad.Fail as Fail
 #endif
 import Data.Functor.Identity
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -84,7 +84,7 @@ mapSelect f = mapSelectT (Identity . f . runIdentity)
 -- 'SelectT' is not a functor on the category of monads, and many operations
 -- cannot be lifted through it.
 newtype SelectT r m a = SelectT ((a -> m r) -> m a)
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/State/Lazy.hs b/Control/Monad/Trans/State/Lazy.hs
index c638c84..cb280a1 100644
--- a/Control/Monad/Trans/State/Lazy.hs
+++ b/Control/Monad/Trans/State/Lazy.hs
@@ -88,7 +88,7 @@ import Control.Monad
 import qualified Control.Monad.Fail as Fail
 #endif
 import Control.Monad.Fix
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -163,7 +163,7 @@ withState = withStateT
 -- the final state of the first computation as the initial state of
 -- the second.
 newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/State/Strict.hs b/Control/Monad/Trans/State/Strict.hs
index 4d58a3b..a9a0546 100644
--- a/Control/Monad/Trans/State/Strict.hs
+++ b/Control/Monad/Trans/State/Strict.hs
@@ -85,7 +85,7 @@ import Control.Monad
 import qualified Control.Monad.Fail as Fail
 #endif
 import Control.Monad.Fix
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -160,7 +160,7 @@ withState = withStateT
 -- the final state of the first computation as the initial state of
 -- the second.
 newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Writer/CPS.hs b/Control/Monad/Trans/Writer/CPS.hs
index 48b1ae5..bacab3f 100644
--- a/Control/Monad/Trans/Writer/CPS.hs
+++ b/Control/Monad/Trans/Writer/CPS.hs
@@ -69,7 +69,7 @@ import Data.Monoid
 #if MIN_VERSION_base(4,9,0)
 import qualified Control.Monad.Fail as Fail
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -120,7 +120,7 @@ mapWriter f = mapWriterT (Identity . f . runIdentity)
 -- combines the outputs of the subcomputations using 'mappend'.
 
 newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Writer/Lazy.hs b/Control/Monad/Trans/Writer/Lazy.hs
index b70025f..58a89ff 100644
--- a/Control/Monad/Trans/Writer/Lazy.hs
+++ b/Control/Monad/Trans/Writer/Lazy.hs
@@ -74,7 +74,7 @@ import Data.Monoid
 import Data.Traversable (Traversable(traverse))
 #endif
 import Prelude hiding (null, length)
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -122,7 +122,7 @@ mapWriter f = mapWriterT (Identity . f . runIdentity)
 -- The 'return' function produces the output 'mempty', while @>>=@
 -- combines the outputs of the subcomputations using 'mappend'.
 newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Control/Monad/Trans/Writer/Strict.hs b/Control/Monad/Trans/Writer/Strict.hs
index 1209cb4..b36d104 100644
--- a/Control/Monad/Trans/Writer/Strict.hs
+++ b/Control/Monad/Trans/Writer/Strict.hs
@@ -77,7 +77,7 @@ import Data.Monoid
 import Data.Traversable (Traversable(traverse))
 #endif
 import Prelude hiding (null, length)
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -125,7 +125,7 @@ mapWriter f = mapWriterT (Identity . f . runIdentity)
 -- The 'return' function produces the output 'mempty', while @>>=@
 -- combines the outputs of the subcomputations using 'mappend'.
 newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/Data/Functor/Constant.hs b/Data/Functor/Constant.hs
index 841a071..3391d0d 100644
--- a/Data/Functor/Constant.hs
+++ b/Data/Functor/Constant.hs
@@ -54,7 +54,7 @@ import Prelude hiding (null, length)
 #if __GLASGOW_HASKELL__ >= 800
 import Data.Data
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -66,7 +66,7 @@ newtype Constant a b = Constant { getConstant :: a }
 #endif
 #if __GLASGOW_HASKELL__ >= 710
         , Generic, Generic1
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
         , Generic
 #endif
         )
diff --git a/Data/Functor/Reverse.hs b/Data/Functor/Reverse.hs
index c268888..fbf85b4 100644
--- a/Data/Functor/Reverse.hs
+++ b/Data/Functor/Reverse.hs
@@ -44,7 +44,7 @@ import Data.Foldable
 import Data.Traversable (Traversable(traverse))
 #endif
 import Data.Monoid
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -53,7 +53,7 @@ import GHC.Generics
 newtype Reverse f a = Reverse { getReverse :: f a }
 #if __GLASGOW_HASKELL__ >= 710
     deriving (Generic, Generic1)
-#elif __GLASGOW_HASKELL__ >= 702
+#elif __GLASGOW_HASKELL__ >= 704
     deriving (Generic)
 #endif
 
diff --git a/legacy/pre709/Data/Functor/Identity.hs b/legacy/pre709/Data/Functor/Identity.hs
index 940e4e4..54b1d4c 100644
--- a/legacy/pre709/Data/Functor/Identity.hs
+++ b/legacy/pre709/Data/Functor/Identity.hs
@@ -61,7 +61,7 @@ import Data.Data
 #endif
 import Data.Ix (Ix(..))
 import Foreign (Storable(..), castPtr)
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -71,7 +71,7 @@ newtype Identity a = Identity { runIdentity :: a }
 #if __GLASGOW_HASKELL__ >= 700
              , Data, Typeable
 #endif
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
              , Generic
 #endif
 #if __GLASGOW_HASKELL__ >= 706
diff --git a/legacy/pre711/Data/Functor/Compose.hs b/legacy/pre711/Data/Functor/Compose.hs
index ed78130..edc6791 100644
--- a/legacy/pre711/Data/Functor/Compose.hs
+++ b/legacy/pre711/Data/Functor/Compose.hs
@@ -45,7 +45,7 @@ import Data.Data
 #endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
@@ -56,7 +56,7 @@ infixr 9 `Compose`
 -- but the composition of monads is not always a monad.
 newtype Compose f g a = Compose { getCompose :: f (g a) }
 
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 deriving instance Generic (Compose f g a)
 
 instance Functor f => Generic1 (Compose f g) where
diff --git a/legacy/pre711/Data/Functor/Product.hs b/legacy/pre711/Data/Functor/Product.hs
index ba0dc04..a694a09 100644
--- a/legacy/pre711/Data/Functor/Product.hs
+++ b/legacy/pre711/Data/Functor/Product.hs
@@ -50,14 +50,14 @@ import Data.Functor.Contravariant
 #endif
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
 -- | Lifted product of functors.
 data Product f g a = Pair (f a) (g a)
 
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 deriving instance Generic (Product f g a)
 
 instance Generic1 (Product f g) where
diff --git a/legacy/pre711/Data/Functor/Sum.hs b/legacy/pre711/Data/Functor/Sum.hs
index e6d1428..a56d502 100644
--- a/legacy/pre711/Data/Functor/Sum.hs
+++ b/legacy/pre711/Data/Functor/Sum.hs
@@ -45,14 +45,14 @@ import Data.Functor.Contravariant
 #endif
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 import GHC.Generics
 #endif
 
 -- | Lifted sum of functors.
 data Sum f g a = InL (f a) | InR (g a)
 
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 704
 deriving instance Generic (Sum f g a)
 
 instance Generic1 (Sum f g) where
-- 
GitLab