diff --git a/src/App.hs b/src/App.hs index 128ad3a..a63469c 100644 --- a/src/App.hs +++ b/src/App.hs @@ -5,13 +5,15 @@ module App ( , debug , exec , get + , player , session , update ) where import Control.Concurrent (MVar, modifyMVar, readMVar) import Control.Monad.Reader (ReaderT(..), ask, asks, lift) -import Data.Map ((!)) +import Data.Map ((!), (!?)) +import qualified Player (T) import qualified Server (T(..)) import qualified Session (ID, T(..)) @@ -31,6 +33,11 @@ session = do Context {sessionID} <- ask get $ (! sessionID) . Server.sessions +player :: T (Maybe Player.T) +player = do + Context {sessionID} <- ask + get $ (Session.player =<<) . (!? sessionID) . Server.sessions + debug :: String -> T () debug message = show <$> asks sessionID diff --git a/src/Automaton.hs b/src/Automaton.hs index a89049a..7a0ee85 100644 --- a/src/Automaton.hs +++ b/src/Automaton.hs @@ -3,7 +3,7 @@ module Automaton ( loop ) 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 qualified Game (new, play) import qualified Hanafuda.Message as Message (FromClient(..), T(..)) @@ -70,5 +70,5 @@ sendError = Messaging.send . Message.Error loop :: App.T () loop = do message <- Messaging.get - (receive message . Session.player) =<< App.session + receive message =<< App.player loop diff --git a/src/Main.hs b/src/Main.hs index 025b4a2..c620c75 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -21,8 +21,8 @@ import qualified Session (open) exit :: App.T () exit = do - Messaging.relay Message.LogOut broadcast asks App.sessionID >>= App.update . Server.logOut + Messaging.relay Message.LogOut broadcast serverApp :: App.T () -> App.T () -> IO ServerApp serverApp onEnter onExit = do diff --git a/src/Messaging.hs b/src/Messaging.hs index e966dea..0a15ef4 100644 --- a/src/Messaging.hs +++ b/src/Messaging.hs @@ -12,7 +12,7 @@ module Messaging ( , sendTo ) where -import qualified App (T, debug, get, session) +import qualified App (T, debug, get, player, session) import Control.Monad.Reader (lift) import Data.Aeson (eitherDecode', encode) import Data.ByteString.Lazy.Char8 (unpack) @@ -57,7 +57,7 @@ broadcast obj = do relay :: FromClient -> (Message.T -> App.T ()) -> App.T () relay message f = do App.debug "Relaying" - maybe (return ()) doRelay . Session.player =<< App.session + maybe (return ()) doRelay =<< App.player where doRelay player = f $ Relay {from = playerID player, message}