Continue emptying Game into APILanguage and update the rest of the code accordingly
This commit is contained in:
parent
e3f4ce697d
commit
fbad40afdc
3 changed files with 11 additions and 49 deletions
|
@ -9,7 +9,7 @@ import Control.Monad.Writer (runWriterT)
|
||||||
import qualified Data (RW(..))
|
import qualified Data (RW(..))
|
||||||
import Data.Map (Map, (!?))
|
import Data.Map (Map, (!?))
|
||||||
import qualified Game (Key, T, new, play)
|
import qualified Game (Key, T, new, play)
|
||||||
import qualified Hanafuda.KoiKoi as KoiKoi (Game(..), Step(..))
|
import qualified Hanafuda.KoiKoi as KoiKoi (GameBlueprint(..), Step(..))
|
||||||
import qualified Session (Status(..), T(..), Update)
|
import qualified Session (Status(..), T(..), Update)
|
||||||
import qualified Server (endGame, get, logIn, logOut, update, register, room)
|
import qualified Server (endGame, get, logIn, logOut, update, register, room)
|
||||||
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
|
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
|
||||||
|
|
56
src/Game.hs
56
src/Game.hs
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
@ -15,70 +14,33 @@ module Game (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Except (throwError)
|
import Control.Monad.Except (throwError)
|
||||||
import Data.Text (pack)
|
|
||||||
import Data.Map (mapWithKey)
|
import Data.Map (mapWithKey)
|
||||||
import Data.HashMap.Strict (insert)
|
|
||||||
import Data.Aeson (ToJSON(..), ToJSONKey(..), Value(..), defaultOptions, genericToEncoding)
|
|
||||||
import Data.Aeson.Types (toJSONKeyText)
|
|
||||||
import qualified Data (Key)
|
import qualified Data (Key)
|
||||||
import qualified Hanafuda (Flower(..), Pack, cardsOfPack, empty)
|
import qualified Hanafuda (empty)
|
||||||
import qualified Hanafuda.KoiKoi (Game(..), Environment, Mode(..), Move(..), PlayerKey, Score, Step(..), Yaku(..), new, play)
|
import qualified Hanafuda.KoiKoi (Game, Environment, Mode(..), Move(..), PlayerKey, new, play)
|
||||||
|
import Hanafuda.KoiKoi (GameBlueprint(..))
|
||||||
import qualified Hanafuda.Player (Player(..), Players(..))
|
import qualified Hanafuda.Player (Player(..), Players(..))
|
||||||
import Hanafuda.Message()
|
import Hanafuda.Message (PublicGame)
|
||||||
import GHC.Generics
|
|
||||||
|
|
||||||
deriving instance Generic Hanafuda.Flower
|
|
||||||
deriving instance Generic Hanafuda.KoiKoi.Mode
|
|
||||||
deriving instance Generic Hanafuda.KoiKoi.Yaku
|
|
||||||
deriving instance Generic Hanafuda.KoiKoi.Step
|
|
||||||
|
|
||||||
type T = Hanafuda.KoiKoi.Game
|
type T = Hanafuda.KoiKoi.Game
|
||||||
|
|
||||||
deriving instance Generic T
|
|
||||||
|
|
||||||
instance ToJSON T where
|
|
||||||
toEncoding = genericToEncoding defaultOptions
|
|
||||||
|
|
||||||
instance ToJSON Hanafuda.Flower
|
|
||||||
|
|
||||||
instance ToJSON Hanafuda.Pack where
|
|
||||||
toJSON = toJSON . Hanafuda.cardsOfPack
|
|
||||||
toEncoding = toEncoding . Hanafuda.cardsOfPack
|
|
||||||
|
|
||||||
instance ToJSON Hanafuda.KoiKoi.Mode
|
|
||||||
|
|
||||||
instance ToJSON Hanafuda.KoiKoi.Step where
|
|
||||||
toEncoding = genericToEncoding defaultOptions
|
|
||||||
|
|
||||||
instance ToJSON (Hanafuda.Player.Player Hanafuda.KoiKoi.Score) where
|
|
||||||
toJSON = toJSON
|
|
||||||
toEncoding = toEncoding
|
|
||||||
|
|
||||||
instance ToJSON Hanafuda.KoiKoi.Yaku where
|
|
||||||
toEncoding = genericToEncoding defaultOptions
|
|
||||||
instance ToJSONKey Hanafuda.KoiKoi.Yaku where
|
|
||||||
toJSONKey = toJSONKeyText (pack . show)
|
|
||||||
|
|
||||||
instance ToJSON (Hanafuda.Player.Players Hanafuda.KoiKoi.Score) where
|
|
||||||
toJSON = toJSON
|
|
||||||
toEncoding = toEncoding
|
|
||||||
|
|
||||||
type Key = Data.Key T
|
type Key = Data.Key T
|
||||||
|
|
||||||
new :: Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.PlayerKey -> IO T
|
new :: Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.PlayerKey -> IO T
|
||||||
new p1 p2 = do
|
new p1 p2 = do
|
||||||
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.WholeYear
|
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.WholeYear
|
||||||
|
|
||||||
export :: Hanafuda.KoiKoi.PlayerKey -> T -> Value
|
export :: Hanafuda.KoiKoi.PlayerKey -> T -> PublicGame
|
||||||
export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
|
export key game = game {
|
||||||
|
deck = length $ deck game
|
||||||
|
, players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
|
||||||
|
}
|
||||||
where
|
where
|
||||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
|
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
|
||||||
maskOpponentsHand k player
|
maskOpponentsHand k player
|
||||||
| k == key = player
|
| k == key = player
|
||||||
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
|
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
|
||||||
Object ast = toJSON $ game {
|
|
||||||
Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
|
|
||||||
}
|
|
||||||
|
|
||||||
play :: Hanafuda.KoiKoi.Environment m => Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.Move -> T -> m T
|
play :: Hanafuda.KoiKoi.Environment m => Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.Move -> T -> m T
|
||||||
play key move game
|
play key move game
|
||||||
|
|
|
@ -24,7 +24,7 @@ import qualified Game (T, export)
|
||||||
import qualified Session (T(..))
|
import qualified Session (T(..))
|
||||||
import qualified Server (T(..), get)
|
import qualified Server (T(..), get)
|
||||||
import qualified App (Context(..), T, connection, debug, server)
|
import qualified App (Context(..), T, connection, debug, server)
|
||||||
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), PlayerKey)
|
import qualified Hanafuda.KoiKoi as KoiKoi (Action, GameBlueprint(..), PlayerKey)
|
||||||
import qualified Hanafuda.Message as Message (T)
|
import qualified Hanafuda.Message as Message (T)
|
||||||
import Hanafuda.Message (FromClient(..), T(..))
|
import Hanafuda.Message (FromClient(..), T(..))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue