{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.LoopM
( MonadClientReadResponse(..)
, loopCli
#ifdef EXPOSE_INTERNAL
, initAI, initUI, loopAI, longestDelay, loopUI
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.HandleAtomicM
import Game.LambdaHack.Client.HandleResponseM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Response
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
class MonadClient m => MonadClientReadResponse m where
receiveResponse :: m Response
initAI :: MonadClient m => m ()
initAI :: m ()
initAI = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"AI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"initializing."
initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI :: CCUI -> m ()
initUI sccui :: CCUI
sccui@CCUI{ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen :: ScreenContent
coscreen} = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"UI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"initializing."
ChanFrontend
schanF <- ScreenContent -> ClientOptions -> m ChanFrontend
forall (m :: * -> *).
MonadClientUI m =>
ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend ScreenContent
coscreen ClientOptions
soptions
(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 {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
sccui}
loopCli :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> CCUI -> UIOptions -> ClientOptions -> Bool -> m ()
loopCli :: CCUI -> UIOptions -> ClientOptions -> Bool -> m ()
loopCli CCUI
ccui UIOptions
sUIOptions ClientOptions
clientOptions Bool
startsNewGame = do
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {soptions :: ClientOptions
soptions = ClientOptions
clientOptions}
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Bool
hasUI <- m Bool
forall (m :: * -> *). MonadClientWriteRequest m => m Bool
clientHasUI
if Bool -> Bool
not Bool
hasUI then m ()
forall (m :: * -> *). MonadClient m => m ()
initAI else CCUI -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
CCUI -> m ()
initUI CCUI
ccui
let cliendKindText :: Text
cliendKindText = if Bool -> Bool
not Bool
hasUI then Text
"AI" else Text
"UI"
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"starting 1/4."
Bool
restored <-
if Bool
startsNewGame Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasUI
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Maybe (StateClient, Maybe SessionUI)
restoredG <- m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe (StateClient, Maybe SessionUI))
tryRestore
case Maybe (StateClient, Maybe SessionUI)
restoredG of
Just (StateClient
cli, Maybe SessionUI
msess)-> do
case Maybe SessionUI
msess of
Just SessionUI
sess | Bool
hasUI -> do
ChanFrontend
schanF <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
CCUI
sccui <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
SessionUI -> m ()
forall (m :: * -> *). MonadClientUI m => SessionUI -> m ()
putSession (SessionUI -> m ()) -> SessionUI -> m ()
forall a b. (a -> b) -> a -> b
$ SessionUI
sess {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
sccui, UIOptions
sUIOptions :: UIOptions
sUIOptions :: UIOptions
sUIOptions}
Maybe SessionUI
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Bool
startsNewGame then
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
let noAnim :: Bool
noAnim = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool) -> ClientOptions -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ StateClient -> ClientOptions
soptions StateClient
cli
StateClient -> m ()
forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
cli {soptions :: ClientOptions
soptions = ClientOptions
clientOptions {snoAnim :: Maybe Bool
snoAnim = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noAnim}}
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe (StateClient, Maybe SessionUI)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"starting 2/4."
PrimArray PointI
tabA <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
PrimArray PointI
tabB <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {stabs :: (PrimArray PointI, PrimArray PointI)
stabs = (PrimArray PointI
tabA, PrimArray PointI
tabB)}
Response
cmd1 <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"starting 3/4."
case (Bool
restored, Bool
startsNewGame, Response
cmd1) of
(Bool
True, Bool
False, RespUpdAtomic State
_ UpdResume{}) ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool
True, Bool
True, RespUpdAtomic State
_ UpdRestart{}) ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
(Bool
False, Bool
False, RespUpdAtomic State
_ UpdResume{}) ->
[Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not usable."
[Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
(Bool
False, Bool
True, RespUpdAtomic State
_ UpdRestart{}) ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool
True, Bool
False, RespUpdAtomicNoState UpdResume{}) ->
m ()
forall a. HasCallStack => a
undefined
(Bool
True, Bool
True, RespUpdAtomicNoState UpdRestart{}) ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
(Bool
False, Bool
False, RespUpdAtomicNoState UpdResume{}) ->
[Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not usable."
[Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
(Bool
False, Bool
True, RespUpdAtomicNoState UpdRestart{}) ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool, Bool, Response)
_ -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected command" [Char] -> (FactionId, Bool, Response) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
side, Bool
restored, Response
cmd1)
Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd1
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"starting 4/4."
if Bool
hasUI
then POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
else m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
m ()
loopAI
FactionId
side2 <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side2
Text -> Text -> Text
<+> Text
"(initially" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") stopped."
loopAI :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> m ()
loopAI :: m ()
loopAI = do
Response
cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd
Bool
quit <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Bool
squit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit
m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
m ()
loopAI
longestDelay :: POSIXTime
longestDelay :: POSIXTime
longestDelay = Pico -> POSIXTime
secondsToNominalDiffTime Pico
1
loopUI :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> POSIXTime -> m ()
loopUI :: POSIXTime -> m ()
loopUI POSIXTime
timeSinceLastQuery = do
Maybe RequestUI
sreqPending <- (SessionUI -> Maybe RequestUI) -> m (Maybe RequestUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RequestUI
sreqPending
ReqDelay
sreqDelay <- (SessionUI -> ReqDelay) -> m ReqDelay
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ReqDelay
sreqDelay
Bool
sregainControl <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sregainControl
Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
let alarm :: Bool
alarm = POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
longestDelay
if | Bool -> Bool
not Bool
alarm
Bool -> Bool -> Bool
&&
(ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayNot
Bool -> Bool -> Bool
|| Bool
sregainControl
Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
keyPressed
Bool -> Bool -> Bool
&& ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
/= ReqDelay
ReqDelayHandled)) -> do
POSIXTime
timeBefore <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
Response
cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
POSIXTime
timeAfter <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd
Bool
quit <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Bool
squit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Response
cmd of
Response
RespQueryUI -> POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
Response
RespQueryUIunderAI ->
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXTime
forall a. Enum a => a -> a
succ POSIXTime
longestDelay
Response
_ -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isJust Maybe RequestUI
sreqPending) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
"Warning: server updated game state after current command was issued by the client but before it was received by the server."
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
timeBefore POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
timeAfter
| Bool -> Bool
not Bool
sregainControl Bool -> Bool -> Bool
&& (Bool
keyPressed
Bool -> Bool -> Bool
|| ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayHandled
Bool -> Bool -> Bool
|| Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isJust Maybe RequestUI
sreqPending) -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
if Faction -> Bool
gunderAI Faction
fact then
(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 {sregainControl :: Bool
sregainControl = Bool
True}
else do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
(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
ReqDelayHandled}
let msg :: Text
msg = if Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RequestUI
sreqPending
then Text
"Server delayed asking us for a command. Regardless, UI is made accessible. Press ESC twice to listen to server some more."
else Text
"Server delayed receiving a command from us. The command is cancelled. Issue a new one."
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
msg
Maybe RequestUI
mreqNew <- m (Maybe RequestUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe RequestUI)
queryUI
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Your client is listening to the server again."
m ()
forall (m :: * -> *). MonadClientUI m => m ()
pushReportFrame
(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
mreqNew}
(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}
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
| Bool
otherwise -> 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
ReqDelayAlarm}
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0