packages feed

generic-data (empty) → 0.1.0.0

raw patch · 19 files changed

+1495/−0 lines, 19 filesdep +basedep +contravariantdep +generic-datasetup-changed

Dependencies added: base, contravariant, generic-data, show-combinators, tasty, tasty-hunit

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright Li-yao Xia (c) 2018++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the “Software”), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,51 @@+# Generic data types in Haskell [![Build Status](https://travis-ci.org/Lysxia/generic-data.svg)](https://travis-ci.org/Lysxia/generic-data)++Utilities for `GHC.Generics`.++## Generic deriving for standard classes++Supported classes that GHC currently can't derive: `Semigroup`, `Monoid`,+`Applicative`, `Alternative`, `Eq1`, `Ord1`, `Show1`.++Other classes from base are also supported, even though GHC can already derive+them:++- `Eq`, `Ord`, `Enum`, `Bounded`, `Show` (standard);+- `Functor`, `Foldable`, `Traversable` (via extensions, `DeriveFunctor`, etc.).++To derive type classes defined elsewhere, it might be worth taking a look at+[one-liner](https://hackage.haskell.org/package/one-liner).++## Type metadata++Extract type names, constructor names, number and arities of constructors, etc..++---++## Related links++generic-data aims to subsume the following packages, which may still be+useful for old versions of GHC and base not supported by generic-data.++- [semigroups](https://hackage.haskell.org/package/semigroups): generic+  `Semigroup`, `Monoid`.+- [transformers-compat](https://hackage.haskell.org/package/transformers-compat):+  generic `Eq1`, `Ord1`, `Show1`, `Read1`.+- [generic-deriving](https://hackage.haskell.org/package/generic-deriving):+  doesn't derive the classes in base (defines clones of these classes as a toy+  example); has Template Haskell code to derive `Generic`.++Here are other relevant links.++- [deriving-compat](https://hackage.haskell.org/package/deriving-compat):+  deriving with Template Haskell.+- [one-liner](https://hackage.haskell.org/package/one-liner): another approach+  to using `GHC.Generics` to derive instances of many type classes, including+  but not restricted to the above classes (this is done in+  [one-liner-instances](https://hackage.haskell.org/package/one-liner-instances)).+- [singletons](https://hackage.haskell.org/package/singletons):+  generic-data borrows code from this package to implement defunctionalization.++---++All contributions are welcome. Open an issue or a pull request on Github!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ generic-data.cabal view
@@ -0,0 +1,67 @@+name:                generic-data+version:             0.1.0.0+synopsis:            Utilities for GHC.Generics+description:         This package provides common functions on generic types.+                     See README.+homepage:            https://github.com/Lysxia/generic-data#readme+license:             MIT+license-file:        LICENSE+author:              Li-yao Xia+maintainer:          lysxia@gmail.com+copyright:           2018 Li-yao Xia+category:            Other+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10+tested-with:         GHC == 8.0.2, GHC == 8.2.2++library+  hs-source-dirs:      src+  exposed-modules:+    Generic.Data+    Generic.Data.Types+    Generic.Data.Internal.Compat+    Generic.Data.Internal.Data+    Generic.Data.Internal.Defun+    Generic.Data.Internal.Enum+    Generic.Data.Internal.Functions+    Generic.Data.Internal.Meta+    Generic.Data.Internal.Newtype+    Generic.Data.Internal.Prelude+    Generic.Data.Internal.Resolvers+    Generic.Data.Internal.Show+  build-depends:+    contravariant,+    show-combinators,+    base >= 4.9 && < 5+  hs-source-dirs:      orphans+  exposed-modules:+    Generic.Data.Orphans+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite unit-test+  hs-source-dirs: test+  main-is: unit.hs+  build-depends:+    tasty,+    tasty-hunit,+    generic-data,+    base+  ghc-options: -Wall+  default-language: Haskell2010+  type: exitcode-stdio-1.0++test-suite record-test+  hs-source-dirs: test+  main-is: record.hs+  build-depends:+    generic-data,+    base+  ghc-options: -Wall+  default-language: Haskell2010+  type: exitcode-stdio-1.0++source-repository head+  type:     git+  location: https://github.com/Lysxia/generic-data
+ orphans/Generic/Data/Orphans.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}++module Generic.Data.Orphans where++import Data.Functor.Classes+import Data.Semigroup+import GHC.Generics++instance Monoid c => Applicative (K1 i c) where+  pure _ = K1 mempty+  K1 a <*> K1 b = K1 (mempty a b)++instance Semigroup (V1 p) where+  v <> _ = v++instance Semigroup (U1 p) where+  _ <> _ = U1++instance Monoid (U1 p) where+  mempty = U1+  mappend = (<>)++deriving instance Semigroup c => Semigroup (K1 i c p)+deriving instance Monoid c => Monoid (K1 i c p)++deriving instance Semigroup (f p) => Semigroup (M1 i c f p)+deriving instance Monoid (f p) => Monoid (M1 i c f p)++instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where+  (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2)++instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where+  mempty = mempty :*: mempty+  mappend (x1 :*: y1) (x2 :*: y2) = mappend x1 x2 :*: mappend y1 y2++deriving instance Semigroup p => Semigroup (Par1 p)+deriving instance Monoid p => Monoid (Par1 p)++deriving instance Semigroup (f p) => Semigroup (Rec1 f p)+deriving instance Monoid (f p) => Monoid (Rec1 f p)++deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p)+deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p)++instance Eq1 V1 where+  liftEq _ v _ = case v of {}++instance Ord1 V1 where+  liftCompare _ v _ = case v of {}++instance Eq1 U1 where+  liftEq _ _ _ = True++instance Ord1 U1 where+  liftCompare _ _ _ = EQ++instance Eq c => Eq1 (K1 i c) where+  liftEq _ (K1 x1) (K1 x2) = x1 == x2++instance Ord c => Ord1 (K1 i c) where+  liftCompare _ (K1 x1) (K1 x2) = compare x1 x2++deriving instance Eq1 f => Eq1 (M1 i c f)+deriving instance Ord1 f => Ord1 (M1 i c f)++instance (Eq1 f, Eq1 g) => Eq1 (f :*: g) where+  liftEq (==.) (x1 :*: y1) (x2 :*: y2) = liftEq (==.) x1 x2 && liftEq (==.) y1 y2++instance (Ord1 f, Ord1 g) => Ord1 (f :*: g) where+  liftCompare compare' (x1 :*: y1) (x2 :*: y2) =+    liftCompare compare' x1 x2 <> liftCompare compare' y1 y2++instance (Eq1 f, Eq1 g) => Eq1 (f :+: g) where+  liftEq (==.) (L1 x1) (L1 x2) = liftEq (==.) x1 x2+  liftEq (==.) (R1 y1) (R1 y2) = liftEq (==.) y1 y2+  liftEq _ _ _ = False++instance (Ord1 f, Ord1 g) => Ord1 (f :+: g) where+  liftCompare compare' (L1 x1) (L1 x2) = liftCompare compare' x1 x2+  liftCompare compare' (R1 y1) (R1 y2) = liftCompare compare' y1 y2+  liftCompare _ (L1 _) (R1 _) = LT+  liftCompare _ (R1 _) (L1 _) = GT++instance Eq1 f => Eq1 (Rec1 f) where+  liftEq (==.) (Rec1 r1) (Rec1 r2) = liftEq (==.) r1 r2++instance Ord1 f => Ord1 (Rec1 f) where+  liftCompare compare' (Rec1 r1) (Rec1 r2) = liftCompare compare' r1 r2++instance Eq1 Par1 where+  liftEq (==.) (Par1 p1) (Par1 p2) = p1 ==. p2++instance Ord1 Par1 where+  liftCompare compare' (Par1 p1) (Par1 p2) = compare' p1 p2++instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where+  liftEq (==.) (Comp1 x1) (Comp1 x2) = (liftEq . liftEq) (==.) x1 x2++instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where+  liftCompare compare' (Comp1 x1) (Comp1 x2) =+    (liftCompare . liftCompare) compare' x1 x2
+ src/Generic/Data.hs view
@@ -0,0 +1,120 @@+-- | Generic combinators to derive type class instances.+--+-- /base/ classes that GHC can not derive instances for, as of version 8.2:+--+-- - 'Data.Semigroup.Semigroup', 'Monoid', 'Applicative',+--   'Control.Applicative.Alternative', 'Data.Functor.Classes.Eq1',+--   'Data.Functor.Classes.Ord1', 'Data.Functor.Classes.Show1'.+--+-- On /base/ < 4.12 (i.e., GHC < 8.6), import "Generic.Data.Orphans" to obtain+-- instances needed internally to derive those.+--+-- GHC can derive instances for other classes here, although there may be+-- types supported by one method but not the other or vice versa.++module Generic.Data+  ( -- * Regular classes++    -- ** 'Data.Semigroup.Semigroup'+    gmappend++    -- ** 'Monoid'+  , gmempty+  , gmappend'++    -- ** 'Eq'+    -- | Can also be derived by GHC as part of the standard.+  , geq++    -- ** 'Ord'+    -- | Can also be derived by GHC as part of the standard.+  , gcompare++    -- ** 'Show'+    -- | Can also be derived by GHC as part of the standard.+  , gshowsPrec+  , GShow0++    -- ** 'Enum'+    -- | Can also be derived by GHC as part of the standard.+  , gfromEnum+  , gtoEnum+  , GEnum()++    -- ** 'Bounded'+    -- | Can also be derived by GHC as part of the standard.+  , gminBound+  , gmaxBound+  , GBounded()++    -- * Higher-kinded classes++    -- ** 'Functor'+    -- | Can also be derived by GHC (`DeriveFunctor` extension).+  , gfmap+  , gconstmap++    -- ** 'Foldable'+    -- | Can also be derived by GHC (`DeriveFoldable` extension).+  , gfoldMap+  , gfoldr++    -- ** 'Traversable'+    -- | Can also be derived by GHC (`DeriveTraversable` extension).+  , gtraverse+  , gsequenceA++    -- ** 'Applicative'+  , gpure+  , gap+  , gliftA2++    -- ** 'Control.Applicative.Alternative'+  , gempty+  , galt++    -- ** 'Data.Functor.Classes.Eq1'+  , gliftEq++    -- ** 'Data.Functor.Classes.Ord1'+  , gliftCompare++    -- ** 'Data.Functor.Classes.Show1'+  , gliftShowsPrec+  , GShow1++    -- * Fields wrappers for deriving+  , Id1(..)+  , Opaque(..)+  , Opaque1(..)++    -- * Newtypes+  , Generically(..)+  , Generically1(..)++    -- * Accessing metadata++    -- | Using @TypeApplications@.++    -- ** Datatype+  , gdatatypeName+  , gmoduleName+  , gpackageName+  , gisNewtype+  , GDatatype++    -- ** Constructor+  , gconName+  , gconFixity+  , gconIsRecord+  , gconNum+  , Constructors+  , GConstructors+  ) where++import Generic.Data.Internal.Prelude+import Generic.Data.Internal.Enum+import Generic.Data.Internal.Meta+import Generic.Data.Internal.Show+import Generic.Data.Internal.Newtype+import Generic.Data.Internal.Resolvers
+ src/Generic/Data/Internal/Compat.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++module Generic.Data.Internal.Compat+  ( readPrec1+  ) where++import Data.Functor.Classes++#if !MIN_VERSION_base(4,10,0)+import Text.ParserCombinators.ReadPrec (ReadPrec, readS_to_Prec)+import Text.Read (Read(..))+#endif++#if !MIN_VERSION_base(4,10,0)+readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)+readPrec1 = readS_to_Prec $ liftReadsPrec readsPrec readList+#endif
+ src/Generic/Data/Internal/Data.hs view
@@ -0,0 +1,55 @@+-- | Generic representations as data types.++{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Generic.Data.Internal.Data where++import Control.Applicative+import Control.Monad+import Data.Functor.Classes+import Data.Functor.Contravariant (Contravariant, phantom)+import Data.Semigroup+import GHC.Generics++import Generic.Data.Internal.Enum+import Generic.Data.Internal.Show++-- | A wrapper to view a generic 'Rep' as the datatype it's supposed+-- to represent, without needing a declaration.+--+-- This can be used to derive types from generic types, and get some instances+-- for free, in particular 'Generic', 'Show', 'Enum', 'Bounded'.+newtype Data r p = Data { unData :: r p }+  deriving ( Functor, Foldable, Traversable, Applicative, Alternative+           , Monad, MonadPlus, Contravariant+           , Eq, Ord, Eq1, Ord1, Semigroup, Monoid )++instance (Functor r, Contravariant r) => Generic (Data r p) where+  type Rep (Data r p) = r+  to = Data . phantom+  from = phantom . unData++instance Generic1 (Data r) where+  type Rep1 (Data r) = r+  to1 = Data+  from1 = unData++instance (GShow1 r, Show p) => Show (Data r p) where+  showsPrec = flip (gLiftPrecShows showsPrec showList . unData)++instance GShow1 r => Show1 (Data r) where+  liftShowsPrec = (fmap . fmap) (flip . (. unData)) gLiftPrecShows++instance GEnum r => Enum (Data r p) where+  toEnum = Data . gToEnum+  fromEnum = gFromEnum . unData++instance GBounded r => Bounded (Data r p) where+  minBound = Data gMinBound+  maxBound = Data gMaxBound
+ src/Generic/Data/Internal/Defun.hs view
@@ -0,0 +1,38 @@+{- | Defunctionalization++See https://hackage.haskell.org/package/singletons-2.4.1/docs/src/Data-Singletons-Internal.html#TyFun++A copy of the defunctionalization implementation in the singletons package, to+not pull in too heavy dependencies.++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Generic.Data.Internal.Defun where++import Data.Kind++data TyFun :: Type -> Type -> Type++-- | Kind of function symbols+type a ~> b = TyFun a b -> Type+infixr 0 ~>++type family (f :: TyFun k1 k2 -> Type) @@ (x :: k1) :: k2+infixl 9 @@++-- | Type constructor function symbol+data TyCon :: (k1 -> k2) -> TyFun k1 k2 -> Type+type instance TyCon f @@ x = f x++-- | Identity function symbol+data Id :: TyFun k1 k2 -> Type+type instance Id @@ x = x++-- | Constant function symbol+data Const :: k2 -> TyFun k1 k2 -> Type+type instance Const t @@ x = t
+ src/Generic/Data/Internal/Enum.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}++module Generic.Data.Internal.Enum where++import GHC.Generics+import Data.Proxy++-- | Generic 'toEnum'.+--+-- @+-- instance 'Enum' MyType where+--   'toEnum' = 'gtoEnum'+--   'fromEnum' = 'gfromEnum'+-- @+gtoEnum :: forall a. (Generic a, GEnum (Rep a)) => Int -> a+gtoEnum n+  | 0 <= n && n < card = to (gToEnum n)+  | otherwise = error $+      "gtoEnum: out of bounds, index " ++ show n ++ ", card " ++ show card+  where+    card = gCardinality (Proxy :: Proxy (Rep a))++-- | Generic 'fromEnum'.+--+-- See also 'gtoEnum'.+gfromEnum :: (Generic a, GEnum (Rep a)) => a -> Int+gfromEnum = gFromEnum . from++-- | Generic 'minBound'.+--+-- @+-- instance 'Bounded' MyType where+--   'minBound' = 'gminBound'+--   'maxBound' = 'gmaxBound'+-- @+gminBound :: (Generic a, GBounded (Rep a)) => a+gminBound = to gMinBound++-- | Generic 'maxBound'.+--+-- See also 'gminBound'.+gmaxBound :: (Generic a, GBounded (Rep a)) => a+gmaxBound = to gMaxBound++-- | Generic representation of 'Enum' types.+class GEnum f where+  gCardinality :: proxy f -> Int+  gFromEnum :: f p -> Int+  gToEnum :: Int -> f p++instance GEnum f => GEnum (M1 i c f) where+  gCardinality _ = gCardinality (Proxy :: Proxy f)+  gFromEnum = gFromEnum . unM1+  gToEnum = M1 . gToEnum++instance (GEnum f, GEnum g) => GEnum (f :+: g) where+  gCardinality _ = gCardinality (Proxy :: Proxy f) + gCardinality (Proxy :: Proxy g)+  gFromEnum (L1 x) = gFromEnum x+  gFromEnum (R1 y) = cardF + gFromEnum y+    where+      cardF = gCardinality (Proxy :: Proxy f)+  gToEnum n+    | n < cardF = L1 (gToEnum n)+    | otherwise = R1 (gToEnum (n - cardF))+    where+      cardF = gCardinality (Proxy :: Proxy f)++instance GEnum U1 where+  gCardinality _ = 1+  gFromEnum U1 = 0+  gToEnum _ = U1++-- | Generic representation of 'Bounded' types.+class GBounded f where+  gMinBound :: f p+  gMaxBound :: f p++deriving instance GBounded f => GBounded (M1 i c f)++instance GBounded U1 where+  gMinBound = U1+  gMaxBound = U1++instance Bounded c => GBounded (K1 i c) where+  gMinBound = K1 minBound+  gMaxBound = K1 maxBound++instance (GBounded f, GBounded g) => GBounded (f :+: g) where+  gMinBound = L1 gMinBound+  gMaxBound = R1 gMaxBound++instance (GBounded f, GBounded g) => GBounded (f :*: g) where+  gMinBound = gMinBound :*: gMinBound+  gMaxBound = gMaxBound :*: gMaxBound
+ src/Generic/Data/Internal/Functions.hs view
@@ -0,0 +1,47 @@+-- | Type level functions on generic representations.++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Generic.Data.Internal.Functions where++import Data.Kind+import Data.Proxy+import GHC.Generics+import GHC.TypeLits++import Generic.Data.Internal.Defun++-- | Apply a type function on every field of a type.+type family   Map (s :: TyFun a b -> Type) (r :: k -> Type) :: k -> Type+type instance Map s (M1 i c f) = M1 i c (Map s f)+type instance Map s (f :+: g)  = Map s f :+: Map s g+type instance Map s (f :*: g)  = Map s f :*: Map s g+type instance Map s (K1 i c)   = K1 i (s @@ c)+type instance Map s U1 = U1+type instance Map s V1 = V1++-- | Number of constructors of a data type.+type family   NConstructors (r :: k -> Type) :: Nat+type instance NConstructors (M1 D c f) = NConstructors f+type instance NConstructors (f :+: g)  = NConstructors f + NConstructors g+type instance NConstructors (M1 C c f) = 1++nconstructors :: forall r. KnownNat (NConstructors r) => Integer+nconstructors = natVal @(NConstructors r) Proxy++-- | Arity of a constructor.+type family   NFields (r :: k -> Type) :: Nat+type instance NFields (M1 C c f) = NFields f+type instance NFields (f :*: g)  = NFields f + NFields g+type instance NFields (M1 S c f) = 1++nfields :: forall r. KnownNat (NFields r) => Integer+nfields = natVal @(NFields r) Proxy
+ src/Generic/Data/Internal/Meta.hs view
@@ -0,0 +1,182 @@+-- | Type metadata accessors+--+-- Type names, constructor names...++{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}++{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Generic.Data.Internal.Meta where++import Data.Proxy+import GHC.Generics++-- | Name of the first data constructor in a type as a string.+--+-- @+-- 'gdatatypeName' @('Maybe' AnyType) = \"Maybe\"+-- @+gdatatypeName :: forall a. (Generic a, GDatatype (Rep a)) => String+gdatatypeName = gDatatypeName @(Rep a)++-- | Name of the module where the first type constructor is defined.+--+-- @+-- 'gmoduleName' @('Maybe' AnyType) = \"GHC.Base\"+-- @+gmoduleName :: forall a. (Generic a, GDatatype (Rep a)) => String+gmoduleName = gModuleName @(Rep a)++-- | Name of the package where the first type constructor is defined.+--+-- @+-- 'gpackageName' @('Maybe' AnyType) = \"base\"+-- @+gpackageName :: forall a. (Generic a, GDatatype (Rep a)) => String+gpackageName = gPackageName @(Rep a)++-- | 'True' if the first type constructor is a newtype.+gisNewtype :: forall a. (Generic a, GDatatype (Rep a)) => Bool+gisNewtype = gIsNewtype @(Rep a)++fromDatatype :: forall d r. Datatype d => (M1 D d Proxy () -> r) -> r+fromDatatype f = f (M1 Proxy :: M1 D d Proxy ())++-- | Generic representations that contain datatype metadata.+class GDatatype f where+  gDatatypeName :: String+  gModuleName :: String+  gPackageName :: String+  gIsNewtype :: Bool++instance Datatype d => GDatatype (M1 D d f) where+  gDatatypeName = fromDatatype @d datatypeName+  gModuleName = fromDatatype @d moduleName+  gPackageName = fromDatatype @d packageName+  gIsNewtype = fromDatatype @d isNewtype++-- | Name of the first constructor in a value.+--+-- @+-- 'gconName' ('Just' 0) = \"Just\"+-- @+gconName :: forall a. Constructors a => a -> String+gconName = conIdToString . conId++-- | The fixity of the first constructor.+--+-- @+-- 'gconFixity' ('Just' 0) = 'Prefix'+-- 'gconFixity' ([] :*: id) = 'Infix' 'RightAssociative' 6+-- @+gconFixity :: forall a. Constructors a => a -> Fixity+gconFixity = gConFixity . from++-- | 'True' if the constructor is a record.+--+-- @+-- 'gconIsRecord' ('Just' 0) = 'False'+-- 'gconIsRecord' ('Data.Monoid.Sum' 0) = 'True'+-- -- newtype 'Data.Monoid.Sum' a = Sum { getSum :: a }+-- @+gconIsRecord :: forall a. Constructors a => a -> Bool+gconIsRecord = gConIsRecord . from++-- | Number of constructors.+--+-- @+-- 'gconNum' @('Maybe' AnyType) = 2+-- @+gconNum :: forall a. Constructors a => Int+gconNum = gConNum @(Rep a)++-- | An opaque identifier for a constructor.+newtype ConId a = ConId Int+  deriving (Eq, Ord)++conIdToInt :: forall a. ConId a -> Int+conIdToInt (ConId i) = i++conIdEnum :: forall a. Constructors a => [ConId a]+conIdEnum = fmap ConId [0 .. n]+  where+    ConId n = conIdMax @a++conIdToString :: forall a. Constructors a => ConId a -> String+conIdToString = gConIdToString . fromConId++conId :: forall a. Constructors a => a -> ConId a+conId = toConId . gConId . from++conIdMax :: forall a. Constructors a => ConId a+conIdMax = toConId gConIdMax++-- | Constraint synonym for 'Generic' and 'GConstructor'.+class (Generic a, GConstructors (Rep a)) => Constructors a+instance (Generic a, GConstructors (Rep a)) => Constructors a++newtype GConId r = GConId Int+  deriving (Eq, Ord)++gConIdToInt :: GConId r -> Int+gConIdToInt (GConId i) = i++toConId :: forall a. Generic a => GConId (Rep a) -> ConId a+toConId (GConId i) = ConId i++fromConId :: forall a. Generic a => ConId a -> GConId (Rep a)+fromConId (ConId i) = GConId i++reGConId :: GConId r -> GConId s+reGConId (GConId i) = GConId i++gConIdMax :: forall r. GConstructors r => GConId r+gConIdMax = GConId (gConNum @r - 1)++-- | Generic representations that contain constructor metadata.+class GConstructors r where+  gConIdToString :: GConId r -> String+  gConId :: r p -> GConId r+  gConNum :: Int+  gConFixity :: r p -> Fixity+  gConIsRecord :: r p -> Bool++instance GConstructors f => GConstructors (M1 D c f) where+  gConIdToString = gConIdToString @f . reGConId+  gConId = reGConId . gConId . unM1+  gConNum = gConNum @f+  gConFixity = gConFixity . unM1+  gConIsRecord = gConIsRecord . unM1++instance (GConstructors f, GConstructors g) => GConstructors (f :+: g) where+  gConIdToString (GConId i) =+    if i < nf then+      gConIdToString @f (GConId i)+    else+      gConIdToString @g (GConId (i - nf - 1))+    where+      GConId nf = gConIdMax @f+  gConId (L1 x) = reGConId (gConId x)+  gConId (R1 y) = let GConId i = gConId y in GConId (nf + 1 + i)+    where+      GConId nf = gConIdMax @f+  gConNum = gConNum @f + gConNum @g+  gConFixity (L1 x) = gConFixity x+  gConFixity (R1 y) = gConFixity y+  gConIsRecord (L1 x) = gConIsRecord x+  gConIsRecord (R1 y) = gConIsRecord y++instance Constructor c => GConstructors (M1 C c f) where+  gConIdToString _ = conName (M1 Proxy :: M1 C c Proxy ())+  gConId _ = GConId 0+  gConNum = 1+  gConFixity = conFixity+  gConIsRecord = conIsRecord
+ src/Generic/Data/Internal/Newtype.hs view
@@ -0,0 +1,103 @@+-- | Newtypes with instances implemented using generic combinators.++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Generic.Data.Internal.Newtype where++import Control.Applicative+import Data.Functor.Classes+import Data.Semigroup+import GHC.Generics++import Generic.Data.Internal.Prelude+import Generic.Data.Internal.Enum+import Generic.Data.Internal.Show++-- | Type with instances derived via 'Generic'.+newtype Generically a = Generically { unGenerically :: a }++instance Generic a => Generic (Generically a) where+  type Rep (Generically a) = Rep a+  to = Generically . to+  from = from . unGenerically++instance (Generic a, Eq (Rep a ())) => Eq (Generically a) where+  (==) = geq++instance (Generic a, Ord (Rep a ())) => Ord (Generically a) where+  compare = gcompare++instance (Generic a, GShow0 (Rep a)) => Show (Generically a) where+  showsPrec = gshowsPrec++instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where+  (<>) = gmappend++instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where+  mempty = gmempty+  mappend = gmappend'++instance (Generic a, GEnum (Rep a)) => Enum (Generically a) where+  fromEnum = gfromEnum+  toEnum = gtoEnum++instance (Generic a, GBounded (Rep a)) => Bounded (Generically a) where+  minBound = gminBound+  maxBound = gmaxBound++-- | Type with instances derived via 'Generic1'.+newtype Generically1 f a = Generically1 { unGenerically1 :: f a }++instance Generic (f a) => Generic (Generically1 f a) where+  type Rep (Generically1 f a) = Rep (f a)+  to = Generically1 . to+  from = from . unGenerically1++instance Generic1 f => Generic1 (Generically1 f) where+  type Rep1 (Generically1 f) = Rep1 f+  to1 = Generically1 . to1+  from1 = from1 . unGenerically1++instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where+  liftEq = gliftEq++instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where+  (==) = eq1++instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where+  liftCompare = gliftCompare++instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where+  compare = compare1++instance (Generic1 f, GShow1 (Rep1 f)) => Show1 (Generically1 f) where+  liftShowsPrec = gliftShowsPrec++instance (Generic1 f, GShow1 (Rep1 f), Show a) => Show (Generically1 f a) where+  showsPrec = showsPrec1++instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where+  fmap = gfmap+  (<$) = gconstmap++instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where+  pure = gpure+  (<*>) = gap+#if MIN_VERSION_base(4,10,0)+  liftA2 = gliftA2+#endif++instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where+  empty = gempty+  (<|>) = galt++instance (Generic1 f, Foldable (Rep1 f)) => Foldable (Generically1 f) where+  foldMap = gfoldMap+  foldr = gfoldr++instance (Generic1 f, Traversable (Rep1 f)) => Traversable (Generically1 f) where+  traverse = gtraverse+  sequenceA = gsequenceA
+ src/Generic/Data/Internal/Prelude.hs view
@@ -0,0 +1,200 @@+-- | Generic deriving for standard classes in base++{-# LANGUAGE FlexibleContexts #-}++module Generic.Data.Internal.Prelude where++import Control.Applicative (liftA2, Alternative(..))+import Data.Function (on)+import Data.Functor.Classes+import Data.Semigroup+import GHC.Generics++-- * 'Eq'++-- | Generic @('==')@.+--+-- @+-- instance 'Eq' MyType where+--   ('==') = 'geq'+-- @+geq :: (Generic a, Eq (Rep a ())) => a -> a -> Bool+geq = (==) `on` from'++-- * 'Ord'++-- | Generic 'compare'.+--+-- @+-- instance 'Ord' MyType where+--   'compare' = 'gcompare'+-- @+gcompare :: (Generic a, Ord (Rep a ())) => a -> a -> Ordering+gcompare = compare `on` from'++-- * 'Semigroup'++-- | Generic @('<>')@ (or 'mappend').+--+-- @+-- instance 'Semigroup' MyType where+--   ('<>') = 'gmappend'+-- @+--+-- See also 'gmempty'.+gmappend :: (Generic a, Semigroup (Rep a ())) => a -> a -> a+gmappend = \a b -> to (from' a <> from' b)++-- * 'Monoid'++-- | Generic 'mempty'.+--+-- @+-- instance 'Monoid' MyType where+--   'mempty' = 'gmempty'+-- @+gmempty :: (Generic a, Monoid (Rep a ())) => a+gmempty = to' mempty++-- | Generic @('<>')@ (or @'mappend'@).+--+-- The difference from `gmappend' is the 'Monoid' constraint instead of+-- 'Semigroup', for older versions of base where 'Semigroup' is not a+-- superclass of 'Monoid'.+gmappend' :: (Generic a, Monoid (Rep a ())) => a -> a -> a+gmappend' = \a b -> to (from' a `mappend` from' b)++-- * 'Functor'++-- | Generic 'fmap'.+--+-- @+-- instance 'Functor' MyTypeF where+--   'fmap' = 'gfmap'+-- @+gfmap :: (Generic1 f, Functor (Rep1 f)) => (a -> b) -> f a -> f b+gfmap = \f -> to1 . fmap f . from1++-- | Generic @('<$')@.+--+-- See also 'gfmap'.+gconstmap :: (Generic1 f, Functor (Rep1 f)) => a -> f b -> f a+gconstmap = \a -> to1 . (a <$) . from1++-- * 'Applicative'++-- | Generic 'pure'.+--+-- @+-- instance 'Applicative' MyTypeF where+--   'pure' = 'gpure'+--   ('<*>') = 'gap'+-- @+gpure :: (Generic1 f, Applicative (Rep1 f)) => a -> f a+gpure = to1 . pure++-- | Generic @('<*>')@ (or 'Control.Monad.ap').+--+-- See also 'gpure'.+gap :: (Generic1 f, Applicative (Rep1 f)) => f (a -> b) -> f a -> f b+gap = liftG2 (<*>)++-- | Generic 'liftA2'.+--+-- See also 'gpure'.+gliftA2 :: (Generic1 f, Applicative (Rep1 f)) => (a -> b -> c) -> f a -> f b -> f c+gliftA2 = liftG2 . liftA2++-- * 'Alternative'++-- | Generic 'empty'.+--+-- @+-- instance 'Alternative' MyTypeF where+--   'empty' = 'gempty'+--   ('<|>') = 'galt'+-- @+gempty :: (Generic1 f, Alternative (Rep1 f)) => f a+gempty = to1 empty++-- | Generic ('<|>').+--+-- See also 'gempty'.+galt :: (Generic1 f, Alternative (Rep1 f)) => f a -> f a -> f a+galt = liftG2 (<|>)++-- * 'Foldable'++-- | Generic 'foldMap'.+--+-- @+-- instance 'Foldable' MyTypeF where+--   'foldMap' = 'gfoldMap'+-- @+gfoldMap :: (Generic1 f, Foldable (Rep1 f), Monoid m) => (a -> m) -> f a -> m+gfoldMap = \f -> foldMap f . from1++-- | Generic 'foldr'.+--+-- @+-- instance 'Foldable' MyTypeF where+--   'foldr' = 'gfoldr'+-- @+--+-- See also 'gfoldMap'.+gfoldr :: (Generic1 f, Foldable (Rep1 f)) => (a -> b -> b) -> b -> f a -> b+gfoldr = \f b -> foldr f b . from1++-- * 'Traversable'++-- | Generic 'traverse'.+--+-- @+-- instance 'Traversable' MyTypeF where+--   'traverse' = 'gtraverse'+-- @+gtraverse+  :: (Generic1 f, Traversable (Rep1 f), Applicative m)+  => (a -> m b) -> f a -> m (f b)+gtraverse = \f -> fmap to1 . traverse f . from1++-- | Generic 'sequenceA'.+--+-- @+-- instance 'Traversable' MyTypeF where+--   'sequenceA' = 'gsequenceA'+-- @+--+-- See also 'gtraverse'.+gsequenceA+  :: (Generic1 f, Traversable (Rep1 f), Applicative m)+  => f (m a) -> m (f a)+gsequenceA = fmap to1 . sequenceA . from1++-- * 'Eq1'++-- | Generic 'liftEq'.+gliftEq :: (Generic1 f, Eq1 (Rep1 f)) => (a -> b -> Bool) -> f a -> f b -> Bool+gliftEq = \(==.) a b -> liftEq (==.) (from1 a) (from1 b)++-- * 'Ord1'++-- | Generic 'liftCompare'.+gliftCompare+  :: (Generic1 f, Ord1 (Rep1 f))+  => (a -> b -> Ordering) -> f a -> f b -> Ordering+gliftCompare = \compare' a b -> liftCompare compare' (from1 a) (from1 b)++-- * Utils++-- | A helper for better type inference.+from' :: Generic a => a -> Rep a ()+from' = from++-- | A helper for better type inference.+to' :: Generic a => Rep a () -> a+to' = to++-- | Lift binary combinators generically.+liftG2 :: Generic1 f => (Rep1 f a -> Rep1 f b -> Rep1 f c) -> f a -> f b -> f c+liftG2 = \(<?>) a b -> to1 (from1 a <?> from1 b)
+ src/Generic/Data/Internal/Resolvers.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Generic.Data.Internal.Resolvers where++import Data.Bifunctor (first)+import Data.Functor.Classes+import Data.Function (on)+import Text.Read (Read(..))++import Generic.Data.Internal.Compat(readPrec1)++-- | A newtype whose instances for simple classes ('Eq', 'Ord', 'Read', 'Show')+-- use higher-kinded class instances for @f@ (`Eq1`, `Ord1`, `Read1`, `Show1`).+newtype Id1 f a = Id1 { unId1 :: f a }+  deriving (Eq1, Ord1, Read1, Show1)++instance (Eq1 f, Eq a) => Eq (Id1 f a) where+  (==) = eq1 `on` unId1++instance (Ord1 f, Ord a) => Ord (Id1 f a) where+  compare = compare1 `on` unId1++instance (Read1 f, Read a) => Read (Id1 f a) where+  readsPrec = (fmap . fmap . fmap . first) Id1 readsPrec1+  readPrec = fmap Id1 readPrec1++instance (Show1 f, Show a) => Show (Id1 f a) where+  showsPrec d = showsPrec1 d . unId1++-- | A newtype with trivial instances, that considers+-- every value equivalent to every other one,+-- and shows as just @"_"@.+newtype Opaque a = Opaque { unOpaque :: a }++-- | All equal.+instance Eq (Opaque a) where+  (==) _ _ = True++-- | All equal.+instance Ord (Opaque a) where+  compare _ _ = EQ++-- | Shown as @"_"@.+instance Show (Opaque a) where+  showsPrec _ _ = showString "_"++-- | All equal.+instance Eq1 Opaque where+  liftEq _ _ _ = True++-- | All equal.+instance Ord1 Opaque where+  liftCompare _ _ _ = EQ++-- | Shown as @"_"@.+instance Show1 Opaque where+  liftShowsPrec _ _ _ _ = showString "_"++-- | A higher-kinded version of 'Opaque'.+newtype Opaque1 f a = Opaque1 { unOpaque1 :: f a }++-- | All equal.+instance Eq (Opaque1 f a) where+  (==) _ _ = True++-- | All equal.+instance Ord (Opaque1 f a) where+  compare _ _ = EQ++-- | Shown as @"_"@.+instance Show (Opaque1 f a) where+  showsPrec _ _ = showString "_"++-- | All equal.+instance Eq1 (Opaque1 f) where+  liftEq _ _ _ = True++-- | All equal.+instance Ord1 (Opaque1 f) where+  liftCompare _ _ _ = EQ++-- | Shown as @"_"@.+instance Show1 (Opaque1 f) where+  liftShowsPrec _ _ _ _ = showString "_"
+ src/Generic/Data/Internal/Show.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE Safe #-}++module Generic.Data.Internal.Show where++import Data.Foldable (foldl')+import Data.Functor.Classes (Show1(..))+import Data.Functor.Identity+import Data.Proxy+import GHC.Generics+import Text.Show.Combinators++-- | Generic 'showsPrec'.+--+-- @+-- instance 'Show' MyType where+--   'showsPrec' = 'gshowsPrec'+-- @+gshowsPrec :: (Generic a, GShow0 (Rep a)) => Int -> a -> ShowS+gshowsPrec = flip gprecShows++gprecShows :: (Generic a, GShow0 (Rep a)) => a -> PrecShowS+gprecShows = gPrecShows Proxy . from++-- | Generic representation of 'Show' types.+type GShow0 = GShow Proxy++gliftShowsPrec+  :: (Generic1 f, GShow1 (Rep1 f))+  => (Int -> a -> ShowS) -> ([a] -> ShowS)+  -> Int -> f a -> ShowS+gliftShowsPrec showsPrec' showList' =+  flip (gLiftPrecShows showsPrec' showList' . from1)++gLiftPrecShows+  :: GShow1 f+  => (Int -> a -> ShowS) -> ([a] -> ShowS)+  -> f a -> PrecShowS+gLiftPrecShows = curry (gPrecShows . Identity)++type ShowsPrec a = (Int -> a -> ShowS, [a] -> ShowS)++-- | Generic representation of 'Data.Functor.Classes.Show1' types.+type GShow1 = GShow Identity++class GShow p f where+  gPrecShows :: p (ShowsPrec a) -> f a -> PrecShowS++instance GShow p f => GShow p (M1 D d f) where+  gPrecShows p (M1 x) = gPrecShows p x++instance (GShow p f, GShow p g) => GShow p (f :+: g) where+  gPrecShows p (L1 x) = gPrecShows p x+  gPrecShows p (R1 y) = gPrecShows p y++instance (Constructor c, GShowC p c f) => GShow p (M1 C c f) where+  gPrecShows p x = gPrecShowsC p (conName x) (conFixity x) x++instance GShow p V1 where+  gPrecShows _ v = case v of {}++class GShowC p c f where+  gPrecShowsC :: p (ShowsPrec a) -> String -> Fixity -> M1 C c f a -> PrecShowS++instance GShowFields p f => GShowC p ('MetaCons s y 'False) f where+  gPrecShowsC p name fixity (M1 x)+    | Infix _ fy <- fixity, k1 : k2 : ks <- fields =+      foldl' showApp (showInfix name fy k1 k2) ks+    | otherwise = foldl' showApp (showCon cname) fields+    where+      cname = case fixity of+        Prefix -> name+        Infix _ _ -> "(" ++ name ++ ")"+      fields = gPrecShowsFields p x++instance GShowNamed p f => GShowC p ('MetaCons s y 'True) f where+  gPrecShowsC p name fixity (M1 x) = showRecord cname fields+    where+      cname = case fixity of+        Prefix -> name+        Infix _ _ -> "(" ++ name ++ ")"+      fields = gPrecShowsNamed p x++class GShowFields p f where+  gPrecShowsFields :: p (ShowsPrec a) -> f a -> [PrecShowS]++instance (GShowFields p f, GShowFields p g) => GShowFields p (f :*: g) where+  gPrecShowsFields p (x :*: y) = gPrecShowsFields p x ++ gPrecShowsFields p y++instance GShowSingle p f => GShowFields p (M1 S c f) where+  gPrecShowsFields p (M1 x) = [gPrecShowsSingle p x]++instance GShowFields p U1 where+  gPrecShowsFields _ U1 = []++class GShowNamed p f where+  gPrecShowsNamed :: p (ShowsPrec a) -> f a -> ShowFields++instance (GShowNamed p f, GShowNamed p g) => GShowNamed p (f :*: g) where+  gPrecShowsNamed p (x :*: y) = gPrecShowsNamed p x &| gPrecShowsNamed p y++instance (Selector c, GShowSingle p f) => GShowNamed p (M1 S c f) where+  gPrecShowsNamed p x'@(M1 x) = selName x' `showField` gPrecShowsSingle p x++instance GShowNamed p U1 where+  gPrecShowsNamed _ U1 = noFields++class GShowSingle p f where+  gPrecShowsSingle :: p (ShowsPrec a) -> f a -> PrecShowS++instance Show a => GShowSingle p (K1 i a) where+  gPrecShowsSingle _ (K1 x) = flip showsPrec x++instance Show1 f => GShowSingle Identity (Rec1 f) where+  gPrecShowsSingle (Identity sp) (Rec1 r) =+    flip (uncurry liftShowsPrec sp) r++instance GShowSingle Identity Par1 where+  gPrecShowsSingle (Identity (showsPrec', _)) (Par1 a) = flip showsPrec' a++instance (GShowSingle Identity f, GShowSingle p g)+  => GShowSingle p (f :.: g) where+  gPrecShowsSingle p (Comp1 c) =+    gPrecShowsSingle (Identity (showsPrec_, showList_)) c+    where+      showsPrec_ = flip (gPrecShowsSingle p)+      showList_ = showListWith (showsPrec_ 0)
+ src/Generic/Data/Types.hs view
@@ -0,0 +1,20 @@+-- | Utilities to derive and transform generic types.++{-# LANGUAGE TypeOperators #-}++module Generic.Data.Types+  ( Data(..)+  , Map++    -- * Defunctionalization+  , TyFun+  , type (~>)+  , type (@@)+  , Id+  , TyCon+  , Const+  ) where++import Generic.Data.Internal.Data+import Generic.Data.Internal.Defun+import Generic.Data.Internal.Functions
+ test/record.hs view
@@ -0,0 +1,41 @@+-- Deriving instances for a "functor-functor"-style record.+-- (https://www.benjamin.pizza/posts/2017-12-15-functor-functors.html)++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++import Control.Applicative (Alternative)+import Data.Coerce+import Data.Functor.Classes+import Data.Semigroup+import Data.Monoid (Alt(..))+import GHC.Generics (Generic)++import Generic.Data+import Generic.Data.Orphans ()++data MyRecord f = MyRecord+  { _field1 :: f Int+  , _field2 :: f Bool+  } deriving Generic++instance Show1 f => Show (MyRecord f) where+  showsPrec = coerce (gshowsPrec @(MyRecord (Id1 f)))++instance Eq1 f => Eq (MyRecord f) where+  (==) = coerce (geq @(MyRecord (Id1 f)))++instance Ord1 f => Ord (MyRecord f) where+  compare = coerce (gcompare @(MyRecord (Id1 f)))++instance Alternative f => Semigroup (MyRecord f) where+  (<>) = coerce (gmappend @(MyRecord (Alt f)))++instance Alternative f => Monoid (MyRecord f) where+  mempty = coerce (gmempty @(MyRecord (Alt f)))+  mappend = (<>)++main :: IO ()+main = return () -- Just make this compile
+ test/unit.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++import Control.Applicative+import Data.Semigroup+import Data.Monoid (Sum(..))+import Test.Tasty+import Test.Tasty.HUnit++import GHC.Generics+import Generic.Data+import Generic.Data.Orphans ()++data P a = P a a+  deriving (Generic, Generic1)++type PTy a = a -> a -> Generically (P a)++p :: PTy a+p a b = Generically (P a b)++p' :: PTy Int+p' = p++pl :: PTy [Int]+pl = p++data P1 f a = P1 (f a) (f a)+  deriving Generic1++type PTy1 a = [a] -> [a] -> Generically1 (P1 []) a++p1 :: PTy1 a+p1 a b = Generically1 (P1 a b)++p1' :: PTy1 Int+p1' = p1++pl1 :: PTy1 [Int]+pl1 = p1++data E = E0 | E1 | E2+  deriving (Eq, Show, Generic)++main :: IO ()+main = defaultMain test++test :: TestTree+test = testGroup "unit"+  [ testGroup "Eq"+      [ testCase "(==)" $ p' 1 2 @?= p' 1 2+      , testCase "(/=)" $ False @?= (p' 1 2 == p' 1 1)+      ]+  , testGroup "Ord"+      [ testCase "compare" $ LT @?= compare (p' 1 2) (p' 2 1)+      , testCase "(<=)" $ True @?= (p' 1 1 <= p' 1 1)+      ]+  , testGroup "Semigroup"+      [ testCase "(<>)" $ pl [1, 5] [2, 3] @?= (pl [1] [2] <> pl [5] [3])+      ]+  , testGroup "Monoid"+      [ testCase "mempty" $ pl [] [] @?= mempty+      ]+  , testGroup "Functor"+      [ testCase "fmap" $ p1' [1] [2] @?= fmap (+ 1) (p1 [0] [1])+      ]+  , testGroup "Applicative"+      [ testCase "pure" $ p1' [3] [3] @?= pure 3+      , testCase "ap" $ p1' [1, 3] [2] @?= (p1 [id, (+2)] [(+2)] <*> p1 [1] [0])+      ]+  , testGroup "Alternative"+      [ testCase "empty" $ p1' [] [] @?= empty+      , testCase "(<|>)" $ p1' [1, 5] [2, 3] @?= (p1 [1] [2] <|> p1 [5] [3])+      ]+  , testGroup "Foldable"+      [ testCase "foldMap" $ Sum 3 @?= foldMap Sum (p1' [1] [2])+      , testCase "foldr" $ 3 @?= foldr (+) 0 (p1' [1] [2])+      ]+  , testGroup "Traversable"+      [ testCase "traverse" $+          [p1 [1] [2], p1 [1] [3], p1 [2] [2], p1 [2] [3]] @?=+            traverse (\y -> [y, y+1]) (p1' [1] [2])+      , testCase "sequenceA" $+          [p1 [1] [2], p1 [2] [2]] @?= sequenceA (pl1 [[1, 2]] [[2]])+      ]+  , testGroup "Bounded"+      [ testCase "minBound @E" $ E0 @?= gminBound+      , testCase "maxBound @E" $ E2 @?= gmaxBound+      , testCase "minBound @(P Int)" $ p' minBound minBound @?= gminBound+      , testCase "maxBound @(P Int)" $ p' maxBound maxBound @?= gmaxBound+      ]+  , testGroup "Enum"+      [ testCase "toEnum" $ [E0, E1, E2] @?= fmap gtoEnum [0, 1, 2]+      , testCase "fromEnum" $ [0, 1, 2] @?= fmap gfromEnum [E0, E1, E2]+      ]+  , testGroup "Show"+      [ testCase "show" $ "P 1 2" @?= show (p' 1 2)+      , testCase "showsPrec" $ "(P 1 2)" @?= showsPrec 11 (p' 1 2) ""+      ]++  , testGroup "Meta"+      [ testCase "datatypeName" $ "Maybe" @?= gdatatypeName @(Maybe Int)+      , testCase "moduleName" $ "GHC.Base" @?= gmoduleName @(Maybe Int)+      , testCase "packageName" $ "base" @?= gpackageName @(Maybe Int)+      , testCase "isNewtype" $ False @?= gisNewtype @(Maybe Int)+      , testCase "conName" $ "Just" @?= gconName (Just ())+      , testCase "conFixity" $ Prefix @?= gconFixity (Just ())+      , testCase "conIsRecord" $ False @?= gconIsRecord (Just ())+      , testCase "conNum" $ 2 @?= gconNum @(Maybe Int)+      ]+  ]