content: {-# 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 cmd = case cmd of
    RespUpdAtomic newState cmdA -> do
      oldState <- getState
      execPutState newState
      cmdAtomicSemCli oldState cmdA
      hasUI <- clientHasUI
      when hasUI $ watchRespUpdAtomicUI cmdA
    RespUpdAtomicNoState cmdA -> do
      oldState <- getState
      execUpdAtomic cmdA
      cmdAtomicSemCli oldState cmdA
      hasUI <- clientHasUI
      when hasUI $ watchRespUpdAtomicUI cmdA
    RespQueryAI aid -> do
      cmdC <- queryAI aid
      sendRequestAI cmdC
    RespSfxAtomic sfx ->
      watchRespSfxAtomicUI sfx
    RespQueryUIunderAI -> do
      req <- queryUIunderAI
      sendRequestUI req
    RespQueryUI -> do
      -- Stop displaying the prompt, if any.
      modifySession $ \sess -> sess {sreqDelay = ReqDelayNot}
      sreqPending <- getsSession sreqPending
      req <- case sreqPending of
        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 = do
                mreq <- queryUI
                maybe loop pure mreq
          loop
        Just reqPending -> do
          modifySession $ \sess -> sess {sreqPending = Nothing}
          return reqPending
      sendRequestUI req
  