Revert "Switch session logging out and relaying the log-out message to keep the sessionID accessible until the end" : the solution was to handle cases when the player wasn't logged in separately
This reverts commit 3bd2829cf2
.
This commit is contained in:
parent
0d19c4f8dc
commit
e5ee61e848
4 changed files with 13 additions and 6 deletions
|
@ -5,13 +5,15 @@ module App (
|
||||||
, debug
|
, debug
|
||||||
, exec
|
, exec
|
||||||
, get
|
, get
|
||||||
|
, player
|
||||||
, session
|
, session
|
||||||
, update
|
, update
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent (MVar, modifyMVar, readMVar)
|
import Control.Concurrent (MVar, modifyMVar, readMVar)
|
||||||
import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
|
import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
|
||||||
import Data.Map ((!))
|
import Data.Map ((!), (!?))
|
||||||
|
import qualified Player (T)
|
||||||
import qualified Server (T(..))
|
import qualified Server (T(..))
|
||||||
import qualified Session (ID, T(..))
|
import qualified Session (ID, T(..))
|
||||||
|
|
||||||
|
@ -31,6 +33,11 @@ session = do
|
||||||
Context {sessionID} <- ask
|
Context {sessionID} <- ask
|
||||||
get $ (! sessionID) . Server.sessions
|
get $ (! sessionID) . Server.sessions
|
||||||
|
|
||||||
|
player :: T (Maybe Player.T)
|
||||||
|
player = do
|
||||||
|
Context {sessionID} <- ask
|
||||||
|
get $ (Session.player =<<) . (!? sessionID) . Server.sessions
|
||||||
|
|
||||||
debug :: String -> T ()
|
debug :: String -> T ()
|
||||||
debug message =
|
debug message =
|
||||||
show <$> asks sessionID
|
show <$> asks sessionID
|
||||||
|
|
|
@ -3,7 +3,7 @@ module Automaton (
|
||||||
loop
|
loop
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified App (Context(..), T, exec, get, session, update)
|
import qualified App (Context(..), T, exec, get, player, update)
|
||||||
import Control.Monad.Reader (asks)
|
import Control.Monad.Reader (asks)
|
||||||
import qualified Game (new, play)
|
import qualified Game (new, play)
|
||||||
import qualified Hanafuda.Message as Message (FromClient(..), T(..))
|
import qualified Hanafuda.Message as Message (FromClient(..), T(..))
|
||||||
|
@ -70,5 +70,5 @@ sendError = Messaging.send . Message.Error
|
||||||
loop :: App.T ()
|
loop :: App.T ()
|
||||||
loop = do
|
loop = do
|
||||||
message <- Messaging.get
|
message <- Messaging.get
|
||||||
(receive message . Session.player) =<< App.session
|
receive message =<< App.player
|
||||||
loop
|
loop
|
||||||
|
|
|
@ -21,8 +21,8 @@ import qualified Session (open)
|
||||||
|
|
||||||
exit :: App.T ()
|
exit :: App.T ()
|
||||||
exit = do
|
exit = do
|
||||||
Messaging.relay Message.LogOut broadcast
|
|
||||||
asks App.sessionID >>= App.update . Server.logOut
|
asks App.sessionID >>= App.update . Server.logOut
|
||||||
|
Messaging.relay Message.LogOut broadcast
|
||||||
|
|
||||||
serverApp :: App.T () -> App.T () -> IO ServerApp
|
serverApp :: App.T () -> App.T () -> IO ServerApp
|
||||||
serverApp onEnter onExit = do
|
serverApp onEnter onExit = do
|
||||||
|
|
|
@ -12,7 +12,7 @@ module Messaging (
|
||||||
, sendTo
|
, sendTo
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified App (T, debug, get, session)
|
import qualified App (T, debug, get, player, session)
|
||||||
import Control.Monad.Reader (lift)
|
import Control.Monad.Reader (lift)
|
||||||
import Data.Aeson (eitherDecode', encode)
|
import Data.Aeson (eitherDecode', encode)
|
||||||
import Data.ByteString.Lazy.Char8 (unpack)
|
import Data.ByteString.Lazy.Char8 (unpack)
|
||||||
|
@ -57,7 +57,7 @@ broadcast obj = do
|
||||||
relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
|
relay :: FromClient -> (Message.T -> App.T ()) -> App.T ()
|
||||||
relay message f = do
|
relay message f = do
|
||||||
App.debug "Relaying"
|
App.debug "Relaying"
|
||||||
maybe (return ()) doRelay . Session.player =<< App.session
|
maybe (return ()) doRelay =<< App.player
|
||||||
where
|
where
|
||||||
doRelay player = f $ Relay {from = playerID player, message}
|
doRelay player = f $ Relay {from = playerID player, message}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue