From f1ee5628096792b579d31939580110236668c9e9 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Mon, 12 Aug 2019 23:02:17 +0200 Subject: [PATCH] Handle the end of games --- ChangeLog.md | 4 ++++ hanafuda.cabal | 2 +- src/Hanafuda/KoiKoi.hs | 22 +++++++++++----------- src/Hanafuda/KoiKoi/Game.hs | 24 +++++++----------------- src/Hanafuda/KoiKoi/Round.hs | 21 +++++++++++---------- src/Hanafuda/KoiKoi/Turn.hs | 34 +++++++++++++++++----------------- 6 files changed, 51 insertions(+), 56 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 4019f31..91acd35 100644 --- a/ChangeLog.md +++ b/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 diff --git a/hanafuda.cabal b/hanafuda.cabal index 2aa2ea6..7b54aa9 100644 --- a/hanafuda.cabal +++ b/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 diff --git a/src/Hanafuda/KoiKoi.hs b/src/Hanafuda/KoiKoi.hs index eee5092..07749b3 100644 --- a/src/Hanafuda/KoiKoi.hs +++ b/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 move on@(On_ {river, step}) = +play :: (Environment m, Ord player) => Move -> Game player -> m (Game player) +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 diff --git a/src/Hanafuda/KoiKoi/Game.hs b/src/Hanafuda/KoiKoi/Game.hs index eb01c4b..2b0a03b 100644 --- a/src/Hanafuda/KoiKoi/Game.hs +++ b/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) -data Over player = Over_ { - finalScores :: Scores player + , rounds :: [(player, Score)] } 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 -setPlayer on@(On_ {players, playing}) player = on {players = set playing player players} - -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 +end :: Monad m => Game player -> m (Game player) +end game = return $ game {step = Over} diff --git a/src/Hanafuda/KoiKoi/Round.hs b/src/Hanafuda/KoiKoi/Round.hs index edcc0ac..0d453d2 100644 --- a/src/Hanafuda/KoiKoi/Round.hs +++ b/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 qualified Hanafuda.Player as Player (deal, get, next, score) +import Hanafuda.KoiKoi.Game (Game(..), Mode(..), Step(..), end) +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 on@(On_ {players}) = do +deal :: (MonadIO m, Ord player) => Game player -> m (Game player) +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 on@(On_ {mode, scores, month, players, oyake, winning}) = +next :: (MonadIO m, Ord player) => Game player -> m (Game player) +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) - scored = on {scores = insert winning newScore scores} + winner = Player.get winning players + 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 + }) diff --git a/src/Hanafuda/KoiKoi/Turn.hs b/src/Hanafuda/KoiKoi/Turn.hs index a9ffb53..aba4873 100644 --- a/src/Hanafuda/KoiKoi/Turn.hs +++ b/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 on@(On_ {players, playing}) card (river, trick) = do +catch :: (Environment m, Ord player) => Game player -> Card -> (Pack, [Card]) -> m (Game player) +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 (On_ {deck = []}) = throwError "No more cards in the stack" -popNextCard on@(On_ {river, deck = turned : others}) = - let pop = on {deck = others} in +popNextCard :: (Environment m, Ord player) => Game player -> m (Game player) +popNextCard (Game {deck = []}) = throwError "No more cards in the stack" +popNextCard game@(Game {river, deck = turned : others}) = + 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 on@(On_ {month, trick, playing, players}) card (river, newCaptured) = do +end :: (MonadWriter [Action] m, MonadIO m, Ord player) => Game player -> Card -> (Pack, [Card]) -> m (Game player) +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 on@(On_ {players, playing}) = +next :: (MonadIO m, Ord player) => Game player -> m (Game player) +next game@(Game {players, playing}) = let newPlaying = Player.next players playing in if hand (Player.get newPlaying players) == empty - then Round.next $ on - else stop $ on {playing = newPlaying, step = ToPlay} + then Round.next $ game + else return $ game {playing = newPlaying, step = ToPlay}