{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.HandleResponseM
( MonadClientWriteRequest(..)
, MonadClientAtomic(..)
, 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.Common.MonadStateRead
import Game.LambdaHack.Common.State
class MonadClient m => MonadClientWriteRequest m where
sendRequestAI :: RequestAI -> m ()
sendRequestUI :: RequestUI -> m ()
clientHasUI :: m Bool
class MonadClient m => MonadClientAtomic m where
execUpdAtomic :: UpdAtomic -> m ()
execPutState :: State -> m ()
handleResponse :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientWriteRequest m )
=> Response -> m ()
handleResponse :: Response -> m ()
handleResponse cmd :: Response
cmd = case Response
cmd of
RespUpdAtomic newState :: State
newState cmdA :: 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
UpdAtomic -> m ()
displayRespUpdAtomicUI UpdAtomic
cmdA
RespUpdAtomicNoState cmdA :: 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
UpdAtomic -> m ()
displayRespUpdAtomicUI UpdAtomic
cmdA
RespQueryAI aid :: 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 sfx :: SfxAtomic
sfx ->
SfxAtomic -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
SfxAtomic -> m ()
displayRespSfxAtomicUI SfxAtomic
sfx
RespQueryUI -> do
RequestUI
cmdH <- m RequestUI
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m RequestUI
queryUI
RequestUI -> m ()
forall (m :: * -> *).
MonadClientWriteRequest m =>
RequestUI -> m ()
sendRequestUI RequestUI
cmdH