{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}

module ADD.Games.Correct where

import Data.Foldable
import qualified Data.Set as S
import Data.Set (Set)
import Data.Data
import Data.Word
import GHC.Generics
import Test.QuickCheck hiding (Result)
import Control.Monad.Writer
import Data.Tuple (swap)
import Data.List
import QuickSpec

data Event = Event Word8
  deriving stock (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Eq Event
Eq Event =>
(Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
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
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Typeable Event
DataType
Constr
Typeable Event =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Event -> c Event)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Event)
-> (Event -> Constr)
-> (Event -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Event))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event))
-> ((forall b. Data b => b -> b) -> Event -> Event)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall u. (forall d. Data d => d -> u) -> Event -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Event -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Event -> m Event)
-> Data Event
Event -> DataType
Event -> Constr
(forall b. Data b => b -> b) -> Event -> Event
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
forall u. (forall d. Data d => d -> u) -> Event -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cEvent :: Constr
$tEvent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapMp :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapM :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapQi :: Int -> (forall d. Data d => d -> u) -> Event -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
gmapQ :: (forall d. Data d => d -> u) -> Event -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Event -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapT :: (forall b. Data b => b -> b) -> Event -> Event
$cgmapT :: (forall b. Data b => b -> b) -> Event -> Event
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Event)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
dataTypeOf :: Event -> DataType
$cdataTypeOf :: Event -> DataType
toConstr :: Event -> Constr
$ctoConstr :: Event -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cp1Data :: Typeable Event
Data, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic)

-- # ArbitraryEvent
instance Arbitrary Event where
  arbitrary :: Gen Event
arbitrary = Word8 -> Event
Event (Word8 -> Event) -> Gen Word8 -> Gen Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Event -> [Event]
shrink    = Event -> [Event]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink


data EventFilter
  = Always
  | Never
  | Exactly Word8  -- ! 1
  deriving stock (EventFilter -> EventFilter -> Bool
(EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> Bool) -> Eq EventFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventFilter -> EventFilter -> Bool
$c/= :: EventFilter -> EventFilter -> Bool
== :: EventFilter -> EventFilter -> Bool
$c== :: EventFilter -> EventFilter -> Bool
Eq, Eq EventFilter
Eq EventFilter =>
(EventFilter -> EventFilter -> Ordering)
-> (EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> Bool)
-> (EventFilter -> EventFilter -> EventFilter)
-> (EventFilter -> EventFilter -> EventFilter)
-> Ord EventFilter
EventFilter -> EventFilter -> Bool
EventFilter -> EventFilter -> Ordering
EventFilter -> EventFilter -> EventFilter
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
min :: EventFilter -> EventFilter -> EventFilter
$cmin :: EventFilter -> EventFilter -> EventFilter
max :: EventFilter -> EventFilter -> EventFilter
$cmax :: EventFilter -> EventFilter -> EventFilter
>= :: EventFilter -> EventFilter -> Bool
$c>= :: EventFilter -> EventFilter -> Bool
> :: EventFilter -> EventFilter -> Bool
$c> :: EventFilter -> EventFilter -> Bool
<= :: EventFilter -> EventFilter -> Bool
$c<= :: EventFilter -> EventFilter -> Bool
< :: EventFilter -> EventFilter -> Bool
$c< :: EventFilter -> EventFilter -> Bool
compare :: EventFilter -> EventFilter -> Ordering
$ccompare :: EventFilter -> EventFilter -> Ordering
$cp1Ord :: Eq EventFilter
Ord, Int -> EventFilter -> ShowS
[EventFilter] -> ShowS
EventFilter -> String
(Int -> EventFilter -> ShowS)
-> (EventFilter -> String)
-> ([EventFilter] -> ShowS)
-> Show EventFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventFilter] -> ShowS
$cshowList :: [EventFilter] -> ShowS
show :: EventFilter -> String
$cshow :: EventFilter -> String
showsPrec :: Int -> EventFilter -> ShowS
$cshowsPrec :: Int -> EventFilter -> ShowS
Show, Typeable EventFilter
DataType
Constr
Typeable EventFilter =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EventFilter -> c EventFilter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EventFilter)
-> (EventFilter -> Constr)
-> (EventFilter -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EventFilter))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EventFilter))
-> ((forall b. Data b => b -> b) -> EventFilter -> EventFilter)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EventFilter -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EventFilter -> r)
-> (forall u. (forall d. Data d => d -> u) -> EventFilter -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EventFilter -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter)
-> Data EventFilter
EventFilter -> DataType
EventFilter -> Constr
(forall b. Data b => b -> b) -> EventFilter -> EventFilter
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventFilter -> c EventFilter
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventFilter
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EventFilter -> u
forall u. (forall d. Data d => d -> u) -> EventFilter -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventFilter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventFilter -> c EventFilter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventFilter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventFilter)
$cExactly :: Constr
$cNever :: Constr
$cAlways :: Constr
$tEventFilter :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
gmapMp :: (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
gmapM :: (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EventFilter -> m EventFilter
gmapQi :: Int -> (forall d. Data d => d -> u) -> EventFilter -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EventFilter -> u
gmapQ :: (forall d. Data d => d -> u) -> EventFilter -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventFilter -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventFilter -> r
gmapT :: (forall b. Data b => b -> b) -> EventFilter -> EventFilter
$cgmapT :: (forall b. Data b => b -> b) -> EventFilter -> EventFilter
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventFilter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EventFilter)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EventFilter)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventFilter)
dataTypeOf :: EventFilter -> DataType
$cdataTypeOf :: EventFilter -> DataType
toConstr :: EventFilter -> Constr
$ctoConstr :: EventFilter -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventFilter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventFilter
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventFilter -> c EventFilter
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventFilter -> c EventFilter
$cp1Data :: Typeable EventFilter
Data, (forall x. EventFilter -> Rep EventFilter x)
-> (forall x. Rep EventFilter x -> EventFilter)
-> Generic EventFilter
forall x. Rep EventFilter x -> EventFilter
forall x. EventFilter -> Rep EventFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventFilter x -> EventFilter
$cfrom :: forall x. EventFilter -> Rep EventFilter x
Generic)

-- # ArbitraryEventFilter
instance Arbitrary EventFilter where
  arbitrary :: Gen EventFilter
arbitrary = [(Int, Gen EventFilter)] -> Gen EventFilter
forall a. [(Int, Gen a)] -> Gen a
frequency
    [ (3, EventFilter -> Gen EventFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFilter
Always)
    , (1, EventFilter -> Gen EventFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventFilter
Never)
    , (5, Word8 -> EventFilter
Exactly (Word8 -> EventFilter) -> Gen Word8 -> Gen EventFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary)
    ]
  shrink :: EventFilter -> [EventFilter]
shrink = EventFilter -> [EventFilter]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

always :: EventFilter
always :: EventFilter
always = EventFilter
Always

never :: EventFilter
never :: EventFilter
never = EventFilter
Never

sig_filters :: Sig
sig_filters :: Sig
sig_filters = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ String -> EventFilter -> Sig
forall a. Typeable a => String -> a -> Sig
con "always" EventFilter
always
  , String -> EventFilter -> Sig
forall a. Typeable a => String -> a -> Sig
con  "never" EventFilter
never
  ]


data Reward = Reward Word8
  deriving stock (Reward -> Reward -> Bool
(Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool) -> Eq Reward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reward -> Reward -> Bool
$c/= :: Reward -> Reward -> Bool
== :: Reward -> Reward -> Bool
$c== :: Reward -> Reward -> Bool
Eq, Eq Reward
Eq Reward =>
(Reward -> Reward -> Ordering)
-> (Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool)
-> (Reward -> Reward -> Bool)
-> (Reward -> Reward -> Reward)
-> (Reward -> Reward -> Reward)
-> Ord Reward
Reward -> Reward -> Bool
Reward -> Reward -> Ordering
Reward -> Reward -> Reward
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
min :: Reward -> Reward -> Reward
$cmin :: Reward -> Reward -> Reward
max :: Reward -> Reward -> Reward
$cmax :: Reward -> Reward -> Reward
>= :: Reward -> Reward -> Bool
$c>= :: Reward -> Reward -> Bool
> :: Reward -> Reward -> Bool
$c> :: Reward -> Reward -> Bool
<= :: Reward -> Reward -> Bool
$c<= :: Reward -> Reward -> Bool
< :: Reward -> Reward -> Bool
$c< :: Reward -> Reward -> Bool
compare :: Reward -> Reward -> Ordering
$ccompare :: Reward -> Reward -> Ordering
$cp1Ord :: Eq Reward
Ord, Int -> Reward -> ShowS
[Reward] -> ShowS
Reward -> String
(Int -> Reward -> ShowS)
-> (Reward -> String) -> ([Reward] -> ShowS) -> Show Reward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reward] -> ShowS
$cshowList :: [Reward] -> ShowS
show :: Reward -> String
$cshow :: Reward -> String
showsPrec :: Int -> Reward -> ShowS
$cshowsPrec :: Int -> Reward -> ShowS
Show, Typeable Reward
DataType
Constr
Typeable Reward =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Reward -> c Reward)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Reward)
-> (Reward -> Constr)
-> (Reward -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Reward))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reward))
-> ((forall b. Data b => b -> b) -> Reward -> Reward)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Reward -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Reward -> r)
-> (forall u. (forall d. Data d => d -> u) -> Reward -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Reward -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Reward -> m Reward)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Reward -> m Reward)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Reward -> m Reward)
-> Data Reward
Reward -> DataType
Reward -> Constr
(forall b. Data b => b -> b) -> Reward -> Reward
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reward -> c Reward
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reward
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Reward -> u
forall u. (forall d. Data d => d -> u) -> Reward -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reward -> m Reward
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reward -> m Reward
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reward
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reward -> c Reward
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Reward)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reward)
$cReward :: Constr
$tReward :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Reward -> m Reward
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reward -> m Reward
gmapMp :: (forall d. Data d => d -> m d) -> Reward -> m Reward
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reward -> m Reward
gmapM :: (forall d. Data d => d -> m d) -> Reward -> m Reward
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reward -> m Reward
gmapQi :: Int -> (forall d. Data d => d -> u) -> Reward -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Reward -> u
gmapQ :: (forall d. Data d => d -> u) -> Reward -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Reward -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r
gmapT :: (forall b. Data b => b -> b) -> Reward -> Reward
$cgmapT :: (forall b. Data b => b -> b) -> Reward -> Reward
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reward)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reward)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Reward)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Reward)
dataTypeOf :: Reward -> DataType
$cdataTypeOf :: Reward -> DataType
toConstr :: Reward -> Constr
$ctoConstr :: Reward -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reward
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Reward
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reward -> c Reward
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reward -> c Reward
$cp1Data :: Typeable Reward
Data, (forall x. Reward -> Rep Reward x)
-> (forall x. Rep Reward x -> Reward) -> Generic Reward
forall x. Rep Reward x -> Reward
forall x. Reward -> Rep Reward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reward x -> Reward
$cfrom :: forall x. Reward -> Rep Reward x
Generic)

-- # ArbitraryReward
instance Arbitrary Reward where
  arbitrary :: Gen Reward
arbitrary = Word8 -> Reward
Reward (Word8 -> Reward) -> Gen Word8 -> Gen Reward
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Reward -> [Reward]
shrink    = Reward -> [Reward]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink


data Result
  = Victory
  | Defeat
  deriving stock (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Eq Result
Eq Result =>
(Result -> Result -> Ordering)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Result)
-> (Result -> Result -> Result)
-> Ord Result
Result -> Result -> Bool
Result -> Result -> Ordering
Result -> Result -> Result
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
min :: Result -> Result -> Result
$cmin :: Result -> Result -> Result
max :: Result -> Result -> Result
$cmax :: Result -> Result -> Result
>= :: Result -> Result -> Bool
$c>= :: Result -> Result -> Bool
> :: Result -> Result -> Bool
$c> :: Result -> Result -> Bool
<= :: Result -> Result -> Bool
$c<= :: Result -> Result -> Bool
< :: Result -> Result -> Bool
$c< :: Result -> Result -> Bool
compare :: Result -> Result -> Ordering
$ccompare :: Result -> Result -> Ordering
$cp1Ord :: Eq Result
Ord, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show, Typeable Result
DataType
Constr
Typeable Result =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Result -> c Result)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Result)
-> (Result -> Constr)
-> (Result -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Result))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result))
-> ((forall b. Data b => b -> b) -> Result -> Result)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Result -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Result -> r)
-> (forall u. (forall d. Data d => d -> u) -> Result -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Result -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Result -> m Result)
-> Data Result
Result -> DataType
Result -> Constr
(forall b. Data b => b -> b) -> Result -> Result
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Result -> u
forall u. (forall d. Data d => d -> u) -> Result -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result -> m Result
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Result)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
$cDefeat :: Constr
$cVictory :: Constr
$tResult :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Result -> m Result
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapMp :: (forall d. Data d => d -> m d) -> Result -> m Result
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapM :: (forall d. Data d => d -> m d) -> Result -> m Result
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Result -> m Result
gmapQi :: Int -> (forall d. Data d => d -> u) -> Result -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Result -> u
gmapQ :: (forall d. Data d => d -> u) -> Result -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Result -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r
gmapT :: (forall b. Data b => b -> b) -> Result -> Result
$cgmapT :: (forall b. Data b => b -> b) -> Result -> Result
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Result)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Result)
dataTypeOf :: Result -> DataType
$cdataTypeOf :: Result -> DataType
toConstr :: Result -> Constr
$ctoConstr :: Result -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Result
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Result -> c Result
$cp1Data :: Typeable Result
Data, (forall x. Result -> Rep Result x)
-> (forall x. Rep Result x -> Result) -> Generic Result
forall x. Rep Result x -> Result
forall x. Result -> Rep Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Result x -> Result
$cfrom :: forall x. Result -> Rep Result x
Generic)

-- # ArbitraryResult
instance Arbitrary Result where
  arbitrary :: Gen Result
arbitrary = [Result] -> Gen Result
forall a. [a] -> Gen a
elements [ Result
victory, Result
defeat ]
  shrink :: Result -> [Result]
shrink    = Result -> [Result]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

victory :: Result
victory :: Result
victory = Result
Victory

defeat :: Result
defeat :: Result
defeat = Result
Defeat

sig_results :: Sig
sig_results :: Sig
sig_results = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ String -> Result -> Sig
forall a. Typeable a => String -> a -> Sig
con "victory" Result
victory
  , String -> Result -> Sig
forall a. Typeable a => String -> a -> Sig
con "defeat"  Result
defeat
  ]


------------------------------------------------------------------------------
--                         constructors
------------------------------------------------------------------------------

data Game
  = Win
  | Lose
  | RewardThen Reward Game
  | Subgame Game Game Game
  | EitherW Game Game
  | Both Game Game
  | Race Game Game
  | Multigate [(EventFilter, Game)]
  deriving stock (Game -> Game -> Bool
(Game -> Game -> Bool) -> (Game -> Game -> Bool) -> Eq Game
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Game -> Game -> Bool
$c/= :: Game -> Game -> Bool
== :: Game -> Game -> Bool
$c== :: Game -> Game -> Bool
Eq, Eq Game
Eq Game =>
(Game -> Game -> Ordering)
-> (Game -> Game -> Bool)
-> (Game -> Game -> Bool)
-> (Game -> Game -> Bool)
-> (Game -> Game -> Bool)
-> (Game -> Game -> Game)
-> (Game -> Game -> Game)
-> Ord Game
Game -> Game -> Bool
Game -> Game -> Ordering
Game -> Game -> Game
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
min :: Game -> Game -> Game
$cmin :: Game -> Game -> Game
max :: Game -> Game -> Game
$cmax :: Game -> Game -> Game
>= :: Game -> Game -> Bool
$c>= :: Game -> Game -> Bool
> :: Game -> Game -> Bool
$c> :: Game -> Game -> Bool
<= :: Game -> Game -> Bool
$c<= :: Game -> Game -> Bool
< :: Game -> Game -> Bool
$c< :: Game -> Game -> Bool
compare :: Game -> Game -> Ordering
$ccompare :: Game -> Game -> Ordering
$cp1Ord :: Eq Game
Ord, Int -> Game -> ShowS
[Game] -> ShowS
Game -> String
(Int -> Game -> ShowS)
-> (Game -> String) -> ([Game] -> ShowS) -> Show Game
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Game] -> ShowS
$cshowList :: [Game] -> ShowS
show :: Game -> String
$cshow :: Game -> String
showsPrec :: Int -> Game -> ShowS
$cshowsPrec :: Int -> Game -> ShowS
Show, Typeable Game
DataType
Constr
Typeable Game =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Game -> c Game)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Game)
-> (Game -> Constr)
-> (Game -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Game))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Game))
-> ((forall b. Data b => b -> b) -> Game -> Game)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r)
-> (forall u. (forall d. Data d => d -> u) -> Game -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Game -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Game -> m Game)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Game -> m Game)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Game -> m Game)
-> Data Game
Game -> DataType
Game -> Constr
(forall b. Data b => b -> b) -> Game -> Game
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Game -> c Game
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Game
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Game -> u
forall u. (forall d. Data d => d -> u) -> Game -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Game -> m Game
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Game -> m Game
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Game
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Game -> c Game
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Game)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Game)
$cMultigate :: Constr
$cRace :: Constr
$cBoth :: Constr
$cEitherW :: Constr
$cSubgame :: Constr
$cRewardThen :: Constr
$cLose :: Constr
$cWin :: Constr
$tGame :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Game -> m Game
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Game -> m Game
gmapMp :: (forall d. Data d => d -> m d) -> Game -> m Game
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Game -> m Game
gmapM :: (forall d. Data d => d -> m d) -> Game -> m Game
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Game -> m Game
gmapQi :: Int -> (forall d. Data d => d -> u) -> Game -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Game -> u
gmapQ :: (forall d. Data d => d -> u) -> Game -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Game -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r
gmapT :: (forall b. Data b => b -> b) -> Game -> Game
$cgmapT :: (forall b. Data b => b -> b) -> Game -> Game
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Game)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Game)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Game)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Game)
dataTypeOf :: Game -> DataType
$cdataTypeOf :: Game -> DataType
toConstr :: Game -> Constr
$ctoConstr :: Game -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Game
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Game
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Game -> c Game
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Game -> c Game
$cp1Data :: Typeable Game
Data, (forall x. Game -> Rep Game x)
-> (forall x. Rep Game x -> Game) -> Generic Game
forall x. Rep Game x -> Game
forall x. Game -> Rep Game x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Game x -> Game
$cfrom :: forall x. Game -> Rep Game x
Generic)

-- # ArbitraryGame
instance Arbitrary Game where
  arbitrary :: Gen Game
arbitrary = (Int -> Gen Game) -> Gen Game
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Game) -> Gen Game) -> (Int -> Gen Game) -> Gen Game
forall a b. (a -> b) -> a -> b
$ \n :: Int
n ->
    case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 of
      True -> [Game] -> Gen Game
forall a. [a] -> Gen a
elements [Game
win, Game
lose]
      False -> [(Int, Gen Game)] -> Gen Game
forall a. [(Int, Gen a)] -> Gen a
frequency
        [ (3, Game -> Gen Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
win)
        , (3, Game -> Gen Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
lose)
        , (3, Reward -> Game
reward  (Reward -> Game) -> Gen Reward -> Gen Game
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Reward
forall a. Arbitrary a => Gen a
arbitrary)
        , (5, Reward -> Game -> Game
rewardThen (Reward -> Game -> Game) -> Gen Reward -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Reward
forall a. Arbitrary a => Gen a
arbitrary
                         Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2)
        , (5, Game -> Game -> Game
andThen (Game -> Game -> Game) -> Gen Game -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2
                      Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2)
        , (5, Game -> Game -> Game -> Game
subgame (Game -> Game -> Game -> Game)
-> Gen Game -> Gen (Game -> Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 3
                      Gen (Game -> Game -> Game) -> Gen Game -> Gen (Game -> Game)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 3
                      Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 3)
        , (5, Game -> Game -> Game
both (Game -> Game -> Game) -> Gen Game -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2
                   Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2)
        , (5, Game -> Game -> Game
eitherG (Game -> Game -> Game) -> Gen Game -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2
                      Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2)
        , (5, Game -> Game -> Game
race (Game -> Game -> Game) -> Gen Game -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2
                   Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Game
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 2)
        , (5, [(EventFilter, Game)] -> Game
multigate ([(EventFilter, Game)] -> Game)
-> Gen [(EventFilter, Game)] -> Gen Game
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [(EventFilter, Game)]
forall a. Arbitrary a => Int -> Gen a
decayArbitrary 5)
        , (2, Game -> Game
comeback  (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Game
forall a. Arbitrary a => Gen a
arbitrary)
        , (1, Game -> Gen Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
bottom)
        , (5, EventFilter -> Game -> Game
gate (EventFilter -> Game -> Game)
-> Gen EventFilter -> Gen (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EventFilter
forall a. Arbitrary a => Gen a
arbitrary Gen (Game -> Game) -> Gen Game -> Gen Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Game
forall a. Arbitrary a => Gen a
arbitrary)
        ]
  shrink :: Game -> [Game]
shrink = Game -> [Game]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

-- # ObserveGame
instance
    Observe [Event] (Set Reward, Maybe Result) Game
    where
  observe :: [Event] -> Game -> (Set Reward, Maybe Result)
observe = [Event] -> Game -> (Set Reward, Maybe Result)
runGame

decayArbitrary :: Arbitrary a => Int -> Gen a
decayArbitrary :: Int -> Gen a
decayArbitrary n :: Int
n = (Int -> Int) -> Gen a -> Gen a
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n) Gen a
forall a. Arbitrary a => Gen a
arbitrary

reward :: Reward -> Game
reward :: Reward -> Game
reward r :: Reward
r = Reward -> Game -> Game
rewardThen Reward
r Game
win

rewardThen :: Reward -> Game -> Game
rewardThen :: Reward -> Game -> Game
rewardThen = Reward -> Game -> Game
RewardThen

win :: Game
win :: Game
win = Game
Win

lose :: Game
lose :: Game
lose = Game
Lose

andThen :: Game -> Game -> Game
andThen :: Game -> Game -> Game
andThen g1 :: Game
g1 g2 :: Game
g2 = Game -> Game -> Game -> Game
subgame Game
g1 Game
g2 Game
lose

subgame :: Game -> Game -> Game -> Game
subgame :: Game -> Game -> Game -> Game
subgame (RewardThen r :: Reward
r g :: Game
g) g1 :: Game
g1 g2 :: Game
g2 =
  Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game -> Game
subgame Game
g Game
g1 Game
g2)
subgame Win  g1 :: Game
g1 _  = Game
g1
subgame Lose _  g2 :: Game
g2 = Game
g2
subgame g :: Game
g    g1 :: Game
g1 g2 :: Game
g2 = Game -> Game -> Game -> Game
Subgame Game
g Game
g1 Game
g2

eitherG :: Game -> Game -> Game
eitherG :: Game -> Game -> Game
eitherG (RewardThen r :: Reward
r g1 :: Game
g1) g2 :: Game
g2 =
  Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
eitherG Game
g1 Game
g2)
eitherG g1 :: Game
g1 (RewardThen r :: Reward
r g2 :: Game
g2) =
  Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
eitherG Game
g1 Game
g2)
eitherG Lose Lose = Game
lose
eitherG Win  _    = Game
win
eitherG _    Win  = Game
win
eitherG a :: Game
a    b :: Game
b    = Game -> Game -> Game
EitherW Game
a Game
b

both :: Game -> Game -> Game
both :: Game -> Game -> Game
both (RewardThen r :: Reward
r g1 :: Game
g1) g2 :: Game
g2 = Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
both Game
g1 Game
g2)
both g1 :: Game
g1 (RewardThen r :: Reward
r g2 :: Game
g2) = Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
both Game
g1 Game
g2)
both Win  Win  = Game
win
both Lose _    = Game
lose
both _    Lose = Game
lose
both a :: Game
a    b :: Game
b    = Game -> Game -> Game
Both Game
a Game
b

race :: Game -> Game -> Game
race :: Game -> Game -> Game
race (RewardThen r :: Reward
r g1 :: Game
g1) g2 :: Game
g2 = Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
race Game
g1 Game
g2)
race g1 :: Game
g1 (RewardThen r :: Reward
r g2 :: Game
g2) = Reward -> Game -> Game
rewardThen Reward
r (Game -> Game -> Game
race Game
g1 Game
g2)
race Win  _ = Game
win
race Lose _ = Game
lose
race _ Win  = Game
win
race _ Lose = Game
lose
race a :: Game
a b :: Game
b    = Game -> Game -> Game
Race Game
a Game
b

multigate :: [(EventFilter, Game)] -> Game
multigate :: [(EventFilter, Game)] -> Game
multigate cs :: [(EventFilter, Game)]
cs = [(EventFilter, Game)] -> Game
Multigate [(EventFilter, Game)]
cs

sig_games_core :: Sig
sig_games_core :: Sig
sig_games_core = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ String -> Game -> Sig
forall a. Typeable a => String -> a -> Sig
con        "win" Game
win
  , String -> Game -> Sig
forall a. Typeable a => String -> a -> Sig
con       "lose" Game
lose
  , String -> (Game -> Game -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con    "subgame" Game -> Game -> Game -> Game
subgame
  , String -> (Game -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con    "eitherG" Game -> Game -> Game
eitherG
  , String -> (Game -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con       "both" Game -> Game -> Game
both
  , String -> (Game -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con       "race" Game -> Game -> Game
race
  , String -> ([(EventFilter, Game)] -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con  "multigate" [(EventFilter, Game)] -> Game
multigate
  , String -> (Reward -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con "rewardThen" Reward -> Game -> Game
rewardThen
  , String -> (EventFilter -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con     "gate" EventFilter -> Game -> Game
gate
  ]

------------------------------------------------------------------------------
--                         extensions
------------------------------------------------------------------------------

comeback :: Game -> Game
comeback :: Game -> Game
comeback g :: Game
g = Game -> Game -> Game -> Game
subgame Game
g Game
lose Game
win

bottom :: Game
bottom :: Game
bottom = [(EventFilter, Game)] -> Game
multigate []

gate :: EventFilter -> Game -> Game
gate :: EventFilter -> Game -> Game
gate ef :: EventFilter
ef g :: Game
g = [(EventFilter, Game)] -> Game
multigate [(EventFilter
ef, Game
g)]

sig_games_ext :: Sig
sig_games_ext :: Sig
sig_games_ext = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ String -> (Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con "comeback" Game -> Game
comeback
  , String -> Game -> Sig
forall a. Typeable a => String -> a -> Sig
con   "bottom" Game
bottom
  , String -> (Game -> Game -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con  "andThen" Game -> Game -> Game
andThen
  , String -> (Reward -> Game) -> Sig
forall a. Typeable a => String -> a -> Sig
con   "reward" Reward -> Game
reward
  ]


bingo :: [[Game]] -> Reward -> Game
bingo :: [[Game]] -> Reward -> Game
bingo squares :: [[Game]]
squares r :: Reward
r
  = let subgames :: [[Game]]
subgames = [[Game]]
squares
                [[Game]] -> [[Game]] -> [[Game]]
forall a. [a] -> [a] -> [a]
++ [[Game]] -> [[Game]]
forall a. [[a]] -> [[a]]
transpose [[Game]]
squares  -- ! 1
        allOf :: [Game] -> Game
        allOf :: [Game] -> Game
allOf = (Game -> Game -> Game) -> Game -> [Game] -> Game
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Game -> Game -> Game
both    Game
win
        anyOf :: [Game] -> Game
        anyOf :: [Game] -> Game
anyOf = (Game -> Game -> Game) -> Game -> [Game] -> Game
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Game -> Game -> Game
eitherG Game
lose
     in Game -> Game -> Game -> Game
subgame ([Game] -> Game
anyOf (([Game] -> Game) -> [[Game]] -> [Game]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Game] -> Game
allOf [[Game]]
subgames)) (Reward -> Game
reward Reward
r) Game
lose

------------------------------------------------------------------------------
--                           tests
------------------------------------------------------------------------------

bingo_game :: Game
bingo_game :: Game
bingo_game = ([[Game]] -> Reward -> Game) -> Reward -> [[Game]] -> Game
forall a b c. (a -> b -> c) -> b -> a -> c
flip [[Game]] -> Reward -> Game
bingo (Word8 -> Reward
Reward 100) ([[Game]] -> Game) -> [[Game]] -> Game
forall a b. (a -> b) -> a -> b
$ do
  Word8
x <- [0..2]
  [Game] -> [[Game]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Game] -> [[Game]]) -> [Game] -> [[Game]]
forall a b. (a -> b) -> a -> b
$ do
    Word8
y <- [0..2]
    Game -> [Game]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Game -> [Game]) -> Game -> [Game]
forall a b. (a -> b) -> a -> b
$ EventFilter -> Game -> Game
gate (Word8 -> EventFilter
Exactly (Word8 -> EventFilter) -> Word8 -> EventFilter
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* 10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
y) Game
win


foo :: Property
foo :: Property
foo = (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \g :: Game
g g2 :: Game
g2 -> Game -> Game -> Game
race Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g2 Game
g

------------------------------------------------------------------------------
--                         observations
------------------------------------------------------------------------------

runGame :: [Event] -> Game -> (Set Reward, Maybe Result)
runGame :: [Event] -> Game -> (Set Reward, Maybe Result)
runGame evs :: [Event]
evs g :: Game
g =
  (Maybe Result, Set Reward) -> (Set Reward, Maybe Result)
forall a b. (a, b) -> (b, a)
swap ((Maybe Result, Set Reward) -> (Set Reward, Maybe Result))
-> (Maybe Result, Set Reward) -> (Set Reward, Maybe Result)
forall a b. (a -> b) -> a -> b
$ Writer (Set Reward) (Maybe Result) -> (Maybe Result, Set Reward)
forall w a. Writer w a -> (a, w)
runWriter (Writer (Set Reward) (Maybe Result) -> (Maybe Result, Set Reward))
-> Writer (Set Reward) (Maybe Result) -> (Maybe Result, Set Reward)
forall a b. (a -> b) -> a -> b
$ (Game -> Maybe Result)
-> WriterT (Set Reward) Identity Game
-> Writer (Set Reward) (Maybe Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Game -> Maybe Result
_toResult (WriterT (Set Reward) Identity Game
 -> Writer (Set Reward) (Maybe Result))
-> WriterT (Set Reward) Identity Game
-> Writer (Set Reward) (Maybe Result)
forall a b. (a -> b) -> a -> b
$ Game -> [Event] -> WriterT (Set Reward) Identity Game
_runGame Game
g [Event]
evs

_toResult :: Game -> Maybe Result
_toResult :: Game -> Maybe Result
_toResult Win  = Result -> Maybe Result
forall a. a -> Maybe a
Just Result
Victory
_toResult Lose = Result -> Maybe Result
forall a. a -> Maybe a
Just Result
Defeat
_toResult _    = Maybe Result
forall a. Maybe a
Nothing

_runGame :: Game -> [Event] -> Writer (Set Reward) Game
_runGame :: Game -> [Event] -> WriterT (Set Reward) Identity Game
_runGame g :: Game
g (e :: Event
e : es :: [Event]
es) = do
  Game
g' <- Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g (Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e)
  Game -> [Event] -> WriterT (Set Reward) Identity Game
_runGame Game
g' [Event]
es
_runGame g :: Game
g [] = do
  Game
g' <- Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g Maybe Event
forall a. Maybe a
Nothing
  case Game
g Game -> Game -> Bool
forall a. Eq a => a -> a -> Bool
== Game
g' of  -- ! 1
    True  -> Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
g'
    False -> Game -> [Event] -> WriterT (Set Reward) Identity Game
_runGame Game
g' []

_stepGame :: Game -> Maybe Event -> Writer (Set Reward) Game
_stepGame :: Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Win  _ = Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
win
_stepGame Lose _ = Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
lose

-- # _stepGameRewardThen
_stepGame (RewardThen r :: Reward
r g :: Game
g) e :: Maybe Event
e =
  Set Reward -> WriterT (Set Reward) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Reward -> Set Reward
forall a. a -> Set a
S.singleton Reward
r) WriterT (Set Reward) Identity ()
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity Game
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g Maybe Event
e

_stepGame (Subgame g :: Game
g g1 :: Game
g1 g2 :: Game
g2) e :: Maybe Event
e =  -- ! 1
  Game -> Game -> Game -> Game
subgame (Game -> Game -> Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity (Game -> Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g Maybe Event
e      -- ! 2
          WriterT (Set Reward) Identity (Game -> Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity (Game -> Game)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
g1
          WriterT (Set Reward) Identity (Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
g2
_stepGame (EitherW g1 :: Game
g1 g2 :: Game
g2) e :: Maybe Event
e =
  Game -> Game -> Game
eitherG (Game -> Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g1 Maybe Event
e
          WriterT (Set Reward) Identity (Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g2 Maybe Event
e
_stepGame (Both g1 :: Game
g1 g2 :: Game
g2) e :: Maybe Event
e =
  Game -> Game -> Game
both (Game -> Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g1 Maybe Event
e
       WriterT (Set Reward) Identity (Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g2 Maybe Event
e
_stepGame (Race g1 :: Game
g1 g2 :: Game
g2) e :: Maybe Event
e =
  Game -> Game -> Game
race (Game -> Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity (Game -> Game)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g1 Maybe Event
e
       WriterT (Set Reward) Identity (Game -> Game)
-> WriterT (Set Reward) Identity Game
-> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Game -> Maybe Event -> WriterT (Set Reward) Identity Game
_stepGame Game
g2 Maybe Event
e
_stepGame (Multigate cs :: [(EventFilter, Game)]
cs) (Just e :: Event
e)
  | Just (_, g :: Game
g) <- ((EventFilter, Game) -> Bool)
-> [(EventFilter, Game)] -> Maybe (EventFilter, Game)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ef :: EventFilter
ef, _) -> EventFilter -> Event -> Bool
matches EventFilter
ef Event
e) [(EventFilter, Game)]
cs
  = Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
g
_stepGame x :: Game
x@Multigate{} _ = Game -> WriterT (Set Reward) Identity Game
forall (f :: * -> *) a. Applicative f => a -> f a
pure Game
x


matches :: EventFilter -> Event -> Bool
matches :: EventFilter -> Event -> Bool
matches Never  _ = Bool
False
matches Always _ = Bool
True
matches (Exactly e :: Word8
e) (Event ev :: Word8
ev) = Word8
e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
ev

------------------------------------------------------------------------------
--                         specifications
------------------------------------------------------------------------------

sig_types :: Sig
sig_types :: Sig
sig_types = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ Proxy Event -> Sig
forall (proxy :: * -> *) a.
(Ord a, Arbitrary a, Typeable a) =>
proxy a -> Sig
monoType        (Proxy Event -> Sig) -> Proxy Event -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Event
forall k (t :: k). Proxy t
Proxy @Event
  , Proxy EventFilter -> Sig
forall (proxy :: * -> *) a.
(Ord a, Arbitrary a, Typeable a) =>
proxy a -> Sig
monoType        (Proxy EventFilter -> Sig) -> Proxy EventFilter -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy EventFilter
forall k (t :: k). Proxy t
Proxy @EventFilter
  , Proxy Reward -> Sig
forall (proxy :: * -> *) a.
(Ord a, Arbitrary a, Typeable a) =>
proxy a -> Sig
monoType        (Proxy Reward -> Sig) -> Proxy Reward -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Reward
forall k (t :: k). Proxy t
Proxy @Reward
  , Proxy Result -> Sig
forall (proxy :: * -> *) a.
(Ord a, Arbitrary a, Typeable a) =>
proxy a -> Sig
monoType        (Proxy Result -> Sig) -> Proxy Result -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Result
forall k (t :: k). Proxy t
Proxy @Result
  , Proxy Game -> Sig
forall (proxy :: * -> *) test outcome a.
(Observe test outcome a, Arbitrary test, Ord outcome, Arbitrary a,
 Typeable test, Typeable outcome, Typeable a) =>
proxy a -> Sig
monoTypeObserve (Proxy Game -> Sig) -> Proxy Game -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Game
forall k (t :: k). Proxy t
Proxy @Game
  , [String] -> Proxy Event -> Sig
forall (proxy :: * -> *) a.
Typeable a =>
[String] -> proxy a -> Sig
vars ["e"]      (Proxy Event -> Sig) -> Proxy Event -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Event
forall k (t :: k). Proxy t
Proxy @Event
  , [String] -> Proxy EventFilter -> Sig
forall (proxy :: * -> *) a.
Typeable a =>
[String] -> proxy a -> Sig
vars ["ef"]     (Proxy EventFilter -> Sig) -> Proxy EventFilter -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy EventFilter
forall k (t :: k). Proxy t
Proxy @EventFilter
  , [String] -> Proxy Reward -> Sig
forall (proxy :: * -> *) a.
Typeable a =>
[String] -> proxy a -> Sig
vars ["r"]      (Proxy Reward -> Sig) -> Proxy Reward -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Reward
forall k (t :: k). Proxy t
Proxy @Reward
  , [String] -> Proxy Result -> Sig
forall (proxy :: * -> *) a.
Typeable a =>
[String] -> proxy a -> Sig
vars ["res"]    (Proxy Result -> Sig) -> Proxy Result -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Result
forall k (t :: k). Proxy t
Proxy @Result
  , [String] -> Proxy Game -> Sig
forall (proxy :: * -> *) a.
Typeable a =>
[String] -> proxy a -> Sig
vars ["g"]      (Proxy Game -> Sig) -> Proxy Game -> Sig
forall a b. (a -> b) -> a -> b
$ Proxy Game
forall k (t :: k). Proxy t
Proxy @Game
  ]

sig_options :: Sig
sig_options :: Sig
sig_options = [Sig] -> Sig
forall sig. Signature sig => sig -> Sig
signature
  [ Int -> Sig
withMaxTermSize 5
  ]




quickspec_laws' :: [(String, Property)]
quickspec_laws' :: [(String, Property)]
quickspec_laws' =
  [ ( "comeback bottom = bottom"
    , Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Game -> Game
comeback Game
bottom Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
bottom)
  , ( "win = comeback lose"
    , Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback Game
lose)
  , ( "lose = comeback win"
    , Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback Game
win)
  , ( "both g g2 = both g2 g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
both Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g2 Game
g)
  , ( "both g g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
both Game
g Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "eitherG g g2 = eitherG g2 g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
eitherG Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g2 Game
g)
  , ( "eitherG g g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
eitherG Game
g Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "race g g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
race Game
g Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "andThen g win = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
andThen Game
g Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "andThen bottom g = bottom"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
andThen Game
bottom Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
bottom)
  , ( "andThen lose g = lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
andThen Game
lose Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
lose)
  , ( "andThen win g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
andThen Game
win Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "both g bottom = andThen g bottom"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
both Game
g Game
bottom Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen Game
g Game
bottom)
  , ( "both g win = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
both Game
g Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "eitherG g lose = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
eitherG Game
g Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "race g bottom = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
race Game
g Game
bottom Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "race bottom g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Game
g :: Game) -> Game -> Game -> Game
race Game
bottom Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "race lose g = both g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
race Game
lose Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g Game
lose)
  , ( "race win g = eitherG g win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
race Game
win Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g Game
win)
  , ( "gate ef bottom = bottom"
    , (EventFilter -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Property) -> Property)
-> (EventFilter -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) -> EventFilter -> Game -> Game
gate EventFilter
ef Game
bottom Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
bottom)
  , ( "reward r = rewardThen r win"
    , (Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Reward -> Property) -> Property)
-> (Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Reward
r :: Reward) -> Reward -> Game
reward Reward
r Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Reward -> Game -> Game
rewardThen Reward
r Game
win)
  , ( "comeback (comeback g) = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game
comeback (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "comeback (reward r) = rewardThen r lose"
    , (Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Reward -> Property) -> Property)
-> (Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Reward
r :: Reward) ->
            Game -> Game
comeback (Reward -> Game
reward Reward
r) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Reward -> Game -> Game
rewardThen Reward
r Game
lose)
  , ( "andThen g g2 = subgame g g2 lose"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
g2 Game
lose)
  , ( "subgame bottom g g2 = bottom"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game -> Game
subgame Game
bottom Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
bottom)
  , ( "subgame lose g g2 = g2"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game -> Game
subgame Game
lose Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g2)
  , ( "subgame win g g2 = g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game -> Game
subgame Game
win Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "comeback g = subgame g lose win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game
comeback Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
lose Game
win)
  , ( "subgame g win bottom = eitherG g bottom"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game -> Game
subgame Game
g Game
win Game
bottom Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g Game
bottom)
  , ( "andThen (comeback g) g2 = subgame g lose g2"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen (Game -> Game
comeback Game
g) Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
lose Game
g2)
  , ( "rewardThen r g = andThen (reward r) g"
    , (Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Reward -> Property) -> Property)
-> (Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Reward
r :: Reward) ->
            Reward -> Game -> Game
rewardThen Reward
r Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen (Reward -> Game
reward Reward
r) Game
g)
  , ( "both g (comeback g) = andThen g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
both Game
g (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen Game
g Game
lose)
  , ( "rewardThen r g = both g (reward r)"
    , (Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Reward -> Property) -> Property)
-> (Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Reward
r :: Reward) ->
            Reward -> Game -> Game
rewardThen Reward
r Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Reward -> Game
reward Reward
r))
  , ( "eitherG g (comeback g) = subgame g win win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
eitherG Game
g (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
win Game
win)
  , ( "race g (comeback g) = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
race Game
g (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "race (reward r) g = eitherG g (reward r)"
    , (Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Reward -> Property) -> Property)
-> (Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Reward
r :: Reward) ->
            Game -> Game -> Game
race (Reward -> Game
reward Reward
r) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Reward -> Game
reward Reward
r))
  , ( "gate ef (comeback g) = comeback (gate ef g)"
    , (EventFilter -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) ->
            EventFilter -> Game -> Game
gate EventFilter
ef (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (EventFilter -> Game -> Game
gate EventFilter
ef Game
g))
  , ( "rewardThen r (comeback g) = comeback (rewardThen r g)"
    , (Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Reward -> Property) -> Property)
-> (Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Reward
r :: Reward) ->
            Reward -> Game -> Game
rewardThen Reward
r (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (Reward -> Game -> Game
rewardThen Reward
r Game
g))
  , ( "comeback (andThen g bottom) = subgame g bottom win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game
comeback (Game -> Game -> Game
andThen Game
g Game
bottom) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
bottom Game
win)
  , ( "comeback (andThen g lose) = subgame g win win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game
comeback (Game -> Game -> Game
andThen Game
g Game
lose) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
win Game
win)
  , ( "comeback (both g lose) = eitherG g win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game
comeback (Game -> Game -> Game
both Game
g Game
lose) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g Game
win)
  , ( "comeback (eitherG g bottom) = subgame g lose bottom"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game
comeback (Game -> Game -> Game
eitherG Game
g Game
bottom) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
lose Game
bottom)
  , ( "both lose (comeback g) = both g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
both Game
lose (Game -> Game
comeback Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g Game
lose)
  , ( "both lose (multigate xs) = lose"
    , ([(EventFilter, Game)] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([(EventFilter, Game)] -> Property) -> Property)
-> ([(EventFilter, Game)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ ([(EventFilter, Game)]
xs :: [(EventFilter, Game)]) ->
            Game -> Game -> Game
both Game
lose ([(EventFilter, Game)] -> Game
multigate [(EventFilter, Game)]
xs) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
lose)
  , ( "race (comeback g) lose = comeback (race g win)"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
race (Game -> Game
comeback Game
g) Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (Game -> Game -> Game
race Game
g Game
win))
  , ( "race (multigate xs) lose = lose"
    , ([(EventFilter, Game)] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([(EventFilter, Game)] -> Property) -> Property)
-> ([(EventFilter, Game)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ ([(EventFilter, Game)]
xs :: [(EventFilter, Game)]) ->
            Game -> Game -> Game
race ([(EventFilter, Game)] -> Game
multigate [(EventFilter, Game)]
xs) Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
lose)
  , ( "race (multigate xs) win = win"
    , ([(EventFilter, Game)] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([(EventFilter, Game)] -> Property) -> Property)
-> ([(EventFilter, Game)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ ([(EventFilter, Game)]
xs :: [(EventFilter, Game)]) ->
            Game -> Game -> Game
race ([(EventFilter, Game)] -> Game
multigate [(EventFilter, Game)]
xs) Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
win)
  , ( "andThen (andThen g g2) g3 = andThen g (andThen g2 g3)"
    , (Game -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Game -> Property) -> Property)
-> (Game -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Game
g3 :: Game) ->
            Game -> Game -> Game
andThen (Game -> Game -> Game
andThen Game
g Game
g2) Game
g3 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen Game
g (Game -> Game -> Game
andThen Game
g2 Game
g3))
  , ( "both (both g g2) g3 = both g (both g2 g3)"
    , (Game -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Game -> Property) -> Property)
-> (Game -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Game
g3 :: Game) ->
            Game -> Game -> Game
both (Game -> Game -> Game
both Game
g Game
g2) Game
g3 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
both Game
g2 Game
g3))
  , ( "eitherG g (andThen g g) = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
andThen Game
g Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "eitherG g (both g g2) = both g (eitherG g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
both Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
eitherG Game
g Game
g2))
  , ( "eitherG (eitherG g g2) g3 = eitherG g (eitherG g2 g3)"
    , (Game -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Game -> Property) -> Property)
-> (Game -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Game
g3 :: Game) ->
            Game -> Game -> Game
eitherG (Game -> Game -> Game
eitherG Game
g Game
g2) Game
g3 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
eitherG Game
g2 Game
g3))
  , ( "eitherG g (rewardThen r g2) = eitherG g2 (rewardThen r g)"
    , (Game -> Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Reward -> Property) -> Property)
-> (Game -> Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Reward
r :: Reward) ->
            Game -> Game -> Game
eitherG Game
g (Reward -> Game -> Game
rewardThen Reward
r Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g2 (Reward -> Game -> Game
rewardThen Reward
r Game
g))
  , ( "race g (andThen g g2) = eitherG g (andThen g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
andThen Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
andThen Game
g Game
g2))
  , ( "race g (both g g2) = both g (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
both Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race g (eitherG g g2) = eitherG g (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
eitherG Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race g (race g g2) = race g g2"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
race Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g Game
g2)
  , ( "race g (race g2 g) = race g g2"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
race Game
g2 Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g Game
g2)
  , ( "race g (rewardThen r g) = rewardThen r g"
    , (Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Reward -> Property) -> Property)
-> (Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Reward
r :: Reward) ->
            Game -> Game -> Game
race Game
g (Reward -> Game -> Game
rewardThen Reward
r Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Reward -> Game -> Game
rewardThen Reward
r Game
g)
  , ( "race (both g g2) g = both g (race g2 g)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
both Game
g Game
g2) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
race Game
g2 Game
g))
  , ( "race (eitherG g g2) g = eitherG g (race g2 g)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
eitherG Game
g Game
g2) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
race Game
g2 Game
g))
  , ( "race (race g g2) g3 = race g (race g2 g3)"
    , (Game -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Game -> Property) -> Property)
-> (Game -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Game
g3 :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
race Game
g Game
g2) Game
g3 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g (Game -> Game -> Game
race Game
g2 Game
g3))
  , ( "race (rewardThen r g) g2 = race g (rewardThen r g2)"
    , (Game -> Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Reward -> Property) -> Property)
-> (Game -> Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Reward
r :: Reward) ->
            Game -> Game -> Game
race (Reward -> Game -> Game
rewardThen Reward
r Game
g) Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g (Reward -> Game -> Game
rewardThen Reward
r Game
g2))
  , ( "gate ef (andThen g g2) = andThen (gate ef g) g2"
    , (EventFilter -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) (Game
g2 :: Game) ->
            EventFilter -> Game -> Game
gate EventFilter
ef (Game -> Game -> Game
andThen Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen (EventFilter -> Game -> Game
gate EventFilter
ef Game
g) Game
g2)
  , ( "subgame (comeback g) g2 g3 = subgame g g3 g2"
    , (Game -> Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Game -> Property) -> Property)
-> (Game -> Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Game
g3 :: Game) ->
            Game -> Game -> Game -> Game
subgame (Game -> Game
comeback Game
g) Game
g2 Game
g3 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
g3 Game
g2)
  , ( "subgame (reward r) g g2 = rewardThen r g"
    , (Game -> Game -> Reward -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Reward -> Property) -> Property)
-> (Game -> Game -> Reward -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) (Reward
r :: Reward) ->
            Game -> Game -> Game -> Game
subgame (Reward -> Game
reward Reward
r) Game
g Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Reward -> Game -> Game
rewardThen Reward
r Game
g)
  , ( "comeback (subgame g g2 win) = andThen g (comeback g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game
comeback (Game -> Game -> Game -> Game
subgame Game
g Game
g2 Game
win) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen Game
g (Game -> Game
comeback Game
g2))
  , ( "andThen g (both g lose) = andThen g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
andThen Game
g (Game -> Game -> Game
both Game
g Game
lose) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen Game
g Game
lose)
  , ( "andThen g (eitherG g2 win) = eitherG g (andThen g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen Game
g (Game -> Game -> Game
eitherG Game
g2 Game
win) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
andThen Game
g Game
g2))
  , ( "andThen g (race g2 win) = race (andThen g g2) g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen Game
g (Game -> Game -> Game
race Game
g2 Game
win) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race (Game -> Game -> Game
andThen Game
g Game
g2) Game
g)
  , ( "andThen (eitherG g bottom) g2 = subgame g g2 bottom"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen (Game -> Game -> Game
eitherG Game
g Game
bottom) Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
g2 Game
bottom)
  , ( "andThen (eitherG g win) g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
andThen (Game -> Game -> Game
eitherG Game
g Game
win) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "andThen (race g g2) lose = andThen (race g2 g) lose"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
andThen (Game -> Game -> Game
race Game
g Game
g2) Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen (Game -> Game -> Game
race Game
g2 Game
g) Game
lose)
  , ( "andThen (race g lose) g = race g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
andThen (Game -> Game -> Game
race Game
g Game
lose) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g Game
lose)
  , ( "andThen (race g win) g = g"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) -> Game -> Game -> Game
andThen (Game -> Game -> Game
race Game
g Game
win) Game
g Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
g)
  , ( "both g (eitherG g2 win) = andThen (eitherG g2 win) g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
both Game
g (Game -> Game -> Game
eitherG Game
g2 Game
win) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen (Game -> Game -> Game
eitherG Game
g2 Game
win) Game
g)
  , ( "both lose (eitherG g g2) = both g (both g2 lose)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
both Game
lose (Game -> Game -> Game
eitherG Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
both Game
g2 Game
lose))
  , ( "both lose (race g g2) = both g (both g2 lose)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
both Game
lose (Game -> Game -> Game
race Game
g Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
both Game
g2 Game
lose))
  , ( "both lose (gate ef g) = lose"
    , (EventFilter -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) ->
            Game -> Game -> Game
both Game
lose (EventFilter -> Game -> Game
gate EventFilter
ef Game
g) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
lose)
  , ( "both (comeback g) (comeback g2) = comeback (eitherG g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
both (Game -> Game
comeback Game
g) (Game -> Game
comeback Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (Game -> Game -> Game
eitherG Game
g Game
g2))
  , ( "eitherG g (both g2 lose) = andThen (eitherG g2 win) g"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
both Game
g2 Game
lose) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
andThen (Game -> Game -> Game
eitherG Game
g2 Game
win) Game
g)
  , ( "race g (andThen g2 bottom) = both g (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
andThen Game
g2 Game
bottom) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race g (eitherG g2 bottom) = eitherG g (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race Game
g (Game -> Game -> Game
eitherG Game
g2 Game
bottom) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race (comeback g) (comeback g2) = comeback (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race (Game -> Game
comeback Game
g) (Game -> Game
comeback Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race (andThen g g) lose = race g lose"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
andThen Game
g Game
g) Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g Game
lose)
  , ( "race (andThen g g) win = race g win"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
andThen Game
g Game
g) Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
race Game
g Game
win)
  , ( "race (andThen g bottom) g2 = both g2 (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
andThen Game
g Game
bottom) Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
both Game
g2 (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race (eitherG g bottom) g2 = eitherG g2 (race g g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game
race (Game -> Game -> Game
eitherG Game
g Game
bottom) Game
g2 Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
g2 (Game -> Game -> Game
race Game
g Game
g2))
  , ( "race (gate ef g) lose = lose"
    , (EventFilter -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) ->
            Game -> Game -> Game
race (EventFilter -> Game -> Game
gate EventFilter
ef Game
g) Game
lose Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
lose)
  , ( "race (gate ef g) win = win"
    , (EventFilter -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) ->
            Game -> Game -> Game
race (EventFilter -> Game -> Game
gate EventFilter
ef Game
g) Game
win Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game
win)
  , ( "gate ef (eitherG g bottom) = eitherG bottom (gate ef g)"
    , (EventFilter -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((EventFilter -> Game -> Property) -> Property)
-> (EventFilter -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (EventFilter
ef :: EventFilter) (Game
g :: Game) ->
            EventFilter -> Game -> Game
gate EventFilter
ef (Game -> Game -> Game
eitherG Game
g Game
bottom) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game
eitherG Game
bottom (EventFilter -> Game -> Game
gate EventFilter
ef Game
g))
  , ( "subgame g bottom (comeback g2) = comeback (subgame g bottom g2)"
    , (Game -> Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Game -> Property) -> Property)
-> (Game -> Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) (Game
g2 :: Game) ->
            Game -> Game -> Game -> Game
subgame Game
g Game
bottom (Game -> Game
comeback Game
g2) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game
comeback (Game -> Game -> Game -> Game
subgame Game
g Game
bottom Game
g2))
  , ( "eitherG bottom (andThen g lose) = subgame g bottom bottom"
    , (Game -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Game -> Property) -> Property) -> (Game -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
        \ (Game
g :: Game) ->
            Game -> Game -> Game
eitherG Game
bottom (Game -> Game -> Game
andThen Game
g Game
lose) Game -> Game -> Property
forall test outcome a.
(Show test, Show outcome, Observe test outcome a) =>
a -> a -> Property
=~= Game -> Game -> Game -> Game
subgame Game
g Game
bottom Game
bottom)
  ]