{-# 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

--------------------------------------------------------------------------------
-- Primitive goblins
--------------------------------------------------------------------------------

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
  -- TODO : this uses up 21 bits of genome, and we may not be interested in thorough
  -- coverage of the Char space
  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

-- | This instance generates Double values in range [0..1] (inclusive) at 0.01
-- increments. 0.01, 0.02 ... 0.99, 1.00
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)


--------------------------------------------------------------------------------
-- Composite goblins
--------------------------------------------------------------------------------

deriveGoblin ''(,)
deriveGoblin ''(,,)
deriveGoblin ''(,,,)
deriveGoblin ''(,,,,)
deriveGoblin ''(,,,,,)
deriveGoblin ''(,,,,,,)
deriveGoblin ''(,,,,,,,)
deriveGoblin ''(,,,,,,,,)
deriveGoblin ''(,,,,,,,,,)
deriveGoblin ''(,,,,,,,,,,)
deriveGoblin ''Ratio

instance (Goblin g a, AddShrinks a)
      => Goblin g (Maybe a) where
  -- TODO mhueschen - reconsider this. it seems suspect.
  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)

-- | Our list goblin behaves slightly differently, since it pulls whole lists of
-- things from the bag of tricks, and is also specialised to do some more
-- messing about with lists.
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 there's nothing to rummage, we do unary operations
    -- Otherwise we select BinOps or UnOps based on a gene
    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)
      -- TODO mhueschen | consider tinkering with elements here
      ]

    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

    -- Toys for lists can use 'TinkerM', because they might be random
    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 there's nothing to rummage, we do unary operations
    -- Otherwise we select BinOps or UnOps based on a gene
    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)))
      -- TODO mhueschen | consider tinkering with elements here
      ]

    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

    -- Toys for sets can use 'TinkerM', because they might be random
    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 there's nothing to rummage, we do unary operations
      -- Otherwise we select BinOps or UnOps based on a gene
      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)))
        -- TODO mhueschen | consider tinkering with elements here
        ]

      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

      -- Toys for sets can use 'TinkerM', because they might be random
      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)

--------------------------------------------------------------------------------
-- AddShrinks
--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------
-- SeedGoblin
--------------------------------------------------------------------------------

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