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
KoiKoi.Error s -> status `withError` s
KoiKoi.Over _ -> undefined
KoiKoi.On _ -> do
App.update_ $ Server.update gameKey (const newGame)
Message.notifyPlayers newGame
KoiKoi.On on -> do
App.update_ $ Server.update gameKey (const on)
Message.notifyPlayers on
return status
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
toEncoding = toEncoding1
instance ToJSON On
instance ToJSON Over
type T = Hanafuda.KoiKoi.Game Player.Key
type T = Hanafuda.KoiKoi.On Player.Key
instance ToJSON T
@ -91,11 +88,10 @@ type Key = Data.Key T
new :: Player.Key -> Player.Key -> IO T
new p1 p2 = do
on <- Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
return $ Hanafuda.KoiKoi.On on
Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
export :: Player.Key -> T -> T
export key (Hanafuda.KoiKoi.On on) = Hanafuda.KoiKoi.On $ on {
export key on = on {
Hanafuda.KoiKoi.deck = []
, 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
| k == key = player
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
export _ game = game
play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO T
play key move (Hanafuda.KoiKoi.On on)
play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO (Hanafuda.KoiKoi.Game Player.Key)
play key move on
| Hanafuda.KoiKoi.playing on == key = do
newState <- Hanafuda.KoiKoi.play move on
return $ newState
| 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 Server (T(..), get)
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)
data FromClient =
@ -100,9 +100,5 @@ update = Update {alone = [], paired = []}
notifyPlayers :: Game.T -> App.T ()
notifyPlayers game =
forM_ (keys $ scores game) $ \k ->
forM_ (keys $ KoiKoi.scores game) $ \k ->
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