{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Registry.Hedgehog
(
GenIO,
Chooser (..),
forallS,
forAllT,
filterGenS,
genFun,
genVal,
genWith,
modifyGenS,
setGen,
setGenIO,
setGenS,
specializeGen,
specializeGenIO,
specializeGenS,
tweakGen,
tweakGenS,
makeNonEmpty,
makeNonEmptyS,
eitherOf,
hashMapOf,
listOf,
listOfMinMax,
mapOf,
maybeOf,
nonEmptyMapOf,
nonEmptyOf,
pairOf,
setOf,
tripleOf,
choiceChooser,
chooseOne,
setCycleChooser,
setCycleChooserS,
distinct,
setDistinct,
setDistinctFor,
setDistinctForS,
setDistinctS,
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
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
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)
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)
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
<$>)
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)
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)
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)
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)
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)
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)
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)
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
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)
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 =
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
(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
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)
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
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
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)
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')
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)
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]
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]
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
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)
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)
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))
{-# 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
{-# 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'
{-# 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
{-# 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)
{-# 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
{-# 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)