63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
{-# 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
|