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

Revert to storing only 'On' games

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

6
src/Automaton.hs
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 _ =

16
src/Game.hs
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"

8
src/Message.hs
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