{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Game ( Key , State(..) , T(..) , export , new ) where import Data.Map (Map, (!), fromList, mapKeys) import Data.Aeson (FromJSON(..), ToJSON(..), genericToEncoding) import qualified JSON (singleLCField) import qualified Data (Key) import qualified Player (Key) import qualified Hanafuda (Card(..), cardsOfPack) import qualified Hanafuda.Player (Player(..), Seat(..)) import qualified Hanafuda.KoiKoi (Mode(..), Move(..), On(..), new) import GHC.Generics deriving instance Generic Hanafuda.Card deriving instance Generic Hanafuda.KoiKoi.Move instance FromJSON Hanafuda.Card instance ToJSON Hanafuda.Card instance FromJSON Hanafuda.KoiKoi.Move instance ToJSON Hanafuda.KoiKoi.Move where toEncoding = genericToEncoding JSON.singleLCField data T = T { seats :: Map Hanafuda.Player.Seat Player.Key , state :: Hanafuda.KoiKoi.On } type Key = Data.Key T data State = State { river :: [Hanafuda.Card] , yakus :: Map Player.Key [Hanafuda.Card] } deriving (Generic) instance ToJSON State where toEncoding = genericToEncoding JSON.singleLCField new :: Player.Key -> Player.Key -> IO T new p1 p2 = do state <- Hanafuda.KoiKoi.new Hanafuda.KoiKoi.WholeYear return $ T { seats = fromList [(Hanafuda.Player.Player1, p1), (Hanafuda.Player.Player2, p2)] , state } export :: T -> State export (T {seats, state}) = State { river = Hanafuda.cardsOfPack $ Hanafuda.KoiKoi.river state , yakus = fmap extractYakus players } where extractYakus = Hanafuda.cardsOfPack . Hanafuda.Player.meld players = mapKeys (seats !) $ Hanafuda.KoiKoi.players state