{-# 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)
import Generics.Kind.Unexported
import Polysemy
import Polysemy.Internal
import Test.QuickCheck


------------------------------------------------------------------------------
-- | Data family for the instantiation of existential variables. If you want to
-- check properties for an effect @e@ that contains an existential type, the
-- synthesized 'Arbitrary' instance will instantiate all of @e@'s existential
-- types at @'ExistentialFor' e@.
--
-- @'ExistentialFor' e@ must have instances for every dictionary required by
-- @e@, and will likely require an 'Arbitrary' instance.
data family ExistentialFor (e :: Effect)


------------------------------------------------------------------------------
-- | Given @'GArbitraryK' e ('RepK' e) r a@, this typeclass computes
-- generators for every well-typed constructor of @e (Sem r) a@. It is capable
-- of building generators for GADTs.
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 (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 (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 (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 (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 (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
forall (e :: Effect) (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
garbitraryk @e) (forall (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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 (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 (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)
forall (xs :: LoT Effect).
SubstRep' f (ExistentialFor e) xs =>
SubstRep f (ExistentialFor e) xs -> f (ExistentialFor e ':&&: 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
<$>
    GArbitraryK e (SubstRep f (ExistentialFor e)) r a =>
[Gen (SubstRep f (ExistentialFor e) (LoT2 (Sem r) a))]
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 (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 (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 (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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 (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 (r :: EffectRow) a.
GArbitraryK e g r a =>
[Gen (g (LoT2 (Sem r) a))]
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 (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 (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 (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((\(SuchThat (SuchThat x :: 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 (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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 (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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 (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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 (f :: LoT Effect -> *) (r :: EffectRow) a.
GArbitraryK e f r a =>
[Gen (f (LoT2 (Sem r) a))]
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 (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
$ \n :: Int
n ->
          case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 of
            True -> [Gen (Sem r a)] -> Gen (Sem r a)
forall a. [Gen a] -> Gen a
oneof [Gen (Sem r a)]
terminal
            False -> [Gen (Sem r a)] -> Gen (Sem r a)
forall a. [Gen a] -> Gen a
oneof ([Gen (Sem r a)] -> Gen (Sem r a))
-> [Gen (Sem r a)] -> Gen (Sem r a)
forall a b. (a -> b) -> a -> b
$
              [ do
                  SomeEffOfType e :: e (Sem r) a
e <- ArbitraryEffOfType a r r => Gen (SomeEffOfType r a)
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 (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
              , do
                  SomeEff e :: e (Sem r) a
e <- ArbitraryEff r r => Gen (SomeEff r)
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 (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` 2) Gen (Sem r a)
forall a. Arbitrary a => Gen a
arbitrary
                  Sem r a -> Gen (Sem r 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Sem r a
k
              ] [Gen (Sem r a)] -> [Gen (Sem r a)] -> [Gen (Sem r a)]
forall a. Semigroup a => a -> a -> a
<> [Gen (Sem r a)]
terminal

------------------------------------------------------------------------------
-- | @genEff \@e \@r \@a@ gets a generator capable of producing every
-- well-typed GADT constructor of @e (Sem r) a@.
genEff :: forall e r a. (GenericK e, GArbitraryK e (RepK e) r a) => Gen (e (Sem r) a)
genEff :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RepK e (Sem r ':&&: (a ':&&: 'LoT0)) -> e (Sem r) a
forall k (f :: k) (x :: LoT k). GenericK f => RepK f x -> f :@@: 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 a.
GArbitraryK e (RepK e) r a =>
[Gen (RepK e (LoT2 (Sem r) a))]
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


------------------------------------------------------------------------------
-- | Generate any action for effect @e@.
arbitraryAction
    :: forall e r
     . ArbitraryAction (TypesOf e) e r
    => Gen (SomeAction e r)
       -- ^
arbitraryAction :: 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
$ ArbitraryAction (TypesOf e) e r => [Gen (SomeAction e r)]
forall (as :: [*]) (e :: Effect) (r :: EffectRow).
ArbitraryAction as e r =>
[Gen (SomeAction e r)]
genSomeAction @(TypesOf e) @e @r


------------------------------------------------------------------------------
-- | Generate any action for effect @e@ that produces type @a@.
arbitraryActionOfType
    :: forall e a r
     . (GenericK e, GArbitraryK e (RepK e) r a)
    => Gen (e (Sem r) a)
       -- ^
arbitraryActionOfType :: Gen (e (Sem r) a)
arbitraryActionOfType = (GenericK e, GArbitraryK e (RepK e) r a) => Gen (e (Sem r) a)
forall (e :: Effect) (r :: EffectRow) a.
(GenericK e, GArbitraryK e (RepK e) r a) =>
Gen (e (Sem r) a)
genEff @e @r @a


------------------------------------------------------------------------------
-- | Generate any action from any effect in @effs@.
arbitraryActionFromRow
    :: forall (effs :: EffectRow) r
     . ArbitraryEff effs r
    => Gen (SomeEff r)
       -- ^
arbitraryActionFromRow :: 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
$ ArbitraryEff effs r => [Gen (SomeEff r)]
forall (es :: EffectRow) (r :: EffectRow).
ArbitraryEff es r =>
[Gen (SomeEff r)]
genSomeEff @effs @r


------------------------------------------------------------------------------
-- | Generate any action from any effect in @effs@ that produces type @a@.
arbitraryActionFromRowOfType
    :: forall (effs :: EffectRow) r a
     . ArbitraryEffOfType a effs r
    => Gen (SomeEffOfType r a)
       -- ^
arbitraryActionFromRowOfType :: 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
$ ArbitraryEffOfType a effs r => [Gen (SomeEffOfType r a)]
forall a (es :: EffectRow) (r :: EffectRow).
ArbitraryEffOfType a es r =>
[Gen (SomeEffOfType r a)]
genSomeEffOfType @a @effs @r


------------------------------------------------------------------------------
-- | Helper function for implementing 'GTypesOf'
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]
  -- Otherwise, we don't have any constraints on @a@, so we can instantiate it
  -- how we please. Just assume ().
  GTypesOf _1 = '[()]


------------------------------------------------------------------------------
-- | @'TypesOf' e@ is a list of every type that can be bound via @e@'s actions.
--
-- For example, given:
--
-- @
-- data MyEffect m a where
--   Foo :: MyEffect m Int
--   Blah :: Bool -> MyEffect m String
-- @
--
-- the result of @'TypesOf' MyEffect@ is @'[Int, String]@.
type TypesOf (e :: Effect) = GTypesOf (RepK e)


------------------------------------------------------------------------------
-- | @'SomeAction' e r@ is some action for effect @e@ in effect row @r@.
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 ema :: e (Sem r) a
ema) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
ema


------------------------------------------------------------------------------
-- | @'SomeEff' r@ is some action for some effect in the effect row @r@.
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 sse :: e (Sem r) a
sse) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
sse


------------------------------------------------------------------------------
-- | @'SomeEff' r@ is some action for some effect in the effect row @r@.
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 sse :: e (Sem r) a
sse) = e (Sem r) a -> String
forall a. Show a => a -> String
show e (Sem r) a
sse


------------------------------------------------------------------------------
-- | @'ArbitraryEff' es r@ lets you randomly generate an action in any of
-- the effects @es@.
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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SomeAction e :: e (Sem r) a
e) -> e (Sem r) a -> SomeEff 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 -> SomeEff r
SomeEff e (Sem r) a
e)) (ArbitraryAction (TypesOf e) e r => [Gen (SomeAction e r)]
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
<> ArbitraryEff es r => [Gen (SomeEff r)]
forall (es :: EffectRow) (r :: EffectRow).
ArbitraryEff es r =>
[Gen (SomeEff r)]
genSomeEff @es @r


------------------------------------------------------------------------------
-- | @'ArbitraryEffOfType' a es r@ lets you randomly generate an action in any of
-- the effects @es@ that produces type @a@.
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
(Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a)) =>
e (Sem r) a -> SomeEffOfType r a
forall (e :: Effect) (r :: EffectRow) a.
(Member e r, Eq a, Show a, CoArbitrary a, Show (e (Sem r) a)) =>
e (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
forall k (f :: k) (x :: LoT k). GenericK f => RepK f x -> f :@@: 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 a.
GArbitraryK e (RepK e) r a =>
[Gen (RepK e (LoT2 (Sem r) a))]
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
<> ArbitraryEffOfType a es r => [Gen (SomeEffOfType r a)]
forall a (es :: EffectRow) (r :: EffectRow).
ArbitraryEffOfType a es r =>
[Gen (SomeEffOfType r a)]
genSomeEffOfType @a @es @r


------------------------------------------------------------------------------
-- | @'ArbitraryAction' as e r@ lets you randomly generate an action
-- producing any type in @as@ from the effect @e@.
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 (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
$ (GenericK e, GArbitraryK e (RepK e) r a) => Gen (e (Sem r) a)
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]
: ArbitraryAction as e r => [Gen (SomeAction e r)]
forall (as :: [*]) (e :: Effect) (r :: EffectRow).
ArbitraryAction as e r =>
[Gen (SomeAction e r)]
genSomeAction @as @e @r