module Test.QuickCheck.Arbitrary.Generic
(
genericArbitrary
#if MIN_VERSION_QuickCheck(2, 14, 0)
, GenericArbitrary(..)
#endif
, Arg
, GArbitrary
, FiniteSum
, FiniteSumElem
, Finite
, AllFieldsFinal
, TypesDiffer
, ArgumentsCount
, SumLen
, Arbitrary(..)
, genericShrink
) where
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 GenericArbitrary a = GenericArbitrary { GenericArbitrary a -> a
unGenericArbitrary :: a }
deriving (Int -> GenericArbitrary a -> ShowS
[GenericArbitrary a] -> ShowS
GenericArbitrary a -> String
(Int -> GenericArbitrary a -> ShowS)
-> (GenericArbitrary a -> String)
-> ([GenericArbitrary a] -> ShowS)
-> Show (GenericArbitrary a)
forall a. Show a => Int -> GenericArbitrary a -> ShowS
forall a. Show a => [GenericArbitrary a] -> ShowS
forall a. Show a => GenericArbitrary a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericArbitrary a] -> ShowS
$cshowList :: forall a. Show a => [GenericArbitrary a] -> ShowS
show :: GenericArbitrary a -> String
$cshow :: forall a. Show a => GenericArbitrary a -> String
showsPrec :: Int -> GenericArbitrary a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericArbitrary a -> ShowS
Show, GenericArbitrary a -> GenericArbitrary a -> Bool
(GenericArbitrary a -> GenericArbitrary a -> Bool)
-> (GenericArbitrary a -> GenericArbitrary a -> Bool)
-> Eq (GenericArbitrary a)
forall a. Eq a => GenericArbitrary a -> GenericArbitrary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericArbitrary a -> GenericArbitrary a -> Bool
$c/= :: forall a. Eq a => GenericArbitrary a -> GenericArbitrary a -> Bool
== :: GenericArbitrary a -> GenericArbitrary a -> Bool
$c== :: forall a. Eq a => GenericArbitrary a -> GenericArbitrary a -> Bool
Eq)
instance
( Generic a,
GArbitrary a (Rep a) some,
RecursivelyShrink (Rep a),
GSubterms (Rep a) a
) => Arbitrary (GenericArbitrary a) where
arbitrary :: Gen (GenericArbitrary a)
arbitrary = Gen a -> Gen (GenericArbitrary a)
coerce (Gen a
forall a (ga :: * -> *) (some :: Bool).
(Generic a, GArbitrary a ga some, ga ~ Rep a) =>
Gen a
genericArbitrary :: Gen a)
shrink :: GenericArbitrary a -> [GenericArbitrary a]
shrink = (a -> [a]) -> GenericArbitrary a -> [GenericArbitrary a]
coerce (a -> [a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink :: a -> [a])
#endif
type Arg self field = (TypesDiffer self field ~ 'True)
type family TypesDiffer a b where
TypesDiffer a a = 'False
TypesDiffer a b = 'True
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
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)
type family SumLen a :: Nat where
SumLen (a G.:+: b) = (SumLen a) + (SumLen b)
SumLen a = 1
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 :: Proxy self -> Gen (M1 D t (M1 C c f) x)
gArbitrary Proxy self
_ = M1 C c f x -> M1 D t (M1 C c f) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (M1 C c f x -> M1 D t (M1 C c f) x)
-> Gen (M1 C c f x) -> Gen (M1 D t (M1 C c f) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> Gen (M1 C c f x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
instance
( GArbitrary self f some
, KnownNat (ArgumentsCount f)
, AllFieldsFinal self f ~ some
) => GArbitrary self (M1 C c f) some where
gArbitrary :: Proxy self -> Gen (M1 C c f x)
gArbitrary Proxy self
_ = f x -> M1 C c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> M1 C c f x) -> Gen (f x) -> Gen (M1 C c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen (f x) -> Gen (f x)
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
predNat (Proxy self -> Gen (f x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self))
where
argumentsCount :: Int
argumentsCount = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (ArgumentsCount f) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (ArgumentsCount f)
forall k (t :: k). Proxy t
Proxy :: Proxy (ArgumentsCount f))
predNat :: Int -> Int
predNat Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ if Int
argumentsCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
argumentsCount
else Int -> Int
forall a. Enum a => a -> a
pred Int
n
instance GArbitrary self U1 'True where
gArbitrary :: Proxy self -> Gen (U1 x)
gArbitrary Proxy self
_ = U1 x -> Gen (U1 x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 x
forall k (p :: k). U1 p
U1
instance GArbitrary self f some => GArbitrary self (M1 S t f) some where
gArbitrary :: Proxy self -> Gen (M1 S t f x)
gArbitrary Proxy self
_ = f x -> M1 S t f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> M1 S t f x) -> Gen (f x) -> Gen (M1 S t f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> Gen (f x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
instance
( Arbitrary t
, Finite self (K1 R t) ~ some
) => GArbitrary self (K1 R t) some where
gArbitrary :: Proxy self -> Gen (K1 R t x)
gArbitrary Proxy self
_ = t -> K1 R t x
forall k i c (p :: k). c -> K1 i c p
K1 (t -> K1 R t x) -> Gen t -> Gen (K1 R t x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen t
forall a. Arbitrary a => Gen a
arbitrary
instance
( GArbitrary self a af
, GArbitrary self b bf
, (af && bf) ~ some
) => GArbitrary self (a :*: b) some where
gArbitrary :: Proxy self -> Gen ((:*:) a b x)
gArbitrary Proxy self
_ = (a x -> b x -> (:*:) a b x)
-> Gen (a x) -> Gen (b x) -> Gen ((:*:) a b x)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a x -> b x -> (:*:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
(Proxy self -> Gen (a x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)) (Proxy self -> Gen (b x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
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 :: Proxy self -> Gen (M1 D t (M1 C c f) x)
gArbitrary Proxy self
_ = String -> Gen (M1 D t (M1 C c f) x)
forall a. HasCallStack => String -> a
error String
"Unreachable"
#endif
instance
( FiniteSum self a b af bf
, GArbitrary self (a :+: b) 'True
) => GArbitrary self (M1 D t (a :+: b)) 'True where
gArbitrary :: Proxy self -> Gen (M1 D t (a :+: b) x)
gArbitrary Proxy self
_ = (Int -> Gen (M1 D t (a :+: b) x)) -> Gen (M1 D t (a :+: b) x)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (M1 D t (a :+: b) x)) -> Gen (M1 D t (a :+: b) x))
-> (Int -> Gen (M1 D t (a :+: b) x)) -> Gen (M1 D t (a :+: b) x)
forall a b. (a -> b) -> a -> b
$ \Int
s -> (:+:) a b x -> M1 D t (a :+: b) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((:+:) a b x -> M1 D t (a :+: b) x)
-> Gen ((:+:) a b x) -> Gen (M1 D t (a :+: b) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then Proxy self -> Gen ((:+:) a b x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
else [Gen ((:+:) a b x)] -> Gen ((:+:) a b x)
forall a. [Gen a] -> Gen a
oneof (Proxy self -> [Gen ((:+:) a b x)]
forall self (a :: * -> *) (b :: * -> *) (af :: Bool) (bf :: Bool)
p.
FiniteSum self a b af bf =>
Proxy self -> [Gen ((:+:) a b p)]
finiteSum (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self))
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 :: Proxy self -> Gen ((:+:) a b x)
gArbitrary Proxy self
_ = [(Int, Gen ((:+:) a b x))] -> Gen ((:+:) a b x)
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
lfreq, a x -> (:+:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
G.L1 (a x -> (:+:) a b x) -> Gen (a x) -> Gen ((:+:) a b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> Gen (a x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self))
, (Int
rfreq, b x -> (:+:) a b x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
G.R1 (b x -> (:+:) a b x) -> Gen (b x) -> Gen ((:+:) a b x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> Gen (b x)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)) ]
where
lfreq :: Int
lfreq = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (SumLen a) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SumLen a)
forall k (t :: k). Proxy t
Proxy :: Proxy (SumLen a))
rfreq :: Int
rfreq = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (SumLen b) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SumLen b)
forall k (t :: k). Proxy t
Proxy :: Proxy (SumLen b))
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 :: Proxy self -> [Gen ((:+:) a b p)]
finiteSum Proxy self
_ = [[Gen ((:+:) a b p)]] -> [Gen ((:+:) a b p)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ (a p -> (:+:) a b p) -> Gen (a p) -> Gen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Gen (a p) -> Gen ((:+:) a b p))
-> [Gen (a p)] -> [Gen ((:+:) a b p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> [Gen (a p)]
forall k k (self :: k) (a :: k -> *) (p :: k).
FiniteSumElem self a =>
Proxy self -> [Gen (a p)]
finiteElem (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
, (b p -> (:+:) a b p) -> Gen (b p) -> Gen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Gen (b p) -> Gen ((:+:) a b p))
-> [Gen (b p)] -> [Gen ((:+:) a b p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> [Gen (b p)]
forall k k (self :: k) (a :: k -> *) (p :: k).
FiniteSumElem self a =>
Proxy self -> [Gen (a p)]
finiteElem (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)]
instance
( FiniteSumElem self a
, Finite self a ~ 'True
, Finite self b ~ 'False
) => FiniteSum self a b 'True 'False where
finiteSum :: Proxy self -> [Gen ((:+:) a b p)]
finiteSum Proxy self
_ = (a p -> (:+:) a b p) -> Gen (a p) -> Gen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Gen (a p) -> Gen ((:+:) a b p))
-> [Gen (a p)] -> [Gen ((:+:) a b p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> [Gen (a p)]
forall k k (self :: k) (a :: k -> *) (p :: k).
FiniteSumElem self a =>
Proxy self -> [Gen (a p)]
finiteElem (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
instance
( FiniteSumElem self b
, Finite self a ~ 'False
, Finite self b ~ 'True
) => FiniteSum self a b 'False 'True where
finiteSum :: Proxy self -> [Gen ((:+:) a b p)]
finiteSum Proxy self
_ = (b p -> (:+:) a b p) -> Gen (b p) -> Gen ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Gen (b p) -> Gen ((:+:) a b p))
-> [Gen (b p)] -> [Gen ((:+:) a b p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy self -> [Gen (b p)]
forall k k (self :: k) (a :: k -> *) (p :: k).
FiniteSumElem self a =>
Proxy self -> [Gen (a p)]
finiteElem (Proxy self
forall k (t :: k). Proxy t
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 :: Proxy self -> [Gen ((:+:) a b p)]
finiteElem Proxy self
_ = Proxy self -> [Gen ((:+:) a b p)]
forall self (a :: * -> *) (b :: * -> *) (af :: Bool) (bf :: Bool)
p.
FiniteSum self a b af bf =>
Proxy self -> [Gen ((:+:) a b p)]
finiteSum (Proxy self
forall k (t :: k). Proxy t
Proxy :: Proxy self)
instance
( GArbitrary self (M1 C c f) 'True
) => FiniteSumElem self (M1 C c f) where
finiteElem :: Proxy self -> [Gen (M1 C c f p)]
finiteElem Proxy self
_ = [Proxy self -> Gen (M1 C c f p)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy self
forall k (t :: k). Proxy t
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 :: Proxy self -> Gen (M1 D t (a :+: b) x)
gArbitrary Proxy self
_ = String -> Gen (M1 D t (a :+: b) x)
forall a. HasCallStack => String -> a
error String
"Unreachable"
#endif
genericArbitrary
:: forall a ga some
. (Generic a, GArbitrary a ga some, ga ~ Rep a)
=> Gen a
genericArbitrary :: Gen a
genericArbitrary = ga Any -> a
forall a x. Generic a => Rep a x -> a
G.to (ga Any -> a) -> Gen (ga Any) -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> Gen (ga Any)
forall self (a :: * -> *) (finite :: Bool) x.
GArbitrary self a finite =>
Proxy self -> Gen (a x)
gArbitrary (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)