{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Registry.Hedgehog
  ( -- creation / tweaking functions
    GenIO,
    Chooser (..),
    forallS,
    forAllT, -- re-export of forAllT for convenience purpose since we are working in GenIO
    filterGenS,
    genFun,
    genVal,
    genWith,
    modifyGenS,
    setGen,
    setGenIO,
    setGenS,
    specializeGen,
    specializeGenIO,
    specializeGenS,
    tweakGen,
    tweakGenS,
    makeNonEmpty,
    makeNonEmptyS,
    -- combinators to compose different types of generators
    eitherOf,
    hashMapOf,
    listOf,
    listOfMinMax,
    mapOf,
    maybeOf,
    nonEmptyMapOf,
    nonEmptyOf,
    pairOf,
    setOf,
    tripleOf,
    -- cycling values
    choiceChooser,
    chooseOne,
    setCycleChooser,
    setCycleChooserS,
    -- making distinct values
    distinct,
    setDistinct,
    setDistinctFor,
    setDistinctForS,
    setDistinctS,
    -- sampling for GenIO generators
    sampleIO,
  )
where

import Control.Monad.Morph
import Data.HashMap.Strict as HashMap (HashMap, fromList)
import Data.IORef
import Data.List.NonEmpty hiding (cycle, nonEmpty, (!!))
import Data.Map as Map (fromList)
import Data.Maybe as Maybe
import Data.Registry
import Data.Registry.Internal.Hedgehog
import Data.Registry.Internal.Types
import Data.Set as Set (fromList)
import Hedgehog
import Hedgehog.Gen as Gen
import Hedgehog.Internal.Property (forAllT)
import Hedgehog.Range
import Protolude as P
import System.IO.Unsafe

-- * CREATION / TWEAKING OF REGISTRY GENERATORS

-- | Create a GenIO a for a given constructor of type a
genFun :: forall a b. (ApplyVariadic GenIO a b, Typeable a, Typeable b) => a -> Typed b
genFun :: a -> Typed b
genFun = forall a b.
(ApplyVariadic GenIO a b, Typeable a, Typeable b) =>
a -> Typed b
forall (m :: * -> *) a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
funTo @GenIO

-- | Lift a Gen a into GenIO a to be added to a registry
genVal :: forall a. (Typeable a) => Gen a -> Typed (GenIO a)
genVal :: Gen a -> Typed (GenIO a)
genVal Gen a
g = GenIO a -> Typed (GenIO a)
forall a. Typeable a => a -> Typed a
fun (Gen a -> GenIO a
forall (m :: * -> *) a. Monad m => Gen a -> GenT m a
liftGen Gen a
g)

-- | Extract a generator from a registry
--   We use makeUnsafe assuming that the registry has been checked before
genWith :: forall a ins out. (Typeable a) => Registry ins out -> GenIO a
genWith :: Registry ins out -> GenIO a
genWith = forall (ins :: [*]) (out :: [*]).
Typeable (GenIO a) =>
Registry ins out -> GenIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(GenIO a)

-- | Modify the value of a generator in a given registry
tweakGen :: forall a ins out. (Typeable a) => (a -> a) -> Registry ins out -> Registry ins out
tweakGen :: (a -> a) -> Registry ins out -> Registry ins out
tweakGen a -> a
f = (GenIO a -> GenIO a) -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweak @(GenIO a) (a -> a
f (a -> a) -> GenIO a -> GenIO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Modify the registry for a given generator in a State monad
tweakGenS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => (a -> a) -> m ()
tweakGenS :: (a -> a) -> m ()
tweakGenS a -> a
f = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((a -> a) -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweakGen a -> a
f)

-- | Set a specific generator on the registry the value of a generator in a given registry
setGen :: forall a ins out. (Typeable a) => Gen a -> Registry ins out -> Registry ins out
setGen :: Gen a -> Registry ins out -> Registry ins out
setGen = GenIO a -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
GenIO a -> Registry ins out -> Registry ins out
setGenIO (GenIO a -> Registry ins out -> Registry ins out)
-> (Gen a -> GenIO a)
-> Gen a
-> Registry ins out
-> Registry ins out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen a -> GenIO a
forall (m :: * -> *) a. Monad m => Gen a -> GenT m a
liftGen

setGenIO :: forall a ins out. (Typeable a) => GenIO a -> Registry ins out -> Registry ins out
setGenIO :: GenIO a -> Registry ins out -> Registry ins out
setGenIO GenIO a
genA = (GenIO a -> GenIO a) -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweak @(GenIO a) (GenIO a -> GenIO a -> GenIO a
forall a b. a -> b -> a
const GenIO a
genA)

-- | Set a specific generator on the registry the value of a generator in a given registry in a State monad
setGenS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => Gen a -> m ()
setGenS :: Gen a -> m ()
setGenS Gen a
genA = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Gen a -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Gen a -> Registry ins out -> Registry ins out
setGen Gen a
genA)

-- | Specialize a generator in a given context
specializeGen :: forall a b ins out. (Typeable a, Typeable b, Contains (GenIO a) out) => Gen b -> Registry ins out -> Registry ins out
specializeGen :: Gen b -> Registry ins out -> Registry ins out
specializeGen Gen b
g = GenIO b -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, Contains (GenIO a) out) =>
GenIO b -> Registry ins out -> Registry ins out
specializeGenIO @a (Gen b -> GenIO b
forall (m :: * -> *) a. Monad m => Gen a -> GenT m a
liftGen Gen b
g)

-- | Specialize a generator in a given context
specializeGenIO :: forall a b ins out. (Typeable a, Typeable b, Contains (GenIO a) out) => GenIO b -> Registry ins out -> Registry ins out
specializeGenIO :: GenIO b -> Registry ins out -> Registry ins out
specializeGenIO = forall b (ins :: [*]) (out :: [*]).
(Typeable (GenIO a), Typeable b) =>
b -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b) =>
b -> Registry ins out -> Registry ins out
specialize @(GenIO a)

-- | Specialize a generator in a given context
specializeGenS :: forall a b m ins out. (Typeable a, Typeable b, Contains (GenIO a) out, MonadState (Registry ins out) m) => Gen b -> m ()
specializeGenS :: Gen b -> m ()
specializeGenS Gen b
g = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Gen b -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, Contains (GenIO a) out) =>
Gen b -> Registry ins out -> Registry ins out
specializeGen @a @b Gen b
g)

-- | Modify a generator
modifyGenS :: forall a ins out. (Typeable a) => (GenIO a -> GenIO a) -> PropertyT (StateT (Registry ins out) IO) ()
modifyGenS :: (GenIO a -> GenIO a) -> PropertyT (StateT (Registry ins out) IO) ()
modifyGenS GenIO a -> GenIO a
f = (Registry ins out -> Registry ins out)
-> PropertyT (StateT (Registry ins out) IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GenIO a -> GenIO a) -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweak @(GenIO a) GenIO a -> GenIO a
f)

-- | Filter a generator
filterGenS :: forall a ins out. (Typeable a) => (a -> Bool) -> PropertyT (StateT (Registry ins out) IO) ()
filterGenS :: (a -> Bool) -> PropertyT (StateT (Registry ins out) IO) ()
filterGenS = (GenIO a -> GenIO a) -> PropertyT (StateT (Registry ins out) IO) ()
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(GenIO a -> GenIO a) -> PropertyT (StateT (Registry ins out) IO) ()
modifyGenS ((GenIO a -> GenIO a)
 -> PropertyT (StateT (Registry ins out) IO) ())
-> ((a -> Bool) -> GenIO a -> GenIO a)
-> (a -> Bool)
-> PropertyT (StateT (Registry ins out) IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> GenIO a -> GenIO a
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
Gen.filterT

-- | Get a value generated from one of the generators in the registry and modify the registry
--   using a state monad
forallS :: forall a m out. (Typeable a, Show a, MonadIO m) => PropertyT (StateT (Registry _ out) m) a
forallS :: PropertyT (StateT (Registry _ out) m) a
forallS = do
  Registry _ out
r <- StateT (Registry _ out) m (Registry _ out)
-> PropertyT (StateT (Registry _ out) m) (Registry _ out)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
P.lift (StateT (Registry _ out) m (Registry _ out)
 -> PropertyT (StateT (Registry _ out) m) (Registry _ out))
-> StateT (Registry _ out) m (Registry _ out)
-> PropertyT (StateT (Registry _ out) m) (Registry _ out)
forall a b. (a -> b) -> a -> b
$ StateT (Registry _ out) m (Registry _ out)
forall s (m :: * -> *). MonadState s m => m s
get
  (HasCallStack => PropertyT (StateT (Registry _ out) m) a)
-> PropertyT (StateT (Registry _ out) m) a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => PropertyT (StateT (Registry _ out) m) a)
 -> PropertyT (StateT (Registry _ out) m) a)
-> (HasCallStack => PropertyT (StateT (Registry _ out) m) a)
-> PropertyT (StateT (Registry _ out) m) a
forall a b. (a -> b) -> a -> b
$ (forall a. IO a -> StateT (Registry _ out) m a)
-> PropertyT IO a -> PropertyT (StateT (Registry _ out) m) a
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. IO a -> StateT (Registry _ out) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PropertyT IO a -> PropertyT (StateT (Registry _ out) m) a)
-> PropertyT IO a -> PropertyT (StateT (Registry _ out) m) a
forall a b. (a -> b) -> a -> b
$ GenT IO a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
GenT m a -> PropertyT m a
forAllT (Registry _ out -> GenT IO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> GenIO a
genWith @a Registry _ out
r)

-- | Make sure there is always one element of a given type in a list of elements
makeNonEmpty :: forall a ins out. (Typeable a) => Registry ins out -> Registry ins out
makeNonEmpty :: Registry ins out -> Registry ins out
makeNonEmpty Registry ins out
r =
  -- extract a generator for one element only
  let genA :: GenIO a
genA = Registry ins out -> GenIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> GenIO a
genWith @a Registry ins out
r
   in -- add that element in front of a list of generated elements
      (GenIO [a] -> GenIO [a]) -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweak @(GenIO [a]) (\GenIO [a]
genAs -> (:) (a -> [a] -> [a]) -> GenIO a -> GenT IO ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO a
genA GenT IO ([a] -> [a]) -> GenIO [a] -> GenIO [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenIO [a]
genAs) Registry ins out
r

-- | Make sure there is always one element of a given type in a list of elements in a State monad
makeNonEmptyS :: forall a m ins out. (Typeable a, MonadState (Registry ins out) m) => m ()
makeNonEmptyS :: m ()
makeNonEmptyS = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Registry ins out
makeNonEmpty @a)

-- * CONTAINERS COMBINATORS

-- | Create a generator for a pair
pairOf :: forall a b. GenIO a -> GenIO b -> GenIO (a, b)
pairOf :: GenIO a -> GenIO b -> GenIO (a, b)
pairOf GenIO a
ga GenIO b
gb = (,) (a -> b -> (a, b)) -> GenIO a -> GenT IO (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO a
ga GenT IO (b -> (a, b)) -> GenIO b -> GenIO (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenIO b
gb

-- | Create a generator for a triple
tripleOf :: forall a b c. GenIO a -> GenIO b -> GenIO c -> GenIO (a, b, c)
tripleOf :: GenIO a -> GenIO b -> GenIO c -> GenIO (a, b, c)
tripleOf GenIO a
ga GenIO b
gb GenIO c
gc = (,,) (a -> b -> c -> (a, b, c))
-> GenIO a -> GenT IO (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO a
ga GenT IO (b -> c -> (a, b, c))
-> GenIO b -> GenT IO (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenIO b
gb GenT IO (c -> (a, b, c)) -> GenIO c -> GenIO (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenIO c
gc

-- | Create a default generator for a small list of elements
listOf :: forall a. GenIO a -> GenIO [a]
listOf :: GenIO a -> GenIO [a]
listOf = Range Int -> GenIO a -> GenIO [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
linear Int
0 Int
10)

-- | Create a default generator for a list of elements of min elements and max elements
listOfMinMax :: forall a. Int -> Int -> GenIO a -> GenIO [a]
listOfMinMax :: Int -> Int -> GenIO a -> GenIO [a]
listOfMinMax Int
min' Int
max' = Range Int -> GenIO a -> GenIO [a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
linear Int
min' Int
max')

-- | Create a default generator for a small non-empty list of elements
nonEmptyOf :: GenIO a -> GenIO (NonEmpty a)
nonEmptyOf :: GenIO a -> GenIO (NonEmpty a)
nonEmptyOf = Range Int -> GenIO a -> GenIO (NonEmpty a)
forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (NonEmpty a)
Gen.nonEmpty (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
linear Int
1 Int
10)

-- | Create a default generator for a Maybe, choosing evenly between Nothing and Just
maybeOf :: forall a. GenIO a -> GenIO (Maybe a)
maybeOf :: GenIO a -> GenIO (Maybe a)
maybeOf GenIO a
genA = [GenIO (Maybe a)] -> GenIO (Maybe a)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
choice [Maybe a -> GenIO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> GenIO a -> GenIO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO a
genA]

-- | Create a default generator for a Either, choosing evenly between Left and Right
eitherOf :: forall a b. GenIO a -> GenIO b -> GenIO (Either a b)
eitherOf :: GenIO a -> GenIO b -> GenIO (Either a b)
eitherOf GenIO a
genA GenIO b
genB = [GenIO (Either a b)] -> GenIO (Either a b)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
choice [a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> GenIO a -> GenIO (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO a
genA, b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> GenIO b -> GenIO (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO b
genB]

-- | Create a default generator for a small set of elements
setOf :: forall a. (Ord a) => GenIO a -> GenIO (Set a)
setOf :: GenIO a -> GenIO (Set a)
setOf = ([a] -> Set a) -> GenT IO [a] -> GenIO (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (GenT IO [a] -> GenIO (Set a))
-> (GenIO a -> GenT IO [a]) -> GenIO a -> GenIO (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenIO a -> GenT IO [a]
forall a. GenIO a -> GenIO [a]
listOf

-- | Create a default generator for map of key/values
mapOf :: forall k v. (Ord k) => GenIO k -> GenIO v -> GenIO (Map k v)
mapOf :: GenIO k -> GenIO v -> GenIO (Map k v)
mapOf GenIO k
gk GenIO v
gv = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> GenT IO [(k, v)] -> GenIO (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO (k, v) -> GenT IO [(k, v)]
forall a. GenIO a -> GenIO [a]
listOf (GenIO k -> GenIO v -> GenIO (k, v)
forall a b. GenIO a -> GenIO b -> GenIO (a, b)
pairOf GenIO k
gk GenIO v
gv)

-- | Create a default generator for HashMap of key/values
hashMapOf :: forall k v. (Ord k, Hashable k) => GenIO k -> GenIO v -> GenIO (HashMap k v)
hashMapOf :: GenIO k -> GenIO v -> GenIO (HashMap k v)
hashMapOf GenIO k
gk GenIO v
gv = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(k, v)] -> HashMap k v)
-> GenT IO [(k, v)] -> GenIO (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO (k, v) -> GenT IO [(k, v)]
forall a. GenIO a -> GenIO [a]
listOf (GenIO k -> GenIO v -> GenIO (k, v)
forall a b. GenIO a -> GenIO b -> GenIO (a, b)
pairOf GenIO k
gk GenIO v
gv)

-- | Create a default generator for a small non-empty map of elements
nonEmptyMapOf :: forall k v. (Ord k) => GenIO k -> GenIO v -> GenIO (Map k v)
nonEmptyMapOf :: GenIO k -> GenIO v -> GenIO (Map k v)
nonEmptyMapOf GenIO k
gk GenIO v
gv = do
  (k, v)
h <- GenIO k -> GenIO v -> GenIO (k, v)
forall a b. GenIO a -> GenIO b -> GenIO (a, b)
pairOf GenIO k
gk GenIO v
gv
  [(k, v)]
t <- GenIO (k, v) -> GenIO [(k, v)]
forall a. GenIO a -> GenIO [a]
listOf (GenIO k -> GenIO v -> GenIO (k, v)
forall a b. GenIO a -> GenIO b -> GenIO (a, b)
pairOf GenIO k
gk GenIO v
gv)
  Map k v -> GenIO (Map k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((k, v)
h (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)]
t))

-- * STATEFUL GENERATORS

-- * CHOOSING VALUES DETERMINISTICALLY

-- | Set a cycling chooser for a specific data type
{-# NOINLINE setCycleChooser #-}
setCycleChooser :: forall a ins out. (Typeable a, Contains (GenIO a) out) => Registry ins out -> Registry ins out
setCycleChooser :: Registry ins out -> Registry ins out
setCycleChooser Registry ins out
r = IO (Registry ins out) -> Registry ins out
forall a. IO a -> a
unsafePerformIO (IO (Registry ins out) -> Registry ins out)
-> IO (Registry ins out) -> Registry ins out
forall a b. (a -> b) -> a -> b
$ do
  Chooser
c <- IO Chooser
cycleChooser
  Registry ins out -> IO (Registry ins out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Registry ins out -> IO (Registry ins out))
-> Registry ins out -> IO (Registry ins out)
forall a b. (a -> b) -> a -> b
$ Chooser -> Registry ins out -> Registry ins out
forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(Applicative m, Typeable a, Typeable (m b), Typeable b, Show b) =>
b -> Registry ins out -> Registry ins out
specializeValTo @GenIO @(GenIO a) Chooser
c Registry ins out
r

-- | Set a cycling chooser for a specific data type
{-# NOINLINE setCycleChooserS #-}
setCycleChooserS :: forall a m ins out. (Typeable a, Contains (GenIO a) out, MonadState (Registry ins out) m, MonadIO m) => m ()
setCycleChooserS :: m ()
setCycleChooserS =
  let c :: Chooser
c = IO Chooser -> Chooser
forall a. IO a -> a
unsafePerformIO IO Chooser
cycleChooser
   in do
        Registry ins out
r <- m (Registry ins out)
forall s (m :: * -> *). MonadState s m => m s
get
        let r' :: Registry ins out
r' = Chooser -> Registry ins out -> Registry ins out
forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(Applicative m, Typeable a, Typeable (m b), Typeable b, Show b) =>
b -> Registry ins out -> Registry ins out
specializeValTo @GenIO @(GenIO a) Chooser
c Registry ins out
r
        Registry ins out -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Registry ins out
r'

-- * MAKING DISTINCT VALUES

-- | Generate distinct values for a specific data type
{-# NOINLINE setDistinct #-}
setDistinct :: forall a ins out. (Eq a, Typeable a, Contains (GenIO a) out) => Registry ins out -> Registry ins out
setDistinct :: Registry ins out -> Registry ins out
setDistinct = IORef [a] -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
(Eq a, Typeable a, Contains (GenIO a) out) =>
IORef [a] -> Registry ins out -> Registry ins out
setDistinctWithRef @a (IO (IORef [a]) -> IORef [a]
forall a. IO a -> a
unsafePerformIO (IO (IORef [a]) -> IORef [a]) -> IO (IORef [a]) -> IORef [a]
forall a b. (a -> b) -> a -> b
$ [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef [])

setDistinctWithRef :: forall a ins out. (Eq a, Typeable a, Contains (GenIO a) out) => IORef [a] -> Registry ins out -> Registry ins out
setDistinctWithRef :: IORef [a] -> Registry ins out -> Registry ins out
setDistinctWithRef IORef [a]
ref Registry ins out
r = GenIO a -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
GenIO a -> Registry ins out -> Registry ins out
setGenIO (IORef [a] -> GenIO a -> GenIO a
forall (m :: * -> *) a.
(MonadIO m, Eq a) =>
IORef [a] -> GenT m a -> GenT m a
distinctWith IORef [a]
ref (Registry ins out -> GenIO a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(GenIO a) Registry ins out
r)) Registry ins out
r

-- | Generate distinct values for a specific data type
{-# NOINLINE setDistinctS #-}
setDistinctS :: forall a m ins out. (Eq a, Typeable a, Contains (GenIO a) out, MonadState (Registry ins out) m, MonadIO m) => m ()
setDistinctS :: m ()
setDistinctS =
  let ref :: IORef [a]
ref = IO (IORef [a]) -> IORef [a]
forall a. IO a -> a
unsafePerformIO (IO (IORef [a]) -> IORef [a]) -> IO (IORef [a]) -> IORef [a]
forall a b. (a -> b) -> a -> b
$ [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef []
   in (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (IORef [a] -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
(Eq a, Typeable a, Contains (GenIO a) out) =>
IORef [a] -> Registry ins out -> Registry ins out
setDistinctWithRef @a IORef [a]
forall a. IORef [a]
ref)

-- | Generate distinct values for a specific data type, when used inside another data type
{-# NOINLINE setDistinctFor #-}
setDistinctFor :: forall a b ins out. (Typeable a, Contains (GenIO a) out, Eq b, Typeable b, Contains (GenIO b) out) => Registry ins out -> Registry ins out
setDistinctFor :: Registry ins out -> Registry ins out
setDistinctFor = IORef [b] -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Contains (GenIO a) out, Eq b, Typeable b,
 Contains (GenIO b) out) =>
IORef [b] -> Registry ins out -> Registry ins out
setDistinctForWithRef @a @b (IO (IORef [b]) -> IORef [b]
forall a. IO a -> a
unsafePerformIO (IO (IORef [b]) -> IORef [b]) -> IO (IORef [b]) -> IORef [b]
forall a b. (a -> b) -> a -> b
$ [b] -> IO (IORef [b])
forall a. a -> IO (IORef a)
newIORef [])

setDistinctForWithRef :: forall a b ins out. (Typeable a, Contains (GenIO a) out, Eq b, Typeable b, Contains (GenIO b) out) => IORef [b] -> Registry ins out -> Registry ins out
setDistinctForWithRef :: IORef [b] -> Registry ins out -> Registry ins out
setDistinctForWithRef IORef [b]
ref Registry ins out
r = GenIO b -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, Contains (GenIO a) out) =>
GenIO b -> Registry ins out -> Registry ins out
specializeGenIO @a (IORef [b] -> GenIO b -> GenIO b
forall (m :: * -> *) a.
(MonadIO m, Eq a) =>
IORef [a] -> GenT m a -> GenT m a
distinctWith IORef [b]
ref (Registry ins out -> GenIO b
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(GenIO b) Registry ins out
r)) Registry ins out
r

-- | Generate distinct values for a specific data type, when used inside another data type
{-# NOINLINE setDistinctForS #-}
setDistinctForS :: forall a b m ins out. (Typeable a, Contains (GenIO a) out, Eq b, Typeable b, Contains (GenIO b) out, MonadState (Registry ins out) m, MonadIO m) => m ()
setDistinctForS :: m ()
setDistinctForS =
  let ref :: IORef [a]
ref = IO (IORef [a]) -> IORef [a]
forall a. IO a -> a
unsafePerformIO (IO (IORef [a]) -> IORef [a]) -> IO (IORef [a]) -> IORef [a]
forall a b. (a -> b) -> a -> b
$ [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef []
   in (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (IORef [b] -> Registry ins out -> Registry ins out
forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Contains (GenIO a) out, Eq b, Typeable b,
 Contains (GenIO b) out) =>
IORef [b] -> Registry ins out -> Registry ins out
setDistinctForWithRef @a @b IORef [b]
forall a. IORef [a]
ref)