{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}

-- | Mutations as transformations of values into mutants.
module Test.Mutagen.Mutation
  ( -- * Mutable types
    Pos
  , Mutation
  , Mutable (..)
  , mutateEverywhere
  , wrap
  , node
  , invalidPosition
  , invalidPositionShow

    -- * Immutable wrapper
  , Immutable (..)

    -- * Mutation order
  , MutationOrder
  , preorder
  , postorder
  , levelorder
  )
where

import Data.Char (chr)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Tree (Tree (..), levels)
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word64, Word8)
import Test.Mutagen.Fragment.Store (sampleFragments)
import Test.Mutagen.Mutant (Mutant (..))
import Test.QuickCheck (Arbitrary (..), arbitrary)

{-------------------------------------------------------------------------------
-- * Mutable types
-------------------------------------------------------------------------------}

-- ** Types

-- | Breadcrumbs used to place mutations inside of values.
type Pos = [Int]

-- | Mutations as transformations of values into mutants.
type Mutation a = a -> [Mutant a]

-- ** Mutable class

-- | Mutable types that can be mutated by into similar values with small changes.
class (Typeable a) => Mutable a where
  -- | List all the possible positions within a value that accept mutations.
  positions :: a -> Tree Pos
  positions a
_ = [(Int, Tree Pos)] -> Tree Pos
node []

  -- | Default value of this type to be used when "growing" a value.
  --
  -- This is used when mutating from a "smaller" instance to a "larger" data
  -- constructor; for example, when mutating from 'Nothing' to 'Just a'. In
  -- those cases, 'def' is used to fill the missing gaps deterministically.
  def :: a
  def = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"def: not defined"

  -- | Top-level mutation accepted by this value.
  --
  -- NOTE: this should only return the mutations that change the value at the
  -- top level; deeper mutations happening inside the value will be created on
  -- demand by Mutagen via 'inside' during the testing loop.
  mutate :: Mutation a
  mutate = Mutation a
forall a. Monoid a => a
mempty

  -- | Apply a top-level mutation inside a value at the given position.
  --
  -- Note that the input mutation uses a higher-rank type to ensure that the
  -- mutation being applied is valid for the type at the given position, which
  -- is not necessarily the same as the one at the top-level.
  inside :: Pos -> (forall x. (Mutable x) => Mutation x) -> Mutation a
  inside [] forall x. Mutable x => Mutation x
mut = Mutation a
forall x. Mutable x => Mutation x
mut
  inside Pos
pos forall x. Mutable x => Mutation x
_ = Pos -> Mutation a
forall a. Pos -> a
invalidPosition Pos
pos

-- | A mutation that acts everywhere inside a mutable value.
--
-- Useful mostly for testing purposes.
mutateEverywhere :: (Mutable a) => Mutation a
mutateEverywhere :: forall x. Mutable x => Mutation x
mutateEverywhere a
a = [Mutant a]
topLevel [Mutant a] -> [Mutant a] -> [Mutant a]
forall a. Semigroup a => a -> a -> a
<> [Mutant a]
nested
  where
    topLevel :: [Mutant a]
topLevel = Mutation a
forall x. Mutable x => Mutation x
mutate a
a
    nested :: [Mutant a]
nested = [[Mutant a]] -> [Mutant a]
forall a. Monoid a => [a] -> a
mconcat [Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
pos Mutation x
forall x. Mutable x => Mutation x
mutate a
a | Pos
pos <- Tree Pos -> [Pos]
MutationOrder
levelorder (a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)]

-- ** Helpers for defining instances

-- | Wrap mutants with a constructor.
wrap :: [Mutant a] -> (a -> b) -> [Mutant b]
wrap :: forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap [Mutant a]
mutants a -> b
wrapper = (Mutant a -> Mutant b) -> [Mutant a] -> [Mutant b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Mutant a -> Mutant b
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
wrapper) [Mutant a]
mutants

-- | Construct a position tree node from its indexed children.
node :: [(Int, Tree Pos)] -> Tree Pos
node :: [(Int, Tree Pos)] -> Tree Pos
node [(Int, Tree Pos)]
xs = Pos -> [Tree Pos] -> Tree Pos
forall a. a -> [Tree a] -> Tree a
Node [] (((Int, Tree Pos) -> Tree Pos) -> [(Int, Tree Pos)] -> [Tree Pos]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
idx, Tree Pos
children) -> (Pos -> Pos) -> Tree Pos -> Tree Pos
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
idx Int -> Pos -> Pos
forall a. a -> [a] -> [a]
:) Tree Pos
children) [(Int, Tree Pos)]
xs)

-- | Report an invalid position error
invalidPosition :: Pos -> a
invalidPosition :: forall a. Pos -> a
invalidPosition Pos
pos =
  [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"inside: invalid position: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Pos -> [Char]
forall a. Show a => a -> [Char]
show Pos
pos)

-- | Report an invalid position error, showing also the value being mutated.
invalidPositionShow :: (Show a) => Pos -> a -> b
invalidPositionShow :: forall a b. Show a => Pos -> a -> b
invalidPositionShow Pos
pos a
a =
  [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char]
"inside: invalid position: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Pos -> [Char]
forall a. Show a => a -> [Char]
show Pos
pos [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\nvalue: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
a)

{-------------------------------------------------------------------------------
-- * Immutable wrapper
-------------------------------------------------------------------------------}

-- | A mutable wrapper that produces no mutations.
--
-- This useful for constraining certain parts of a data structure to be
-- immutable while still fulfilling the 'Mutable' interface.
newtype Immutable a = Immutable {forall a. Immutable a -> a
unImmutabe :: a}
  deriving (Immutable a -> Immutable a -> Bool
(Immutable a -> Immutable a -> Bool)
-> (Immutable a -> Immutable a -> Bool) -> Eq (Immutable a)
forall a. Eq a => Immutable a -> Immutable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Immutable a -> Immutable a -> Bool
== :: Immutable a -> Immutable a -> Bool
$c/= :: forall a. Eq a => Immutable a -> Immutable a -> Bool
/= :: Immutable a -> Immutable a -> Bool
Eq, Eq (Immutable a)
Eq (Immutable a) =>
(Immutable a -> Immutable a -> Ordering)
-> (Immutable a -> Immutable a -> Bool)
-> (Immutable a -> Immutable a -> Bool)
-> (Immutable a -> Immutable a -> Bool)
-> (Immutable a -> Immutable a -> Bool)
-> (Immutable a -> Immutable a -> Immutable a)
-> (Immutable a -> Immutable a -> Immutable a)
-> Ord (Immutable a)
Immutable a -> Immutable a -> Bool
Immutable a -> Immutable a -> Ordering
Immutable a -> Immutable a -> Immutable a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Immutable a)
forall a. Ord a => Immutable a -> Immutable a -> Bool
forall a. Ord a => Immutable a -> Immutable a -> Ordering
forall a. Ord a => Immutable a -> Immutable a -> Immutable a
$ccompare :: forall a. Ord a => Immutable a -> Immutable a -> Ordering
compare :: Immutable a -> Immutable a -> Ordering
$c< :: forall a. Ord a => Immutable a -> Immutable a -> Bool
< :: Immutable a -> Immutable a -> Bool
$c<= :: forall a. Ord a => Immutable a -> Immutable a -> Bool
<= :: Immutable a -> Immutable a -> Bool
$c> :: forall a. Ord a => Immutable a -> Immutable a -> Bool
> :: Immutable a -> Immutable a -> Bool
$c>= :: forall a. Ord a => Immutable a -> Immutable a -> Bool
>= :: Immutable a -> Immutable a -> Bool
$cmax :: forall a. Ord a => Immutable a -> Immutable a -> Immutable a
max :: Immutable a -> Immutable a -> Immutable a
$cmin :: forall a. Ord a => Immutable a -> Immutable a -> Immutable a
min :: Immutable a -> Immutable a -> Immutable a
Ord, ReadPrec [Immutable a]
ReadPrec (Immutable a)
Int -> ReadS (Immutable a)
ReadS [Immutable a]
(Int -> ReadS (Immutable a))
-> ReadS [Immutable a]
-> ReadPrec (Immutable a)
-> ReadPrec [Immutable a]
-> Read (Immutable a)
forall a. Read a => ReadPrec [Immutable a]
forall a. Read a => ReadPrec (Immutable a)
forall a. Read a => Int -> ReadS (Immutable a)
forall a. Read a => ReadS [Immutable a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Immutable a)
readsPrec :: Int -> ReadS (Immutable a)
$creadList :: forall a. Read a => ReadS [Immutable a]
readList :: ReadS [Immutable a]
$creadPrec :: forall a. Read a => ReadPrec (Immutable a)
readPrec :: ReadPrec (Immutable a)
$creadListPrec :: forall a. Read a => ReadPrec [Immutable a]
readListPrec :: ReadPrec [Immutable a]
Read, Int -> Immutable a -> [Char] -> [Char]
[Immutable a] -> [Char] -> [Char]
Immutable a -> [Char]
(Int -> Immutable a -> [Char] -> [Char])
-> (Immutable a -> [Char])
-> ([Immutable a] -> [Char] -> [Char])
-> Show (Immutable a)
forall a. Show a => Int -> Immutable a -> [Char] -> [Char]
forall a. Show a => [Immutable a] -> [Char] -> [Char]
forall a. Show a => Immutable a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Immutable a -> [Char] -> [Char]
showsPrec :: Int -> Immutable a -> [Char] -> [Char]
$cshow :: forall a. Show a => Immutable a -> [Char]
show :: Immutable a -> [Char]
$cshowList :: forall a. Show a => [Immutable a] -> [Char] -> [Char]
showList :: [Immutable a] -> [Char] -> [Char]
Show)

instance (Arbitrary a) => Arbitrary (Immutable a) where
  arbitrary :: Gen (Immutable a)
arbitrary = a -> Immutable a
forall a. a -> Immutable a
Immutable (a -> Immutable a) -> Gen a -> Gen (Immutable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary

instance (Arbitrary a, Typeable a) => Mutable (Immutable a)

{-------------------------------------------------------------------------------
-- * Mutation order
-------------------------------------------------------------------------------}

-- | Order in which to traverse the mutation positions of a value.
type MutationOrder = forall a. Tree a -> [a]

-- | Pre-order traversal.
preorder :: MutationOrder
preorder :: MutationOrder
preorder Tree a
t = Tree a -> [a] -> [a]
forall {a}. Tree a -> [a] -> [a]
squish Tree a
t []
  where
    squish :: Tree a -> [a] -> [a]
squish (Node a
x [Tree a]
ts) [a]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Tree a -> [a] -> [a]) -> [a] -> [Tree a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr Tree a -> [a] -> [a]
squish [a]
xs [Tree a]
ts

-- | Post-order traversal.
postorder :: MutationOrder
postorder :: MutationOrder
postorder = [a] -> Tree a -> [a]
forall {a}. [a] -> Tree a -> [a]
squish []
  where
    squish :: [a] -> Tree a -> [a]
squish [a]
xs (Node a
x [Tree a]
ts) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> Tree a -> [a]) -> [a] -> [Tree a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [a] -> Tree a -> [a]
squish [a]
xs [Tree a]
ts

-- | Level-order traversal.
levelorder :: MutationOrder
levelorder :: MutationOrder
levelorder = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> (Tree a -> [[a]]) -> Tree a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [[a]]
forall a. Tree a -> [[a]]
levels

{-------------------------------------------------------------------------------
-- * Instances
-------------------------------------------------------------------------------}

instance Mutable () where
  def :: ()
def = ()

instance Mutable Int where
  def :: Int
def = Int
0
  mutate :: Mutation Int
mutate Int
n = [Gen Int -> Mutant Int
forall a. Gen a -> Mutant a
Rand Gen Int
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen Pos) -> Mutant Int
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Int -> FragmentStore -> Gen Pos
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Int
n)]

instance Mutable Double where
  def :: Double
def = Double
0
  mutate :: Mutation Double
mutate Double
n = [Gen Double -> Mutant Double
forall a. Gen a -> Mutant a
Rand Gen Double
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Double]) -> Mutant Double
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Double -> FragmentStore -> Gen [Double]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Double
n)]

instance Mutable Float where
  def :: Float
def = Float
0
  mutate :: Mutation Float
mutate Float
n = [Gen Float -> Mutant Float
forall a. Gen a -> Mutant a
Rand Gen Float
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Float]) -> Mutant Float
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Float -> FragmentStore -> Gen [Float]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Float
n)]

instance Mutable Word8 where
  def :: Word8
def = Word8
0
  mutate :: Mutation Word8
mutate Word8
n = [Gen Word8 -> Mutant Word8
forall a. Gen a -> Mutant a
Rand Gen Word8
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Word8]) -> Mutant Word8
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Word8 -> FragmentStore -> Gen [Word8]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Word8
n)]

instance Mutable Word16 where
  def :: Word16
def = Word16
0
  mutate :: Mutation Word16
mutate Word16
n = [Gen Word16 -> Mutant Word16
forall a. Gen a -> Mutant a
Rand Gen Word16
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Word16]) -> Mutant Word16
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Word16 -> FragmentStore -> Gen [Word16]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Word16
n)]

instance Mutable Word32 where
  def :: Word32
def = Word32
0
  mutate :: Mutation Word32
mutate Word32
n = [Gen Word32 -> Mutant Word32
forall a. Gen a -> Mutant a
Rand Gen Word32
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Word32]) -> Mutant Word32
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Word32 -> FragmentStore -> Gen [Word32]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Word32
n)]

instance Mutable Word64 where
  def :: Word64
def = Word64
0
  mutate :: Mutation Word64
mutate Word64
n = [Gen Word64 -> Mutant Word64
forall a. Gen a -> Mutant a
Rand Gen Word64
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Word64]) -> Mutant Word64
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Word64 -> FragmentStore -> Gen [Word64]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Word64
n)]

instance Mutable Char where
  def :: Char
def = Int -> Char
chr Int
0
  mutate :: Mutation Char
mutate Char
c = [Gen Char -> Mutant Char
forall a. Gen a -> Mutant a
Rand Gen Char
forall a. Arbitrary a => Gen a
arbitrary, (FragmentStore -> Gen [Char]) -> Mutant Char
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag (Char -> FragmentStore -> Gen [Char]
forall a. Typeable a => a -> FragmentStore -> Gen [a]
sampleFragments Char
c)]

instance Mutable Bool where
  def :: Bool
def = Bool
False
  mutate :: Mutation Bool
mutate Bool
b = [Bool -> Mutant Bool
forall a. a -> Mutant a
Pure (Bool -> Bool
not Bool
b)]

instance (Mutable a) => Mutable (Maybe a) where
  positions :: Maybe a -> Tree Pos
positions Maybe a
Nothing = [(Int, Tree Pos)] -> Tree Pos
node []
  positions (Just a
a) = [(Int, Tree Pos)] -> Tree Pos
node [(Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)]

  def :: Maybe a
def = Maybe a
forall a. Maybe a
Nothing

  mutate :: Mutation (Maybe a)
mutate Maybe a
Nothing = [Maybe a -> Mutant (Maybe a)
forall a. a -> Mutant a
Pure (a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Mutable a => a
def)]
  mutate (Just a
_) = [Maybe a -> Mutant (Maybe a)
forall a. a -> Mutant a
Pure Maybe a
forall a. Maybe a
Nothing]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (Maybe a)
inside [] forall x. Mutable x => Mutation x
mut Maybe a
x = Mutation (Maybe a)
forall x. Mutable x => Mutation x
mut Maybe a
x
  inside (Int
0 : Pos
ps) forall x. Mutable x => Mutation x
mut (Just a
a) = [Mutant a] -> (a -> Maybe a) -> [Mutant (Maybe a)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x)
  inside Pos
pos forall x. Mutable x => Mutation x
_ Maybe a
_ = Pos -> [Mutant (Maybe a)]
forall a. Pos -> a
invalidPosition Pos
pos

instance (Mutable a, Mutable b) => Mutable (Either a b) where
  positions :: Either a b -> Tree Pos
positions (Left a
a) = [(Int, Tree Pos)] -> Tree Pos
node [(Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)]
  positions (Right b
b) = [(Int, Tree Pos)] -> Tree Pos
node [(Int
0, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)]

  def :: Either a b
def = a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Mutable a => a
def

  mutate :: Mutation (Either a b)
mutate (Left a
_) = [Either a b -> Mutant (Either a b)
forall a. a -> Mutant a
Pure (b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Mutable a => a
def)]
  mutate (Right b
_) = [Either a b -> Mutant (Either a b)
forall a. a -> Mutant a
Pure (a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Mutable a => a
def)]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (Either a b)
inside [] forall x. Mutable x => Mutation x
mut Either a b
x = Mutation (Either a b)
forall x. Mutable x => Mutation x
mut Either a b
x
  inside (Int
0 : Pos
ps) forall x. Mutable x => Mutation x
mut (Left a
a) = [Mutant a] -> (a -> Either a b) -> [Mutant (Either a b)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
x -> a -> Either a b
forall a b. a -> Either a b
Left a
x)
  inside (Int
0 : Pos
ps) forall x. Mutable x => Mutation x
mut (Right b
a) = [Mutant b] -> (b -> Either a b) -> [Mutant (Either a b)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
a) (\b
x -> b -> Either a b
forall a b. b -> Either a b
Right b
x)
  inside Pos
pos forall x. Mutable x => Mutation x
_ Either a b
_ = Pos -> [Mutant (Either a b)]
forall a. Pos -> a
invalidPosition Pos
pos

instance (Mutable a) => Mutable [a] where
  positions :: [a] -> Tree Pos
positions [] = [(Int, Tree Pos)] -> Tree Pos
node []
  positions (a
x : [a]
xs) = [(Int, Tree Pos)] -> Tree Pos
node [(Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
x), (Int
1, [a] -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions [a]
xs)]

  def :: [a]
def = []

  -- NOTE: this instance additionally allows values to be duplicated
  mutate :: Mutation [a]
mutate [] = [[a] -> Mutant [a]
forall a. a -> Mutant a
Pure [a
forall a. Mutable a => a
def]]
  mutate [a
x] = [[a] -> Mutant [a]
forall a. a -> Mutant a
Pure [], [a] -> Mutant [a]
forall a. a -> Mutant a
Pure [a
x, a
x]]
  mutate (a
x : [a]
xs) = [[a] -> Mutant [a]
forall a. a -> Mutant a
Pure [], [a] -> Mutant [a]
forall a. a -> Mutant a
Pure [a]
xs, [a] -> Mutant [a]
forall a. a -> Mutant a
Pure (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation [a]
inside [] forall x. Mutable x => Mutation x
mut [a]
xs = Mutation [a]
forall x. Mutable x => Mutation x
mut [a]
xs
  inside (Int
0 : Pos
ps) forall x. Mutable x => Mutation x
mut (a
a : [a]
as) = [Mutant a] -> (a -> [a]) -> [Mutant [a]]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
x -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
  inside (Int
1 : Pos
ps) forall x. Mutable x => Mutation x
mut (a
a : [a]
as) = [Mutant [a]] -> ([a] -> [a]) -> [Mutant [a]]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation [a]
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut [a]
as) (\[a]
xs -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
  inside Pos
pos forall x. Mutable x => Mutation x
_ [a]
_ = Pos -> [Mutant [a]]
forall a. Pos -> a
invalidPosition Pos
pos

instance (Mutable v, Typeable k) => Mutable (Map k v) where
  positions :: Map k v -> Tree Pos
positions Map k v
m = [(Int, Tree Pos)] -> Tree Pos
node [(Int
k, v -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions v
v) | (Int
k, v
v) <- Pos -> [v] -> [(Int, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (Map k v -> [v]
forall k a. Map k a -> [a]
Map.elems Map k v
m)]

  def :: Map k v
def = Map k v
forall k a. Map k a
Map.empty

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (Map k v)
inside [] forall x. Mutable x => Mutation x
mut Map k v
m = Mutation (Map k v)
forall x. Mutable x => Mutation x
mut Map k v
m
  inside (Int
n : Pos
ps) forall x. Mutable x => Mutation x
mut Map k v
m
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
m =
        [Mutant v] -> (v -> Map k v) -> [Mutant (Map k v)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap
          (Pos -> (forall x. Mutable x => Mutation x) -> Mutation v
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut ((k, v) -> v
forall a b. (a, b) -> b
snd (Int -> Map k v -> (k, v)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
n Map k v
m)))
          (\v
x -> (k -> v -> Maybe v) -> Int -> Map k v -> Map k v
forall k a. (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
Map.updateAt (\k
_ v
_ -> v -> Maybe v
forall a. a -> Maybe a
Just v
x) Int
n Map k v
m)
    | Bool
otherwise =
        Pos -> [Mutant (Map k v)]
forall a. Pos -> a
invalidPosition (Int
n Int -> Pos -> Pos
forall a. a -> [a] -> [a]
: Pos
ps)

-- ** Tuple instances

instance
  ( Mutable a
  , Mutable b
  )
  => Mutable (a, b)
  where
  positions :: (a, b) -> Tree Pos
positions (a
a, b
b) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      ]

  def :: (a, b)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b)
mutate (a
a, b
b) =
    [(a -> (a, b)) -> Mutant a -> Mutant (a, b)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b)] -> [Mutant (a, b)] -> [Mutant (a, b)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b)) -> Mutant b -> Mutant (a, b)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (a, b)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b)
x@(a
a, b
b) =
    case Pos
pos of
      [] -> Mutation (a, b)
forall x. Mutable x => Mutation x
mut (a, b)
x
      (Int
0 : Pos
ps) -> [Mutant a] -> (a -> (a, b)) -> [Mutant (a, b)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b))
      (Int
1 : Pos
ps) -> [Mutant b] -> (b -> (a, b)) -> [Mutant (a, b)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b'))
      Pos
_ -> Pos -> [Mutant (a, b)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  )
  => Mutable (a, b, c)
  where
  positions :: (a, b, c) -> Tree Pos
positions (a
a, b
b, c
c) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      ]

  def :: (a, b, c)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c)
mutate (a
a, b
b, c
c) =
    [(a -> (a, b, c)) -> Mutant a -> Mutant (a, b, c)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c)] -> [Mutant (a, b, c)] -> [Mutant (a, b, c)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c)) -> Mutant b -> Mutant (a, b, c)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c)] -> [Mutant (a, b, c)] -> [Mutant (a, b, c)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c)) -> Mutant c -> Mutant (a, b, c)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (a, b, c)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c)
x@(a
a, b
b, c
c) =
    case Pos
pos of
      [] -> Mutation (a, b, c)
forall x. Mutable x => Mutation x
mut (a, b, c)
x
      (Int
0 : Pos
ps) -> [Mutant a] -> (a -> (a, b, c)) -> [Mutant (a, b, c)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c))
      (Int
1 : Pos
ps) -> [Mutant b] -> (b -> (a, b, c)) -> [Mutant (a, b, c)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c))
      (Int
2 : Pos
ps) -> [Mutant c] -> (c -> (a, b, c)) -> [Mutant (a, b, c)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c'))
      Pos
_ -> Pos -> [Mutant (a, b, c)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  )
  => Mutable (a, b, c, d)
  where
  positions :: (a, b, c, d) -> Tree Pos
positions (a
a, b
b, c
c, d
d) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      ]

  def :: (a, b, c, d)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d)
mutate (a
a, b
b, c
c, d
d) =
    [(a -> (a, b, c, d)) -> Mutant a -> Mutant (a, b, c, d)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d)]
-> [Mutant (a, b, c, d)] -> [Mutant (a, b, c, d)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d)) -> Mutant b -> Mutant (a, b, c, d)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d)]
-> [Mutant (a, b, c, d)] -> [Mutant (a, b, c, d)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d)) -> Mutant c -> Mutant (a, b, c, d)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d)]
-> [Mutant (a, b, c, d)] -> [Mutant (a, b, c, d)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d)) -> Mutant d -> Mutant (a, b, c, d)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]

  inside :: Pos -> (forall x. Mutable x => Mutation x) -> Mutation (a, b, c, d)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d)
x@(a
a, b
b, c
c, d
d) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d)
forall x. Mutable x => Mutation x
mut (a, b, c, d)
x
      (Int
0 : Pos
ps) -> [Mutant a] -> (a -> (a, b, c, d)) -> [Mutant (a, b, c, d)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d))
      (Int
1 : Pos
ps) -> [Mutant b] -> (b -> (a, b, c, d)) -> [Mutant (a, b, c, d)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d))
      (Int
2 : Pos
ps) -> [Mutant c] -> (c -> (a, b, c, d)) -> [Mutant (a, b, c, d)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d))
      (Int
3 : Pos
ps) -> [Mutant d] -> (d -> (a, b, c, d)) -> [Mutant (a, b, c, d)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  )
  => Mutable (a, b, c, d, e)
  where
  positions :: (a, b, c, d, e) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      ]

  def :: (a, b, c, d, e)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e)
mutate (a
a, b
b, c
c, d
d, e
e) =
    [(a -> (a, b, c, d, e)) -> Mutant a -> Mutant (a, b, c, d, e)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e)]
-> [Mutant (a, b, c, d, e)] -> [Mutant (a, b, c, d, e)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e)) -> Mutant b -> Mutant (a, b, c, d, e)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e)]
-> [Mutant (a, b, c, d, e)] -> [Mutant (a, b, c, d, e)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e)) -> Mutant c -> Mutant (a, b, c, d, e)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e)]
-> [Mutant (a, b, c, d, e)] -> [Mutant (a, b, c, d, e)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e)) -> Mutant d -> Mutant (a, b, c, d, e)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e)]
-> [Mutant (a, b, c, d, e)] -> [Mutant (a, b, c, d, e)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e)) -> Mutant e -> Mutant (a, b, c, d, e)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]

  inside :: Pos
-> (forall x. Mutable x => Mutation x) -> Mutation (a, b, c, d, e)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e)
x@(a
a, b
b, c
c, d
d, e
e) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e)
x
      (Int
0 : Pos
ps) -> [Mutant a] -> (a -> (a, b, c, d, e)) -> [Mutant (a, b, c, d, e)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e))
      (Int
1 : Pos
ps) -> [Mutant b] -> (b -> (a, b, c, d, e)) -> [Mutant (a, b, c, d, e)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e))
      (Int
2 : Pos
ps) -> [Mutant c] -> (c -> (a, b, c, d, e)) -> [Mutant (a, b, c, d, e)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e))
      (Int
3 : Pos
ps) -> [Mutant d] -> (d -> (a, b, c, d, e)) -> [Mutant (a, b, c, d, e)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e))
      (Int
4 : Pos
ps) -> [Mutant e] -> (e -> (a, b, c, d, e)) -> [Mutant (a, b, c, d, e)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  , Mutable f
  )
  => Mutable (a, b, c, d, e, f)
  where
  positions :: (a, b, c, d, e, f) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e, f
f) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      , (Int
5, f -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions f
f)
      ]

  def :: (a, b, c, d, e, f)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def, f
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e, f)
mutate (a
a, b
b, c
c, d
d, e
e, f
f) =
    [(a -> (a, b, c, d, e, f)) -> Mutant a -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e, f
f)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e, f)]
-> [Mutant (a, b, c, d, e, f)] -> [Mutant (a, b, c, d, e, f)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e, f)) -> Mutant b -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e, f
f)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e, f)]
-> [Mutant (a, b, c, d, e, f)] -> [Mutant (a, b, c, d, e, f)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e, f)) -> Mutant c -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e, f
f)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e, f)]
-> [Mutant (a, b, c, d, e, f)] -> [Mutant (a, b, c, d, e, f)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e, f)) -> Mutant d -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e, f
f)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e, f)]
-> [Mutant (a, b, c, d, e, f)] -> [Mutant (a, b, c, d, e, f)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e, f)) -> Mutant e -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x, f
f)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]
      [Mutant (a, b, c, d, e, f)]
-> [Mutant (a, b, c, d, e, f)] -> [Mutant (a, b, c, d, e, f)]
forall a. Semigroup a => a -> a -> a
<> [(f -> (a, b, c, d, e, f)) -> Mutant f -> Mutant (a, b, c, d, e, f)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f
x -> (a
a, b
b, c
c, d
d, e
e, f
x)) Mutant f
gf | Mutant f
gf <- Mutation f
forall x. Mutable x => Mutation x
mutate f
f]

  inside :: Pos
-> (forall x. Mutable x => Mutation x)
-> Mutation (a, b, c, d, e, f)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e, f)
x@(a
a, b
b, c
c, d
d, e
e, f
f) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e, f)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e, f)
x
      (Int
0 : Pos
ps) -> [Mutant a]
-> (a -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e, f
f))
      (Int
1 : Pos
ps) -> [Mutant b]
-> (b -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e, f
f))
      (Int
2 : Pos
ps) -> [Mutant c]
-> (c -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e, f
f))
      (Int
3 : Pos
ps) -> [Mutant d]
-> (d -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e, f
f))
      (Int
4 : Pos
ps) -> [Mutant e]
-> (e -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e', f
f))
      (Int
5 : Pos
ps) -> [Mutant f]
-> (f -> (a, b, c, d, e, f)) -> [Mutant (a, b, c, d, e, f)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation f
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut f
f) (\f
f' -> (a
a, b
b, c
c, d
d, e
e, f
f'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e, f)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  , Mutable f
  , Mutable g
  )
  => Mutable (a, b, c, d, e, f, g)
  where
  positions :: (a, b, c, d, e, f, g) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      , (Int
5, f -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions f
f)
      , (Int
6, g -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions g
g)
      ]

  def :: (a, b, c, d, e, f, g)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def, f
forall a. Mutable a => a
def, g
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e, f, g)
mutate (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    [(a -> (a, b, c, d, e, f, g))
-> Mutant a -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e, f
f, g
g)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e, f, g))
-> Mutant b -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e, f
f, g
g)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e, f, g))
-> Mutant c -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e, f
f, g
g)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e, f, g))
-> Mutant d -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e, f
f, g
g)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e, f, g))
-> Mutant e -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x, f
f, g
g)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(f -> (a, b, c, d, e, f, g))
-> Mutant f -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f
x -> (a
a, b
b, c
c, d
d, e
e, f
x, g
g)) Mutant f
gf | Mutant f
gf <- Mutation f
forall x. Mutable x => Mutation x
mutate f
f]
      [Mutant (a, b, c, d, e, f, g)]
-> [Mutant (a, b, c, d, e, f, g)] -> [Mutant (a, b, c, d, e, f, g)]
forall a. Semigroup a => a -> a -> a
<> [(g -> (a, b, c, d, e, f, g))
-> Mutant g -> Mutant (a, b, c, d, e, f, g)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
x)) Mutant g
gg | Mutant g
gg <- Mutation g
forall x. Mutable x => Mutation x
mutate g
g]

  inside :: Pos
-> (forall x. Mutable x => Mutation x)
-> Mutation (a, b, c, d, e, f, g)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e, f, g)
x@(a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e, f, g)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e, f, g)
x
      (Int
0 : Pos
ps) -> [Mutant a]
-> (a -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e, f
f, g
g))
      (Int
1 : Pos
ps) -> [Mutant b]
-> (b -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e, f
f, g
g))
      (Int
2 : Pos
ps) -> [Mutant c]
-> (c -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e, f
f, g
g))
      (Int
3 : Pos
ps) -> [Mutant d]
-> (d -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e, f
f, g
g))
      (Int
4 : Pos
ps) -> [Mutant e]
-> (e -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e', f
f, g
g))
      (Int
5 : Pos
ps) -> [Mutant f]
-> (f -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation f
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut f
f) (\f
f' -> (a
a, b
b, c
c, d
d, e
e, f
f', g
g))
      (Int
6 : Pos
ps) -> [Mutant g]
-> (g -> (a, b, c, d, e, f, g)) -> [Mutant (a, b, c, d, e, f, g)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation g
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut g
g) (\g
g' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e, f, g)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  , Mutable f
  , Mutable g
  , Mutable h
  )
  => Mutable (a, b, c, d, e, f, g, h)
  where
  positions :: (a, b, c, d, e, f, g, h) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      , (Int
5, f -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions f
f)
      , (Int
6, g -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions g
g)
      , (Int
7, h -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions h
h)
      ]

  def :: (a, b, c, d, e, f, g, h)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def, f
forall a. Mutable a => a
def, g
forall a. Mutable a => a
def, h
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e, f, g, h)
mutate (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    [(a -> (a, b, c, d, e, f, g, h))
-> Mutant a -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e, f
f, g
g, h
h)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e, f, g, h))
-> Mutant b -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e, f
f, g
g, h
h)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e, f, g, h))
-> Mutant c -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e, f
f, g
g, h
h)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e, f, g, h))
-> Mutant d -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e, f
f, g
g, h
h)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e, f, g, h))
-> Mutant e -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x, f
f, g
g, h
h)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(f -> (a, b, c, d, e, f, g, h))
-> Mutant f -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f
x -> (a
a, b
b, c
c, d
d, e
e, f
x, g
g, h
h)) Mutant f
gf | Mutant f
gf <- Mutation f
forall x. Mutable x => Mutation x
mutate f
f]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(g -> (a, b, c, d, e, f, g, h))
-> Mutant g -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
x, h
h)) Mutant g
gg | Mutant g
gg <- Mutation g
forall x. Mutable x => Mutation x
mutate g
g]
      [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Semigroup a => a -> a -> a
<> [(h -> (a, b, c, d, e, f, g, h))
-> Mutant h -> Mutant (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\h
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
x)) Mutant h
gh | Mutant h
gh <- Mutation h
forall x. Mutable x => Mutation x
mutate h
h]

  inside :: Pos
-> (forall x. Mutable x => Mutation x)
-> Mutation (a, b, c, d, e, f, g, h)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e, f, g, h)
x@(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e, f, g, h)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e, f, g, h)
x
      (Int
0 : Pos
ps) -> [Mutant a]
-> (a -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e, f
f, g
g, h
h))
      (Int
1 : Pos
ps) -> [Mutant b]
-> (b -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e, f
f, g
g, h
h))
      (Int
2 : Pos
ps) -> [Mutant c]
-> (c -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e, f
f, g
g, h
h))
      (Int
3 : Pos
ps) -> [Mutant d]
-> (d -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e, f
f, g
g, h
h))
      (Int
4 : Pos
ps) -> [Mutant e]
-> (e -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e', f
f, g
g, h
h))
      (Int
5 : Pos
ps) -> [Mutant f]
-> (f -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation f
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut f
f) (\f
f' -> (a
a, b
b, c
c, d
d, e
e, f
f', g
g, h
h))
      (Int
6 : Pos
ps) -> [Mutant g]
-> (g -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation g
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut g
g) (\g
g' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g', h
h))
      (Int
7 : Pos
ps) -> [Mutant h]
-> (h -> (a, b, c, d, e, f, g, h))
-> [Mutant (a, b, c, d, e, f, g, h)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation h
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut h
h) (\h
h' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e, f, g, h)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  , Mutable f
  , Mutable g
  , Mutable h
  , Mutable i
  )
  => Mutable (a, b, c, d, e, f, g, h, i)
  where
  positions :: (a, b, c, d, e, f, g, h, i) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      , (Int
5, f -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions f
f)
      , (Int
6, g -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions g
g)
      , (Int
7, h -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions h
h)
      , (Int
8, i -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions i
i)
      ]

  def :: (a, b, c, d, e, f, g, h, i)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def, f
forall a. Mutable a => a
def, g
forall a. Mutable a => a
def, h
forall a. Mutable a => a
def, i
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e, f, g, h, i)
mutate (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
    [(a -> (a, b, c, d, e, f, g, h, i))
-> Mutant a -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e, f, g, h, i))
-> Mutant b -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e, f
f, g
g, h
h, i
i)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e, f, g, h, i))
-> Mutant c -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e, f
f, g
g, h
h, i
i)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e, f, g, h, i))
-> Mutant d -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e, f
f, g
g, h
h, i
i)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e, f, g, h, i))
-> Mutant e -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x, f
f, g
g, h
h, i
i)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(f -> (a, b, c, d, e, f, g, h, i))
-> Mutant f -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f
x -> (a
a, b
b, c
c, d
d, e
e, f
x, g
g, h
h, i
i)) Mutant f
gf | Mutant f
gf <- Mutation f
forall x. Mutable x => Mutation x
mutate f
f]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(g -> (a, b, c, d, e, f, g, h, i))
-> Mutant g -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
x, h
h, i
i)) Mutant g
gg | Mutant g
gg <- Mutation g
forall x. Mutable x => Mutation x
mutate g
g]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(h -> (a, b, c, d, e, f, g, h, i))
-> Mutant h -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\h
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
x, i
i)) Mutant h
gh | Mutant h
gh <- Mutation h
forall x. Mutable x => Mutation x
mutate h
h]
      [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Semigroup a => a -> a -> a
<> [(i -> (a, b, c, d, e, f, g, h, i))
-> Mutant i -> Mutant (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
x)) Mutant i
gi | Mutant i
gi <- Mutation i
forall x. Mutable x => Mutation x
mutate i
i]

  inside :: Pos
-> (forall x. Mutable x => Mutation x)
-> Mutation (a, b, c, d, e, f, g, h, i)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e, f, g, h, i)
x@(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e, f, g, h, i)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e, f, g, h, i)
x
      (Int
0 : Pos
ps) -> [Mutant a]
-> (a -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i))
      (Int
1 : Pos
ps) -> [Mutant b]
-> (b -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e, f
f, g
g, h
h, i
i))
      (Int
2 : Pos
ps) -> [Mutant c]
-> (c -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e, f
f, g
g, h
h, i
i))
      (Int
3 : Pos
ps) -> [Mutant d]
-> (d -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e, f
f, g
g, h
h, i
i))
      (Int
4 : Pos
ps) -> [Mutant e]
-> (e -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e', f
f, g
g, h
h, i
i))
      (Int
5 : Pos
ps) -> [Mutant f]
-> (f -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation f
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut f
f) (\f
f' -> (a
a, b
b, c
c, d
d, e
e, f
f', g
g, h
h, i
i))
      (Int
6 : Pos
ps) -> [Mutant g]
-> (g -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation g
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut g
g) (\g
g' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g', h
h, i
i))
      (Int
7 : Pos
ps) -> [Mutant h]
-> (h -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation h
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut h
h) (\h
h' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h', i
i))
      (Int
8 : Pos
ps) -> [Mutant i]
-> (i -> (a, b, c, d, e, f, g, h, i))
-> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation i
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut i
i) (\i
i' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e, f, g, h, i)]
forall a. Pos -> a
invalidPosition Pos
pos

instance
  ( Mutable a
  , Mutable b
  , Mutable c
  , Mutable d
  , Mutable e
  , Mutable f
  , Mutable g
  , Mutable h
  , Mutable i
  , Mutable j
  )
  => Mutable (a, b, c, d, e, f, g, h, i, j)
  where
  positions :: (a, b, c, d, e, f, g, h, i, j) -> Tree Pos
positions (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
    [(Int, Tree Pos)] -> Tree Pos
node
      [ (Int
0, a -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions a
a)
      , (Int
1, b -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions b
b)
      , (Int
2, c -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions c
c)
      , (Int
3, d -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions d
d)
      , (Int
4, e -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions e
e)
      , (Int
5, f -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions f
f)
      , (Int
6, g -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions g
g)
      , (Int
7, h -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions h
h)
      , (Int
8, i -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions i
i)
      , (Int
9, j -> Tree Pos
forall a. Mutable a => a -> Tree Pos
positions j
j)
      ]

  def :: (a, b, c, d, e, f, g, h, i, j)
def = (a
forall a. Mutable a => a
def, b
forall a. Mutable a => a
def, c
forall a. Mutable a => a
def, d
forall a. Mutable a => a
def, e
forall a. Mutable a => a
def, f
forall a. Mutable a => a
def, g
forall a. Mutable a => a
def, h
forall a. Mutable a => a
def, i
forall a. Mutable a => a
def, j
forall a. Mutable a => a
def)

  mutate :: Mutation (a, b, c, d, e, f, g, h, i, j)
mutate (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
    [(a -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant a -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)) Mutant a
ga | Mutant a
ga <- Mutation a
forall x. Mutable x => Mutation x
mutate a
a]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(b -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant b -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
x -> (a
a, b
x, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)) Mutant b
gb | Mutant b
gb <- Mutation b
forall x. Mutable x => Mutation x
mutate b
b]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(c -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant c -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
x -> (a
a, b
b, c
x, d
d, e
e, f
f, g
g, h
h, i
i, j
j)) Mutant c
gc | Mutant c
gc <- Mutation c
forall x. Mutable x => Mutation x
mutate c
c]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(d -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant d -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d
x -> (a
a, b
b, c
c, d
x, e
e, f
f, g
g, h
h, i
i, j
j)) Mutant d
gd | Mutant d
gd <- Mutation d
forall x. Mutable x => Mutation x
mutate d
d]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(e -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant e -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
x -> (a
a, b
b, c
c, d
d, e
x, f
f, g
g, h
h, i
i, j
j)) Mutant e
ge | Mutant e
ge <- Mutation e
forall x. Mutable x => Mutation x
mutate e
e]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(f -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant f -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f
x -> (a
a, b
b, c
c, d
d, e
e, f
x, g
g, h
h, i
i, j
j)) Mutant f
gf | Mutant f
gf <- Mutation f
forall x. Mutable x => Mutation x
mutate f
f]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(g -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant g -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
x, h
h, i
i, j
j)) Mutant g
gg | Mutant g
gg <- Mutation g
forall x. Mutable x => Mutation x
mutate g
g]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(h -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant h -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\h
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
x, i
i, j
j)) Mutant h
gh | Mutant h
gh <- Mutation h
forall x. Mutable x => Mutation x
mutate h
h]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(i -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant i -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
x, j
j)) Mutant i
gi | Mutant i
gi <- Mutation i
forall x. Mutable x => Mutation x
mutate i
i]
      [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Semigroup a => a -> a -> a
<> [(j -> (a, b, c, d, e, f, g, h, i, j))
-> Mutant j -> Mutant (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> Mutant a -> Mutant b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\j
x -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
x)) Mutant j
gj | Mutant j
gj <- Mutation j
forall x. Mutable x => Mutation x
mutate j
j]

  inside :: Pos
-> (forall x. Mutable x => Mutation x)
-> Mutation (a, b, c, d, e, f, g, h, i, j)
inside Pos
pos forall x. Mutable x => Mutation x
mut x :: (a, b, c, d, e, f, g, h, i, j)
x@(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
    case Pos
pos of
      [] -> Mutation (a, b, c, d, e, f, g, h, i, j)
forall x. Mutable x => Mutation x
mut (a, b, c, d, e, f, g, h, i, j)
x
      (Int
0 : Pos
ps) -> [Mutant a]
-> (a -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut a
a) (\a
a' -> (a
a', b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j))
      (Int
1 : Pos
ps) -> [Mutant b]
-> (b -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation b
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut b
b) (\b
b' -> (a
a, b
b', c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j))
      (Int
2 : Pos
ps) -> [Mutant c]
-> (c -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation c
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut c
c) (\c
c' -> (a
a, b
b, c
c', d
d, e
e, f
f, g
g, h
h, i
i, j
j))
      (Int
3 : Pos
ps) -> [Mutant d]
-> (d -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation d
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut d
d) (\d
d' -> (a
a, b
b, c
c, d
d', e
e, f
f, g
g, h
h, i
i, j
j))
      (Int
4 : Pos
ps) -> [Mutant e]
-> (e -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation e
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut e
e) (\e
e' -> (a
a, b
b, c
c, d
d, e
e', f
f, g
g, h
h, i
i, j
j))
      (Int
5 : Pos
ps) -> [Mutant f]
-> (f -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation f
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut f
f) (\f
f' -> (a
a, b
b, c
c, d
d, e
e, f
f', g
g, h
h, i
i, j
j))
      (Int
6 : Pos
ps) -> [Mutant g]
-> (g -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation g
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut g
g) (\g
g' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g', h
h, i
i, j
j))
      (Int
7 : Pos
ps) -> [Mutant h]
-> (h -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation h
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut h
h) (\h
h' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h', i
i, j
j))
      (Int
8 : Pos
ps) -> [Mutant i]
-> (i -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation i
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut i
i) (\i
i' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i', j
j))
      (Int
9 : Pos
ps) -> [Mutant j]
-> (j -> (a, b, c, d, e, f, g, h, i, j))
-> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a b. [Mutant a] -> (a -> b) -> [Mutant b]
wrap (Pos -> (forall x. Mutable x => Mutation x) -> Mutation j
forall a.
Mutable a =>
Pos -> (forall x. Mutable x => Mutation x) -> Mutation a
inside Pos
ps Mutation x
forall x. Mutable x => Mutation x
mut j
j) (\j
j' -> (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j'))
      Pos
_ -> Pos -> [Mutant (a, b, c, d, e, f, g, h, i, j)]
forall a. Pos -> a
invalidPosition Pos
pos