    {-# LANGUAGE FlexibleContexts #-}
    -- | Semantics of atomic commands shared by client and server.
    --
    -- See
    -- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.
    module Game.LambdaHack.Atomic.HandleAtomicWrite
      ( handleUpdAtomic
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , updRegisterItems, updCreateActor, updDestroyActor
      , updCreateItem, updDestroyItem, updSpotItemBag, updLoseItemBag
      , updMoveActor, updWaitActor, updDisplaceActor, updMoveItem
      , updRefillHP, updRefillCalm
      , updTrajectory, updQuitFaction, updSpotStashFaction, updLoseStashFaction
      , updLeadFaction, updDiplFaction, updDoctrineFaction, updAutoFaction
      , updRecordKill, updAlterTile, updAlterExplorable, updSearchTile
      , updSpotTile, updLoseTile, updAlterSmell, updSpotSmell, updLoseSmell
      , updTimeItem, updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover
      , updDiscoverKind, discoverKind, updCoverKind
      , updDiscoverAspect, discoverAspect, updCoverAspect
      , updDiscoverServer, updCoverServer
      , updRestart, updRestartServer, updResumeServer
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Int (Int64)

    import           Game.LambdaHack.Atomic.CmdAtomic
    import           Game.LambdaHack.Atomic.MonadStateWrite
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    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.MonadStateRead
    import           Game.LambdaHack.Common.Perception
    import           Game.LambdaHack.Common.Point
    import qualified Game.LambdaHack.Common.PointArray as PointArray
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import           Game.LambdaHack.Common.Vector
    import           Game.LambdaHack.Content.FactionKind
    import           Game.LambdaHack.Content.ItemKind (ItemKind)
    import qualified Game.LambdaHack.Content.PlaceKind as PK
    import           Game.LambdaHack.Content.TileKind (TileKind, unknownId)
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import           Game.LambdaHack.Definition.Defs

    -- | The game-state semantics of atomic game commands.
    -- There is no corresponding definition for special effects (@SfxAtomic@),
    -- because they don't modify 'State'.
    --
    -- For each of the commands, we are guaranteed that the client,
    -- the command is addressed to, perceives all the positions the command
    -- affects (as computed by 'Game.LambdaHack.Atomic.PosAtomicRead.posUpdAtomic').
    -- In the code for each semantic function we additonally verify
    -- the client is aware of any relevant items and/or actors and we throw
    -- the @AtomicFail@ exception if it's not.
    -- The server keeps copies of all clients' states and, before sending a command
    -- to a client, applies it to the client's state copy.
    -- If @AtomicFail@ is signalled, the command is ignored for that client.
    -- This enables simpler server code that addresses commands to all clients
    -- that can see it, even though not all are able to process it.
    handleUpdAtomic :: MonadStateWrite m => UpdAtomic -> m ()
    handleUpdAtomic :: forall (m :: * -> *). MonadStateWrite m => UpdAtomic -> m ()
    handleUpdAtomic UpdAtomic
    cmd = case UpdAtomic
    cmd of
      UpdRegisterItems [(ItemId, Item)]
    ais -> [(ItemId, Item)] -> m ()
    forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
    updRegisterItems [(ItemId, Item)]
    ais
      UpdCreateActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais -> ActorId -> Actor -> [(ItemId, Item)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updCreateActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais
      UpdDestroyActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais -> ActorId -> Actor -> [(ItemId, Item)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updDestroyActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais
      UpdCreateItem Bool
    _ ItemId
    iid Item
    item ItemQuant
    kit Container
    c -> ItemId -> Item -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> ItemQuant -> Container -> m ()
    updCreateItem ItemId
    iid Item
    item ItemQuant
    kit Container
    c
      UpdDestroyItem Bool
    _ ItemId
    iid Item
    item ItemQuant
    kit Container
    c -> ItemId -> Item -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> ItemQuant -> Container -> m ()
    updDestroyItem ItemId
    iid Item
    item ItemQuant
    kit Container
    c
      UpdSpotActor ActorId
    aid Actor
    body -> ActorId -> Actor -> m ()
    forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
    updSpotActor ActorId
    aid Actor
    body
      UpdLoseActor ActorId
    aid Actor
    body -> ActorId -> Actor -> m ()
    forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
    updLoseActor ActorId
    aid Actor
    body
      UpdSpotItem Bool
    _ ItemId
    iid ItemQuant
    kit Container
    c -> ItemId -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    updSpotItem ItemId
    iid ItemQuant
    kit Container
    c
      UpdLoseItem Bool
    _ ItemId
    iid ItemQuant
    kit Container
    c -> ItemId -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    updLoseItem ItemId
    iid ItemQuant
    kit Container
    c
      UpdSpotItemBag Bool
    _ Container
    c ItemBag
    bag -> Container -> ItemBag -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemBag -> m ()
    updSpotItemBag Container
    c ItemBag
    bag
      UpdLoseItemBag Bool
    _ Container
    c ItemBag
    bag -> Container -> ItemBag -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemBag -> m ()
    updLoseItemBag Container
    c ItemBag
    bag
      UpdMoveActor ActorId
    aid Point
    fromP Point
    toP -> ActorId -> Point -> Point -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Point -> Point -> m ()
    updMoveActor ActorId
    aid Point
    fromP Point
    toP
      UpdWaitActor ActorId
    aid Watchfulness
    fromWS Watchfulness
    toWS -> ActorId -> Watchfulness -> Watchfulness -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Watchfulness -> Watchfulness -> m ()
    updWaitActor ActorId
    aid Watchfulness
    fromWS Watchfulness
    toWS
      UpdDisplaceActor ActorId
    source ActorId
    target -> ActorId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> ActorId -> m ()
    updDisplaceActor ActorId
    source ActorId
    target
      UpdMoveItem ItemId
    iid Int
    k ActorId
    aid CStore
    c1 CStore
    c2 -> ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
    updMoveItem ItemId
    iid Int
    k ActorId
    aid CStore
    c1 CStore
    c2
      UpdRefillHP ActorId
    aid Int64
    n -> ActorId -> Int64 -> m ()
    forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillHP ActorId
    aid Int64
    n
      UpdRefillCalm ActorId
    aid Int64
    n -> ActorId -> Int64 -> m ()
    forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillCalm ActorId
    aid Int64
    n
      UpdTrajectory ActorId
    aid Maybe ([Vector], Speed)
    fromT Maybe ([Vector], Speed)
    toT -> ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
    updTrajectory ActorId
    aid Maybe ([Vector], Speed)
    fromT Maybe ([Vector], Speed)
    toT
      UpdQuitFaction FactionId
    fid Maybe Status
    fromSt Maybe Status
    toSt Maybe (FactionAnalytics, GenerationAnalytics)
    _ -> FactionId -> Maybe Status -> Maybe Status -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Maybe Status -> Maybe Status -> m ()
    updQuitFaction FactionId
    fid Maybe Status
    fromSt Maybe Status
    toSt
      UpdSpotStashFaction Bool
    _ FactionId
    fid LevelId
    lid Point
    pos -> FactionId -> LevelId -> Point -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> LevelId -> Point -> m ()
    updSpotStashFaction FactionId
    fid LevelId
    lid Point
    pos
      UpdLoseStashFaction Bool
    _ FactionId
    fid LevelId
    lid Point
    pos -> FactionId -> LevelId -> Point -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> LevelId -> Point -> m ()
    updLoseStashFaction FactionId
    fid LevelId
    lid Point
    pos
      UpdLeadFaction FactionId
    fid Maybe ActorId
    source Maybe ActorId
    target -> FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
    updLeadFaction FactionId
    fid Maybe ActorId
    source Maybe ActorId
    target
      UpdDiplFaction FactionId
    fid1 FactionId
    fid2 Diplomacy
    fromDipl Diplomacy
    toDipl ->
        FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
    updDiplFaction FactionId
    fid1 FactionId
    fid2 Diplomacy
    fromDipl Diplomacy
    toDipl
      UpdDoctrineFaction FactionId
    fid Doctrine
    toT Doctrine
    fromT -> FactionId -> Doctrine -> Doctrine -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Doctrine -> Doctrine -> m ()
    updDoctrineFaction FactionId
    fid Doctrine
    toT Doctrine
    fromT
      UpdAutoFaction FactionId
    fid Bool
    st -> FactionId -> Bool -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Bool -> m ()
    updAutoFaction FactionId
    fid Bool
    st
      UpdRecordKill ActorId
    aid ContentId ItemKind
    ikind Int
    k -> ActorId -> ContentId ItemKind -> Int -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> ContentId ItemKind -> Int -> m ()
    updRecordKill ActorId
    aid ContentId ItemKind
    ikind Int
    k
      UpdAlterTile LevelId
    lid Point
    p ContentId TileKind
    fromTile ContentId TileKind
    toTile -> LevelId
    -> Point -> ContentId TileKind -> ContentId TileKind -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId
    -> Point -> ContentId TileKind -> ContentId TileKind -> m ()
    updAlterTile LevelId
    lid Point
    p ContentId TileKind
    fromTile ContentId TileKind
    toTile
      UpdAlterExplorable LevelId
    lid Int
    delta -> LevelId -> Int -> m ()
    forall (m :: * -> *). MonadStateWrite m => LevelId -> Int -> m ()
    updAlterExplorable LevelId
    lid Int
    delta
      UpdAlterGold Int
    delta -> Int -> m ()
    forall (m :: * -> *). MonadStateWrite m => Int -> m ()
    updAlterGold Int
    delta
      UpdSearchTile ActorId
    aid Point
    p ContentId TileKind
    toTile -> ActorId -> Point -> ContentId TileKind -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Point -> ContentId TileKind -> m ()
    updSearchTile ActorId
    aid Point
    p ContentId TileKind
    toTile
      UpdHideTile{} -> m ()
    forall a. HasCallStack => a
    undefined
      UpdSpotTile LevelId
    lid [(Point, ContentId TileKind)]
    ts -> LevelId -> [(Point, ContentId TileKind)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, ContentId TileKind)] -> m ()
    updSpotTile LevelId
    lid [(Point, ContentId TileKind)]
    ts
      UpdLoseTile LevelId
    lid [(Point, ContentId TileKind)]
    ts -> LevelId -> [(Point, ContentId TileKind)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, ContentId TileKind)] -> m ()
    updLoseTile LevelId
    lid [(Point, ContentId TileKind)]
    ts
      UpdSpotEntry LevelId
    lid [(Point, PlaceEntry)]
    ts -> LevelId -> [(Point, PlaceEntry)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, PlaceEntry)] -> m ()
    updSpotEntry LevelId
    lid [(Point, PlaceEntry)]
    ts
      UpdLoseEntry LevelId
    lid [(Point, PlaceEntry)]
    ts -> LevelId -> [(Point, PlaceEntry)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, PlaceEntry)] -> m ()
    updLoseEntry LevelId
    lid [(Point, PlaceEntry)]
    ts
      UpdAlterSmell LevelId
    lid Point
    p Time
    fromSm Time
    toSm -> LevelId -> Point -> Time -> Time -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> Point -> Time -> Time -> m ()
    updAlterSmell LevelId
    lid Point
    p Time
    fromSm Time
    toSm
      UpdSpotSmell LevelId
    lid [(Point, Time)]
    sms -> LevelId -> [(Point, Time)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, Time)] -> m ()
    updSpotSmell LevelId
    lid [(Point, Time)]
    sms
      UpdLoseSmell LevelId
    lid [(Point, Time)]
    sms -> LevelId -> [(Point, Time)] -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, Time)] -> m ()
    updLoseSmell LevelId
    lid [(Point, Time)]
    sms
      UpdTimeItem ItemId
    iid Container
    c ItemTimers
    fromIt ItemTimers
    toIt -> ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
    updTimeItem ItemId
    iid Container
    c ItemTimers
    fromIt ItemTimers
    toIt
      UpdAgeGame EnumSet LevelId
    lids -> EnumSet LevelId -> m ()
    forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
    updAgeGame EnumSet LevelId
    lids
      UpdUnAgeGame EnumSet LevelId
    lids -> EnumSet LevelId -> m ()
    forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
    updUnAgeGame EnumSet LevelId
    lids
      UpdDiscover Container
    c ItemId
    iid ContentId ItemKind
    ik AspectRecord
    arItem -> Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    updDiscover Container
    c ItemId
    iid ContentId ItemKind
    ik AspectRecord
    arItem
      UpdCover Container
    c ItemId
    iid ContentId ItemKind
    ik AspectRecord
    arItem -> Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    forall (m :: * -> *).
    Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    updCover Container
    c ItemId
    iid ContentId ItemKind
    ik AspectRecord
    arItem
      UpdDiscoverKind Container
    c ItemKindIx
    ix ContentId ItemKind
    ik -> Container -> ItemKindIx -> ContentId ItemKind -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updDiscoverKind Container
    c ItemKindIx
    ix ContentId ItemKind
    ik
      UpdCoverKind Container
    c ItemKindIx
    ix ContentId ItemKind
    ik -> Container -> ItemKindIx -> ContentId ItemKind -> m ()
    forall (m :: * -> *).
    Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updCoverKind Container
    c ItemKindIx
    ix ContentId ItemKind
    ik
      UpdDiscoverAspect Container
    c ItemId
    iid AspectRecord
    arItem -> Container -> ItemId -> AspectRecord -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemId -> AspectRecord -> m ()
    updDiscoverAspect Container
    c ItemId
    iid AspectRecord
    arItem
      UpdCoverAspect Container
    c ItemId
    iid AspectRecord
    arItem -> Container -> ItemId -> AspectRecord -> m ()
    forall (m :: * -> *). Container -> ItemId -> AspectRecord -> m ()
    updCoverAspect Container
    c ItemId
    iid AspectRecord
    arItem
      UpdDiscoverServer ItemId
    iid AspectRecord
    arItem -> ItemId -> AspectRecord -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    updDiscoverServer ItemId
    iid AspectRecord
    arItem
      UpdCoverServer ItemId
    iid AspectRecord
    arItem -> ItemId -> AspectRecord -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    updCoverServer ItemId
    iid AspectRecord
    arItem
      UpdPerception LevelId
    _ Perception
    outPer Perception
    inPer ->
        Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Perception -> Bool
    nullPer Perception
    outPer Bool -> Bool -> Bool
    && Perception -> Bool
    nullPer Perception
    inPer)) (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
      UpdRestart FactionId
    _ PerLid
    _ State
    s Challenge
    _ ClientOptions
    _ SMGen
    _ -> State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updRestart State
    s
      UpdRestartServer State
    s -> State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updRestartServer State
    s
      UpdResume{} -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      UpdResumeServer State
    s -> State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updResumeServer State
    s
      UpdKillExit{} -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      UpdAtomic
    UpdWriteSave -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      UpdHearFid{} -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      UpdMuteMessages{} -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- Actor's items may or may not be already present in @sitemD@,
    -- regardless if they are already present otherwise in the dungeon.
    -- We re-add them all to save time determining which really need it.
    -- If collision occurs, pick the item found on easier level.
    updRegisterItems :: MonadStateWrite m => [(ItemId, Item)] -> m ()
    updRegisterItems :: forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
    updRegisterItems [(ItemId, Item)]
    ais = do
      let h :: Item -> Item -> Item
    h Item
    item1 Item
    item2 =
            Bool -> Item -> Item
    forall a. HasCallStack => Bool -> a -> a
    assert (Item -> Item -> Bool
    itemsMatch Item
    item1 Item
    item2
                    Bool -> (String, (Item, Item, [(ItemId, Item)])) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "inconsistent added items"
                    String
    -> (Item, Item, [(ItemId, Item)])
    -> (String, (Item, Item, [(ItemId, Item)]))
    forall v. String -> v -> (String, v)
    `swith` (Item
    item1, Item
    item2, [(ItemId, Item)]
    ais))
                   Item
    item2 -- keep the first found level
      [(ItemId, Item)] -> ((ItemId, Item) -> m ()) -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t a -> (a -> m ()) -> m ()
    forM_ [(ItemId, Item)]
    ais (((ItemId, Item) -> m ()) -> m ())
    -> ((ItemId, Item) -> m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \(ItemId
    iid, Item
    item) -> do
        let f :: State -> State
    f = case Item -> ItemIdentity
    jkind Item
    item of
              IdentityObvious ContentId ItemKind
    _ -> State -> State
    forall a. a -> a
    id
              IdentityCovered ItemKindIx
    ix ContentId ItemKind
    _ ->
                (ItemIxMap -> ItemIxMap) -> State -> State
    updateItemIxMap ((ItemIxMap -> ItemIxMap) -> State -> State)
    -> (ItemIxMap -> ItemIxMap) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ (EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId)
    -> ItemKindIx -> EnumSet ItemId -> ItemIxMap -> ItemIxMap
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.union ItemKindIx
    ix (ItemId -> EnumSet ItemId
    forall k. Enum k => k -> EnumSet k
    ES.singleton ItemId
    iid)
        (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ State -> State
    f (State -> State) -> (State -> State) -> State -> State
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ItemDict -> ItemDict) -> State -> State
    updateItemD ((Item -> Item -> Item) -> ItemId -> Item -> ItemDict -> ItemDict
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Item -> Item -> Item
    h ItemId
    iid Item
    item)

    -- Note: after this command, usually a new leader
    -- for the party should be elected (in case this actor is the only one alive).
    updCreateActor :: MonadStateWrite m
                   => ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updCreateActor :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updCreateActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais = do
      [(ItemId, Item)] -> m ()
    forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
    updRegisterItems [(ItemId, Item)]
    ais
      ActorId -> Actor -> m ()
    forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
    updSpotActor ActorId
    aid Actor
    body

    -- If a leader dies, a new leader should be elected on the server
    -- before this command is executed (not checked).
    updDestroyActor :: MonadStateWrite m
                    => ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updDestroyActor :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Actor -> [(ItemId, Item)] -> m ()
    updDestroyActor ActorId
    aid Actor
    body [(ItemId, Item)]
    ais = do
      -- Assert that actor's items belong to @sitemD@. Do not remove those
      -- that do not appear anywhere else, for simplicity and speed.
      itemD <- (State -> ItemDict) -> m ItemDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ItemDict
    sitemD
      let match (ItemId
    iid, Item
    item) = Item -> Item -> Bool
    itemsMatch (ItemDict
    itemD ItemDict -> ItemId -> Item
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid) Item
    item
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (((ItemId, Item) -> Bool) -> [(ItemId, Item)] -> Bool
    forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB (ItemId, Item) -> Bool
    match [(ItemId, Item)]
    ais Bool
    -> (String, (ActorId, Actor, [(ItemId, Item)], ItemDict)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "destroyed actor items not found"
                        String
    -> (ActorId, Actor, [(ItemId, Item)], ItemDict)
    -> (String, (ActorId, Actor, [(ItemId, Item)], ItemDict))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aid, Actor
    body, [(ItemId, Item)]
    ais, ItemDict
    itemD)) ()
      updLoseActor aid body

    -- Create a few copies of an item that is already registered for the dungeon
    -- (in @sitemRev@ field of @StateServer@).
    --
    -- Number of copies may be zero, when the item is only created as a sample
    -- to let the player know what can potentially be genereated in the dungeon.
    updCreateItem :: MonadStateWrite m
                  => ItemId -> Item -> ItemQuant -> Container -> m ()
    updCreateItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> ItemQuant -> Container -> m ()
    updCreateItem ItemId
    iid Item
    item ItemQuant
    kit Container
    c = do
      [(ItemId, Item)] -> m ()
    forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
    updRegisterItems [(ItemId
    iid, Item
    item)]
      ItemId -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    updSpotItem ItemId
    iid ItemQuant
    kit Container
    c

    -- Destroy some copies (possibly not all) of an item.
    updDestroyItem :: MonadStateWrite m
                   => ItemId -> Item -> ItemQuant -> Container -> m ()
    updDestroyItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> ItemQuant -> Container -> m ()
    updDestroyItem ItemId
    iid Item
    item kit :: ItemQuant
    kit@(Int
    k, ItemTimers
    _) Container
    c = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      -- Do not remove the item from @sitemD@ nor from @sitemRev@
      -- nor from @DiscoveryAspect@, @ItemIxMap@, etc.
      -- It's incredibly costly and not particularly noticeable for the player.
      -- Moreover, copies of the item may reappear in the future
      -- and then we save computation and the player remembers past discovery.
      -- However, assert the item is registered in @sitemD@.
      itemD <- (State -> ItemDict) -> m ItemDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ItemDict
    sitemD
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert ((case ItemId
    iid ItemId -> ItemDict -> Maybe Item
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    `EM.lookup` ItemDict
    itemD of
                            Maybe Item
    Nothing -> Bool
    False
                            Just Item
    item0 -> Item -> Item -> Bool
    itemsMatch Item
    item0 Item
    item)
                        Bool -> (String, (ItemId, Item, ItemDict)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "item already removed"
                        String
    -> (ItemId, Item, ItemDict) -> (String, (ItemId, Item, ItemDict))
    forall v. String -> v -> (String, v)
    `swith` (ItemId
    iid, Item
    item, ItemDict
    itemD)) ()
      updLoseItem iid kit c

    updSpotActor :: MonadStateWrite m => ActorId -> Actor -> m ()
    updSpotActor :: forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
    updSpotActor ActorId
    aid Actor
    body = do
      -- The exception is possible, e.g., when we teleport and so see our actor
      -- at the new location, but also the location is part of new perception,
      -- so @UpdSpotActor@ is sent.
      let f :: Maybe Actor -> Maybe Actor
    f Maybe Actor
    Nothing = Actor -> Maybe Actor
    forall a. a -> Maybe a
    Just Actor
    body
          f (Just Actor
    b) = Bool -> Maybe Actor -> Maybe Actor
    forall a. HasCallStack => Bool -> a -> a
    assert (Actor
    body Actor -> Actor -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor
    b Bool -> (ActorId, Actor, Actor) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (ActorId
    aid, Actor
    body, Actor
    b)) (Maybe Actor -> Maybe Actor) -> Maybe Actor -> Maybe Actor
    forall a b. (a -> b) -> a -> b
    $
            String -> Maybe Actor
    forall a. String -> a
    atomicFail (String -> Maybe Actor) -> String -> Maybe Actor
    forall a b. (a -> b) -> a -> b
    $ String
    "actor already added" String -> (ActorId, Actor, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body, Actor
    b)
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (ActorDict -> ActorDict) -> State -> State
    updateActorD ((ActorDict -> ActorDict) -> State -> State)
    -> (ActorDict -> ActorDict) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ (Maybe Actor -> Maybe Actor) -> ActorId -> ActorDict -> ActorDict
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe Actor -> Maybe Actor
    f ActorId
    aid
      let g :: Maybe [ActorId] -> Maybe [ActorId]
    g Maybe [ActorId]
    Nothing = [ActorId] -> Maybe [ActorId]
    forall a. a -> Maybe a
    Just [ActorId
    aid]
          g (Just [ActorId]
    l) =
    #ifdef WITH_EXPENSIVE_ASSERTIONS
            -- Not so much expensive, as doubly impossible.
            assert (aid `notElem` l `blame` "actor already added"
                                    `swith` (aid, body, l))
    #endif
            ([ActorId] -> Maybe [ActorId]
    forall a. a -> Maybe a
    Just ([ActorId] -> Maybe [ActorId]) -> [ActorId] -> Maybe [ActorId]
    forall a b. (a -> b) -> a -> b
    $ ActorId
    aid ActorId -> [ActorId] -> [ActorId]
    forall a. a -> [a] -> [a]
    : [ActorId]
    l)
      let h :: Maybe ActorId -> Maybe ActorId
    h Maybe ActorId
    Nothing = ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    aid
          h (Just ActorId
    aid2) = String -> Maybe ActorId
    forall a. HasCallStack => String -> a
    error (String -> Maybe ActorId) -> String -> Maybe ActorId
    forall a b. (a -> b) -> a -> b
    $ String
    "an actor already present there"
                                  String -> (ActorId, Actor, ActorId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body, ActorId
    aid2)
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel (Actor -> LevelId
    blid Actor
    body) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ if Actor -> Bool
    bproj Actor
    body
                                then (ProjectileMap -> ProjectileMap) -> Level -> Level
    updateProjMap ((Maybe [ActorId] -> Maybe [ActorId])
    -> Point -> ProjectileMap -> ProjectileMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe [ActorId] -> Maybe [ActorId]
    g (Actor -> Point
    bpos Actor
    body))
                                else (BigActorMap -> BigActorMap) -> Level -> Level
    updateBigMap ((Maybe ActorId -> Maybe ActorId)
    -> Point -> BigActorMap -> BigActorMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe ActorId -> Maybe ActorId
    h (Actor -> Point
    bpos Actor
    body))
      actorMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ Actor -> State -> Skills
    maxSkillsFromActor Actor
    body
      modifyState $ updateActorMaxSkills $ EM.insert aid actorMaxSk

    updLoseActor :: MonadStateWrite m => ActorId -> Actor ->  m ()
    updLoseActor :: forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
    updLoseActor ActorId
    aid Actor
    body = do
      -- Remove actor from @sactorD@.
      let f :: Maybe Actor -> Maybe Actor
    f Maybe Actor
    Nothing = String -> Maybe Actor
    forall a. HasCallStack => String -> a
    error (String -> Maybe Actor) -> String -> Maybe Actor
    forall a b. (a -> b) -> a -> b
    $ String
    "actor already removed" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body)
          f (Just Actor
    b) = Bool -> Maybe Actor -> Maybe Actor
    forall a. HasCallStack => Bool -> a -> a
    assert (Actor
    b Actor -> Actor -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor
    body Bool -> (String, (ActorId, Actor, Actor)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "inconsistent destroyed actor body"
                                         String
    -> (ActorId, Actor, Actor) -> (String, (ActorId, Actor, Actor))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aid, Actor
    body, Actor
    b)) Maybe Actor
    forall a. Maybe a
    Nothing
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (ActorDict -> ActorDict) -> State -> State
    updateActorD ((ActorDict -> ActorDict) -> State -> State)
    -> (ActorDict -> ActorDict) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ (Maybe Actor -> Maybe Actor) -> ActorId -> ActorDict -> ActorDict
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe Actor -> Maybe Actor
    f ActorId
    aid
      let g :: Maybe [ActorId] -> Maybe [ActorId]
    g Maybe [ActorId]
    Nothing = String -> Maybe [ActorId]
    forall a. HasCallStack => String -> a
    error (String -> Maybe [ActorId]) -> String -> Maybe [ActorId]
    forall a b. (a -> b) -> a -> b
    $ String
    "actor already removed" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body)
          g (Just [ActorId]
    l) =
    #ifdef WITH_EXPENSIVE_ASSERTIONS
            -- Not so much expensive, as doubly impossible.
            assert (aid `elem` l `blame` "actor already removed"
                                 `swith` (aid, body, l))
    #endif
            (let l2 :: [ActorId]
    l2 = ActorId -> [ActorId] -> [ActorId]
    forall a. Eq a => a -> [a] -> [a]
    delete ActorId
    aid [ActorId]
    l
             in if [ActorId] -> Bool
    forall a. [a] -> Bool
    null [ActorId]
    l2 then Maybe [ActorId]
    forall a. Maybe a
    Nothing else [ActorId] -> Maybe [ActorId]
    forall a. a -> Maybe a
    Just [ActorId]
    l2)
      let h :: Maybe ActorId -> Maybe ActorId
    h Maybe ActorId
    Nothing = String -> Maybe ActorId
    forall a. HasCallStack => String -> a
    error (String -> Maybe ActorId) -> String -> Maybe ActorId
    forall a b. (a -> b) -> a -> b
    $ String
    "actor already removed" String -> (ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    body)
          h (Just ActorId
    _aid2) =
    #ifdef WITH_EXPENSIVE_ASSERTIONS
            -- Not so much expensive, as doubly impossible.
            assert (aid == _aid2 `blame` "actor already removed"
                                 `swith` (aid, body, _aid2))
    #endif
            Maybe ActorId
    forall a. Maybe a
    Nothing
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel (Actor -> LevelId
    blid Actor
    body) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ if Actor -> Bool
    bproj Actor
    body
                                then (ProjectileMap -> ProjectileMap) -> Level -> Level
    updateProjMap ((Maybe [ActorId] -> Maybe [ActorId])
    -> Point -> ProjectileMap -> ProjectileMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe [ActorId] -> Maybe [ActorId]
    g (Actor -> Point
    bpos Actor
    body))
                                else (BigActorMap -> BigActorMap) -> Level -> Level
    updateBigMap ((Maybe ActorId -> Maybe ActorId)
    -> Point -> BigActorMap -> BigActorMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe ActorId -> Maybe ActorId
    h (Actor -> Point
    bpos Actor
    body))
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (ActorMaxSkills -> ActorMaxSkills) -> State -> State
    updateActorMaxSkills ((ActorMaxSkills -> ActorMaxSkills) -> State -> State)
    -> (ActorMaxSkills -> ActorMaxSkills) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ ActorId -> ActorMaxSkills -> ActorMaxSkills
    forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
    EM.delete ActorId
    aid

    updSpotItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()
    updSpotItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    updSpotItem ItemId
    iid kit :: ItemQuant
    kit@(Int
    k, ItemTimers
    _) Container
    c = do
      item <- (State -> Item) -> m Item
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> Item
    getItemBody ItemId
    iid
      when (k > 0) $ do
        insertItemContainer iid kit c
        case c of
          CActor ActorId
    aid CStore
    store -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    store CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore
    CEqp, CStore
    COrgan])
                              (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ItemId -> Item -> Int -> ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> Int -> ActorId -> m ()
    addItemToActorMaxSkills ItemId
    iid Item
    item Int
    k ActorId
    aid
          Container
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    updLoseItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()
    updLoseItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    updLoseItem ItemId
    iid kit :: ItemQuant
    kit@(Int
    k, ItemTimers
    _) Container
    c = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      item <- (State -> Item) -> m Item
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> Item
    getItemBody ItemId
    iid
      deleteItemContainer iid kit c
      case c of
        CActor ActorId
    aid CStore
    store -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    store CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore
    CEqp, CStore
    COrgan])
                            (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ItemId -> Item -> Int -> ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> Int -> ActorId -> m ()
    addItemToActorMaxSkills ItemId
    iid Item
    item (-Int
    k) ActorId
    aid
        Container
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()
    updSpotItemBag :: forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemBag -> m ()
    updSpotItemBag Container
    c ItemBag
    bag =
      -- The case of empty bag is for a hack to help identifying sample items.
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ItemBag -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null ItemBag
    bag) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        ItemBag -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemBag -> Container -> m ()
    insertBagContainer ItemBag
    bag Container
    c
        case Container
    c of
          CActor ActorId
    aid CStore
    store ->
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    store CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore
    CEqp, CStore
    COrgan]) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
              itemD <- (State -> ItemDict) -> m ItemDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ItemDict
    sitemD
              let ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ItemId
    iid -> (ItemId
    iid, ItemDict
    itemD ItemDict -> ItemId -> Item
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid)) ([ItemId] -> [(ItemId, Item)]) -> [ItemId] -> [(ItemId, Item)]
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys ItemBag
    bag
              forM_ ais $ \(ItemId
    iid, Item
    item) ->
                ItemId -> Item -> Int -> ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> Int -> ActorId -> m ()
    addItemToActorMaxSkills ItemId
    iid Item
    item (ItemQuant -> Int
    forall a b. (a, b) -> a
    fst (ItemQuant -> Int) -> ItemQuant -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemBag
    bag ItemBag -> ItemId -> ItemQuant
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid) ActorId
    aid
          Container
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()
    updLoseItemBag :: forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemBag -> m ()
    updLoseItemBag Container
    c ItemBag
    bag = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ItemBag -> Int
    forall k a. EnumMap k a -> Int
    EM.size ItemBag
    bag Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      ItemBag -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemBag -> Container -> m ()
    deleteBagContainer ItemBag
    bag Container
    c
      -- Do not remove the items from @sitemD@ nor from @sitemRev@,
      -- It's incredibly costly and not noticeable for the player.
      -- However, assert the items are registered in @sitemD@.
      case Container
    c of
        CActor ActorId
    aid CStore
    store ->
          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    store CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore
    CEqp, CStore
    COrgan]) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            itemD <- (State -> ItemDict) -> m ItemDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ItemDict
    sitemD
            let ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ItemId
    iid -> (ItemId
    iid, ItemDict
    itemD ItemDict -> ItemId -> Item
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid)) ([ItemId] -> [(ItemId, Item)]) -> [ItemId] -> [(ItemId, Item)]
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys ItemBag
    bag
            forM_ ais $ \(ItemId
    iid, Item
    item) ->
              ItemId -> Item -> Int -> ActorId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Item -> Int -> ActorId -> m ()
    addItemToActorMaxSkills ItemId
    iid Item
    item (- (ItemQuant -> Int
    forall a b. (a, b) -> a
    fst (ItemQuant -> Int) -> ItemQuant -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemBag
    bag ItemBag -> ItemId -> ItemQuant
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid)) ActorId
    aid
        Container
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m ()
    updMoveActor :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Point -> Point -> m ()
    updMoveActor ActorId
    aid Point
    fromP Point
    toP = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Point
    fromP Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Point
    toP) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Point
    fromP Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    body
                        Bool -> (String, (ActorId, Point, Point, Point, Actor)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected moved actor position"
                        String
    -> (ActorId, Point, Point, Point, Actor)
    -> (String, (ActorId, Point, Point, Point, Actor))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aid, Point
    fromP, Point
    toP, Actor -> Point
    bpos Actor
    body, Actor
    body)) ()
          newBody = Actor
    body {bpos = toP, boldpos = Just fromP}
      updateActor aid $ const newBody
      moveActorMap aid body newBody

    updWaitActor :: MonadStateWrite m
                 => ActorId -> Watchfulness -> Watchfulness -> m ()
    updWaitActor :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Watchfulness -> Watchfulness -> m ()
    updWaitActor ActorId
    aid Watchfulness
    fromWS Watchfulness
    toWS = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Watchfulness
    fromWS Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Watchfulness
    toWS) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Watchfulness
    fromWS Watchfulness -> Watchfulness -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Watchfulness
    bwatch Actor
    body
                        Bool
    -> (String, (ActorId, Watchfulness, Watchfulness, Actor)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected actor wait state"
                        String
    -> (ActorId, Watchfulness, Watchfulness, Actor)
    -> (String, (ActorId, Watchfulness, Watchfulness, Actor))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aid, Watchfulness
    fromWS, Actor -> Watchfulness
    bwatch Actor
    body, Actor
    body)) ()
      updateActor aid $ \Actor
    b -> Actor
    b {bwatch = toWS}

    updDisplaceActor :: MonadStateWrite m => ActorId -> ActorId -> m ()
    updDisplaceActor :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> ActorId -> m ()
    updDisplaceActor ActorId
    source ActorId
    target = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ActorId
    source ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ActorId
    target) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      sbody <- (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
    source
      tbody <- getsState $ getActorBody target
      let spos = Actor -> Point
    bpos Actor
    sbody
          tpos = Actor -> Point
    bpos Actor
    tbody
          snewBody = Actor
    sbody {bpos = tpos, boldpos = Just spos}
          tnewBody = Actor
    tbody {bpos = spos, boldpos = Just tpos}
      updateActor source $ const snewBody
      updateActor target $ const tnewBody
      swapActorMap source sbody target tbody

    updMoveItem :: MonadStateWrite m
                => ItemId -> Int -> ActorId -> CStore -> CStore
                -> m ()
    updMoveItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
    updMoveItem ItemId
    iid Int
    k ActorId
    aid CStore
    s1 CStore
    s2 = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && CStore
    s1 CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    s2) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      bag <- getsState $ getBodyStoreBag b s1
      case iid `EM.lookup` bag of
        Maybe ItemQuant
    Nothing -> String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ItemId, Int, ActorId, CStore, CStore) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ItemId
    iid, Int
    k, ActorId
    aid, CStore
    s1, CStore
    s2)
        Just (Int
    _, ItemTimers
    it) -> do
          ItemId -> ItemQuant -> ActorId -> CStore -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> ActorId -> CStore -> m ()
    deleteItemActor ItemId
    iid (Int
    k, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    k ItemTimers
    it) ActorId
    aid CStore
    s1
          ItemId -> ItemQuant -> ActorId -> CStore -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> ActorId -> CStore -> m ()
    insertItemActor ItemId
    iid (Int
    k, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    k ItemTimers
    it) ActorId
    aid CStore
    s2
      case s1 of
        CStore
    CEqp -> case CStore
    s2 of
          CStore
    COrgan -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          CStore
    _ -> do
            itemBase <- (State -> Item) -> m Item
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> Item
    getItemBody ItemId
    iid
            addItemToActorMaxSkills iid itemBase (-k) aid
        CStore
    COrgan -> case CStore
    s2 of
          CStore
    CEqp -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          CStore
    _ -> do
            itemBase <- (State -> Item) -> m Item
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> Item
    getItemBody ItemId
    iid
            addItemToActorMaxSkills iid itemBase (-k) aid
        CStore
    _ ->
          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CStore
    s2 CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore
    CEqp, CStore
    COrgan]) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            itemBase <- (State -> Item) -> m Item
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> Item
    getItemBody ItemId
    iid
            addItemToActorMaxSkills iid itemBase k aid

    updRefillHP :: MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillHP :: forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillHP ActorId
    aid Int64
    nRaw =
      ActorId -> (Actor -> Actor) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> (Actor -> Actor) -> m ()
    updateActor ActorId
    aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Actor
    b ->
        -- Make rescue easier by not going into negative HP the first time.
        let newRawHP :: Int64
    newRawHP = Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    nRaw
            newHP :: Int64
    newHP = if Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    0 then Int64
    newRawHP else Int64 -> Int64 -> Int64
    forall a. Ord a => a -> a -> a
    max Int64
    0 Int64
    newRawHP
            n :: Int64
    n = Int64
    newHP Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - Actor -> Int64
    bhp Actor
    b
        in Actor
    b { bhp = newHP
             , bhpDelta = let oldD = Actor -> ResDelta
    bhpDelta Actor
    b
                          in case compare n 0 of
                            Ordering
    EQ -> ResDelta { resCurrentTurn :: (Int64, Int64)
    resCurrentTurn = (Int64
    0, Int64
    0)
                                           , resPreviousTurn :: (Int64, Int64)
    resPreviousTurn = ResDelta -> (Int64, Int64)
    resCurrentTurn ResDelta
    oldD }
                            Ordering
    LT -> ResDelta
    oldD {resCurrentTurn =
                                          ( fst (resCurrentTurn oldD) + n
                                          , snd (resCurrentTurn oldD) )}
                            Ordering
    GT -> ResDelta
    oldD {resCurrentTurn =
                                          ( fst (resCurrentTurn oldD)
                                          , snd (resCurrentTurn oldD) + n )}
             }

    updRefillCalm :: MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillCalm :: forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
    updRefillCalm ActorId
    aid Int64
    n =
      ActorId -> (Actor -> Actor) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> (Actor -> Actor) -> m ()
    updateActor ActorId
    aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Actor
    b ->
        Actor
    b { bcalm = max 0 $ bcalm b + n
          , bcalmDelta = let oldD = Actor -> ResDelta
    bcalmDelta Actor
    b
                         in case compare n 0 of
                           Ordering
    EQ -> ResDelta { resCurrentTurn :: (Int64, Int64)
    resCurrentTurn = (Int64
    0, Int64
    0)
                                          , resPreviousTurn :: (Int64, Int64)
    resPreviousTurn = ResDelta -> (Int64, Int64)
    resCurrentTurn ResDelta
    oldD }
                           Ordering
    LT -> ResDelta
    oldD {resCurrentTurn =
                                         ( fst (resCurrentTurn oldD) + n
                                         , snd (resCurrentTurn oldD) )}
                           Ordering
    GT -> ResDelta
    oldD {resCurrentTurn =
                                         ( fst (resCurrentTurn oldD)
                                         , snd (resCurrentTurn oldD) + n )}
          }

    updTrajectory :: MonadStateWrite m
                  => ActorId
                  -> Maybe ([Vector], Speed)
                  -> Maybe ([Vector], Speed)
                  -> m ()
    updTrajectory :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
    updTrajectory ActorId
    aid Maybe ([Vector], Speed)
    fromT Maybe ([Vector], Speed)
    toT = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe ([Vector], Speed)
    fromT Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe ([Vector], Speed)
    toT) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe ([Vector], Speed)
    fromT Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    body
                        Bool
    -> (String,
        (ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed), Actor))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected actor trajectory"
                        String
    -> (ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed),
        Actor)
    -> (String,
        (ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed), Actor))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aid, Maybe ([Vector], Speed)
    fromT, Maybe ([Vector], Speed)
    toT, Actor
    body)) ()
      updateActor aid $ \Actor
    b -> Actor
    b {btrajectory = toT}

    updQuitFaction :: MonadStateWrite m
                   => FactionId -> Maybe Status -> Maybe Status
                   -> m ()
    updQuitFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Maybe Status -> Maybe Status -> m ()
    updQuitFaction FactionId
    fid Maybe Status
    fromSt Maybe Status
    toSt = do
      let !_A :: ()
    _A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe Status
    fromSt Maybe Status -> Maybe Status -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Status
    toSt Bool -> (FactionId, Maybe Status, Maybe Status) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (FactionId
    fid, Maybe Status
    fromSt, Maybe Status
    toSt)) ()
      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 !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe Status
    fromSt Maybe Status -> Maybe Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Faction -> Maybe Status
    gquit Faction
    fact
                        Bool
    -> (String, (FactionId, Maybe Status, Maybe Status, Faction))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected actor quit status"
                        String
    -> (FactionId, Maybe Status, Maybe Status, Faction)
    -> (String, (FactionId, Maybe Status, Maybe Status, Faction))
    forall v. String -> v -> (String, v)
    `swith` (FactionId
    fid, Maybe Status
    fromSt, Maybe Status
    toSt, Faction
    fact)) ()
      let adj Faction
    fa = Faction
    fa {gquit = toSt}
      updateFaction fid adj

    updSpotStashFaction :: MonadStateWrite m
                        => FactionId -> LevelId -> Point -> m ()
    updSpotStashFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> LevelId -> Point -> m ()
    updSpotStashFaction FactionId
    fid LevelId
    lid Point
    pos = do
      let adj :: Faction -> Faction
    adj Faction
    fa = Faction
    fa {gstash = Just (lid, pos)}
        -- the stash may be outdated, but not empty and it's correct,
        -- because we know stash may be only one, so here it's added,
        -- the old one is removed, despite us not seeing its location;
        -- warning: in this form, this is not reversible, no undo,
        -- so we'd need to add the required @UpdLoseStashFaction@
        -- elsehwere, similarly as @LoseTile@ is added when FOV
        -- reveals that tile is different than expected
      FactionId -> (Faction -> Faction) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> (Faction -> Faction) -> m ()
    updateFaction FactionId
    fid Faction -> Faction
    adj

    updLoseStashFaction :: MonadStateWrite m
                        => FactionId -> LevelId -> Point -> m ()
    updLoseStashFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> LevelId -> Point -> m ()
    updLoseStashFaction FactionId
    fid LevelId
    lid Point
    pos = do
      let adj :: Faction -> Faction
    adj Faction
    fa = Bool -> Faction -> Faction
    forall a. HasCallStack => Bool -> a -> a
    assert (Faction -> Maybe (LevelId, Point)
    gstash Faction
    fa Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (LevelId
    lid, Point
    pos)
                           Bool -> (String, (FactionId, LevelId, Point, Faction)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected lack of gstash"
                           String
    -> (FactionId, LevelId, Point, Faction)
    -> (String, (FactionId, LevelId, Point, Faction))
    forall v. String -> v -> (String, v)
    `swith` (FactionId
    fid, LevelId
    lid, Point
    pos, Faction
    fa))
                   (Faction -> Faction) -> Faction -> Faction
    forall a b. (a -> b) -> a -> b
    $ Faction
    fa {gstash = Nothing}
      FactionId -> (Faction -> Faction) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> (Faction -> Faction) -> m ()
    updateFaction FactionId
    fid Faction -> Faction
    adj

    -- The previous leader is assumed to be alive.
    updLeadFaction :: MonadStateWrite m
                   => FactionId
                   -> Maybe ActorId
                   -> Maybe ActorId
                   -> m ()
    updLeadFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
    updLeadFaction FactionId
    fid Maybe ActorId
    source Maybe ActorId
    target = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe ActorId
    source Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe ActorId
    target) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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 !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (FactionKind -> Bool
    fhasPointman (Faction -> FactionKind
    gkind Faction
    fact)) ()
        -- @PosNone@ ensures this
      mtb <- getsState $ \State
    s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ActorId -> State -> Actor
    getActorBody State
    s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ActorId
    target
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> (Actor -> Bool) -> Maybe Actor -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (Bool -> Bool
    not (Bool -> Bool) -> (Actor -> Bool) -> Actor -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Bool
    bproj) Maybe Actor
    mtb
                        Bool
    -> (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction)
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (FactionId
    fid, Maybe ActorId
    source, Maybe ActorId
    target, Maybe Actor
    mtb, Faction
    fact)) ()
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe ActorId
    source Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Faction -> Maybe ActorId
    gleader Faction
    fact
                        Bool
    -> (String,
        (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected actor leader"
                        String
    -> (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction)
    -> (String,
        (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction))
    forall v. String -> v -> (String, v)
    `swith` (FactionId
    fid, Maybe ActorId
    source, Maybe ActorId
    target, Maybe Actor
    mtb, Faction
    fact)) ()
      let adj Faction
    fa = Faction
    fa {_gleader = target}
      updateFaction fid adj

    updDiplFaction :: MonadStateWrite m
                   => FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
    updDiplFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
    updDiplFaction FactionId
    fid1 FactionId
    fid2 Diplomacy
    fromDipl Diplomacy
    toDipl =
      Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (FactionId
    fid1 FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FactionId
    fid2 Bool -> Bool -> Bool
    && Diplomacy
    fromDipl Diplomacy -> Diplomacy -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Diplomacy
    toDipl) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        fact1 <- (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
    fid1) (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
        fact2 <- getsState $ (EM.! fid2) . sfactionD
        let !_A =
              Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Diplomacy
    fromDipl Diplomacy -> Diplomacy -> Bool
    forall a. Eq a => a -> a -> Bool
    == Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Diplomacy
    Unknown FactionId
    fid2 (Faction -> EnumMap FactionId Diplomacy
    gdipl Faction
    fact1)
                      Bool -> Bool -> Bool
    && Diplomacy
    fromDipl Diplomacy -> Diplomacy -> Bool
    forall a. Eq a => a -> a -> Bool
    == Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Diplomacy
    Unknown FactionId
    fid1 (Faction -> EnumMap FactionId Diplomacy
    gdipl Faction
    fact2)
                      Bool
    -> (String,
        (FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected actor diplomacy status"
                      String
    -> (FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction)
    -> (String,
        (FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction))
    forall v. String -> v -> (String, v)
    `swith` (FactionId
    fid1, FactionId
    fid2, Diplomacy
    fromDipl, Diplomacy
    toDipl, Faction
    fact1, Faction
    fact2)) ()
        let adj FactionId
    fid Faction
    fact = Faction
    fact {gdipl = EM.insert fid toDipl (gdipl fact)}
        updateFaction fid1 (adj fid2)
        updateFaction fid2 (adj fid1)

    updDoctrineFaction :: MonadStateWrite m
                       => FactionId -> Ability.Doctrine -> Ability.Doctrine -> m ()
    updDoctrineFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Doctrine -> Doctrine -> m ()
    updDoctrineFaction FactionId
    fid Doctrine
    toT Doctrine
    fromT = do
      let adj :: Faction -> Faction
    adj Faction
    fact = Bool -> Faction -> Faction
    forall a. HasCallStack => Bool -> a -> a
    assert (Faction -> Doctrine
    gdoctrine Faction
    fact Doctrine -> Doctrine -> Bool
    forall a. Eq a => a -> a -> Bool
    == Doctrine
    fromT) (Faction -> Faction) -> Faction -> Faction
    forall a b. (a -> b) -> a -> b
    $ Faction
    fact {gdoctrine = toT}
      FactionId -> (Faction -> Faction) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> (Faction -> Faction) -> m ()
    updateFaction FactionId
    fid Faction -> Faction
    adj

    updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m ()
    updAutoFaction :: forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> Bool -> m ()
    updAutoFaction FactionId
    fid Bool
    st =
      FactionId -> (Faction -> Faction) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    FactionId -> (Faction -> Faction) -> m ()
    updateFaction FactionId
    fid (\Faction
    fact ->
        Bool -> Faction -> Faction
    forall a. HasCallStack => Bool -> a -> a
    assert (Faction -> Bool
    gunderAI Faction
    fact Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Bool
    not Bool
    st) (Faction -> Faction) -> Faction -> Faction
    forall a b. (a -> b) -> a -> b
    $ Faction
    fact {gunderAI = st})

    -- Record a given number (usually just 1, or -1 for undo) of actor kills
    -- for score calculation.
    updRecordKill :: MonadStateWrite m
                  => ActorId -> ContentId ItemKind -> Int -> m ()
    updRecordKill :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> ContentId ItemKind -> Int -> m ()
    updRecordKill ActorId
    aid ContentId ItemKind
    ikind Int
    k = 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
      let !_A = Bool -> ZonkAny 0 -> ZonkAny 0
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    b) Bool -> (ActorId, Actor) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (ActorId
    aid, Actor
    b))
      let alterKind Maybe Int
    mn = let n :: Int
    n = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 Maybe Int
    mn Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    k
                         in if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then Maybe Int
    forall a. Maybe a
    Nothing else Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
          adjFact Faction
    fact = Faction
    fact {gvictims = EM.alter alterKind ikind
                                          $ gvictims fact}
      updateFaction (bfid b) adjFact
        -- The death of a dominated actor counts as the dominating faction's loss
        -- for score purposes, so human nor AI can't treat such actor as disposable,
        -- which means domination will not be as cruel, as frustrating,
        -- as it could be and there is a higher chance of getting back alive
        -- the actor, the human player has grown attached to.

    -- Alter an attribute (actually, the only, the defining attribute)
    -- of a visible tile. This is similar to e.g., @UpdTrajectory@.
    --
    -- Removing and creating embedded items when altering a tile
    -- is done separately via @UpdCreateItem@ and @UpdDestroyItem@.
    updAlterTile :: MonadStateWrite m
                 => LevelId -> Point -> ContentId TileKind -> ContentId TileKind
                 -> m ()
    updAlterTile :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId
    -> Point -> ContentId TileKind -> ContentId TileKind -> m ()
    updAlterTile LevelId
    lid Point
    p ContentId TileKind
    fromTile ContentId TileKind
    toTile = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ContentId TileKind
    fromTile ContentId TileKind -> ContentId TileKind -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ContentId TileKind
    toTile) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lvl <- getLevel lid
      let t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    p
      if t /= fromTile
      then atomicFail "terrain to modify is different than assumed"
      else do
        let adj Array (ContentId TileKind)
    ts = Array (ContentId TileKind)
    ts Array (ContentId TileKind)
    -> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
    forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
    PointArray.// [(Point
    p, ContentId TileKind
    toTile)]
        updateLevel lid $ updateTile adj
        case ( Tile.isExplorable coTileSpeedup fromTile
             , Tile.isExplorable coTileSpeedup toTile ) of
          (Bool
    False, Bool
    True) -> LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl2 -> Level
    lvl2 {lseen = lseen lvl2 + 1}
          (Bool
    True, Bool
    False) -> LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl2 -> Level
    lvl2 {lseen = lseen lvl2 - 1}
          (Bool, Bool)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    updAlterExplorable :: MonadStateWrite m => LevelId -> Int -> m ()
    updAlterExplorable :: forall (m :: * -> *). MonadStateWrite m => LevelId -> Int -> m ()
    updAlterExplorable LevelId
    lid Int
    delta = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    delta Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl -> Level
    lvl {lexpl = lexpl lvl + delta}

    updAlterGold :: MonadStateWrite m => Int -> m ()
    updAlterGold :: forall (m :: * -> *). MonadStateWrite m => Int -> m ()
    updAlterGold Int
    delta = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    delta Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int) -> State -> State
    updateGold (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    delta)

    -- Showing to the client the embedded items, if any, is done elsewhere.
    updSearchTile :: MonadStateWrite m
                  => ActorId -> Point -> ContentId TileKind -> m ()
    updSearchTile :: forall (m :: * -> *).
    MonadStateWrite m =>
    ActorId -> Point -> ContentId TileKind -> m ()
    updSearchTile ActorId
    aid Point
    p ContentId TileKind
    toTile = do
      COps{cotile} <- (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 aid
      lvl <- getLevel $ blid b
      let t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    p
      if t == toTile
      then atomicFail "tile already searched"
      else assert (Just t == Tile.hideAs cotile toTile) $ do
        updLoseTile (blid b) [(p, t)]
        updSpotTile (blid b) [(p, toTile)]  -- not the hidden version this one time

    -- Notice previously invisible tiles. This is done in bulk,
    -- because it often involves dozens of tiles per move.
    -- We verify that the old tiles at the positions in question
    -- are indeed unknown.
    updSpotTile :: MonadStateWrite m
                => LevelId -> [(Point, ContentId TileKind)] -> m ()
    updSpotTile :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, ContentId TileKind)] -> m ()
    updSpotTile LevelId
    lid [(Point, ContentId TileKind)]
    ts = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, ContentId TileKind)] -> Bool
    forall a. [a] -> Bool
    null [(Point, ContentId TileKind)]
    ts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      let unk Array (ContentId TileKind)
    tileMap (Point
    p, b
    _) = Array (ContentId TileKind)
    tileMap Array (ContentId TileKind) -> Point -> ContentId TileKind
    forall c. UnboxRepClass c => Array c -> Point -> c
    PointArray.! Point
    p ContentId TileKind -> ContentId TileKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == ContentId TileKind
    unknownId
          adj Array (ContentId TileKind)
    tileMap = Bool -> Array (ContentId TileKind) -> Array (ContentId TileKind)
    forall a. HasCallStack => Bool -> a -> a
    assert (((Point, ContentId TileKind) -> Bool)
    -> [(Point, ContentId TileKind)] -> Bool
    forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB (Array (ContentId TileKind) -> (Point, ContentId TileKind) -> Bool
    forall {b}. Array (ContentId TileKind) -> (Point, b) -> Bool
    unk Array (ContentId TileKind)
    tileMap) [(Point, ContentId TileKind)]
    ts)
                        (Array (ContentId TileKind) -> Array (ContentId TileKind))
    -> Array (ContentId TileKind) -> Array (ContentId TileKind)
    forall a b. (a -> b) -> a -> b
    $ Array (ContentId TileKind)
    tileMap Array (ContentId TileKind)
    -> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
    forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
    PointArray.// [(Point, ContentId TileKind)]
    ts
      updateLevel lid $ updateTile adj
      let f (Point
    _, ContentId TileKind
    t1) = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isExplorable TileSpeedup
    coTileSpeedup ContentId TileKind
    t1) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl -> Level
    lvl {lseen = lseen lvl + 1}
      mapM_ f ts

    -- Stop noticing previously visible tiles. It verifies
    -- the state of the tiles before wiping them out.
    updLoseTile :: MonadStateWrite m
                => LevelId -> [(Point, ContentId TileKind)] -> m ()
    updLoseTile :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, ContentId TileKind)] -> m ()
    updLoseTile LevelId
    lid [(Point, ContentId TileKind)]
    ts = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, ContentId TileKind)] -> Bool
    forall a. [a] -> Bool
    null [(Point, ContentId TileKind)]
    ts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
      let matches Array a
    tileMap (Point
    p, a
    ov) = Array a
    tileMap Array a -> Point -> a
    forall c. UnboxRepClass c => Array c -> Point -> c
    PointArray.! Point
    p a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    ov
          tu = ((Point, ContentId TileKind) -> (Point, ContentId TileKind))
    -> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((ContentId TileKind -> ContentId TileKind)
    -> (Point, ContentId TileKind) -> (Point, ContentId TileKind)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (ContentId TileKind -> ContentId TileKind -> ContentId TileKind
    forall a b. a -> b -> a
    const ContentId TileKind
    unknownId)) [(Point, ContentId TileKind)]
    ts
          adj Array (ContentId TileKind)
    tileMap = Bool -> Array (ContentId TileKind) -> Array (ContentId TileKind)
    forall a. HasCallStack => Bool -> a -> a
    assert (((Point, ContentId TileKind) -> Bool)
    -> [(Point, ContentId TileKind)] -> Bool
    forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB (Array (ContentId TileKind) -> (Point, ContentId TileKind) -> Bool
    forall {a}. UnboxRepClass a => Array a -> (Point, a) -> Bool
    matches Array (ContentId TileKind)
    tileMap) [(Point, ContentId TileKind)]
    ts)
                        (Array (ContentId TileKind) -> Array (ContentId TileKind))
    -> Array (ContentId TileKind) -> Array (ContentId TileKind)
    forall a b. (a -> b) -> a -> b
    $ Array (ContentId TileKind)
    tileMap Array (ContentId TileKind)
    -> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
    forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
    PointArray.// [(Point, ContentId TileKind)]
    tu
      updateLevel lid $ updateTile adj
      let f (Point
    _, ContentId TileKind
    t1) = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isExplorable TileSpeedup
    coTileSpeedup ContentId TileKind
    t1) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl -> Level
    lvl {lseen = lseen lvl - 1}
      mapM_ f ts

    updSpotEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m ()
    updSpotEntry :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, PlaceEntry)] -> m ()
    updSpotEntry LevelId
    lid [(Point, PlaceEntry)]
    ts = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, PlaceEntry)] -> Bool
    forall a. [a] -> Bool
    null [(Point, PlaceEntry)]
    ts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      let alt :: PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
    alt PlaceEntry
    en Maybe PlaceEntry
    Nothing = PlaceEntry -> Maybe PlaceEntry
    forall a. a -> Maybe a
    Just PlaceEntry
    en
          alt PlaceEntry
    en (Just PlaceEntry
    oldEn) = String -> Maybe PlaceEntry
    forall a. String -> a
    atomicFail (String -> Maybe PlaceEntry) -> String -> Maybe PlaceEntry
    forall a b. (a -> b) -> a -> b
    $ String
    "entry already added"
                                             String
    -> (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry)
    -> String
    forall v. Show v => String -> v -> String
    `showFailure` (LevelId
    lid, [(Point, PlaceEntry)]
    ts, PlaceEntry
    en, PlaceEntry
    oldEn)
          f :: (Point, PlaceEntry)
    -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    f (Point
    p, PlaceEntry
    en) = (Maybe PlaceEntry -> Maybe PlaceEntry)
    -> Point -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter (PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
    alt PlaceEntry
    en) Point
    p
          upd :: EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    upd EnumMap Point PlaceEntry
    m = ((Point, PlaceEntry)
     -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
    -> EnumMap Point PlaceEntry
    -> [(Point, PlaceEntry)]
    -> EnumMap Point PlaceEntry
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Point, PlaceEntry)
    -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    f EnumMap Point PlaceEntry
    m [(Point, PlaceEntry)]
    ts
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
    -> Level -> Level
    updateEntry EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    upd

    updLoseEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m ()
    updLoseEntry :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, PlaceEntry)] -> m ()
    updLoseEntry LevelId
    lid [(Point, PlaceEntry)]
    ts = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, PlaceEntry)] -> Bool
    forall a. [a] -> Bool
    null [(Point, PlaceEntry)]
    ts) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      let alt :: PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
    alt PlaceEntry
    en Maybe PlaceEntry
    Nothing = String -> Maybe PlaceEntry
    forall a. HasCallStack => String -> a
    error (String -> Maybe PlaceEntry) -> String -> Maybe PlaceEntry
    forall a b. (a -> b) -> a -> b
    $ String
    "entry already removed"
                                   String -> (LevelId, [(Point, PlaceEntry)], PlaceEntry) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (LevelId
    lid, [(Point, PlaceEntry)]
    ts, PlaceEntry
    en)
          alt PlaceEntry
    en (Just PlaceEntry
    oldEn) =
            Bool -> Maybe PlaceEntry -> Maybe PlaceEntry
    forall a. HasCallStack => Bool -> a -> a
    assert (PlaceEntry
    en PlaceEntry -> PlaceEntry -> Bool
    forall a. Eq a => a -> a -> Bool
    == PlaceEntry
    oldEn Bool
    -> (String,
        (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected lost entry"
                                String
    -> (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry)
    -> (String,
        (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry))
    forall v. String -> v -> (String, v)
    `swith` (LevelId
    lid, [(Point, PlaceEntry)]
    ts, PlaceEntry
    en, PlaceEntry
    oldEn)) Maybe PlaceEntry
    forall a. Maybe a
    Nothing
          f :: (Point, PlaceEntry)
    -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    f (Point
    p, PlaceEntry
    en) = (Maybe PlaceEntry -> Maybe PlaceEntry)
    -> Point -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter (PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
    alt PlaceEntry
    en) Point
    p
          upd :: EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    upd EnumMap Point PlaceEntry
    m = ((Point, PlaceEntry)
     -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
    -> EnumMap Point PlaceEntry
    -> [(Point, PlaceEntry)]
    -> EnumMap Point PlaceEntry
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Point, PlaceEntry)
    -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    f EnumMap Point PlaceEntry
    m [(Point, PlaceEntry)]
    ts
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
    -> Level -> Level
    updateEntry EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
    upd

    updAlterSmell :: MonadStateWrite m => LevelId -> Point -> Time -> Time -> m ()
    updAlterSmell :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> Point -> Time -> Time -> m ()
    updAlterSmell LevelId
    lid Point
    p Time
    fromSm' Time
    toSm' = do
      let fromSm :: Maybe Time
    fromSm = if Time
    fromSm' Time -> Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Time
    timeZero then Maybe Time
    forall a. Maybe a
    Nothing else Time -> Maybe Time
    forall a. a -> Maybe a
    Just Time
    fromSm'
          toSm :: Maybe Time
    toSm = if Time
    toSm' Time -> Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Time
    timeZero then Maybe Time
    forall a. Maybe a
    Nothing else Time -> Maybe Time
    forall a. a -> Maybe a
    Just Time
    toSm'
          alt :: Maybe Time -> Maybe Time
    alt Maybe Time
    sm = Bool -> Maybe Time -> Maybe Time
    forall a. HasCallStack => Bool -> a -> a
    assert (Maybe Time
    sm Maybe Time -> Maybe Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Time
    fromSm Bool
    -> (String, (LevelId, Point, Maybe Time, Maybe Time, Maybe Time))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected tile smell"
                                        String
    -> (LevelId, Point, Maybe Time, Maybe Time, Maybe Time)
    -> (String, (LevelId, Point, Maybe Time, Maybe Time, Maybe Time))
    forall v. String -> v -> (String, v)
    `swith` (LevelId
    lid, Point
    p, Maybe Time
    fromSm, Maybe Time
    toSm, Maybe Time
    sm)) Maybe Time
    toSm
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (SmellMap -> SmellMap) -> Level -> Level
    updateSmell ((SmellMap -> SmellMap) -> Level -> Level)
    -> (SmellMap -> SmellMap) -> Level -> Level
    forall a b. (a -> b) -> a -> b
    $ (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe Time -> Maybe Time
    alt Point
    p

    updSpotSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()
    updSpotSmell :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, Time)] -> m ()
    updSpotSmell LevelId
    lid [(Point, Time)]
    sms = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, Time)] -> Bool
    forall a. [a] -> Bool
    null [(Point, Time)]
    sms) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      let alt :: Time -> Maybe Time -> Maybe Time
    alt Time
    sm Maybe Time
    Nothing = Time -> Maybe Time
    forall a. a -> Maybe a
    Just Time
    sm
          alt Time
    sm (Just Time
    oldSm) = String -> Maybe Time
    forall a. HasCallStack => String -> a
    error (String -> Maybe Time) -> String -> Maybe Time
    forall a b. (a -> b) -> a -> b
    $ String
    "smell already added"
                                        String -> (LevelId, [(Point, Time)], Time, Time) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (LevelId
    lid, [(Point, Time)]
    sms, Time
    sm, Time
    oldSm)
          f :: (Point, Time) -> SmellMap -> SmellMap
    f (Point
    p, Time
    sm) = (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter (Time -> Maybe Time -> Maybe Time
    alt Time
    sm) Point
    p
          upd :: SmellMap -> SmellMap
    upd SmellMap
    m = ((Point, Time) -> SmellMap -> SmellMap)
    -> SmellMap -> [(Point, Time)] -> SmellMap
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Point, Time) -> SmellMap -> SmellMap
    f SmellMap
    m [(Point, Time)]
    sms
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (SmellMap -> SmellMap) -> Level -> Level
    updateSmell SmellMap -> SmellMap
    upd

    updLoseSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()
    updLoseSmell :: forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> [(Point, Time)] -> m ()
    updLoseSmell LevelId
    lid [(Point, Time)]
    sms = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Point, Time)] -> Bool
    forall a. [a] -> Bool
    null [(Point, Time)]
    sms) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
      let alt :: Time -> Maybe Time -> Maybe Time
    alt Time
    sm Maybe Time
    Nothing = String -> Maybe Time
    forall a. HasCallStack => String -> a
    error (String -> Maybe Time) -> String -> Maybe Time
    forall a b. (a -> b) -> a -> b
    $ String
    "smell already removed"
                                   String -> (LevelId, [(Point, Time)], Time) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (LevelId
    lid, [(Point, Time)]
    sms, Time
    sm)
          alt Time
    sm (Just Time
    oldSm) =
            Bool -> Maybe Time -> Maybe Time
    forall a. HasCallStack => Bool -> a -> a
    assert (Time
    sm Time -> Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Time
    oldSm Bool -> (String, (LevelId, [(Point, Time)], Time, Time)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "unexpected lost smell"
                                String
    -> (LevelId, [(Point, Time)], Time, Time)
    -> (String, (LevelId, [(Point, Time)], Time, Time))
    forall v. String -> v -> (String, v)
    `swith` (LevelId
    lid, [(Point, Time)]
    sms, Time
    sm, Time
    oldSm)) Maybe Time
    forall a. Maybe a
    Nothing
          f :: (Point, Time) -> SmellMap -> SmellMap
    f (Point
    p, Time
    sm) = (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter (Time -> Maybe Time -> Maybe Time
    alt Time
    sm) Point
    p
          upd :: SmellMap -> SmellMap
    upd SmellMap
    m = ((Point, Time) -> SmellMap -> SmellMap)
    -> SmellMap -> [(Point, Time)] -> SmellMap
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Point, Time) -> SmellMap -> SmellMap
    f SmellMap
    m [(Point, Time)]
    sms
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (SmellMap -> SmellMap) -> Level -> Level
    updateSmell SmellMap -> SmellMap
    upd

    updTimeItem :: MonadStateWrite m
                => ItemId -> Container -> ItemTimers -> ItemTimers
                -> m ()
    updTimeItem :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
    updTimeItem ItemId
    iid Container
    c ItemTimers
    fromIt ItemTimers
    toIt = Bool -> m () -> m ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ItemTimers
    fromIt ItemTimers -> ItemTimers -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ItemTimers
    toIt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ 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
    c
      case iid `EM.lookup` bag of
        Just (Int
    k, ItemTimers
    it) -> do
          let !_A1 :: ()
    _A1 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ItemTimers
    fromIt ItemTimers -> ItemTimers -> Bool
    forall a. Eq a => a -> a -> Bool
    == ItemTimers
    it Bool
    -> (Int, ItemTimers, ItemId, Container, ItemTimers, ItemTimers)
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Int
    k, ItemTimers
    it, ItemId
    iid, Container
    c, ItemTimers
    fromIt, ItemTimers
    toIt)) ()
              !_A2 :: ()
    _A2 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (ItemTimers -> Int
    forall a. [a] -> Int
    length ItemTimers
    toIt Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    k Bool -> (Int, ItemTimers, ItemId, Container, ItemTimers) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Int
    k, ItemTimers
    toIt, ItemId
    iid, Container
    c, ItemTimers
    fromIt)) ()
          ItemId -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    deleteItemContainer ItemId
    iid (Int
    k, ItemTimers
    fromIt) Container
    c
          ItemId -> ItemQuant -> Container -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> ItemQuant -> Container -> m ()
    insertItemContainer ItemId
    iid (Int
    k, ItemTimers
    toIt) Container
    c
        Maybe ItemQuant
    Nothing -> String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String
    -> (ItemBag, ItemId, Container, ItemTimers, ItemTimers) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ItemBag
    bag, ItemId
    iid, Container
    c, ItemTimers
    fromIt, ItemTimers
    toIt)

    updAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m ()
    updAgeGame :: forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
    updAgeGame EnumSet LevelId
    lids = do
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Time -> Time) -> State -> State
    updateTime ((Time -> Time) -> State -> State)
    -> (Time -> Time) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ (Time -> Delta Time -> Time) -> Delta Time -> Time -> Time
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Time -> Delta Time -> Time
    timeShift (Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip)
      (LevelId -> m ()) -> [LevelId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Delta Time -> LevelId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Delta Time -> LevelId -> m ()
    ageLevel (Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip)) ([LevelId] -> m ()) -> [LevelId] -> m ()
    forall a b. (a -> b) -> a -> b
    $ EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems EnumSet LevelId
    lids

    updUnAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m ()
    updUnAgeGame :: forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
    updUnAgeGame EnumSet LevelId
    lids = do
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Time -> Time) -> State -> State
    updateTime ((Time -> Time) -> State -> State)
    -> (Time -> Time) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ (Time -> Delta Time -> Time) -> Delta Time -> Time -> Time
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Time -> Delta Time -> Time
    timeShift (Delta Time -> Delta Time
    timeDeltaReverse (Delta Time -> Delta Time) -> Delta Time -> Delta Time
    forall a b. (a -> b) -> a -> b
    $ Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip)
      (LevelId -> m ()) -> [LevelId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Delta Time -> LevelId -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    Delta Time -> LevelId -> m ()
    ageLevel (Delta Time -> Delta Time
    timeDeltaReverse (Delta Time -> Delta Time) -> Delta Time -> Delta Time
    forall a b. (a -> b) -> a -> b
    $ Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip)) ([LevelId] -> m ()) -> [LevelId] -> m ()
    forall a b. (a -> b) -> a -> b
    $ EnumSet LevelId -> [LevelId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems EnumSet LevelId
    lids

    ageLevel :: MonadStateWrite m => Delta Time -> LevelId -> m ()
    ageLevel :: forall (m :: * -> *).
    MonadStateWrite m =>
    Delta Time -> LevelId -> m ()
    ageLevel Delta Time
    delta LevelId
    lid =
      LevelId -> (Level -> Level) -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    LevelId -> (Level -> Level) -> m ()
    updateLevel LevelId
    lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Level
    lvl -> Level
    lvl {ltime = timeShift (ltime lvl) delta}

    updDiscover :: MonadStateWrite m
                => Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord
                -> m ()
    updDiscover :: forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    updDiscover Container
    _c ItemId
    iid ContentId ItemKind
    ik AspectRecord
    arItem = do
      itemD <- (State -> ItemDict) -> m ItemDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> ItemDict
    sitemD
      COps{coItemSpeedup} <- getsState scops
      let kmIsConst = KindMean -> Bool
    IA.kmConst (KindMean -> Bool) -> KindMean -> Bool
    forall a b. (a -> b) -> a -> b
    $ ContentId ItemKind -> ItemSpeedup -> KindMean
    getKindMean ContentId ItemKind
    ik ItemSpeedup
    coItemSpeedup
      discoKind <- getsState sdiscoKind
      let discoverAtMostAspect = do
            discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> DiscoveryAspect
    sdiscoAspect
            if kmIsConst || iid `EM.member` discoAspect
            then atomicFail "item already fully discovered"
            else discoverAspect iid arItem
      case EM.lookup iid itemD of
        Maybe Item
    Nothing -> String -> m ()
    forall a. String -> a
    atomicFail String
    "discovered item unheard of"
        Just Item
    item -> case Item -> ItemIdentity
    jkind Item
    item of
          IdentityObvious ContentId ItemKind
    _ -> m ()
    discoverAtMostAspect
          IdentityCovered ItemKindIx
    ix ContentId ItemKind
    _ik -> case ItemKindIx -> DiscoveryKind -> Maybe (ContentId ItemKind)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup ItemKindIx
    ix DiscoveryKind
    discoKind of
            Just{} -> m ()
    discoverAtMostAspect
            Maybe (ContentId ItemKind)
    Nothing -> do
              ItemKindIx -> ContentId ItemKind -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemKindIx -> ContentId ItemKind -> m ()
    discoverKind ItemKindIx
    ix ContentId ItemKind
    ik
              Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    kmIsConst (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ItemId -> AspectRecord -> m ()
    forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    discoverAspect ItemId
    iid AspectRecord
    arItem
      resetActorMaxSkills

    updCover :: Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m ()
    updCover :: forall (m :: * -> *).
    Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
    updCover Container
    _c ItemId
    _iid ContentId ItemKind
    _ik AspectRecord
    _arItem = m ()
    forall a. HasCallStack => a
    undefined

    updDiscoverKind :: MonadStateWrite m
                    => Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updDiscoverKind :: forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updDiscoverKind Container
    _c ItemKindIx
    ix ContentId ItemKind
    kmKind = do
      discoKind <- (State -> DiscoveryKind) -> m DiscoveryKind
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> DiscoveryKind
    sdiscoKind
      if ix `EM.member` discoKind
      then atomicFail "item kind already discovered"
      else do
        discoverKind ix kmKind
        resetActorMaxSkills

    discoverKind :: MonadStateWrite m => ItemKindIx -> ContentId ItemKind -> m ()
    discoverKind :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemKindIx -> ContentId ItemKind -> m ()
    discoverKind ItemKindIx
    ix ContentId ItemKind
    kindId = do
      let f :: Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind)
    f Maybe (ContentId ItemKind)
    Nothing = ContentId ItemKind -> Maybe (ContentId ItemKind)
    forall a. a -> Maybe a
    Just ContentId ItemKind
    kindId
          f Just{} = String -> Maybe (ContentId ItemKind)
    forall a. HasCallStack => String -> a
    error (String -> Maybe (ContentId ItemKind))
    -> String -> Maybe (ContentId ItemKind)
    forall a b. (a -> b) -> a -> b
    $ String
    "already discovered" String -> (ItemKindIx, ContentId ItemKind) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ItemKindIx
    ix, ContentId ItemKind
    kindId)
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryKind -> DiscoveryKind) -> State -> State
    updateDiscoKind ((DiscoveryKind -> DiscoveryKind) -> State -> State)
    -> (DiscoveryKind -> DiscoveryKind) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ \DiscoveryKind
    discoKind1 ->
        (Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind))
    -> ItemKindIx -> DiscoveryKind -> DiscoveryKind
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind)
    f ItemKindIx
    ix DiscoveryKind
    discoKind1

    updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updCoverKind :: forall (m :: * -> *).
    Container -> ItemKindIx -> ContentId ItemKind -> m ()
    updCoverKind Container
    _c ItemKindIx
    _ix ContentId ItemKind
    _ik = m ()
    forall a. HasCallStack => a
    undefined

    updDiscoverAspect :: MonadStateWrite m
                      => Container -> ItemId -> IA.AspectRecord -> m ()
    updDiscoverAspect :: forall (m :: * -> *).
    MonadStateWrite m =>
    Container -> ItemId -> AspectRecord -> m ()
    updDiscoverAspect Container
    _c ItemId
    iid AspectRecord
    arItem = do
      COps{coItemSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      itemD <- getsState sitemD
      case EM.lookup iid itemD of
        Maybe Item
    Nothing -> String -> m ()
    forall a. String -> a
    atomicFail String
    "discovered item unheard of"
        Just Item
    item -> do
          -- Here the kind information is exact, hence @getItemKindIdServer@.
          kindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
    -> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
    forall a b. (a -> b) -> a -> b
    $ Item -> State -> ContentId ItemKind
    getItemKindIdServer Item
    item
          discoAspect <- getsState sdiscoAspect
          let kmIsConst = KindMean -> Bool
    IA.kmConst (KindMean -> Bool) -> KindMean -> Bool
    forall a b. (a -> b) -> a -> b
    $ ContentId ItemKind -> ItemSpeedup -> KindMean
    getKindMean ContentId ItemKind
    kindId ItemSpeedup
    coItemSpeedup
          if kmIsConst || iid `EM.member` discoAspect
          then atomicFail "item arItem already discovered"
          else do
            discoverAspect iid arItem
            resetActorMaxSkills

    discoverAspect :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
    discoverAspect :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    discoverAspect ItemId
    iid AspectRecord
    arItem = do
      let f :: Maybe AspectRecord -> Maybe AspectRecord
    f Maybe AspectRecord
    Nothing = AspectRecord -> Maybe AspectRecord
    forall a. a -> Maybe a
    Just AspectRecord
    arItem
          f Just{} = String -> Maybe AspectRecord
    forall a. HasCallStack => String -> a
    error (String -> Maybe AspectRecord) -> String -> Maybe AspectRecord
    forall a b. (a -> b) -> a -> b
    $ String
    "already discovered" String -> (ItemId, AspectRecord) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ItemId
    iid, AspectRecord
    arItem)
      -- At this point we know the item is not @kmConst@.
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
    -> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ \DiscoveryAspect
    discoAspect1 ->
        (Maybe AspectRecord -> Maybe AspectRecord)
    -> ItemId -> DiscoveryAspect -> DiscoveryAspect
    forall k a.
    Enum k =>
    (Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
    EM.alter Maybe AspectRecord -> Maybe AspectRecord
    f ItemId
    iid DiscoveryAspect
    discoAspect1

    updCoverAspect :: Container -> ItemId -> IA.AspectRecord -> m ()
    updCoverAspect :: forall (m :: * -> *). Container -> ItemId -> AspectRecord -> m ()
    updCoverAspect Container
    _c ItemId
    _iid AspectRecord
    _arItem = m ()
    forall a. HasCallStack => a
    undefined

    updDiscoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
    updDiscoverServer :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    updDiscoverServer ItemId
    iid AspectRecord
    arItem =
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
    -> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ \DiscoveryAspect
    discoAspect1 ->
        ItemId -> AspectRecord -> DiscoveryAspect -> DiscoveryAspect
    forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
    EM.insert ItemId
    iid AspectRecord
    arItem DiscoveryAspect
    discoAspect1

    updCoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
    updCoverServer :: forall (m :: * -> *).
    MonadStateWrite m =>
    ItemId -> AspectRecord -> m ()
    updCoverServer ItemId
    iid AspectRecord
    arItem =
      (State -> State) -> m ()
    forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
    modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
    -> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
    forall a b. (a -> b) -> a -> b
    $ \DiscoveryAspect
    discoAspect1 ->
        Bool -> DiscoveryAspect -> DiscoveryAspect
    forall a. HasCallStack => Bool -> a -> a
    assert (DiscoveryAspect
    discoAspect1 DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid AspectRecord -> AspectRecord -> Bool
    forall a. Eq a => a -> a -> Bool
    == AspectRecord
    arItem)
        (DiscoveryAspect -> DiscoveryAspect)
    -> DiscoveryAspect -> DiscoveryAspect
    forall a b. (a -> b) -> a -> b
    $ ItemId -> DiscoveryAspect -> DiscoveryAspect
    forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
    EM.delete ItemId
    iid DiscoveryAspect
    discoAspect1

    -- This is ever run only on clients.
    updRestart :: MonadStateWrite m => State -> m ()
    updRestart :: forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updRestart = State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    putState

    -- This is ever run only on the server.
    updRestartServer :: MonadStateWrite m => State -> m ()
    updRestartServer :: forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updRestartServer = State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    putState

    -- This is ever run only on the server.
    updResumeServer :: MonadStateWrite m => State -> m ()
    updResumeServer :: forall (m :: * -> *). MonadStateWrite m => State -> m ()
    updResumeServer = State -> m ()
    forall (m :: * -> *). MonadStateWrite m => State -> m ()
    putState