Kata: C** de chouette - sequence
In the previous log, we have continued a coding kata based on a dices game called Cul de chouette.
At this point, we can get the score of a throw and deal with multi-players, we also have various score calculation modes in standalone functions, but no single entry point.
There are two ways to practice Test-Driven Development: Inside Out and Outside In.
We have used Inside Out so far as it makes starting smoother, at the cost of proper problem break down.
Since we need to create a single entry point, we have to create a function which is able to process the sequence of actions and gives the score of each player.
Usually, when a system has to represent a time-related real-life system, it relies on event sourcing.
The main issue is that, usually, we implement event sourcing based on commands, the intent, and events, what actually happened.
In this kind of game, there is no hard boundary, players act and the consequences are derived from the context, we will focus only on events to be closer to the reality.
To have the simplest possible start, we will focus on have just enough events to fill the regular score, it will take the Players, Events and produce the scores as follows:
We can design Event to match each single action a player can do as follows:
data Event
= PlayerChanged
| DiceThrown Dice
| ActionsDone Player Actions
Game is more involved as it should represent the mode, players' score and round, we can start with the following naive design:
type PlayerActions = (Player, Actions)
data Game = Game
{ rounds :: Stream Player,
}
data Scored = Scored
{ points :: Points,
}
data Mode
= RegularStart [PlayerActions]
| RegularOne [PlayerActions] Dice
| RegularTwo [PlayerActions] Dice Dice
| RegularThree [PlayerActions] Dice Dice Dice
We can notice Stream, which represents the cycling rounds, it is handy as it avoid both having a dedicate value for the current play, we simply use the head, and having to deal bounds.
It is defined as follows:
data Stream a = a :< Stream a
streamCycle = foldr (:<) (error "Stream has not end") . cycle1
streamHead (x :< _) = x
streamTail (_ :< xs) = xs
We can continue with the definition of some helpers for Game, as follows:
initialState players =
Game
{ rounds = streamCycle players,
scores = Map.fromSet (const emptyScore) (Set.fromList $ NonEmpty.toList players),
mode = RegularStart []
}
where
emptyScore =
Scored
{ points = 0,
civets = 0,
isGrelottineImmune = False,
hasGrelottine = False
}
updateGameScores game scores =
game
{ scores = foldr (\(p, s) -> Map.adjust (updateScored s) p) game.scores scores
}
nextRound game =
game
{ rounds = streamTail game.rounds,
mode = RegularStart []
}
The following one on Scored to simplify the transition with Scorer:
updateScored u s =
case u of
ScorePoints p -> s {points = s.points + p}
ScoreGrelottine -> s {hasGrelottine = True}
Civet -> s {civets = s.civets + 1}
Then, the biggest part consist of matching every mode to every event, long and tedious, but not complicated, as follows:
game players = Map.map (.points) . (.scores) . foldl applyEvent (initialState players)
where
applyEvent game =
case game.mode of
RegularStart actions ->
\case
PlayerChanged -> game
DiceThrown d0 -> game {mode = RegularOne actions d0}
ActionsDone player actions' -> game {mode = RegularStart ((player, actions') : actions)}
RegularOne actions d0 ->
\case
PlayerChanged -> game
DiceThrown d1 -> game {mode = RegularTwo actions d0 d1}
ActionsDone player actions' -> game {mode = RegularOne ((player, actions') : actions) d0}
RegularTwo actions d0 d1 ->
\case
PlayerChanged -> game
DiceThrown d2 -> game {mode = RegularThree actions d0 d1 d2}
ActionsDone player actions' -> game {mode = RegularTwo ((player, actions') : actions) d0 d1}
RegularThree actions d0 d1 d2 ->
\case
PlayerChanged -> nextRound $ updateGameScores game $ score currentPlayer d0 d1 d2 actions
DiceThrown _ -> game
ActionsDone player actions' -> game {mode = RegularThree ((player, actions') : actions) d0 d1 d2}
where
currentPlayer = streamHead game.rounds
bevue = ScorePoints (-10)
This code is very redundant, but the idea is to move constructor to constructor, eventually cumulating actions, as dices are thrown.
Once done, we wait for PlayerChanged to update the score.
Finally, we can come up with a really high-level test, making sure the function is called correctly as follows:
describe "Game (event-based)" $ do
it "Chouette" $
game
("Perceval" :| ["Karadoc"])
[DiceThrown D6, DiceThrown D5, DiceThrown D6, ActionsDone "Karadoc" JapprecieLesFruitsAuSirop, PlayerChanged]
`shouldBe` Map.fromList [("Perceval", 36), ("Karadoc", (-10))]
The next step is to handle Sirotage, we should add two Modes and two Events to handle bets, as follows:
data Mode
= RegularStart [PlayerActions]
| RegularOne [PlayerActions] Dice
| RegularTwo [PlayerActions] Dice Dice
| RegularThree [PlayerActions] Dice Dice Dice
| SirotagePending [PlayerActions] [(Player, Dice)] Dice
| SirotageThrown [PlayerActions] [(Player, Dice)] Dice RethrownDice
data Event
= PlayerChanged
| DiceThrown Dice
| ActionsDone Player Actions
| SirotageStarted
| SirotageBet Player Dice
Then, we should fill the incomplete pattern matching, as follows:
game players = -- ...
where
applyEvent game =
case game.mode of
RegularStart actions ->
\case
-- ...
SirotageStarted -> game
SirotageBet _ _ -> game
RegularOne actions d0 ->
\case
PlayerChanged -> game
DiceThrown d1 -> game {mode = RegularTwo actions d0 d1}
ActionsDone player actions' -> game {mode = RegularOne ((player, actions') : actions) d0}
SirotageStarted -> game
SirotageBet _ _ -> game
RegularTwo actions d0 d1 ->
\case
-- ...
SirotageStarted -> game
SirotageBet _ _ -> game
RegularThree actions d0 d1 d2 ->
\case
-- ...
SirotageStarted
| d0 == d1 || d0 == d2 -> game {mode = SirotagePending actions [] d0}
| d1 == d2 -> game {mode = SirotagePending actions [] d1}
| otherwise -> game
SirotageBet _ _ -> game
SirotagePending actions bets d0 ->
\case
u -- ...
SirotageStarted -> game
SirotageBet player bet -> game {mode = SirotagePending actions ((player, bet) : bets) d0}
SirotageThrown actions bets d0 d3 ->
\case
PlayerChanged -> nextRound $ updateGameScores game $ sirot currentPlayer d0 d3 bets actions
DiceThrown _ -> game
ActionsDone player actions' -> game {mode = SirotageThrown ((player, actions') : actions) bets d0 d3}
SirotageStarted -> game
SirotageBet player bet -> game
where
-- ...
Note that previous modes would skip new events.
Sirotage is a variation of Regular, except it is done only on two constructors.
Finally, we can add the following test:
it "Sirotage" $
game
("Perceval" :| ["Karadoc"])
[DiceThrown D6, DiceThrown D5, DiceThrown D6, SirotageStarted, SirotageBet "Karadoc" D2, DiceThrown D2, ActionsDone "Karadoc" JapprecieLesFruitsAuSirop, PlayerChanged]
`shouldBe` Map.fromList [("Perceval", (-36)), ("Karadoc", 35)]
Next step is Grelottine which is a challenge working like the regular scoring, we can factor the throws as follows:
data ThrownDices
= ThrownDicesStart
| ThrownDicesOne Dice
| ThrownDicesTwo Dice Dice
| ThrownDicesThree Dice Dice Dice
addThrownDice dx =
\case
ThrownDicesStart -> ThrownDicesOne dx
ThrownDicesOne d0 -> ThrownDicesTwo d0 dx
ThrownDicesTwo d0 d1 -> ThrownDicesThree d0 d1 dx
ThrownDicesThree d0 d1 d2 -> ThrownDicesThree d0 d1 d2
Then, we can factor Mode constructors as follows:
data Mode
= Regular [PlayerActions] ThrownDices
| SirotagePending [PlayerActions] [(Player, Dice)] Dice
| SirotageThrown [PlayerActions] [(Player, Dice)] Dice RethrownDice
It is better as there is no impact on the dice throwing, we have to refactor slightly game as follows:
game players = Map.map (.points) . (.scores) . foldl applyEvent (initialState players)
where
applyEvent game =
case game.mode of
Regular actions (ThrownDicesThree d0 d1 d2) ->
\case
PlayerChanged ->
nextRound $ updateGameScores game $ score currentPlayer d0 d1 d2 actions
ActionsDone player actions' ->
game {mode = Regular ((player, actions') : actions) (ThrownDicesThree d0 d1 d2)}
SirotageStarted
| d0 == d1 || d0 == d2 -> game {mode = SirotagePending actions [] d0}
| d1 == d2 -> game {mode = SirotagePending actions [] d1}
| otherwise -> game
_ -> game
Regular actions thrown ->
\case
DiceThrown dx -> game {mode = Regular actions $ addThrownDice dx thrown}
ActionsDone player actions' -> game {mode = Regular ((player, actions') : actions) thrown}
_ -> game
We have Regular it two, a first one, when all dices are thrown, responsible on either the end of the round, or other modes.
And another one to accumulate throws.
Then, adding the Event/Mode is trivial, as follow:
data Mode
= Regular [PlayerActions] ThrownDices
| SirotagePending [PlayerActions] [(Player, Dice)] Dice
| SirotageThrown [PlayerActions] [(Player, Dice)] Dice RethrownDice
| GrelottineChallenge [PlayerActions] ChallengerPlayer Combination Points ThrownDices
data Event
= PlayerChanged
| DiceThrown Dice
| ActionsDone Player Actions
| SirotageStarted
| SirotageBet Player Dice
| GrelottineChallenged Player Combination Points
At this point, GHC should at least emit a warning, let's fix that, as follows:
game players = -- ...
where
applyEvent game =
case game.mode of
-- ...
Regular actions (ThrownDicesThree d0 d1 d2) ->
\case
-- ...
GrelottineChallenged challenger expectedCombination bet
| combination d0 d1 d2 == Néant ->
game {mode = GrelottineChallenge [] (ChallengerPlayer challenger) expectedCombination bet ThrownDicesStart}
_ -> game
GrelottineChallenge actions challenger expectedCombination bet (ThrownDicesThree d0 d1 d2) ->
\case
PlayerChanged ->
nextRound $ updateGameScores game $ grelottine (ChallengedPlayer currentPlayer) challenger expectedCombination bet d0 d1 d2 actions
ActionsDone player actions' -> game {mode = GrelottineChallenge ((player, actions') : actions) challenger expectedCombination bet (ThrownDicesThree d0 d1 d2)}
_ -> game
GrelottineChallenge actions challenger expectedCombination bet thrown ->
\case
DiceThrown dx -> game {mode = GrelottineChallenge actions challenger expectedCombination bet $ addThrownDice dx thrown}
ActionsDone player actions' -> game {mode = GrelottineChallenge ((player, actions') : actions) challenger expectedCombination bet thrown}
_ -> game
Similarly, we have two cases for Grelottine, one for the end of the round, calling grelottine when the player change, another to accumulate dices.
We can conclude the implementation of this rule with the following test:
it "Grelottine" $
game
("Perceval" :| ["Karadoc"])
[DiceThrown D6, DiceThrown D1, DiceThrown D3, GrelottineChallenged "Karadoc" (CulDeChouette D3) 1, DiceThrown D3, DiceThrown D3, DiceThrown D3, PlayerChanged]
`shouldBe` Map.fromList [("Perceval", 1), ("Karadoc", (-1))]
The last mode we have implemented is the Soufflette, once again, we start by adding the constructors as follows:
data Mode
= Regular [PlayerActions] ThrownDices
| SirotagePending [PlayerActions] [(Player, Dice)] Dice
| SirotageThrown [PlayerActions] [(Player, Dice)] Dice RethrownDice
| GrelottineChallenge [PlayerActions] ChallengerPlayer Combination Points ThrownDices
| SouffletteChallenge [PlayerActions] ChallengedPlayer [(Dice, Dice, Dice)] ThrownDices
data Event
= PlayerChanged
| DiceThrown Dice
| ActionsDone Player Actions
| SirotageStarted
| SirotageBet Player Dice
| GrelottineChallenged Player Combination Points
| SouffletteChallenged Player
We can then fill the pattern matching as follows:
game players = -- ...
where
applyEvent game =
case game.mode of
-- ...
SouffletteChallenge actions challenged throws thrown ->
\case
DiceThrown dx ->
let (throws', thrown') =
case addThrownDice dx thrown of
ThrownDicesThree d0 d1 d2 -> ((d0, d1, d2) : throws, ThrownDicesStart)
ts -> (throws, ts)
in game {mode = SouffletteChallenge actions challenged throws' thrown'}
PlayerChanged ->
nextRound $ updateGameScores game $ soufflette challenged (ChallengerPlayer currentPlayer) (reverse throws) actions
ActionsDone player actions' -> game {mode = SouffletteChallenge ((player, actions') : actions) challenged throws thrown}
_ -> game
where
currentPlayer = streamHead game.rounds
bevue = ScorePoints (-10)
This time, we have only one case, it's by pure laziness, not the runtime, the write time.
Ideally, we should stop after 9 throws, or on 4-2-1, but it would duplicate the logic.
Let's add the following final test:
it "Soufflette" $
game
("Perceval" :| ["Karadoc"])
[SouffletteChallenged "Karadoc", DiceThrown D6, DiceThrown D1, DiceThrown D3, DiceThrown D4, DiceThrown D2, DiceThrown D1, PlayerChanged]
`shouldBe` Map.fromList [("Perceval", (-30)), ("Karadoc", 40)]