diff --git a/ChangeLog.md b/ChangeLog.md index 93ed5ba..acef02a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for hanafudapi +## 0.2.2.0 -- 2019-08-12 + +* Handle the end of games + +## 0.2.1.0 -- 2019-01-08 + +* Use latest changes in the lib to send a log of what happened during a turn + ## 0.2.0.1 -- 2018-08-26 * Games are now playable diff --git a/hanafuda-webapp.cabal b/hanafuda-webapp.cabal index 6b4f4f9..e5356e3 100644 --- a/hanafuda-webapp.cabal +++ b/hanafuda-webapp.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hanafuda-webapp -version: 0.2.1.0 +version: 0.2.2.0 synopsis: A webapp for the Haskell hanafuda library -- description: homepage: https://framagit.org/hanafuda diff --git a/src/Automaton.hs b/src/Automaton.hs index 85c7404..67e49d4 100644 --- a/src/Automaton.hs +++ b/src/Automaton.hs @@ -7,29 +7,28 @@ import Control.Monad.Except (runExceptT) import Control.Monad.Reader (asks, lift) import Control.Monad.Writer (runWriterT) import qualified Data (RW(..)) -import qualified Game (new, play) -import qualified Hanafuda.KoiKoi as KoiKoi (Game(..)) +import Data.Map (Map, (!?)) +import qualified Game (Key, T, new, play) +import qualified Hanafuda.KoiKoi as KoiKoi (Game(..), Step(..)) import qualified Session (Status(..), T(..), Update) -import qualified Server (get, logIn, logOut, update, register) +import qualified Server (endGame, get, logIn, logOut, update, register) import qualified App (Context(..), T, current, debug, get, server, try, update, update_) import qualified Message (FromClient(..), T(..), broadcast, get, notifyPlayers, relay, send, sendTo, update) -type Vertex = Session.Status +receive :: Session.Status -> Message.FromClient -> App.T () -edges :: Vertex -> Message.FromClient -> App.T Vertex - -edges (Session.LoggedIn False) logIn@(Message.LogIn login) = +receive (Session.LoggedIn False) logIn@(Message.LogIn login) = asks App.key >>= App.try . (Server.logIn login) >>= maybe - (Message.relay logIn Message.broadcast >> return (Session.LoggedIn True)) - (withError $ Session.LoggedIn False) + (Message.relay logIn Message.broadcast >> setSessionStatus (Session.LoggedIn True)) + sendError -edges (Session.LoggedIn True) logOut@Message.LogOut = do +receive (Session.LoggedIn True) logOut@Message.LogOut = do Message.relay logOut Message.broadcast asks App.key >>= App.update_ . Server.logOut - return (Session.LoggedIn False) + setSessionStatus (Session.LoggedIn False) -edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do +receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do session <- App.get to case Session.status session of Session.LoggedIn True -> do @@ -37,10 +36,10 @@ edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do App.update_ (Server.update to (Data.set $ Session.Answering key :: Session.Update)) Message.broadcast $ Message.update {Message.paired = [key, to]} (Message.relay invitation $ Message.sendTo [to]) - return (Session.Waiting to) - _ -> Session.LoggedIn True `withError` "They just left" + setSessionStatus (Session.Waiting to) + _ -> sendError "They just left" -edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do +receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do session <- App.get to key <- asks App.key case Session.status session of @@ -57,42 +56,52 @@ edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do Message.broadcast $ Message.update {Message.alone = [key, to]} return $ Session.LoggedIn True App.update_ $ Server.update to (Data.set newStatus :: Session.Update) - return newStatus - _ -> (Session.LoggedIn True) `withError` "They're not waiting for your answer" + setSessionStatus newStatus + _ -> sendError "They're not waiting for your answer" -edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do +receive (Session.Playing gameKey) played@(Message.Play {}) = do key <- asks App.key game <- Server.get gameKey <$> App.server - (result, logs) <- lift . runWriterT . runExceptT $ Game.play key move game + (result, logs) <- lift . runWriterT . runExceptT $ Game.play key (Message.move played) game case result of - Left message -> status `withError` message - Right newGame -> - case newGame of - KoiKoi.Over _ -> undefined - KoiKoi.On on -> do - App.update_ $ Server.update gameKey (const on) - Message.notifyPlayers on logs - return status + Left message -> sendError message + Right newGame -> do + Message.notifyPlayers newGame logs + case KoiKoi.step newGame of + KoiKoi.Over -> do + App.debug $ "Game " ++ show gameKey ++ " ended" + App.update_ $ Server.endGame gameKey + _ -> App.update_ $ Server.update gameKey (const newGame) -edges state _ = - state `withError` ("Invalid message in state " ++ show state) +receive (Session.Playing gameKey) Message.Quit = do + games <- (Data.get <$> App.server :: App.T (Map Game.Key Game.T)) + case games !? gameKey of + Nothing -> do + key <- asks App.key + Message.broadcast $ Message.update {Message.alone = [key]} + setSessionStatus (Session.LoggedIn True) + _ -> sendError "Game is still running" -withError :: Vertex -> String -> App.T Vertex -withError vertex message = - (Message.send $ Message.Error message) >> return vertex +receive state _ = sendError $ "Invalid message in state " ++ show state -run :: App.T () -run = do - message <- Message.get - status <- Session.status <$> App.current - newStatus <- edges status message +sendError :: String -> App.T () +sendError = Message.send . Message.Error + +setSessionStatus :: Session.Status -> App.T () +setSessionStatus newStatus = do key <- asks App.key App.update_ $ Server.update key $ (Data.set newStatus :: Session.Update) App.debug $ show newStatus - run + +loop :: App.T () +loop = do + message <- Message.get + status <- Session.status <$> App.current + status `receive` message + loop start :: App.T () start = do App.debug "Initial state" Message.Welcome <$> App.server <*> asks App.key >>= Message.send - run + loop diff --git a/src/Game.hs b/src/Game.hs index 2678d59..2b9cb47 100644 --- a/src/Game.hs +++ b/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,13 +39,12 @@ 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 T where + toEncoding = genericToEncoding JSON.defaultOptions instance FromJSON Hanafuda.Card instance ToJSON Hanafuda.Card @@ -90,29 +88,25 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where toJSON = toJSON1 toEncoding = toEncoding1 -type T = Hanafuda.KoiKoi.On Player.Key - -instance ToJSON T - 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.WholeYear export :: Player.Key -> T -> Value -export key on = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast +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" diff --git a/src/Message.hs b/src/Message.hs index 12e1f05..5ef1771 100644 --- a/src/Message.hs +++ b/src/Message.hs @@ -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 (Action, On(..), Move(..)) +import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), Move(..)) import GHC.Generics (Generic) data FromClient = @@ -36,6 +36,7 @@ data FromClient = | LogIn {name :: Text} | LogOut | Play {move :: KoiKoi.Move} + | Quit | Ping deriving (Generic) diff --git a/src/Server.hs b/src/Server.hs index ed55943..de9601f 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -8,6 +8,7 @@ module Server ( T(..) , disconnect + , endGame , get , logIn , logOut @@ -96,6 +97,10 @@ disconnect :: Player.Key -> T -> T disconnect key = Data.update (delete key :: Sessions -> Sessions) . logOut key +endGame :: Game.Key -> T -> T +endGame key = + Data.update (delete key :: Games -> Games) + logIn :: Text -> Player.Key -> T -> Either String T logIn name key server = Data.update (Set.insert name) . diff --git a/www/game.js b/www/game.js index 02e4821..2e89dd8 100644 --- a/www/game.js +++ b/www/game.js @@ -48,8 +48,12 @@ function Game(modules) { } function handleGameMessage(o) { - if(o.game.deck == 24) { - return o.logs.length > 0 ? modules.async.sequence(applyDiff(o), setGame(o)) : setGame(o); + if(o.game.deck == 24) { // deck is full, means new round + if(o.logs.length > 0) { // but still some logs, from the previous round + return modules.async.sequence(applyDiff(o), setGame(o)); // so play the diff, then set the new round + } else { + return setGame(o); // directly set a whole new game + } } else { return applyDiff(o); } @@ -70,39 +74,75 @@ function Game(modules) { function handleStep(o) { return function(f) { - if(status.step == "Turned") { - setTurned(o.game.step.contents); - } else { - if(status.step == "ToPlay" && o.game.playing == o.game.oyake) { - rest.className = ["card", "count" + o.game.deck].join(' '); - } - if(deck.lastChild.id != "rest") { - deck.removeChild(deck.lastChild); - } - } - if(status.step == "Scored") { - if(status.playing) { - modules.screen.dialog({ - text: modules.i18n.get('youScored'), - answers: [ - {label: 'endRound', action: function() {play({koiKoi: false}); f();}}, - {label: 'koikoi', action: function() {play({koiKoi: true}); f();}} - ] - }); - } else { - modules.screen.dialog({ - text: modules.i18n.get('theyScored')(modules.room.name(o.game.playing)), - answers: [ - {label: 'ok', action: f} - ] - }); - } - } else { + handleTurnedCard(o, f); + if(status.step == "Scored") { + if(status.playing) { + askKoikoi(o, f); + } else { + theyScored(o, f); + } + } else if (status.step == "Over") { + gameEnd(o, f); + } else { f(); } }; } + function handleTurnedCard(o, f) { + if(status.step == "Turned") { + setTurned(o.game.step.contents); + } else { + if(status.step == "ToPlay" && o.game.playing == o.game.oyake) { + rest.className = ["card", "count" + o.game.deck].join(' '); + } + if(deck.lastChild.id != "rest") { + deck.removeChild(deck.lastChild); + } + } + } + + function askKoikoi(o, f) { + modules.screen.dialog({ + text: modules.i18n.get('youScored'), + answers: [ + {label: 'endRound', action: function() {play({koiKoi: false}); f();}}, + {label: 'koikoi', action: function() {play({koiKoi: true}); f();}} + ] + }); + + } + + function theyScored(o, f) { + modules.screen.dialog({ + text: modules.i18n.get('theyScored')(modules.room.name(o.game.playing)), + answers: [ + {label: 'ok', action: f} + ] + }); + } + + function gameEnd(o, f) { + var winner, maxScore; + for(var key in o.game.scores) { + if(maxScore == undefined || o.game.scores[key] > maxScore) { + winner = key; + maxScore = o.game.scores[key]; + } + } + modules.screen.dialog({ + text: modules.i18n.get(modules.session.is(winner) ? 'won' : 'lost'), + answers: [{ + label: 'endGame', + action: function() { + modules.messaging.send({tag: "Quit"}); + modules.screen.select('reception'); + f(); + } + }] + }); + } + function applyDiff(o) { return modules.async.sequence.apply(null, o.logs.map(animate).concat( diff --git a/www/translations.js b/www/translations.js index f10e5db..f3658d9 100644 --- a/www/translations.js +++ b/www/translations.js @@ -17,6 +17,7 @@ function Translations() { alone: "No one to play with yet ! Wait a little", decline: "Decline", endRound: "End the round", + endGame: "Return to main menu", join: "Join", invite: "Invite", invited: function(name) { @@ -24,6 +25,7 @@ function Translations() { }, koikoi: "KoiKoi !!", leave: "Leave", + lost: "You lost the game", monthFlower: function(flower) { return "This month's flower is the " + flower; }, @@ -37,6 +39,7 @@ function Translations() { theyScored: function(name) { return name + " scored"; }, + won: "You won !", yourTurn: "Your turn", youScored: "You scored ! Do you want to get your points and end the round or KoiKoi ?" }, @@ -57,6 +60,7 @@ function Translations() { alone: "Personne pour jouer pour l'instant ! Attendez un peu", decline: "Refuser", endRound: "Finir la manche", + endGame: "Retourner au menu principal", join: "Entrer", invite: "Inviter", invited: function(name) { @@ -64,6 +68,7 @@ function Translations() { }, koikoi: "KoiKoi !!", leave: "Partir", + lost: "Vous avez perdu", monthFlower: function(flower) { return "C'est le mois des " + flower; }, @@ -77,6 +82,7 @@ function Translations() { theyScored: function(name) { return name + " a marqué"; }, + won: "Vous avez gagné !", yourTurn: "À vous", youScored: "Vous avez marqué ! Voulez-vous empocher vos gains et terminer la manche ou faire KoiKoi ?" }