hanafuda/server
1
1
Fork 0
Code Issues Pull requests Releases Wiki Activity

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Automaton.hs
View file

@ -9,7 +9,7 @@ import Control.Monad.Writer (runWriterT)
import qualified Data (RW(..))
import Data.Map (Map, (!?))
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 Server (endGame, get, logIn, logOut, update, register, room)
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)

56
src/Game.hs
View file

@ -1,6 +1,5 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@ -15,70 +14,33 @@ module Game (
) where
import Control.Monad.Except (throwError)
import Data.Text (pack)
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 Hanafuda (Flower(..), Pack, cardsOfPack, empty)
import qualified Hanafuda.KoiKoi (Game(..), Environment, Mode(..), Move(..), PlayerKey, Score, Step(..), Yaku(..), new, play)
import qualified Hanafuda (empty)
import qualified Hanafuda.KoiKoi (Game, Environment, Mode(..), Move(..), PlayerKey, new, play)
import Hanafuda.KoiKoi (GameBlueprint(..))
import qualified Hanafuda.Player (Player(..), Players(..))
import Hanafuda.Message()
import GHC.Generics
import Hanafuda.Message (PublicGame)
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
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
new :: Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.PlayerKey -> IO T
new p1 p2 = do
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.WholeYear
export :: Hanafuda.KoiKoi.PlayerKey -> T -> Value
export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
export :: Hanafuda.KoiKoi.PlayerKey -> T -> PublicGame
export key 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 == key = player
| 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 key move game

2
src/Messaging.hs
View file

@ -24,7 +24,7 @@ import qualified Game (T, export)
import qualified Session (T(..))
import qualified Server (T(..), get)
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 Hanafuda.Message (FromClient(..), T(..))