Follow the simplication of Game data type on lib's side
This commit is contained in:
parent
b3808551fd
commit
71b666ca7d
3 changed files with 24 additions and 37 deletions
|
@ -50,7 +50,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
|
|||
then do
|
||||
gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
|
||||
game <- Server.get gameKey <$> App.server
|
||||
Message.notifyPlayers (KoiKoi.On game) []
|
||||
Message.notifyPlayers game []
|
||||
return $ Session.Playing gameKey
|
||||
else do
|
||||
Message.broadcast $ Message.update {Message.alone = [key, to]}
|
||||
|
@ -66,17 +66,17 @@ receive (Session.Playing gameKey) played@(Message.Play {}) = do
|
|||
case result of
|
||||
Left message -> sendError message
|
||||
Right newGame ->
|
||||
case newGame of
|
||||
KoiKoi.Over _ -> do
|
||||
if KoiKoi.on newGame
|
||||
then do
|
||||
App.update_ $ Server.update gameKey (const newGame)
|
||||
Message.notifyPlayers newGame logs
|
||||
else do
|
||||
let newStatus = Session.LoggedIn True
|
||||
let opponent = Player.next (KoiKoi.players game) key
|
||||
let opponent = Player.next (KoiKoi.players newGame) key
|
||||
App.update_ $ Server.endGame gameKey
|
||||
App.update_ $ Server.update opponent (Data.set newStatus :: Session.Update)
|
||||
Message.notifyPlayers newGame logs
|
||||
move newStatus
|
||||
KoiKoi.On on -> do
|
||||
App.update_ $ Server.update gameKey (const on)
|
||||
Message.notifyPlayers newGame logs
|
||||
|
||||
receive state _ = sendError $ "Invalid message in state " ++ show state
|
||||
|
||||
|
|
34
src/Game.hs
34
src/Game.hs
|
@ -8,7 +8,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Game (
|
||||
Key
|
||||
, View
|
||||
, T
|
||||
, export
|
||||
, new
|
||||
|
@ -26,7 +25,7 @@ import qualified Data (Key)
|
|||
import qualified Player (Key)
|
||||
import qualified Hanafuda (Flower(..), Card(..), Pack, cardsOfPack, empty)
|
||||
import qualified Hanafuda.Player (Player(..), Players(..))
|
||||
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), On(..), Over(..), Score, Source(..), Step(..), Yaku(..), new, play)
|
||||
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), Score, Source(..), Step(..), Yaku(..), new, play)
|
||||
import GHC.Generics
|
||||
|
||||
deriving instance Generic Hanafuda.Card
|
||||
|
@ -40,17 +39,11 @@ deriving instance Generic Hanafuda.KoiKoi.Step
|
|||
deriving instance Generic1 (Hanafuda.Player.Player Player.Key)
|
||||
deriving instance Generic1 (Hanafuda.Player.Players Player.Key)
|
||||
|
||||
type On = Hanafuda.KoiKoi.On Player.Key
|
||||
type Over = Hanafuda.KoiKoi.Over Player.Key
|
||||
type View = Hanafuda.KoiKoi.Game Player.Key
|
||||
type T = Hanafuda.KoiKoi.Game Player.Key
|
||||
|
||||
deriving instance Generic On
|
||||
deriving instance Generic Over
|
||||
deriving instance Generic View
|
||||
deriving instance Generic T
|
||||
|
||||
instance ToJSON On where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
instance ToJSON Over where
|
||||
instance ToJSON T where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
|
||||
instance FromJSON Hanafuda.Card
|
||||
|
@ -95,28 +88,25 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
|
|||
toJSON = toJSON1
|
||||
toEncoding = toEncoding1
|
||||
|
||||
type T = On
|
||||
|
||||
type Key = Data.Key T
|
||||
|
||||
new :: Player.Key -> Player.Key -> IO T
|
||||
new p1 p2 = do
|
||||
Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
|
||||
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.FirstAt 1
|
||||
|
||||
export :: Player.Key -> View -> Value
|
||||
export _ (Hanafuda.KoiKoi.Over over) = toJSON over
|
||||
export key (Hanafuda.KoiKoi.On on) = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast
|
||||
export :: Player.Key -> T -> Value
|
||||
export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
|
||||
where
|
||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on
|
||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
|
||||
maskOpponentsHand k player
|
||||
| k == key = player
|
||||
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
|
||||
Object ast = toJSON $ on {
|
||||
Object ast = toJSON $ game {
|
||||
Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
|
||||
}
|
||||
|
||||
play :: Hanafuda.KoiKoi.Environment m => Player.Key -> Hanafuda.KoiKoi.Move -> T -> m (Hanafuda.KoiKoi.Game Player.Key)
|
||||
play key move on
|
||||
| Hanafuda.KoiKoi.playing on == key =
|
||||
Hanafuda.KoiKoi.play move on
|
||||
play key move game
|
||||
| Hanafuda.KoiKoi.playing game == key =
|
||||
Hanafuda.KoiKoi.play move game
|
||||
| otherwise = throwError "Not your turn"
|
||||
|
|
|
@ -23,11 +23,11 @@ import Data.ByteString.Lazy.Char8 (unpack)
|
|||
import Data.Text (Text)
|
||||
import Control.Monad.Reader (asks, lift)
|
||||
import qualified Player (Key)
|
||||
import qualified Game (View, export)
|
||||
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(..), On(..), Over(..), Move(..))
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), Move(..))
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
data FromClient =
|
||||
|
@ -98,10 +98,7 @@ get =
|
|||
update :: T
|
||||
update = Update {alone = [], paired = []}
|
||||
|
||||
notifyPlayers :: Game.View -> [KoiKoi.Action] -> App.T ()
|
||||
notifyPlayers game@(KoiKoi.Over over) logs =
|
||||
forM_ (keys $ KoiKoi.finalScores over) $ \k ->
|
||||
sendTo [k] $ Game {game = Game.export k game, logs}
|
||||
notifyPlayers game@(KoiKoi.On on) logs =
|
||||
forM_ (keys $ KoiKoi.scores on) $ \k ->
|
||||
notifyPlayers :: Game.T -> [KoiKoi.Action] -> App.T ()
|
||||
notifyPlayers game logs =
|
||||
forM_ (keys $ KoiKoi.scores game) $ \k ->
|
||||
sendTo [k] $ Game {game = Game.export k game, logs}
|
||||
|
|
Loading…
Reference in a new issue