algebra-driven-design-0.1.0.1: Companion library for the book Algebra-Driven Design by Sandy Maguire
Safe HaskellNone
LanguageHaskell2010

ADD.Games.Correct

Documentation

data Event Source #

Constructors

Event Word8 

Instances

Instances details
Eq Event Source # 
Instance details

Defined in ADD.Games.Correct

Methods

(==) :: Event -> Event -> Bool #

(/=) :: Event -> Event -> Bool #

Data Event Source # 
Instance details

Defined in ADD.Games.Correct

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Event -> c Event #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Event #

toConstr :: Event -> Constr #

dataTypeOf :: Event -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Event) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event) #

gmapT :: (forall b. Data b => b -> b) -> Event -> Event #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r #

gmapQ :: (forall d. Data d => d -> u) -> Event -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Event -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Event -> m Event #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Event -> m Event #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Event -> m Event #

Ord Event Source # 
Instance details

Defined in ADD.Games.Correct

Methods

compare :: Event -> Event -> Ordering #

(<) :: Event -> Event -> Bool #

(<=) :: Event -> Event -> Bool #

(>) :: Event -> Event -> Bool #

(>=) :: Event -> Event -> Bool #

max :: Event -> Event -> Event #

min :: Event -> Event -> Event #

Show Event Source # 
Instance details

Defined in ADD.Games.Correct

Methods

showsPrec :: Int -> Event -> ShowS #

show :: Event -> String #

showList :: [Event] -> ShowS #

Generic Event Source # 
Instance details

Defined in ADD.Games.Correct

Associated Types

type Rep Event :: Type -> Type #

Methods

from :: Event -> Rep Event x #

to :: Rep Event x -> Event #

Arbitrary Event Source # 
Instance details

Defined in ADD.Games.Correct

Methods

arbitrary :: Gen Event #

shrink :: Event -> [Event] #

Observe [Event] (Set Reward, Maybe Result) Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

observe :: [Event] -> Game -> (Set Reward, Maybe Result) #

type Rep Event Source # 
Instance details

Defined in ADD.Games.Correct

type Rep Event = D1 ('MetaData "Event" "ADD.Games.Correct" "algebra-driven-design-0.1.0.1-Yk9mMOYOK2LEHtxEveIkr" 'False) (C1 ('MetaCons "Event" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word8)))

data EventFilter Source #

Constructors

Always 
Never 
Exactly Word8 

Instances

Instances details
Eq EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

Data EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> EventFilter -> c EventFilter #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c EventFilter #

toConstr :: EventFilter -> Constr #

dataTypeOf :: EventFilter -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c EventFilter) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EventFilter) #

gmapT :: (forall b. Data b => b -> b) -> EventFilter -> EventFilter #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EventFilter -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EventFilter -> r #

gmapQ :: (forall d. Data d => d -> u) -> EventFilter -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> EventFilter -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> EventFilter -> m EventFilter #

Ord EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

Show EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

Generic EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

Associated Types

type Rep EventFilter :: Type -> Type #

Arbitrary EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

type Rep EventFilter Source # 
Instance details

Defined in ADD.Games.Correct

type Rep EventFilter = D1 ('MetaData "EventFilter" "ADD.Games.Correct" "algebra-driven-design-0.1.0.1-Yk9mMOYOK2LEHtxEveIkr" 'False) (C1 ('MetaCons "Always" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Never" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Exactly" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word8))))

data Reward Source #

Constructors

Reward Word8 

Instances

Instances details
Eq Reward Source # 
Instance details

Defined in ADD.Games.Correct

Methods

(==) :: Reward -> Reward -> Bool #

(/=) :: Reward -> Reward -> Bool #

Data Reward Source # 
Instance details

Defined in ADD.Games.Correct

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Reward -> c Reward #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Reward #

toConstr :: Reward -> Constr #

dataTypeOf :: Reward -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Reward) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Reward) #

gmapT :: (forall b. Data b => b -> b) -> Reward -> Reward #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reward -> r #

gmapQ :: (forall d. Data d => d -> u) -> Reward -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Reward -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Reward -> m Reward #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Reward -> m Reward #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Reward -> m Reward #

Ord Reward Source # 
Instance details

Defined in ADD.Games.Correct

Show Reward Source # 
Instance details

Defined in ADD.Games.Correct

Generic Reward Source # 
Instance details

Defined in ADD.Games.Correct

Associated Types

type Rep Reward :: Type -> Type #

Methods

from :: Reward -> Rep Reward x #

to :: Rep Reward x -> Reward #

Arbitrary Reward Source # 
Instance details

Defined in ADD.Games.Correct

Observe [Event] (Set Reward, Maybe Result) Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

observe :: [Event] -> Game -> (Set Reward, Maybe Result) #

type Rep Reward Source # 
Instance details

Defined in ADD.Games.Correct

type Rep Reward = D1 ('MetaData "Reward" "ADD.Games.Correct" "algebra-driven-design-0.1.0.1-Yk9mMOYOK2LEHtxEveIkr" 'False) (C1 ('MetaCons "Reward" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word8)))

data Result Source #

Constructors

Victory 
Defeat 

Instances

Instances details
Eq Result Source # 
Instance details

Defined in ADD.Games.Correct

Methods

(==) :: Result -> Result -> Bool #

(/=) :: Result -> Result -> Bool #

Data Result Source # 
Instance details

Defined in ADD.Games.Correct

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Result -> c Result #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Result #

toConstr :: Result -> Constr #

dataTypeOf :: Result -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Result) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Result) #

gmapT :: (forall b. Data b => b -> b) -> Result -> Result #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Result -> r #

gmapQ :: (forall d. Data d => d -> u) -> Result -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Result -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Result -> m Result #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Result -> m Result #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Result -> m Result #

Ord Result Source # 
Instance details

Defined in ADD.Games.Correct

Show Result Source # 
Instance details

Defined in ADD.Games.Correct

Generic Result Source # 
Instance details

Defined in ADD.Games.Correct

Associated Types

type Rep Result :: Type -> Type #

Methods

from :: Result -> Rep Result x #

to :: Rep Result x -> Result #

Arbitrary Result Source # 
Instance details

Defined in ADD.Games.Correct

Observe [Event] (Set Reward, Maybe Result) Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

observe :: [Event] -> Game -> (Set Reward, Maybe Result) #

type Rep Result Source # 
Instance details

Defined in ADD.Games.Correct

type Rep Result = D1 ('MetaData "Result" "ADD.Games.Correct" "algebra-driven-design-0.1.0.1-Yk9mMOYOK2LEHtxEveIkr" 'False) (C1 ('MetaCons "Victory" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Defeat" 'PrefixI 'False) (U1 :: Type -> Type))

data Game Source #

Instances

Instances details
Eq Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

(==) :: Game -> Game -> Bool #

(/=) :: Game -> Game -> Bool #

Data Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Game -> c Game #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Game #

toConstr :: Game -> Constr #

dataTypeOf :: Game -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Game) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Game) #

gmapT :: (forall b. Data b => b -> b) -> Game -> Game #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Game -> r #

gmapQ :: (forall d. Data d => d -> u) -> Game -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Game -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Game -> m Game #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Game -> m Game #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Game -> m Game #

Ord Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

compare :: Game -> Game -> Ordering #

(<) :: Game -> Game -> Bool #

(<=) :: Game -> Game -> Bool #

(>) :: Game -> Game -> Bool #

(>=) :: Game -> Game -> Bool #

max :: Game -> Game -> Game #

min :: Game -> Game -> Game #

Show Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

showsPrec :: Int -> Game -> ShowS #

show :: Game -> String #

showList :: [Game] -> ShowS #

Generic Game Source # 
Instance details

Defined in ADD.Games.Correct

Associated Types

type Rep Game :: Type -> Type #

Methods

from :: Game -> Rep Game x #

to :: Rep Game x -> Game #

Arbitrary Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

arbitrary :: Gen Game #

shrink :: Game -> [Game] #

Observe [Event] (Set Reward, Maybe Result) Game Source # 
Instance details

Defined in ADD.Games.Correct

Methods

observe :: [Event] -> Game -> (Set Reward, Maybe Result) #

type Rep Game Source # 
Instance details

Defined in ADD.Games.Correct

type Rep Game = D1 ('MetaData "Game" "ADD.Games.Correct" "algebra-driven-design-0.1.0.1-Yk9mMOYOK2LEHtxEveIkr" 'False) (((C1 ('MetaCons "Win" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Lose" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "RewardThen" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Reward) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game)) :+: C1 ('MetaCons "Subgame" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game))))) :+: ((C1 ('MetaCons "EitherW" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game)) :+: C1 ('MetaCons "Both" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game))) :+: (C1 ('MetaCons "Race" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Game)) :+: C1 ('MetaCons "Multigate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(EventFilter, Game)])))))

bingo :: [[Game]] -> Reward -> Game Source #