Continue emptying Game into APILanguage and update the rest of the code accordingly

This commit is contained in:
Tissevert 2019-08-19 18:59:48 +02:00
parent e3f4ce697d
commit fbad40afdc
3 changed files with 11 additions and 49 deletions

View file

@ -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_)

View file

@ -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

View file

@ -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(..))