{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.HandleResponseM
( MonadClientAtomic(..), MonadClientWriteRequest(..)
, handleResponse
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Game.LambdaHack.Atomic (UpdAtomic)
import Game.LambdaHack.Client.AI
import Game.LambdaHack.Client.HandleAtomicM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Request
import Game.LambdaHack.Client.Response
import Game.LambdaHack.Client.UI
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
class MonadClient m => MonadClientAtomic m where
execUpdAtomic :: UpdAtomic -> m ()
execPutState :: State -> m ()
class MonadClient m => MonadClientWriteRequest m where
sendRequestAI :: RequestAI -> m ()
sendRequestUI :: RequestUI -> m ()
clientHasUI :: m Bool
handleResponse :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientWriteRequest m )
=> Response -> m ()
handleResponse :: Response -> m ()
handleResponse Response
cmd = case Response
cmd of
RespUpdAtomic State
newState UpdAtomic
cmdA -> do
State
oldState <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
State -> m ()
forall (m :: * -> *). MonadClientAtomic m => State -> m ()
execPutState State
newState
State -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadClientSetup m =>
State -> UpdAtomic -> m ()
cmdAtomicSemCli State
oldState UpdAtomic
cmdA
Bool
hasUI <- m Bool
forall (m :: * -> *). MonadClientWriteRequest m => m Bool
clientHasUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UpdAtomic -> m ()
forall (m :: * -> *). MonadClientUI m => UpdAtomic -> m ()
watchRespUpdAtomicUI UpdAtomic
cmdA
RespUpdAtomicNoState UpdAtomic
cmdA -> do
State
oldState <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
UpdAtomic -> m ()
forall (m :: * -> *). MonadClientAtomic m => UpdAtomic -> m ()
execUpdAtomic UpdAtomic
cmdA
State -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadClientSetup m =>
State -> UpdAtomic -> m ()
cmdAtomicSemCli State
oldState UpdAtomic
cmdA
Bool
hasUI <- m Bool
forall (m :: * -> *). MonadClientWriteRequest m => m Bool
clientHasUI
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UpdAtomic -> m ()
forall (m :: * -> *). MonadClientUI m => UpdAtomic -> m ()
watchRespUpdAtomicUI UpdAtomic
cmdA
RespQueryAI ActorId
aid -> do
RequestAI
cmdC <- ActorId -> m RequestAI
forall (m :: * -> *). MonadClient m => ActorId -> m RequestAI
queryAI ActorId
aid
RequestAI -> m ()
forall (m :: * -> *).
MonadClientWriteRequest m =>
RequestAI -> m ()
sendRequestAI RequestAI
cmdC
RespSfxAtomic SfxAtomic
sfx ->
SfxAtomic -> m ()
forall (m :: * -> *). MonadClientUI m => SfxAtomic -> m ()
watchRespSfxAtomicUI SfxAtomic
sfx
Response
RespQueryUIunderAI -> do
RequestUI
req <- m RequestUI
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m RequestUI
queryUIunderAI
RequestUI -> m ()
forall (m :: * -> *).
MonadClientWriteRequest m =>
RequestUI -> m ()
sendRequestUI RequestUI
req
Response
RespQueryUI -> do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayNot}
Maybe RequestUI
sreqPending <- (SessionUI -> Maybe RequestUI) -> m (Maybe RequestUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RequestUI
sreqPending
RequestUI
req <- case Maybe RequestUI
sreqPending of
Maybe RequestUI
Nothing -> do
let loop :: m RequestUI
loop = do
Maybe RequestUI
mreq <- m (Maybe RequestUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe RequestUI)
queryUI
m RequestUI
-> (RequestUI -> m RequestUI) -> Maybe RequestUI -> m RequestUI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m RequestUI
loop RequestUI -> m RequestUI
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RequestUI
mreq
m RequestUI
loop
Just RequestUI
reqPending -> do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sreqPending :: Maybe RequestUI
sreqPending = Maybe RequestUI
forall a. Maybe a
Nothing}
RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return RequestUI
reqPending
RequestUI -> m ()
forall (m :: * -> *).
MonadClientWriteRequest m =>
RequestUI -> m ()
sendRequestUI RequestUI
req