    -- | The main loop of the server, processing human and computer player
    -- moves turn by turn.
    module Game.LambdaHack.Server.LoopM
      ( loopSer
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip
      , manageCalmAndDomination, applyPeriodicLevel
      , handleTrajectories, hTrajectories, advanceTrajectory
      , handleActors, hActors, handleUIunderAI, dieSer, restartGame
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Client (ReqUI (..), Response (..))
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Analytics
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    import qualified Game.LambdaHack.Common.ItemAspect as IA
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Level
    import           Game.LambdaHack.Common.Misc
    import           Game.LambdaHack.Common.MonadStateRead
    import           Game.LambdaHack.Common.Perception
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import           Game.LambdaHack.Common.Vector
    import           Game.LambdaHack.Content.FactionKind
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Content.ModeKind
    import           Game.LambdaHack.Content.RuleKind
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Server.CommonM
    import           Game.LambdaHack.Server.HandleEffectM
    import           Game.LambdaHack.Server.HandleRequestM
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.PeriodicM
    import           Game.LambdaHack.Server.ProtocolM
    import           Game.LambdaHack.Server.ServerOptions
    import           Game.LambdaHack.Server.StartM
    import           Game.LambdaHack.Server.State

    -- | Start a game session, including the clients, and then loop,
    -- communicating with the clients.
    --
    -- The loop is started in server state that is empty, see 'emptyStateServer'.
    loopSer :: (MonadServerAtomic m, MonadServerComm m)
            => ServerOptions
                 -- ^ player-supplied server options
            -> (Bool -> FactionId -> ChanServer -> IO ())
                 -- ^ function that initializes a client and runs its main loop
            -> m ()
    loopSer :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    ServerOptions -> (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
    loopSer ServerOptions
    serverOptions Bool -> FactionId -> ChanServer -> IO ()
    executorClient = do
      -- Recover states and launch clients.
      (StateServer -> StateServer) -> m ()
    forall (m :: * -> *).
    MonadServer m =>
    (StateServer -> StateServer) -> m ()
    modifyServer ((StateServer -> StateServer) -> m ())
    -> (StateServer -> StateServer) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateServer
    ser -> StateServer
    ser { soptionsNxt = serverOptions
                                 , soptions = serverOptions }
      cops <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      let updConn Bool
    startsNewGame = (FactionId -> ChanServer -> IO ()) -> m ()
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    (FactionId -> ChanServer -> IO ()) -> m ()
    updateConn ((FactionId -> ChanServer -> IO ()) -> m ())
    -> (FactionId -> ChanServer -> IO ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> FactionId -> ChanServer -> IO ()
    executorClient Bool
    startsNewGame
      restored <- tryRestore
      case restored of
        Just (State
    sRaw, StateServer
    ser) | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ServerOptions -> Bool
    snewGameSer ServerOptions
    serverOptions -> do  -- a restored game
          UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ State -> UpdAtomic
    UpdResumeServer
                        (State -> UpdAtomic) -> State -> UpdAtomic
    forall a b. (a -> b) -> a -> b
    $ (COps -> COps) -> State -> State
    updateCOpsAndCachedData (COps -> COps -> COps
    forall a b. a -> b -> a
    const COps
    cops) State
    sRaw
          StateServer -> m ()
    forall (m :: * -> *). MonadServer m => StateServer -> m ()
    putServer StateServer
    ser {soptionsNxt = serverOptions}
          m ()
    forall (m :: * -> *). MonadServer m => m ()
    applyDebug
          factionD <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
          let f FactionId
    fid = let cmd :: UpdAtomic
    cmd = State -> UpdAtomic
    UpdResumeServer
                                (State -> UpdAtomic) -> State -> UpdAtomic
    forall a b. (a -> b) -> a -> b
    $ (COps -> COps) -> State -> State
    updateCOpsAndCachedData (COps -> COps -> COps
    forall a b. a -> b -> a
    const COps
    cops)
                                (State -> State) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ StateServer -> EnumMap FactionId State
    sclientStates StateServer
    ser EnumMap FactionId State -> FactionId -> State
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
                      in FactionId -> UpdAtomic -> m Bool
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> UpdAtomic -> m Bool
    execUpdAtomicFidCatch FactionId
    fid UpdAtomic
    cmd
          mapM_ (void <$> f) $ EM.keys factionD
          updConn False
          initPer
          pers <- getsServer sperFid
          let clear = Perception -> b -> Perception
    forall a b. a -> b -> a
    const Perception
    emptyPer
              persFid FactionId
    fid | ServerOptions -> Bool
    sknowEvents ServerOptions
    serverOptions = (Perception -> Perception)
    -> EnumMap LevelId Perception -> EnumMap LevelId Perception
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map Perception -> Perception
    forall {b}. b -> Perception
    clear (PerFid
    pers PerFid -> FactionId -> EnumMap LevelId Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid)
                          | Bool
    otherwise = PerFid
    pers PerFid -> FactionId -> EnumMap LevelId Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
          mapM_ (\FactionId
    fid -> FactionId -> UpdAtomic -> m ()
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    FactionId -> UpdAtomic -> m ()
    sendUpdate FactionId
    fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> EnumMap LevelId Perception -> UpdAtomic
    UpdResume FactionId
    fid (FactionId -> EnumMap LevelId Perception
    persFid FactionId
    fid))
                (EM.keys factionD)
          arenasNew <- arenasForLoop
          modifyServer $ \StateServer
    ser2 -> StateServer
    ser2 {sarenas = arenasNew, svalidArenas = True}
          -- We dump RNG seeds here, based on @soptionsNxt@, in case the game
          -- wasn't run with @--dumpInitRngs@ previously, but we need the seeds,
          -- e.g., to diagnose a crash.
          rngs <- getsServer srngs
          when (sdumpInitRngs serverOptions) $ dumpRngs rngs
        Maybe (State, StateServer)
    _ -> do  -- starting new game for this savefile (--newGame or fresh save)
          factionDold <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
          s <- gameReset serverOptions Nothing Nothing
                 -- get RNG from item boost
          -- Set up commandline options.
          let optionsBarRngs =
                ServerOptions
    serverOptions {sdungeonRng = Nothing, smainRng = Nothing}
          modifyServer $ \StateServer
    ser -> StateServer
    ser { soptionsNxt = optionsBarRngs
                                     , soptions = optionsBarRngs }
          execUpdAtomic $ UpdRestartServer s
          updConn True
          initPer
          reinitGame factionDold
          writeSaveAll False False
      loopUpd $ updConn True

    factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId)
    factionArena :: forall (m :: * -> *).
    MonadStateRead m =>
    Faction -> m (Maybe LevelId)
    factionArena Faction
    fact = case Faction -> Maybe ActorId
    gleader Faction
    fact of
      -- Even spawners need an active arena for their leader,
      -- or they start clogging stairs.
      Just ActorId
    leader -> do
        b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
        return $ Just $ blid b
      Maybe ActorId
    Nothing -> Maybe LevelId -> m (Maybe LevelId)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LevelId
    forall a. Maybe a
    Nothing
        -- This means Allure heroes can kill all aliens on lvl 4, retreat,
        -- hide and sleep on lvl 3 and they are guaranteed aliens don't spawn.
        -- However, animals still spawn, if slowly, and aliens resume
        -- spawning when heroes move on again.

    arenasForLoop :: MonadStateRead m => m (ES.EnumSet LevelId)
    {-# INLINE arenasForLoop #-}
    arenasForLoop :: forall (m :: * -> *). MonadStateRead m => m (EnumSet LevelId)
    arenasForLoop = do
      factionD <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
      marenas <- mapM factionArena $ EM.elems factionD
      let arenas = [LevelId] -> EnumSet LevelId
    forall k. Enum k => [k] -> EnumSet k
    ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
    forall a b. (a -> b) -> a -> b
    $ [Maybe LevelId] -> [LevelId]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe LevelId]
    marenas
          !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not (EnumSet LevelId -> Bool
    forall k. EnumSet k -> Bool
    ES.null EnumSet LevelId
    arenas)
                        Bool -> (String, FactionDict) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "game over not caught earlier"
                        String -> FactionDict -> (String, FactionDict)
    forall v. String -> v -> (String, v)
    `swith` FactionDict
    factionD) ()
      return $! arenas

    handleFidUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
                 => (FactionId -> m ()) -> FactionId -> Faction -> m ()
    {-# INLINE handleFidUpd #-}
    handleFidUpd :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    (FactionId -> m ()) -> FactionId -> Faction -> m ()
    handleFidUpd FactionId -> m ()
    updatePerFid FactionId
    fid Faction
    fact = do
      -- Update perception on all levels at once,
      -- in case a leader is changed to actor on another
      -- (possibly not even currently active) level.
      -- This runs for all factions even if save is requested by UI.
      -- Let players ponder new game state while the engine is busy saving.
      -- Also, this ensures perception before game save is exactly the same
      -- as at game resume, which is an invariant we check elsewhere.
      -- However, if perception is not updated after the action, the actor
      -- may not see his vicinity, so may not see enemy that displaces (or hits) him
      -- resulting in breaking the displace action and temporary leader loss,
      -- which is fine, though a bit alarming. So, we update it at the end.
      FactionId -> m ()
    updatePerFid FactionId
    fid
      -- Move a single actor only. Note that the skipped actors are not marked
      -- as waiting. Normally they will act in the next clip or the next few,
      -- so that's natural. But if there are dozens of them, this is wierd.
      -- E.g., they don't move, but still make nearby foes lose Calm.
      -- However, for KISS, we leave it be.
      --
      -- Bail out if immediate loop break- requested by UI. No check
      -- for @sbreakLoop@ needed, for the same reasons as in @handleActors@.
      let handle :: [LevelId] -> m Bool
          handle :: [LevelId] -> m Bool
    handle [] = Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
          handle (LevelId
    lid : [LevelId]
    rest) = do
            breakASAP <- (StateServer -> Bool) -> m Bool
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> Bool
    sbreakASAP
            if breakASAP
            then return False
            else do
              nonWaitMove <- handleActors lid fid
              if nonWaitMove
              then return True
              else handle rest
          killDying :: [LevelId] -> m ()
          killDying :: [LevelId] -> m ()
    killDying = (LevelId -> m ()) -> [LevelId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ LevelId -> m ()
    killDyingLid
          killDyingLid :: LevelId -> m ()
          killDyingLid :: LevelId -> m ()
    killDyingLid LevelId
    lid = do
            localTime <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
    forall a b. (a -> b) -> a -> b
    $ LevelId -> State -> Time
    getLocalTime LevelId
    lid
            levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime
            let l = ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(ActorId
    _, Time
    atime) -> Time
    atime Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Time
    localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
    -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap ActorId Time -> [(ActorId, Time)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap ActorId Time
    levelTime
                killAid (ActorId
    aid, b
    _) = do
                  b1 <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
                  when (bhp b1 <= 0) $ dieSer aid b1
            mapM_ killAid l
      -- Start on arena with leader, if available. This is crucial to ensure
      -- that no actor (even ours) moves before UI declares save(&exit).
      fa <- Faction -> m (Maybe LevelId)
    forall (m :: * -> *).
    MonadStateRead m =>
    Faction -> m (Maybe LevelId)
    factionArena Faction
    fact
      arenas <- getsServer sarenas
      let myArenas = case Maybe LevelId
    fa of
            Just LevelId
    myArena -> LevelId
    myArena LevelId -> [LevelId] -> [LevelId]
    forall a. a -> [a] -> [a]
    : LevelId -> [LevelId] -> [LevelId]
    forall a. Eq a => a -> [a] -> [a]
    delete LevelId
    myArena (EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems EnumSet LevelId
    arenas)
            Maybe LevelId
    Nothing -> EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems EnumSet LevelId
    arenas
      nonWaitMove <- handle myArenas
      breakASAP <- getsServer sbreakASAP
      unless breakASAP $ killDying myArenas
      -- We update perception at the end, see comment above. This is usually
      -- cheap, and when not, if it's AI faction, it's a waste, but if it's UI,
      -- that's exactly where it prevents lost attack messages, etc.
      -- If the move was a wait, perception unchanged, so no need to update,
      -- unless the actor starts sleeping, in which case his perception
      -- is reduced a bit later, so no harm done.
      when nonWaitMove $ updatePerFid fid

    -- | Handle a clip (the smallest fraction of a game turn for which a frame may
    -- potentially be generated). Run the leader and other actors moves.
    -- Eventually advance the time and repeat.
    loopUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
            => m () -> m ()
    loopUpd :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    m () -> m ()
    loopUpd m ()
    updConn = do
      let updatePerFid :: FactionId -> m ()
          {-# NOINLINE updatePerFid #-}
          updatePerFid :: FactionId -> m ()
    updatePerFid FactionId
    fid = do  -- {-# SCC updatePerFid #-} do
            perValid <- (StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool)
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool))
    -> (StateServer -> EnumMap LevelId Bool)
    -> m (EnumMap LevelId Bool)
    forall a b. (a -> b) -> a -> b
    $ (EnumMap FactionId (EnumMap LevelId Bool)
    -> FactionId -> EnumMap LevelId Bool
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (EnumMap FactionId (EnumMap LevelId Bool) -> EnumMap LevelId Bool)
    -> (StateServer -> EnumMap FactionId (EnumMap LevelId Bool))
    -> StateServer
    -> EnumMap LevelId Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> EnumMap FactionId (EnumMap LevelId Bool)
    sperValidFid
            mapM_ (\(LevelId
    lid, Bool
    valid) -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    valid (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> LevelId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> m ()
    updatePer FactionId
    fid LevelId
    lid)
                  (EM.assocs perValid)
          handleFid :: (FactionId, Faction) -> m ()
          {-# NOINLINE handleFid #-}
          handleFid :: (FactionId, Faction) -> m ()
    handleFid (FactionId
    fid, Faction
    fact) = do
            breakASAP <- (StateServer -> Bool) -> m Bool
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> Bool
    sbreakASAP
            -- Don't process other factions, even their perceptions,
            -- if UI saves and/or exits.
            unless breakASAP $ handleFidUpd updatePerFid fid fact
          loopConditionally :: m ()
    loopConditionally = do
            factionD <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
            -- Update perception one last time to satisfy save/resume assertions,
            -- because we may get here at arbitrary moment due to game over
            -- and so have outdated perception.
            mapM_ updatePerFid (EM.keys factionD)
            modifyServer $ \StateServer
    ser -> StateServer
    ser { sbreakLoop = False
                                       , sbreakASAP = False }
            endOrLoop loopUpdConn (restartGame updConn loopUpdConn)
          loopUpdConn :: m ()
    loopUpdConn = do
            factionD <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
            -- Start handling actors with the single UI faction,
            -- to safely save/exit. Note that this hack fails if there are many UI
            -- factions (when we reenable multiplayer). Then players will request
            -- save&exit and others will vote on it and it will happen
            -- after the clip has ended, not at the start.
            -- Note that at most a single actor with a time-consuming action
            -- is processed per faction, so it's fair, but many loops are needed.
            let hasUI (a
    _, Faction
    fact) = FactionKind -> Bool
    fhasUI (Faction -> FactionKind
    gkind Faction
    fact)
                (factionUI, factionsRest) = case break hasUI $ EM.assocs factionD of
                  ([(FactionId, Faction)]
    noUI1, (FactionId, Faction)
    ui : [(FactionId, Faction)]
    noUI2) -> ((FactionId, Faction)
    ui, [(FactionId, Faction)]
    noUI1 [(FactionId, Faction)]
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. [a] -> [a] -> [a]
    ++ [(FactionId, Faction)]
    noUI2)
                  ([(FactionId, Faction)], [(FactionId, Faction)])
    _ -> String -> ((FactionId, Faction), [(FactionId, Faction)])
    forall a. (?callStack::CallStack) => String -> a
    error String
    "no UI faction in the game"
            mapM_ handleFid $ factionUI : factionsRest
            breakASAP <- getsServer sbreakASAP
            breakLoop <- getsServer sbreakLoop
            if breakASAP || breakLoop
            then loopConditionally
            else do
              -- Projectiles are processed last and not at all if the UI leader
              -- decides to save or exit or restart or if there is game over.
              -- This and UI leader acting before any other ordinary actors
              -- ensures state is not changed and so the clip doesn't need
              -- to be carried through before save.
              arenas <- getsServer sarenas
              mapM_ (\FactionId
    fid -> (LevelId -> m ()) -> [LevelId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (LevelId -> FactionId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    LevelId -> FactionId -> m ()
    `handleTrajectories` FactionId
    fid) ([LevelId] -> m ()) -> [LevelId] -> m ()
    forall a b. (a -> b) -> a -> b
    $ EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems EnumSet LevelId
    arenas)
                    (EM.keys factionD)
              endClip updatePerFid  -- must be last, in case performs a bkp save
              -- The condition can be changed in @handleTrajectories@ by pushing
              -- onto an escape and in @endClip@.
              breakLoop2 <- getsServer sbreakLoop
              if breakLoop2
              then loopConditionally
              else loopUpdConn  -- process next iteration unconditionally
      m ()
    loopUpdConn

    -- | Handle the end of every clip. Do whatever has to be done
    -- every fixed number of clips, e.g., monster generation.
    -- Advance time. Perform periodic saves, if applicable.
    --
    -- This is never run if UI requested save or exit or restart and it's correct,
    -- because we know nobody moved and no time was or needs to be advanced
    -- and arenas are not changed. After game was saved and exited,
    -- on game resume the first clip is performed with empty arenas,
    -- so arena time is not updated and nobody moves, nor anything happens,
    -- but arenas are here correctly updated.
    endClip :: forall m. MonadServerAtomic m => (FactionId -> m ()) -> m ()
    {-# INLINE endClip #-}
    endClip :: forall (m :: * -> *).
    MonadServerAtomic m =>
    (FactionId -> m ()) -> m ()
    endClip FactionId -> m ()
    updatePerFid = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      time <- getsState stime
      let clipN = Time
    time Time -> Time -> Int
    `timeFit` Time
    timeClip
      -- No check if @sbreakASAP@ is set, because then the function is not called.
      breakLoop <- getsServer sbreakLoop
      -- We don't send a lot of useless info to the client if the game has already
      -- ended. At best wasteful, at worst the player sees strange messages.
      unless breakLoop $ do
        -- I need to send time updates, because I can't add time to each command,
        -- because I'd need to send also all arenas, which should be updated,
        -- and this is too expensive data for each, e.g., projectile move.
        -- I send even if nothing changes so that UI time display can progress.
        -- Possibly @arenas@ are invalid here, but all moves were performed
        -- according to this value, so time should be replenished according
        -- to this value as well.
        -- This is crucial, because tiny time discrepancies can accumulate
        -- magnified by hunders of actors that share the clip slots due to the
        -- restriction that at most one faction member acts each clip.
        arenas <- getsServer sarenas
        execUpdAtomic $ UpdAgeGame arenas
        -- Perform periodic dungeon maintenance.
        when (clipN `mod` rleadLevelClips corule == 0) leadLevelSwitch
        case clipN `mod` clipsInTurn of
          Int
    0 ->
            -- Spawn monsters at most once per 3 turns.
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    clipN Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    clipsInTurn) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0)
              m ()
    forall (m :: * -> *). MonadServerAtomic m => m ()
    spawnMonster
          Int
    4 ->
            -- Periodic activation only once per turn, for speed,
            -- but on all active arenas. Calm updates and domination
            -- happen there as well. Once per turn is too rare for accurate
            -- expiration of short conditions, e.g., 1-turn haste. TODO.
            m ()
    forall (m :: * -> *). MonadServerAtomic m => m ()
    applyPeriodicLevel
          Int
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      -- @applyPeriodicLevel@ might have, e.g., dominated actors, ending the game.
      -- It could not have unended the game, though.
      breakLoop2 <- getsServer sbreakLoop
      unless breakLoop2 $ do
        -- Possibly a leader change due to @leadLevelSwitch@, so update arenas here
        -- for 100% accuracy at least at the start of actor moves, before they
        -- change leaders as part of their moves.
        --
        -- After game resume, this is the first non-vacuus computation.
        -- Next call to @loopUpdConn@ really moves actors and updates arena times
        -- so we start in exactly the same place that UI save ended in.
        validArenas <- getsServer svalidArenas
        unless validArenas $ do
          arenasNew <- arenasForLoop
          modifyServer $ \StateServer
    ser -> StateServer
    ser {sarenas = arenasNew, svalidArenas = True}
      -- Update all perception for visual feedback and to make sure saving
      -- and resuming game doesn't affect gameplay (by updating perception).
      -- Perception updates in @handleFidUpd@ are not enough, because
      -- periodic actions could have invalidated them.
      factionD <- getsState sfactionD
      mapM_ updatePerFid (EM.keys factionD)
      -- Saving on the browser causes a huge lag, hence autosave disabled.
    #ifndef USE_JSFILE
      unless breakLoop2 $  -- if by chance requested and periodic saves coincide
        -- Periodic save needs to be at the end, so that restore can start
        -- at the beginning. Double save on first turn is avoided with @succ@.
        when (succ clipN `mod` rwriteSaveClips corule == 0) $
          writeSaveAll False False
    #endif

    -- | Check if the given actor is dominated and update his calm.
    manageCalmAndDomination :: MonadServerAtomic m => ActorId -> Actor -> m ()
    manageCalmAndDomination :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    manageCalmAndDomination ActorId
    aid Actor
    b = do
      performedDomination <-
        if Actor -> Int64
    bcalm Actor
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 then Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False else do  -- triggered by zeroed Calm
          hiImpression <- Actor -> m (Maybe (FactionId, Int))
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Actor -> m (Maybe (FactionId, Int))
    highestImpression Actor
    b
          case hiImpression of
            Maybe (FactionId, Int)
    Nothing -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Just (FactionId
    hiImpressionFid, Int
    hiImpressionK) -> do
              fact <- (State -> Faction) -> m Faction
    forall a. (State -> a) -> m a
    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
    $ (FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b) (FactionDict -> Faction)
    -> (State -> FactionDict) -> State -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> FactionDict
    sfactionD
              if fhasPointman (gkind fact)
                   -- animals/robots/human drones never Calm-dominated
                 || hiImpressionK >= 10
                   -- unless very high impression, e.g., in a dominated hero
              then dominateFidSfx aid aid (btrunk b) hiImpressionFid
              else return False
      unless performedDomination $ do
        newCalmDelta <- getsState $ regenCalmDelta aid b
        unless (newCalmDelta == 0) $
          -- Update delta for the current player turn.
          updateCalm aid newCalmDelta

    -- | Trigger periodic items for all actors on the given level.
    applyPeriodicLevel :: MonadServerAtomic m => m ()
    applyPeriodicLevel :: forall (m :: * -> *). MonadServerAtomic m => m ()
    applyPeriodicLevel = do
      arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> EnumSet LevelId
    sarenas
      let applyPeriodicItem ActorId
    _ CStore
    _ (ItemId
    _, (a
    _, [])) = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            -- periodic items always have at least one timer
          applyPeriodicItem ActorId
    aid CStore
    cstore (ItemId
    iid, (a, [a])
    _) = do
            itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
            let arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
            when (IA.checkFlag Ability.Periodic arItem) $ do
              -- Check if the item is still in the bag (previous items act!).
              b2 <- getsState $ getActorBody aid
              bag <- getsState $ getBodyStoreBag b2 cstore
              case iid `EM.lookup` bag of
                Maybe ItemQuant
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- item dropped
                Just (Int
    k, ItemTimers
    _) -> do
                  -- Activate even if effects null or vacuous, to possibly
                  -- destroy the item.
                  let effApplyFlags :: EffApplyFlags
    effApplyFlags = EffApplyFlags
                        { effToUse :: EffToUse
    effToUse            = EffToUse
    EffBare  -- no periodic crafting
                        , effVoluntary :: Bool
    effVoluntary        = Bool
    True
                        , effUseAllCopies :: Bool
    effUseAllCopies     = Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
                        , effKineticPerformed :: Bool
    effKineticPerformed = Bool
    False
                        , effActivation :: ActivationFlag
    effActivation       = ActivationFlag
    Ability.ActivationPeriodic
                        , effMayDestroy :: Bool
    effMayDestroy       = Bool
    True
                        }
                  m UseResult -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m UseResult -> m ()) -> m UseResult -> m ()
    forall a b. (a -> b) -> a -> b
    $ EffApplyFlags
    -> ActorId
    -> ActorId
    -> ActorId
    -> ItemId
    -> Container
    -> ItemFull
    -> m UseResult
    forall (m :: * -> *).
    MonadServerAtomic m =>
    EffApplyFlags
    -> ActorId
    -> ActorId
    -> ActorId
    -> ItemId
    -> Container
    -> ItemFull
    -> m UseResult
    effectAndDestroyAndAddKill
                           EffApplyFlags
    effApplyFlags
                           ActorId
    aid ActorId
    aid ActorId
    aid ItemId
    iid (ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    cstore) ItemFull
    itemFull
          applyPeriodicActor (ActorId
    aid, Actor
    b) =
            -- While it's fun when projectiles flash or speed up mid-air,
            -- it's very exotic and quite time-intensive whenever hundreds
            -- of projectiles exist due to ongoing explosions.
            -- Nothing activates when actor dying to prevent a regenerating
            -- actor from resurrecting each turn, resulting in silly gameover stats.
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    b) Bool -> Bool -> Bool
    && Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0 Bool -> Bool -> Bool
    && Actor -> LevelId
    blid Actor
    b LevelId -> EnumSet LevelId -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet LevelId
    arenas) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              -- Equipment goes first, to refresh organs before they expire,
              -- to avoid the message that organ expired.
              ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
    forall {m :: * -> *} {a} {a}.
    MonadServerAtomic m =>
    ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
    applyPeriodicItem ActorId
    aid CStore
    CEqp) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [(ItemId, ItemQuant)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
    -> ItemBag -> [(ItemId, ItemQuant)]
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemBag
    beqp Actor
    b
              ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
    forall {m :: * -> *} {a} {a}.
    MonadServerAtomic m =>
    ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
    applyPeriodicItem ActorId
    aid CStore
    COrgan) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [(ItemId, ItemQuant)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
    -> ItemBag -> [(ItemId, ItemQuant)]
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemBag
    borgan Actor
    b
              -- While we are at it, also update his Calm.
              ActorId -> Actor -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    manageCalmAndDomination ActorId
    aid Actor
    b
      allActors <- getsState sactorD
      mapM_ applyPeriodicActor $ EM.assocs allActors

    handleTrajectories :: MonadServerAtomic m => LevelId -> FactionId -> m ()
    handleTrajectories :: forall (m :: * -> *).
    MonadServerAtomic m =>
    LevelId -> FactionId -> m ()
    handleTrajectories LevelId
    lid FactionId
    fid = do
      localTime <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
    forall a b. (a -> b) -> a -> b
    $ LevelId -> State -> Time
    getLocalTime LevelId
    lid
      levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . strajTime
      let l = [ActorId] -> [ActorId]
    forall a. Ord a => [a] -> [a]
    sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
    forall a b. (a -> b) -> [a] -> [b]
    map (ActorId, Time) -> ActorId
    forall a b. (a, b) -> a
    fst
              ([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(ActorId
    _, Time
    atime) -> Time
    atime Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Time
    localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
    -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap ActorId Time -> [(ActorId, Time)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap ActorId Time
    levelTime
      -- The @strajTime@ map may be outdated before @hTrajectories@
      -- call (due to other actors following their trajectories),
      -- so it's only used to decide which actors are processed in this
      -- @handleTrajectories@ call. If an actor is added to the map,
      -- the recursive call to @handleTrajectories@ will detect that
      -- and process him later on.
      -- If the actor is no longer on the level or no longer belongs
      -- to the faction, it is nevertheless processed without a problem.
      -- We are guaranteed the actor still exists.
      mapM_ hTrajectories l
      -- Avoid frames between fadeout and fadein.
      breakLoop <- getsServer sbreakLoop
      unless (null l || breakLoop) $
        handleTrajectories lid fid  -- for speeds > tile/clip

    hTrajectories :: MonadServerAtomic m => ActorId -> m ()
    {-# INLINE hTrajectories #-}
    hTrajectories :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    hTrajectories ActorId
    aid = do
      b1 <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      let removePushed Actor
    b =
            -- No longer fulfills criteria and was not removed by dying; remove him.
            (StateServer -> StateServer) -> m ()
    forall (m :: * -> *).
    MonadServer m =>
    (StateServer -> StateServer) -> m ()
    modifyServer ((StateServer -> StateServer) -> m ())
    -> (StateServer -> StateServer) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateServer
    ser ->
              StateServer
    ser { strajTime =
                      EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b)
                                (strajTime ser)
                  , strajPushedBy = EM.delete aid (strajPushedBy ser) }
          removeTrajectory Actor
    b =
            -- Non-projectile actor stops flying (a projectile with empty trajectory
            -- would be intercepted earlier on as dead).
            -- Will be removed from @strajTime@ in recursive call
            -- to @handleTrajectories@.
            Bool -> m () -> m ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Bool
    bproj Actor
    b)
            (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b) Maybe ([Vector], Speed)
    forall a. Maybe a
    Nothing
      breakLoop <- getsServer sbreakLoop
      if breakLoop then return ()  -- don't move if game over via pushing
      else if actorDying b1 then dieSer aid b1
      else case btrajectory b1 of
        Maybe ([Vector], Speed)
    Nothing -> Actor -> m ()
    removePushed Actor
    b1
        Just ([], Speed
    _) -> Actor -> m ()
    removeTrajectory Actor
    b1 m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Actor -> m ()
    removePushed Actor
    b1
        Just{} -> do
          ActorId -> Actor -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    advanceTrajectory ActorId
    aid Actor
    b1
          -- Here, @advanceTrajectory@ might have affected @actorDying@,
          -- so we check again ASAP to make sure the body of the projectile
          -- (or pushed actor) doesn't block movement of other actors,
          -- but vanishes promptly.
          -- Bodies of actors that die not flying remain on the battlefied until
          -- their natural next turn, to give them a chance of rescue.
          -- Note that domination of pushed actors is not checked
          -- nor is their calm updated. They are helpless wrt movement,
          -- but also invulnerable in this respect.
          b2 <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
          if actorDying b2
          then dieSer aid b2
          else case btrajectory b2 of
            Maybe ([Vector], Speed)
    Nothing -> Actor -> m ()
    removePushed Actor
    b2
            Just ([], Speed
    _) -> Actor -> m ()
    removeTrajectory Actor
    b2 m () -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Actor -> m ()
    removePushed Actor
    b2
            Just{} -> -- delay next iteration only if still flying
              ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    advanceTimeTraj ActorId
    aid
      -- if @actorDying@ due to @bhp b <= 0@:
      -- If @b@ is a projectile, it means hits an actor or is hit by actor.
      -- Then the carried item is destroyed and that's all.
      -- If @b@ is not projectile, it dies, his items drop to the ground
      -- and possibly a new leader is elected.
      --
      -- if @actorDying@ due to @btrajectory@ null:
      -- A projectile drops to the ground due to obstacles or range.
      -- The carried item is not destroyed, unless it's fragile,
      -- but drops to the ground.

    -- | Manage trajectory of a projectile or a pushed other actor.
    --
    -- Colliding with a wall or actor doesn't take time, because
    -- the projectile does not move (the move is blocked).
    -- Not advancing time forces dead projectiles to be destroyed ASAP.
    -- Otherwise, with some timings, it can stay on the game map dead,
    -- blocking path of human-controlled actors and alarming the hapless human.
    advanceTrajectory :: MonadServerAtomic m => ActorId -> Actor -> m ()
    advanceTrajectory :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    advanceTrajectory ActorId
    aid Actor
    b1 = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lvl <- getLevel $ blid b1
      arTrunk <- getsState $ (EM.! btrunk b1) . sdiscoAspect
      let registerKill KillHow
    killHow =
            -- Kill counts for each blast particle is TMI.
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Actor -> Bool
    bproj Actor
    b1
                  Bool -> Bool -> Bool
    && Bool -> Bool
    not (Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arTrunk)) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              killer <- (StateServer -> ActorId) -> m ActorId
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> ActorId) -> m ActorId)
    -> (StateServer -> ActorId) -> m ActorId
    forall a b. (a -> b) -> a -> b
    $ ActorId -> ActorId -> EnumMap ActorId ActorId -> ActorId
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault ActorId
    aid ActorId
    aid (EnumMap ActorId ActorId -> ActorId)
    -> (StateServer -> EnumMap ActorId ActorId)
    -> StateServer
    -> ActorId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> EnumMap ActorId ActorId
    strajPushedBy
              addKillToAnalytics killer killHow (bfid b1) (btrunk b1)
      case btrajectory b1 of
        Just (Vector
    d : [Vector]
    lv, Speed
    speed) -> do
          let tpos :: Point
    tpos = Actor -> Point
    bpos Actor
    b1 Point -> Vector -> Point
    `shift` Vector
    d  -- target position
          if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos then do
               -- Hit will clear trajectories in @reqMelee@,
               -- so no need to do that here.
               UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b1) (([Vector], Speed) -> Maybe ([Vector], Speed)
    forall a. a -> Maybe a
    Just ([Vector]
    lv, Speed
    speed))
               Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Vector] -> Bool
    forall a. [a] -> Bool
    null [Vector]
    lv) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ KillHow -> m ()
    registerKill KillHow
    KillDropLaunch
               let occupied :: Bool
    occupied = Point -> Level -> Bool
    occupiedBigLvl Point
    tpos Level
    lvl Bool -> Bool -> Bool
    || Point -> Level -> Bool
    occupiedProjLvl Point
    tpos Level
    lvl
                   reqMoveHit :: m ()
    reqMoveHit = Bool -> Bool -> ActorId -> Vector -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> Bool -> ActorId -> Vector -> m ()
    reqMoveGeneric Bool
    False Bool
    True ActorId
    aid Vector
    d
                   reqDisp :: ActorId -> m ()
    reqDisp = Bool -> ActorId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> m ()
    reqDisplaceGeneric Bool
    False ActorId
    aid
               if | Actor -> Bool
    bproj Actor
    b1 -> m ()
    reqMoveHit  -- projectiles always hit
                  | Bool
    occupied ->
                    -- Non-projectiles displace if they are ending their flight
                    -- or if only a projectile is in the way.
                    -- So, no chaos of displacing a whole line of enemies.
                    case (Point -> Level -> Maybe ActorId
    posToBigLvl Point
    tpos Level
    lvl, Point -> Level -> [ActorId]
    posToProjsLvl Point
    tpos Level
    lvl) of
                      (Maybe ActorId
    Nothing, []) -> String -> m ()
    forall a. (?callStack::CallStack) => String -> a
    error String
    "advanceTrajectory: not occupied"
                      (Maybe ActorId
    Nothing, [ActorId
    target]) -> ActorId -> m ()
    reqDisp ActorId
    target
                      (Maybe ActorId
    Nothing, [ActorId]
    _) -> m ()
    reqMoveHit  -- can't displace multiple
                      (Just ActorId
    target, []) ->
                        if [Vector] -> Bool
    forall a. [a] -> Bool
    null [Vector]
    lv then ActorId -> m ()
    reqDisp ActorId
    target else m ()
    reqMoveHit
                      (Just ActorId
    _, [ActorId]
    _) -> m ()
    reqMoveHit  -- can't displace multiple
                  | Bool
    otherwise -> m ()
    reqMoveHit  -- if not occupied, just move
          else do
               -- Will be removed from @strajTime@ in recursive call
               -- to @handleTrajectories@.
               Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Actor -> Bool
    bproj Actor
    b1) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                 SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Point -> SfxAtomic
    SfxCollideTile ActorId
    aid Point
    tpos
               embedsPre <- (State -> ItemBag) -> m ItemBag
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemBag) -> m ItemBag)
    -> (State -> ItemBag) -> m ItemBag
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Point -> State -> ItemBag
    getEmbedBag (Actor -> LevelId
    blid Actor
    b1) Point
    tpos
               -- No crafting by projectiles that bump tiles nor by pushed actors.
               -- The only way is if they land in a tile (are engulfed by it)
               -- and have enough skill. But projectiles transform when hitting,
               -- if terrain permits, not just bump off the obstacle.
               mfail <- reqAlterFail (not $ bproj b1) EffBare False aid tpos
               embedsPost <- getsState $ getEmbedBag (blid b1) tpos
               b2 <- getsState $ getActorBody aid
               let tpos2 = Actor -> Point
    bpos Actor
    b2 Point -> Vector -> Point
    `shift` Vector
    d  -- possibly another level and/or bpos
               lvl2 <- getLevel $ blid b2
               case mfail of
                 Maybe ReqFailure
    Nothing | TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl2 Level -> Point -> ContentId TileKind
    `at` Point
    tpos2 ->
                   -- Too late to announce anything, but given that the way
                   -- is opened, continue flight. Don't even normally lose any HP,
                   -- because it's not a hard collision, but altering.
                   -- However, if embed was possibly triggered/removed, lose HP.
                   if ItemBag
    embedsPre ItemBag -> ItemBag -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ItemBag
    embedsPost Bool -> Bool -> Bool
    && Bool -> Bool
    not (ItemBag -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null ItemBag
    embedsPre) then
                     if Actor -> Int64
    bhp Actor
    b2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    oneM then do
                       UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Int64 -> UpdAtomic
    UpdRefillHP ActorId
    aid Int64
    minusM
                       b3 <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
                       advanceTrajectory aid b3
                     else do
                       -- Projectile has too low HP to pierce; terminate its flight.
                       UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b2)
                                     (Maybe ([Vector], Speed) -> UpdAtomic)
    -> Maybe ([Vector], Speed) -> UpdAtomic
    forall a b. (a -> b) -> a -> b
    $ ([Vector], Speed) -> Maybe ([Vector], Speed)
    forall a. a -> Maybe a
    Just ([], Speed
    speed)
                       KillHow -> m ()
    registerKill KillHow
    KillTileLaunch
                   else
                     -- Try again with the cleared path and possibly actors
                     -- spawned in the way, etc.
                     ActorId -> Actor -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    advanceTrajectory ActorId
    aid Actor
    b2
                 Maybe ReqFailure
    _ -> do
                   -- Altering failed to open the passage, probably just a wall,
                   -- so lose HP due to being pushed into an obstacle.
                   -- Never kill in this way.
                   -- Note that sometimes this may come already after one faction
                   -- wins the game and end game screens are show. This is OK-ish.
                   -- @Nothing@ trajectory of signals an obstacle hit.
                   -- If projectile, second call of @actorDying@ above
                   -- will take care of dropping dead.
                   UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b2) Maybe ([Vector], Speed)
    forall a. Maybe a
    Nothing
                   -- If projectile, losing HP due to hitting an obstacle
                   -- not needed, because trajectory is halted, so projectile
                   -- will die soon anyway
                   if Actor -> Bool
    bproj Actor
    b2
                   then KillHow -> m ()
    registerKill KillHow
    KillTileLaunch
                   else Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Actor -> Int64
    bhp Actor
    b2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    oneM) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                     UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Int64 -> UpdAtomic
    UpdRefillHP ActorId
    aid Int64
    minusM
                     let effect :: Effect
    effect = Int -> Effect
    IK.RefillHP (-Int
    2)  -- -2 is a lie to ensure display
                     SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
    SfxEffect (Actor -> FactionId
    bfid Actor
    b2) ActorId
    aid (Actor -> ItemId
    btrunk Actor
    b2) Effect
    effect (-Int64
    1)
        Maybe ([Vector], Speed)
    _ -> String -> m ()
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Nothing or empty trajectory" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b1)

    handleActors :: (MonadServerAtomic m, MonadServerComm m)
                 => LevelId -> FactionId -> m Bool
    handleActors :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    LevelId -> FactionId -> m Bool
    handleActors LevelId
    lid FactionId
    fid = do
      localTime <- (State -> Time) -> m Time
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
    forall a b. (a -> b) -> a -> b
    $ LevelId -> State -> Time
    getLocalTime LevelId
    lid
      levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime
      let l = [ActorId] -> [ActorId]
    forall a. Ord a => [a] -> [a]
    sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
    forall a b. (a -> b) -> [a] -> [b]
    map (ActorId, Time) -> ActorId
    forall a b. (a, b) -> a
    fst
              ([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(ActorId
    _, Time
    atime) -> Time
    atime Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Time
    localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
    -> [(ActorId, Time)] -> [(ActorId, Time)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap ActorId Time -> [(ActorId, Time)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap ActorId Time
    levelTime
      -- The @sactorTime@ map may be outdated before @hActors@
      -- call (due to other actors on the list acting),
      -- so it's only used to decide which actors are processed in this call.
      -- If the actor is no longer on the level or no longer belongs
      -- to the faction, it is nevertheless processed without a problem
      -- (the client may act wrt slightly outdated Perception and that's all).
      -- We are guaranteed the actor still exists.
      mleader <- getsState $ gleader . (EM.! fid) . sfactionD
      -- Leader acts first, so that UI leader can save&exit before state changes.
      hActors $ case mleader of
        Just ActorId
    aid | ActorId
    aid ActorId -> [ActorId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ActorId]
    l -> ActorId
    aid ActorId -> [ActorId] -> [ActorId]
    forall a. a -> [a] -> [a]
    : ActorId -> [ActorId] -> [ActorId]
    forall a. Eq a => a -> [a] -> [a]
    delete ActorId
    aid [ActorId]
    l
        Maybe ActorId
    _ -> [ActorId]
    l

    hActors :: forall m. (MonadServerAtomic m, MonadServerComm m)
            => [ActorId] -> m Bool
    hActors :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    [ActorId] -> m Bool
    hActors [] = Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    hActors as :: [ActorId]
    as@(ActorId
    aid : [ActorId]
    rest) = do
     b1 <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
     let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Bool
    bproj Actor
    b1) ()
     if bhp b1 <= 0 then
       -- Will be killed in a later pass, making it possible to revive him now.
       hActors rest
     else do
      let side = Actor -> FactionId
    bfid Actor
    b1
      fact <- getsState $ (EM.! side) . sfactionD
      breakLoop <- getsServer sbreakLoop
      let mleader = Faction -> Maybe ActorId
    gleader Faction
    fact
          aidIsLeader = Maybe ActorId
    mleader Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    aid
          mainUIactor = FactionKind -> Bool
    fhasUI (Faction -> FactionKind
    gkind Faction
    fact)
                        Bool -> Bool -> Bool
    && (Bool
    aidIsLeader Bool -> Bool -> Bool
    || Bool -> Bool
    not (FactionKind -> Bool
    fhasPointman (Faction -> FactionKind
    gkind Faction
    fact)))
          -- Checking @breakLoop@, to avoid doubly setting faction status to Camping
          -- in case AI-controlled UI client asks to exit game at exactly
          -- the same moment as natural game over was detected.
          mainUIunderAI = Bool
    mainUIactor Bool -> Bool -> Bool
    && Faction -> Bool
    gunderAI Faction
    fact Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    breakLoop
      when mainUIunderAI $
        handleUIunderAI side aid
      factNew <- getsState $ (EM.! side) . sfactionD
      let doQueryAI = Bool -> Bool
    not Bool
    mainUIactor Bool -> Bool -> Bool
    || Faction -> Bool
    gunderAI Faction
    factNew
      breakASAP <- getsServer sbreakASAP
      -- If breaking out of the game loop, pretend there was a non-wait move.
      -- we don't need additionally to check @sbreakLoop@, because it occurs alone
      -- only via action of an actor and at most one action is performed here.
      if breakASAP then return True else do
        let mswitchLeader :: Maybe ActorId -> m ActorId
            {-# NOINLINE mswitchLeader #-}
            mswitchLeader (Just ActorId
    aidNew) = FactionId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> m ()
    switchLeader FactionId
    side ActorId
    aidNew m () -> m ActorId -> m ActorId
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ActorId -> m ActorId
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActorId
    aidNew
            mswitchLeader Maybe ActorId
    Nothing = ActorId -> m ActorId
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActorId
    aid
        (aidNew, mtimed) <-
          if doQueryAI then do
            (cmd, maid) <- sendQueryAI side aid
            aidNew <- mswitchLeader maid
            mtimed <- handleRequestAI cmd
            return (aidNew, mtimed)
          else do
            (cmd, maid) <- sendQueryUI RespQueryUI side aid
            aidNew <- mswitchLeader maid
            mtimed <- handleRequestUI side aidNew cmd
            return (aidNew, mtimed)
        case mtimed of
          Just RequestTimed
    timed -> do
            nonWaitMove <- FactionId -> ActorId -> RequestTimed -> m Bool
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> RequestTimed -> m Bool
    handleRequestTimed FactionId
    side ActorId
    aidNew RequestTimed
    timed
            -- Even if the actor got a free turn of time via a scroll,
            -- he will not act again this clip, only next clip.
            -- Clip is small, so not a big deal and it's faster and avoids
            -- complete game time freezes, e.g., due to an exploit.
            if nonWaitMove then return True else hActors rest
          Maybe RequestTimed
    Nothing -> do
            breakASAP2 <- (StateServer -> Bool) -> m Bool
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> Bool
    sbreakASAP
            -- If breaking out of the game lopp, pretend there was a non-wait move.
            if breakASAP2 then return True else hActors as

    handleUIunderAI :: (MonadServerAtomic m, MonadServerComm m)
                    => FactionId -> ActorId -> m ()
    handleUIunderAI :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    FactionId -> ActorId -> m ()
    handleUIunderAI FactionId
    side ActorId
    aid = do
      cmdS <- Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
    sendQueryUI Response
    RespQueryUIunderAI FactionId
    side ActorId
    aid
      case fst cmdS of
        ReqUI
    ReqUINop -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        ReqUI
    ReqUIAutomate -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> Bool -> UpdAtomic
    UpdAutoFaction FactionId
    side Bool
    False
        ReqUI
    ReqUIGameDropAndExit -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameDropAndExit ActorId
    aid
        ReqUI
    ReqUIGameSaveAndExit -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameSaveAndExit ActorId
    aid
        ReqUI
    _ -> String -> m ()
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ReqUI, Maybe ActorId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ReqUI, Maybe ActorId)
    cmdS

    dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()
    dieSer :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Actor -> m ()
    dieSer ActorId
    aid Actor
    b2 = do
      if Actor -> Bool
    bproj Actor
    b2 then
        Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe ([Vector], Speed) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ([Vector], Speed) -> Bool)
    -> Maybe ([Vector], Speed) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b2) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
          UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b2) Maybe ([Vector], Speed)
    forall a. Maybe a
    Nothing
            -- needed only to ensure display of the last position of projectile
      else do
        kindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
    -> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ContentId ItemKind
    getIidKindIdServer (ItemId -> State -> ContentId ItemKind)
    -> ItemId -> State -> ContentId ItemKind
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemId
    btrunk Actor
    b2
        execUpdAtomic $ UpdRecordKill aid kindId 1
        -- At this point the actor's body exists and his items are not dropped.
        deduceKilled aid
        -- Most probabaly already done, but just in case (e.g., when actor
        -- created with 0 HP):
        electLeader (bfid b2) (blid b2) aid
      -- If an explosion blast, before the particle is destroyed, it tries
      -- to modify terrain with it as well as do some easy crafting,
      -- e.g., cooking on fire.
      arTrunk <- (State -> AspectRecord) -> m AspectRecord
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> AspectRecord) -> m AspectRecord)
    -> (State -> AspectRecord) -> m AspectRecord
    forall a b. (a -> b) -> a -> b
    $ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> ItemId
    btrunk Actor
    b2) (EnumMap ItemId AspectRecord -> AspectRecord)
    -> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> EnumMap ItemId AspectRecord
    sdiscoAspect
      let spentProj = Actor -> Bool
    bproj Actor
    b2 Bool -> Bool -> Bool
    && ItemBag -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null (Actor -> ItemBag
    beqp Actor
    b2)
          isBlast = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arTrunk
          -- Let thrown food cook in fire (crafting) and other projectiles
          -- transform terrain they fall onto. Big actors are inert at death.
          (effScope, bumping) = if bproj b2
                                then (EffBareAndOnCombine, False)
                                else (EffBare, True)
      when (not spentProj && isBlast) $
        void $ reqAlterFail bumping effScope False aid (bpos b2)
      b3 <- getsState $ getActorBody aid
      -- Items need to do dropped now, so that they can be transformed by effects
      -- of the embedded items, if they are activated.
      -- If the actor was a projectile and no effect was triggered by hitting
      -- an enemy, the item still exists and @OnSmash@ effects will be triggered.
      dropAllEquippedItems aid b3
      -- Also destroy, not just drop, all organs, to trigger any effects.
      -- Note that some effects may be invoked on an actor that has
      -- no trunk any more. Conditions are ignored to avoid spam about them ending.
      bag <- getsState $ getBodyStoreBag b3 COrgan
      discoAspect <- getsState sdiscoAspect
      let f = m UseResult -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m UseResult -> m ())
    -> (ItemId -> ItemQuant -> m UseResult)
    -> ItemId
    -> ItemQuant
    -> m ()
    forall (f :: * -> *) (g :: * -> *) a b.
    (Functor f, Functor g) =>
    (a -> b) -> f (g a) -> f (g b)
    <$$> Bool
    -> Bool
    -> CStore
    -> ActorId
    -> Actor
    -> Int
    -> ItemId
    -> ItemQuant
    -> m UseResult
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> Bool
    -> CStore
    -> ActorId
    -> Actor
    -> Int
    -> ItemId
    -> ItemQuant
    -> m UseResult
    dropCStoreItem Bool
    False Bool
    True CStore
    COrgan ActorId
    aid Actor
    b3 Int
    forall a. Bounded a => a
    maxBound
          isCondition = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Condition (AspectRecord -> Bool)
    -> (ItemId -> AspectRecord) -> ItemId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EnumMap ItemId AspectRecord
    discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.!)
      mapM_ (uncurry f) $ filter (not . isCondition . fst) $ EM.assocs bag
      -- As the last act of heroism, the actor (even if projectile)
      -- changes the terrain with its embedded items, if possible.
      -- Note that all the resulting effects are invoked on an actor that has
      -- no trunk any more.
      when (not spentProj && not isBlast) $
        void $ reqAlterFail bumping effScope False aid (bpos b2)
          -- old bpos; OK, safer
      b4 <- getsState $ getActorBody aid
      execUpdAtomic $ UpdDestroyActor aid b4 []

    restartGame :: MonadServerAtomic m
                => m () -> m () -> Maybe (GroupName ModeKind) -> m ()
    restartGame :: forall (m :: * -> *).
    MonadServerAtomic m =>
    m () -> m () -> Maybe (GroupName ModeKind) -> m ()
    restartGame m ()
    updConn m ()
    loop Maybe (GroupName ModeKind)
    mgameMode = do
      -- This goes only to the old UI client.
      SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic SfxAtomic
    SfxRestart
      soptionsNxt <- (StateServer -> ServerOptions) -> m ServerOptions
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> ServerOptions
    soptionsNxt
      srandom <- getsServer srandom
      factionDold <- getsState sfactionD
      -- Create new factions.
      s <- gameReset soptionsNxt mgameMode (Just srandom)
      -- Note how we also no longer assert exploration, because there may not be
      -- enough time left in the debug run to explore again in a new game.
      let optionsBarRngs = ServerOptions
    soptionsNxt { sdungeonRng = Nothing
                                       , smainRng = Nothing
                                       , sassertExplored = Nothing }
      modifyServer $ \StateServer
    ser -> StateServer
    ser { soptionsNxt = optionsBarRngs
                                 , soptions = optionsBarRngs }
      -- This reaches only the intersection of old and new clients.
      execUpdAtomic $ UpdRestartServer s
      -- Spawn new clients, as needed, according to new factions.
      updConn
      initPer
      reinitGame factionDold
      -- Save a just started noConfirm game to preserve history of the just
      -- ended normal game, in case the user exits brutally.
      writeSaveAll False True
      loop