generic-deriving 1.10.0 → 1.10.1

raw patch · 16 files changed

+1197/−876 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• generic-deriving.cabal +4/−2
• src/Generics/Deriving/Base.hs +5/−797
• src/Generics/Deriving/Base/Internal.hs +808/−0
• src/Generics/Deriving/ConNames.hs +9/−0
• src/Generics/Deriving/Copoint.hs +6/−1
• src/Generics/Deriving/Enum.hs +85/−66
• src/Generics/Deriving/Eq.hs +13/−2
• src/Generics/Deriving/Foldable.hs +6/−1
• src/Generics/Deriving/Functor.hs +6/−1
• src/Generics/Deriving/Instances.hs +12/−1
• src/Generics/Deriving/Monoid.hs +18/−2
• src/Generics/Deriving/Semigroup.hs +206/−0
• src/Generics/Deriving/Show.hs +1/−1
• src/Generics/Deriving/Traversable.hs +6/−1
• src/Generics/Deriving/Uniplate.hs +5/−1

@@ -1,3 +1,10 @@+# 1.10.1+* Added `Generics.Deriving.Semigroup`+* Added `GMonoid` instance for `Data.Monoid.Alt`+* Fixed a bug in the `GEnum` instances for unsigned `Integral` types+* Added `Safe`/`Trustworthy` pragmas+* Made instances polykinded where possible+ # 1.10.0 * On GHC 8.0 and up, `Generics.Deriving.TH` uses the new type literal-based   machinery

@@ -1,5 +1,5 @@ name:                   generic-deriving-version:                1.10.0+version:                1.10.1 synopsis:               Generic programming library for generalised deriving. description: @@ -52,13 +52,15 @@                         Generics.Deriving.Foldable                         Generics.Deriving.Functor                         Generics.Deriving.Monoid+                        Generics.Deriving.Semigroup                         Generics.Deriving.Show                         Generics.Deriving.Traversable                         Generics.Deriving.Uniplate                          Generics.Deriving.TH -  other-modules:        Generics.Deriving.TH.Internal+  other-modules:        Generics.Deriving.Base.Internal+                        Generics.Deriving.TH.Internal                         Paths_generic_deriving   if impl(ghc >= 7.11)     other-modules:      Generics.Deriving.TH.Post711

@@ -1,802 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-} -module Generics.Deriving.Base (--- * Introduction------ |------ Datatype-generic functions are are based on the idea of converting values of--- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T@.--- The type @'Rep' T@ is--- built from a limited set of type constructors, all provided by this module. A--- datatype-generic function is then an overloaded function with instances--- for most of these type constructors, together with a wrapper that performs--- the mapping between @T@ and @'Rep' T@. By using this technique, we merely need--- a few generic instances in order to implement functionality that works for any--- representable type.------ Representable types are collected in the 'Generic' class, which defines the--- associated type 'Rep' as well as conversion functions 'from' and 'to'.--- Typically, you will not define 'Generic' instances by hand, but have the compiler--- derive them for you.---- ** Representing datatypes------ |------ The key to defining your own datatype-generic functions is to understand how to--- represent datatypes using the given set of type constructors.------ Let us look at an example first:------ @--- data Tree a = Leaf a | Node (Tree a) (Tree a)---   deriving 'Generic'--- @------ The above declaration (which requires the language pragma @DeriveGeneric@)--- causes the following representation to be generated:------ @--- class 'Generic' (Tree a) where---   type 'Rep' (Tree a) =---     'D1' D1Tree---       ('C1' C1_0Tree---          ('S1' 'NoSelector' ('Par0' a))---        ':+:'---        'C1' C1_1Tree---          ('S1' 'NoSelector' ('Rec0' (Tree a))---           ':*:'---           'S1' 'NoSelector' ('Rec0' (Tree a))))---   ...--- @------ /Hint:/ You can obtain information about the code being generated from GHC by passing--- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using--- the @:kind!@ command.----#if 0--- /TODO:/ Newer GHC versions abandon the distinction between 'Par0' and 'Rec0' and will--- use 'Rec0' everywhere.----#endif--- This is a lot of information! However, most of it is actually merely meta-information--- that makes names of datatypes and constructors and more available on the type level.------ Here is a reduced representation for 'Tree' with nearly all meta-information removed,--- for now keeping only the most essential aspects:------ @--- instance 'Generic' (Tree a) where---   type 'Rep' (Tree a) =---     'Par0' a---     ':+:'---     ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a))--- @------ The @Tree@ datatype has two constructors. The representation of individual constructors--- is combined using the binary type constructor ':+:'.------ The first constructor consists of a single field, which is the parameter @a@. This is--- represented as @'Par0' a@.------ The second constructor consists of two fields. Each is a recursive field of type @Tree a@,--- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using--- the binary type constructor ':*:'.------ Now let us explain the additional tags being used in the complete representation:------    * The @'S1' 'NoSelector'@ indicates that there is no record field selector associated with---      this field of the constructor.------    * The @'C1' C1_0Tree@ and @'C1' C1_1Tree@ invocations indicate that the enclosed part is---      the representation of the first and second constructor of datatype @Tree@, respectively.---      Here, @C1_0Tree@ and @C1_1Tree@ are datatypes generated by the compiler as part of---      @deriving 'Generic'@. These datatypes are proxy types with no values. They are useful---      because they are instances of the type class 'Constructor'. This type class can be used---      to obtain information about the constructor in question, such as its name---      or infix priority.------    * The @'D1' D1Tree@ tag indicates that the enclosed part is the representation of the---      datatype @Tree@. Again, @D1Tree@ is a datatype generated by the compiler. It is a---      proxy type, and is useful by being an instance of class 'Datatype', which---      can be used to obtain the name of a datatype, the module it has been defined in, and---      whether it has been defined using @data@ or @newtype@.---- ** Derived and fundamental representation types------ |------ There are many datatype-generic functions that do not distinguish between positions that--- are parameters or positions that are recursive calls. There are also many datatype-generic--- functions that do not care about the names of datatypes and constructors at all. To keep--- the number of cases to consider in generic functions in such a situation to a minimum,--- it turns out that many of the type constructors introduced above are actually synonyms,--- defining them to be variants of a smaller set of constructors.---- *** Individual fields of constructors: 'K1'------ |------ The type constructors 'Par0' and 'Rec0' are variants of 'K1':------ @--- type 'Par0' = 'K1' 'P'--- type 'Rec0' = 'K1' 'R'--- @------ Here, 'P' and 'R' are type-level proxies again that do not have any associated values.---- *** Meta information: 'M1'------ |------ The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1':------ @--- type 'S1' = 'M1' 'S'--- type 'C1' = 'M1' 'C'--- type 'D1' = 'M1' 'D'--- @------ The types 'S', 'C' and 'R' are once again type-level proxies, just used to create--- several variants of 'M1'.---- *** Additional generic representation type constructors------ |------ Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur--- in the representations of other datatypes.---- **** Empty datatypes: 'V1'------ |------ For empty datatypes, 'V1' is used as a representation. For example,------ @--- data Empty deriving 'Generic'--- @------ yields------ @--- instance 'Generic' Empty where---   type 'Rep' Empty = 'D1' D1Empty 'V1'--- @---- **** Constructors without fields: 'U1'------ |------ If a constructor has no arguments, then 'U1' is used as its representation. For example--- the representation of 'Bool' is------ @--- instance 'Generic' Bool where---   type 'Rep' Bool =---     'D1' D1Bool---       ('C1' C1_0Bool 'U1' ':+:' 'C1' C1_1Bool 'U1')--- @---- *** Representation of types with many constructors or many fields------ |------ As ':+:' and ':*:' are just binary operators, one might ask what happens if the--- datatype has more than two constructors, or a constructor with more than two--- fields. The answer is simple: the operators are used several times, to combine--- all the constructors and fields as needed. However, users /should not rely on--- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is--- free to choose any nesting it prefers. (In practice, the current implementation--- tries to produce a more or less balanced nesting, so that the traversal of the--- structure of the datatype from the root to a particular component can be performed--- in logarithmic rather than linear time.)---- ** Defining datatype-generic functions------ |------ A datatype-generic function comprises two parts:------    1. /Generic instances/ for the function, implementing it for most of the representation---       type constructors introduced above.------    2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion---       between the original value and its `Rep`-based representation and then invokes the---       generic instances.------ As an example, let us look at a function 'encode' that produces a naive, but lossless--- bit encoding of values of various datatypes. So we are aiming to define a function------ @--- encode :: 'Generic' a => a -> [Bool]--- @------ where we use 'Bool' as our datatype for bits.------ For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized--- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation--- type constructors operate with kind @* -> *@ as base kind. But the type argument is never--- being used. This may be changed at some point in the future. The class has a single method,--- and we use the type we want our final function to have, but we replace the occurrences of--- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used).------ > class Encode' f where--- >   encode' :: f p -> [Bool]------ With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define--- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'.---- *** Definition of the generic representation types------ |------ In order to be able to do this, we need to know the actual definitions of these types:------ @--- data    'V1'        p                       -- lifted version of Empty--- data    'U1'        p = 'U1'                  -- lifted version of ()--- data    (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either'--- data    (':*:') f g p = (f p) ':*:' (g p)     -- lifted version of (,)--- newtype 'K1'    i c p = 'K1' { 'unK1' :: c }    -- a container for a c--- newtype 'M1'  i t f p = 'M1' { 'unM1' :: f p }  -- a wrapper--- @------ So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either',--- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value--- of a specific type @c@, and 'M1' wraps a value of the generic type argument,--- which in the lifted world is an @f p@ (where we do not care about @p@).---- *** Generic instances------ |------ The instance for 'V1' is slightly awkward (but also rarely used):------ @--- instance Encode' 'V1' where---   encode' x = undefined--- @------ There are no values of type @V1 p@ to pass (except undefined), so this is--- actually impossible. One can ask why it is useful to define an instance for--- 'V1' at all in this case? Well, an empty type can be used as an argument to--- a non-empty type, and you might still want to encode the resulting type.--- As a somewhat contrived example, consider @[Empty]@, which is not an empty--- type, but contains just the empty list. The 'V1' instance ensures that we--- can call the generic function on such types.------ There is exactly one value of type 'U1', so encoding it requires no--- knowledge, and we can use zero bits:------ @--- instance Encode' 'U1' where---   encode' 'U1' = []--- @------ In the case for ':+:', we produce 'False' or 'True' depending on whether--- the constructor of the value provided is located on the left or on the right:------ @--- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where---   encode' ('L1' x) = False : encode' x---   encode' ('R1' x) = True  : encode' x--- @------ In the case for ':*:', we append the encodings of the two subcomponents:------ @--- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where---   encode' (x ':*:' y) = encode' x ++ encode' y--- @------ The case for 'K1' is rather interesting. Here, we call the final function--- 'encode' that we yet have to define, recursively. We will use another type--- class 'Encode' for that function:------ @--- instance (Encode c) => Encode' ('K1' i c) where---   encode' ('K1' x) = encode x--- @------ Note how 'Par0' and 'Rec0' both being mapped to 'K1' allows us to define--- a uniform instance here.------ Similarly, we can define a uniform instance for 'M1', because we completely--- disregard all meta-information:------ @--- instance (Encode' f) => Encode' ('M1' i t f) where---   encode' ('M1' x) = encode' x--- @------ Unlike in 'K1', the instance for 'M1' refers to 'encode'', not 'encode'.---- *** The wrapper and generic default------ |------ We now define class 'Encode' for the actual 'encode' function:------ @--- class Encode a where---   encode :: a -> [Bool]---   default encode :: ('Generic' a) => a -> [Bool]---   encode x = encode' ('from' x)--- @------ The incoming 'x' is converted using 'from', then we dispatch to the--- generic instances using 'encode''. We use this as a default definition--- for 'encode'. We need the 'default encode' signature because ordinary--- Haskell default methods must not introduce additional class constraints,--- but our generic default does.------ Defining a particular instance is now as simple as saying------ @--- instance (Encode a) => Encode (Tree a)--- @----#if 0--- /TODO:/ Add usage example?----#endif--- The generic default is being used. In the future, it will hopefully be--- possible to use @deriving Encode@ as well, but GHC does not yet support--- that syntax for this situation.------ Having 'Encode' as a class has the advantage that we can define--- non-generic special cases, which is particularly useful for abstract--- datatypes that have no structural representation. For example, given--- a suitable integer encoding function 'encodeInt', we can define------ @--- instance Encode Int where---   encode = encodeInt--- @---- *** Omitting generic instances------ |------ It is not always required to provide instances for all the generic--- representation types, but omitting instances restricts the set of--- datatypes the functions will work for:------    * If no ':+:' instance is given, the function may still work for---      empty datatypes or datatypes that have a single constructor,---      but will fail on datatypes with more than one constructor.------    * If no ':*:' instance is given, the function may still work for---      datatypes where each constructor has just zero or one field,---      in particular for enumeration types.------    * If no 'K1' instance is given, the function may still work for---      enumeration types, where no constructor has any fields.------    * If no 'V1' instance is given, the function may still work for---      any datatype that is not empty.------    * If no 'U1' instance is given, the function may still work for---      any datatype where each constructor has at least one field.------ An 'M1' instance is always required (but it can just ignore the--- meta-information, as is the case for 'encode' above).-#if 0--- *** Using meta-information------ |------ TODO-#endif--- ** Generic constructor classes------ |------ Datatype-generic functions as defined above work for a large class--- of datatypes, including parameterized datatypes. (We have used 'Tree'--- as our example above, which is of kind @* -> *@.) However, the--- 'Generic' class ranges over types of kind @*@, and therefore, the--- resulting generic functions (such as 'encode') must be parameterized--- by a generic type argument of kind @*@.------ What if we want to define generic classes that range over type--- constructors (such as 'Functor', 'Traversable', or 'Foldable')?---- *** The 'Generic1' class------ |------ Like 'Generic', there is a class 'Generic1' that defines a--- representation 'Rep1' and conversion functions 'from1' and 'to1',--- only that 'Generic1' ranges over types of kind @* -> *@.--- The 'Generic1' class is also derivable.------ The representation 'Rep1' is ever so slightly different from 'Rep'.--- Let us look at 'Tree' as an example again:------ @--- data Tree a = Leaf a | Node (Tree a) (Tree a)---   deriving 'Generic1'--- @------ The above declaration causes the following representation to be generated:------ class 'Generic1' Tree where---   type 'Rep1' Tree =---     'D1' D1Tree---       ('C1' C1_0Tree---          ('S1' 'NoSelector' 'Par1')---        ':+:'---        'C1' C1_1Tree---          ('S1' 'NoSelector' ('Rec1' Tree)---           ':*:'---           'S1' 'NoSelector' ('Rec1' Tree)))---   ...------ The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well--- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we--- carry around the dummy type argument for kind-@*@-types, but there are--- already enough different names involved without duplicating each of--- these.)------ What's different is that we now use 'Par1' to refer to the parameter--- (and that parameter, which used to be @a@), is not mentioned explicitly--- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a@.---- *** Representation of @* -> *@ types------ |------ Unlike 'Par0' and 'Rec0', the 'Par1' and 'Rec1' type constructors do not--- map to 'K1'. They are defined directly, as follows:------ @--- newtype 'Par1'   p = 'Par1' { 'unPar1' ::   p } -- gives access to parameter p--- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper--- @------ In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply--- wraps an application of @f@ to @p@.------ Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation,--- namely when the datatype has a field that does not mention the parameter.------ The declaration------ @--- data WithInt a = WithInt Int a---   deriving 'Generic1'--- @------ yields------ @--- class 'Rep1' WithInt where---   type 'Rep1' WithInt =---     'D1' D1WithInt---       ('C1' C1_0WithInt---         ('S1' 'NoSelector' ('Rec0' Int)---          ':*:'---          'S1' 'NoSelector' 'Par1'))--- @------ If the parameter @a@ appears underneath a composition of other type constructors,--- then the representation involves composition, too:------ @--- data Rose a = Fork a [Rose a]--- @------ yields------ @--- class 'Rep1' Rose where---   type 'Rep1' Rose =---     'D1' D1Rose---       ('C1' C1_0Rose---         ('S1' 'NoSelector' 'Par1'---          ':*:'---          'S1' 'NoSelector' ([] ':.:' 'Rec1' Rose)--- @------ where------ @--- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }--- @---- *** Representation of unlifted types------ |------ If one were to attempt to derive a Generic instance for a datatype with an--- unlifted argument (for example, 'Int#'), one might expect the occurrence of--- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work,--- though, since 'Int#' is of kind @#@ and 'Rec0' expects a type of kind @*@.--- In fact, polymorphism over unlifted types is disallowed completely.------ One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int'--- instead. With this approach, however, the programmer has no way of knowing--- whether the 'Int' is actually an 'Int#' in disguise.------ Instead of reusing 'Rec0', a separate data family 'URec' is used to mark--- occurrences of common unlifted types:------ @--- data family URec a p------ data instance 'URec' ('Ptr' ()) p = 'UAddr'   { 'uAddr#'   :: 'Addr#'   }--- data instance 'URec' 'Char'     p = 'UChar'   { 'uChar#'   :: 'Char#'   }--- data instance 'URec' 'Double'   p = 'UDouble' { 'uDouble#' :: 'Double#' }--- data instance 'URec' 'Int'      p = 'UFloat'  { 'uFloat#'  :: 'Float#'  }--- data instance 'URec' 'Float'    p = 'UInt'    { 'uInt#'    :: 'Int#'    }--- data instance 'URec' 'Word'     p = 'UWord'   { 'uWord#'   :: 'Word#'   }--- @------ Several type synonyms are provided for convenience:------ @--- type 'UAddr'   = 'URec' ('Ptr' ())--- type 'UChar'   = 'URec' 'Char'--- type 'UDouble' = 'URec' 'Double'--- type 'UFloat'  = 'URec' 'Float'--- type 'UInt'    = 'URec' 'Int'--- type 'UWord'   = 'URec' 'Word'--- @------ The declaration------ @--- data IntHash = IntHash Int#---   deriving 'Generic'--- @------ yields------ @--- instance 'Generic' IntHash where---   type 'Rep' IntHash =---     'D1' D1IntHash---       ('C1' C1_0IntHash---         ('S1' 'NoSelector' 'UInt'))--- @------ Currently, only the six unlifted types listed above are generated, but this--- may be extended to encompass more unlifted types in the future.-#if 0--- *** Limitations------ |------ /TODO/------ /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion.----#endif-#if __GLASGOW_HASKELL__ < 701-  -- * Generic representation types-    V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)-  , (:+:)(..), (:*:)(..), (:.:)(..)--  -- ** Synonyms for convenience-  , Rec0, Par0, R, P-  , D1, C1, S1, D, C, S--  -- * Meta-information-  , Datatype(..), Constructor(..), Selector(..), NoSelector-  , Fixity(..), Associativity(..), Arity(..), prec--  -- * Generic type classes-  , Generic(..), Generic1(..),--#else-  module GHC.Generics,-#endif-#if __GLASGOW_HASKELL__ < 711-  -- ** Unboxed representation types-    URec(..), UAddr, UChar, UDouble, UFloat, UInt, UWord-#endif-  ) where---#if __GLASGOW_HASKELL__ >= 701-import GHC.Generics-#endif--#if __GLASGOW_HASKELL__ < 709-import Data.Word ( Word )-#endif--#if __GLASGOW_HASKELL__ < 711-import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# )-import GHC.Ptr ( Ptr )-#endif--#if __GLASGOW_HASKELL__ < 701------------------------------------------------------------------------------------ Representation types------------------------------------------------------------------------------------- | Void: used for datatypes without constructors-data V1 p---- | Unit: used for constructors without arguments-data U1 p = U1-  deriving (Eq, Ord, Read, Show)---- | Used for marking occurrences of the parameter-newtype Par1 p = Par1 { unPar1 :: p }-  deriving (Eq, Ord, Read, Show)---- | Recursive calls of kind * -> *-newtype Rec1 f p = Rec1 { unRec1 :: f p }-  deriving (Eq, Ord, Read, Show)---- | Constants, additional parameters and recursion of kind *-newtype K1 i c p = K1 { unK1 :: c }-  deriving (Eq, Ord, Read, Show)---- | Meta-information (constructor names, etc.)-newtype M1 i c f p = M1 { unM1 :: f p }-  deriving (Eq, Ord, Read, Show)---- | Sums: encode choice between constructors-infixr 5 :+:-data (:+:) f g p = L1 (f p) | R1 (g p)-  deriving (Eq, Ord, Read, Show)---- | Products: encode multiple arguments to constructors-infixr 6 :*:-data (:*:) f g p = f p :*: g p-  deriving (Eq, Ord, Read, Show)---- | Composition of functors-infixr 7 :.:-newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }-  deriving (Eq, Ord, Read, Show)--- | Tag for K1: recursion (of kind *)-data R--- | Tag for K1: parameters (other than the last)-data P---- | Type synonym for encoding recursion (of kind *)-type Rec0  = K1 R--- | Type synonym for encoding parameters (other than the last)-type Par0  = K1 P---- | Tag for M1: datatype-data D--- | Tag for M1: constructor-data C--- | Tag for M1: record selector-data S---- | Type synonym for encoding meta-information for datatypes-type D1 = M1 D---- | Type synonym for encoding meta-information for constructors-type C1 = M1 C---- | Type synonym for encoding meta-information for record selectors-type S1 = M1 S---- | Class for datatypes that represent datatypes-class Datatype d where-  -- | The name of the datatype, fully qualified-  datatypeName :: t d (f :: * -> *) a -> String-  moduleName   :: t d (f :: * -> *) a -> String---- | Class for datatypes that represent records-class Selector s where-  -- | The name of the selector-  selName :: t s (f :: * -> *) a -> String---- | Used for constructor fields without a name-data NoSelector--instance Selector NoSelector where selName _ = ""---- | Class for datatypes that represent data constructors-class Constructor c where-  -- | The name of the constructor-  conName :: t c (f :: * -> *) a -> String--  -- | The fixity of the constructor-  conFixity :: t c (f :: * -> *) a -> Fixity-  conFixity = const Prefix--  -- | Marks if this constructor is a record-  conIsRecord :: t c (f :: * -> *) a -> Bool-  conIsRecord = const False----- | Datatype to represent the arity of a tuple.-data Arity = NoArity | Arity Int-  deriving (Eq, Show, Ord, Read)---- | Datatype to represent the fixity of a constructor. An infix--- | declaration directly corresponds to an application of 'Infix'.-data Fixity = Prefix | Infix Associativity Int-  deriving (Eq, Show, Ord, Read)---- | Get the precedence of a fixity value.-prec :: Fixity -> Int-prec Prefix      = 10-prec (Infix _ n) = n---- | Datatype to represent the associativy of a constructor-data Associativity =  LeftAssociative-                   |  RightAssociative-                   |  NotAssociative-  deriving (Eq, Show, Ord, Read)---- | Representable types of kind *-class Generic a where-  type Rep a :: * -> *-  -- | Convert from the datatype to its representation-  from  :: a -> Rep a x-  -- | Convert from the representation to the datatype-  to    :: Rep a x -> a---- | Representable types of kind * -> *-class Generic1 f where-  type Rep1 f :: * -> *-  -- | Convert from the datatype to its representation-  from1  :: f a -> Rep1 f a-  -- | Convert from the representation to the datatype-  to1    :: Rep1 f a -> f a-+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Safe #-} #endif -#if __GLASGOW_HASKELL__ < 711--- | Constants of kind @#@-data family URec (a :: *) (p :: *)---- | Used for marking occurrences of 'Addr#'-data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }-  deriving (Eq, Ord)---- | Used for marking occurrences of 'Char#'-data instance URec Char p = UChar { uChar# :: Char# }-  deriving (Eq, Ord, Show)---- | Used for marking occurrences of 'Double#'-data instance URec Double p = UDouble { uDouble# :: Double# }-  deriving (Eq, Ord, Show)---- | Used for marking occurrences of 'Float#'-data instance URec Float p = UFloat { uFloat# :: Float# }-  deriving (Eq, Ord, Show)---- | Used for marking occurrences of 'Int#'-data instance URec Int p = UInt { uInt# :: Int# }-  deriving (Eq, Ord, Show)---- | Used for marking occurrences of 'Word#'-data instance URec Word p = UWord { uWord# :: Word# }-  deriving (Eq, Ord, Show)+module Generics.Deriving.Base (module Generics.Deriving.Base.Internal) where --- | Type synonym for 'URec': 'Addr#'-type UAddr   = URec (Ptr ())--- | Type synonym for 'URec': 'Char#'-type UChar   = URec Char--- | Type synonym for 'URec': 'Double#'-type UDouble = URec Double--- | Type synonym for 'URec': 'Float#'-type UFloat  = URec Float--- | Type synonym for 'URec': 'Int#'-type UInt    = URec Int--- | Type synonym for 'URec': 'Word#'-type UWord   = URec Word-#endif+import Generics.Deriving.Base.Internal+import Generics.Deriving.Instances ()

@@ -0,0 +1,808 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}++#if __GLASGOW_HASKELL__ >= 711+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif++module Generics.Deriving.Base.Internal (+-- * Introduction+--+-- |+--+-- Datatype-generic functions are are based on the idea of converting values of+-- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T@.+-- The type @'Rep' T@ is+-- built from a limited set of type constructors, all provided by this module. A+-- datatype-generic function is then an overloaded function with instances+-- for most of these type constructors, together with a wrapper that performs+-- the mapping between @T@ and @'Rep' T@. By using this technique, we merely need+-- a few generic instances in order to implement functionality that works for any+-- representable type.+--+-- Representable types are collected in the 'Generic' class, which defines the+-- associated type 'Rep' as well as conversion functions 'from' and 'to'.+-- Typically, you will not define 'Generic' instances by hand, but have the compiler+-- derive them for you.++-- ** Representing datatypes+--+-- |+--+-- The key to defining your own datatype-generic functions is to understand how to+-- represent datatypes using the given set of type constructors.+--+-- Let us look at an example first:+--+-- @+-- data Tree a = Leaf a | Node (Tree a) (Tree a)+--   deriving 'Generic'+-- @+--+-- The above declaration (which requires the language pragma @DeriveGeneric@)+-- causes the following representation to be generated:+--+-- @+-- class 'Generic' (Tree a) where+--   type 'Rep' (Tree a) =+--     'D1' D1Tree+--       ('C1' C1_0Tree+--          ('S1' 'NoSelector' ('Par0' a))+--        ':+:'+--        'C1' C1_1Tree+--          ('S1' 'NoSelector' ('Rec0' (Tree a))+--           ':*:'+--           'S1' 'NoSelector' ('Rec0' (Tree a))))+--   ...+-- @+--+-- /Hint:/ You can obtain information about the code being generated from GHC by passing+-- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using+-- the @:kind!@ command.+--+#if 0+-- /TODO:/ Newer GHC versions abandon the distinction between 'Par0' and 'Rec0' and will+-- use 'Rec0' everywhere.+--+#endif+-- This is a lot of information! However, most of it is actually merely meta-information+-- that makes names of datatypes and constructors and more available on the type level.+--+-- Here is a reduced representation for 'Tree' with nearly all meta-information removed,+-- for now keeping only the most essential aspects:+--+-- @+-- instance 'Generic' (Tree a) where+--   type 'Rep' (Tree a) =+--     'Par0' a+--     ':+:'+--     ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a))+-- @+--+-- The @Tree@ datatype has two constructors. The representation of individual constructors+-- is combined using the binary type constructor ':+:'.+--+-- The first constructor consists of a single field, which is the parameter @a@. This is+-- represented as @'Par0' a@.+--+-- The second constructor consists of two fields. Each is a recursive field of type @Tree a@,+-- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using+-- the binary type constructor ':*:'.+--+-- Now let us explain the additional tags being used in the complete representation:+--+--    * The @'S1' 'NoSelector'@ indicates that there is no record field selector associated with+--      this field of the constructor.+--+--    * The @'C1' C1_0Tree@ and @'C1' C1_1Tree@ invocations indicate that the enclosed part is+--      the representation of the first and second constructor of datatype @Tree@, respectively.+--      Here, @C1_0Tree@ and @C1_1Tree@ are datatypes generated by the compiler as part of+--      @deriving 'Generic'@. These datatypes are proxy types with no values. They are useful+--      because they are instances of the type class 'Constructor'. This type class can be used+--      to obtain information about the constructor in question, such as its name+--      or infix priority.+--+--    * The @'D1' D1Tree@ tag indicates that the enclosed part is the representation of the+--      datatype @Tree@. Again, @D1Tree@ is a datatype generated by the compiler. It is a+--      proxy type, and is useful by being an instance of class 'Datatype', which+--      can be used to obtain the name of a datatype, the module it has been defined in, and+--      whether it has been defined using @data@ or @newtype@.++-- ** Derived and fundamental representation types+--+-- |+--+-- There are many datatype-generic functions that do not distinguish between positions that+-- are parameters or positions that are recursive calls. There are also many datatype-generic+-- functions that do not care about the names of datatypes and constructors at all. To keep+-- the number of cases to consider in generic functions in such a situation to a minimum,+-- it turns out that many of the type constructors introduced above are actually synonyms,+-- defining them to be variants of a smaller set of constructors.++-- *** Individual fields of constructors: 'K1'+--+-- |+--+-- The type constructors 'Par0' and 'Rec0' are variants of 'K1':+--+-- @+-- type 'Par0' = 'K1' 'P'+-- type 'Rec0' = 'K1' 'R'+-- @+--+-- Here, 'P' and 'R' are type-level proxies again that do not have any associated values.++-- *** Meta information: 'M1'+--+-- |+--+-- The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1':+--+-- @+-- type 'S1' = 'M1' 'S'+-- type 'C1' = 'M1' 'C'+-- type 'D1' = 'M1' 'D'+-- @+--+-- The types 'S', 'C' and 'R' are once again type-level proxies, just used to create+-- several variants of 'M1'.++-- *** Additional generic representation type constructors+--+-- |+--+-- Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur+-- in the representations of other datatypes.++-- **** Empty datatypes: 'V1'+--+-- |+--+-- For empty datatypes, 'V1' is used as a representation. For example,+--+-- @+-- data Empty deriving 'Generic'+-- @+--+-- yields+--+-- @+-- instance 'Generic' Empty where+--   type 'Rep' Empty = 'D1' D1Empty 'V1'+-- @++-- **** Constructors without fields: 'U1'+--+-- |+--+-- If a constructor has no arguments, then 'U1' is used as its representation. For example+-- the representation of 'Bool' is+--+-- @+-- instance 'Generic' Bool where+--   type 'Rep' Bool =+--     'D1' D1Bool+--       ('C1' C1_0Bool 'U1' ':+:' 'C1' C1_1Bool 'U1')+-- @++-- *** Representation of types with many constructors or many fields+--+-- |+--+-- As ':+:' and ':*:' are just binary operators, one might ask what happens if the+-- datatype has more than two constructors, or a constructor with more than two+-- fields. The answer is simple: the operators are used several times, to combine+-- all the constructors and fields as needed. However, users /should not rely on+-- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is+-- free to choose any nesting it prefers. (In practice, the current implementation+-- tries to produce a more or less balanced nesting, so that the traversal of the+-- structure of the datatype from the root to a particular component can be performed+-- in logarithmic rather than linear time.)++-- ** Defining datatype-generic functions+--+-- |+--+-- A datatype-generic function comprises two parts:+--+--    1. /Generic instances/ for the function, implementing it for most of the representation+--       type constructors introduced above.+--+--    2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion+--       between the original value and its `Rep`-based representation and then invokes the+--       generic instances.+--+-- As an example, let us look at a function 'encode' that produces a naive, but lossless+-- bit encoding of values of various datatypes. So we are aiming to define a function+--+-- @+-- encode :: 'Generic' a => a -> [Bool]+-- @+--+-- where we use 'Bool' as our datatype for bits.+--+-- For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized+-- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation+-- type constructors operate with kind @* -> *@ as base kind. But the type argument is never+-- being used. This may be changed at some point in the future. The class has a single method,+-- and we use the type we want our final function to have, but we replace the occurrences of+-- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used).+--+-- > class Encode' f where+-- >   encode' :: f p -> [Bool]+--+-- With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define+-- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'.++-- *** Definition of the generic representation types+--+-- |+--+-- In order to be able to do this, we need to know the actual definitions of these types:+--+-- @+-- data    'V1'        p                       -- lifted version of Empty+-- data    'U1'        p = 'U1'                  -- lifted version of ()+-- data    (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either'+-- data    (':*:') f g p = (f p) ':*:' (g p)     -- lifted version of (,)+-- newtype 'K1'    i c p = 'K1' { 'unK1' :: c }    -- a container for a c+-- newtype 'M1'  i t f p = 'M1' { 'unM1' :: f p }  -- a wrapper+-- @+--+-- So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either',+-- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value+-- of a specific type @c@, and 'M1' wraps a value of the generic type argument,+-- which in the lifted world is an @f p@ (where we do not care about @p@).++-- *** Generic instances+--+-- |+--+-- The instance for 'V1' is slightly awkward (but also rarely used):+--+-- @+-- instance Encode' 'V1' where+--   encode' x = undefined+-- @+--+-- There are no values of type @V1 p@ to pass (except undefined), so this is+-- actually impossible. One can ask why it is useful to define an instance for+-- 'V1' at all in this case? Well, an empty type can be used as an argument to+-- a non-empty type, and you might still want to encode the resulting type.+-- As a somewhat contrived example, consider @[Empty]@, which is not an empty+-- type, but contains just the empty list. The 'V1' instance ensures that we+-- can call the generic function on such types.+--+-- There is exactly one value of type 'U1', so encoding it requires no+-- knowledge, and we can use zero bits:+--+-- @+-- instance Encode' 'U1' where+--   encode' 'U1' = []+-- @+--+-- In the case for ':+:', we produce 'False' or 'True' depending on whether+-- the constructor of the value provided is located on the left or on the right:+--+-- @+-- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where+--   encode' ('L1' x) = False : encode' x+--   encode' ('R1' x) = True  : encode' x+-- @+--+-- In the case for ':*:', we append the encodings of the two subcomponents:+--+-- @+-- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where+--   encode' (x ':*:' y) = encode' x ++ encode' y+-- @+--+-- The case for 'K1' is rather interesting. Here, we call the final function+-- 'encode' that we yet have to define, recursively. We will use another type+-- class 'Encode' for that function:+--+-- @+-- instance (Encode c) => Encode' ('K1' i c) where+--   encode' ('K1' x) = encode x+-- @+--+-- Note how 'Par0' and 'Rec0' both being mapped to 'K1' allows us to define+-- a uniform instance here.+--+-- Similarly, we can define a uniform instance for 'M1', because we completely+-- disregard all meta-information:+--+-- @+-- instance (Encode' f) => Encode' ('M1' i t f) where+--   encode' ('M1' x) = encode' x+-- @+--+-- Unlike in 'K1', the instance for 'M1' refers to 'encode'', not 'encode'.++-- *** The wrapper and generic default+--+-- |+--+-- We now define class 'Encode' for the actual 'encode' function:+--+-- @+-- class Encode a where+--   encode :: a -> [Bool]+--   default encode :: ('Generic' a) => a -> [Bool]+--   encode x = encode' ('from' x)+-- @+--+-- The incoming 'x' is converted using 'from', then we dispatch to the+-- generic instances using 'encode''. We use this as a default definition+-- for 'encode'. We need the 'default encode' signature because ordinary+-- Haskell default methods must not introduce additional class constraints,+-- but our generic default does.+--+-- Defining a particular instance is now as simple as saying+--+-- @+-- instance (Encode a) => Encode (Tree a)+-- @+--+#if 0+-- /TODO:/ Add usage example?+--+#endif+-- The generic default is being used. In the future, it will hopefully be+-- possible to use @deriving Encode@ as well, but GHC does not yet support+-- that syntax for this situation.+--+-- Having 'Encode' as a class has the advantage that we can define+-- non-generic special cases, which is particularly useful for abstract+-- datatypes that have no structural representation. For example, given+-- a suitable integer encoding function 'encodeInt', we can define+--+-- @+-- instance Encode Int where+--   encode = encodeInt+-- @++-- *** Omitting generic instances+--+-- |+--+-- It is not always required to provide instances for all the generic+-- representation types, but omitting instances restricts the set of+-- datatypes the functions will work for:+--+--    * If no ':+:' instance is given, the function may still work for+--      empty datatypes or datatypes that have a single constructor,+--      but will fail on datatypes with more than one constructor.+--+--    * If no ':*:' instance is given, the function may still work for+--      datatypes where each constructor has just zero or one field,+--      in particular for enumeration types.+--+--    * If no 'K1' instance is given, the function may still work for+--      enumeration types, where no constructor has any fields.+--+--    * If no 'V1' instance is given, the function may still work for+--      any datatype that is not empty.+--+--    * If no 'U1' instance is given, the function may still work for+--      any datatype where each constructor has at least one field.+--+-- An 'M1' instance is always required (but it can just ignore the+-- meta-information, as is the case for 'encode' above).+#if 0+-- *** Using meta-information+--+-- |+--+-- TODO+#endif+-- ** Generic constructor classes+--+-- |+--+-- Datatype-generic functions as defined above work for a large class+-- of datatypes, including parameterized datatypes. (We have used 'Tree'+-- as our example above, which is of kind @* -> *@.) However, the+-- 'Generic' class ranges over types of kind @*@, and therefore, the+-- resulting generic functions (such as 'encode') must be parameterized+-- by a generic type argument of kind @*@.+--+-- What if we want to define generic classes that range over type+-- constructors (such as 'Functor', 'Traversable', or 'Foldable')?++-- *** The 'Generic1' class+--+-- |+--+-- Like 'Generic', there is a class 'Generic1' that defines a+-- representation 'Rep1' and conversion functions 'from1' and 'to1',+-- only that 'Generic1' ranges over types of kind @* -> *@.+-- The 'Generic1' class is also derivable.+--+-- The representation 'Rep1' is ever so slightly different from 'Rep'.+-- Let us look at 'Tree' as an example again:+--+-- @+-- data Tree a = Leaf a | Node (Tree a) (Tree a)+--   deriving 'Generic1'+-- @+--+-- The above declaration causes the following representation to be generated:+--+-- class 'Generic1' Tree where+--   type 'Rep1' Tree =+--     'D1' D1Tree+--       ('C1' C1_0Tree+--          ('S1' 'NoSelector' 'Par1')+--        ':+:'+--        'C1' C1_1Tree+--          ('S1' 'NoSelector' ('Rec1' Tree)+--           ':*:'+--           'S1' 'NoSelector' ('Rec1' Tree)))+--   ...+--+-- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well+-- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we+-- carry around the dummy type argument for kind-@*@-types, but there are+-- already enough different names involved without duplicating each of+-- these.)+--+-- What's different is that we now use 'Par1' to refer to the parameter+-- (and that parameter, which used to be @a@), is not mentioned explicitly+-- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a@.++-- *** Representation of @* -> *@ types+--+-- |+--+-- Unlike 'Par0' and 'Rec0', the 'Par1' and 'Rec1' type constructors do not+-- map to 'K1'. They are defined directly, as follows:+--+-- @+-- newtype 'Par1'   p = 'Par1' { 'unPar1' ::   p } -- gives access to parameter p+-- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper+-- @+--+-- In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply+-- wraps an application of @f@ to @p@.+--+-- Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation,+-- namely when the datatype has a field that does not mention the parameter.+--+-- The declaration+--+-- @+-- data WithInt a = WithInt Int a+--   deriving 'Generic1'+-- @+--+-- yields+--+-- @+-- class 'Rep1' WithInt where+--   type 'Rep1' WithInt =+--     'D1' D1WithInt+--       ('C1' C1_0WithInt+--         ('S1' 'NoSelector' ('Rec0' Int)+--          ':*:'+--          'S1' 'NoSelector' 'Par1'))+-- @+--+-- If the parameter @a@ appears underneath a composition of other type constructors,+-- then the representation involves composition, too:+--+-- @+-- data Rose a = Fork a [Rose a]+-- @+--+-- yields+--+-- @+-- class 'Rep1' Rose where+--   type 'Rep1' Rose =+--     'D1' D1Rose+--       ('C1' C1_0Rose+--         ('S1' 'NoSelector' 'Par1'+--          ':*:'+--          'S1' 'NoSelector' ([] ':.:' 'Rec1' Rose)+-- @+--+-- where+--+-- @+-- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }+-- @++-- *** Representation of unlifted types+--+-- |+--+-- If one were to attempt to derive a Generic instance for a datatype with an+-- unlifted argument (for example, 'Int#'), one might expect the occurrence of+-- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work,+-- though, since 'Int#' is of kind @#@ and 'Rec0' expects a type of kind @*@.+-- In fact, polymorphism over unlifted types is disallowed completely.+--+-- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int'+-- instead. With this approach, however, the programmer has no way of knowing+-- whether the 'Int' is actually an 'Int#' in disguise.+--+-- Instead of reusing 'Rec0', a separate data family 'URec' is used to mark+-- occurrences of common unlifted types:+--+-- @+-- data family URec a p+--+-- data instance 'URec' ('Ptr' ()) p = 'UAddr'   { 'uAddr#'   :: 'Addr#'   }+-- data instance 'URec' 'Char'     p = 'UChar'   { 'uChar#'   :: 'Char#'   }+-- data instance 'URec' 'Double'   p = 'UDouble' { 'uDouble#' :: 'Double#' }+-- data instance 'URec' 'Int'      p = 'UFloat'  { 'uFloat#'  :: 'Float#'  }+-- data instance 'URec' 'Float'    p = 'UInt'    { 'uInt#'    :: 'Int#'    }+-- data instance 'URec' 'Word'     p = 'UWord'   { 'uWord#'   :: 'Word#'   }+-- @+--+-- Several type synonyms are provided for convenience:+--+-- @+-- type 'UAddr'   = 'URec' ('Ptr' ())+-- type 'UChar'   = 'URec' 'Char'+-- type 'UDouble' = 'URec' 'Double'+-- type 'UFloat'  = 'URec' 'Float'+-- type 'UInt'    = 'URec' 'Int'+-- type 'UWord'   = 'URec' 'Word'+-- @+--+-- The declaration+--+-- @+-- data IntHash = IntHash Int#+--   deriving 'Generic'+-- @+--+-- yields+--+-- @+-- instance 'Generic' IntHash where+--   type 'Rep' IntHash =+--     'D1' D1IntHash+--       ('C1' C1_0IntHash+--         ('S1' 'NoSelector' 'UInt'))+-- @+--+-- Currently, only the six unlifted types listed above are generated, but this+-- may be extended to encompass more unlifted types in the future.+#if 0+-- *** Limitations+--+-- |+--+-- /TODO/+--+-- /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion.+--+#endif+#if __GLASGOW_HASKELL__ < 701+  -- * Generic representation types+    V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)+  , (:+:)(..), (:*:)(..), (:.:)(..)++  -- ** Synonyms for convenience+  , Rec0, Par0, R, P+  , D1, C1, S1, D, C, S++  -- * Meta-information+  , Datatype(..), Constructor(..), Selector(..), NoSelector+  , Fixity(..), Associativity(..), Arity(..), prec++  -- * Generic type classes+  , Generic(..), Generic1(..),++#else+  module GHC.Generics,+#endif+#if __GLASGOW_HASKELL__ < 711+  -- ** Unboxed representation types+    URec(..), UAddr, UChar, UDouble, UFloat, UInt, UWord+#endif+  ) where+++#if __GLASGOW_HASKELL__ >= 701+import GHC.Generics+#endif++#if __GLASGOW_HASKELL__ < 709+import Data.Word ( Word )+#endif++#if __GLASGOW_HASKELL__ < 711+import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# )+import GHC.Ptr ( Ptr )+#endif++#if __GLASGOW_HASKELL__ < 701+--------------------------------------------------------------------------------+-- Representation types+--------------------------------------------------------------------------------++-- | Void: used for datatypes without constructors+data V1 p++-- | Unit: used for constructors without arguments+data U1 p = U1+  deriving (Eq, Ord, Read, Show)++-- | Used for marking occurrences of the parameter+newtype Par1 p = Par1 { unPar1 :: p }+  deriving (Eq, Ord, Read, Show)++-- | Recursive calls of kind * -> *+newtype Rec1 f p = Rec1 { unRec1 :: f p }+  deriving (Eq, Ord, Read, Show)++-- | Constants, additional parameters and recursion of kind *+newtype K1 i c p = K1 { unK1 :: c }+  deriving (Eq, Ord, Read, Show)++-- | Meta-information (constructor names, etc.)+newtype M1 i c f p = M1 { unM1 :: f p }+  deriving (Eq, Ord, Read, Show)++-- | Sums: encode choice between constructors+infixr 5 :+:+data (:+:) f g p = L1 (f p) | R1 (g p)+  deriving (Eq, Ord, Read, Show)++-- | Products: encode multiple arguments to constructors+infixr 6 :*:+data (:*:) f g p = f p :*: g p+  deriving (Eq, Ord, Read, Show)++-- | Composition of functors+infixr 7 :.:+newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }+  deriving (Eq, Ord, Read, Show)+-- | Tag for K1: recursion (of kind *)+data R+-- | Tag for K1: parameters (other than the last)+data P++-- | Type synonym for encoding recursion (of kind *)+type Rec0  = K1 R+-- | Type synonym for encoding parameters (other than the last)+type Par0  = K1 P++-- | Tag for M1: datatype+data D+-- | Tag for M1: constructor+data C+-- | Tag for M1: record selector+data S++-- | Type synonym for encoding meta-information for datatypes+type D1 = M1 D++-- | Type synonym for encoding meta-information for constructors+type C1 = M1 C++-- | Type synonym for encoding meta-information for record selectors+type S1 = M1 S++-- | Class for datatypes that represent datatypes+class Datatype d where+  -- | The name of the datatype, fully qualified+  datatypeName :: t d (f :: * -> *) a -> String+  moduleName   :: t d (f :: * -> *) a -> String++-- | Class for datatypes that represent records+class Selector s where+  -- | The name of the selector+  selName :: t s (f :: * -> *) a -> String++-- | Used for constructor fields without a name+data NoSelector++instance Selector NoSelector where selName _ = ""++-- | Class for datatypes that represent data constructors+class Constructor c where+  -- | The name of the constructor+  conName :: t c (f :: * -> *) a -> String++  -- | The fixity of the constructor+  conFixity :: t c (f :: * -> *) a -> Fixity+  conFixity = const Prefix++  -- | Marks if this constructor is a record+  conIsRecord :: t c (f :: * -> *) a -> Bool+  conIsRecord = const False+++-- | Datatype to represent the arity of a tuple.+data Arity = NoArity | Arity Int+  deriving (Eq, Show, Ord, Read)++-- | Datatype to represent the fixity of a constructor. An infix+-- | declaration directly corresponds to an application of 'Infix'.+data Fixity = Prefix | Infix Associativity Int+  deriving (Eq, Show, Ord, Read)++-- | Get the precedence of a fixity value.+prec :: Fixity -> Int+prec Prefix      = 10+prec (Infix _ n) = n++-- | Datatype to represent the associativy of a constructor+data Associativity =  LeftAssociative+                   |  RightAssociative+                   |  NotAssociative+  deriving (Eq, Show, Ord, Read)++-- | Representable types of kind *+class Generic a where+  type Rep a :: * -> *+  -- | Convert from the datatype to its representation+  from  :: a -> Rep a x+  -- | Convert from the representation to the datatype+  to    :: Rep a x -> a++-- | Representable types of kind * -> *+class Generic1 f where+  type Rep1 f :: * -> *+  -- | Convert from the datatype to its representation+  from1  :: f a -> Rep1 f a+  -- | Convert from the representation to the datatype+  to1    :: Rep1 f a -> f a++#endif++#if __GLASGOW_HASKELL__ < 711+-- | Constants of kind @#@+data family URec (a :: *) (p :: *)++-- | Used for marking occurrences of 'Addr#'+data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }+  deriving (Eq, Ord)++-- | Used for marking occurrences of 'Char#'+data instance URec Char p = UChar { uChar# :: Char# }+  deriving (Eq, Ord, Show)++-- | Used for marking occurrences of 'Double#'+data instance URec Double p = UDouble { uDouble# :: Double# }+  deriving (Eq, Ord, Show)++-- | Used for marking occurrences of 'Float#'+data instance URec Float p = UFloat { uFloat# :: Float# }+  deriving (Eq, Ord, Show)++-- | Used for marking occurrences of 'Int#'+data instance URec Int p = UInt { uInt# :: Int# }+  deriving (Eq, Ord, Show)++-- | Used for marking occurrences of 'Word#'+data instance URec Word p = UWord { uWord# :: Word# }+  deriving (Eq, Ord, Show)++-- | Type synonym for 'URec': 'Addr#'+type UAddr   = URec (Ptr ())+-- | Type synonym for 'URec': 'Char#'+type UChar   = URec Char+-- | Type synonym for 'URec': 'Double#'+type UDouble = URec Double+-- | Type synonym for 'URec': 'Float#'+type UFloat  = URec Float+-- | Type synonym for 'URec': 'Int#'+type UInt    = URec Int+-- | Type synonym for 'URec': 'Word#'+type UWord   = URec Word+#endif

@@ -1,8 +1,17 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif++#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif  ----------------------------------------------------------------------------- -- |

@@ -2,10 +2,16 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-}+ #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ module Generics.Deriving.Copoint (   -- * GCopoint class     GCopoint(..),@@ -21,7 +27,6 @@ import qualified Data.Monoid as Monoid (Sum)  import           Generics.Deriving.Base-import           Generics.Deriving.Instances ()  #if MIN_VERSION_base(4,8,0) import           Data.Functor.Identity (Identity)

@@ -1,12 +1,19 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+ #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ #include "HsBaseConfig.h"  module Generics.Deriving.Enum (@@ -36,7 +43,6 @@ import           Foreign.Ptr  import           Generics.Deriving.Base-import           Generics.Deriving.Instances () import           Generics.Deriving.Eq  import           System.Exit (ExitCode)@@ -47,7 +53,10 @@ #endif  #if MIN_VERSION_base(4,7,0)+import           Data.Coerce (coerce) import           Data.Proxy (Proxy)+#else+import           Unsafe.Coerce (unsafeCoerce) #endif  #if MIN_VERSION_base(4,8,0)@@ -149,12 +158,17 @@   pos n = n     : pos (n + 1)   neg n = (n-1) : neg (n - 1) -genumNumBounded :: (Bounded a, Enum a, Num a) => [a]-genumNumBounded = genumNumWithBounds minBound maxBound+genumNumSigned :: (Bounded a, Enum a, Num a) => [a]+genumNumSigned = [0 .. maxBound] ||| [-1, -2 .. minBound] -genumNumWithBounds :: (Enum a, Num a) => a -> a -> [a]-genumNumWithBounds minB maxB = [0 .. maxB] ||| [-1, -2 .. minB]+genumNumUnsigned :: (Enum a, Num a) => [a]+genumNumUnsigned = [0 ..] +#if !(MIN_VERSION_base(4,7,0))+coerce :: a -> b+coerce = unsafeCoerce+#endif+ -- Base types instances instance GEnum () where   genum = genumDefault@@ -220,67 +234,64 @@  #if defined(HTYPE_CC_T) instance GEnum CCc where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_CC_T))-                             (fromIntegral (maxBound :: HTYPE_CC_T))+  genum = coerce (genum :: [HTYPE_CC_T]) #endif  instance GEnum CChar where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_CHAR])  instance GEnum CClock where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_CLOCK_T))-                             (fromIntegral (maxBound :: HTYPE_CLOCK_T))+  genum = coerce (genum :: [HTYPE_CLOCK_T])  #if defined(HTYPE_DEV_T) instance GEnum CDev where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_DEV_T))-                             (fromIntegral (maxBound :: HTYPE_DEV_T))+  genum = coerce (genum :: [HTYPE_DEV_T]) #endif  instance GEnum CDouble where-  genum = genumNumUnbounded+  genum = coerce (genum :: [HTYPE_DOUBLE])  instance GEnum CFloat where-  genum = genumNumUnbounded+  genum = coerce (genum :: [HTYPE_FLOAT])  #if defined(HTYPE_GID_T) instance GEnum CGid where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_GID_T]) #endif  #if defined(HTYPE_INO_T) instance GEnum CIno where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_INO_T]) #endif  instance GEnum CInt where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_INT])  instance GEnum CIntMax where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_INTMAX_T])  instance GEnum CIntPtr where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_INTPTR_T])  instance GEnum CLLong where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_LONG_LONG])  instance GEnum CLong where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_LONG])  #if defined(HTYPE_MODE_T) instance GEnum CMode where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_MODE_T]) #endif  #if defined(HTYPE_NLINK_T) instance GEnum CNlink where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_NLINK_T]) #endif  #if defined(HTYPE_OFF_T) instance GEnum COff where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_OFF_T]) #endif  #if MIN_VERSION_base(4,4,0)@@ -293,89 +304,85 @@  #if defined(HTYPE_PID_T) instance GEnum CPid where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_PID_T]) #endif  instance GEnum CPtrdiff where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_PTRDIFF_T])  #if defined(HTYPE_RLIM_T) instance GEnum CRLim where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_RLIM_T]) #endif  instance GEnum CSChar where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_SIGNED_CHAR])  #if defined(HTYPE_SPEED_T) instance GEnum CSpeed where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_SPEED_T))-                             (fromIntegral (maxBound :: HTYPE_SPEED_T))+  genum = coerce (genum :: [HTYPE_SPEED_T]) #endif  #if MIN_VERSION_base(4,4,0) instance GEnum CSUSeconds where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_SUSECONDS_T))-                             (fromIntegral (maxBound :: HTYPE_SUSECONDS_T))+  genum = coerce (genum :: [HTYPE_SUSECONDS_T]) #endif  instance GEnum CShort where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_SHORT])  instance GEnum CSigAtomic where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_SIG_ATOMIC_T])  instance GEnum CSize where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_SIZE_T])  #if defined(HTYPE_SSIZE_T) instance GEnum CSsize where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_SSIZE_T]) #endif  #if defined(HTYPE_TCFLAG_T) instance GEnum CTcflag where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_TCFLAG_T]) #endif  instance GEnum CTime where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_TIME_T))-                             (fromIntegral (maxBound :: HTYPE_TIME_T))+  genum = coerce (genum :: [HTYPE_TIME_T])  instance GEnum CUChar where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UNSIGNED_CHAR])  #if defined(HTYPE_UID_T) instance GEnum CUid where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UID_T]) #endif  instance GEnum CUInt where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UNSIGNED_INT])  instance GEnum CUIntMax where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UINTMAX_T])  instance GEnum CUIntPtr where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UINTPTR_T])  instance GEnum CULLong where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UNSIGNED_LONG_LONG])  instance GEnum CULong where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UNSIGNED_LONG])  #if MIN_VERSION_base(4,4,0) instance GEnum CUSeconds where-  genum = genumNumWithBounds (fromIntegral (minBound :: HTYPE_USECONDS_T))-                             (fromIntegral (maxBound :: HTYPE_USECONDS_T))+  genum = coerce (genum :: [HTYPE_USECONDS_T]) #endif  instance GEnum CUShort where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_UNSIGNED_SHORT])  instance GEnum CWchar where-  genum = genumNumBounded+  genum = coerce (genum :: [HTYPE_WCHAR_T])  instance GEnum Double where   genum = genumNumUnbounded@@ -390,7 +397,7 @@   genum = genumDefault  instance GEnum Fd where-  genum = genumNumBounded+  genum = coerce (genum :: [CInt])  instance GEnum a => GEnum (Monoid.First a) where   genum = genumDefault@@ -412,25 +419,25 @@ #endif  instance GEnum Int where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum Int8 where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum Int16 where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum Int32 where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum Int64 where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum Integer where   genum = genumNumUnbounded  instance GEnum IntPtr where-  genum = genumNumBounded+  genum = genumNumSigned  instance GEnum c => GEnum (K1 i c p) where   genum = genumDefault@@ -461,7 +468,7 @@  #if MIN_VERSION_base(4,8,0) instance GEnum Natural where-  genum = [0..]+  genum = genumNumUnsigned #endif  #if MIN_VERSION_base(4,9,0)@@ -482,7 +489,13 @@   genum = genumDefault  #if MIN_VERSION_base(4,7,0)-instance GEnum (Proxy s) where+instance GEnum+# if MIN_VERSION_base(4,9,0)+               (Proxy s)+# else+               (Proxy (s :: *))+# endif+               where   genum = genumDefault #endif @@ -496,22 +509,22 @@   genum = genumDefault  instance GEnum Word where-  genum = genumNumBounded+  genum = genumNumUnsigned  instance GEnum Word8 where-  genum = genumNumBounded+  genum = genumNumUnsigned  instance GEnum Word16 where-  genum = genumNumBounded+  genum = genumNumUnsigned  instance GEnum Word32 where-  genum = genumNumBounded+  genum = genumNumUnsigned  instance GEnum Word64 where-  genum = genumNumBounded+  genum = genumNumUnsigned  instance GEnum WordPtr where-  genum = genumNumBounded+  genum = genumNumUnsigned  #if MIN_VERSION_base(4,9,0) instance GEnum m => GEnum (WrappedMonoid m) where@@ -983,7 +996,13 @@   inRange = inRangeDefault  #if MIN_VERSION_base(4,7,0)-instance GIx (Proxy s) where+instance GIx+# if MIN_VERSION_base(4,9,0)+             (Proxy s)+# else+             (Proxy (s :: *))+# endif+             where   range   = rangeDefault   index   = indexDefault   inRange = inRangeDefault

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -8,8 +9,13 @@  #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ #include "HsBaseConfig.h"  module Generics.Deriving.Eq (@@ -37,7 +43,6 @@ import           Foreign.StablePtr (StablePtr)  import           Generics.Deriving.Base-import           Generics.Deriving.Instances ()  import           GHC.Exts hiding (Any) @@ -481,7 +486,13 @@   geq = geqdefault  #if MIN_VERSION_base(4,7,0)-instance GEq (Proxy s) where+instance GEq+# if MIN_VERSION_base(4,9,0)+             (Proxy s)+# else+             (Proxy (s :: *))+# endif+             where   geq = geqdefault #endif 

@@ -3,10 +3,16 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+ #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ module Generics.Deriving.Foldable (   -- * Foldable class     GFoldable(..)@@ -43,7 +49,6 @@ #endif  import           Generics.Deriving.Base-import           Generics.Deriving.Instances ()  #if MIN_VERSION_base(4,4,0) import           Data.Complex (Complex)

@@ -3,10 +3,16 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+ #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ module Generics.Deriving.Functor (   -- * GFunctor class     GFunctor(..)@@ -22,7 +28,6 @@ import           Data.Monoid (Dual)  import           Generics.Deriving.Base-import           Generics.Deriving.Instances ()  #if MIN_VERSION_base(4,4,0) import           Data.Complex (Complex)

@@ -5,6 +5,17 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}++#if __GLASGOW_HASKELL__ >= 711+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif++#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Generics.Deriving.Instances (@@ -108,7 +119,7 @@  #if __GLASGOW_HASKELL__ < 711 import Data.Version (Version(..))-import Generics.Deriving.Base+import Generics.Deriving.Base.Internal import System.Exit (ExitCode(..)) #endif 

@@ -1,11 +1,17 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeOperators #-}  #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ -- | This module provides two main features: -- --     1. 'GMonoid', a generic version of the 'Monoid' type class, including instances@@ -56,7 +62,6 @@ import Control.Applicative import Data.Monoid import Generics.Deriving.Base-import Generics.Deriving.Instances ()  #if MIN_VERSION_base(4,7,0) import Data.Proxy (Proxy)@@ -185,6 +190,11 @@ 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@@ -203,7 +213,13 @@   gmappend = gmappenddefault  #if MIN_VERSION_base(4,7,0)-instance GMonoid (Proxy s) where+instance GMonoid+# if MIN_VERSION_base(4,9,0)+                 (Proxy s)+# else+                 (Proxy (s :: *))+# endif+                 where   gmempty  = memptydefault   gmappend = mappenddefault #endif

@@ -0,0 +1,206 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeOperators #-}++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-}+#endif++#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif++module Generics.Deriving.Semigroup (+  -- * Generic semigroup class+    GSemigroup(..)++  -- * Default definition+  , gsappenddefault++  ) 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,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 (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)++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)

@@ -8,6 +8,7 @@  #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Trustworthy #-} #endif  #if __GLASGOW_HASKELL__ < 709@@ -37,7 +38,6 @@ import           Foreign.Ptr  import           Generics.Deriving.Base-import           Generics.Deriving.Instances ()  import           GHC.Exts hiding (Any) 

@@ -3,10 +3,16 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+ #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Safe #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ module Generics.Deriving.Traversable (   -- * GTraversable class     GTraversable(..)@@ -27,7 +33,6 @@ import           Generics.Deriving.Base import           Generics.Deriving.Foldable import           Generics.Deriving.Functor-import           Generics.Deriving.Instances ()  #if MIN_VERSION_base(4,4,0) import           Data.Complex (Complex)

@@ -7,8 +7,13 @@  #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 705+{-# LANGUAGE PolyKinds #-}+#endif+ #if __GLASGOW_HASKELL__ < 709 {-# LANGUAGE OverlappingInstances #-} #endif@@ -51,7 +56,6 @@   import Generics.Deriving.Base-import Generics.Deriving.Instances ()  import Control.Monad (liftM, liftM2) import GHC.Exts (build)