Handle the end of games

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for hanafuda
 
+## 0.3.2.0  -- 2019-08-12
+
+* Handle the end of games
+
 ## 0.3.1.0  -- 2019-01-08
 
 * Generalize the output monad of basic functions by only expressing constraints on it

hanafuda.cabal

@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hanafuda
-version:             0.3.1.0
+version:             0.3.2.0
 synopsis:            A game of Hanafuda (a family of japanese card games)
 description:         This is a library to represent the cards and the players
                      of games in this family. It also implements one such game

src/Hanafuda/KoiKoi.hs

@@ -7,8 +7,6 @@ module Hanafuda.KoiKoi (
     , Environment
     , Mode(..)
     , Move(..)
-    , On(..)
-    , Over(..)
     , Score
     , Source(..)
     , Step(..)
@@ -20,34 +18,35 @@ module Hanafuda.KoiKoi (
 import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
 import qualified Hanafuda.Player as Player (players, random, scores)
 import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
-import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Mode(..), Move(..), On(..), Over(..), Source(..), Step(..))
+import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Mode(..), Move(..), Source(..), Step(..))
 import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
 import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.IO.Class (MonadIO)
 
-play :: (Environment m, Ord player) => Move -> On player -> m (Game player)
+play :: (Environment m, Ord player) => Move -> Game player -> m (Game player)
-play move on@(On_ {river, step}) =
+play move game@(Game {river, step}) =
   case (step, move) of
     (ToPlay, Play card) ->
-      either throwError (Turn.catch on card) $ match card river
+      either throwError (Turn.catch game card) $ match card river
     (ToPlay, Capture (card, caught)) ->
       if card `canCatch` caught
-        then Turn.catch on card (remove river caught, [card, caught])
+        then Turn.catch game card (remove river caught, [card, caught])
         else throwError "You can't choose that card"
     (Turned card, Choose caught) ->
       if card `canCatch` caught
-        then Turn.end on card (remove river caught, [card, caught])
+        then Turn.end game card (remove river caught, [card, caught])
         else throwError "You can't choose that card"
-    (Scored, KoiKoi keepOn) -> (if keepOn then Turn.next else Round.next) on
+    (Scored, KoiKoi keepGame) -> (if keepGame then Turn.next else Round.next) game
+    (Over, _) -> throwError "This game is over"
     (_, _) -> throwError "You can't play this move in that state"
   where
     canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2
 
-new :: (MonadIO m, Ord player) => [player] -> Mode -> m (On player)
+new :: (MonadIO m, Ord player) => [player] -> Mode -> m (Game player)
 new playersList mode = do
   playing <- Player.random players
-  Round.deal $ On_ {
+  Round.deal $ Game {
         mode
       , scores = Player.scores players [0, 0]
       , month = Pine
@@ -59,6 +58,7 @@ new playersList mode = do
       , river = undefined
       , step = ToPlay
       , trick = []
+      , rounds = []
     }
   where
     players = Player.players playersList

src/Hanafuda/KoiKoi/Game.hs

@@ -7,13 +7,10 @@ module Hanafuda.KoiKoi.Game (
     , Environment
     , Mode(..)
     , Move(..)
-    , On(..)
-    , Over(..)
     , Source(..)
     , Step(..)
     , end
     , setPlayer
-    , stop
   ) where
 
 import Control.Monad.Except (MonadError)
@@ -25,7 +22,7 @@ import Hanafuda.KoiKoi.Yaku (Score)
 
 data Mode = FirstAt Int | WholeYear deriving (Show)
 data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool
-data Step = ToPlay | Turned Card | Scored deriving (Show)
+data Step = ToPlay | Turned Card | Scored | Over deriving (Show)
 data Source = Hand | Deck deriving (Show)
 data Action = Action {
       source :: Source
@@ -35,7 +32,7 @@ data Action = Action {
 
 type Environment m = (MonadIO m, MonadError String m, MonadWriter [Action] m)
 
-data On player = On_ {
+data Game player = Game {
       mode :: Mode
     , scores :: Scores player
     , month :: Flower
@@ -47,18 +44,11 @@ data On player = On_ {
     , river :: Pack
     , step :: Step
     , trick :: [Card]
-  } deriving (Show)
+    , rounds :: [(player, Score)]
-data Over player = Over_ {
-    finalScores :: Scores player
   } deriving (Show)
 
-data Game player = Over (Over player) | On (On player) deriving (Show)
+setPlayer :: Ord player => Game player -> Player player Score -> Game player
+setPlayer game@(Game {players, playing}) player = game {players = set playing player players}
 
-setPlayer :: Ord player => On player -> Player player Score -> On player
+end :: Monad m => Game player -> m (Game player)
-setPlayer on@(On_ {players, playing}) player = on {players = set playing player players}
+end game = return $ game {step = Over}
-
-end :: Monad m => On player -> m (Game player)
-end (On_ {scores}) = return . Over $ Over_ {finalScores = scores}
-
-stop :: Monad m => On player -> m (Game player)
-stop = return . On

src/Hanafuda/KoiKoi/Round.hs

@@ -6,16 +6,16 @@ module Hanafuda.KoiKoi.Round (
 
 import Hanafuda (Flower(Paulownia), cards, shuffle, packOfCards)
 import Hanafuda.KoiKoi.Yaku (sumYakus)
-import Hanafuda.KoiKoi.Game (Game, Mode(..), On(..), Step(..), end, stop)
+import Hanafuda.KoiKoi.Game (Game(..), Mode(..), Step(..), end)
-import qualified Hanafuda.Player as Player (deal, get, next, score)
+import qualified Hanafuda.Player as Player (deal, get, next, score, yakus)
 import Data.Map ((!), insert)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.State (runState, state)
 
-deal :: (MonadIO m, Ord player) => On player -> m (On player)
+deal :: (MonadIO m, Ord player) => Game player -> m (Game  player)
-deal on@(On_ {players}) = do
+deal game@(Game {players}) = do
   ((hand1, hand2, river), deck) <- runState getTriple <$> shuffle cards
-  return on {
+  return game {
         players = Player.deal players [hand1, hand2]
       , deck
       , river = packOfCards river
@@ -24,8 +24,8 @@ deal on@(On_ {players}) = do
     take8 = state $ splitAt 8
     getTriple = (,,) <$> take8 <*> take8 <*> take8
 
-next :: (MonadIO m, Ord player) => On player -> m (Game player)
+next :: (MonadIO m, Ord player) => Game player -> m (Game player)
-next on@(On_ {mode, scores, month, players, oyake, winning}) =
+next game@(Game {mode, scores, month, players, oyake, winning, rounds}) =
   case mode of
     FirstAt n | n <= newScore -> end scored
     FirstAt _ -> continue
@@ -33,8 +33,9 @@ next on@(On_ {mode, scores, month, players, oyake, winning}) =
     WholeYear -> continue
   where
     playing = Player.next players oyake
-    newScore = (scores ! winning) + Player.score sumYakus (Player.get winning players)
+    winner = Player.get winning players
-    scored = on {scores = insert winning newScore scores}
+    newScore = (scores ! winning) + Player.score sumYakus winner
+    scored = game {scores = insert winning newScore scores, rounds = (winning, Player.yakus winner): rounds}
     continue =
       deal (scored {
             month = succ month
@@ -42,4 +43,4 @@ next on@(On_ {mode, scores, month, players, oyake, winning}) =
           , winning = playing
           , oyake = playing
           , step = ToPlay
-        }) >>= stop
+        })

src/Hanafuda/KoiKoi/Turn.hs

@@ -11,7 +11,7 @@ import Hanafuda (Card, Pack, empty, match)
 import Hanafuda.Player (Player(..), plays)
 import qualified Hanafuda.Player as Player (get, next)
 import Hanafuda.KoiKoi.Yaku (meldInto)
-import Hanafuda.KoiKoi.Game (Action(..), Environment, Game, On(..), Source(..), Step(..), setPlayer, stop)
+import Hanafuda.KoiKoi.Game (Action(..), Environment, Game(..), Source(..), Step(..), setPlayer)
 import qualified Hanafuda.KoiKoi.Round as Round (next)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.IO.Class (MonadIO)
@@ -27,37 +27,37 @@ log source played cards = tell [
     captures [_, captured] = Just captured
     captures _ = Nothing
 
-catch :: (Environment m, Ord player) => On player -> Card -> (Pack, [Card]) -> m (Game player)
+catch :: (Environment m, Ord player) => Game player -> Card -> (Pack, [Card]) -> m (Game player)
-catch on@(On_ {players, playing}) card (river, trick) = do
+catch game@(Game {players, playing}) card (river, trick) = do
   log Hand card trick
-  (setPlayer (on {river, trick})) <$> played >>= popNextCard
+  (setPlayer (game {river, trick})) <$> played >>= popNextCard
   where
     played = (Player.get playing players) `plays` card
 
-popNextCard :: (Environment m, Ord player) => On player -> m (Game player)
+popNextCard :: (Environment m, Ord player) => Game player -> m (Game player)
-popNextCard (On_ {deck = []}) = throwError "No more cards in the stack"
+popNextCard (Game {deck = []}) = throwError "No more cards in the stack"
-popNextCard on@(On_ {river, deck = turned : others}) =
+popNextCard game@(Game {river, deck = turned : others}) =
-  let pop = on {deck = others} in
+  let pop = game {deck = others} in
   case match turned river of
     Right (newRiver, newCaptured) -> end pop turned (newRiver, newCaptured)
-    Left _ -> stop $ pop {step = Turned turned}
+    Left _ -> return $ pop {step = Turned turned}
 
-end :: (MonadWriter [Action] m, MonadIO m, Ord player) => On player -> Card -> (Pack, [Card]) -> m (Game player)
+end :: (MonadWriter [Action] m, MonadIO m, Ord player) => Game player -> Card -> (Pack, [Card]) -> m (Game player)
-end on@(On_ {month, trick, playing, players}) card (river, newCaptured) = do
+end game@(Game {month, trick, playing, players}) card (river, newCaptured) = do
   log Deck card newCaptured
-  let updatedGame = setPlayer (on {river, trick = []}) updatedPlayer
+  let updatedGame = setPlayer (game {river, trick = []}) updatedPlayer
   if null scored
     then next updatedGame
-    else stop $ updatedGame {step = Scored, winning = playing}
+    else return $ updatedGame {step = Scored, winning = playing}
   where
     newTrick = newCaptured ++ trick
     player = Player.get playing players
     (scored, newMeld) = runReader (newTrick `meldInto` (meld player)) month
     updatedPlayer = player {meld = newMeld, yakus = scored `mappend` (yakus player)}
 
-next :: (MonadIO m, Ord player) => On player -> m (Game player)
+next :: (MonadIO m, Ord player) => Game player -> m (Game player)
-next on@(On_ {players, playing}) =
+next game@(Game {players, playing}) =
   let newPlaying = Player.next players playing in
   if hand (Player.get newPlaying players) == empty
-    then Round.next $ on
+    then Round.next $ game
-    else stop $ on {playing = newPlaying, step = ToPlay}
+    else return $ game {playing = newPlaying, step = ToPlay}