diff --git a/Control/Applicative/Backwards.hs b/Control/Applicative/Backwards.hs
index 80987fc683aa9abc3db65d1478a70b255531ca9a..bc779930e26fcb8f728f367ae363e4722e3f5bd9 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 ef363cd4ef659e713ce8362ae8af4ff7a19bc9ca..db907d5837da30c5f4776d07389d5ed7e80527b4 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 d39a7a3280e0fc1ad332d83df1c8568809fa0f92..e5b7b88c08a81f2fcea888d20b4517f6923efd95 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 6cef3c6c9e741f0f85e229cb36d8fd7daaa5142e..ea9db74ecc67cc22c45913f5916d2fea22fe8421 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 0e6f7fca7c2506d924ca11ee53aa36efc60570d3..67e55e92fd879831e15e5ffea9669b480956f1b4 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 f930777d467cf616d7e48d224443408a27e9d58a..62c143c7bf4318dcabab00ea32b4800157b92471 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 91eda175b7b880f972baaf32796dd49f803452b3..3ddfd8c2e335cd8459e2448153be65150161ef38 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 e3823787229a3b022460ec86de7f9e5ab0640db7..67060f6e4e9fb7f0ec6225c0bffc7e35da95e9a3 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 ff78313821a62fc23a5ab075d1256e21e04a2315..a1d23b67ed0c5cb4580eb6d18b7ff152a5bd68b3 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 98453e312900198140529da72dba6e6fd7f0a668..93aee57d09586ddc8a3095942000b42126d11913 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 d27ab59fc1cac2940e11765dffc547d3fc7ccbf1..fd9419d7aa52e4148dda56710fc3c2ea095f2f41 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 1438d371f5ceb684ad8539922343206f8b5f420f..f8221398609ae8df9b5e782f216683c49dbf5c07 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 c638c8497c1a86c4d2bcf9bc7067b3e335698bf4..cb280a1305865ffdcce41b7ba0b4bdf5e2c5016d 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 4d58a3b46e08df56919506258ba2d3bded2638f1..a9a05467b4884eabc455f47f39e2cd726dfb97de 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 48b1ae5a615dc2d14e612ececcf87eacee24d2f0..bacab3f0251aa9823276693dd68d0c2e6c03eab4 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 b70025f7b4e5691d9719428a40fa1c886a21b78c..58a89fffbd95872f925e7d72ad0446cfdd716332 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 1209cb4698c2215e00b3bb2b5d56a36a6d662352..b36d1046581ac98c609a25a649351a3602a3aa11 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 841a071fe91605308b54e887d7d18caf46469e25..3391d0d0df63141a6469132b0e6e9ea01fabaf65 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 c268888e4484fcf18ccfdbf39ee6e77a89a070d3..fbf85b48cdf8137ae4ac15f74255e70b18df6e58 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 940e4e470f476a59a6c1520b9d3ab2d1c2dc765d..54b1d4ce0d60e5fc28989f60cc2cd3353edec10a 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 ed781309aff8e83f4602fa1339fafc3921652ac2..edc679194fe6976c0ba1e3ba74809e0f6b7fbc23 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 ba0dc0407e00e2cc5b66e6e837841c8dfa46b83d..a694a09bd1a6cd05f122d62238a9500c7320694a 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 e6d1428b30e36fd301e042749424da5000f85054..a56d5021c13b44c624f7e88ea7999f6ac5494992 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