    {-# LANGUAGE FlexibleContexts #-}
    -- | Semantics of responses sent by the server to clients.
    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.Common.MonadStateRead
    import Game.LambdaHack.Common.State

    -- | Monad for executing atomic game state transformations on a client.
    class MonadClient m => MonadClientAtomic m where
      -- | Execute an atomic update that changes the client's 'State'.
      execUpdAtomic :: UpdAtomic -> m ()
      -- | Put state that is intended to be the result of performing
      -- an atomic update by the server on its copy of the client's 'State'.
      execPutState :: State -> m ()

    -- | Client monad in which one can send requests to the client.
    class MonadClient m => MonadClientWriteRequest m where
      sendRequestAI :: RequestAI -> m ()
      sendRequestUI :: RequestUI -> m ()
      clientHasUI   :: m Bool

    -- | Handle server responses.
    --
    -- Note that for clients communicating with the server over the net,
    -- @RespUpdAtomicNoState@ should be used, because executing a single command
    -- is cheaper than sending the whole state over the net.
    -- However, for the standalone exe mode, with clients in the same process
    -- as the server, a pointer to the state set with @execPutState@ is cheaper.
    handleResponse :: ( MonadClientSetup m
                      , MonadClientUI m
                      , MonadClientAtomic m
                      , MonadClientWriteRequest m )
                   => Response -> m ()
    handleResponse :: forall (m :: * -> *).
    (MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
     MonadClientWriteRequest m) =>
    Response -> m ()
    handleResponse Response
    cmd = case Response
    cmd of
      RespUpdAtomic State
    newState UpdAtomic
    cmdA -> do
        oldState <- m State
    forall (m :: * -> *). MonadStateRead m => m State
    getState
        execPutState newState
        cmdAtomicSemCli oldState cmdA
        hasUI <- clientHasUI
        when hasUI $ watchRespUpdAtomicUI cmdA
      RespUpdAtomicNoState UpdAtomic
    cmdA -> do
        oldState <- m State
    forall (m :: * -> *). MonadStateRead m => m State
    getState
        execUpdAtomic cmdA
        cmdAtomicSemCli oldState cmdA
        hasUI <- clientHasUI
        when hasUI $ watchRespUpdAtomicUI cmdA
      RespQueryAI ActorId
    aid -> do
        cmdC <- ActorId -> m RequestAI
    forall (m :: * -> *). MonadClient m => ActorId -> m RequestAI
    queryAI ActorId
    aid
        sendRequestAI cmdC
      RespSfxAtomic SfxAtomic
    sfx ->
        SfxAtomic -> m ()
    forall (m :: * -> *). MonadClientUI m => SfxAtomic -> m ()
    watchRespSfxAtomicUI SfxAtomic
    sfx
      Response
    RespQueryUIunderAI -> do
        req <- m RequestUI
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m RequestUI
    queryUIunderAI
        sendRequestUI req
      Response
    RespQueryUI -> do
        -- Stop displaying the prompt, if any.
        (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 = ReqDelayNot}
        sreqPending <- (SessionUI -> Maybe RequestUI) -> m (Maybe RequestUI)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe RequestUI
    sreqPending
        req <- case sreqPending of
          Maybe RequestUI
    Nothing -> do
            -- Server sending @RespQueryUI@ means that it's sent everything
            -- and is now ready to receive a request ASAP, so no point polling
            -- and instead query the player repeatedly until request generated.
            let loop :: m RequestUI
    loop = do
                  mreq <- m (Maybe RequestUI)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m (Maybe RequestUI)
    queryUI
                  maybe loop pure 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 = Nothing}
            RequestUI -> m RequestUI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RequestUI
    reqPending
        sendRequestUI req