server/src/Game.hs

module Game (
      export
    , new
    , play
  ) where

import qualified App (T, update)
import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Reader (lift)
import Control.Monad.Writer (runWriterT)
import Data.Map (mapWithKey)
import qualified Hanafuda (empty)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
import qualified Hanafuda.KoiKoi as KoiKoi (
    Action, Move(..), play, new
  )
import Hanafuda.Message (PublicGame)
import qualified Hanafuda.Player (Player(..), Players(..))
import qualified Server (register)

new :: (PlayerID, PlayerID) -> App.T GameID
new (for, to) =
  Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update

export :: PlayerID -> Game -> PublicGame
export playerID game = game {
      deck = length $ deck game
    , players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
  }
  where
    Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
    maskOpponentsHand k player
      | k == playerID = player
      | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}

play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
play playerID move game = lift . runWriterT . runExceptT $
  if playing game == playerID
  then KoiKoi.play move game
  else throwError "Not your turn"