Revert to storing only 'On' games

This commit is contained in:
Sasha 2018-07-15 17:57:40 +02:00
parent bf5990de47
commit 262b6e3e79
3 changed files with 10 additions and 20 deletions

View File

@ -65,9 +65,9 @@ edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
case newGame of case newGame of
KoiKoi.Error s -> status `withError` s KoiKoi.Error s -> status `withError` s
KoiKoi.Over _ -> undefined KoiKoi.Over _ -> undefined
KoiKoi.On _ -> do KoiKoi.On on -> do
App.update_ $ Server.update gameKey (const newGame) App.update_ $ Server.update gameKey (const on)
Message.notifyPlayers newGame Message.notifyPlayers on
return status return status
edges state _ = edges state _ =

View File

@ -80,10 +80,7 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
toJSON = toJSON1 toJSON = toJSON1
toEncoding = toEncoding1 toEncoding = toEncoding1
instance ToJSON On type T = Hanafuda.KoiKoi.On Player.Key
instance ToJSON Over
type T = Hanafuda.KoiKoi.Game Player.Key
instance ToJSON T instance ToJSON T
@ -91,11 +88,10 @@ type Key = Data.Key T
new :: Player.Key -> Player.Key -> IO T new :: Player.Key -> Player.Key -> IO T
new p1 p2 = do new p1 p2 = do
on <- Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
return $ Hanafuda.KoiKoi.On on
export :: Player.Key -> T -> T export :: Player.Key -> T -> T
export key (Hanafuda.KoiKoi.On on) = Hanafuda.KoiKoi.On $ on { export key on = on {
Hanafuda.KoiKoi.deck = [] Hanafuda.KoiKoi.deck = []
, Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered , Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
} }
@ -104,12 +100,10 @@ export key (Hanafuda.KoiKoi.On on) = Hanafuda.KoiKoi.On $ on {
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}
export _ game = game
play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO T play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO (Hanafuda.KoiKoi.Game Player.Key)
play key move (Hanafuda.KoiKoi.On on) play key move on
| Hanafuda.KoiKoi.playing on == key = do | Hanafuda.KoiKoi.playing on == key = do
newState <- Hanafuda.KoiKoi.play move on newState <- Hanafuda.KoiKoi.play move on
return $ newState return $ newState
| otherwise = return $ Hanafuda.KoiKoi.Error "Not your turn" | otherwise = return $ Hanafuda.KoiKoi.Error "Not your turn"
play _ _ _ = return $ Hanafuda.KoiKoi.Error "This game is over"

View File

@ -27,7 +27,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 (Game(..), On(..), Over(..), Move(..)) import qualified Hanafuda.KoiKoi as KoiKoi (On(..), Move(..))
import GHC.Generics (Generic) import GHC.Generics (Generic)
data FromClient = data FromClient =
@ -100,9 +100,5 @@ update = Update {alone = [], paired = []}
notifyPlayers :: Game.T -> App.T () notifyPlayers :: Game.T -> App.T ()
notifyPlayers game = notifyPlayers game =
forM_ (keys $ scores game) $ \k -> forM_ (keys $ KoiKoi.scores game) $ \k ->
sendTo [k] $ Game {game = Game.export k game} sendTo [k] $ Game {game = Game.export k game}
where
scores (KoiKoi.On on) = KoiKoi.scores on
scores (KoiKoi.Over over) = KoiKoi.finalScores over
scores _ = mempty