{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Polysemy.Check.Arbitrary where
import Control.Applicative (liftA2)
import Data.Kind (Type)
import GHC.Exts (type (~~))
import Generics.Kind hiding (SubstRep, SubstRep')
import Generics.Kind.Unexported
import Polysemy
import Polysemy.Internal
import Test.QuickCheck
data family ExistentialFor (e :: Effect)
class GArbitraryK (e :: Effect) (f :: LoT Effect -> Type) (r :: EffectRow) (a :: Type) where
garbitraryk :: [Gen (f (LoT2 (Sem r) a))]
instance GArbitraryK e U1 r a where
garbitraryk :: [Gen (U1 (LoT2 (Sem r) a))]
garbitraryk = Gen (U1 (LoT2 (Sem r) a)) -> [Gen (U1 (LoT2 (Sem r) a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gen (U1 (LoT2 (Sem r) a)) -> [Gen (U1 (LoT2 (Sem r) a))])
-> Gen (U1 (LoT2 (Sem r) a)) -> [Gen (U1 (LoT2 (Sem r) a))]
forall a b. (a -> b) -> a -> b
$ U1 (LoT2 (Sem r) a) -> Gen (U1 (LoT2 (Sem r) a))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 (LoT2 (Sem r) a)
forall k (p :: k). U1 p
U1
instance (GArbitraryK e f r a, GArbitraryK e g r a) => GArbitraryK e (f :*: g) r a where
garbitraryk :: [Gen ((:*:) f g (LoT2 (Sem r) a))]
garbitraryk = (Gen (f (LoT2 (Sem r) a))
-> Gen (g (LoT2 (Sem r) a)) -> Gen ((:*:) f g (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))]
-> [Gen (g (LoT2 (Sem r) a))]
-> [Gen ((:*:) f g (LoT2 (Sem r) a))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((f (LoT2 (Sem r) a)
-> g (LoT2 (Sem r) a) -> (:*:) f g (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a))
-> Gen (g (LoT2 (Sem r) a))
-> Gen ((:*:) f g (LoT2 (Sem r) a))
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f (LoT2 (Sem r) a)
-> g (LoT2 (Sem r) a) -> (:*:) f g (LoT2 (Sem r) a)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)) (forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e) (forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e)
instance Arbitrary (Interpret f (LoT2 (Sem r) a)) => GArbitraryK e (Field f) r a where
garbitraryk :: [Gen (Field f (LoT2 (Sem r) a))]
garbitraryk = Gen (Field f (LoT2 (Sem r) a)) -> [Gen (Field f (LoT2 (Sem r) a))]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gen (Field f (LoT2 (Sem r) a))
-> [Gen (Field f (LoT2 (Sem r) a))])
-> Gen (Field f (LoT2 (Sem r) a))
-> [Gen (Field f (LoT2 (Sem r) a))]
forall a b. (a -> b) -> a -> b
$ (Interpret f (LoT2 (Sem r) a) -> Field f (LoT2 (Sem r) a))
-> Gen (Interpret f (LoT2 (Sem r) a))
-> Gen (Field f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Interpret f (LoT2 (Sem r) a) -> Field f (LoT2 (Sem r) a)
forall {d} (t :: Atom d (*)) (x :: LoT d).
Interpret t x -> Field t x
Field Gen (Interpret f (LoT2 (Sem r) a))
forall a. Arbitrary a => Gen a
arbitrary
instance
( GArbitraryK e (SubstRep f (ExistentialFor e)) r a
, SubstRep' f (ExistentialFor e) (LoT2 (Sem r) a)
) => GArbitraryK e (Exists Type f) r a where
garbitraryk :: [Gen (Exists (*) f (LoT2 (Sem r) a))]
garbitraryk = (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a)
-> Exists (*) f (LoT2 (Sem r) a))
-> Gen (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a))
-> Gen (Exists (*) f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f (ExistentialFor e ':&&: LoT2 (Sem r) a)
-> Exists (*) f (LoT2 (Sem r) a)
forall k (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d).
f (t ':&&: x) -> Exists k f x
Exists (f (ExistentialFor e ':&&: LoT2 (Sem r) a)
-> Exists (*) f (LoT2 (Sem r) a))
-> (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a)
-> f (ExistentialFor e ':&&: LoT2 (Sem r) a))
-> SubstRep f (ExistentialFor e) (LoT2 (Sem r) a)
-> Exists (*) f (LoT2 (Sem r) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t k (f :: LoT (t -> k) -> *) (x :: t) (xs :: LoT k).
SubstRep' f x xs =>
SubstRep f x xs -> f (x ':&&: xs)
unsubstRep @_ @_ @_ @(ExistentialFor e)) (Gen (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a))
-> Gen (Exists (*) f (LoT2 (Sem r) a)))
-> [Gen (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a))]
-> [Gen (Exists (*) f (LoT2 (Sem r) a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @(SubstRep f (ExistentialFor e)) @r @a
instance (GArbitraryK e f r a, GArbitraryK e g r a) => GArbitraryK e (f :+: g) r a where
garbitraryk :: [Gen ((:+:) f g (LoT2 (Sem r) a))]
garbitraryk = (Gen (f (LoT2 (Sem r) a)) -> Gen ((:+:) f g (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))] -> [Gen ((:+:) f g (LoT2 (Sem r) a))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (LoT2 (Sem r) a) -> (:+:) f g (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a)) -> Gen ((:+:) f g (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (LoT2 (Sem r) a) -> (:+:) f g (LoT2 (Sem r) a)
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) (forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @f)
[Gen ((:+:) f g (LoT2 (Sem r) a))]
-> [Gen ((:+:) f g (LoT2 (Sem r) a))]
-> [Gen ((:+:) f g (LoT2 (Sem r) a))]
forall a. Semigroup a => a -> a -> a
<> (Gen (g (LoT2 (Sem r) a)) -> Gen ((:+:) f g (LoT2 (Sem r) a)))
-> [Gen (g (LoT2 (Sem r) a))] -> [Gen ((:+:) f g (LoT2 (Sem r) a))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g (LoT2 (Sem r) a) -> (:+:) f g (LoT2 (Sem r) a))
-> Gen (g (LoT2 (Sem r) a)) -> Gen ((:+:) f g (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (LoT2 (Sem r) a) -> (:+:) f g (LoT2 (Sem r) a)
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) (forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @g)
instance (Interpret c (LoT2 (Sem r) a), GArbitraryK e f r a) => GArbitraryK e (c :=>: f) r a where
garbitraryk :: [Gen ((:=>:) c f (LoT2 (Sem r) a))]
garbitraryk = (Gen (f (LoT2 (Sem r) a)) -> Gen ((:=>:) c f (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))]
-> [Gen ((:=>:) c f (LoT2 (Sem r) a))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (LoT2 (Sem r) a) -> (:=>:) c f (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a)) -> Gen ((:=>:) c f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (LoT2 (Sem r) a) -> (:=>:) c f (LoT2 (Sem r) a)
forall {d} (c :: Atom d Constraint) (x :: LoT d) (f :: LoT d -> *).
Interpret c x =>
f x -> (:=>:) c f x
SuchThat) (forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @f)
instance {-# OVERLAPPING #-} GArbitraryK e (c1 :=>: (c2 :=>: f)) r a
=> GArbitraryK e ((c1 ':&: c2) :=>: f) r a where
garbitraryk :: [Gen ((:=>:) (c1 ':&: c2) f (LoT2 (Sem r) a))]
garbitraryk =
((:=>:) c1 (c2 :=>: f) (LoT2 (Sem r) a)
-> (:=>:) (c1 ':&: c2) f (LoT2 (Sem r) a))
-> Gen ((:=>:) c1 (c2 :=>: f) (LoT2 (Sem r) a))
-> Gen ((:=>:) (c1 ':&: c2) f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
((\(SuchThat (SuchThat f x
x)) -> f x -> (:=>:) (c1 ':&: c2) f x
forall {d} (c :: Atom d Constraint) (x :: LoT d) (f :: LoT d -> *).
Interpret c x =>
f x -> (:=>:) c f x
SuchThat f x
x)
:: (c1 :=>: (c2 :=>: f)) x -> ((c1 ':&: c2) :=>: f) x)
(Gen ((:=>:) c1 (c2 :=>: f) (LoT2 (Sem r) a))
-> Gen ((:=>:) (c1 ':&: c2) f (LoT2 (Sem r) a)))
-> [Gen ((:=>:) c1 (c2 :=>: f) (LoT2 (Sem r) a))]
-> [Gen ((:=>:) (c1 ':&: c2) f (LoT2 (Sem r) a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e
instance {-# OVERLAPPING #-} GArbitraryK e f r a => GArbitraryK e ('Kon ((~~) a) ':@: Var1 :=>: f) r a where
garbitraryk :: [Gen ((:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a))]
garbitraryk = (f (LoT2 (Sem r) a)
-> (:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a))
-> Gen ((:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (LoT2 (Sem r) a)
-> (:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a)
forall {d} (c :: Atom d Constraint) (x :: LoT d) (f :: LoT d -> *).
Interpret c x =>
f x -> (:=>:) c f x
SuchThat (Gen (f (LoT2 (Sem r) a))
-> Gen ((:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))]
-> [Gen ((:=>:) ('Kon ((~~) a) ':@: Var1) f (LoT2 (Sem r) a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @f
instance {-# OVERLAPPING #-} GArbitraryK e f r a => GArbitraryK e ('Kon (~~) ':@: Var1 ':@: 'Kon a :=>: f) r a where
garbitraryk :: [Gen
((:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a))]
garbitraryk = (f (LoT2 (Sem r) a)
-> (:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a))
-> Gen
((:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (LoT2 (Sem r) a)
-> (:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a)
forall {d} (c :: Atom d Constraint) (x :: LoT d) (f :: LoT d -> *).
Interpret c x =>
f x -> (:=>:) c f x
SuchThat (Gen (f (LoT2 (Sem r) a))
-> Gen
((:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))]
-> [Gen
((:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon a) f (LoT2 (Sem r) a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @f
instance {-# INCOHERENT #-} GArbitraryK e ('Kon ((~~) b) ':@: Var1 :=>: f) r a where
garbitraryk :: [Gen ((:=>:) ('Kon ((~~) b) ':@: Var1) f (LoT2 (Sem r) a))]
garbitraryk = []
instance {-# INCOHERENT #-} GArbitraryK e ('Kon (~~) ':@: Var1 ':@: 'Kon b :=>: f) r a where
garbitraryk :: [Gen
((:=>:) (('Kon (~~) ':@: Var1) ':@: 'Kon b) f (LoT2 (Sem r) a))]
garbitraryk = []
instance (GArbitraryK e f r a) => GArbitraryK e (M1 _1 _2 f) r a where
garbitraryk :: [Gen (M1 _1 _2 f (LoT2 (Sem r) a))]
garbitraryk = (f (LoT2 (Sem r) a) -> M1 _1 _2 f (LoT2 (Sem r) a))
-> Gen (f (LoT2 (Sem r) a)) -> Gen (M1 _1 _2 f (LoT2 (Sem r) a))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (LoT2 (Sem r) a) -> M1 _1 _2 f (LoT2 (Sem r) a)
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Gen (f (LoT2 (Sem r) a)) -> Gen (M1 _1 _2 f (LoT2 (Sem r) a)))
-> [Gen (f (LoT2 (Sem r) a))]
-> [Gen (M1 _1 _2 f (LoT2 (Sem r) a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e
instance (Arbitrary a, ArbitraryEff r r, ArbitraryEffOfType a r r)
=> Arbitrary (Sem r a) where
arbitrary :: Gen (Sem r a)
arbitrary =
let terminal :: [Gen (Sem r a)]
terminal = [a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Sem r a) -> Gen a -> Gen (Sem r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary]
in (Int -> Gen (Sem r a)) -> Gen (Sem r a)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (Sem r a)) -> Gen (Sem r a))
-> (Int -> Gen (Sem r a)) -> Gen (Sem r a)
forall a b. (a -> b) -> a -> b
$ \Int
n ->
case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 of
Bool
True -> [Gen (Sem r a)] -> Gen (Sem r a)
forall a. [Gen a] -> Gen a
oneof [Gen (Sem r a)]
terminal
Bool
False -> [(Int, Gen (Sem r a))] -> Gen (Sem r a)
forall a. [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen (Sem r a))] -> Gen (Sem r a))
-> [(Int, Gen (Sem r a))] -> Gen (Sem r a)
forall a b. (a -> b) -> a -> b
$
[ (Int
2,) (Gen (Sem r a) -> (Int, Gen (Sem r a)))
-> Gen (Sem r a) -> (Int, Gen (Sem r a))
forall a b. (a -> b) -> a -> b
$ do
SomeEffOfType e (Sem r) a
e <- forall (effs :: EffectRow) (r :: EffectRow) a.
ArbitraryEffOfType a effs r =>
Gen (SomeEffOfType r a)
arbitraryActionFromRowOfType @r @r @a
Sem r a -> Gen (Sem r a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sem r a -> Gen (Sem r a)) -> Sem r a -> Gen (Sem r a)
forall a b. (a -> b) -> a -> b
$ e (Sem r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send e (Sem r) a
e
, (Int
8,) (Gen (Sem r a) -> (Int, Gen (Sem r a)))
-> Gen (Sem r a) -> (Int, Gen (Sem r a))
forall a b. (a -> b) -> a -> b
$ do
SomeEff e (Sem r) a
e <- forall (effs :: EffectRow) (r :: EffectRow).
ArbitraryEff effs r =>
Gen (SomeEff r)
arbitraryActionFromRow @r @r
a -> Sem r a
k <- Gen (Sem r a) -> Gen (a -> Sem r a)
forall a. Gen a -> Gen (a -> a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen (Sem r a) -> Gen (a -> Sem r a))
-> Gen (Sem r a) -> Gen (a -> Sem r a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Gen (Sem r a) -> Gen (Sem r a)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen (Sem r a)
forall a. Arbitrary a => Gen a
arbitrary
Sem r a -> Gen (Sem r a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sem r a -> Gen (Sem r a)) -> Sem r a -> Gen (Sem r a)
forall a b. (a -> b) -> a -> b
$ e (Sem r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send e (Sem r) a
e Sem r a -> (a -> Sem r a) -> Sem r a
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Sem r a
k
] [(Int, Gen (Sem r a))]
-> [(Int, Gen (Sem r a))] -> [(Int, Gen (Sem r a))]
forall a. Semigroup a => a -> a -> a
<> (Gen (Sem r a) -> (Int, Gen (Sem r a)))
-> [Gen (Sem r a)] -> [(Int, Gen (Sem r a))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
1,) [Gen (Sem r a)]
terminal
genEff :: forall e r a. (GenericK e, GArbitraryK e (RepK e) r a) => Gen (e (Sem r) a)
genEff :: forall (e :: Effect) (r :: EffectRow) a.
(GenericK e, GArbitraryK e (RepK e) r a) =>
Gen (e (Sem r) a)
genEff = (RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> e (Sem r) a)
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0))) -> Gen (e (Sem r) a)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> e (Sem r) a
RepK e (Sem r ':&&: (a ':&&: 'LoT0))
-> e :@@: (Sem r ':&&: (a ':&&: 'LoT0))
forall k (f :: k) (x :: LoT k). GenericK f => RepK f x -> f :@@: x
forall (x :: LoT Effect). RepK e x -> e :@@: x
toK (Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0))) -> Gen (e (Sem r) a))
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0))) -> Gen (e (Sem r) a)
forall a b. (a -> b) -> a -> b
$ [Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))]
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))
forall a. [Gen a] -> Gen a
oneof ([Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))]
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0))))
-> [Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))]
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))
forall a b. (a -> b) -> a -> b
$ forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @(RepK e) @r
arbitraryAction
:: forall e r
. ArbitraryAction (TypesOf e) e r
=> Gen (SomeAction e r)
arbitraryAction :: forall (e :: Effect) (r :: EffectRow).
ArbitraryAction (TypesOf e) e r =>
Gen (SomeAction e r)
arbitraryAction = [Gen (SomeAction e r)] -> Gen (SomeAction e r)
forall a. [Gen a] -> Gen a
oneof ([Gen (SomeAction e r)] -> Gen (SomeAction e r))
-> [Gen (SomeAction e r)] -> Gen (SomeAction e r)
forall a b. (a -> b) -> a -> b
$ forall (as :: [*]) (e :: Effect) (r :: EffectRow).
ArbitraryAction as e r =>
[Gen (SomeAction e r)]
genSomeAction @(TypesOf e) @e @r
arbitraryActionOfType
:: forall e a r
. (GenericK e, GArbitraryK e (RepK e) r a)
=> Gen (e (Sem r) a)
arbitraryActionOfType :: forall (e :: Effect) a (r :: EffectRow).
(GenericK e, GArbitraryK e (RepK e) r a) =>
Gen (e (Sem r) a)
arbitraryActionOfType = forall (e :: Effect) (r :: EffectRow) a.
(GenericK e, GArbitraryK e (RepK e) r a) =>
Gen (e (Sem r) a)
genEff @e @r @a
arbitraryActionFromRow
:: forall (effs :: EffectRow) r
. ArbitraryEff effs r
=> Gen (SomeEff r)
arbitraryActionFromRow :: forall (effs :: EffectRow) (r :: EffectRow).
ArbitraryEff effs r =>
Gen (SomeEff r)
arbitraryActionFromRow = [Gen (SomeEff r)] -> Gen (SomeEff r)
forall a. [Gen a] -> Gen a
oneof ([Gen (SomeEff r)] -> Gen (SomeEff r))
-> [Gen (SomeEff r)] -> Gen (SomeEff r)
forall a b. (a -> b) -> a -> b
$ forall (es :: EffectRow) (r :: EffectRow).
ArbitraryEff es r =>
[Gen (SomeEff r)]
genSomeEff @effs @r
arbitraryActionFromRowOfType
:: forall (effs :: EffectRow) r a
. ArbitraryEffOfType a effs r
=> Gen (SomeEffOfType r a)
arbitraryActionFromRowOfType :: forall (effs :: EffectRow) (r :: EffectRow) a.
ArbitraryEffOfType a effs r =>
Gen (SomeEffOfType r a)
arbitraryActionFromRowOfType = [Gen (SomeEffOfType r a)] -> Gen (SomeEffOfType r a)
forall a. [Gen a] -> Gen a
oneof ([Gen (SomeEffOfType r a)] -> Gen (SomeEffOfType r a))
-> [Gen (SomeEffOfType r a)] -> Gen (SomeEffOfType r a)
forall a b. (a -> b) -> a -> b
$ forall a (es :: EffectRow) (r :: EffectRow).
ArbitraryEffOfType a es r =>
[Gen (SomeEffOfType r a)]
genSomeEffOfType @a @effs @r
type family GTypesOf (f :: LoT Effect -> Type) :: [Type] where
GTypesOf (M1 _1 _2 f) = GTypesOf f
GTypesOf (f :+: g) = Append (GTypesOf f) (GTypesOf g)
GTypesOf (('Kon (~~) ':@: Var1 ':@: 'Kon a) :=>: f) = '[a]
GTypesOf (('Kon ((~~) a) ':@: Var1) :=>: f) = '[a]
GTypesOf _1 = '[()]
type TypesOf (e :: Effect) = GTypesOf (RepK e)
data SomeAction e (r :: EffectRow) where
SomeAction
:: (Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a))
=> e (Sem r) a
-> SomeAction e r
instance Show (SomeAction e r) where
show :: SomeAction e r -> String
show (SomeAction e (Sem r) a
ema) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
ema
data SomeEff (r :: EffectRow) where
SomeEff
:: (Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a))
=> e (Sem r) a
-> SomeEff r
instance Show (SomeEff r) where
show :: SomeEff r -> String
show (SomeEff e (Sem r) a
sse) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
sse
data SomeEffOfType (r :: EffectRow) a where
SomeEffOfType
:: (Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a))
=> e (Sem r) a
-> SomeEffOfType r a
instance Show (SomeEffOfType r a) where
show :: SomeEffOfType r a -> String
show (SomeEffOfType e (Sem r) a
sse) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
sse
class ArbitraryEff (es :: EffectRow) (r :: EffectRow) where
genSomeEff :: [Gen (SomeEff r)]
instance ArbitraryEff '[] r where
genSomeEff :: [Gen (SomeEff r)]
genSomeEff = []
instance
(ArbitraryEff es r, ArbitraryAction (TypesOf e) e r)
=> ArbitraryEff (e ': es) r
where
genSomeEff :: [Gen (SomeEff r)]
genSomeEff = (Gen (SomeAction e r) -> Gen (SomeEff r))
-> [Gen (SomeAction e r)] -> [Gen (SomeEff r)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeAction e r -> SomeEff r)
-> Gen (SomeAction e r) -> Gen (SomeEff r)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SomeAction e (Sem r) a
e) -> e (Sem r) a -> SomeEff r
forall (a :: Effect) (r :: EffectRow) a.
(Member a r, Eq a, Show a, CoArbitrary a, Show (a (Sem r) a)) =>
a (Sem r) a -> SomeEff r
SomeEff e (Sem r) a
e)) (forall (as :: [*]) (e :: Effect) (r :: EffectRow).
ArbitraryAction as e r =>
[Gen (SomeAction e r)]
genSomeAction @(TypesOf e) @e @r)
[Gen (SomeEff r)] -> [Gen (SomeEff r)] -> [Gen (SomeEff r)]
forall a. Semigroup a => a -> a -> a
<> forall (es :: EffectRow) (r :: EffectRow).
ArbitraryEff es r =>
[Gen (SomeEff r)]
genSomeEff @es @r
class ArbitraryEffOfType (a :: Type) (es :: EffectRow) (r :: EffectRow) where
genSomeEffOfType :: [Gen (SomeEffOfType r a)]
instance ArbitraryEffOfType a '[] r where
genSomeEffOfType :: [Gen (SomeEffOfType r a)]
genSomeEffOfType = []
instance
( Eq a
, Show a
, Show (e (Sem r) a)
, ArbitraryEffOfType a es r
, GenericK e
, GArbitraryK e (RepK e) r a
, CoArbitrary a
, Member e r
)
=> ArbitraryEffOfType a (e ': es) r
where
genSomeEffOfType :: [Gen (SomeEffOfType r a)]
genSomeEffOfType
= ((RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> SomeEffOfType r a)
-> Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))
-> Gen (SomeEffOfType r a)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: Effect) (r :: EffectRow) a.
(Member a r, Eq a, Show a, CoArbitrary a, Show (a (Sem r) a)) =>
a (Sem r) a -> SomeEffOfType r a
SomeEffOfType @e @r (e (Sem r) a -> SomeEffOfType r a)
-> (RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> e (Sem r) a)
-> RepK e (Sem r ':&&: (a ':&&: 'LoT0))
-> SomeEffOfType r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> e (Sem r) a
RepK e (Sem r ':&&: (a ':&&: 'LoT0))
-> e :@@: (Sem r ':&&: (a ':&&: 'LoT0))
forall k (f :: k) (x :: LoT k). GenericK f => RepK f x -> f :@@: x
forall (x :: LoT Effect). RepK e x -> e :@@: x
toK) (Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))
-> Gen (SomeEffOfType r a))
-> [Gen (RepK e (Sem r ':&&: (a ':&&: 'LoT0)))]
-> [Gen (SomeEffOfType r a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e @(RepK e) @r)
[Gen (SomeEffOfType r a)]
-> [Gen (SomeEffOfType r a)] -> [Gen (SomeEffOfType r a)]
forall a. Semigroup a => a -> a -> a
<> forall a (es :: EffectRow) (r :: EffectRow).
ArbitraryEffOfType a es r =>
[Gen (SomeEffOfType r a)]
genSomeEffOfType @a @es @r
class ArbitraryAction (as :: [Type]) (e :: Effect) (r :: EffectRow) where
genSomeAction :: [Gen (SomeAction e r)]
instance ArbitraryAction '[] e r where
genSomeAction :: [Gen (SomeAction e r)]
genSomeAction = []
instance
( ArbitraryAction as e r
, Eq a
, Show a
, Member e r
, Show (e (Sem r) a)
, GenericK e
, CoArbitrary a
, GArbitraryK e (RepK e) r a
)
=> ArbitraryAction (a : as) e r
where
genSomeAction :: [Gen (SomeAction e r)]
genSomeAction = ((e (Sem r) a -> SomeAction e r)
-> Gen (e (Sem r) a) -> Gen (SomeAction e r)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e (Sem r) a -> SomeAction e r
forall (e :: Effect) (r :: EffectRow) a.
(Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a)) =>
e (Sem r) a -> SomeAction e r
SomeAction (Gen (e (Sem r) a) -> Gen (SomeAction e r))
-> Gen (e (Sem r) a) -> Gen (SomeAction e r)
forall a b. (a -> b) -> a -> b
$ forall (e :: Effect) (r :: EffectRow) a.
(GenericK e, GArbitraryK e (RepK e) r a) =>
Gen (e (Sem r) a)
genEff @e @r @a) Gen (SomeAction e r)
-> [Gen (SomeAction e r)] -> [Gen (SomeAction e r)]
forall a. a -> [a] -> [a]
: forall (as :: [*]) (e :: Effect) (r :: EffectRow).
ArbitraryAction as e r =>
[Gen (SomeAction e r)]
genSomeAction @as @e @r