Kata: C** de chouette - refactoring and last rules

In the previous log, we have continued a coding kata based on a dices game called Cul de chouette.

Let's have a new look at our game design:

data Game = Game
  { rounds :: Stream Player,
    scores :: Map.Map Player Scored,
    mode :: Mode
  }

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

There is a big drawback: [PlayerActions] is spread on each odes which creates a lot of implementation complexity.

We can start refactoring actions, moving them from Mode to Game as follows:

data Game = Game
  { rounds :: Stream Player,
    scores :: Map.Map Player Scored,
    mode :: Mode,
    actions :: [PlayerActions]
  }

data Mode
  = Regular ThrownDices
  | SirotagePending [(Player, Dice)] Dice
  | SirotageThrown [(Player, Dice)] Dice RethrownDice
  | GrelottineChallenge ChallengerPlayer Combination Points ThrownDices
  | SouffletteChallenge ChallengedPlayer [(Dice, Dice, Dice)] ThrownDices

appendActions :: Game -> Player -> Actions -> Game
appendActions game player actions =
  game
    { actions = (player, actions) : game.actions
    }

Doing so greatly simplify the implementation, see the following examples:

game :: NonEmpty Player -> [Event] -> Map.Map Player Points
game players = -- ...
  where
    applyEvent game =
      case game.mode of
        Regular (ThrownDicesThree d0 d1 d2) ->
          \case
            ActionsDone player actions ->
              appendActions' player actions
            -- ...
        SirotagePending bets d0 ->
          \case
            ActionsDone player actions ->
              appendActions' player actions
            -- ...
        -- ...
      where
        appendActions' = appendActions game
        -- ...

No more error-prone specific implementation.

The next step is to accumulate scores for bévues, lost points when performing an action which should not be performed, we can rewrite our catch-all clauses as follows:

-- it "Bévue (current player)" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [DiceThrown D6, DiceThrown D6, DiceThrown D6, DiceThrown D6]
--     `shouldBe` Map.fromList [("Perceval", (-10)), ("Karadoc", 0)]
-- it "Bévue (other player)" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [DiceThrown D6, SirotageBet "Karadoc" D2]
--     `shouldBe` Map.fromList [("Perceval", 0), ("Karadoc", (-10))]
game :: NonEmpty Player -> [Event] -> Map.Map Player Points
game players = -- ...
  where
    applyEvent game =
      case game.mode of
        Regular (ThrownDicesThree d0 d1 d2) ->
          \case
            -- ...
            event -> bevue event
        SirotagePending bets d0 ->
          \case
            -- ...
            event -> bevue event
        -- ...
      where
        bevue =
          \case
            PlayerChanged -> bevueOf currentPlayer
            DiceThrown _ -> bevueOf currentPlayer
            ActionsDone player _ -> bevueOf player
            SirotageStarted -> bevueOf currentPlayer
            SirotageBet player __ -> bevueOf player
            GrelottineChallenged player _ _ -> bevueOf player
            SouffletteChallenged player -> bevueOf player
        bevueOf player = updateGameScores game [(player, ScorePoints (-10))]
        -- ...

We have now reduced the cost of the next changes.

Speaking of which, we have boucliette (small shield), which you get at the beginning of the game, and you can use to dodge a challenge.

We can start by adding the information in Scored and initialize it as follows:

data Scored = Scored
  { points :: Points,
    civets :: Int,
    isGrelottineImmune :: Bool,
    hasGrelottine :: Bool,
    hasBoucliette :: Bool
  }

initialState :: NonEmpty Player -> Game
initialState players =
  Game
    { rounds = streamCycle players,
      scores = Map.fromSet (const emptyScore) (Set.fromList $ NonEmpty.toList players),
      mode = Regular ThrownDicesStart,
      actions = []
    }
  where
    emptyScore =
      Scored
        { points = 0,
          civets = 0,
          isGrelottineImmune = False,
          hasGrelottine = False,
          hasBoucliette = True
        }

consumeBoucliette :: Game -> Player -> Maybe Game
consumeBoucliette game player =
  (\s -> game {scores = s}) <$> Map.alterF (>>= fmap Just . consume) player game.scores
  where
    consume s =
      if s.hasBoucliette
        then Just s {hasBoucliette = False}
        else Nothing

When used, boucliette cancel the challenge, reverting to the previous mode, which has to be stored, as follows:

data Mode
  = Regular ThrownDices
  | SirotagePending [(Player, Dice)] Dice
  | SirotageThrown [(Player, Dice)] Dice RethrownDice
  | GrelottineChallenge Mode ChallengerPlayer Combination Points ThrownDices
  | SouffletteChallenge Mode ChallengedPlayer [(Dice, Dice, Dice)] ThrownDices

We also have to add an event as follows:

data Event
  = PlayerChanged
  | DiceThrown Dice
  | ActionsDone Player Actions
  | SirotageStarted
  | SirotageBet Player Dice
  | GrelottineChallenged Player Combination Points
  | SouffletteChallenged Player
  | BouclietteUsed

Finally, we have to process the event as shown below:

-- it "Boucliette (grelottine)" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [DiceThrown D6, DiceThrown D1, DiceThrown D3, GrelottineChallenged "Karadoc" (CulDeChouette D3) 1, BouclietteUsed, PlayerChanged]
--     `shouldBe` Map.fromList [("Perceval", 0), ("Karadoc", 0)]
-- it "Boucliette (grelottine)" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [SouffletteChallenged "Karadoc", BouclietteUsed, DiceThrown D6, DiceThrown D1, DiceThrown D3, PlayerChanged]
--     `shouldBe` Map.fromList [("Perceval", 0), ("Karadoc", 0)]
-- it "Boucliette (twice fail)" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [DiceThrown D6, DiceThrown D1, DiceThrown D3, GrelottineChallenged "Karadoc" (CulDeChouette D3) 1, BouclietteUsed, GrelottineChallenged "Karadoc" (CulDeChouette D3) 1, BouclietteUsed]
--     `shouldBe` Map.fromList [("Perceval", (-10)), ("Karadoc", 0)]
game :: NonEmpty Player -> [Event] -> Map.Map Player Points
game players = Map.map (.points) . (.scores) . foldl applyEvent (initialState players)
  where
    applyEvent game =
      case game.mode of
        Regular (ThrownDicesThree d0 d1 d2) ->
          \case
            GrelottineChallenged challenger expectedCombination bet
              | combination d0 d1 d2 == Néant ->
                  game {mode = GrelottineChallenge game.mode (ChallengerPlayer challenger) expectedCombination bet ThrownDicesStart}
            -- ...
        Regular thrown ->
          \case
            SouffletteChallenged player -> game {mode = SouffletteChallenge game.mode (ChallengedPlayer player) [] ThrownDicesStart}
            -- ...
        GrelottineChallenge previousMode challenger expectedCombination bet thrown ->
          \case
            BouclietteUsed -> useBoucliette previousMode currentPlayer
            -- ...
        SouffletteChallenge previousMode challenged@(ChallengedPlayer challengedPlayer) throws thrown ->
          \case
            BouclietteUsed -> useBoucliette previousMode challengedPlayer
            -- ...
        -- ...
      where
        -- ...
        useBoucliette previousMode player =
          case consumeBoucliette game player of
            Nothing -> bevueOf player
            Just newGame -> newGame {mode = previousMode}

The last rule we will cover is Achat de Dé (buying dices), which states that, a player can exchange 30 points against the last throw of another player.

So, the current player throws they chouettes, two first dices, then another player buy the cul, the third dice, so this player loose 30 points and the current player only score the chouettes.

Let's start by adding a mode and an event, as follows:

data Mode
  = Regular ThrownDices
  | SirotagePending [(Player, Dice)] Dice
  | SirotageThrown [(Player, Dice)] Dice RethrownDice
  | GrelottineChallenge Mode ChallengerPlayer Combination Points ThrownDices
  | SouffletteChallenge Mode ChallengedPlayer [(Dice, Dice, Dice)] ThrownDices
  | AchatDeDe Player Dice Dice

data Event
  = PlayerChanged
  | DiceThrown Dice
  | ActionsDone Player Actions
  | SirotageStarted
  | SirotageBet Player Dice
  | GrelottineChallenged Player Combination Points
  | SouffletteChallenged Player
  | BouclietteUsed
  | DiceBought Player

The next step is to be able to get the combination of only two dices, we should refactor as follows:

combination :: Dice -> Dice -> Maybe Dice -> Combination
combination o0 o1 =
  \case
    Just b
      | diceInt o0 + diceInt o1 == diceInt b -> Velute b
      | o0 == o1 && o0 == b -> CulDeChouette o0
      | o0 == o1 || o0 == b -> Chouette o0
      | o1 == b -> ChouetteVelute o1
      | sort [o0, o1, b] == take 3 [(minimum [o0, o1, b]) ..] -> Suite
      | otherwise -> Néant
    Nothing
      | o0 == o1 -> Chouette o0
      | otherwise -> Néant

We have a new problem, score takes also three dices, we have to start by extracting the score computation as follows:

score :: Player -> Dice -> Dice -> Dice -> Scorer
score p o0 o1 b =
  combinationScore (combination o0 o1 $ Just b) p

combinationScore :: Combination -> Player -> Scorer
combinationScore c p actions =
  case c of
    Chouette d ->
      (p, ScorePoints $ Points $ diceInt d * diceInt d) : allActionsErrors
    Velute d ->
      let errors = actionError <$> filter ((/= PasMouLeCailloux) . snd) actions
       in case lookup PasMouLeCailloux $ map swap actions of
            Just p' -> (p', ScorePoints $ Points $ 2 * diceInt d * diceInt d) : errors
            Nothing -> errors
    ChouetteVelute d ->
      (p, ScorePoints $ Points $ diceInt d * diceInt d) : allActionsErrors
    CulDeChouette d ->
      (p, ScorePoints $ Points $ diceInt d * 10 + 40) : allActionsErrors
    Suite ->
      let errors = actionError <$> filter ((/= GrelotteCaPicotte) . snd) actions
       in case lookup GrelotteCaPicotte $ reverse $ map swap actions of
            Just p' -> (p', ScorePoints $ Points (-10)) : errors
            Nothing -> errors
    Néant ->
      (p, ScoreGrelottine) : allActionsErrors
  where
    allActionsErrors = actionError <$> actions

Finally, we should change game once last time as follows:

-- it "Achat de Dé" $
--   game
--     ("Perceval" :| ["Karadoc"])
--     [DiceThrown D6, DiceThrown D6, DiceBought "Karadoc", PlayerChanged]
--     `shouldBe` Map.fromList [("Perceval", 36), ("Karadoc", (-30))]
game :: NonEmpty Player -> [Event] -> Map.Map Player Points
game players = -- ...
  where
    applyEvent game =
      case game.mode of
        -- ...
        Regular thrown@(ThrownDicesTwo d0 d1) ->
          \case
            DiceThrown dx -> game {mode = Regular $ addThrownDice dx thrown}
            ActionsDone player actions ->
              appendActions' player actions
            SouffletteChallenged player ->
              game {mode = SouffletteChallenge game.mode (ChallengedPlayer player) [] ThrownDicesStart}
            DiceBought buyer ->
              game {mode = AchatDeDe buyer d0 d1}
            event -> bevue event
        -- ...
        AchatDeDe buyer d0 d1 ->
          \case
            PlayerChanged ->
              nextRound $ updateGameScores game $ (buyer, ScorePoints (-30)) : combinationScore (combination d0 d1 Nothing) currentPlayer game.actions
            ActionsDone player actions ->
              appendActions' player actions
            event -> bevue event
      -- ...