    {-# LANGUAGE TupleSections #-}
    -- | Server operations common to many modules.
    module Game.LambdaHack.Server.CommonM
      ( revealAll, generalMoveItem, deduceQuits
      , writeSaveAll, verifyCaches, deduceKilled, electLeader, setFreshLeader
      , updatePer, projectFail, addActorFromGroup, registerActor
      , discoverIfMinorEffects, pickWeaponServer, currentSkillsServer, allGroupItems
      , addCondition, removeConditionSingle, addSleep, removeSleepSingle
      , addKillToAnalytics
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , revealItems, revealPerceptionLid, containerMoveItem, quitF, keepArenaFact
      , anyActorsAlive, updatePerFromNew, recomputeCachePer
      , projectBla, addProjectile, addNonProjectile, addActorIid
      , getCacheLucid, getCacheTotal
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import qualified Data.IntMap.Strict as IM
    import           Data.Ratio

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Analytics
    import           Game.LambdaHack.Common.Area
    import           Game.LambdaHack.Common.ClientOptions
    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.Point
    import           Game.LambdaHack.Common.ReqFailure
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import qualified Game.LambdaHack.Content.CaveKind as CK
    import           Game.LambdaHack.Content.FactionKind
    import           Game.LambdaHack.Content.ItemKind (ItemKind)
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Core.Random
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import           Game.LambdaHack.Definition.Defs
    import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal
    import           Game.LambdaHack.Server.Fov
    import           Game.LambdaHack.Server.ItemM
    import           Game.LambdaHack.Server.ItemRev
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.ServerOptions
    import           Game.LambdaHack.Server.State

    revealItems :: MonadServerAtomic m => FactionId -> m ()
    revealItems :: forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
    revealItems FactionId
    fid = do
      COps{coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      ServerOptions{sclientOptions} <- getsServer soptions
      discoAspect <- getsState sdiscoAspect
      let keptSecret ItemKind
    kind AspectRecord
    ar = ItemKind -> Bool
    IA.isHumanTrinket ItemKind
    kind
                               Bool -> Bool -> Bool
    || Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.MetaGame AspectRecord
    ar
          discover ActorId
    aid CStore
    store ItemId
    iid ItemQuant
    _ = do
            itemKindId <- (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
    iid
            let arItem = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid
                c = ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    store
                itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
            unless (keptSecret itemKind arItem) $  -- a hack
              execUpdAtomic $ UpdDiscover c iid itemKindId arItem
          f (ActorId
    aid, Actor
    b) =
            -- CStash is IDed for each actor of each faction, which is fine,
            -- even though it may introduce a slight lag at gameover.
            m (m ()) -> m ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (m (m ()) -> m ()) -> m (m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (State -> m ()) -> m (m ())
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> m ()) -> m (m ())) -> (State -> m ()) -> m (m ())
    forall a b. (a -> b) -> a -> b
    $ (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()
    forall (m :: * -> *).
    Monad m =>
    (CStore -> ItemId -> ItemQuant -> m ()) -> Actor -> State -> m ()
    mapActorItems_ (ActorId -> CStore -> ItemId -> ItemQuant -> m ()
    discover ActorId
    aid) Actor
    b
      -- Don't ID projectiles, their items are not really owned by the party.
      aids <- getsState $ fidActorNotProjGlobalAssocs fid
      mapM_ f aids
      dungeon <- getsState sdungeon
      let minLid = (LevelId, Level) -> LevelId
    forall a b. (a, b) -> a
    fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
    forall a b. (a -> b) -> a -> b
    $ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    minimumBy (((LevelId, Level) -> AbsDepth)
    -> (LevelId, Level) -> (LevelId, Level) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Level -> AbsDepth
    ldepth (Level -> AbsDepth)
    -> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LevelId, Level) -> Level
    forall a b. (a, b) -> b
    snd))
                       ([(LevelId, Level)] -> (LevelId, Level))
    -> [(LevelId, Level)] -> (LevelId, Level)
    forall a b. (a -> b) -> a -> b
    $ Dungeon -> [(LevelId, Level)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs Dungeon
    dungeon
          discoverSample ItemId
    iid = do
            itemKindId <- (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
    iid
            let arItem = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid
                cdummy = FactionId -> LevelId -> Point -> Container
    CTrunk FactionId
    fid LevelId
    minLid Point
    originPoint
                itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
            -- Due to @cdummy@, the met and unmet secret things will appear
            -- at gameover among actors in the debug mode. Tough luck.
            execUpdAtomic $ if keptSecret itemKind arItem
                            then UpdSpotItem False iid quantSingle cdummy
                            else UpdDiscover cdummy iid itemKindId arItem
      generationAn <- getsServer sgenerationAn
      getKindId <- getsState $ flip getIidKindIdServer
      let kindsEqual ItemId
    iid ItemId
    iid2 = ItemId -> ContentId ItemKind
    getKindId ItemId
    iid ContentId ItemKind -> ContentId ItemKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == ItemId -> ContentId ItemKind
    getKindId ItemId
    iid2 Bool -> Bool -> Bool
    && ItemId
    iid ItemId -> ItemId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ItemId
    iid2
          nonDupSample EnumMap ItemId Int
    em ItemId
    iid Int
    0 = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (ItemId -> Bool) -> [ItemId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (ItemId -> ItemId -> Bool
    kindsEqual ItemId
    iid) ([ItemId] -> Bool) -> [ItemId] -> Bool
    forall a b. (a -> b) -> a -> b
    $ EnumMap ItemId Int -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys EnumMap ItemId Int
    em
          nonDupSample EnumMap ItemId Int
    _ ItemId
    _ Int
    _ = Bool
    True
          nonDupGen = (EnumMap ItemId Int -> EnumMap ItemId Int)
    -> GenerationAnalytics -> GenerationAnalytics
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (\EnumMap ItemId Int
    em -> (ItemId -> Int -> Bool) -> EnumMap ItemId Int -> EnumMap ItemId Int
    forall k a.
    Enum k =>
    (k -> a -> Bool) -> EnumMap k a -> EnumMap k a
    EM.filterWithKey (EnumMap ItemId Int -> ItemId -> Int -> Bool
    nonDupSample EnumMap ItemId Int
    em) EnumMap ItemId Int
    em)
                             GenerationAnalytics
    generationAn
      -- Remove samples that are supplanted by real items.
      -- If there are mutliple UI factions, the second run will be vacuus,
      -- but it's important to do that before the first try to identify things
      -- to prevent spam from identifying samples that are not needed.
      modifyServer $ \StateServer
    ser -> StateServer
    ser {sgenerationAn = nonDupGen}
      when (sexposeActors sclientOptions) $
        -- Few, if any, need ID, but we can't rule out unusual content.
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! STrunk
      when (sexposeItems sclientOptions) $ do
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SItem
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SEmbed
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SOrgan
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SCondition
        mapM_ discoverSample $ EM.keys $ nonDupGen EM.! SBlast

    revealAll :: MonadServerAtomic m => FactionId -> m ()
    revealAll :: forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
    revealAll FactionId
    fid = do
      FactionId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
    revealItems FactionId
    fid
      UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> Bool -> UpdAtomic
    UpdMuteMessages FactionId
    fid Bool
    True
      dungeon <- (State -> Dungeon) -> m Dungeon
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> Dungeon
    sdungeon
      -- Perception needs to be sent explicitly, because normal management
      -- assumes an action must happen on a level to invalidate and regenerate
      -- perception on the level (and actors must survive!).
      -- Also, we'd rather hack here and in `verifyCaches` that complicate
      -- the already complex perception creation and caching code.
      mapM_ (revealPerceptionLid fid) $ EM.assocs dungeon
      execUpdAtomic $ UpdMuteMessages fid False

    revealPerceptionLid :: MonadServerAtomic m
                        => FactionId -> (LevelId, Level) -> m ()
    revealPerceptionLid :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> (LevelId, Level) -> m ()
    revealPerceptionLid FactionId
    fid (LevelId
    lid, Level
    lvl) = do
      let (Int
    x0, Int
    y0, Int
    x1, Int
    y1) = Area -> (Int, Int, Int, Int)
    fromArea (Area -> (Int, Int, Int, Int)) -> Area -> (Int, Int, Int, Int)
    forall a b. (a -> b) -> a -> b
    $ Level -> Area
    larea Level
    lvl
          fullSet :: EnumSet Point
    fullSet = [Point] -> EnumSet Point
    forall k. Enum k => [k] -> EnumSet k
    ES.fromDistinctAscList [ Int -> Int -> Point
    Point Int
    x Int
    y
                                           | Int
    y <- [Int
    y0 .. Int
    y1]
                                           , Int
    x <- [Int
    x0 .. Int
    x1] ]
          perNew :: Perception
    perNew = Perception
            { psight :: PerVisible
    psight = EnumSet Point -> PerVisible
    PerVisible EnumSet Point
    fullSet
            , psmell :: PerSmelled
    psmell = EnumSet Point -> PerSmelled
    PerSmelled EnumSet Point
    forall k. EnumSet k
    ES.empty  -- don't obscure
            }
      FactionId -> LevelId -> Perception -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> Perception -> m ()
    updatePerFromNew FactionId
    fid LevelId
    lid Perception
    perNew

    -- | Generate the atomic updates that jointly perform a given item move.
    generalMoveItem :: MonadStateRead m
                    => Bool -> ItemId -> Int -> Container -> Container
                    -> m [UpdAtomic]
    generalMoveItem :: forall (m :: * -> *).
    MonadStateRead m =>
    Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    generalMoveItem Bool
    _ ItemId
    iid Int
    k (CActor ActorId
    aid1 CStore
    cstore1) c2 :: Container
    c2@(CActor ActorId
    aid2 CStore
    cstore2)
      | ActorId
    aid1 ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId
    aid2 = do
        moveStash <- Container -> m [UpdAtomic]
    forall (m :: * -> *).
    MonadStateRead m =>
    Container -> m [UpdAtomic]
    moveStashIfNeeded Container
    c2
        return $! moveStash ++ [UpdMoveItem iid k aid1 cstore1 cstore2]
    generalMoveItem Bool
    verbose ItemId
    iid Int
    k Container
    c1 Container
    c2 = Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    forall (m :: * -> *).
    MonadStateRead m =>
    Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    containerMoveItem Bool
    verbose ItemId
    iid Int
    k Container
    c1 Container
    c2

    containerMoveItem :: MonadStateRead m
                      => Bool -> ItemId -> Int -> Container -> Container
                      -> m [UpdAtomic]
    containerMoveItem :: forall (m :: * -> *).
    MonadStateRead m =>
    Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    containerMoveItem Bool
    verbose ItemId
    iid Int
    k Container
    c1 Container
    c2 = do
      bag <- (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
    $ Container -> State -> ItemBag
    getContainerBag Container
    c1
      case iid `EM.lookup` bag of
        Maybe ItemQuant
    Nothing -> [Char] -> m [UpdAtomic]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m [UpdAtomic]) -> [Char] -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (ItemId, Int, Container, Container) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (ItemId
    iid, Int
    k, Container
    c1, Container
    c2)
        Just (Int
    _, ItemTimers
    it) -> do
          moveStash <- Container -> m [UpdAtomic]
    forall (m :: * -> *).
    MonadStateRead m =>
    Container -> m [UpdAtomic]
    moveStashIfNeeded Container
    c2
          return $ [UpdLoseItem verbose iid (k, take k it) c1]
                   ++ moveStash
                   ++ [UpdSpotItem verbose iid (k, take k it) c2]

    quitF :: MonadServerAtomic m => Status -> FactionId -> m ()
    quitF :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Status -> FactionId -> m ()
    quitF Status
    status FactionId
    fid = 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
    $ (EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (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
      let oldSt = Faction -> Maybe Status
    gquit Faction
    fact
      -- Note that it's the _old_ status that we check here.
      case stOutcome <$> oldSt of
        Just Outcome
    Killed -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()    -- Do not overwrite in case
        Just Outcome
    Defeated -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- many things happen in 1 turn.
        Just Outcome
    Conquer -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just Outcome
    Escape -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Maybe Outcome
    _ -> do
          let !_A :: ()
    _A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Status -> Outcome
    stOutcome Status
    status Outcome -> [Outcome] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Outcome
    Camping, Outcome
    Restart]
                            Bool -> ([Char], (Maybe Outcome, Status, FactionId)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "Camping and Restart are handled separately"
                            [Char]
    -> (Maybe Outcome, Status, FactionId)
    -> ([Char], (Maybe Outcome, Status, FactionId))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (Status -> Outcome
    stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Status
    oldSt, Status
    status, FactionId
    fid)) ()
          -- This runs regardless of the _new_ status.
          manalytics <-
            if FactionKind -> Bool
    fhasUI (FactionKind -> Bool) -> FactionKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Faction -> FactionKind
    gkind Faction
    fact then do
              keepAutomated <- (StateServer -> Bool) -> m Bool
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> Bool) -> m Bool)
    -> (StateServer -> Bool) -> m Bool
    forall a b. (a -> b) -> a -> b
    $ ServerOptions -> Bool
    skeepAutomated (ServerOptions -> Bool)
    -> (StateServer -> ServerOptions) -> StateServer -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> ServerOptions
    soptions
              -- Try to remove AI control of the UI faction, to show gameover info.
              when (gunderAI fact && not keepAutomated) $
                execUpdAtomic $ UpdAutoFaction fid False
              revealAll fid
              -- Likely, by this time UI faction is no longer AI-controlled,
              -- so the score will get registered.
              registerScore status fid
              factionAn <- getsServer sfactionAn
              generationAn <- getsServer sgenerationAn
              return $ Just (factionAn, generationAn)
            else Maybe (FactionAnalytics, GenerationAnalytics)
    -> m (Maybe (FactionAnalytics, GenerationAnalytics))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (FactionAnalytics, GenerationAnalytics)
    forall a. Maybe a
    Nothing
          execUpdAtomic $ UpdQuitFaction fid oldSt (Just status) manalytics
          modifyServer $ \StateServer
    ser -> StateServer
    ser {sbreakLoop = True}  -- check game over

    -- Send any UpdQuitFaction actions that can be deduced from factions'
    -- current state.
    deduceQuits :: MonadServerAtomic m => FactionId -> Status -> m ()
    deduceQuits :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> Status -> m ()
    deduceQuits FactionId
    fid0 status :: Status
    status@Status{Outcome
    stOutcome :: Status -> Outcome
    stOutcome :: Outcome
    stOutcome}
      | Outcome
    stOutcome Outcome -> [Outcome] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Outcome
    Defeated, Outcome
    Camping, Outcome
    Restart, Outcome
    Conquer] =
        [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no quitting to deduce" [Char] -> (FactionId, Status) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (FactionId
    fid0, Status
    status)
    deduceQuits FactionId
    fid0 Status
    status = do
      fact0 <- (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
    $ (EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid0) (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
      let factHasUI = FactionKind -> Bool
    fhasUI (FactionKind -> Bool)
    -> (Faction -> FactionKind) -> Faction -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> FactionKind
    gkind
          quitFaction (Outcome
    stOutcome, (FactionId
    fid, Faction
    _)) = Status -> FactionId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Status -> FactionId -> m ()
    quitF Status
    status{stOutcome} FactionId
    fid
          mapQuitF [(Outcome, (FactionId, Faction))]
    outfids = do
            let ([(Outcome, (FactionId, Faction))]
    withUI, [(Outcome, (FactionId, Faction))]
    withoutUI) =
                  ((Outcome, (FactionId, Faction)) -> Bool)
    -> [(Outcome, (FactionId, Faction))]
    -> ([(Outcome, (FactionId, Faction))],
        [(Outcome, (FactionId, Faction))])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Faction -> Bool
    factHasUI (Faction -> Bool)
    -> ((Outcome, (FactionId, Faction)) -> Faction)
    -> (Outcome, (FactionId, Faction))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd ((FactionId, Faction) -> Faction)
    -> ((Outcome, (FactionId, Faction)) -> (FactionId, Faction))
    -> (Outcome, (FactionId, Faction))
    -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Outcome, (FactionId, Faction)) -> (FactionId, Faction)
    forall a b. (a, b) -> b
    snd)
                            ((Status -> Outcome
    stOutcome Status
    status, (FactionId
    fid0, Faction
    fact0)) (Outcome, (FactionId, Faction))
    -> [(Outcome, (FactionId, Faction))]
    -> [(Outcome, (FactionId, Faction))]
    forall a. a -> [a] -> [a]
    : [(Outcome, (FactionId, Faction))]
    outfids)
            ((Outcome, (FactionId, Faction)) -> m ())
    -> [(Outcome, (FactionId, Faction))] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Outcome, (FactionId, Faction)) -> m ()
    quitFaction ([(Outcome, (FactionId, Faction))]
    withoutUI [(Outcome, (FactionId, Faction))]
    -> [(Outcome, (FactionId, Faction))]
    -> [(Outcome, (FactionId, Faction))]
    forall a. [a] -> [a] -> [a]
    ++ [(Outcome, (FactionId, Faction))]
    withUI)
          inGameOutcome (FactionId
    fid, Faction
    fact) = do
            let mout :: Maybe Outcome
    mout | FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid0 = Outcome -> Maybe Outcome
    forall a. a -> Maybe a
    Just (Outcome -> Maybe Outcome) -> Outcome -> Maybe Outcome
    forall a b. (a -> b) -> a -> b
    $ Status -> Outcome
    stOutcome Status
    status
                     | Bool
    otherwise = Status -> Outcome
    stOutcome (Status -> Outcome) -> Maybe Status -> Maybe Outcome
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Faction -> Maybe Status
    gquit Faction
    fact
            case Maybe Outcome
    mout of
              Just Outcome
    Killed -> Bool
    False
              Just Outcome
    Defeated -> Bool
    False
              Just Outcome
    Restart -> Bool
    False  -- effectively, commits suicide
              Maybe Outcome
    _ -> Bool
    True
      factionD <- getsState sfactionD
      let assocsInGame = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FactionId, Faction) -> Bool
    inGameOutcome ([(FactionId, Faction)] -> [(FactionId, Faction)])
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap FactionId Faction -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap FactionId Faction
    factionD
          assocsKeepArena = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Faction -> Bool
    keepArenaFact (Faction -> Bool)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd) [(FactionId, Faction)]
    assocsInGame
          assocsUI = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Faction -> Bool
    factHasUI (Faction -> Bool)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd) [(FactionId, Faction)]
    assocsInGame
          nonHorrorAIG = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((FactionId, Faction) -> Bool) -> (FactionId, Faction) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> Bool
    isHorrorFact (Faction -> Bool)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd) [(FactionId, Faction)]
    assocsInGame
          worldPeace =
            ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(FactionId
    fid1, Faction
    _) -> ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(FactionId
    fid2, Faction
    fact2) -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    fid2 Faction
    fact2 FactionId
    fid1)
                               [(FactionId, Faction)]
    nonHorrorAIG)
            [(FactionId, Faction)]
    nonHorrorAIG
          othersInGame = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FactionId
    fid0) (FactionId -> Bool)
    -> ((FactionId, Faction) -> FactionId)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> FactionId
    forall a b. (a, b) -> a
    fst) [(FactionId, Faction)]
    assocsInGame
      if | null assocsUI ->
           -- Only non-UI players left in the game and they all win.
           mapQuitF $ zip (repeat Conquer) othersInGame
         | null assocsKeepArena ->
           -- Only leaderless and spawners remain (the latter may sometimes
           -- have no leader, just as the former), so they win,
           -- or we could get stuck in a state with no active arena
           -- and so no spawns.
           mapQuitF $ zip (repeat Conquer) othersInGame
         | worldPeace ->
           -- Nobody is at war any more, so all win (e.g., horrors, but never mind).
           mapQuitF $ zip (repeat Conquer) othersInGame
         | stOutcome status == Escape -> do
           -- Otherwise, in a game with many warring teams alive,
           -- only complete Victory matters, until enough of them die.
           let (victors, losers) =
                 partition (\(FactionId
    fi, Faction
    _) -> FactionId -> Faction -> FactionId -> Bool
    isFriend FactionId
    fid0 Faction
    fact0 FactionId
    fi) othersInGame
           mapQuitF $ zip (repeat Escape) victors ++ zip (repeat Defeated) losers
         | otherwise -> quitF status fid0

    -- | Save game on server and all clients.
    writeSaveAll :: MonadServerAtomic m => Bool -> Bool -> m ()
    writeSaveAll :: forall (m :: * -> *). MonadServerAtomic m => Bool -> Bool -> m ()
    writeSaveAll Bool
    uiRequested Bool
    evenForNoConfirmGames = do
      bench <- (StateServer -> Bool) -> m Bool
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> Bool) -> m Bool)
    -> (StateServer -> Bool) -> m Bool
    forall a b. (a -> b) -> a -> b
    $ ClientOptions -> Bool
    sbenchmark (ClientOptions -> Bool)
    -> (StateServer -> ClientOptions) -> StateServer -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ServerOptions -> ClientOptions
    sclientOptions (ServerOptions -> ClientOptions)
    -> (StateServer -> ServerOptions) -> StateServer -> ClientOptions
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> ServerOptions
    soptions
      noConfirmsGame <- isNoConfirmsGame
      when (uiRequested
            || not bench && (not noConfirmsGame || evenForNoConfirmGames)) $ do
        execUpdAtomic UpdWriteSave
        saveServer
    #ifdef WITH_EXPENSIVE_ASSERTIONS
        -- This check is sometimes repeated in @gameExit@, but we don't care about
        -- speed of shutdown and even more so in WITH_EXPENSIVE_ASSERTIONS mode.
        verifyCaches
    #endif

    verifyCaches :: MonadServer m => m ()
    verifyCaches :: forall (m :: * -> *). MonadServer m => m ()
    verifyCaches = do
      sperCacheFid <- (StateServer -> PerCacheFid) -> m PerCacheFid
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> PerCacheFid
    sperCacheFid
      sperValidFid <- getsServer sperValidFid
      sactorMaxSkills2 <- getsState sactorMaxSkills
      sfovLucidLid <- getsServer sfovLucidLid
      sfovClearLid <- getsServer sfovClearLid
      sfovLitLid <- getsServer sfovLitLid
      sperFid <- getsServer sperFid
      actorMaxSkills <- getsState maxSkillsInDungeon
      ( fovLitLid, fovClearLid, fovLucidLid
       ,perValidFid, perCacheFid, perFid ) <- getsState perFidInDungeon
      rngs <- getsServer srngs  -- initial display may scroll off terminal memory
      factionD <- getsState sfactionD
      -- Perception off UI faction at game over is illegal (revealed to the player
      -- in 'revealAll'), which is fine, because it's never used.
      -- Don't verify perception in such cases. All the caches from which
      -- legal perception would be created at that point are legal and verified,
      -- which is almost as tight.
      let gameOverUI Faction
    fact = FactionKind -> Bool
    fhasUI (Faction -> FactionKind
    gkind Faction
    fact)
                            Bool -> Bool -> Bool
    && Bool -> (Status -> Bool) -> Maybe Status -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False ((Outcome -> Outcome -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Outcome
    Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Status -> Outcome
    stOutcome) (Faction -> Maybe Status
    gquit Faction
    fact)
          isGameOverUI = (Faction -> Bool) -> [Faction] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Faction -> Bool
    gameOverUI ([Faction] -> Bool) -> [Faction] -> Bool
    forall a b. (a -> b) -> a -> b
    $ EnumMap FactionId Faction -> [Faction]
    forall k a. EnumMap k a -> [a]
    EM.elems EnumMap FactionId Faction
    factionD
          !_A7 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (FovLitLid
    sfovLitLid FovLitLid -> FovLitLid -> Bool
    forall a. Eq a => a -> a -> Bool
    == FovLitLid
    fovLitLid
                         Bool -> ([Char], (FovLitLid, FovLitLid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sfovLitLid"
                         [Char]
    -> (FovLitLid, FovLitLid, RNGs)
    -> ([Char], (FovLitLid, FovLitLid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (FovLitLid
    sfovLitLid, FovLitLid
    fovLitLid, RNGs
    rngs)) ()
          !_A6 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (FovClearLid
    sfovClearLid FovClearLid -> FovClearLid -> Bool
    forall a. Eq a => a -> a -> Bool
    == FovClearLid
    fovClearLid
                         Bool -> ([Char], (FovClearLid, FovClearLid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sfovClearLid"
                         [Char]
    -> (FovClearLid, FovClearLid, RNGs)
    -> ([Char], (FovClearLid, FovClearLid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (FovClearLid
    sfovClearLid, FovClearLid
    fovClearLid, RNGs
    rngs)) ()
          !_A5 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ActorMaxSkills
    sactorMaxSkills2 ActorMaxSkills -> ActorMaxSkills -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorMaxSkills
    actorMaxSkills
                         Bool -> ([Char], (ActorMaxSkills, ActorMaxSkills, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sactorMaxSkills"
                         [Char]
    -> (ActorMaxSkills, ActorMaxSkills, RNGs)
    -> ([Char], (ActorMaxSkills, ActorMaxSkills, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (ActorMaxSkills
    sactorMaxSkills2, ActorMaxSkills
    actorMaxSkills, RNGs
    rngs)) ()
          !_A4 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (FovLucidLid
    sfovLucidLid FovLucidLid -> FovLucidLid -> Bool
    forall a. Eq a => a -> a -> Bool
    == FovLucidLid
    fovLucidLid
                         Bool -> ([Char], (FovLucidLid, FovLucidLid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sfovLucidLid"
                         [Char]
    -> (FovLucidLid, FovLucidLid, RNGs)
    -> ([Char], (FovLucidLid, FovLucidLid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (FovLucidLid
    sfovLucidLid, FovLucidLid
    fovLucidLid, RNGs
    rngs)) ()
          !_A3 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (PerValidFid
    sperValidFid PerValidFid -> PerValidFid -> Bool
    forall a. Eq a => a -> a -> Bool
    == PerValidFid
    perValidFid
                         Bool -> ([Char], (PerValidFid, PerValidFid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sperValidFid"
                         [Char]
    -> (PerValidFid, PerValidFid, RNGs)
    -> ([Char], (PerValidFid, PerValidFid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (PerValidFid
    sperValidFid, PerValidFid
    perValidFid, RNGs
    rngs)) ()
          !_A2 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (PerCacheFid
    sperCacheFid PerCacheFid -> PerCacheFid -> Bool
    forall a. Eq a => a -> a -> Bool
    == PerCacheFid
    perCacheFid
                         Bool -> ([Char], (PerCacheFid, PerCacheFid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated sperCacheFid"
                         [Char]
    -> (PerCacheFid, PerCacheFid, RNGs)
    -> ([Char], (PerCacheFid, PerCacheFid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (PerCacheFid
    sperCacheFid, PerCacheFid
    perCacheFid, RNGs
    rngs)) ()
          !_A1 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool
    isGameOverUI Bool -> Bool -> Bool
    || PerFid
    sperFid PerFid -> PerFid -> Bool
    forall a. Eq a => a -> a -> Bool
    == PerFid
    perFid
                         Bool -> ([Char], (PerFid, PerFid, RNGs)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` [Char]
    "wrong accumulated perception"
                         [Char]
    -> (PerFid, PerFid, RNGs) -> ([Char], (PerFid, PerFid, RNGs))
    forall v. [Char] -> v -> ([Char], v)
    `swith` (PerFid
    sperFid, PerFid
    perFid, RNGs
    rngs)) ()
      return ()

    -- | Tell whether a faction that we know is still in game, keeps arena.
    -- Keeping arena means, if the faction is still in game,
    -- it always has a leader in the dungeon somewhere.
    -- So, leaderless factions and spawner factions do not keep an arena,
    -- even though the latter usually has a leader for most of the game.
    keepArenaFact :: Faction -> Bool
    keepArenaFact :: Faction -> Bool
    keepArenaFact Faction
    fact = FactionKind -> Bool
    fhasPointman (Faction -> FactionKind
    gkind Faction
    fact) Bool -> Bool -> Bool
    && FactionKind -> Bool
    fneverEmpty (Faction -> FactionKind
    gkind Faction
    fact)

    -- We assume the actor in the second argument has HP <= 0 or is going to be
    -- dominated right now. Even if the actor is to be dominated,
    -- @bfid@ of the actor body is still the old faction.
    deduceKilled :: MonadServerAtomic m => ActorId -> m ()
    deduceKilled :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    deduceKilled ActorId
    aid = do
      body <- (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
      fact <- getsState $ (EM.! bfid body) . sfactionD
      when (fneverEmpty $ gkind fact) $ do
        actorsAlive <- anyActorsAlive (bfid body) aid
        unless actorsAlive $
          deduceQuits (bfid body) $ Status Killed (fromEnum $ blid body) Nothing

    anyActorsAlive :: MonadServer m => FactionId -> ActorId -> m Bool
    anyActorsAlive :: forall (m :: * -> *).
    MonadServer m =>
    FactionId -> ActorId -> m Bool
    anyActorsAlive FactionId
    fid ActorId
    aid = do
      as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
    -> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
    forall a b. (a -> b) -> a -> b
    $ FactionId -> State -> [(ActorId, Actor)]
    fidActorNotProjGlobalAssocs FactionId
    fid
      -- We test HP here, in case more than one actor goes to 0 HP in the same turn.
      return $! any (\(ActorId
    aid2, Actor
    b2) -> ActorId
    aid2 ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ActorId
    aid Bool -> Bool -> Bool
    && Actor -> Int64
    bhp Actor
    b2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0) as

    electLeader :: MonadServerAtomic m => FactionId -> LevelId -> ActorId -> m ()
    electLeader :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> ActorId -> m ()
    electLeader FactionId
    fid LevelId
    lid ActorId
    aidToReplace = do
      mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
    -> (State -> Maybe ActorId) -> m (Maybe ActorId)
    forall a b. (a -> b) -> a -> b
    $ Faction -> Maybe ActorId
    gleader (Faction -> Maybe ActorId)
    -> (State -> Faction) -> State -> Maybe ActorId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (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
      when (mleader == Just aidToReplace) $ do
        allOurs <- getsState $ fidActorNotProjGlobalAssocs fid  -- not only on level
        let -- Prefer actors on this level and with positive HP and not sleeping.
            -- Exclude @aidToReplace@, even if not dead (e.g., if being dominated).
            (positive, negative) = partition (\(ActorId
    _, Actor
    b) -> Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0) allOurs
            (awake, sleeping) = partition (\(ActorId
    _, Actor
    b) -> Actor -> Watchfulness
    bwatch Actor
    b Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Watchfulness
    WSleep) positive
        onThisLevel <- getsState $ fidActorRegularAssocs fid lid
        let candidates = ((ActorId, Actor) -> Bool)
    -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(ActorId
    _, Actor
    b) -> Actor -> Watchfulness
    bwatch Actor
    b Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Watchfulness
    WSleep) [(ActorId, Actor)]
    onThisLevel
                         [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. [a] -> [a] -> [a]
    ++ [(ActorId, Actor)]
    awake [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. [a] -> [a] -> [a]
    ++ [(ActorId, Actor)]
    sleeping [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. [a] -> [a] -> [a]
    ++ [(ActorId, Actor)]
    negative
            mleaderNew = (ActorId -> Bool) -> [ActorId] -> Maybe ActorId
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ActorId
    aidToReplace) ([ActorId] -> Maybe ActorId) -> [ActorId] -> Maybe ActorId
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor) -> ActorId) -> [(ActorId, Actor)] -> [ActorId]
    forall a b. (a -> b) -> [a] -> [b]
    map (ActorId, Actor) -> ActorId
    forall a b. (a, b) -> a
    fst [(ActorId, Actor)]
    candidates
        execUpdAtomic $ UpdLeadFaction fid mleader mleaderNew

    setFreshLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()
    setFreshLeader :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> m ()
    setFreshLeader FactionId
    fid ActorId
    aid = 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
    $ (EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (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
      when (fhasPointman (gkind fact)) $ do
        -- First update and send Perception so that the new leader
        -- may report his environment.
        b <- getsState $ getActorBody aid
        let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Bool
    bproj Actor
    b) ()
        valid <- getsServer $ (EM.! blid b) . (EM.! fid) . sperValidFid
        unless valid $ updatePer fid (blid b)
        execUpdAtomic $ UpdLeadFaction fid (gleader fact) (Just aid)

    updatePer :: MonadServerAtomic m => FactionId -> LevelId -> m ()
    updatePer :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> m ()
    updatePer FactionId
    fid LevelId
    lid = do
      -- Performed in the State after action, e.g., with a new actor.
      perNew <- FactionId -> LevelId -> m Perception
    forall (m :: * -> *).
    MonadServer m =>
    FactionId -> LevelId -> m Perception
    recomputeCachePer FactionId
    fid LevelId
    lid
      updatePerFromNew fid lid perNew

    updatePerFromNew :: MonadServerAtomic m
                     => FactionId -> LevelId -> Perception -> m ()
    updatePerFromNew :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> Perception -> m ()
    updatePerFromNew FactionId
    fid LevelId
    lid Perception
    perNew = do
      -- Even if nothing needed to be done, perception is now validated.
      (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 {sperValidFid = EM.adjust (EM.insert lid True) fid $ sperValidFid ser}
      sperFidOld <- (StateServer -> PerFid) -> m PerFid
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> PerFid
    sperFid
      let perOld = PerFid
    sperFidOld PerFid -> FactionId -> EnumMap LevelId Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid EnumMap LevelId Perception -> LevelId -> Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid
          inPer = Perception -> Perception -> Perception
    diffPer Perception
    perNew Perception
    perOld
          outPer = Perception -> Perception -> Perception
    diffPer Perception
    perOld Perception
    perNew
      unless (nullPer outPer && nullPer inPer) $ do
        -- Perception is modified on the server and sent to the client
        -- together with all the revealed info.
        let fper = (EnumMap LevelId Perception -> EnumMap LevelId Perception)
    -> FactionId -> PerFid -> PerFid
    forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
    EM.adjust (LevelId
    -> Perception
    -> EnumMap LevelId Perception
    -> EnumMap LevelId Perception
    forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
    EM.insert LevelId
    lid Perception
    perNew) FactionId
    fid
        modifyServer $ \StateServer
    ser -> StateServer
    ser {sperFid = fper $ sperFid ser}
        execSendPer fid lid outPer inPer perNew

    recomputeCachePer :: MonadServer m => FactionId -> LevelId -> m Perception
    recomputeCachePer :: forall (m :: * -> *).
    MonadServer m =>
    FactionId -> LevelId -> m Perception
    recomputeCachePer FactionId
    fid LevelId
    lid = do
      total <- FactionId -> LevelId -> m CacheBeforeLucid
    forall (m :: * -> *).
    MonadServer m =>
    FactionId -> LevelId -> m CacheBeforeLucid
    getCacheTotal FactionId
    fid LevelId
    lid
      fovLucid <- getCacheLucid lid
      getsState $ perceptionFromPTotal fid lid fovLucid total

    -- The missile item is removed from the store only if the projection
    -- went into effect (no failure occured).
    projectFail :: MonadServerAtomic m
                => ActorId    -- ^ actor causing the projection
                -> ActorId    -- ^ actor projecting the item (is on current level)
                -> Point      -- ^ starting position of the projectile;
                              --   usually, but not always, position of @origin@
                -> Point      -- ^ target position of the projectile
                -> Int        -- ^ digital line parameter
                -> Bool       -- ^ whether to start at the origin's position
                -> ItemId     -- ^ the item to be projected
                -> CStore     -- ^ which store the items comes from
                -> Bool       -- ^ whether the item is a blast
                -> m (Maybe ReqFailure)
    projectFail :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> ActorId
    -> Point
    -> Point
    -> Int
    -> Bool
    -> ItemId
    -> CStore
    -> Bool
    -> m (Maybe ReqFailure)
    projectFail ActorId
    propeller ActorId
    origin Point
    oxy Point
    tpxy Int
    eps Bool
    center ItemId
    iid CStore
    cstore Bool
    blast = 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
      body <- getsState $ getActorBody origin
      let lid = Actor -> LevelId
    blid Actor
    body
      lvl <- getLevel lid
      case bresenhamsLineAlgorithm eps oxy tpxy of
        Maybe [Point]
    Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    ProjectAimOnself
        Just [] -> [Char] -> m (Maybe ReqFailure)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m (Maybe ReqFailure)) -> [Char] -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "projecting from the edge of level"
                           [Char] -> (Point, Point) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Point
    oxy, Point
    tpxy)
        Just (Point
    pos : [Point]
    restUnlimited) -> do
          bag <- (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
    $ Actor -> CStore -> State -> ItemBag
    getBodyStoreBag Actor
    body CStore
    cstore
          case EM.lookup iid bag of
            Maybe ItemQuant
    Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    ProjectOutOfReach
            Just ItemQuant
    _kit -> 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
              actorSk <- currentSkillsServer origin
              actorMaxSk <- getsState $ getActorMaxSkills origin
              let skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkProject Skills
    actorSk
                  forced = Bool
    blast Bool -> Bool -> Bool
    || Actor -> Bool
    bproj Actor
    body
                  calmE = Actor -> Skills -> Bool
    calmEnough Actor
    body Skills
    actorMaxSk
                  legal = Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
    permittedProject Bool
    forced Int
    skill Bool
    calmE ItemFull
    itemFull
                  arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
              case legal of
                Left ReqFailure
    reqFail -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    reqFail
                Right Bool
    _ -> do
                  let lobable :: Bool
    lobable = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Lobable AspectRecord
    arItem
                      rest :: [Point]
    rest = if Bool
    lobable
                             then Int -> [Point] -> [Point]
    forall a. Int -> [a] -> [a]
    take (Point -> Point -> Int
    chessDist Point
    oxy Point
    tpxy Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [Point]
    restUnlimited
                             else [Point]
    restUnlimited
                      t :: ContentId TileKind
    t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    pos
                  if | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    t ->
                       Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    ProjectBlockTerrain
                     | Point -> Level -> Bool
    occupiedBigLvl Point
    pos Level
    lvl ->
                       if Bool
    blast then do
                         -- Hit the blocking actor by starting the explosion
                         -- particle where the projectile landed, not a step away.
                         -- The same when the spot has the explosive embed,
                         -- regardless if it's walkable (@pos@ is, that's enough).
                         -- No problem even if there's a big actor where
                         -- the projectile starts, though it's wierd it may get
                         -- away unharmed sometimes.
                         ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    projectBla ActorId
    propeller ActorId
    origin Point
    oxy (Point
    posPoint -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    :[Point]
    rest)
                                    ItemId
    iid CStore
    cstore Bool
    blast
                         Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ReqFailure
    forall a. Maybe a
    Nothing
                       else Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    ProjectBlockActor
                     | Bool
    otherwise -> do
                       -- Make the explosion less regular and weaker at the edges.
                       if Bool
    blast Bool -> Bool -> Bool
    && Bool
    center then
                         -- Start in the center, not around, even if the center
                         -- is a non-walkable tile with the exploding embed
                         -- or if a big actor is there.
                         ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    projectBla ActorId
    propeller ActorId
    origin Point
    oxy (Point
    posPoint -> [Point] -> [Point]
    forall a. a -> [a] -> [a]
    :[Point]
    rest)
                                    ItemId
    iid CStore
    cstore Bool
    blast
                       else
                         ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    projectBla ActorId
    propeller ActorId
    origin Point
    pos [Point]
    rest
                                    ItemId
    iid CStore
    cstore Bool
    blast
                       Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ReqFailure
    forall a. Maybe a
    Nothing

    projectBla :: MonadServerAtomic m
               => ActorId    -- ^ actor causing the projection
               -> ActorId    -- ^ actor projecting the item (is on current lvl)
               -> Point      -- ^ starting point of the projectile
               -> [Point]    -- ^ rest of the trajectory of the projectile
               -> ItemId     -- ^ the item to be projected
               -> CStore     -- ^ which store the items comes from
               -> Bool       -- ^ whether the item is a blast
               -> m ()
    projectBla :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> ActorId -> Point -> [Point] -> ItemId -> CStore -> Bool -> m ()
    projectBla ActorId
    propeller ActorId
    origin Point
    pos [Point]
    rest ItemId
    iid CStore
    cstore Bool
    blast = do
      body <- (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
    origin
      let lid = Actor -> LevelId
    blid Actor
    body
      localTime <- getsState $ getLocalTime lid
      unless blast $ execSfxAtomic $ SfxProject origin iid
      bag <- getsState $ getBodyStoreBag body cstore
      ItemFull{itemKind} <- getsState $ itemToFull iid
      case iid `EM.lookup` bag of
        Maybe ItemQuant
    Nothing -> [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (ActorId, Point, [Point], ItemId, CStore) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (ActorId
    origin, Point
    pos, [Point]
    rest, ItemId
    iid, CStore
    cstore)
        Just kit :: ItemQuant
    kit@(Int
    _, ItemTimers
    it) -> do
          let delay :: Time
    delay =
                if ItemKind -> Int
    IK.iweight ItemKind
    itemKind Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                then Time
    timeTurn  -- big delay at start, e.g., to easily read hologram
                else Time
    timeZero  -- avoid running into own projectiles
              btime :: Time
    btime = Time -> Time -> Time
    absoluteTimeAdd Time
    delay Time
    localTime
          ActorId
    -> Point
    -> [Point]
    -> ItemId
    -> ItemQuant
    -> LevelId
    -> FactionId
    -> Time
    -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> Point
    -> [Point]
    -> ItemId
    -> ItemQuant
    -> LevelId
    -> FactionId
    -> Time
    -> m ()
    addProjectile ActorId
    propeller Point
    pos [Point]
    rest ItemId
    iid ItemQuant
    kit LevelId
    lid (Actor -> FactionId
    bfid Actor
    body) Time
    btime
          let c :: Container
    c = ActorId -> CStore -> Container
    CActor ActorId
    origin CStore
    cstore
          UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdLoseItem Bool
    False ItemId
    iid (Int
    1, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    1 ItemTimers
    it) Container
    c

    addActorFromGroup :: MonadServerAtomic m
                      => GroupName ItemKind -> FactionId -> Point -> LevelId -> Time
                      -> m (Maybe ActorId)
    addActorFromGroup :: forall (m :: * -> *).
    MonadServerAtomic m =>
    GroupName ItemKind
    -> FactionId -> Point -> LevelId -> Time -> m (Maybe ActorId)
    addActorFromGroup GroupName ItemKind
    actorGroup FactionId
    fid Point
    pos LevelId
    lid Time
    time = do
      Level{ldepth} <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid
      -- We bootstrap the actor by first creating the trunk of the actor's body
      -- that contains the fixed properties of all actors of that kind.
      freq <- prepareItemKind 0 ldepth [(actorGroup, 1)]
      m2 <- rollItemAspect freq ldepth
      case m2 of
        NewItem
    NoNewItem -> Maybe ActorId -> m (Maybe ActorId)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ActorId
    forall a. Maybe a
    Nothing
        NewItem GroupName ItemKind
    _ ItemKnown
    itemKnown ItemFull
    itemFull ItemQuant
    itemQuant -> do
          let itemFullKit :: (ItemFull, ItemQuant)
    itemFullKit = (ItemFull
    itemFull, ItemQuant
    itemQuant)
          ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just (ActorId -> Maybe ActorId) -> m ActorId -> m (Maybe ActorId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> ItemKnown
    -> (ItemFull, ItemQuant)
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> ItemKnown
    -> (ItemFull, ItemQuant)
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    registerActor Bool
    False ItemKnown
    itemKnown (ItemFull, ItemQuant)
    itemFullKit FactionId
    fid Point
    pos LevelId
    lid Time
    time

    registerActor :: MonadServerAtomic m
                  => Bool -> ItemKnown -> ItemFullKit
                  -> FactionId -> Point -> LevelId -> Time
                  -> m ActorId
    registerActor :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> ItemKnown
    -> (ItemFull, ItemQuant)
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    registerActor Bool
    summoned (ItemKnown ItemIdentity
    kindIx AspectRecord
    ar Maybe FactionId
    _) (ItemFull
    itemFullRaw, ItemQuant
    kit)
                  FactionId
    bfid Point
    pos LevelId
    lid Time
    time = do
      COps{cocave} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      let container = FactionId -> LevelId -> Point -> Container
    CTrunk FactionId
    bfid LevelId
    lid Point
    pos
          jfid = FactionId -> Maybe FactionId
    forall a. a -> Maybe a
    Just FactionId
    bfid
          itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
    ItemKnown ItemIdentity
    kindIx AspectRecord
    ar Maybe FactionId
    jfid
          itemFull = ItemFull
    itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}}
      trunkId <- registerItem False (itemFull, kit) itemKnown container
      aid <- addNonProjectile summoned trunkId (itemFull, kit) bfid pos lid time
      fact <- getsState $ (EM.! bfid) . sfactionD
      actorMaxSk <- getsState $ getActorMaxSkills aid
      condAnyFoeAdj <- getsState $ anyFoeAdj aid
      Level{lkind} <- getLevel lid
      let cinitSleep = CaveKind -> InitSleep
    CK.cinitSleep (CaveKind -> InitSleep) -> CaveKind -> InitSleep
    forall a b. (a -> b) -> a -> b
    $ ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
      when (cinitSleep /= CK.InitSleepBanned
            && canSleep actorMaxSk
            && not condAnyFoeAdj
            && not summoned
            && not (fhasGender (gkind fact))) $ do  -- heroes never start asleep
        -- A lot of actors will wake up at once anyway, so let most start sleeping.
        let sleepOdds = if Skills -> Bool
    prefersSleep Skills
    actorMaxSk then Integer
    19Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    %Integer
    20 else Integer
    2Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    %Integer
    3
        sleeps <- rndToAction $ chance sleepOdds
        when (cinitSleep == CK.InitSleepAlways || sleeps) $ addSleep aid
      return aid

    addProjectile :: MonadServerAtomic m
                  => ActorId -> Point -> [Point] -> ItemId -> ItemQuant -> LevelId
                  -> FactionId -> Time
                  -> m ()
    addProjectile :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> Point
    -> [Point]
    -> ItemId
    -> ItemQuant
    -> LevelId
    -> FactionId
    -> Time
    -> m ()
    addProjectile ActorId
    propeller Point
    pos [Point]
    rest ItemId
    iid (Int
    _, ItemTimers
    it) LevelId
    lid FactionId
    fid Time
    time = 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
          IK.ThrowMod{IK.throwHP} = IA.aToThrow arItem
          (trajectory, (speed, _)) =
            IA.itemTrajectory arItem (itemKind itemFull) (pos : rest)
          -- Trunk is added to equipment, not to organs, because it's the
          -- projected item, so it's carried, not grown.
          tweakBody Actor
    b = Actor
    b { bhp = xM throwHP
                          , btrajectory = Just (trajectory, speed)
                          , beqp = EM.singleton iid (1, take 1 it) }
      aid <- addActorIid iid itemFull True fid pos lid tweakBody
      bp <- getsState $ getActorBody propeller
      -- If propeller is a projectile, it may produce other projectiles, e.g.,
      -- by exploding, so it's not voluntary, so others are to blame.
      -- However, we can't easily see whether a pushed non-projectile actor
      -- produced a projectile due to colliding or voluntarily, so we assign
      -- blame to him.
      originator <- if bproj bp
                    then getsServer $ EM.findWithDefault propeller propeller
                                      . strajPushedBy
                    else return propeller
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser { strajTime = updateActorTime fid lid aid time $ strajTime ser
            , strajPushedBy = EM.insert aid originator $ strajPushedBy ser }

    addNonProjectile :: MonadServerAtomic m
                     => Bool -> ItemId -> ItemFullKit -> FactionId -> Point
                     -> LevelId -> Time
                     -> m ActorId
    addNonProjectile :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> ItemId
    -> (ItemFull, ItemQuant)
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    addNonProjectile Bool
    summoned ItemId
    trunkId (ItemFull
    itemFull, ItemQuant
    kit) FactionId
    fid Point
    pos LevelId
    lid Time
    time = do
      let tweakBody :: Actor -> Actor
    tweakBody Actor
    b = Actor
    b { borgan = EM.singleton trunkId kit
                          , bcalm = if summoned
                                    then xM 5  -- a tiny buffer before domination
                                    else bcalm b }
      aid <- ItemId
    -> ItemFull
    -> Bool
    -> FactionId
    -> Point
    -> LevelId
    -> (Actor -> Actor)
    -> m ActorId
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ItemId
    -> ItemFull
    -> Bool
    -> FactionId
    -> Point
    -> LevelId
    -> (Actor -> Actor)
    -> m ActorId
    addActorIid ItemId
    trunkId ItemFull
    itemFull Bool
    False FactionId
    fid Point
    pos LevelId
    lid Actor -> Actor
    tweakBody
      -- We assume actor is never born pushed.
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser {sactorTime = updateActorTime fid lid aid time $ sactorTime ser}
      return aid

    addActorIid :: MonadServerAtomic m
                => ItemId -> ItemFull -> Bool -> FactionId -> Point -> LevelId
                -> (Actor -> Actor)
                -> m ActorId
    addActorIid :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ItemId
    -> ItemFull
    -> Bool
    -> FactionId
    -> Point
    -> LevelId
    -> (Actor -> Actor)
    -> m ActorId
    addActorIid ItemId
    trunkId ItemFull{Item
    itemBase :: ItemFull -> Item
    itemBase :: Item
    itemBase, ItemKind
    itemKind :: ItemFull -> ItemKind
    itemKind :: ItemKind
    itemKind, itemDisco :: ItemFull -> ItemDisco
    itemDisco=ItemDiscoFull AspectRecord
    arItem}
                Bool
    bproj FactionId
    fid Point
    pos LevelId
    lid Actor -> Actor
    tweakBody = do
      COps{coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      -- Initial HP and Calm is based only on trunk and ignores organs.
      let trunkMaxHP = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    2 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Skill -> AspectRecord -> Int
    IA.getSkill Skill
    Ability.SkMaxHP AspectRecord
    arItem
          hp = Int -> Int64
    xM Int
    trunkMaxHP Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int64
    2
          -- Slightly reduced starting Calm to auto-id items that refill Calm
          -- and to let animals do some initial exploration before going to sleep.
          -- Higher reduction would cause confusingly low sight range at game
          -- start and even inability to handle equipment.
          calm = Int -> Int64
    xM (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Skill -> AspectRecord -> Int
    IA.getSkill Skill
    Ability.SkMaxCalm AspectRecord
    arItem Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)
      -- Create actor.
      factionD <- getsState sfactionD
      curChalSer <- getsServer $ scurChalSer . soptions
      let fact = EnumMap FactionId Faction
    factionD EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
          teamContinuityOurs = FactionKind -> TeamContinuity
    fteam (Faction -> FactionKind
    gkind Faction
    fact)
      bnumberTeam <-
        if bproj then return Nothing else do
          stcounter <- getsServer stcounter
          let number = Int -> TeamContinuity -> EnumMap TeamContinuity Int -> Int
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Int
    0 TeamContinuity
    teamContinuityOurs EnumMap TeamContinuity Int
    stcounter
          modifyServer $ \StateServer
    ser -> StateServer
    ser {stcounter =
            EM.insert teamContinuityOurs (succ number) stcounter}
          return $ Just (number, teamContinuityOurs)
      let bnumber = (Int, TeamContinuity) -> Int
    forall a b. (a, b) -> a
    fst ((Int, TeamContinuity) -> Int)
    -> Maybe (Int, TeamContinuity) -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Int, TeamContinuity)
    bnumberTeam
      -- If difficulty is below standard, HP is added to the UI factions,
      -- otherwise HP is added to their enemies.
      -- If no UI factions, their role is taken by the escapees (for testing).
      let diffBonusCoeff = Int -> Int
    difficultyCoeff (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Challenge -> Int
    cdiff Challenge
    curChalSer
          -- For most projectiles (exceptions are, e.g.,  maxHP boosting rings),
          -- SkMaxHP is zero, which means they drop after one hit regardless
          -- of extra bhp they have due to piercing. That is fine.
          -- If we want armoured missiles, that should not be done via piercing,
          -- but via SkMaxHP of the thrown items. Rings that are piercing
          -- by coincidence are harmless, too. However, piercing should not be
          -- added to missiles via SkMaxHP or equipping them would be beneficial
          -- in a hard to balance way (e.g., one bullet adds 10 SkMaxHP).
          boostFact = Bool -> Bool
    not Bool
    bproj
                      Bool -> Bool -> Bool
    && if Int
    diffBonusCoeff Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                         then ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FactionKind -> Bool
    fhasUI (FactionKind -> Bool)
    -> ((FactionId, Faction) -> FactionKind)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> FactionKind
    gkind (Faction -> FactionKind)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> FactionKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd)
                                  (((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(FactionId
    fi, Faction
    fa) -> FactionId -> Faction -> FactionId -> Bool
    isFriend FactionId
    fi Faction
    fa FactionId
    fid)
                                          (EnumMap FactionId Faction -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap FactionId Faction
    factionD))
                         else ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FactionKind -> Bool
    fhasUI (FactionKind -> Bool)
    -> ((FactionId, Faction) -> FactionKind)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Faction -> FactionKind
    gkind  (Faction -> FactionKind)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> FactionKind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd)
                                  (((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(FactionId
    fi, Faction
    fa) -> FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    fi Faction
    fa FactionId
    fid)
                                          (EnumMap FactionId Faction -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap FactionId Faction
    factionD))
          finalHP | Bool
    boostFact = Int64 -> Int64 -> Int64
    forall a. Ord a => a -> a -> a
    min (Int -> Int64
    xM Int
    899)  -- no more than UI can stand
                                    (Int64
    hp Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    2 Int64 -> Int -> Int64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int -> Int
    forall a. Num a => a -> a
    abs Int
    diffBonusCoeff)
                  | Bool
    otherwise = Int64
    hp
          -- Prevent too high max HP resulting in panic when low HP/max HP ratio.
          maxHP = Int64 -> Int64 -> Int64
    forall a. Ord a => a -> a -> a
    min (Int64
    finalHP Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int -> Int64
    xM Int
    100) (Int64
    2 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    finalHP)
          bonusHP = Int64 -> Int
    forall a. Enum a => a -> Int
    fromEnum (Int64
    maxHP Int64 -> Int64 -> Int64
    forall a. Integral a => a -> a -> a
    `div` Int64
    oneM) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    trunkMaxHP
          healthOrgans = [(Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    bonusHP, (GroupName ItemKind
    IK.S_BONUS_HP, CStore
    COrgan)) | Int
    bonusHP Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0]
          b = ItemId
    -> Maybe Int
    -> Int64
    -> Int64
    -> Point
    -> LevelId
    -> FactionId
    -> Bool
    -> Actor
    actorTemplate ItemId
    trunkId Maybe Int
    bnumber Int64
    finalHP Int64
    calm Point
    pos LevelId
    lid FactionId
    fid Bool
    bproj
          withTrunk =
            Actor
    b { bweapon = if IA.checkFlag Ability.Meleeable arItem then 1 else 0
              , bweapBenign =
                  if IA.checkFlag Ability.Meleeable arItem
                     && IA.checkFlag Ability.Benign arItem then 1 else 0 }
          bodyTweaked = Actor -> Actor
    tweakBody Actor
    withTrunk
      aid <- getsServer sacounter
      modifyServer $ \StateServer
    ser -> StateServer
    ser {sacounter = succ aid}
      execUpdAtomic $ UpdCreateActor aid bodyTweaked [(trunkId, itemBase)]
      unless bproj $ do
        steamGearCur <- getsServer steamGearCur
        let gearList = case Maybe (Int, TeamContinuity)
    bnumberTeam of
              Maybe (Int, TeamContinuity)
    Nothing -> []
              Just (Int
    number, TeamContinuity
    teamContinuity) ->
                case TeamContinuity
    teamContinuity TeamContinuity
    -> GearOfTeams
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    `EM.lookup` GearOfTeams
    steamGearCur of
                  Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    Nothing -> []
                  Just IntMap [(GroupName ItemKind, ContentId ItemKind)]
    im -> [(GroupName ItemKind, ContentId ItemKind)]
    -> Int
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> Int -> IntMap a -> a
    IM.findWithDefault [] Int
    number IntMap [(GroupName ItemKind, ContentId ItemKind)]
    im
        -- Create, register and insert all initial actor items, including
        -- the bonus health organs from difficulty setting.
        forM_ (healthOrgans ++ map (Nothing,) (IK.ikit itemKind))
              $ \(Maybe Int
    mk, (GroupName ItemKind
    ikGrp, CStore
    cstore)) -> do
         -- TODO: remove ASAP. This is a hack that prevents AI from stealing
         -- backstories until there is enough of them in Allure.
         -- Instead, pre-generate 20 player heroes to make sure all unique
         -- backstories are available to the player and so that the order
         -- of games played doesn't affect their availability.
         if GroupName ItemKind
    ikGrp GroupName ItemKind -> GroupName ItemKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> GroupName ItemKind
    forall c. Text -> GroupName c
    DefsInternal.GroupName Text
    "backstory"
            Bool -> Bool -> Bool
    && Maybe (Int, TeamContinuity) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Int, TeamContinuity)
    bnumberTeam
            Bool -> Bool -> Bool
    && ((Int, TeamContinuity) -> TeamContinuity
    forall a b. (a, b) -> b
    snd ((Int, TeamContinuity) -> TeamContinuity)
    -> Maybe (Int, TeamContinuity) -> Maybe TeamContinuity
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Int, TeamContinuity)
    bnumberTeam) Maybe TeamContinuity -> Maybe TeamContinuity -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TeamContinuity -> Maybe TeamContinuity
    forall a. a -> Maybe a
    Just TeamContinuity
    teamExplorer
         then () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
         else do
          let container :: Container
    container = ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    cstore
          Level{ldepth} <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid
          mIidEtc <- case lookup ikGrp gearList of
            Maybe (ContentId ItemKind)
    Nothing -> do
              let itemFreq :: Freqs ItemKind
    itemFreq = [(GroupName ItemKind
    ikGrp, Int
    1)]
              -- Power depth of new items unaffected by number of spawned actors.
              freq <- Int
    -> AbsDepth
    -> Freqs ItemKind
    -> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Int
    -> AbsDepth
    -> Freqs ItemKind
    -> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
    prepareItemKind Int
    0 AbsDepth
    ldepth Freqs ItemKind
    itemFreq
              mIidEtc <- rollAndRegisterItem False ldepth freq container mk
              case (bnumberTeam, mIidEtc) of
                (Just (Int
    number, TeamContinuity
    teamContinuity), Just (ItemId
    _, (ItemFull
    itemFull2, ItemQuant
    _))) -> do
                  let arItem2 :: AspectRecord
    arItem2 = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull2
                      inMetaGame :: Bool
    inMetaGame = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.MetaGame AspectRecord
    arItem2
                      itemKindId2 :: ContentId ItemKind
    itemKindId2 = ItemFull -> ContentId ItemKind
    itemKindId ItemFull
    itemFull2
                  Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    inMetaGame (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                    let altInner :: Maybe [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe [(GroupName ItemKind, ContentId ItemKind)]
    altInner Maybe [(GroupName ItemKind, ContentId ItemKind)]
    ml = [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> Maybe a
    Just ([(GroupName ItemKind, ContentId ItemKind)]
     -> Maybe [(GroupName ItemKind, ContentId ItemKind)])
    -> [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe [(GroupName ItemKind, ContentId ItemKind)]
    forall a b. (a -> b) -> a -> b
    $ (GroupName ItemKind
    ikGrp, ContentId ItemKind
    itemKindId2) (GroupName ItemKind, ContentId ItemKind)
    -> [(GroupName ItemKind, ContentId ItemKind)]
    -> [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> [a] -> [a]
    : [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe [(GroupName ItemKind, ContentId ItemKind)]
    -> [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> Maybe a -> a
    fromMaybe [] Maybe [(GroupName ItemKind, ContentId ItemKind)]
    ml
                        alt :: Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    alt Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    mim =
                          IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    forall a. a -> Maybe a
    Just (IntMap [(GroupName ItemKind, ContentId ItemKind)]
     -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    forall a b. (a -> b) -> a -> b
    $ (Maybe [(GroupName ItemKind, ContentId ItemKind)]
     -> Maybe [(GroupName ItemKind, ContentId ItemKind)])
    -> Int
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
    IM.alter Maybe [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe [(GroupName ItemKind, ContentId ItemKind)]
    altInner Int
    number (IntMap [(GroupName ItemKind, ContentId ItemKind)]
     -> IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a b. (a -> b) -> a -> b
    $ IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> Maybe a -> a
    fromMaybe IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. IntMap a
    IM.empty Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    mim
                    (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 {steamGear = EM.alter alt teamContinuity $ steamGear ser}
                (Maybe (Int, TeamContinuity),
     Maybe (ItemId, (ItemFull, ItemQuant)))
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              return mIidEtc
            Just ContentId ItemKind
    itemKindId2 -> do
              let gearListNew :: [(GroupName ItemKind, ContentId ItemKind)]
    gearListNew = (GroupName ItemKind, ContentId ItemKind)
    -> [(GroupName ItemKind, ContentId ItemKind)]
    -> [(GroupName ItemKind, ContentId ItemKind)]
    forall a. Eq a => a -> [a] -> [a]
    delete (GroupName ItemKind
    ikGrp, ContentId ItemKind
    itemKindId2) [(GroupName ItemKind, ContentId ItemKind)]
    gearList
                  (Int
    number, TeamContinuity
    teamContinuity) = Maybe (Int, TeamContinuity) -> (Int, TeamContinuity)
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe (Int, TeamContinuity)
    bnumberTeam
                  alt :: Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    alt Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    mim =
                    IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    forall a. a -> Maybe a
    Just (IntMap [(GroupName ItemKind, ContentId ItemKind)]
     -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)]))
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    forall a b. (a -> b) -> a -> b
    $ Int
    -> [(GroupName ItemKind, ContentId ItemKind)]
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. Int -> a -> IntMap a -> IntMap a
    IM.insert Int
    number [(GroupName ItemKind, ContentId ItemKind)]
    gearListNew (IntMap [(GroupName ItemKind, ContentId ItemKind)]
     -> IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a b. (a -> b) -> a -> b
    $ IntMap [(GroupName ItemKind, ContentId ItemKind)]
    -> Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    -> IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. a -> Maybe a -> a
    fromMaybe IntMap [(GroupName ItemKind, ContentId ItemKind)]
    forall a. IntMap a
    IM.empty Maybe (IntMap [(GroupName ItemKind, ContentId ItemKind)])
    mim
              (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 {steamGearCur = EM.alter alt teamContinuity steamGearCur}
              let itemKind2 :: ItemKind
    itemKind2 = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId2
                  freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq = (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    forall a. a -> Frequency a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (GroupName ItemKind
    ikGrp, ContentId ItemKind
    itemKindId2, ItemKind
    itemKind2)
              Bool
    -> AbsDepth
    -> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> Container
    -> Maybe Int
    -> m (Maybe (ItemId, (ItemFull, ItemQuant)))
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> AbsDepth
    -> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    -> Container
    -> Maybe Int
    -> m (Maybe (ItemId, (ItemFull, ItemQuant)))
    rollAndRegisterItem Bool
    False AbsDepth
    ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq Container
    container Maybe Int
    mk
          case mIidEtc of
            Maybe (ItemId, (ItemFull, ItemQuant))
    Nothing -> [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char]
    -> (LevelId, GroupName ItemKind, Container, Maybe Int) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (LevelId
    lid, GroupName ItemKind
    ikGrp, Container
    container, Maybe Int
    mk)
            Just (ItemId
    iid, (ItemFull
    itemFull2, ItemQuant
    _)) ->
              Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    cstore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    CGround) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                -- The items are created owned by actors, so won't be picked up,
                -- so we have to discover them now, if eligible.
                Container -> ItemId -> ContentId ItemKind -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Container -> ItemId -> ContentId ItemKind -> m ()
    discoverIfMinorEffects Container
    container ItemId
    iid (ItemFull -> ContentId ItemKind
    itemKindId ItemFull
    itemFull2)
      return aid
    addActorIid ItemId
    _ ItemFull
    _ Bool
    _ FactionId
    _ Point
    _ LevelId
    _ Actor -> Actor
    _ = [Char] -> m ActorId
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "addActorIid: server ignorant about an item"

    discoverIfMinorEffects :: MonadServerAtomic m
                           => Container -> ItemId -> ContentId ItemKind -> m ()
    discoverIfMinorEffects :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Container -> ItemId -> ContentId ItemKind -> m ()
    discoverIfMinorEffects Container
    c ItemId
    iid ContentId ItemKind
    itemKindId = do
      COps{coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      discoAspect <- getsState sdiscoAspect
      let arItem = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid
          itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
       -- Otherwise, discover by use when item's effects get activated later on.
      when (IA.onlyMinorEffects arItem itemKind
            && not (IA.isHumanTrinket itemKind)) $
        execUpdAtomic $ UpdDiscover c iid itemKindId arItem

    pickWeaponServer :: MonadServer m
                     => ActorId -> ActorId -> m (Maybe (ItemId, CStore))
    pickWeaponServer :: forall (m :: * -> *).
    MonadServer m =>
    ActorId -> ActorId -> m (Maybe (ItemId, CStore))
    pickWeaponServer ActorId
    source ActorId
    target = do
      eqpAssocs <- (State -> [(ItemId, (ItemFull, ItemQuant))])
    -> m [(ItemId, (ItemFull, ItemQuant))]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [(ItemId, (ItemFull, ItemQuant))])
     -> m [(ItemId, (ItemFull, ItemQuant))])
    -> (State -> [(ItemId, (ItemFull, ItemQuant))])
    -> m [(ItemId, (ItemFull, ItemQuant))]
    forall a b. (a -> b) -> a -> b
    $ ActorId -> [CStore] -> State -> [(ItemId, (ItemFull, ItemQuant))]
    kitAssocs ActorId
    source [CStore
    CEqp]
      bodyAssocs <- getsState $ kitAssocs source [COrgan]
      actorSk <- currentSkillsServer source
      sb <- getsState $ getActorBody source
      tb <- getsState $ getActorBody target
      let kitAssRaw = [(ItemId, (ItemFull, ItemQuant))]
    eqpAssocs [(ItemId, (ItemFull, ItemQuant))]
    -> [(ItemId, (ItemFull, ItemQuant))]
    -> [(ItemId, (ItemFull, ItemQuant))]
    forall a. [a] -> [a] -> [a]
    ++ [(ItemId, (ItemFull, ItemQuant))]
    bodyAssocs
          forced = Actor -> Bool
    bproj Actor
    sb
          kitAss | Bool
    forced = [(ItemId, (ItemFull, ItemQuant))]
    kitAssRaw  -- for projectiles, anything is weapon
                 | Bool
    otherwise =
                     ((ItemId, (ItemFull, ItemQuant)) -> Bool)
    -> [(ItemId, (ItemFull, ItemQuant))]
    -> [(ItemId, (ItemFull, ItemQuant))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Meleeable
                             (AspectRecord -> Bool)
    -> ((ItemId, (ItemFull, ItemQuant)) -> AspectRecord)
    -> (ItemId, (ItemFull, ItemQuant))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemFull -> AspectRecord
    aspectRecordFull (ItemFull -> AspectRecord)
    -> ((ItemId, (ItemFull, ItemQuant)) -> ItemFull)
    -> (ItemId, (ItemFull, ItemQuant))
    -> AspectRecord
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemFull, ItemQuant) -> ItemFull
    forall a b. (a, b) -> a
    fst ((ItemFull, ItemQuant) -> ItemFull)
    -> ((ItemId, (ItemFull, ItemQuant)) -> (ItemFull, ItemQuant))
    -> (ItemId, (ItemFull, ItemQuant))
    -> ItemFull
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemId, (ItemFull, ItemQuant)) -> (ItemFull, ItemQuant)
    forall a b. (a, b) -> b
    snd) [(ItemId, (ItemFull, ItemQuant))]
    kitAssRaw
          benign ItemFull
    itemFull = let arItem :: AspectRecord
    arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
                            in Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Benign AspectRecord
    arItem
      -- Server ignores item effects or it would leak item discovery info.
      -- Hence, weapons with powerful burning or wouding are undervalued.
      -- In particular, it even uses weapons that would heal an opponent.
      -- But server decides only in exceptiona cases, e.g. projectile collision
      -- or melee in place of an impossible displace. Otherwise, client decides.
      strongest <- pickWeaponM False Nothing kitAss actorSk source
      case strongest of
        [] -> Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ItemId, CStore)
    forall a. Maybe a
    Nothing
        (Double
    _, Bool
    _, Int
    _, Int
    _, ItemId
    _, (ItemFull
    itemFull, ItemQuant
    _)) : [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    _ | Bool -> Bool
    not Bool
    forced
                                             Bool -> Bool -> Bool
    && ItemFull -> Bool
    benign ItemFull
    itemFull Bool -> Bool -> Bool
    && Actor -> Bool
    bproj Actor
    tb ->
          Maybe (ItemId, CStore) -> m (Maybe (ItemId, CStore))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ItemId, CStore)
    forall a. Maybe a
    Nothing  -- if strongest is benign, don't waste fun on a projectile
        iis :: [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    iis@((Double
    value1, Bool
    hasEffect1, Int
    timeout1, Int
    _, ItemId
    _, (ItemFull, ItemQuant)
    _) : [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    _) -> do
          let minIis :: [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    minIis = ((Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant)) -> Bool)
    -> [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    -> [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (\(Double
    value, Bool
    hasEffect, Int
    timeout, Int
    _, ItemId
    _, (ItemFull, ItemQuant)
    _) ->
                                     Double
    value Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    == Double
    value1
                                     Bool -> Bool -> Bool
    && Bool
    hasEffect Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    hasEffect1
                                     Bool -> Bool -> Bool
    && Int
    timeout Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    timeout1)
                                 [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    iis
          (_, _, _, _, iid, _) <- Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
    -> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
    forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
    rndToAction (Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
     -> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant)))
    -> Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
    -> m (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
    forall a b. (a -> b) -> a -> b
    $ [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    -> Rnd (Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))
    forall a. [a] -> Rnd a
    oneOf [(Double, Bool, Int, Int, ItemId, (ItemFull, ItemQuant))]
    minIis
          let cstore = if Maybe (ItemFull, ItemQuant) -> Bool
    forall a. Maybe a -> Bool
    isJust (ItemId
    -> [(ItemId, (ItemFull, ItemQuant))] -> Maybe (ItemFull, ItemQuant)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ItemId
    iid [(ItemId, (ItemFull, ItemQuant))]
    bodyAssocs) then CStore
    COrgan else CStore
    CEqp
          return $ Just (iid, cstore)

    -- @MonadStateRead@ would be enough, but the logic is sound only on server.
    currentSkillsServer :: MonadServer m => ActorId -> m Ability.Skills
    currentSkillsServer :: forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    aid  = do
      body <- (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
      mleader <- getsState $ gleader . (EM.! bfid body) . sfactionD
      getsState $ actorCurrentSkills mleader aid

    getCacheLucid :: MonadServer m => LevelId -> m FovLucid
    getCacheLucid :: forall (m :: * -> *). MonadServer m => LevelId -> m FovLucid
    getCacheLucid LevelId
    lid = do
      fovClearLid <- (StateServer -> FovClearLid) -> m FovClearLid
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> FovClearLid
    sfovClearLid
      fovLitLid <- getsServer sfovLitLid
      fovLucidLid <- getsServer sfovLucidLid
      let getNewLucid = (State -> FovLucid) -> m FovLucid
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> FovLucid) -> m FovLucid)
    -> (State -> FovLucid) -> m FovLucid
    forall a b. (a -> b) -> a -> b
    $ \State
    s ->
            FovClearLid -> FovLitLid -> State -> LevelId -> Level -> FovLucid
    lucidFromLevel FovClearLid
    fovClearLid FovLitLid
    fovLitLid State
    s LevelId
    lid (State -> Dungeon
    sdungeon State
    s Dungeon -> LevelId -> Level
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid)
      case EM.lookup lid fovLucidLid of
        Just (FovValid FovLucid
    fovLucid) -> FovLucid -> m FovLucid
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FovLucid
    fovLucid
        Maybe (FovValid FovLucid)
    _ -> do
          newLucid <- m FovLucid
    getNewLucid
          modifyServer $ \StateServer
    ser ->
            StateServer
    ser {sfovLucidLid = EM.insert lid (FovValid newLucid)
                                $ sfovLucidLid ser}
          return newLucid

    getCacheTotal :: MonadServer m => FactionId -> LevelId -> m CacheBeforeLucid
    getCacheTotal :: forall (m :: * -> *).
    MonadServer m =>
    FactionId -> LevelId -> m CacheBeforeLucid
    getCacheTotal FactionId
    fid LevelId
    lid = do
      sperCacheFidOld <- (StateServer -> PerCacheFid) -> m PerCacheFid
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> PerCacheFid
    sperCacheFid
      let perCacheOld = PerCacheFid
    sperCacheFidOld PerCacheFid -> FactionId -> EnumMap LevelId PerceptionCache
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid EnumMap LevelId PerceptionCache -> LevelId -> PerceptionCache
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid
      case ptotal perCacheOld of
        FovValid CacheBeforeLucid
    total -> CacheBeforeLucid -> m CacheBeforeLucid
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CacheBeforeLucid
    total
        FovValid CacheBeforeLucid
    FovInvalid -> do
          actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ActorMaxSkills
    sactorMaxSkills
          fovClearLid <- getsServer sfovClearLid
          getActorB <- getsState $ flip getActorBody
          let perActorNew =
                PerActor
    -> (ActorId -> Actor) -> ActorMaxSkills -> FovClear -> PerActor
    perActorFromLevel (PerceptionCache -> PerActor
    perActor PerceptionCache
    perCacheOld) ActorId -> Actor
    getActorB
                                  ActorMaxSkills
    actorMaxSkills (FovClearLid
    fovClearLid FovClearLid -> LevelId -> FovClear
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid)
              -- We don't check if any actor changed, because almost surely one is.
              -- Exception: when an actor is destroyed, but then union differs, too.
              total = PerActor -> CacheBeforeLucid
    totalFromPerActor PerActor
    perActorNew
              perCache = PerceptionCache { ptotal :: FovValid CacheBeforeLucid
    ptotal = CacheBeforeLucid -> FovValid CacheBeforeLucid
    forall a. a -> FovValid a
    FovValid CacheBeforeLucid
    total
                                         , perActor :: PerActor
    perActor = PerActor
    perActorNew }
              fperCache = (EnumMap LevelId PerceptionCache
     -> EnumMap LevelId PerceptionCache)
    -> FactionId -> PerCacheFid -> PerCacheFid
    forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
    EM.adjust (LevelId
    -> PerceptionCache
    -> EnumMap LevelId PerceptionCache
    -> EnumMap LevelId PerceptionCache
    forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
    EM.insert LevelId
    lid PerceptionCache
    perCache) FactionId
    fid
          modifyServer $ \StateServer
    ser -> StateServer
    ser {sperCacheFid = fperCache $ sperCacheFid ser}
          return total

    allGroupItems :: MonadServerAtomic m
                  => CStore -> GroupName ItemKind -> ActorId
                  -> m [(ItemId, ItemQuant)]
    allGroupItems :: forall (m :: * -> *).
    MonadServerAtomic m =>
    CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
    allGroupItems CStore
    store GroupName ItemKind
    grp ActorId
    target = do
      COps{coitem} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      b <- getsState $ getActorBody target
      assocsCStore <- getsState $ EM.assocs . getBodyStoreBag b store
      getKindId <- getsState $ flip getIidKindIdServer
      let assocsKindId = ((ItemId, ItemQuant) -> (ContentId ItemKind, (ItemId, ItemQuant)))
    -> [(ItemId, ItemQuant)]
    -> [(ContentId ItemKind, (ItemId, ItemQuant))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\as :: (ItemId, ItemQuant)
    as@(ItemId
    iid, ItemQuant
    _) -> (ItemId -> ContentId ItemKind
    getKindId ItemId
    iid, (ItemId, ItemQuant)
    as)) [(ItemId, ItemQuant)]
    assocsCStore
          hasGroup (ContentId ItemKind
    itemKindId, (ItemId, ItemQuant)
    _) =
            Bool -> (Int -> Bool) -> Maybe Int -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (Maybe Int -> Bool) -> Maybe Int -> Bool
    forall a b. (a -> b) -> a -> b
    $ GroupName ItemKind -> Freqs ItemKind -> Maybe Int
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup GroupName ItemKind
    grp (Freqs ItemKind -> Maybe Int) -> Freqs ItemKind -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> Freqs ItemKind
    IK.ifreq (ItemKind -> Freqs ItemKind) -> ItemKind -> Freqs ItemKind
    forall a b. (a -> b) -> a -> b
    $ ContentData ItemKind -> ContentId ItemKind -> ItemKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData ItemKind
    coitem ContentId ItemKind
    itemKindId
      return $! map snd $ sortBy (comparing fst) $ filter hasGroup assocsKindId

    addCondition :: MonadServerAtomic m
                 => Bool -> GroupName ItemKind -> ActorId -> m ()
    addCondition :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> GroupName ItemKind -> ActorId -> m ()
    addCondition Bool
    verbose GroupName ItemKind
    name ActorId
    aid = 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
    aid
      Level{ldepth} <- getLevel $ blid b
      let c = ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    COrgan
      -- Power depth of new items unaffected by number of spawned actors.
      freq <- prepareItemKind 0 ldepth [(name, 1)]
      mresult <- rollAndRegisterItem verbose ldepth freq c Nothing
      assert (isJust mresult) $ return ()

    removeConditionSingle :: MonadServerAtomic m
                          => GroupName ItemKind -> ActorId -> m Int
    removeConditionSingle :: forall (m :: * -> *).
    MonadServerAtomic m =>
    GroupName ItemKind -> ActorId -> m Int
    removeConditionSingle GroupName ItemKind
    name ActorId
    aid = do
      let c :: Container
    c = ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    COrgan
      is <- CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
    forall (m :: * -> *).
    MonadServerAtomic m =>
    CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
    allGroupItems CStore
    COrgan GroupName ItemKind
    name ActorId
    aid
      case is of
        [(ItemId
    iid, (Int
    nAll, ItemTimers
    itemTimer))] -> do
          UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdLoseItem Bool
    False ItemId
    iid (Int
    1, ItemTimers
    itemTimer) Container
    c
          Int -> m Int
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> m Int) -> Int -> m Int
    forall a b. (a -> b) -> a -> b
    $ Int
    nAll Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
        [(ItemId, ItemQuant)]
    _ -> [Char] -> m Int
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m Int) -> [Char] -> m Int
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "missing or multiple item" [Char] -> (GroupName ItemKind, [(ItemId, ItemQuant)]) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (GroupName ItemKind
    name, [(ItemId, ItemQuant)]
    is)

    addSleep :: MonadServerAtomic m => ActorId -> m ()
    addSleep :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    addSleep ActorId
    aid = 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
    aid
      addCondition True IK.S_ASLEEP aid
      execUpdAtomic $ UpdWaitActor aid (bwatch b) WSleep

    removeSleepSingle :: MonadServerAtomic m => ActorId -> m ()
    removeSleepSingle :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    removeSleepSingle ActorId
    aid = do
      nAll <- GroupName ItemKind -> ActorId -> m Int
    forall (m :: * -> *).
    MonadServerAtomic m =>
    GroupName ItemKind -> ActorId -> m Int
    removeConditionSingle GroupName ItemKind
    IK.S_ASLEEP ActorId
    aid
      when (nAll == 0) $
        execUpdAtomic $ UpdWaitActor aid WWake WWatch

    addKillToAnalytics :: MonadServerAtomic m
                       => ActorId -> KillHow -> FactionId -> ItemId -> m ()
    addKillToAnalytics :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> KillHow -> FactionId -> ItemId -> m ()
    addKillToAnalytics ActorId
    aid KillHow
    killHow FactionId
    fid ItemId
    iid = do
      actorD <- (State -> ActorDict) -> m ActorDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ActorDict
    sactorD
      case EM.lookup aid actorD of
        Just Actor
    b ->
          (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 { sfactionAn = addFactionKill (bfid b) killHow fid iid
                               $ sfactionAn ser
                , sactorAn = addActorKill aid killHow fid iid
                             $ sactorAn ser }
        Maybe Actor
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- killer dead, too late to assign blame