Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-generic-random for openSUSE:Factory checked in at 2021-08-25 20:57:27 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-generic-random (Old) and /work/SRC/openSUSE:Factory/.ghc-generic-random.new.1899 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-generic-random" Wed Aug 25 20:57:27 2021 rev:3 rq:912746 version:1.5.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-generic-random/ghc-generic-random.changes 2021-06-01 10:40:44.225147626 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-generic-random.new.1899/ghc-generic-random.changes 2021-08-25 20:58:44.289119448 +0200 @@ -1,0 +2,9 @@ +Thu Jul 15 16:15:26 UTC 2021 - [email protected] + +- Update generic-random to version 1.5.0.0. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/generic-random-1.5.0.0/src/CHANGELOG.md + +------------------------------------------------------------------- Old: ---- generic-random-1.4.0.0.tar.gz New: ---- generic-random-1.5.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-generic-random.spec ++++++ --- /var/tmp/diff_new_pack.Q3xmlz/_old 2021-08-25 20:58:44.729118871 +0200 +++ /var/tmp/diff_new_pack.Q3xmlz/_new 2021-08-25 20:58:44.733118865 +0200 @@ -19,7 +19,7 @@ %global pkg_name generic-random %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.0.0 +Version: 1.5.0.0 Release: 0 Summary: Generic random generators for QuickCheck License: MIT ++++++ generic-random-1.4.0.0.tar.gz -> generic-random-1.5.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/CHANGELOG.md new/generic-random-1.5.0.0/CHANGELOG.md --- old/generic-random-1.4.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/generic-random-1.5.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,11 @@ -https://github.com/Lysxia/generic-random/blob/master/changelog.md +# Changelog + +Latest version: https://github.com/Lysxia/generic-random/blob/master/changelog.md + +# 1.5.0.0 + +- Add newtypes for `DerivingVia` +- Drop compatibility with GHC 8.0 and 8.2 # 1.4.0.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/generic-random.cabal new/generic-random-1.5.0.0/generic-random.cabal --- old/generic-random-1.4.0.0/generic-random.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/generic-random-1.5.0.0/generic-random.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: generic-random -version: 1.4.0.0 +version: 1.5.0.0 synopsis: Generic random generators for QuickCheck description: Derive instances of @Arbitrary@ for QuickCheck, @@ -23,18 +23,20 @@ build-type: Simple extra-source-files: README.md CHANGELOG.md cabal-version: >=1.10 -tested-with: GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1, GHC == 8.4.1, GHC == 8.6.1 +tested-with: GHC == 8.4.1, GHC == 8.6.1, GHC == 8.8.4, GHC == 8.10.5, GHC == 9.0.1 library hs-source-dirs: src exposed-modules: Generic.Random + Generic.Random.DerivingVia Generic.Random.Internal.BaseCase Generic.Random.Internal.Generic Generic.Random.Tutorial build-depends: - base >= 4.9 && < 5, - QuickCheck + base >= 4.11 && < 5, + QuickCheck >= 2.14 + -- exports RecursivelyShrink default-language: Haskell2010 ghc-options: -Wall -fno-warn-name-shadowing @@ -70,6 +72,22 @@ build-depends: base, QuickCheck, + inspection-testing, + generic-random + type: exitcode-stdio-1.0 + default-language: Haskell2010 + if !flag(enable-inspect) + buildable: False + else + build-depends: random < 1.2 + -- TODO: this test fails with newer versions of random + +test-suite inspect-derivingvia + hs-source-dirs: test + main-is: Inspect/DerivingVia.hs + build-depends: + base, + QuickCheck, inspection-testing, generic-random type: exitcode-stdio-1.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/src/Generic/Random/DerivingVia.hs new/generic-random-1.5.0.0/src/Generic/Random/DerivingVia.hs --- old/generic-random-1.4.0.0/src/Generic/Random/DerivingVia.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/generic-random-1.5.0.0/src/Generic/Random/DerivingVia.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,334 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_HADDOCK not-home #-} + +module Generic.Random.DerivingVia + ( GenericArbitrary (..), + GenericArbitraryU (..), + GenericArbitrarySingle (..), + GenericArbitraryRec (..), + GenericArbitraryG (..), + GenericArbitraryUG (..), + GenericArbitrarySingleG (..), + GenericArbitraryRecG (..), + GenericArbitraryWith (..), + AndShrinking (..), + TypeLevelGenList (..), + TypeLevelOpts (..), + ) +where + +import Data.Coerce (Coercible, coerce) +import Data.Kind (Type) +import Data.Proxy (Proxy (..)) +import GHC.Generics (Generic(..)) +import GHC.TypeLits (KnownNat, natVal) +import Generic.Random.Internal.Generic +import Test.QuickCheck (Arbitrary (..), Gen, genericShrink) +import Test.QuickCheck.Arbitrary (RecursivelyShrink, GSubterms) + +-- * Newtypes for DerivingVia + +-- | Pick a constructor with a given distribution, and fill its fields +-- with recursive calls to 'Test.QuickCheck.arbitrary'. +-- +-- === Example +-- +-- > data X = ... +-- > deriving Arbitrary via (GenericArbitrary '[2, 3, 5] X) +-- +-- Picks the first constructor with probability @2/10@, +-- the second with probability @3/10@, the third with probability @5/10@. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitrary'. +-- +-- @since 1.5.0.0 +newtype GenericArbitrary weights a = GenericArbitrary {unGenericArbitrary :: a} deriving (Eq, Show) + +instance + ( GArbitrary UnsizedOpts a, + TypeLevelWeights' weights a + ) => + Arbitrary (GenericArbitrary weights a) + where + arbitrary = GenericArbitrary <$> genericArbitrary (typeLevelWeights @weights) + +-- | Pick every constructor with equal probability. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryU'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryU a = GenericArbitraryU {unGenericArbitraryU :: a} deriving (Eq, Show) + +instance + ( GArbitrary UnsizedOpts a, + GUniformWeight a + ) => + Arbitrary (GenericArbitraryU a) + where + arbitrary = GenericArbitraryU <$> genericArbitraryU + +-- | @arbitrary@ for types with one constructor. +-- Equivalent to 'GenericArbitraryU', with a stricter type. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitrarySingle'. +-- +-- @since 1.5.0.0 +newtype GenericArbitrarySingle a = GenericArbitrarySingle {unGenericArbitrarySingle :: a} deriving (Eq, Show) + +instance + ( GArbitrary UnsizedOpts a, + Weights_ (Rep a) ~ L c0 + ) => + Arbitrary (GenericArbitrarySingle a) + where + arbitrary = GenericArbitrarySingle <$> genericArbitrarySingle + +-- | Decrease size at every recursive call, but don't do anything different +-- at size 0. +-- +-- > data X = ... +-- > deriving Arbitrary via (GenericArbitraryRec '[2, 3, 5] X) +-- +-- N.B.: This replaces the generator for fields of type @[t]@ with +-- @'listOf'' arbitrary@ instead of @'Test.QuickCheck.listOf' arbitrary@ (i.e., @arbitrary@ for +-- lists). +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryRec'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryRec weights a = GenericArbitraryRec {unGenericArbitraryRec :: a} deriving (Eq, Show) + +instance + ( GArbitrary SizedOptsDef a, + TypeLevelWeights' weights a + ) => + Arbitrary (GenericArbitraryRec weights a) + where + arbitrary = GenericArbitraryRec <$> genericArbitraryRec (typeLevelWeights @weights) + +-- | 'GenericArbitrary' with explicit generators. +-- +-- === Example +-- +-- > data X = ... +-- > deriving Arbitrary via (GenericArbitraryG CustomGens '[2, 3, 5] X) +-- +-- where, for example, custom generators to override 'String' and 'Int' fields +-- might look as follows: +-- +-- @ +-- type CustomGens = CustomString ':+' CustomInt +-- @ +-- +-- === Note on multiple matches +-- +-- Multiple generators may match a given field: the first will be chosen. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryG'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryG genList weights a = GenericArbitraryG {unGenericArbitraryG :: a} deriving (Eq, Show) + +instance + ( GArbitrary (SetGens genList UnsizedOpts) a, + GUniformWeight a, + TypeLevelWeights' weights a, + TypeLevelGenList genList', + genList ~ TypeLevelGenList' genList' + ) => + Arbitrary (GenericArbitraryG genList' weights a) + where + arbitrary = GenericArbitraryG <$> genericArbitraryG (toGenList $ Proxy @genList') (typeLevelWeights @weights) + +-- | 'GenericArbitraryU' with explicit generators. +-- See also 'GenericArbitraryG'. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryUG'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryUG genList a = GenericArbitraryUG {unGenericArbitraryUG :: a} deriving (Eq, Show) + +instance + ( GArbitrary (SetGens genList UnsizedOpts) a, + GUniformWeight a, + TypeLevelGenList genList', + genList ~ TypeLevelGenList' genList' + ) => + Arbitrary (GenericArbitraryUG genList' a) + where + arbitrary = GenericArbitraryUG <$> genericArbitraryUG (toGenList $ Proxy @genList') + +-- | 'genericArbitrarySingle' with explicit generators. +-- See also 'GenericArbitraryG'. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitrarySingleG'. +-- +-- @since 1.5.0.0 +newtype GenericArbitrarySingleG genList a = GenericArbitrarySingleG {unGenericArbitrarySingleG :: a} deriving (Eq, Show) + +instance + ( GArbitrary (SetGens genList UnsizedOpts) a, + Weights_ (Rep a) ~ L c0, + TypeLevelGenList genList', + genList ~ TypeLevelGenList' genList' + ) => + Arbitrary (GenericArbitrarySingleG genList' a) + where + arbitrary = GenericArbitrarySingleG <$> genericArbitrarySingleG (toGenList $ Proxy @genList') + +-- | 'genericArbitraryRec' with explicit generators. +-- See also 'genericArbitraryG'. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryRecG'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryRecG genList weights a = GenericArbitraryRecG {unGenericArbitraryRecG :: a} deriving (Eq, Show) + +instance + ( GArbitrary (SetGens genList SizedOpts) a, + TypeLevelWeights' weights a, + TypeLevelGenList genList', + genList ~ TypeLevelGenList' genList' + ) => + Arbitrary (GenericArbitraryRecG genList' weights a) + where + arbitrary = GenericArbitraryRecG <$> genericArbitraryRecG (toGenList $ Proxy @genList') (typeLevelWeights @weights) + +-- | General generic generator with custom options. +-- +-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'. +-- +-- Uses 'genericArbitraryWith'. +-- +-- @since 1.5.0.0 +newtype GenericArbitraryWith opts weights a = GenericArbitraryWith {unGenericArbitraryWith :: a} deriving (Eq, Show) + +instance + ( GArbitrary opts a, + TypeLevelWeights' weights a, + TypeLevelOpts opts', + opts ~ TypeLevelOpts' opts' + ) => + Arbitrary (GenericArbitraryWith opts' weights a) + where + arbitrary = GenericArbitraryWith <$> genericArbitraryWith (toOpts $ Proxy @opts') (typeLevelWeights @weights) + +-- | Add generic shrinking to a newtype wrapper for 'Arbitrary', using 'genericShrink'. +-- +-- @ +-- data X = ... +-- deriving Arbitrary via ('GenericArbitrary' '[1,2,3] `'AndShrinking'` X) +-- @ +-- +-- Equivalent to: +-- +-- @ +-- instance Arbitrary X where +-- arbitrary = 'genericArbitrary' (1 % 2 % 3 % ()) +-- shrink = 'Test.QuickCheck.genericShrink' +-- @ +-- +-- @since 1.5.0.0 +newtype AndShrinking f a = AndShrinking a deriving (Eq, Show) + +instance + ( Arbitrary (f a), Coercible (f a) a, Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a + ) => Arbitrary (AndShrinking f a) where + arbitrary = coerce (arbitrary :: Gen (f a)) + shrink = coerce (genericShrink :: a -> [a]) + +-- * Internal + +-- | +-- @since 1.5.0.0 +type TypeLevelWeights' weights a = TypeLevelWeights weights (Weights_ (Rep a)) + +typeLevelWeights :: + forall weights a. + TypeLevelWeights weights (Weights_ (Rep a)) => + Weights a +typeLevelWeights = + let (w, n) = typeLevelWeightsBuilder @weights + in Weights w n + +-- | +-- @since 1.5.0.0 +class TypeLevelWeights weights a where + typeLevelWeightsBuilder :: (a, Int) + +instance + ( KnownNat weight, + TypeLevelWeights weights a + ) => + TypeLevelWeights (weight ': weights) (L x :| a) + where + typeLevelWeightsBuilder = + let (a, m) = (L, fromIntegral $ natVal $ Proxy @weight) + (b, n) = typeLevelWeightsBuilder @weights @a + in (N a m b, m + n) + +instance + ( KnownNat weight + ) => + TypeLevelWeights (weight ': '[]) (L x) + where + typeLevelWeightsBuilder = (L, fromIntegral $ natVal $ Proxy @weight) + +instance + TypeLevelWeights (w ': ws) (t :| (u :| v)) => + TypeLevelWeights (w ': ws) ((t :| u) :| v) + where + typeLevelWeightsBuilder = + let (N t nt (N u nu v), m) = typeLevelWeightsBuilder @(w ': ws) @(t :| (u :| v)) + in (N (N t nt u) (nt + nu) v, m) + +instance TypeLevelWeights '[] () where + typeLevelWeightsBuilder = ((), 1) + +-- | +-- @since 1.5.0.0 +class TypeLevelGenList a where + type TypeLevelGenList' a :: Type + toGenList :: Proxy a -> TypeLevelGenList' a + +instance Arbitrary a => TypeLevelGenList (Gen a) where + type TypeLevelGenList' (Gen a) = Gen a + toGenList _ = arbitrary + +instance (TypeLevelGenList a, TypeLevelGenList b) => TypeLevelGenList (a :+ b) where + type TypeLevelGenList' (a :+ b) = TypeLevelGenList' a :+ TypeLevelGenList' b + toGenList _ = toGenList (Proxy @a) :+ toGenList (Proxy @b) + +-- | +-- @since 1.5.0.0 +class TypeLevelOpts a where + type TypeLevelOpts' a :: Type + toOpts :: Proxy a -> TypeLevelOpts' a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/src/Generic/Random/Internal/BaseCase.hs new/generic-random-1.5.0.0/src/Generic/Random/Internal/BaseCase.hs --- old/generic-random-1.4.0.0/src/Generic/Random/Internal/BaseCase.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/generic-random-1.5.0.0/src/Generic/Random/Internal/BaseCase.hs 2001-09-09 03:46:40.000000000 +0200 @@ -27,6 +27,7 @@ import Control.Applicative import Data.Proxy +import Data.Kind (Type) import GHC.Generics import GHC.TypeLits import Test.QuickCheck @@ -75,7 +76,7 @@ -- -- @e@ is the original type the search started with, that @a@ appears in. -- It is used for error reporting. -class BaseCaseSearch (a :: *) (z :: Nat) (y :: Maybe Nat) (e :: *) where +class BaseCaseSearch (a :: Type) (z :: Nat) (y :: Maybe Nat) (e :: Type) where baseCaseSearch :: prox y -> proxy '(z, e) -> IfM y Gen Proxy a @@ -180,7 +181,7 @@ type instance MinOf 'LT m n = m class Alternative (IfM y Weighted Proxy) - => GBCS (f :: k -> *) (z :: Nat) (y :: Maybe Nat) (e :: *) where + => GBCS (f :: k -> Type) (z :: Nat) (y :: Maybe Nat) (e :: Type) where gbcs :: prox y -> proxy '(z, e) -> IfM y Weighted Proxy (f p) instance GBCS f z y e => GBCS (M1 i c f) z y e where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/src/Generic/Random/Internal/Generic.hs new/generic-random-1.5.0.0/src/Generic/Random/Internal/Generic.hs --- old/generic-random-1.4.0.0/src/Generic/Random/Internal/Generic.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/generic-random-1.5.0.0/src/Generic/Random/Internal/Generic.hs 2001-09-09 03:46:40.000000000 +0200 @@ -406,7 +406,7 @@ type family CoherenceOf (o :: Type) :: Coherence type instance CoherenceOf (Options c _s _g) = c --- | Match this generator incoherently when the 'INCOHERENT' option is set. +-- | Match this generator incoherently when the 'COHERENT' option is set. newtype Incoherent g = Incoherent g diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/src/Generic/Random.hs new/generic-random-1.5.0.0/src/Generic/Random.hs --- old/generic-random-1.4.0.0/src/Generic/Random.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/generic-random-1.5.0.0/src/Generic/Random.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,6 +3,8 @@ -- = Basic usage -- -- @ +-- {-\# LANGUAGE DeriveGeneric \#-} +-- -- data Foo = A | B | C -- some generic data type -- deriving 'GHC.Generics.Generic' -- @ @@ -11,7 +13,8 @@ -- -- @ -- instance Arbitrary Foo where --- arbitrary = 'genericArbitrary' 'uniform' -- give a distribution of constructors +-- arbitrary = 'genericArbitrary' 'uniform' -- Give a distribution of constructors. +-- shrink = 'Test.QuickCheck.genericShrink' -- Generic shrinking is provided by the QuickCheck library. -- @ -- -- Or derive standalone generators (the fields must still be instances of @@ -22,6 +25,16 @@ -- genFoo = 'genericArbitrary' 'uniform' -- @ -- +-- === Using @DerivingVia@ +-- +-- @ +-- {-\# LANGUAGE DerivingVia, TypeOperators \#-} +-- +-- data Foo = A | B | C +-- deriving 'GHC.Generics.Generic' +-- deriving Arbitrary via ('GenericArbitraryU' `'AndShrinking'` Foo) +-- @ +-- -- For more information: -- -- - "Generic.Random.Tutorial" @@ -136,10 +149,10 @@ -- (getNonNegative '<$>' arbitrary) -- @ -- - -- There are also different types of generators, other than 'Gen', providing + -- There are also different types of generators, other than 'Test.QuickCheck.Gen', providing -- more ways to select the fields the generator than by simply comparing types: -- - -- - @'Gen' a@: override fields of type @a@; + -- - @'Test.QuickCheck.Gen' a@: override fields of type @a@; -- - @'Gen1' f@: override fields of type @f x@ for some @x@, requiring a generator for @x@; -- - @'Gen1_' f@: override fields of type @f x@ for some @x@, __not__ requiring a generator for @x@; -- - @'FieldGen' s a@: override record fields named @s@, which must have type @a@; @@ -208,7 +221,26 @@ , GArbitrary , GUniformWeight + -- * Newtypes for DerivingVia + + -- | These newtypes correspond to the variants of 'genericArbitrary' above. + + , GenericArbitrary (..) + , GenericArbitraryU (..) + , GenericArbitrarySingle (..) + , GenericArbitraryRec (..) + , GenericArbitraryG (..) + , GenericArbitraryUG (..) + , GenericArbitrarySingleG (..) + , GenericArbitraryRecG (..) + , GenericArbitraryWith (..) + , AndShrinking (..) + + -- ** Helpers typeclasses + , TypeLevelGenList (..) + , TypeLevelOpts (..) ) where import Generic.Random.Internal.BaseCase import Generic.Random.Internal.Generic +import Generic.Random.DerivingVia diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generic-random-1.4.0.0/test/Inspect/DerivingVia.hs new/generic-random-1.5.0.0/test/Inspect/DerivingVia.hs --- old/generic-random-1.4.0.0/test/Inspect/DerivingVia.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/generic-random-1.5.0.0/test/Inspect/DerivingVia.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,33 @@ +{-# LANGUAGE + DataKinds, + DeriveGeneric, + DerivingVia, + TypeOperators, + TemplateHaskell + #-} + +import GHC.Generics (Generic) +import Test.QuickCheck (Arbitrary(arbitrary), Gen) + +import Test.Inspection (inspect, (==-)) + +import Generic.Random + +data T = A | B | C Int [Bool] + deriving Generic + deriving Arbitrary via (GenericArbitrary '[1,2,3] T) + +arbT :: Gen T +arbT = genericArbitrary (1 % 2 % 3 % ()) + +arbT' :: Gen T +arbT' = arbitrary + +data T1 = A1 | B1 | C1 Int [Bool] + deriving Generic + deriving Arbitrary via (GenericArbitrary '[1,2,3] `AndShrinking` T1) + +main :: IO () +main = pure () + +inspect $ 'arbT ==- 'arbT'
