Kata: C** de chouette - modes

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.

This games is more sophisticated, there are phases, for example:

• La Soufflette: players can challenge each others (a challenge can be cancelled giving the Boucliette each player get at the beginning of the game), the challenged player has three attempts to get a throw of 4-2-1. If the challenged player succeed at the first try, they get 50 points for the challenger, 40 points on the second attempt, 30 points on the third. And the challenged player give 30 points to the challenger otherwise.
• Le Sirotage: if a player gets a Chouette (2 equal dices), they can pick the third dice and attempt the Cul de chouette (3 equal dices). To do this, they have to announce it, then other players can bet against them (with a special dice, e.g. Perceval got two 3, Karadoc bet for 4), they initially loose 5 points, but get 20 if they win. If the player throwing gets a Cul de chouette, they get the points, or loose the points of the Chouette.
• Le Contre-Sirop: when a Sirotage fails, the first play raising the fist, yelling "J'apprécie les fruits au sirop !", get somes points according to the attempted Cul de chouette (e.g. 10 points for 1, 12 points for 2, 14 points for 3, etc.)
• Le Civet siroté: when the player attempting a Sirotage of 6, they gets a Civet, it can be used whenever the player want. Before throwing their dices, when they have a positive score, the player bet a part of them (as long as they have them, and it cannot exceed a final score of 300 and 102 points maximum) on a result (e.g. "Civet of 80 points on a Cul de chouette with Sirotage")
• The "Grelottine" challenge: a player after getting a Néant (no special dices combination), they get a Grelottine, the others players with one, can challenge the player. The challenger pick a combination which give the maximum percentage of the minimum scores between players (e.g. 8% for Chouette Velute, 14% for Suite, 16% for Cul de chouette, 20% for Cul de chouette with Sirotage, 25% for Velute, 33% for Chouette). Bet points are exchanged depending on the result, and the challenged player gets the points from the throw. Both players loose they grelottine If the challenged player already won one challenge, they are immune to the next challenge, and can yell "Passe-Grelot !" passing the challenge to someone else.

The long term solution is to have a granular, command/event-based solution, but, for the moment, let's have dedicated functions.

We can start with the Soufflette, as a first draft, we can start with the following type:

souflette :: Player -> Player -> [(Dice, Dice, Dice)] -> [(Player, Actions)] -> [(Player, Score)]

It suffers from a duplicated type Player, it is acceptable to have it when the order is not important, but here, the challenged player and the challenger should be different.

Let's take the chance to give a proper type to [(Player, Actions)] -> [(Player, Score)].

We can implement it as follows:

-- describe "Third try" $ do
--      forM_ (permutations [D4, D2, D1]) $ \[x, y, z] ->
--        it (show [x, y, z]) $
--          souflette
--            (ChallengedPlayer "Perceval")
--            (ChallengerPlayer "Karadoc")
--            [(D1, D1, D1), (D2, D2, D2), (x, y, z)]
--            [] `shouldBe` [("Perceval", ScorePoints 30), ("Karadoc", ScorePoints (-30))]
-- describe "Failed" $ do
--        it "Fail" $
--          souflette
--            (ChallengedPlayer "Perceval")
--            (ChallengerPlayer "Karadoc")
--            [(D1, D1, D1), (D2, D2, D2), (D3, D3, D3)]
--            [] `shouldBe` [("Perceval", ScorePoints (-30)), ("Karadoc", ScorePoints 30)]

sortThrow :: (Dice, Dice, Dice) -> (Dice, Dice, Dice)
sortThrow (x, y, z) = (x', y', z')
  where [x', y', z'] = sort [x, y, z]

type Scorer = [(Player, Actions)] -> [(Player, Score)]

newtype ChallengedPlayer
  = ChallengedPlayer {unChallengedPlayer :: Player}
  deriving newtype (Eq, Ord, Show)

newtype ChallengerPlayer
  = ChallengerPlayer {unChallengerPlayer :: Player}
  deriving newtype (Eq, Ord, Show)

souflette :: ChallengedPlayer -> ChallengerPlayer -> [(Dice, Dice, Dice)] -> Scorer
souflette (ChallengedPlayer challenged) (ChallengerPlayer challenger) throws actions =
  scores <> map actionError actions
  where scores =
          case sortThrow <$> throws of
           ((D1, D2, D4):_ )-> win 50
           (_:(D1, D2, D4):_ )-> win 40
           (_:_:(D1, D2, D4):_ )-> win 30
           _ -> [(challenged, ScorePoints $ Points (-30)), (challenger, ScorePoints $ Points 30)]
        win points = 
           [(challenged, ScorePoints points), (challenger, ScorePoints $ Points (-30))]

The next one would be Sirotage, again, if we try to draft the type signature as follows, we ends up with a duplicated type:

sirotage :: Player -> Dice -> Dice -> [(Player, Dice)] -> Scorer

Let's create another wrapper and implement it as follows:

-- describe "Sirop" $ do
--   describe "Sirotage" $ do
--     it "Linotte (1) success with bet on Alouette (2)" $
--       sirot "Perceval" D1 (RethrownDice D1) [("Karadoc", D2)] []
--         `shouldBe` [("Perceval", ScorePoints 50), ("Karadoc", ScorePoints (-5))]
--     it "Linotte (1) failed and success bet on Alouette (2)" $
--       sirot "Perceval" D1 (RethrownDice D2) [("Karadoc", D2)] []
--         `shouldBe` [("Perceval", ScorePoints (-1)), ("Karadoc", ScorePoints 15)]
--     it "Linotte (1) failed and failed bet on Alouette (2)" $
--       sirot "Perceval" D1 (RethrownDice D3) [("Karadoc", D2)] []
--         `shouldBe` [("Perceval", ScorePoints (-1)), ("Karadoc", ScorePoints (-5))]

newtype RethrownDice
  = RethrownDice {unRethrownDice :: Dice}
  deriving stock (Eq, Ord, Show)

sirot :: Player -> Dice -> RethrownDice -> [(Player, Dice)] -> Scorer
sirot player target (RethrownDice rethrown) bets actions =
  if target == rethrown
    then
      score player target target target actions <> map (ScorePoints (-5) <$) bets
    else
      [(player, ScorePoints $ Points $ (-1) * diceInt target * diceInt target)]
        <> map betPoints bets
        <> map actionError actions
  where
    betPoints (p, b) =
      if rethrown == b
        then (p, ScorePoints $ Points 15)
        else (p, ScorePoints $ Points (-5))

Then, we have Contre-Sirop which involve earning some points for the first player yelling "J'apprécie les fruits au sirop !".

We should (re-)work the actions handling as follows:

-- describe "Contre-Sirop" $ do
--   it "Linotte (1) with one yelling" $
--     sirot "Perceval" D1 (RethrownDice D2) [] [("Karadoc", JapprecieLesFruitsAuSirop)]
--       `shouldBe` [("Perceval", ScorePoints (-1)), ("Karadoc", ScorePoints 10)]
--   it "Linotte (1) with two yelling" $
--     sirot "Perceval" D3 (RethrownDice D2) [] [("Karadoc", JapprecieLesFruitsAuSirop), ("Arthur", JapprecieLesFruitsAuSirop)]
--       `shouldBe` [("Perceval", ScorePoints (-9)), ("Karadoc", ScorePoints 14), ("Arthur", ScorePoints (-10))]

sirot :: Player -> Dice -> RethrownDice -> [(Player, Dice)] -> Scorer
sirot player target (RethrownDice rethrown) bets actions =
  if target == rethrown
    then
      score player target target target actions <> map (ScorePoints (-5) <$) bets
    else
      [(player, ScorePoints $ Points $ (-1) * diceInt target * diceInt target)]
        <> map betPoints bets
        <> onFailedActions
  where
    betPoints (p, b) =
      if rethrown == b
        then (p, ScorePoints $ Points 15)
        else (p, ScorePoints $ Points (-5))
    onFailedActions =
      case span ((/= JapprecieLesFruitsAuSirop) . snd) actions of
        (xs, (p, JapprecieLesFruitsAuSirop) : ys) -> map actionError xs <> [(p, ScorePoints $ Points $ 8 + 2 * diceInt target)] <> map actionError ys
        _ -> map actionError actions

The last part is Civet siroté, when the player fail a Sirotage of dice 6, they earn a Civet, let's add it as follows:

-- describe "Civet siroté" $ do
--   it "Chouette (6) success" $
--     sirot "Perceval" D6 (RethrownDice D6) [] []
--       `shouldBe` [("Perceval", ScorePoints 100)]
--   it "Chouette (6) failed" $
--     sirot "Perceval" D6 (RethrownDice D4) [] []
--       `shouldBe` [("Perceval", ScorePoints (-36)), ("Perceval", Civet)]

sirot :: Player -> Dice -> RethrownDice -> [(Player, Dice)] -> Scorer
sirot player target (RethrownDice rethrown) bets actions =
  if target == rethrown
    then
      score player target target target actions <> map (ScorePoints (-5) <$) bets
    else
      [(player, ScorePoints $ Points $ (-1) * diceInt target * diceInt target)]
        <> [(player, Civet) | target == D6] -- <- add a civet
        <> map betPoints bets
        <> onFailedActions
  where
    betPoints (p, b) =
      if rethrown == b
        then (p, ScorePoints $ Points 15)
        else (p, ScorePoints $ Points (-5))
    onFailedActions =
      case span ((/= JapprecieLesFruitsAuSirop) . snd) actions of
        (xs, (p, JapprecieLesFruitsAuSirop) : ys) -> map actionError xs <> [(p, ScorePoints $ Points $ 8 + 2 * diceInt target)] <> map actionError ys
        _ -> map actionError actions

The last is interesting on the design point of view, we will handle Grelottine which is the challenge of a player to another to do a specific combination.

It is interesting because, until now, allow our functions are directly returning the score, not the combination. We can start by extracting both the combinations in a data-type and a function, as follows:

data Combination = Chouette Dice | Velute Dice | ChouetteVelute Dice | CulDeChouette Dice | Suite | Néant
  deriving stock (Eq, Ord, Show)

combination :: Dice -> Dice -> Dice -> Combination
combination o0 o1 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

Then, we can call it in score, simplifying the guard patterns with a case, as follows:

score :: Player -> Dice -> Dice -> Dice -> Scorer
score p o0 o1 b actions =
  case combination o0 o1 b 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, ScoreGrelotting) : allActionsErrors
  where
    allActionsErrors = actionError <$> actions

-- describe "Grelottine" $ do
--   it "Success (Suite)" $ do
--     grelottine
--       (ChallengedPlayer "Perceval")
--       (ChallengerPlayer "Karadoc")
--       Suite
--       10
--       D4
--       D5
--       D6
--       []
--       `shouldBe` [("Perceval", ScorePoints 10), ("Karadoc", ScorePoints (-10))]
--   it "Failed (Néant instead of Suite)" $ do
--     grelottine
--       (ChallengedPlayer "Perceval")
--       (ChallengerPlayer "Karadoc")
--       Suite
--       10
--       D3
--       D5
--       D6
--       []
--       `shouldBe` [("Karadoc", ScorePoints 10), ("Perceval", ScorePoints (-10))]

grelottine :: ChallengedPlayer -> ChallengerPlayer -> Combination -> Points -> Dice -> Dice -> Dice -> Scorer
grelottine (ChallengedPlayer challenged) (ChallengerPlayer challenger) target bet o0 o1 b actions =
  [(winner, ScorePoints bet), (looser, ScorePoints $ (-1) * bet)] <> map actionError actions
  where
    (winner, looser) =
      if target == combination o0 o1 b
        then (challenged, challenger)
        else (challenger, challenged)

There could be plenty of improvements, but that's a solid foundation.

In the next log, we'll see how to combine all these functions in a stateful system with a simple interface.