generic-deriving 1.12.4 → 1.13

raw patch · 10 files changed

+533/−490 lines, 10 filesdep ~th-abstractionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: th-abstraction

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• generic-deriving.cabal +8/−5
• src/Generics/Deriving/Base.hs +3/−1
• src/Generics/Deriving/ConNames.hs +3/−1
• src/Generics/Deriving/Default.hs +4/−0
• src/Generics/Deriving/Monoid.hs +8/−270
• src/Generics/Deriving/Monoid/Internal.hs +276/−0
• src/Generics/Deriving/Semigroup.hs +7/−209
• src/Generics/Deriving/Semigroup/Internal.hs +218/−0
• src/Generics/Deriving/TH/Internal.hs +0/−4

@@ -1,3 +1,9 @@+# 1.13 [2019.08.27]+* Make `GSemigroup` a superclass of `GMonoid`. Similarly, make+  `GSemigroup'` a superclass of `GMonoid'`.+* In the instance `GMonoid (Maybe a)`, relax the constraint on `a` from+  `GMonoid` to `GSemigroup`.+ # 1.12.4 [2019.04.26] * Support `th-abstraction-0.3.0.0` or later. 

@@ -1,5 +1,5 @@ name:                   generic-deriving-version:                1.12.4+version:                1.13 synopsis:               Generic programming library for generalised deriving. description: @@ -34,7 +34,8 @@                       , GHC == 8.0.2                       , GHC == 8.2.2                       , GHC == 8.4.4-                      , GHC == 8.6.4+                      , GHC == 8.6.5+                      , GHC == 8.8.1 extra-source-files:     CHANGELOG.md                       , README.md @@ -68,6 +69,8 @@                         Generics.Deriving.TH    other-modules:        Generics.Deriving.Base.Internal+                        Generics.Deriving.Monoid.Internal+                        Generics.Deriving.Semigroup.Internal                         Generics.Deriving.TH.Internal                         Paths_generic_deriving   if flag(base-4-9)@@ -79,8 +82,8 @@    build-depends:        containers       >= 0.1   && < 0.7                       , ghc-prim                     < 1-                      , template-haskell >= 2.4   && < 2.15-                      , th-abstraction   >= 0.2.9 && < 0.4+                      , template-haskell >= 2.4   && < 2.16+                      , th-abstraction   >= 0.3   && < 0.4    default-language:     Haskell2010   ghc-options:          -Wall@@ -95,7 +98,7 @@   build-depends:        base             >= 4.3  && < 5                       , generic-deriving                       , hspec            >= 2    && < 3-                      , template-haskell >= 2.4  && < 2.15+                      , template-haskell >= 2.4  && < 2.16   build-tool-depends:   hspec-discover:hspec-discover   hs-source-dirs:       tests   default-language:     Haskell2010

@@ -1,7 +1,9 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 701+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} #endif  module Generics.Deriving.Base (module Generics.Deriving.Base.Internal) where

@@ -5,8 +5,10 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} -#if __GLASGOW_HASKELL__ >= 701+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} #endif  #if __GLASGOW_HASKELL__ >= 705

@@ -39,7 +39,11 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+# if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}+# else+{-# LANGUAGE Trustworthy #-}+# endif #endif {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}

@@ -1,289 +1,27 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 701-{-# LANGUAGE DefaultSignatures #-}-#endif--#if __GLASGOW_HASKELL__ >= 705-{-# LANGUAGE PolyKinds #-}-#endif+{-# OPTIONS_GHC -fno-warn-orphans #-} -#if __GLASGOW_HASKELL__ >= 710+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 701+#elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -{- | This module provides two main features:--    1. 'GMonoid', a generic version of the 'Monoid' type class, including instances-    of the types from "Data.Monoid"--    2. Default generic definitions for the 'Monoid' methods 'mempty' and 'mappend'--The generic defaults only work for types without alternatives (i.e. they have-only one constructor). We cannot in general know how to deal with different-constructors.--}--module Generics.Deriving.Monoid (--  -- * GMonoid type class-  GMonoid(..),--  -- * Default definitions-  -- ** GMonoid-  gmemptydefault,-  gmappenddefault,--  -- * Internal auxiliary class for GMonoid-  GMonoid'(..),--  -- ** Monoid-  {- | These functions can be used in a 'Monoid' instance. For example:--  @-  -- LANGUAGE DeriveGeneric--  import Generics.Deriving.Base (Generic)-  import Generics.Deriving.Monoid--  data T a = C a (Maybe a) deriving Generic--  instance Monoid a => Monoid (T a) where-    mempty  = memptydefault-    mappend = mappenddefault-  @-  -}-  memptydefault,-  mappenddefault,--  -- * Internal auxiliary class for Monoid-  Monoid'(..),--  -- * The Monoid module-  -- | This is exported for convenient access to the various wrapper types.-  module Data.Monoid,--  ) where------------------------------------------------------------------------------------import Control.Applicative-import Data.Monoid-import Generics.Deriving.Base--#if MIN_VERSION_base(4,6,0)-import Data.Ord (Down)-#else-import GHC.Exts (Down)-#endif--#if MIN_VERSION_base(4,7,0)-import Data.Proxy (Proxy)-#endif+module Generics.Deriving.Monoid (module Generics.Deriving.Monoid.Internal) where -#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity)-#endif+import Generics.Deriving.Monoid.Internal+import Generics.Deriving.Semigroup (GSemigroup(..))  #if MIN_VERSION_base(4,9,0) import Data.Semigroup (WrappedMonoid) #endif -----------------------------------------------------------------------------------class GMonoid' f where-  gmempty'  :: f x-  gmappend' :: f x -> f x -> f x--instance GMonoid' U1 where-  gmempty' = U1-  gmappend' U1 U1 = U1--instance GMonoid a => GMonoid' (K1 i a) where-  gmempty' = K1 gmempty-  gmappend' (K1 x) (K1 y) = K1 (x `gmappend` y)--instance GMonoid' f => GMonoid' (M1 i c f) where-  gmempty' = M1 gmempty'-  gmappend' (M1 x) (M1 y) = M1 (x `gmappend'` y)--instance (GMonoid' f, GMonoid' h) => GMonoid' (f :*: h) where-  gmempty' = gmempty' :*: gmempty'-  gmappend' (x1 :*: y1) (x2 :*: y2) = gmappend' x1 x2 :*: gmappend' y1 y2------------------------------------------------------------------------------------gmemptydefault :: (Generic a, GMonoid' (Rep a)) => a-gmemptydefault = to gmempty'--gmappenddefault :: (Generic a, GMonoid' (Rep a)) => a -> a -> a-gmappenddefault x y = to (gmappend' (from x) (from y))------------------------------------------------------------------------------------class Monoid' f where-  mempty'  :: f x-  mappend' :: f x -> f x -> f x--instance Monoid' U1 where-  mempty' = U1-  mappend' U1 U1 = U1--instance Monoid a => Monoid' (K1 i a) where-  mempty' = K1 mempty-  mappend' (K1 x) (K1 y) = K1 (x `mappend` y)--instance Monoid' f => Monoid' (M1 i c f) where-  mempty' = M1 mempty'-  mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)--instance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where-  mempty' = mempty' :*: mempty'-  mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2------------------------------------------------------------------------------------memptydefault :: (Generic a, Monoid' (Rep a)) => a-memptydefault = to mempty'--mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a-mappenddefault x y = to (mappend' (from x) (from y))------------------------------------------------------------------------------------class GMonoid a where--  -- | Generic 'mempty'-  gmempty  :: a--  -- | Generic 'mappend'-  gmappend :: a -> a -> a--  -- | Generic 'mconcat'-  gmconcat :: [a] -> a-  gmconcat = foldr gmappend gmempty--#if __GLASGOW_HASKELL__ >= 701-  default gmempty :: (Generic a, GMonoid' (Rep a)) => a-  gmempty = to gmempty'--  default gmappend :: (Generic a, GMonoid' (Rep a)) => a -> a -> a-  gmappend x y = to (gmappend' (from x) (from y))-#endif-------------------------------------------------------------------------------------- Instances that reuse Monoid-instance GMonoid Ordering where-  gmempty = mempty-  gmappend = mappend-instance GMonoid () where-  gmempty = mempty-  gmappend = mappend-instance GMonoid Any where-  gmempty = mempty-  gmappend = mappend-instance GMonoid All where-  gmempty = mempty-  gmappend = mappend-instance GMonoid (First a) where-  gmempty = mempty-  gmappend = mappend-instance GMonoid (Last a) where-  gmempty = mempty-  gmappend = mappend-instance Num a => GMonoid (Sum a) where-  gmempty = mempty-  gmappend = mappend-instance Num a => GMonoid (Product a) where-  gmempty = mempty-  gmappend = mappend-instance GMonoid [a] where-  gmempty  = mempty-  gmappend = mappend-instance GMonoid (Endo a) where-  gmempty = mempty-  gmappend = mappend-#if MIN_VERSION_base(4,8,0)-instance Alternative f => GMonoid (Alt f a) where-  gmempty = mempty-  gmappend = mappend-#endif---- Handwritten instances-instance GMonoid a => GMonoid (Dual a) where-  gmempty = Dual gmempty-  gmappend (Dual x) (Dual y) = Dual (gmappend y x)-instance GMonoid a => GMonoid (Maybe a) where+instance GSemigroup a => GMonoid (Maybe a) where   gmempty = Nothing-  gmappend Nothing  x        = x-  gmappend x        Nothing  = x-  gmappend (Just x) (Just y) = Just (gmappend x y)-instance GMonoid b => GMonoid (a -> b) where-  gmempty _ = gmempty-  gmappend f g x = gmappend (f x) (g x)-instance GMonoid a => GMonoid (Const a b) where-  gmempty  = gmemptydefault-  gmappend = gmappenddefault-instance GMonoid a => GMonoid (Down a) where-  gmempty  = gmemptydefault-  gmappend = gmappenddefault--#if MIN_VERSION_base(4,7,0)-instance GMonoid-# if MIN_VERSION_base(4,9,0)-                 (Proxy s)-# else-                 (Proxy (s :: *))-# endif-                 where-  gmempty  = memptydefault-  gmappend = mappenddefault-#endif--#if MIN_VERSION_base(4,8,0)-instance GMonoid a => GMonoid (Identity a) where-  gmempty  = gmemptydefault-  gmappend = gmappenddefault-#endif+  gmappend = gsappend  #if MIN_VERSION_base(4,9,0) instance GMonoid m => GMonoid (WrappedMonoid m) where   gmempty  = gmemptydefault   gmappend = gmappenddefault #endif---- Tuple instances-instance (GMonoid a,GMonoid b) => GMonoid (a,b) where-  gmempty = (gmempty,gmempty)-  gmappend (a1,b1) (a2,b2) =-    (gmappend a1 a2,gmappend b1 b2)-instance (GMonoid a,GMonoid b,GMonoid c) => GMonoid (a,b,c) where-  gmempty = (gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1) (a2,b2,c2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2)-instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d) => GMonoid (a,b,c,d) where-  gmempty = (gmempty,gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1,d1) (a2,b2,c2,d2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2)-instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e) => GMonoid (a,b,c,d,e) where-  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2)-instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f) => GMonoid (a,b,c,d,e,f) where-  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2)-instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g) => GMonoid (a,b,c,d,e,f,g) where-  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2)-instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g,GMonoid h) => GMonoid (a,b,c,d,e,f,g,h) where-  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)-  gmappend (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) =-    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2,gmappend h1 h2)

@@ -0,0 +1,276 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE DefaultSignatures #-}+#endif++#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif++module Generics.Deriving.Monoid.Internal (++  -- * Introduction+  {- | This module provides two main features:++      1. 'GMonoid', a generic version of the 'Monoid' type class, including instances+      of the types from "Data.Monoid"++      2. Default generic definitions for the 'Monoid' methods 'mempty' and 'mappend'++  The generic defaults only work for types without alternatives (i.e. they have+  only one constructor). We cannot in general know how to deal with different+  constructors.+  -}++  -- * GMonoid type class+  GMonoid(..),++  -- * Default definitions+  -- ** GMonoid+  gmemptydefault,+  gmappenddefault,++  -- * Internal auxiliary class for GMonoid+  GMonoid'(..),++  -- ** Monoid+  {- | These functions can be used in a 'Monoid' instance. For example:++  @+  -- LANGUAGE DeriveGeneric++  import Generics.Deriving.Base (Generic)+  import Generics.Deriving.Monoid++  data T a = C a (Maybe a) deriving Generic++  instance Monoid a => Monoid (T a) where+    mempty  = memptydefault+    mappend = mappenddefault+  @+  -}+  memptydefault,+  mappenddefault,++  -- * Internal auxiliary class for Monoid+  Monoid'(..),++  -- * The Monoid module+  -- | This is exported for convenient access to the various wrapper types.+  module Data.Monoid,++  ) where++--------------------------------------------------------------------------------++import Control.Applicative+import Data.Monoid+import Generics.Deriving.Base+import Generics.Deriving.Semigroup.Internal++#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down)+#else+import GHC.Exts (Down)+#endif++#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy)+#endif++#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity (Identity)+#endif++--------------------------------------------------------------------------------++class GSemigroup' f => GMonoid' f where+  gmempty'  :: f x+  gmappend' :: f x -> f x -> f x++instance GMonoid' U1 where+  gmempty' = U1+  gmappend' U1 U1 = U1++instance GMonoid a => GMonoid' (K1 i a) where+  gmempty' = K1 gmempty+  gmappend' (K1 x) (K1 y) = K1 (x `gmappend` y)++instance GMonoid' f => GMonoid' (M1 i c f) where+  gmempty' = M1 gmempty'+  gmappend' (M1 x) (M1 y) = M1 (x `gmappend'` y)++instance (GMonoid' f, GMonoid' h) => GMonoid' (f :*: h) where+  gmempty' = gmempty' :*: gmempty'+  gmappend' (x1 :*: y1) (x2 :*: y2) = gmappend' x1 x2 :*: gmappend' y1 y2++--------------------------------------------------------------------------------++gmemptydefault :: (Generic a, GMonoid' (Rep a)) => a+gmemptydefault = to gmempty'++gmappenddefault :: (Generic a, GMonoid' (Rep a)) => a -> a -> a+gmappenddefault x y = to (gmappend' (from x) (from y))++--------------------------------------------------------------------------------++class Monoid' f where+  mempty'  :: f x+  mappend' :: f x -> f x -> f x++instance Monoid' U1 where+  mempty' = U1+  mappend' U1 U1 = U1++instance Monoid a => Monoid' (K1 i a) where+  mempty' = K1 mempty+  mappend' (K1 x) (K1 y) = K1 (x `mappend` y)++instance Monoid' f => Monoid' (M1 i c f) where+  mempty' = M1 mempty'+  mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)++instance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where+  mempty' = mempty' :*: mempty'+  mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2++--------------------------------------------------------------------------------++memptydefault :: (Generic a, Monoid' (Rep a)) => a+memptydefault = to mempty'++mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a+mappenddefault x y = to (mappend' (from x) (from y))++--------------------------------------------------------------------------------++class GSemigroup a => GMonoid a where++  -- | Generic 'mempty'+  gmempty  :: a++  -- | Generic 'mappend'+  gmappend :: a -> a -> a++  -- | Generic 'mconcat'+  gmconcat :: [a] -> a+  gmconcat = foldr gmappend gmempty++#if __GLASGOW_HASKELL__ >= 701+  default gmempty :: (Generic a, GMonoid' (Rep a)) => a+  gmempty = to gmempty'++  default gmappend :: (Generic a, GMonoid' (Rep a)) => a -> a -> a+  gmappend x y = to (gmappend' (from x) (from y))+#endif++--------------------------------------------------------------------------------++-- Instances that reuse Monoid+instance GMonoid Ordering where+  gmempty = mempty+  gmappend = mappend+instance GMonoid () where+  gmempty = mempty+  gmappend = mappend+instance GMonoid Any where+  gmempty = mempty+  gmappend = mappend+instance GMonoid All where+  gmempty = mempty+  gmappend = mappend+instance GMonoid (First a) where+  gmempty = mempty+  gmappend = mappend+instance GMonoid (Last a) where+  gmempty = mempty+  gmappend = mappend+instance Num a => GMonoid (Sum a) where+  gmempty = mempty+  gmappend = mappend+instance Num a => GMonoid (Product a) where+  gmempty = mempty+  gmappend = mappend+instance GMonoid [a] where+  gmempty  = mempty+  gmappend = mappend+instance GMonoid (Endo a) where+  gmempty = mempty+  gmappend = mappend+#if MIN_VERSION_base(4,8,0)+instance Alternative f => GMonoid (Alt f a) where+  gmempty = mempty+  gmappend = mappend+#endif++-- Handwritten instances+instance GMonoid a => GMonoid (Dual a) where+  gmempty = Dual gmempty+  gmappend (Dual x) (Dual y) = Dual (gmappend y x)+instance GMonoid b => GMonoid (a -> b) where+  gmempty _ = gmempty+  gmappend f g x = gmappend (f x) (g x)+instance GMonoid a => GMonoid (Const a b) where+  gmempty  = gmemptydefault+  gmappend = gmappenddefault+instance GMonoid a => GMonoid (Down a) where+  gmempty  = gmemptydefault+  gmappend = gmappenddefault++#if MIN_VERSION_base(4,7,0)+instance GMonoid+# if MIN_VERSION_base(4,9,0)+                 (Proxy s)+# else+                 (Proxy (s :: *))+# endif+                 where+  gmempty  = memptydefault+  gmappend = mappenddefault+#endif++#if MIN_VERSION_base(4,8,0)+instance GMonoid a => GMonoid (Identity a) where+  gmempty  = gmemptydefault+  gmappend = gmappenddefault+#endif++-- Tuple instances+instance (GMonoid a,GMonoid b) => GMonoid (a,b) where+  gmempty = (gmempty,gmempty)+  gmappend (a1,b1) (a2,b2) =+    (gmappend a1 a2,gmappend b1 b2)+instance (GMonoid a,GMonoid b,GMonoid c) => GMonoid (a,b,c) where+  gmempty = (gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1) (a2,b2,c2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2)+instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d) => GMonoid (a,b,c,d) where+  gmempty = (gmempty,gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1,d1) (a2,b2,c2,d2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2)+instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e) => GMonoid (a,b,c,d,e) where+  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2)+instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f) => GMonoid (a,b,c,d,e,f) where+  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2)+instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g) => GMonoid (a,b,c,d,e,f,g) where+  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2)+instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g,GMonoid h) => GMonoid (a,b,c,d,e,f,g,h) where+  gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)+  gmappend (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) =+    (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2,gmappend h1 h2)

@@ -1,222 +1,20 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 701-{-# LANGUAGE DefaultSignatures #-}-#endif--#if __GLASGOW_HASKELL__ >= 705-{-# LANGUAGE PolyKinds #-}-#endif+{-# OPTIONS_GHC -fno-warn-orphans #-} -#if __GLASGOW_HASKELL__ >= 710+#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 701+#elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -module Generics.Deriving.Semigroup (-  -- * Generic semigroup class-    GSemigroup(..)--  -- * Default definition-  , gsappenddefault--  -- * Internal semigroup class-  , GSemigroup'(..)--  ) where--import Control.Applicative-import Data.Monoid as Monoid-#if MIN_VERSION_base(4,5,0)-  hiding ((<>))-#endif-import Generics.Deriving.Base--#if MIN_VERSION_base(4,6,0)-import Data.Ord (Down)-#else-import GHC.Exts (Down)-#endif--#if MIN_VERSION_base(4,7,0)-import Data.Proxy (Proxy)-#endif--#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity)-import Data.Void (Void)-#endif--#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty (NonEmpty(..))-import Data.Semigroup as Semigroup-import Generics.Deriving.Monoid (GMonoid(..))-#endif-----------------------------------------------------------------------------------infixr 6 `gsappend'`-class GSemigroup' f where-  gsappend' :: f x -> f x -> f x--instance GSemigroup' U1 where-  gsappend' U1 U1 = U1--instance GSemigroup a => GSemigroup' (K1 i a) where-  gsappend' (K1 x) (K1 y) = K1 (gsappend x y)--instance GSemigroup' f => GSemigroup' (M1 i c f) where-  gsappend' (M1 x) (M1 y) = M1 (gsappend' x y)--instance (GSemigroup' f, GSemigroup' g) => GSemigroup' (f :*: g) where-  gsappend' (x1 :*: y1) (x2 :*: y2) = gsappend' x1 x2 :*: gsappend' y1 y2-----------------------------------------------------------------------------------infixr 6 `gsappend`-class GSemigroup a where-  gsappend :: a -> a -> a-#if __GLASGOW_HASKELL__ >= 701-  default gsappend :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a-  gsappend = gsappenddefault-#endif--  gstimes :: Integral b => b -> a -> a-  gstimes y0 x0-    | y0 <= 0   = error "gstimes: positive multiplier expected"-    | otherwise = f x0 y0-    where-      f x y-        | even y = f (gsappend x x) (y `quot` 2)-        | y == 1 = x-        | otherwise = g (gsappend x x) (pred y  `quot` 2) x-      g x y z-        | even y = g (gsappend x x) (y `quot` 2) z-        | y == 1 = gsappend x z-        | otherwise = g (gsappend x x) (pred y `quot` 2) (gsappend x z)--#if MIN_VERSION_base(4,9,0)-  -- | Only available with @base-4.9@ or later-  gsconcat :: NonEmpty a -> a-  gsconcat (a :| as) = go a as where-    go b (c:cs) = gsappend b (go c cs)-    go b []     = b-#endif--infixr 6 `gsappenddefault`-gsappenddefault :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a-gsappenddefault x y = to (gsappend' (from x) (from y))------------------------------------------------------------------------------------- Instances that reuse Monoid-instance GSemigroup Ordering where-  gsappend = mappend-instance GSemigroup () where-  gsappend = mappend-instance GSemigroup Any where-  gsappend = mappend-instance GSemigroup All where-  gsappend = mappend-instance GSemigroup (Monoid.First a) where-  gsappend = mappend-instance GSemigroup (Monoid.Last a) where-  gsappend = mappend-instance Num a => GSemigroup (Sum a) where-  gsappend = mappend-instance Num a => GSemigroup (Product a) where-  gsappend = mappend-instance GSemigroup [a] where-  gsappend = mappend-instance GSemigroup (Endo a) where-  gsappend = mappend-#if MIN_VERSION_base(4,8,0)-instance Alternative f => GSemigroup (Alt f a) where-  gsappend = mappend-#endif---- Handwritten instances-instance GSemigroup a => GSemigroup (Dual a) where-  gsappend (Dual x) (Dual y) = Dual (gsappend y x)-instance GSemigroup a => GSemigroup (Maybe a) where-  gsappend Nothing  x        = x-  gsappend x        Nothing  = x-  gsappend (Just x) (Just y) = Just (gsappend x y)-instance GSemigroup b => GSemigroup (a -> b) where-  gsappend f g x = gsappend (f x) (g x)-instance GSemigroup a => GSemigroup (Const a b) where-  gsappend = gsappenddefault-instance GSemigroup a => GSemigroup (Down a) where-  gsappend = gsappenddefault-instance GSemigroup (Either a b) where-  gsappend Left{} b = b-  gsappend a      _ = a--#if MIN_VERSION_base(4,7,0)-instance GSemigroup-# if MIN_VERSION_base(4,9,0)-                 (Proxy s)-# else-                 (Proxy (s :: *))-# endif-                 where-  gsappend    = gsappenddefault-#endif--#if MIN_VERSION_base(4,8,0)-instance GSemigroup a => GSemigroup (Identity a) where-  gsappend = gsappenddefault+module Generics.Deriving.Semigroup (module Generics.Deriving.Semigroup.Internal) where -instance GSemigroup Void where-  gsappend a _ = a-#endif+import Generics.Deriving.Semigroup.Internal  #if MIN_VERSION_base(4,9,0)-instance GSemigroup (Semigroup.First a) where-  gsappend = (<>)--instance GSemigroup (Semigroup.Last a) where-  gsappend = (<>)--instance Ord a => GSemigroup (Max a) where-  gsappend = (<>)--instance Ord a => GSemigroup (Min a) where-  gsappend = (<>)--instance GSemigroup (NonEmpty a) where-  gsappend = (<>)--instance GSemigroup a => GSemigroup (Option a) where-  gsappend (Option a) (Option b) = Option (gsappend a b)+import Data.Semigroup (WrappedMonoid(..))+import Generics.Deriving.Monoid.Internal (GMonoid(..))  instance GMonoid m => GSemigroup (WrappedMonoid m) where   gsappend (WrapMonoid a) (WrapMonoid b) = WrapMonoid (gmappend a b) #endif---- Tuple instances-instance (GSemigroup a,GSemigroup b) => GSemigroup (a,b) where-  gsappend (a1,b1) (a2,b2) =-    (gsappend a1 a2,gsappend b1 b2)-instance (GSemigroup a,GSemigroup b,GSemigroup c) => GSemigroup (a,b,c) where-  gsappend (a1,b1,c1) (a2,b2,c2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2)-instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d) => GSemigroup (a,b,c,d) where-  gsappend (a1,b1,c1,d1) (a2,b2,c2,d2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2)-instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e) => GSemigroup (a,b,c,d,e) where-  gsappend (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2)-instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f) => GSemigroup (a,b,c,d,e,f) where-  gsappend (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2)-instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f,GSemigroup g) => GSemigroup (a,b,c,d,e,f,g) where-  gsappend (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2,gsappend g1 g2)-instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f,GSemigroup g,GSemigroup h) => GSemigroup (a,b,c,d,e,f,g,h) where-  gsappend (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) =-    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2,gsappend g1 g2,gsappend h1 h2)

@@ -0,0 +1,218 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE DefaultSignatures #-}+#endif++#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif++module Generics.Deriving.Semigroup.Internal (+  -- * Generic semigroup class+    GSemigroup(..)++  -- * Default definition+  , gsappenddefault++  -- * Internal semigroup class+  , GSemigroup'(..)++  ) where++import Control.Applicative+import Data.Monoid as Monoid+#if MIN_VERSION_base(4,5,0)+  hiding ((<>))+#endif+import Generics.Deriving.Base++#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down)+#else+import GHC.Exts (Down)+#endif++#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy)+#endif++#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity (Identity)+import Data.Void (Void)+#endif++#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Semigroup as Semigroup+#endif++-------------------------------------------------------------------------------++infixr 6 `gsappend'`+class GSemigroup' f where+  gsappend' :: f x -> f x -> f x++instance GSemigroup' U1 where+  gsappend' U1 U1 = U1++instance GSemigroup a => GSemigroup' (K1 i a) where+  gsappend' (K1 x) (K1 y) = K1 (gsappend x y)++instance GSemigroup' f => GSemigroup' (M1 i c f) where+  gsappend' (M1 x) (M1 y) = M1 (gsappend' x y)++instance (GSemigroup' f, GSemigroup' g) => GSemigroup' (f :*: g) where+  gsappend' (x1 :*: y1) (x2 :*: y2) = gsappend' x1 x2 :*: gsappend' y1 y2++-------------------------------------------------------------------------------++infixr 6 `gsappend`+class GSemigroup a where+  gsappend :: a -> a -> a+#if __GLASGOW_HASKELL__ >= 701+  default gsappend :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a+  gsappend = gsappenddefault+#endif++  gstimes :: Integral b => b -> a -> a+  gstimes y0 x0+    | y0 <= 0   = error "gstimes: positive multiplier expected"+    | otherwise = f x0 y0+    where+      f x y+        | even y = f (gsappend x x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (gsappend x x) (pred y  `quot` 2) x+      g x y z+        | even y = g (gsappend x x) (y `quot` 2) z+        | y == 1 = gsappend x z+        | otherwise = g (gsappend x x) (pred y `quot` 2) (gsappend x z)++#if MIN_VERSION_base(4,9,0)+  -- | Only available with @base-4.9@ or later+  gsconcat :: NonEmpty a -> a+  gsconcat (a :| as) = go a as where+    go b (c:cs) = gsappend b (go c cs)+    go b []     = b+#endif++infixr 6 `gsappenddefault`+gsappenddefault :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a+gsappenddefault x y = to (gsappend' (from x) (from y))++-------------------------------------------------------------------------------++-- Instances that reuse Monoid+instance GSemigroup Ordering where+  gsappend = mappend+instance GSemigroup () where+  gsappend = mappend+instance GSemigroup Any where+  gsappend = mappend+instance GSemigroup All where+  gsappend = mappend+instance GSemigroup (Monoid.First a) where+  gsappend = mappend+instance GSemigroup (Monoid.Last a) where+  gsappend = mappend+instance Num a => GSemigroup (Sum a) where+  gsappend = mappend+instance Num a => GSemigroup (Product a) where+  gsappend = mappend+instance GSemigroup [a] where+  gsappend = mappend+instance GSemigroup (Endo a) where+  gsappend = mappend+#if MIN_VERSION_base(4,8,0)+instance Alternative f => GSemigroup (Alt f a) where+  gsappend = mappend+#endif++-- Handwritten instances+instance GSemigroup a => GSemigroup (Dual a) where+  gsappend (Dual x) (Dual y) = Dual (gsappend y x)+instance GSemigroup a => GSemigroup (Maybe a) where+  gsappend Nothing  x        = x+  gsappend x        Nothing  = x+  gsappend (Just x) (Just y) = Just (gsappend x y)+instance GSemigroup b => GSemigroup (a -> b) where+  gsappend f g x = gsappend (f x) (g x)+instance GSemigroup a => GSemigroup (Const a b) where+  gsappend = gsappenddefault+instance GSemigroup a => GSemigroup (Down a) where+  gsappend = gsappenddefault+instance GSemigroup (Either a b) where+  gsappend Left{} b = b+  gsappend a      _ = a++#if MIN_VERSION_base(4,7,0)+instance GSemigroup+# if MIN_VERSION_base(4,9,0)+                 (Proxy s)+# else+                 (Proxy (s :: *))+# endif+                 where+  gsappend    = gsappenddefault+#endif++#if MIN_VERSION_base(4,8,0)+instance GSemigroup a => GSemigroup (Identity a) where+  gsappend = gsappenddefault++instance GSemigroup Void where+  gsappend a _ = a+#endif++#if MIN_VERSION_base(4,9,0)+instance GSemigroup (Semigroup.First a) where+  gsappend = (<>)++instance GSemigroup (Semigroup.Last a) where+  gsappend = (<>)++instance Ord a => GSemigroup (Max a) where+  gsappend = (<>)++instance Ord a => GSemigroup (Min a) where+  gsappend = (<>)++instance GSemigroup (NonEmpty a) where+  gsappend = (<>)++instance GSemigroup a => GSemigroup (Option a) where+  gsappend (Option a) (Option b) = Option (gsappend a b)+#endif++-- Tuple instances+instance (GSemigroup a,GSemigroup b) => GSemigroup (a,b) where+  gsappend (a1,b1) (a2,b2) =+    (gsappend a1 a2,gsappend b1 b2)+instance (GSemigroup a,GSemigroup b,GSemigroup c) => GSemigroup (a,b,c) where+  gsappend (a1,b1,c1) (a2,b2,c2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2)+instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d) => GSemigroup (a,b,c,d) where+  gsappend (a1,b1,c1,d1) (a2,b2,c2,d2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2)+instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e) => GSemigroup (a,b,c,d,e) where+  gsappend (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2)+instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f) => GSemigroup (a,b,c,d,e,f) where+  gsappend (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2)+instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f,GSemigroup g) => GSemigroup (a,b,c,d,e,f,g) where+  gsappend (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2,gsappend g1 g2)+instance (GSemigroup a,GSemigroup b,GSemigroup c,GSemigroup d,GSemigroup e,GSemigroup f,GSemigroup g,GSemigroup h) => GSemigroup (a,b,c,d,e,f,g,h) where+  gsappend (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) =+    (gsappend a1 a2,gsappend b1 b2,gsappend c1 c2,gsappend d1 d2,gsappend e1 e2,gsappend f1 f2,gsappend g1 g2,gsappend h1 h2)

@@ -461,11 +461,7 @@  `recover`   do DatatypeInfo { datatypeContext   = ctxt                   , datatypeName      = parentName-#if MIN_VERSION_th_abstraction(0,3,0)                   , datatypeInstTypes = tys-#else-                  , datatypeVars      = tys-#endif                   , datatypeVariant   = variant                   , datatypeCons      = cons                   } <- reifyDatatype name