{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.Goblin.Instances where
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import qualified Data.Bimap as Bimap
import Data.Char (chr)
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Ratio (Ratio)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Data.Word (Word8, Word64)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import Lens.Micro.Mtl ((.=), use)
import Moo.GeneticAlgorithm.Binary (bitsNeeded, decodeBinary)
import Numeric.Natural (Natural)
import Test.Goblin.Core
import Test.Goblin.TH
instance GeneOps Bool where
onGene :: TinkerM Bool a -> TinkerM Bool a -> TinkerM Bool a
onGene TinkerM Bool a
yes TinkerM Bool a
no = do
Bool
tg <- TinkerM Bool Bool
forall g. TinkerM g g
transcribeGene
if Bool
tg then TinkerM Bool a
yes else TinkerM Bool a
no
transcribeGenesAsInt :: Int -> TinkerM Bool Int
transcribeGenesAsInt Int
n = do
([Bool]
gs, [Bool]
xs) <- Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt ((Int, Int) -> Int
forall a b. (Integral a, Integral b) => (a, a) -> b
bitsNeeded (Int
0,Int
n)) ([Bool] -> ([Bool], [Bool]))
-> StateT (GoblinData Bool) Identity [Bool]
-> StateT (GoblinData Bool) Identity ([Bool], [Bool])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [Bool] (GoblinData Bool) [Bool]
-> StateT (GoblinData Bool) Identity [Bool]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [Bool] (GoblinData Bool) [Bool]
forall g1 g2.
Lens (GoblinData g1) (GoblinData g2) (Genome g1) (Genome g2)
genes
([Bool] -> Identity [Bool])
-> GoblinData Bool -> Identity (GoblinData Bool)
forall g1 g2.
Lens (GoblinData g1) (GoblinData g2) (Genome g1) (Genome g2)
genes (([Bool] -> Identity [Bool])
-> GoblinData Bool -> Identity (GoblinData Bool))
-> [Bool] -> StateT (GoblinData Bool) Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Bool]
xs
let base :: Int
base = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
if Int
base Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [Char] -> TinkerM Bool Int
forall a. HasCallStack => [Char] -> a
error [Char]
"transcribeGenesAsInt: divide by zero"
else Int -> TinkerM Bool Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> TinkerM Bool Int) -> Int -> TinkerM Bool Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Bool] -> Int
forall b.
(FiniteBits b, Bits b, Integral b) =>
(b, b) -> [Bool] -> b
decodeBinary (Int
0, Int
n) [Bool]
gs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
base
instance GeneOps a => Goblin a Bool where
tinker :: Gen Bool -> TinkerM a (Gen Bool)
tinker Gen Bool
_ = Bool -> Gen Bool
forall a. AddShrinks a => a -> Gen a
addShrinks (Bool -> Gen Bool) -> TinkerM a Bool -> TinkerM a (Gen Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TinkerM a Bool -> TinkerM a Bool -> TinkerM a Bool
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene TinkerM a Bool
forall a g. Goblin g a => TinkerM g a
rummageOrConjure TinkerM a Bool
forall g a. Goblin g a => TinkerM g a
conjure
conjure :: TinkerM a Bool
conjure = Bool -> TinkerM a Bool
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Bool -> TinkerM a Bool) -> TinkerM a Bool -> TinkerM a Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TinkerM a Bool -> TinkerM a Bool -> TinkerM a Bool
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene (Bool -> TinkerM a Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) (Bool -> TinkerM a Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
instance GeneOps a => Goblin a Char where
tinker :: Gen Char -> TinkerM a (Gen Char)
tinker Gen Char
_ = Char -> Gen Char
forall a. AddShrinks a => a -> Gen a
addShrinks (Char -> Gen Char) -> TinkerM a Char -> TinkerM a (Gen Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TinkerM a Char -> TinkerM a Char -> TinkerM a Char
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene TinkerM a Char
forall a g. Goblin g a => TinkerM g a
rummageOrConjure TinkerM a Char
forall g a. Goblin g a => TinkerM g a
conjure
conjure :: TinkerM a Char
conjure = Char -> TinkerM a Char
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Char -> TinkerM a Char) -> TinkerM a Char -> TinkerM a Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Char
chr (Int -> Char)
-> StateT (GoblinData a) Identity Int -> TinkerM a Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT (GoblinData a) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
1114111
instance GeneOps a => Goblin a Integer where
tinker :: Gen Integer -> TinkerM a (Gen Integer)
tinker = TinkerM a (Gen Integer) -> TinkerM a (Gen Integer)
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave
(TinkerM a (Gen Integer) -> TinkerM a (Gen Integer))
-> (Gen Integer -> TinkerM a (Gen Integer))
-> Gen Integer
-> TinkerM a (Gen Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen Integer -> Gen Integer -> Gen Integer]
-> Gen Integer -> TinkerM a (Gen Integer)
forall a g.
(AddShrinks a, Goblin g a) =>
[Gen a -> Gen a -> Gen a] -> Gen a -> TinkerM g (Gen a)
tinkerWithToys (((Integer -> Integer -> Integer)
-> Gen Integer -> Gen Integer -> Gen Integer)
-> [Integer -> Integer -> Integer]
-> [Gen Integer -> Gen Integer -> Gen Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Integer -> Integer)
-> Gen Integer -> Gen Integer -> Gen Integer
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+), (-), Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)])
conjure :: TinkerM a Integer
conjure = Integer -> TinkerM a Integer
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Integer -> TinkerM a Integer)
-> TinkerM a Integer -> TinkerM a Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Integer
forall a. Enum a => Int -> a
toEnum (Int -> Integer)
-> StateT (GoblinData a) Identity Int -> TinkerM a Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData a) Identity Int
forall g a. Goblin g a => TinkerM g a
conjure
instance GeneOps a => Goblin a Natural where
tinker :: Gen Natural -> TinkerM a (Gen Natural)
tinker = TinkerM a (Gen Natural) -> TinkerM a (Gen Natural)
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave
(TinkerM a (Gen Natural) -> TinkerM a (Gen Natural))
-> (Gen Natural -> TinkerM a (Gen Natural))
-> Gen Natural
-> TinkerM a (Gen Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen Natural -> Gen Natural -> Gen Natural]
-> Gen Natural -> TinkerM a (Gen Natural)
forall a g.
(AddShrinks a, Goblin g a) =>
[Gen a -> Gen a -> Gen a] -> Gen a -> TinkerM g (Gen a)
tinkerWithToys (((Natural -> Natural -> Natural)
-> Gen Natural -> Gen Natural -> Gen Natural)
-> [Natural -> Natural -> Natural]
-> [Gen Natural -> Gen Natural -> Gen Natural]
forall a b. (a -> b) -> [a] -> [b]
map (Natural -> Natural -> Natural)
-> Gen Natural -> Gen Natural -> Gen Natural
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+), Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(*)])
conjure :: TinkerM a Natural
conjure = Natural -> TinkerM a Natural
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Natural -> TinkerM a Natural)
-> TinkerM a Natural -> TinkerM a Natural
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural)
-> StateT (GoblinData a) Identity Int -> TinkerM a Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT (GoblinData a) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
2000
instance GeneOps a => Goblin a Int where
tinker :: Gen Int -> TinkerM a (Gen Int)
tinker = TinkerM a (Gen Int) -> TinkerM a (Gen Int)
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave
(TinkerM a (Gen Int) -> TinkerM a (Gen Int))
-> (Gen Int -> TinkerM a (Gen Int))
-> Gen Int
-> TinkerM a (Gen Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen Int -> Gen Int -> Gen Int] -> Gen Int -> TinkerM a (Gen Int)
forall a g.
(AddShrinks a, Goblin g a) =>
[Gen a -> Gen a -> Gen a] -> Gen a -> TinkerM g (Gen a)
tinkerWithToys (((Int -> Int -> Int) -> Gen Int -> Gen Int -> Gen Int)
-> [Int -> Int -> Int] -> [Gen Int -> Gen Int -> Gen Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int) -> Gen Int -> Gen Int -> Gen Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Int -> Int -> Int
forall a. Num a => a -> a -> a
(+), (-), Int -> Int -> Int
forall a. Num a => a -> a -> a
(*)])
conjure :: TinkerM a Int
conjure = Int -> TinkerM a Int
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Int -> TinkerM a Int) -> TinkerM a Int -> TinkerM a Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (\Int
x -> Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1000) (Int -> Int) -> TinkerM a Int -> TinkerM a Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> TinkerM a Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
2000
instance GeneOps a => Goblin a Word64 where
tinker :: Gen Word64 -> TinkerM a (Gen Word64)
tinker = TinkerM a (Gen Word64) -> TinkerM a (Gen Word64)
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave
(TinkerM a (Gen Word64) -> TinkerM a (Gen Word64))
-> (Gen Word64 -> TinkerM a (Gen Word64))
-> Gen Word64
-> TinkerM a (Gen Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen Word64 -> Gen Word64 -> Gen Word64]
-> Gen Word64 -> TinkerM a (Gen Word64)
forall a g.
(AddShrinks a, Goblin g a) =>
[Gen a -> Gen a -> Gen a] -> Gen a -> TinkerM g (Gen a)
tinkerWithToys (((Word64 -> Word64 -> Word64)
-> Gen Word64 -> Gen Word64 -> Gen Word64)
-> [Word64 -> Word64 -> Word64]
-> [Gen Word64 -> Gen Word64 -> Gen Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Word64 -> Word64 -> Word64)
-> Gen Word64 -> Gen Word64 -> Gen Word64
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+), (-), Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(*)])
conjure :: TinkerM a Word64
conjure = Word64 -> TinkerM a Word64
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Word64 -> TinkerM a Word64)
-> TinkerM a Word64 -> TinkerM a Word64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64)
-> StateT (GoblinData a) Identity Int -> TinkerM a Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT (GoblinData a) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
2000
instance GeneOps a => Goblin a Double where
tinker :: Gen Double -> TinkerM a (Gen Double)
tinker = TinkerM a (Gen Double) -> TinkerM a (Gen Double)
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave
(TinkerM a (Gen Double) -> TinkerM a (Gen Double))
-> (Gen Double -> TinkerM a (Gen Double))
-> Gen Double
-> TinkerM a (Gen Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen Double -> Gen Double -> Gen Double]
-> Gen Double -> TinkerM a (Gen Double)
forall a g.
(AddShrinks a, Goblin g a) =>
[Gen a -> Gen a -> Gen a] -> Gen a -> TinkerM g (Gen a)
tinkerWithToys (((Double -> Double -> Double)
-> Gen Double -> Gen Double -> Gen Double)
-> [Double -> Double -> Double]
-> [Gen Double -> Gen Double -> Gen Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double)
-> Gen Double -> Gen Double -> Gen Double
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Double -> Double -> Double
forall a. Num a => a -> a -> a
(+), (-), Double -> Double -> Double
forall a. Num a => a -> a -> a
(*)])
conjure :: TinkerM a Double
conjure = Double -> TinkerM a Double
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Double -> TinkerM a Double)
-> TinkerM a Double -> TinkerM a Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Int
i <- Int -> TinkerM a Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
100
Double -> TinkerM a Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
deriveGoblin ''(,)
deriveGoblin ''(,,)
deriveGoblin ''(,,,)
deriveGoblin ''(,,,,)
deriveGoblin ''(,,,,,)
deriveGoblin ''(,,,,,,)
deriveGoblin ''(,,,,,,,)
deriveGoblin ''(,,,,,,,,)
deriveGoblin ''(,,,,,,,,,)
deriveGoblin ''(,,,,,,,,,,)
deriveGoblin ''Ratio
instance (Goblin g a, AddShrinks a)
=> Goblin g (Maybe a) where
tinker :: Gen (Maybe a) -> TinkerM g (Gen (Maybe a))
tinker Gen (Maybe a)
obj = TinkerM g (Gen (Maybe a)) -> TinkerM g (Gen (Maybe a))
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave (TinkerM g (Gen (Maybe a)) -> TinkerM g (Gen (Maybe a)))
-> TinkerM g (Gen (Maybe a)) -> TinkerM g (Gen (Maybe a))
forall a b. (a -> b) -> a -> b
$ do
Gen a
x <- Gen a -> TinkerM g (Gen a)
forall g a. Goblin g a => Gen a -> TinkerM g (Gen a)
tinker (Gen (Maybe a) -> Gen a
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
m (Maybe a) -> m a
Gen.just Gen (Maybe a)
obj)
Gen (Maybe a) -> TinkerM g (Gen (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gen a -> Gen (Maybe a)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe Gen a
x)
conjure :: TinkerM g (Maybe a)
conjure = Maybe a -> TinkerM g (Maybe a)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Maybe a -> TinkerM g (Maybe a))
-> TinkerM g (Maybe a) -> TinkerM g (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
TinkerM g (Maybe a) -> TinkerM g (Maybe a) -> TinkerM g (Maybe a)
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene (Maybe a -> TinkerM g (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)
-> StateT (GoblinData g) Identity a -> TinkerM g (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData g) Identity a
forall g a. Goblin g a => TinkerM g a
conjure)
instance (AddShrinks a, Eq a, Typeable a, GeneOps g, Goblin g a)
=> Goblin g [a] where
tinker :: Gen [a] -> TinkerM g (Gen [a])
tinker Gen [a]
obj = TinkerM g (Gen [a]) -> TinkerM g (Gen [a])
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave (TinkerM g (Gen [a]) -> TinkerM g (Gen [a]))
-> TinkerM g (Gen [a]) -> TinkerM g (Gen [a])
forall a b. (a -> b) -> a -> b
$ do
[Gen [a]]
rummaged <- (([a] -> Gen [a]) -> [[a]] -> [Gen [a]]
forall a b. (a -> b) -> [a] -> [b]
map ([GenT Identity a] -> Gen [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([GenT Identity a] -> Gen [a])
-> ([a] -> [GenT Identity a]) -> [a] -> Gen [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> GenT Identity a) -> [a] -> [GenT Identity a]
forall a b. (a -> b) -> [a] -> [b]
map a -> GenT Identity a
forall a. AddShrinks a => a -> Gen a
addShrinks)) ([[a]] -> [Gen [a]])
-> StateT (GoblinData g) Identity [[a]]
-> StateT (GoblinData g) Identity [Gen [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData g) Identity [[a]]
forall a g. Typeable a => TinkerM g [a]
rummageAll
if ([Gen [a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Gen [a]]
rummaged)
then TinkerM g (Gen [a])
toyUnOp
else TinkerM g (Gen [a]) -> TinkerM g (Gen [a]) -> TinkerM g (Gen [a])
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene TinkerM g (Gen [a])
toyUnOp ([Gen [a]] -> TinkerM g (Gen [a])
toyBinOp [Gen [a]]
rummaged)
where
toyUnOp :: TinkerM g (Gen [a])
toyUnOp :: TinkerM g (Gen [a])
toyUnOp = do
Gen [a] -> TinkerM g (Gen [a])
toy <- ([Gen [a] -> TinkerM g (Gen [a])]
unOpToys [Gen [a] -> TinkerM g (Gen [a])]
-> Int -> Gen [a] -> TinkerM g (Gen [a])
forall a. [a] -> Int -> a
!!) (Int -> Gen [a] -> TinkerM g (Gen [a]))
-> StateT (GoblinData g) Identity Int
-> StateT (GoblinData g) Identity (Gen [a] -> TinkerM g (Gen [a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [a] -> TinkerM g (Gen [a])]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen [a] -> TinkerM g (Gen [a])]
unOpToys
Gen [a] -> TinkerM g (Gen [a])
toy Gen [a]
obj
unOpToys :: [Gen [a] -> TinkerM g (Gen [a])]
unOpToys :: [Gen [a] -> TinkerM g (Gen [a])]
unOpToys =
[ Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, \Gen [a]
a -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.shuffle ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
a)
, \Gen [a]
a -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
a)
]
toyBinOp :: [Gen [a]] -> TinkerM g (Gen [a])
toyBinOp :: [Gen [a]] -> TinkerM g (Gen [a])
toyBinOp [Gen [a]]
rummaged = do
Gen [a] -> Gen [a] -> TinkerM g (Gen [a])
toy <- ([Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
binOpToys [Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
-> Int -> Gen [a] -> Gen [a] -> TinkerM g (Gen [a])
forall a. [a] -> Int -> a
!!) (Int -> Gen [a] -> Gen [a] -> TinkerM g (Gen [a]))
-> StateT (GoblinData g) Identity Int
-> StateT
(GoblinData g) Identity (Gen [a] -> Gen [a] -> TinkerM g (Gen [a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
binOpToys
Gen [a]
val <- ([Gen [a]]
rummaged [Gen [a]] -> Int -> Gen [a]
forall a. [a] -> Int -> a
!!) (Int -> Gen [a])
-> StateT (GoblinData g) Identity Int -> TinkerM g (Gen [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [a]] -> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen [a]]
rummaged
Gen [a] -> Gen [a] -> TinkerM g (Gen [a])
toy Gen [a]
obj Gen [a]
val
binOpToys :: [Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
binOpToys :: [Gen [a] -> Gen [a] -> TinkerM g (Gen [a])]
binOpToys =
[ \Gen [a]
a Gen [a]
_ -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen [a]
a
, \Gen [a]
_ Gen [a]
b -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen [a]
b
, \Gen [a]
a Gen [a]
_ -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.shuffle ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
a)
, \Gen [a]
a Gen [a]
b -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a] -> [a] -> [a]) -> Gen [a] -> GenT Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
a GenT Identity ([a] -> [a]) -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
b))
, \Gen [a]
a Gen [a]
b -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
(List.\\) ([a] -> [a] -> [a]) -> Gen [a] -> GenT Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
a GenT Identity ([a] -> [a]) -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
b))
, \Gen [a]
a Gen [a]
b -> Gen [a] -> TinkerM g (Gen [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a] -> [a] -> [a]) -> Gen [a] -> GenT Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
a)
GenT Identity ([a] -> [a]) -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Gen [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [a]
b))
]
conjure :: TinkerM g [a]
conjure = [a] -> TinkerM g [a]
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks ([a] -> TinkerM g [a]) -> TinkerM g [a] -> TinkerM g [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Int
listLen <- Int -> StateT (GoblinData g) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
15
Int -> StateT (GoblinData g) Identity a -> TinkerM g [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
listLen StateT (GoblinData g) Identity a
forall g a. Goblin g a => TinkerM g a
conjure
instance (Goblin g a, Ord a, AddShrinks a, Typeable a)
=> Goblin g (Set.Set a) where
tinker :: Gen (Set a) -> TinkerM g (Gen (Set a))
tinker Gen (Set a)
obj = TinkerM g (Gen (Set a)) -> TinkerM g (Gen (Set a))
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave (TinkerM g (Gen (Set a)) -> TinkerM g (Gen (Set a)))
-> TinkerM g (Gen (Set a)) -> TinkerM g (Gen (Set a))
forall a b. (a -> b) -> a -> b
$ do
[GenT Identity [a]]
rummaged <- (([a] -> GenT Identity [a]) -> [[a]] -> [GenT Identity [a]]
forall a b. (a -> b) -> [a] -> [b]
map ([GenT Identity a] -> GenT Identity [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([GenT Identity a] -> GenT Identity [a])
-> ([a] -> [GenT Identity a]) -> [a] -> GenT Identity [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> GenT Identity a) -> [a] -> [GenT Identity a]
forall a b. (a -> b) -> [a] -> [b]
map a -> GenT Identity a
forall a. AddShrinks a => a -> Gen a
addShrinks)) ([[a]] -> [GenT Identity [a]])
-> StateT (GoblinData g) Identity [[a]]
-> StateT (GoblinData g) Identity [GenT Identity [a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData g) Identity [[a]]
forall a g. Typeable a => TinkerM g [a]
rummageAll
if ([GenT Identity [a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenT Identity [a]]
rummaged)
then TinkerM g (Gen (Set a))
toyUnOp
else TinkerM g (Gen (Set a))
-> TinkerM g (Gen (Set a)) -> TinkerM g (Gen (Set a))
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene TinkerM g (Gen (Set a))
toyUnOp ([GenT Identity [a]] -> TinkerM g (Gen (Set a))
toyBinOp [GenT Identity [a]]
rummaged)
where
toyUnOp :: TinkerM g (Gen (Set.Set a))
toyUnOp :: TinkerM g (Gen (Set a))
toyUnOp = do
Gen (Set a) -> TinkerM g (Gen (Set a))
toy <- ([Gen (Set a) -> TinkerM g (Gen (Set a))]
unOpToys [Gen (Set a) -> TinkerM g (Gen (Set a))]
-> Int -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall a. [a] -> Int -> a
!!) (Int -> Gen (Set a) -> TinkerM g (Gen (Set a)))
-> StateT (GoblinData g) Identity Int
-> StateT
(GoblinData g) Identity (Gen (Set a) -> TinkerM g (Gen (Set a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Set a) -> TinkerM g (Gen (Set a))]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen (Set a) -> TinkerM g (Gen (Set a))]
unOpToys
Gen (Set a) -> TinkerM g (Gen (Set a))
toy Gen (Set a)
obj
unOpToys :: [Gen (Set.Set a) -> TinkerM g (Gen (Set.Set a))]
unOpToys :: [Gen (Set a) -> TinkerM g (Gen (Set a))]
unOpToys =
[ \Gen (Set a)
a -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen (Set a)
a
, \Gen (Set a)
a -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.shuffle ([a] -> GenT Identity [a])
-> GenT Identity [a] -> GenT Identity [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> Gen (Set a) -> GenT Identity [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set a)
a)))
, \Gen (Set a)
a -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> GenT Identity [a])
-> GenT Identity [a] -> GenT Identity [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> Gen (Set a) -> GenT Identity [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set a)
a)))
]
toyBinOp :: [Gen [a]] -> TinkerM g (Gen (Set.Set a))
toyBinOp :: [GenT Identity [a]] -> TinkerM g (Gen (Set a))
toyBinOp [GenT Identity [a]]
rummaged = do
Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))
toy <- ([Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))]
binOpToys [Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))]
-> Int
-> Gen (Set a)
-> GenT Identity [a]
-> TinkerM g (Gen (Set a))
forall a. [a] -> Int -> a
!!) (Int
-> Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a)))
-> StateT (GoblinData g) Identity Int
-> StateT
(GoblinData g)
Identity
(Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))]
binOpToys
GenT Identity [a]
val <- ([GenT Identity [a]]
rummaged [GenT Identity [a]] -> Int -> GenT Identity [a]
forall a. [a] -> Int -> a
!!) (Int -> GenT Identity [a])
-> StateT (GoblinData g) Identity Int
-> StateT (GoblinData g) Identity (GenT Identity [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenT Identity [a]] -> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [GenT Identity [a]]
rummaged
Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))
toy Gen (Set a)
obj GenT Identity [a]
val
binOpToys :: [Gen (Set.Set a) -> Gen [a] -> TinkerM g (Gen (Set.Set a))]
binOpToys :: [Gen (Set a) -> GenT Identity [a] -> TinkerM g (Gen (Set a))]
binOpToys =
[ \Gen (Set a)
a GenT Identity [a]
_ -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen (Set a)
a
, \Gen (Set a)
_ GenT Identity [a]
b -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity [a]
b)
, \Gen (Set a)
a GenT Identity [a]
b -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
(Set a -> Set a -> Set a)
-> Gen (Set a) -> GenT Identity (Set a -> Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set a)
a
GenT Identity (Set a -> Set a) -> Gen (Set a) -> Gen (Set a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> GenT Identity [a])
-> GenT Identity [a] -> GenT Identity [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [a]
b)))
, \Gen (Set a)
a GenT Identity [a]
b -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union
(Set a -> Set a -> Set a)
-> Gen (Set a) -> GenT Identity (Set a -> Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set a)
a
GenT Identity (Set a -> Set a) -> Gen (Set a) -> Gen (Set a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> GenT Identity [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([a] -> GenT Identity [a])
-> GenT Identity [a] -> GenT Identity [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [a]
b)))
, \Gen (Set a)
a GenT Identity [a]
b -> Gen (Set a) -> TinkerM g (Gen (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gen (Set a) -> TinkerM g (Gen (Set a)))
-> Gen (Set a) -> TinkerM g (Gen (Set a))
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Set a -> Set a -> Set a)
-> Gen (Set a) -> GenT Identity (Set a -> Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set a)
a GenT Identity (Set a -> Set a) -> Gen (Set a) -> Gen (Set a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity [a]
b))
]
conjure :: TinkerM g (Set a)
conjure = Set a -> TinkerM g (Set a)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Set a -> TinkerM g (Set a))
-> TinkerM g (Set a) -> TinkerM g (Set a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Int
listLen <- Int -> StateT (GoblinData g) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
15
[a]
cs <- Int
-> StateT (GoblinData g) Identity a
-> StateT (GoblinData g) Identity [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
listLen StateT (GoblinData g) Identity a
forall g a. Goblin g a => TinkerM g a
conjure
Set a -> TinkerM g (Set a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
cs)
instance (Goblin g k, Goblin g v, Ord k, Eq k, Eq v, AddShrinks (Map.Map k v),
AddShrinks k, AddShrinks v, Typeable k, Typeable v)
=> Goblin g (Map.Map k v) where
tinker :: Gen (Map k v) -> TinkerM g (Gen (Map k v))
tinker Gen (Map k v)
obj = TinkerM g (Gen (Map k v)) -> TinkerM g (Gen (Map k v))
forall g a.
(Goblin g a, AddShrinks a) =>
TinkerM g (Gen a) -> TinkerM g (Gen a)
tinkerRummagedOrConjureOrSave (TinkerM g (Gen (Map k v)) -> TinkerM g (Gen (Map k v)))
-> TinkerM g (Gen (Map k v)) -> TinkerM g (Gen (Map k v))
forall a b. (a -> b) -> a -> b
$ do
[GenT Identity [k]]
rummagedKeys <- (([k] -> GenT Identity [k]) -> [[k]] -> [GenT Identity [k]]
forall a b. (a -> b) -> [a] -> [b]
map ([GenT Identity k] -> GenT Identity [k]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([GenT Identity k] -> GenT Identity [k])
-> ([k] -> [GenT Identity k]) -> [k] -> GenT Identity [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> GenT Identity k) -> [k] -> [GenT Identity k]
forall a b. (a -> b) -> [a] -> [b]
map k -> GenT Identity k
forall a. AddShrinks a => a -> Gen a
addShrinks)) ([[k]] -> [GenT Identity [k]])
-> StateT (GoblinData g) Identity [[k]]
-> StateT (GoblinData g) Identity [GenT Identity [k]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData g) Identity [[k]]
forall a g. Typeable a => TinkerM g [a]
rummageAll
[GenT Identity [v]]
rummagedVals <- (([v] -> GenT Identity [v]) -> [[v]] -> [GenT Identity [v]]
forall a b. (a -> b) -> [a] -> [b]
map ([GenT Identity v] -> GenT Identity [v]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([GenT Identity v] -> GenT Identity [v])
-> ([v] -> [GenT Identity v]) -> [v] -> GenT Identity [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> GenT Identity v) -> [v] -> [GenT Identity v]
forall a b. (a -> b) -> [a] -> [b]
map v -> GenT Identity v
forall a. AddShrinks a => a -> Gen a
addShrinks)) ([[v]] -> [GenT Identity [v]])
-> StateT (GoblinData g) Identity [[v]]
-> StateT (GoblinData g) Identity [GenT Identity [v]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (GoblinData g) Identity [[v]]
forall a g. Typeable a => TinkerM g [a]
rummageAll
if ([GenT Identity [k]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenT Identity [k]]
rummagedKeys) Bool -> Bool -> Bool
|| ([GenT Identity [v]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenT Identity [v]]
rummagedVals)
then TinkerM g (Gen (Map k v))
toyUnOp
else TinkerM g (Gen (Map k v))
-> TinkerM g (Gen (Map k v)) -> TinkerM g (Gen (Map k v))
forall g a. GeneOps g => TinkerM g a -> TinkerM g a -> TinkerM g a
onGene TinkerM g (Gen (Map k v))
toyUnOp ([GenT Identity [k]]
-> [GenT Identity [v]] -> TinkerM g (Gen (Map k v))
toyBinOp [GenT Identity [k]]
rummagedKeys [GenT Identity [v]]
rummagedVals)
where
toyUnOp :: TinkerM g (Gen (Map.Map k v))
toyUnOp :: TinkerM g (Gen (Map k v))
toyUnOp = do
Gen (Map k v) -> TinkerM g (Gen (Map k v))
toy <- ([Gen (Map k v) -> TinkerM g (Gen (Map k v))]
unOpToys [Gen (Map k v) -> TinkerM g (Gen (Map k v))]
-> Int -> Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall a. [a] -> Int -> a
!!) (Int -> Gen (Map k v) -> TinkerM g (Gen (Map k v)))
-> StateT (GoblinData g) Identity Int
-> StateT
(GoblinData g)
Identity
(Gen (Map k v) -> TinkerM g (Gen (Map k v)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Map k v) -> TinkerM g (Gen (Map k v))]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen (Map k v) -> TinkerM g (Gen (Map k v))]
unOpToys
Gen (Map k v) -> TinkerM g (Gen (Map k v))
toy Gen (Map k v)
obj
unOpToys :: [Gen (Map.Map k v) -> TinkerM g (Gen (Map.Map k v))]
unOpToys :: [Gen (Map k v) -> TinkerM g (Gen (Map k v))]
unOpToys =
[ \Gen (Map k v)
a -> Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen (Map k v)
a
, \Gen (Map k v)
a -> Gen (Map k v) -> TinkerM g (Gen (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)] -> Map k v) -> GenT Identity [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(k, v)] -> GenT Identity [(k, v)]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.shuffle ([(k, v)] -> GenT Identity [(k, v)])
-> GenT Identity [(k, v)] -> GenT Identity [(k, v)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k v -> [(k, v)]) -> Gen (Map k v) -> GenT Identity [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
a)))
, \Gen (Map k v)
a -> Gen (Map k v) -> TinkerM g (Gen (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)] -> Map k v) -> GenT Identity [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(k, v)] -> GenT Identity [(k, v)]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([(k, v)] -> GenT Identity [(k, v)])
-> GenT Identity [(k, v)] -> GenT Identity [(k, v)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k v -> [(k, v)]) -> Gen (Map k v) -> GenT Identity [(k, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
a)))
]
toyBinOp :: [Gen [k]] -> [Gen [v]] -> TinkerM g (Gen (Map.Map k v))
toyBinOp :: [GenT Identity [k]]
-> [GenT Identity [v]] -> TinkerM g (Gen (Map k v))
toyBinOp [GenT Identity [k]]
rummagedKeys [GenT Identity [v]]
rummagedVals = do
Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))
toy <- ([Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))]
binOpToys [Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))]
-> Int
-> Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))
forall a. [a] -> Int -> a
!!) (Int
-> Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v)))
-> StateT (GoblinData g) Identity Int
-> StateT
(GoblinData g)
Identity
(Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))]
-> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))]
binOpToys
GenT Identity [k]
key <- ([GenT Identity [k]]
rummagedKeys [GenT Identity [k]] -> Int -> GenT Identity [k]
forall a. [a] -> Int -> a
!!) (Int -> GenT Identity [k])
-> StateT (GoblinData g) Identity Int
-> StateT (GoblinData g) Identity (GenT Identity [k])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenT Identity [k]] -> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [GenT Identity [k]]
rummagedKeys
GenT Identity [v]
val <- ([GenT Identity [v]]
rummagedVals [GenT Identity [v]] -> Int -> GenT Identity [v]
forall a. [a] -> Int -> a
!!) (Int -> GenT Identity [v])
-> StateT (GoblinData g) Identity Int
-> StateT (GoblinData g) Identity (GenT Identity [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenT Identity [v]] -> StateT (GoblinData g) Identity Int
forall g a. GeneOps g => [a] -> TinkerM g Int
geneListIndex [GenT Identity [v]]
rummagedVals
Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))
toy Gen (Map k v)
obj GenT Identity [k]
key GenT Identity [v]
val
binOpToys :: [Gen (Map.Map k v) -> Gen [k] -> Gen [v]
-> TinkerM g (Gen (Map.Map k v))]
binOpToys :: [Gen (Map k v)
-> GenT Identity [k]
-> GenT Identity [v]
-> TinkerM g (Gen (Map k v))]
binOpToys =
[ \Gen (Map k v)
a GenT Identity [k]
_ GenT Identity [v]
_ -> Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gen (Map k v)
a
, \Gen (Map k v)
a GenT Identity [k]
k GenT Identity [v]
v ->
Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
(Map k v -> Map k v -> Map k v)
-> Gen (Map k v) -> GenT Identity (Map k v -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
a
GenT Identity (Map k v -> Map k v)
-> Gen (Map k v) -> Gen (Map k v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> GenT Identity [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([k] -> [v] -> [(k, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([k] -> [v] -> [(k, v)])
-> GenT Identity [k] -> GenT Identity ([v] -> [(k, v)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([k] -> GenT Identity [k]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([k] -> GenT Identity [k])
-> GenT Identity [k] -> GenT Identity [k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [k]
k)
GenT Identity ([v] -> [(k, v)])
-> GenT Identity [v] -> GenT Identity [(k, v)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([v] -> GenT Identity [v]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([v] -> GenT Identity [v])
-> GenT Identity [v] -> GenT Identity [v]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [v]
v))))
, \Gen (Map k v)
a GenT Identity [k]
k GenT Identity [v]
_ -> Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys (Map k v -> Set k -> Map k v)
-> Gen (Map k v) -> GenT Identity (Set k -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
a
GenT Identity (Set k -> Map k v)
-> GenT Identity (Set k) -> Gen (Map k v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([k] -> Set k
forall a. Ord a => [a] -> Set a
Set.fromList ([k] -> Set k) -> GenT Identity [k] -> GenT Identity (Set k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([k] -> GenT Identity [k]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([k] -> GenT Identity [k])
-> GenT Identity [k] -> GenT Identity [k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [k]
k)))
, \Gen (Map k v)
a GenT Identity [k]
k GenT Identity [v]
_ -> Gen (Map k v) -> TinkerM g (Gen (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (Map k v -> Set k -> Map k v)
-> Gen (Map k v) -> GenT Identity (Set k -> Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
a
GenT Identity (Set k -> Map k v)
-> GenT Identity (Set k) -> Gen (Map k v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([k] -> Set k
forall a. Ord a => [a] -> Set a
Set.fromList ([k] -> Set k) -> GenT Identity [k] -> GenT Identity (Set k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([k] -> GenT Identity [k]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ([k] -> GenT Identity [k])
-> GenT Identity [k] -> GenT Identity [k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity [k]
k)))
]
conjure :: TinkerM g (Map k v)
conjure = Map k v -> TinkerM g (Map k v)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks (Map k v -> TinkerM g (Map k v))
-> TinkerM g (Map k v) -> TinkerM g (Map k v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Int
listLen <- Int -> StateT (GoblinData g) Identity Int
forall g. GeneOps g => Int -> TinkerM g Int
transcribeGenesAsInt Int
15
[(k, v)]
cs <- Int
-> StateT (GoblinData g) Identity (k, v)
-> StateT (GoblinData g) Identity [(k, v)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
listLen StateT (GoblinData g) Identity (k, v)
forall g a. Goblin g a => TinkerM g a
conjure
Map k v -> TinkerM g (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)]
cs)
instance AddShrinks () where
instance AddShrinks Bool where
instance AddShrinks Char where
instance AddShrinks Double where
instance AddShrinks Integer where
instance AddShrinks Natural where
instance AddShrinks Int where
instance AddShrinks Word8 where
instance AddShrinks Word64 where
deriveAddShrinks ''(,)
deriveAddShrinks ''(,,)
deriveAddShrinks ''(,,,)
deriveAddShrinks ''(,,,,)
deriveAddShrinks ''(,,,,,)
deriveAddShrinks ''(,,,,,,)
deriveAddShrinks ''(,,,,,,,)
deriveAddShrinks ''(,,,,,,,,)
deriveAddShrinks ''(,,,,,,,,,)
deriveAddShrinks ''(,,,,,,,,,,)
deriveAddShrinks ''Ratio
instance (AddShrinks k, Ord k, AddShrinks v) => AddShrinks (Map.Map k v) where
addShrinks :: Map k v -> Gen (Map k v)
addShrinks Map k v
xs = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> GenT Identity [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((k, v) -> GenT Identity (k, v))
-> [(k, v)] -> GenT Identity [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (k, v) -> GenT Identity (k, v)
forall a. AddShrinks a => a -> Gen a
addShrinks (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
xs)
instance AddShrinks a => AddShrinks [a] where
addShrinks :: [a] -> Gen [a]
addShrinks [a]
ls = (a -> GenT Identity a) -> [a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> GenT Identity a
forall a. AddShrinks a => a -> Gen a
addShrinks [a]
ls
instance (AddShrinks a, Ord a) => AddShrinks (Set.Set a) where
addShrinks :: Set a -> Gen (Set a)
addShrinks Set a
xs = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> GenT Identity [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> GenT Identity a) -> [a] -> GenT Identity [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> GenT Identity a
forall a. AddShrinks a => a -> Gen a
addShrinks (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
xs)
instance AddShrinks a => AddShrinks (Maybe a) where
addShrinks :: Maybe a -> Gen (Maybe a)
addShrinks Maybe a
Nothing = Maybe a -> Gen (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
addShrinks (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> GenT Identity a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> GenT Identity a
forall a. AddShrinks a => a -> Gen a
addShrinks a
x
instance SeedGoblin () where
instance SeedGoblin Bool where
instance SeedGoblin Char where
instance SeedGoblin Integer where
instance SeedGoblin Natural where
instance SeedGoblin Int where
instance SeedGoblin Word8 where
instance SeedGoblin Word64 where
instance SeedGoblin Double where
deriveSeedGoblin ''(,)
deriveSeedGoblin ''(,,)
deriveSeedGoblin ''(,,,)
deriveSeedGoblin ''(,,,,)
deriveSeedGoblin ''(,,,,,)
deriveSeedGoblin ''(,,,,,,)
deriveSeedGoblin ''(,,,,,,,)
deriveSeedGoblin ''(,,,,,,,,)
deriveSeedGoblin ''(,,,,,,,,,)
deriveSeedGoblin ''(,,,,,,,,,,)
instance (SeedGoblin a, Typeable a) => SeedGoblin [a] where
seeder :: [a] -> TinkerM g ()
seeder [a]
xs = do
() () -> StateT (GoblinData g) Identity [a] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [a] -> StateT (GoblinData g) Identity [a]
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks [a]
xs
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (a -> TinkerM g ()) -> [a] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)
instance (SeedGoblin a, Typeable a) => SeedGoblin (Seq.Seq a) where
seeder :: Seq a -> TinkerM g ()
seeder Seq a
xs = do
() () -> StateT (GoblinData g) Identity (Seq a) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Seq a -> StateT (GoblinData g) Identity (Seq a)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks Seq a
xs
() () -> StateT (GoblinData g) Identity (Seq ()) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Seq (TinkerM g ()) -> StateT (GoblinData g) Identity (Seq ())
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (a -> TinkerM g ()) -> Seq a -> Seq (TinkerM g ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq a
xs)
instance (SeedGoblin a, Typeable a, SeedGoblin b, Typeable b)
=> SeedGoblin (Bimap.Bimap a b) where
seeder :: Bimap a b -> TinkerM g ()
seeder Bimap a b
xs = do
() () -> StateT (GoblinData g) Identity (Bimap a b) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bimap a b -> StateT (GoblinData g) Identity (Bimap a b)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks Bimap a b
xs
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (a -> TinkerM g ()) -> [a] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bimap a b -> [a]
forall a b. Bimap a b -> [a]
Bimap.keys Bimap a b
xs)
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (b -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (b -> TinkerM g ()) -> [b] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bimap a b -> [b]
forall a b. Bimap a b -> [b]
Bimap.elems Bimap a b
xs)
instance (SeedGoblin a, Typeable a, SeedGoblin b, Typeable b)
=> SeedGoblin (Map.Map a b) where
seeder :: Map a b -> TinkerM g ()
seeder Map a b
xs = do
() () -> StateT (GoblinData g) Identity (Map a b) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map a b -> StateT (GoblinData g) Identity (Map a b)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks Map a b
xs
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (a -> TinkerM g ()) -> [a] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a b -> [a]
forall k a. Map k a -> [k]
Map.keys Map a b
xs)
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (b -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (b -> TinkerM g ()) -> [b] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a b -> [b]
forall k a. Map k a -> [a]
Map.elems Map a b
xs)
instance (SeedGoblin a, Typeable a) => SeedGoblin (Set.Set a) where
seeder :: Set a -> TinkerM g ()
seeder Set a
xs = do
() () -> StateT (GoblinData g) Identity (Set a) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Set a -> StateT (GoblinData g) Identity (Set a)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks Set a
xs
() () -> StateT (GoblinData g) Identity [()] -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TinkerM g ()] -> StateT (GoblinData g) Identity [()]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder (a -> TinkerM g ()) -> [a] -> [TinkerM g ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
xs)
instance (SeedGoblin a, Typeable a) => SeedGoblin (Maybe a) where
seeder :: Maybe a -> TinkerM g ()
seeder Maybe a
mb = do
() () -> StateT (GoblinData g) Identity (Maybe a) -> TinkerM g ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe a -> StateT (GoblinData g) Identity (Maybe a)
forall g a. Typeable a => a -> TinkerM g a
saveInBagOfTricks Maybe a
mb
case Maybe a
mb of
Maybe a
Nothing -> () -> TinkerM g ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just a
x -> a -> TinkerM g ()
forall a g. SeedGoblin a => a -> TinkerM g ()
seeder a
x