generic-arbitrary 0.2.2 → 1.0.0

raw patch · 10 files changed

+771/−44 lines, 10 filesdep +deepseqdep +generic-arbitrarydep +tastydep ~QuickCheckdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, generic-arbitrary, tasty, tasty-discover, tasty-hunit, tasty-quickcheck

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +140/−0
• generic-arbitrary.cabal +75/−9
• src/Test/QuickCheck/Arbitrary/Generic.hs +307/−35
• test/Auxiliary.hs +10/−0
• test/LimitationDemo.hs +37/−0
• test/NoTypecheckTest.hs +23/−0
• test/ParametersTest.hs +34/−0
• test/RecursiveTest.hs +137/−0
• test/Test.hs +1/−0

@@ -1,3 +1,10 @@+1.0.0+-----++* Fixed issue with too big terms in case of recursive types+* Recpect the `size` argument+* Types with parameters require `Arg` now+ 0.2.2 ----- 

@@ -0,0 +1,140 @@+# generic-arbitrary++[![Haskell-CI](https://github.com/typeable/generic-arbitrary/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/typeable/generic-arbitrary/actions/workflows/haskell-ci.yml)++# What?++Package for deriving `Arbitrary` via `Generic`.++``` haskell+import           GHC.Generics                      (Generic)+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary.Generic++data Expr+  = Lit Int+  | Add Expr Expr+  | Mul Expr Expr+  deriving (Eq, Show, Generic)+  deriving Arbitrary via (GenericArbitrary Expr)+```++Older versions of this package had a problem with hanging `arbitrary`+method. Since `1.0.0` this problem almost solved.++For `QuickCheck` older than `2.14.0` the `GenericArbitrary` is not available, so+you will need to write instances more verbosely++``` haskell+data Expr+  = Lit Int+  | Add Expr Expr+  | Mul Expr Expr+  deriving (Eq, Show, Generic)++instance Arbitrary Expr where+  arbitrary = genericArbitrary+  shrink = genericShrink+```++Which is generally the same.++# Infinite terms problem++The `generic-arbitrary` can partially handle the problem with recursive+types. Assume the type `R`++``` haskell+data R = R R+  deriving Generic+```++there is no instance++``` haskell+instance Arbitrary R where+  arbitrary = genericArbitrary+  shrink = genericShrink+```++If you try to compile this you will get a type level error++>    • R refers to itself in all constructors++Which means that there is no finite term for `R` because it is recursive in all+it's constructors. But, if you correct the definition of `R` like this.++``` haskell+data R = R R | F+  deriving Generic+```++Then it will compile. And the `arbitrary` generated will not hang forever,+because it respects the `size` parameter.++## Limitation++There is a limitation of recursion detection:++``` haskell+data R1 = R1 R2+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+  deriving Arbitrary via (GenericArbitrary R1)++data R2 = R2 R1+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+  deriving Arbitrary via (GenericArbitrary R2)+```++This code will compile and the `arbitrary` generated will always hang. Yes,+there is a problem with mutually recursive types.++# Type parameters++Now let's see an example of datatype with parameters++``` haskell+data A a = A a+  deriving (Eq, Ord, Show)+  deriving anyclass NFData+  deriving (Generic)++instance (Arbitrary a) => Arbitrary (A a) where+  arbitrary = genericArbitrary+  shrink = genericShrink+```++It should work from first glance, but when compile it will throw an error:++```+• Could not deduce (Test.QuickCheck.Arbitrary.Generic.GArbitrary+                          (A a)+                          (GHC.Generics.D1+                             ('GHC.Generics.MetaData "A" "ParametersTest" "main" 'False)+                             (GHC.Generics.C1+                                ('GHC.Generics.MetaCons "A" 'GHC.Generics.PrefixI 'False)+                                (GHC.Generics.S1+                                   ('GHC.Generics.MetaSel+                                      'Nothing+                                      'GHC.Generics.NoSourceUnpackedness+                                      'GHC.Generics.NoSourceStrictness+                                      'GHC.Generics.DecidedLazy)+                                   (GHC.Generics.Rec0 a))))+                          (TypesDiffer (A a) a))+        arising from a use of ‘genericArbitrary’+```++Here the `TypesDiffer` is a type familty dealing with recursive types and+helping us to eliminate inproper instances. To convince the compiller, that the+`a` parameter is not an `A a` we must fix the instance with additional+constraint `Arg (A a) a`++``` haskell+instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where+  arbitrary = genericArbitrary+  shrink = genericShrink+```++Now everything compiles and works as expected.

@@ -1,10 +1,10 @@ name:                generic-arbitrary-version:             0.2.2+version:             1.0.0 synopsis:            Generic implementation for QuickCheck's Arbitrary description:     Generic implementations of methods of the 'Arbitrary' class from the     QuickCheck library. The approach taken here can lead to diverging instances-    for recursive types but is safe for non-recursive ones and guarantees+    for mutually recursive types but is safe for simply recursive ones and guarantees     flat distribution for constructors of sum-types.  license:             MIT@@ -15,17 +15,83 @@ category:            Generic build-type:          Simple extra-source-files:  CHANGELOG.md+                   , README.md cabal-version:       1.22-tested-with:         GHC == 7.10.3-                   , GHC == 8.0.2-                   , GHC == 8.2.2-                   , GHC == 8.4.1-                   , GHC == 8.6.5-                   , GHC == 8.10.1+tested-with:         GHC == 8.10.7                    , GHC == 9.0.2 +source-repository head+  type:     git+  location: https://github.com/typeable/generic-arbitrary.git+ library   exposed-modules:     Test.QuickCheck.Arbitrary.Generic-  build-depends:       QuickCheck >= 2.14, base >=4.8 && <5+  build-depends:       base >=4.8 && <5+                     , QuickCheck   hs-source-dirs:      src   default-language:    Haskell2010+  default-extensions: AllowAmbiguousTypes+                    , CPP+                    , ConstraintKinds+                    , DataKinds+                    , DeriveGeneric+                    , FlexibleContexts+                    , FlexibleInstances+                    , GeneralizedNewtypeDeriving+                    , LambdaCase+                    , MultiParamTypeClasses+                    , PolyKinds+                    , RankNTypes+                    , ScopedTypeVariables+                    , TypeFamilies+                    , TypeOperators+                    , TypeSynonymInstances+                    , UndecidableInstances+                    , ViewPatterns+++test-suite test+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Test.hs+  default-language: Haskell2010+  build-depends:    base >= 4.8 && <5+                  , QuickCheck+                  , deepseq+                  , generic-arbitrary+                  , tasty+                  , tasty-discover+                  , tasty-hunit+                  , tasty-quickcheck+  other-modules: Auxiliary+               , LimitationDemo+               , NoTypecheckTest+               , ParametersTest+               , RecursiveTest+  default-extensions: AllowAmbiguousTypes+                    , CPP+                    , DataKinds+                    , DeriveAnyClass+                    , DeriveGeneric+                    , DerivingStrategies+                    , DerivingVia+                    , FlexibleContexts+                    , FlexibleInstances+                    , GeneralizedNewtypeDeriving+                    , LambdaCase+                    , MultiParamTypeClasses+                    , PolyKinds+                    , RankNTypes+                    , ScopedTypeVariables+                    , TypeApplications+                    , TypeFamilies+                    , TypeOperators+                    , TypeSynonymInstances+                    , UndecidableInstances+                    , ViewPatterns+  build-tools:   tasty-discover+  ghc-options:      -Wall+                    -threaded+                    -rtsopts+                    "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"+  default-extensions: DeriveGeneric

@@ -1,8 +1,7 @@-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeOperators, DataKinds, TypeFamilies, ScopedTypeVariables#-}--{- |+{-| -Generic implementation of the 'arbitrary' method. Example usage:+This module is a generic implementation of the 'arbitrary' method. Example+usage:  @ data Foo = Foo@@ -27,69 +26,342 @@  The generated 'arbitrary' method is equivalent to -@Foo <$> arbitrary <*> arbitrary@.+@+Foo '<$>' arbitrary '<*>' arbitrary+@. +It can also handle a recursive types problem. Assuming a type++@+data R = R R+  deriving Generic+@++there is no instance++@+instance Arbitrary R where+  arbitrary = genericArbitrary+  shrink = genericShrink+@++If you try to compile this you will get a type level error++>    • R refers to itself in all constructors++Which means that there is no finite term for @R@ because it is recursive. But,+if you correct the definition of @R@ like this.++@+data R = R R | F+  deriving Generic+@++Then it will compile. And the @arbitrary@ generated will not hang forever, because+it respects the @size@ parameter.++There is a limitation of recursion detection:++@+data R1 = R1 R2+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+  deriving Arbitrary via (GenericArbitrary R1)++data R2 = R2 R1+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+  deriving Arbitrary via (GenericArbitrary R2)+@++This code will compile and the @arbitrary@ generated will always hang. Yes,+there is a problem with mutually recursive types.++Now lets see an example of datatype with parameters++@+data A a = A a+  deriving (Eq, Ord, Show)+  deriving anyclass NFData+  deriving (Generic)++instance (Arbitrary a) => Arbitrary (A a) where+  arbitrary = genericArbitrary+  shrink = genericShrink+@++It should work from first glance, but when compile it will throw an error:++@+    • Could not deduce (Test.QuickCheck.Arbitrary.Generic.GArbitrary+                          (A a)+                          (GHC.Generics.D1+                             ('GHC.Generics.MetaData "A" "ParametersTest" "main" 'False)+                             (GHC.Generics.C1+                                ('GHC.Generics.MetaCons "A" 'GHC.Generics.PrefixI 'False)+                                (GHC.Generics.S1+                                   ('GHC.Generics.MetaSel+                                      'Nothing+                                      'GHC.Generics.NoSourceUnpackedness+                                      'GHC.Generics.NoSourceStrictness+                                      'GHC.Generics.DecidedLazy)+                                   (GHC.Generics.Rec0 a))))+                          (TypesDiffer (A a) a))+        arising from a use of ‘genericArbitrary’+@++Here the @TypesDiffer@ is a type familty dealing with recursive types and+helping us to eliminate inproper instances. To convince the compiller, that the+@a@ parameter is not an @A a@ we must fix the instance with additional constraint++@+instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where+  arbitrary = genericArbitrary+  shrink = genericShrink+@++Now everything compiles and works as expected.+ -}  module Test.QuickCheck.Arbitrary.Generic-  ( GenericArbitrary(..)+  ( -- * Main+    genericArbitrary+#if MIN_VERSION_QuickCheck(2, 14, 0)+  , GenericArbitrary(..)+#endif+  , Arg+  -- * Internal+  , GArbitrary+  , FiniteSum+  , FiniteSumElem+  , Finite+  , AllFieldsFinal+  , TypesDiffer+  , ArgumentsCount+  , SumLen+  -- * Reexports   , Arbitrary(..)-  , genericArbitrary   , genericShrink   ) where -import Control.Applicative-import Data.Coerce (coerce)-import Data.Proxy-import GHC.Generics as G-import GHC.TypeLits-import Test.QuickCheck as QC-import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)+import           Control.Applicative+import           Data.Coerce               (coerce)+import           Data.Proxy+import           Data.Type.Bool+import           GHC.Generics              as G+import           GHC.TypeLits+import           Test.QuickCheck           as QC+#if MIN_VERSION_QuickCheck(2, 14, 0)+import           Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink) +++-- | Newtype for @DerivingVia@+--+-- Usage:+--+-- @+-- data Foo = Foo+--   { _fooX :: X+--   , _fooY :: Y+--   } deriving (Generic)+--     deriving (Arbitrary) via GenericArbitrary Foo+-- @+--+-- @since 1.0.0 newtype GenericArbitrary a = GenericArbitrary { unGenericArbitrary :: a }   deriving (Show, Eq)  instance   ( Generic a,-    GArbitrary (Rep a),+    GArbitrary a (Rep a) some,     RecursivelyShrink (Rep a),     GSubterms (Rep a) a   ) => Arbitrary (GenericArbitrary a) where   arbitrary = coerce (genericArbitrary :: Gen a)   shrink = coerce (genericShrink :: a -> [a])+#endif -class GArbitrary a where-  gArbitrary :: QC.Gen (a x)+-- | Constraint helper for types with parameters+--+-- Usage:+--+-- @+-- data A a = A a+--   deriving (Generic)+-- instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where+--   arbitrary = genericArbitrary+--   shrink = genericShrink+-- @+--+-- @since 1.0.0 -instance GArbitrary G.U1 where-  gArbitrary = pure G.U1+type Arg self field = (TypesDiffer self field ~ 'True) -instance Arbitrary c => GArbitrary (G.K1 i c) where-  gArbitrary = G.K1 <$> scale predNat arbitrary-    where-      predNat 0 = 0-      predNat n = pred n+type family TypesDiffer a b where+  TypesDiffer a a = 'False+  TypesDiffer a b = 'True -instance GArbitrary f => GArbitrary (G.M1 i c f) where-  gArbitrary = G.M1 <$> gArbitrary+type family AllFieldsFinal self (a :: * -> *) :: Bool where+  AllFieldsFinal self U1 = 'True+  AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b+  AllFieldsFinal self (M1 S t (K1 R field)) = TypesDiffer self field -instance (GArbitrary a, GArbitrary b) => GArbitrary (a G.:*: b) where-  gArbitrary = liftA2 (G.:*:) gArbitrary gArbitrary+type family Finite self (a :: * -> *) :: Bool where+  Finite self U1 = 'True+  Finite self (K1 R field) = TypesDiffer self field+  Finite self (a :*: b) = Finite self a && Finite self b+  Finite self (M1 D t f) = Finite self f+  Finite self (a :+: b) = Finite self a || Finite self b+  Finite self (M1 C c f) = AllFieldsFinal self f+  Finite self (M1 S s f) = Finite self f +type family ArgumentsCount (a :: * -> *) :: Nat where+  ArgumentsCount U1 = 1+  ArgumentsCount (M1 S s f) = 1+  ArgumentsCount (a :*: b) = (ArgumentsCount a) + (ArgumentsCount b)+ -- | Calculates count of constructors encoded by particular ':+:'. -- Internal use only. type family SumLen a :: Nat where   SumLen (a G.:+: b) = (SumLen a) + (SumLen b)   SumLen a           = 1 -instance (GArbitrary a, GArbitrary b, KnownNat (SumLen a), KnownNat (SumLen b)-         ) => GArbitrary (a G.:+: b) where-  gArbitrary = frequency-    [ (lfreq, G.L1 <$> gArbitrary)-    , (rfreq, G.R1 <$> gArbitrary) ]+-- | Generic arbitrary.+--+-- Parameters are:+-- * self: the ADT we generating instance for+-- * a: some part of the `Rep self`+-- * finite: Is `a` finite? Infinite type has no finite values (like Stream)+class (Finite self a ~ finite) => GArbitrary self a (finite :: Bool) where+  gArbitrary :: Proxy self -> QC.Gen (a x)++instance+  ( GArbitrary self (M1 C c f) 'True+  ) => GArbitrary self (M1 D t (M1 C c f)) 'True where+  gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)++-- | The constructor meta information+instance+  ( GArbitrary self f some+  , KnownNat (ArgumentsCount f)+  , AllFieldsFinal self f ~ some+  ) => GArbitrary self (M1 C c f) some where+  gArbitrary _ = M1 <$> scale predNat (gArbitrary (Proxy :: Proxy self))     where+      argumentsCount = fromIntegral $ natVal (Proxy :: Proxy (ArgumentsCount f))+      predNat n = max 0 $ if argumentsCount > 1+        then n `div` argumentsCount+        else pred n++-- | Unit type instance+instance GArbitrary self U1 'True where+  gArbitrary _ = pure U1++-- | Constructor field meta information+instance GArbitrary self f some => GArbitrary self (M1 S t f) some where+  gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)++-- | Data of the constructor field+instance+  ( Arbitrary t+  , Finite self (K1 R t) ~ some+  ) => GArbitrary self (K1 R t) some where+  gArbitrary _ = K1 <$> arbitrary++-- | Product+instance+  ( GArbitrary self a af+  , GArbitrary self b bf+  , (af && bf) ~ some+  ) => GArbitrary self (a :*: b) some where+  gArbitrary _ = liftA2 (:*:)+    (gArbitrary (Proxy :: Proxy self)) (gArbitrary (Proxy :: Proxy self))++#if __GLASGOW_HASKELL__ >= 800+instance+  ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")+  , AllFieldsFinal self f ~ 'False+  ) => GArbitrary self (M1 D t (M1 C c f)) 'False where+  gArbitrary _ = error "Unreachable"+#endif++-- | ADT declaration with multiple constructors+instance+  ( FiniteSum self a b af bf+  , GArbitrary self (a :+: b) 'True+  ) => GArbitrary self (M1 D t (a :+: b)) 'True where+  gArbitrary _ = sized $ \s -> M1 <$>+    if s > 1+    then gArbitrary (Proxy :: Proxy self)+    else oneof (finiteSum (Proxy :: Proxy self))++-- | Any sum inside of declaration+instance+  ( GArbitrary self a af, GArbitrary self b bf+  , KnownNat (SumLen a), KnownNat (SumLen b)+  , (af || bf) ~ some+  ) => GArbitrary self (a :+: b) some where+  gArbitrary _ = frequency+    [ (lfreq, G.L1 <$> gArbitrary (Proxy :: Proxy self))+    , (rfreq, G.R1 <$> gArbitrary (Proxy :: Proxy self)) ]+    where       lfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen a))       rfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen b)) -genericArbitrary :: (Generic a, GArbitrary ga, ga ~ G.Rep a) => Gen a-genericArbitrary = G.to <$> gArbitrary+class+  ( Finite self a ~ af, Finite self b ~ bf+  ) => FiniteSum self (a :: * -> *) (b :: * -> *) af bf where+  finiteSum :: Proxy self -> [Gen ((a :+: b) p)]++instance+  ( FiniteSumElem self a, FiniteSumElem self b+  , Finite self a ~ 'True+  , Finite self b ~ 'True+  ) => FiniteSum self a b 'True 'True where+  finiteSum _ = concat+    [ fmap L1 <$> finiteElem (Proxy :: Proxy self)+    , fmap R1 <$> finiteElem (Proxy :: Proxy self)]++instance+  ( FiniteSumElem self a+  , Finite self a ~ 'True+  , Finite self b ~ 'False+  ) => FiniteSum self a b 'True 'False where+  finiteSum _ = fmap L1 <$> finiteElem (Proxy :: Proxy self)++instance+  ( FiniteSumElem self b+  , Finite self a ~ 'False+  , Finite self b ~ 'True+  ) => FiniteSum self a b 'False 'True where+  finiteSum _ = fmap R1 <$> finiteElem (Proxy :: Proxy self)++class FiniteSumElem self a where+  finiteElem :: Proxy self -> [Gen (a p)]++instance+  ( FiniteSum self a b af bf+  ) => FiniteSumElem self (a :+: b) where+  finiteElem _ = finiteSum (Proxy :: Proxy self)++instance+  ( GArbitrary self (M1 C c f) 'True+  ) => FiniteSumElem self (M1 C c f) where+  finiteElem _ = [gArbitrary (Proxy :: Proxy self)]+++#if __GLASGOW_HASKELL__ >= 800+instance+  ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")+  , (Finite self a || Finite self b) ~ 'False+  ) => GArbitrary self (M1 D t (a :+: b)) 'False where+  gArbitrary _ = error "Unreachable"+#endif++genericArbitrary+  :: forall a ga some+  . (Generic a, GArbitrary a ga some, ga ~ Rep a)+  => Gen a+genericArbitrary = G.to <$> gArbitrary (Proxy :: Proxy a)

@@ -0,0 +1,10 @@+module Auxiliary where++import           Control.Exception+import           Test.QuickCheck++failGeneration :: forall a. (Arbitrary a, Show a) => IO ()+failGeneration = do+  try (generate (arbitrary :: Gen a) >>= print) >>= \case+    Left (_ :: SomeException) -> pure ()+    Right _ -> error "Error expected"

@@ -0,0 +1,37 @@+module LimitationDemo where++import           Control.DeepSeq+import           GHC.Generics                      (Generic)+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary.Generic++-- As you can see, we have this instance generated, but it will definitely lead+-- to generating an infinite term (and the only term). The recursion detection+-- doesn't work here+data R1 = R1 R2+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary R1)+#else+instance Arbitrary R1 where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++data R2 = R2 R1+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary R2)+#else+instance Arbitrary R2 where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++-- To force the instance realy be generated+usage :: IO ()+usage = do+  r1 :: R1 <- generate arbitrary+  print r1 -- haha

@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -fdefer-type-errors #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}++-- | Test that infinite types has no Arbitrary instance++module NoTypecheckTest where++import           Auxiliary+import           GHC.Generics                      (Generic)+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary.Generic++-- | Recursive infinite type which can not have valid Arbitrary instance+data R = R R+  deriving (Eq, Show, Generic)++-- | Instance which must not compile, but we are using deferred type errors+instance Arbitrary R where+  arbitrary = genericArbitrary+  shrink = genericShrink++unit_mustFail :: IO ()+unit_mustFail = failGeneration @R

@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fdefer-type-errors #-}+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}++module ParametersTest where++import           Auxiliary+import           Control.DeepSeq+import           GHC.Generics                      (Generic)+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary.Generic++data A a = A a+  deriving (Eq, Ord, Show)+  deriving anyclass NFData+  deriving (Generic)++instance (Arbitrary a) => Arbitrary (A a) where+  arbitrary = genericArbitrary+  shrink = genericShrink++data B a = B a+  deriving (Eq, Ord, Show)+  deriving anyclass NFData+  deriving (Generic)++instance (Arg (B a) a, Arbitrary a) => Arbitrary (B a) where+  arbitrary = genericArbitrary+  shrink = genericShrink++unit_argumentConstraintFail :: IO ()+unit_argumentConstraintFail = failGeneration @(A Int)++prop_properArgumentConstraint :: B Int -> Property+prop_properArgumentConstraint = total

@@ -0,0 +1,137 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DeriveAnyClass #-}++-- | Testing that our Arbitrary instances do not get stuck and respect the+-- `size` parameter while generating.++module RecursiveTest where++import           Control.DeepSeq+import           GHC.Generics                      (Generic)+import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary.Generic++data Unit = Unit+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Unit)+#else+instance Arbitrary Unit where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_unitTotal :: Unit -> Property+prop_unitTotal = total++data Single = Single Int+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Single)+#else+instance Arbitrary Single where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_singleTotal :: Single -> Property+prop_singleTotal = total++data Multiple = M1 | M2 | M3 Int+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Multiple)+#else+instance Arbitrary Multiple where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_multipleTotal :: Multiple -> Property+prop_multipleTotal = total++data Rec = Rec+  { unit     :: Unit+  , single   :: Single+  , multiple :: Multiple+  } deriving (Eq, Show, Generic)+    deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Rec)+#else+instance Arbitrary Rec where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_recTotal :: Rec -> Property+prop_recTotal = total++data Expr+  = Lit Int+  | Add Expr Expr+  | Mul Expr Expr+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Expr)+#else+instance Arbitrary Expr where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_exprTotal :: Expr -> Property+prop_exprTotal = total++data Recursive+  = R1 Recursive+  | R2 Recursive Int+  | N Int+  | R3 Recursive+  | R4 Recursive+  | R5 Recursive String+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary Recursive)+#else+instance Arbitrary Recursive where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_recursiveTotal :: Recursive -> Property+prop_recursiveTotal = total++data DeepRecursive+  = Deep DeepRecursive DeepRecursive DeepRecursive DeepRecursive DeepRecursive+  | Short+  deriving (Eq, Show, Generic)+  deriving anyclass NFData+#if MIN_VERSION_QuickCheck(2, 14, 0)+  deriving Arbitrary via (GenericArbitrary DeepRecursive)+#else+instance Arbitrary DeepRecursive where+  arbitrary = genericArbitrary+  shrink = genericShrink+#endif++prop_deepRecursiveTotal :: DeepRecursive -> Property+prop_deepRecursiveTotal = total++data P p = NoP | P p+  deriving (Eq, Show, Generic)+  deriving anyclass NFData++-- Note that deriving via doesn't work for case with arguments+instance (Arg (P p) p, Arbitrary p) => Arbitrary (P p) where+  arbitrary = genericArbitrary+  shrink = genericShrink++prop_Ptotal :: P (P Int) -> Property+prop_Ptotal = total

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}