2018-03-10 23:25:44 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2019-01-08 22:37:09 +01:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2018-03-10 23:25:44 +01:00
|
|
|
module Hanafuda.KoiKoi (
|
2019-01-08 22:37:09 +01:00
|
|
|
Action(..)
|
|
|
|
, Card(..)
|
|
|
|
, Environment
|
2019-08-18 22:08:22 +02:00
|
|
|
, Game
|
|
|
|
, GameBlueprint(..)
|
2019-08-15 23:34:59 +02:00
|
|
|
, GameKey
|
2018-03-10 23:25:44 +01:00
|
|
|
, Mode(..)
|
|
|
|
, Move(..)
|
2019-08-15 23:34:59 +02:00
|
|
|
, PlayerKey
|
2018-05-12 11:17:37 +02:00
|
|
|
, Score
|
2019-01-08 22:37:09 +01:00
|
|
|
, Source(..)
|
2018-05-12 11:17:37 +02:00
|
|
|
, Step(..)
|
|
|
|
, Yaku(..)
|
2018-03-15 22:32:24 +01:00
|
|
|
, new
|
|
|
|
, play
|
2018-03-10 23:25:44 +01:00
|
|
|
) where
|
|
|
|
|
2018-03-15 22:32:24 +01:00
|
|
|
import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
|
2018-07-24 22:19:04 +02:00
|
|
|
import qualified Hanafuda.Player as Player (players, random, scores)
|
2018-05-12 11:17:37 +02:00
|
|
|
import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
|
2019-08-15 23:34:59 +02:00
|
|
|
import Hanafuda.KoiKoi.Game (
|
2019-08-18 22:08:22 +02:00
|
|
|
Action(..), Environment, Game, GameBlueprint(..), GameKey, Mode(..), Move(..), PlayerKey
|
2019-08-15 23:34:59 +02:00
|
|
|
, Source(..), Step(..)
|
|
|
|
)
|
2018-03-15 22:32:24 +01:00
|
|
|
import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
|
|
|
|
import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
|
2019-01-08 22:37:09 +01:00
|
|
|
import Control.Monad.Except (MonadError(..))
|
|
|
|
import Control.Monad.IO.Class (MonadIO)
|
2018-03-15 22:32:24 +01:00
|
|
|
|
2019-08-15 23:34:59 +02:00
|
|
|
play :: Environment m => Move -> Game -> m Game
|
2019-08-12 23:02:17 +02:00
|
|
|
play move game@(Game {river, step}) =
|
2018-03-15 22:32:24 +01:00
|
|
|
case (step, move) of
|
|
|
|
(ToPlay, Play card) ->
|
2019-08-12 23:02:17 +02:00
|
|
|
either throwError (Turn.catch game card) $ match card river
|
2018-03-15 22:32:24 +01:00
|
|
|
(ToPlay, Capture (card, caught)) ->
|
|
|
|
if card `canCatch` caught
|
2019-08-12 23:02:17 +02:00
|
|
|
then Turn.catch game card (remove river caught, [card, caught])
|
2019-01-08 22:37:09 +01:00
|
|
|
else throwError "You can't choose that card"
|
2018-03-15 22:32:24 +01:00
|
|
|
(Turned card, Choose caught) ->
|
|
|
|
if card `canCatch` caught
|
2019-08-12 23:02:17 +02:00
|
|
|
then Turn.end game card (remove river caught, [card, caught])
|
2019-01-08 22:37:09 +01:00
|
|
|
else throwError "You can't choose that card"
|
2019-08-12 23:02:17 +02:00
|
|
|
(Scored, KoiKoi keepGame) -> (if keepGame then Turn.next else Round.next) game
|
|
|
|
(Over, _) -> throwError "This game is over"
|
2019-01-08 22:37:09 +01:00
|
|
|
(_, _) -> throwError "You can't play this move in that state"
|
2018-03-15 22:32:24 +01:00
|
|
|
where
|
|
|
|
canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2
|
2018-03-10 23:25:44 +01:00
|
|
|
|
2019-08-15 23:34:59 +02:00
|
|
|
new :: MonadIO m => [PlayerKey] -> Mode -> m Game
|
2018-07-24 22:19:04 +02:00
|
|
|
new playersList mode = do
|
|
|
|
playing <- Player.random players
|
2019-08-12 23:02:17 +02:00
|
|
|
Round.deal $ Game {
|
2018-03-15 22:32:24 +01:00
|
|
|
mode
|
2018-07-24 22:19:04 +02:00
|
|
|
, scores = Player.scores players [0, 0]
|
2018-03-15 22:32:24 +01:00
|
|
|
, month = Pine
|
2018-07-24 22:19:04 +02:00
|
|
|
, players
|
2018-03-15 22:32:24 +01:00
|
|
|
, playing
|
|
|
|
, winning = playing
|
|
|
|
, oyake = playing
|
2018-07-24 22:19:04 +02:00
|
|
|
, deck = undefined
|
2018-03-15 22:32:24 +01:00
|
|
|
, river = undefined
|
|
|
|
, step = ToPlay
|
|
|
|
, trick = []
|
2019-08-12 23:02:17 +02:00
|
|
|
, rounds = []
|
2018-03-15 22:32:24 +01:00
|
|
|
}
|
2018-07-24 22:19:04 +02:00
|
|
|
where
|
|
|
|
players = Player.players playersList
|