    -- | Representation and computation of visiblity of atomic commands
    -- by clients.
    --
    -- See
    -- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.
    module Game.LambdaHack.Atomic.PosAtomicRead
      ( PosAtomic(..), posUpdAtomic, posSfxAtomic, iidUpdAtomic, iidSfxAtomic
      , breakUpdAtomic, lidOfPos, seenAtomicCli, seenAtomicSer
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , pointsProjBody, posProjBody, singleAid, doubleAid
      , singleContainerStash, singleContainerActor
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

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

    import Game.LambdaHack.Atomic.CmdAtomic
    import Game.LambdaHack.Common.Actor
    import Game.LambdaHack.Common.ActorState
    import Game.LambdaHack.Common.Faction
    import Game.LambdaHack.Common.MonadStateRead
    import Game.LambdaHack.Common.Perception
    import Game.LambdaHack.Common.Point
    import Game.LambdaHack.Common.State
    import Game.LambdaHack.Common.Types
    import Game.LambdaHack.Definition.Defs

    -- All functions here that take an atomic action are executed
    -- in the state just before the action is executed.

    -- | The type representing visibility of atomic commands to factions,
    -- based on the position of the command, etc. Note that the server
    -- sees and smells all positions. Also note that hearing is not covered
    -- because it gives very restricted information, so hearing doesn't equal
    -- seeing (and we assume smelling actors get lots of data from smells).
    data PosAtomic =
        PosSight LevelId [Point]    -- ^ whomever sees all the positions, notices
      | PosFidAndSight FactionId LevelId [Point]
                                    -- ^ observers and the faction notice
      | PosSmell LevelId [Point]    -- ^ whomever smells all the positions, notices
      | PosSightLevels [(LevelId, Point)]
                                    -- ^ whomever sees all the positions, notices
      | PosFid FactionId            -- ^ only the faction notices, server doesn't
      | PosFidAndSer FactionId      -- ^ faction and server notices
      | PosSer                      -- ^ only the server notices
      | PosAll                      -- ^ everybody notices
      | PosNone                     -- ^ never broadcasted, but sent manually
      deriving (Int -> PosAtomic -> ShowS
    [PosAtomic] -> ShowS
    PosAtomic -> String
    (Int -> PosAtomic -> ShowS)
    -> (PosAtomic -> String)
    -> ([PosAtomic] -> ShowS)
    -> Show PosAtomic
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PosAtomic -> ShowS
    showsPrec :: Int -> PosAtomic -> ShowS
    $cshow :: PosAtomic -> String
    show :: PosAtomic -> String
    $cshowList :: [PosAtomic] -> ShowS
    showList :: [PosAtomic] -> ShowS
    Show, PosAtomic -> PosAtomic -> Bool
    (PosAtomic -> PosAtomic -> Bool)
    -> (PosAtomic -> PosAtomic -> Bool) -> Eq PosAtomic
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PosAtomic -> PosAtomic -> Bool
    == :: PosAtomic -> PosAtomic -> Bool
    $c/= :: PosAtomic -> PosAtomic -> Bool
    /= :: PosAtomic -> PosAtomic -> Bool
    Eq)

    -- | Produce the positions where the atomic update takes place or, more
    -- generally, the conditions under which the update can be noticed by
    -- a client.
    --
    -- The goal of this mechanics is to ensure that atomic commands involving
    -- some positions visible by a client convey similar information as the client
    -- would get by directly observing the changes
    -- of the portion of server state limited to the visible positions.
    -- Consequently, when the visible commands are later applied
    -- to the client's state, the state stays consistent
    -- --- in sync with the server state and correctly limited by visiblity.
    -- There is some wiggle room both in what "in sync" and
    -- "visible" means and how they propagate through time.
    --
    -- E.g., @UpdDisplaceActor@ in a black room between two enemy actors,
    -- with only one actor carrying a 0-radius light would not be
    -- distinguishable by looking at the state (or the screen) from @UpdMoveActor@
    -- of the illuminated actor, hence such @UpdDisplaceActor@ should not be
    -- observable, but @UpdMoveActor@ in similar cotext would be
    -- (or the former should be perceived as the latter).
    -- However, to simplify, we assign as strict visibility
    -- requirements to @UpdMoveActor@ as to @UpdDisplaceActor@ and fall back
    -- to @UpdSpotActor@ (which provides minimal information that does not
    -- contradict state) if the visibility is lower.
    posUpdAtomic :: MonadStateRead m => UpdAtomic -> m PosAtomic
    posUpdAtomic :: forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
    posUpdAtomic UpdAtomic
    cmd = case UpdAtomic
    cmd of
      UpdRegisterItems{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosNone
      UpdCreateActor ActorId
    _ Actor
    body [(ItemId, Item)]
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! Actor -> PosAtomic
    posProjBody Actor
    body
      UpdDestroyActor ActorId
    _ Actor
    body [(ItemId, Item)]
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! Actor -> PosAtomic
    posProjBody Actor
    body
      UpdCreateItem Bool
    _ ItemId
    _ Item
    _ ItemQuant
    _ Container
    c -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdDestroyItem Bool
    _ ItemId
    _ Item
    _ ItemQuant
    _ Container
    c -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdSpotActor ActorId
    _ Actor
    body -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! Actor -> PosAtomic
    posProjBody Actor
    body
      UpdLoseActor ActorId
    _ Actor
    body -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! Actor -> PosAtomic
    posProjBody Actor
    body
      UpdSpotItem Bool
    _ ItemId
    _ ItemQuant
    _ Container
    c -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdLoseItem Bool
    _ ItemId
    _ ItemQuant
    _ Container
    c -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdSpotItemBag Bool
    _ Container
    c ItemBag
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdLoseItemBag Bool
    _ Container
    c ItemBag
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdMoveActor ActorId
    aid Point
    fromP Point
    toP -> 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
        -- Non-projectile actors are never totally isolated from environment;
        -- they hear, feel air movement, etc.
        return $! pointsProjBody b [fromP, toP]
      UpdWaitActor ActorId
    aid Watchfulness
    _ Watchfulness
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      UpdDisplaceActor ActorId
    source ActorId
    target -> ActorId -> ActorId -> m PosAtomic
    forall (m :: * -> *).
    MonadStateRead m =>
    ActorId -> ActorId -> m PosAtomic
    doubleAid ActorId
    source ActorId
    target
      UpdMoveItem ItemId
    _ Int
    _ ActorId
    aid CStore
    cstore1 CStore
    cstore2 -> 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
        mlidPos1 <- lidPosOfStash b cstore1
        mlidPos2 <- lidPosOfStash b cstore2
        let mlidPos = Maybe (LevelId, Point)
    mlidPos1 Maybe (LevelId, Point)
    -> Maybe (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Maybe (LevelId, Point)
    mlidPos2
        return $! maybe (posProjBody b)
                        (\(LevelId, Point)
    lidPos -> [(LevelId, Point)] -> PosAtomic
    PosSightLevels [(LevelId, Point)
    lidPos, (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)])
                        mlidPos
      UpdRefillHP ActorId
    aid Int64
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      UpdRefillCalm ActorId
    aid Int64
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      UpdTrajectory ActorId
    aid Maybe ([Vector], Speed)
    _ Maybe ([Vector], Speed)
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      UpdQuitFaction{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdSpotStashFaction Bool
    _ FactionId
    fid LevelId
    lid Point
    pos -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> LevelId -> [Point] -> PosAtomic
    PosFidAndSight FactionId
    fid LevelId
    lid [Point
    pos]
      UpdLoseStashFaction Bool
    _ FactionId
    fid LevelId
    lid Point
    pos -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> LevelId -> [Point] -> PosAtomic
    PosFidAndSight FactionId
    fid LevelId
    lid [Point
    pos]
      UpdLeadFaction FactionId
    fid Maybe ActorId
    _ Maybe ActorId
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFidAndSer FactionId
    fid
      UpdDiplFaction{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdDoctrineFaction{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll  -- make faction lore fun
      UpdAutoFaction{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdRecordKill ActorId
    aid ContentId ItemKind
    _ Int
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      UpdAlterTile LevelId
    lid Point
    p ContentId TileKind
    _ ContentId TileKind
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point
    p]
      UpdAlterExplorable{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
        -- Can't have @PosSight@, because we'd end up with many accessible
        -- unknown tiles, but the game reporting 'all seen'.
      UpdAlterGold{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdSearchTile ActorId
    aid Point
    p ContentId TileKind
    _ -> 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
        return $! pointsProjBody b [bpos b, p]
      UpdHideTile ActorId
    aid Point
    p ContentId TileKind
    _ -> 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
        return $! pointsProjBody b [bpos b, p]
      UpdSpotTile LevelId
    lid [(Point, ContentId TileKind)]
    ts -> do
        let ps :: [Point]
    ps = ((Point, ContentId TileKind) -> Point)
    -> [(Point, ContentId TileKind)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, ContentId TileKind) -> Point
    forall a b. (a, b) -> a
    fst [(Point, ContentId TileKind)]
    ts
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point]
    ps
      UpdLoseTile LevelId
    lid [(Point, ContentId TileKind)]
    ts -> do
        let ps :: [Point]
    ps = ((Point, ContentId TileKind) -> Point)
    -> [(Point, ContentId TileKind)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, ContentId TileKind) -> Point
    forall a b. (a, b) -> a
    fst [(Point, ContentId TileKind)]
    ts
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point]
    ps
      UpdSpotEntry LevelId
    lid [(Point, PlaceEntry)]
    ts -> do
        let ps :: [Point]
    ps = ((Point, PlaceEntry) -> Point) -> [(Point, PlaceEntry)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, PlaceEntry) -> Point
    forall a b. (a, b) -> a
    fst [(Point, PlaceEntry)]
    ts
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point]
    ps
      UpdLoseEntry LevelId
    lid [(Point, PlaceEntry)]
    ts -> do
        let ps :: [Point]
    ps = ((Point, PlaceEntry) -> Point) -> [(Point, PlaceEntry)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, PlaceEntry) -> Point
    forall a b. (a, b) -> a
    fst [(Point, PlaceEntry)]
    ts
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point]
    ps
      UpdAlterSmell LevelId
    lid Point
    p Time
    _ Time
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSmell LevelId
    lid [Point
    p]
      UpdSpotSmell LevelId
    lid [(Point, Time)]
    sms -> do
        let ps :: [Point]
    ps = ((Point, Time) -> Point) -> [(Point, Time)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, Time) -> Point
    forall a b. (a, b) -> a
    fst [(Point, Time)]
    sms
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSmell LevelId
    lid [Point]
    ps
      UpdLoseSmell LevelId
    lid [(Point, Time)]
    sms -> do
        let ps :: [Point]
    ps = ((Point, Time) -> Point) -> [(Point, Time)] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, Time) -> Point
    forall a b. (a, b) -> a
    fst [(Point, Time)]
    sms
        PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSmell LevelId
    lid [Point]
    ps
      UpdTimeItem ItemId
    _ Container
    c ItemTimers
    _ ItemTimers
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash Container
    c
      UpdAgeGame EnumSet LevelId
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdUnAgeGame EnumSet LevelId
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdDiscover Container
    c ItemId
    _ ContentId ItemKind
    _ AspectRecord
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
        -- This implies other factions applying items from their inventory,
        -- when we can't see the position of the stash, won't Id the item
        -- for us, even when notice item usage. Thrown items will Id, though,
        -- just as triggering items from the floor or embedded items.
      UpdCover Container
    c ItemId
    _ ContentId ItemKind
    _ AspectRecord
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      UpdDiscoverKind Container
    c ItemKindIx
    _ ContentId ItemKind
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      UpdCoverKind Container
    c ItemKindIx
    _ ContentId ItemKind
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      UpdDiscoverAspect Container
    c ItemId
    _ AspectRecord
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      UpdCoverAspect Container
    c ItemId
    _ AspectRecord
    _ -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      UpdDiscoverServer{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosSer
      UpdCoverServer{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosSer
      UpdPerception{} -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosNone
      UpdRestart FactionId
    fid PerLid
    _ State
    _ Challenge
    _ ClientOptions
    _ SMGen
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFid FactionId
    fid
      UpdRestartServer State
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosSer
      UpdResume FactionId
    _ PerLid
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosNone
      UpdResumeServer State
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosSer
      UpdKillExit FactionId
    fid -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFid FactionId
    fid
      UpdAtomic
    UpdWriteSave -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      UpdHearFid FactionId
    fid Maybe Int
    _ HearMsg
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFid FactionId
    fid
      UpdMuteMessages FactionId
    fid Bool
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFid FactionId
    fid

    -- | Produce the positions where the atomic special effect takes place.
    posSfxAtomic :: MonadStateRead m => SfxAtomic -> m PosAtomic
    posSfxAtomic :: forall (m :: * -> *). MonadStateRead m => SfxAtomic -> m PosAtomic
    posSfxAtomic SfxAtomic
    cmd = case SfxAtomic
    cmd of
      SfxStrike ActorId
    _ ActorId
    target ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    target
      SfxRecoil ActorId
    _ ActorId
    target ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    target
      SfxSteal ActorId
    _ ActorId
    target ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    target
      SfxRelease ActorId
    _ ActorId
    target ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    target
      SfxProject ActorId
    aid ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      SfxReceive ActorId
    aid ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      SfxApply ActorId
    aid ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      SfxCheck ActorId
    aid ItemId
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      SfxTrigger ActorId
    aid LevelId
    lid Point
    p ContentId TileKind
    _ -> 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
        return $! PosSightLevels [(lid, p), (blid body, bpos body)]
          -- @PosFidAndSightLevels@ would be better, but no big deal
      SfxShun ActorId
    aid LevelId
    lid Point
    p ContentId TileKind
    _ -> 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
        return $! PosSightLevels [(lid, p), (blid body, bpos body)]
      SfxEffect FactionId
    _ ActorId
    aid ItemId
    _ Effect
    _ Int64
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid  -- sometimes we don't see source, OK
      SfxItemApplied Bool
    _ ItemId
    _ Container
    c -> Container -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor Container
    c
      SfxMsgFid FactionId
    fid SfxMsg
    _ -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> PosAtomic
    PosFid FactionId
    fid
      SfxAtomic
    SfxRestart -> PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PosAtomic
    PosAll
      SfxCollideTile ActorId
    aid Point
    _ -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid
      SfxTaunt Bool
    _ ActorId
    aid -> ActorId -> m PosAtomic
    forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid

    -- | All items introduced by the atomic command, to be used in it.
    iidUpdAtomic :: UpdAtomic -> [ItemId]
    iidUpdAtomic :: UpdAtomic -> [ItemId]
    iidUpdAtomic UpdAtomic
    cmd = case UpdAtomic
    cmd of
      UpdRegisterItems{} -> []
      UpdCreateActor{} -> []  -- iids and items needed even on server
      UpdDestroyActor{} -> []
      UpdCreateItem{} -> []
      UpdDestroyItem{} -> []
      UpdSpotActor ActorId
    _ Actor
    body -> Actor -> [ItemId]
    getCarriedIidsAndTrunk Actor
    body
      UpdLoseActor{} -> []  -- already seen, so items known
      UpdSpotItem Bool
    _ ItemId
    iid ItemQuant
    _ Container
    _ -> [ItemId
    iid]
      UpdLoseItem{} -> []
      UpdSpotItemBag Bool
    _ Container
    _ ItemBag
    bag -> ItemBag -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys ItemBag
    bag
      UpdLoseItemBag{} -> []
      UpdMoveActor{} -> []
      UpdWaitActor{} -> []
      UpdDisplaceActor{} -> []
      UpdMoveItem{} -> []
      UpdRefillHP{} -> []
      UpdRefillCalm{} -> []
      UpdTrajectory{} -> []
      UpdQuitFaction{} -> []
      UpdSpotStashFaction{} -> []
      UpdLoseStashFaction{} -> []
      UpdLeadFaction{} -> []
      UpdDiplFaction{} -> []
      UpdDoctrineFaction{} -> []
      UpdAutoFaction{} -> []
      UpdRecordKill{} -> []
      UpdAlterTile{} -> []
      UpdAlterExplorable{} -> []
      UpdAlterGold{} -> []
      UpdSearchTile{} -> []
      UpdHideTile{} -> []
      UpdSpotTile{} -> []
      UpdLoseTile{} -> []
      UpdSpotEntry{} -> []
      UpdLoseEntry{} -> []
      UpdAlterSmell{} -> []
      UpdSpotSmell{} -> []
      UpdLoseSmell{} -> []
      UpdTimeItem ItemId
    iid Container
    _ ItemTimers
    _ ItemTimers
    _ -> [ItemId
    iid]
      UpdAgeGame{} -> []
      UpdUnAgeGame{} -> []
      UpdDiscover Container
    _ ItemId
    iid ContentId ItemKind
    _ AspectRecord
    _ -> [ItemId
    iid]
      UpdCover Container
    _ ItemId
    iid ContentId ItemKind
    _ AspectRecord
    _ -> [ItemId
    iid]
      UpdDiscoverKind{} -> []
      UpdCoverKind{} -> []
      UpdDiscoverAspect Container
    _ ItemId
    iid AspectRecord
    _ -> [ItemId
    iid]
      UpdCoverAspect Container
    _ ItemId
    iid AspectRecord
    _ -> [ItemId
    iid]
      UpdDiscoverServer{} -> []  -- never sent to clients
      UpdCoverServer{} -> []
      UpdPerception{} -> []
      UpdRestart{} -> []
      UpdRestartServer{} -> []
      UpdResume{} -> []
      UpdResumeServer{} -> []
      UpdKillExit{} -> []
      UpdAtomic
    UpdWriteSave -> []
      UpdHearFid{} -> []
      UpdMuteMessages{} -> []

    -- | All items introduced by the atomic special effect, to be used in it.
    iidSfxAtomic :: SfxAtomic -> [ItemId]
    iidSfxAtomic :: SfxAtomic -> [ItemId]
    iidSfxAtomic SfxAtomic
    cmd = case SfxAtomic
    cmd of
      SfxStrike ActorId
    _ ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxRecoil ActorId
    _ ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxSteal ActorId
    _ ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxRelease ActorId
    _ ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxProject ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxReceive ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxApply ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxCheck ActorId
    _ ItemId
    iid -> [ItemId
    iid]
      SfxTrigger{} -> []
      SfxShun{} -> []
      SfxEffect{} -> []
      SfxItemApplied Bool
    _ ItemId
    iid Container
    _ -> [ItemId
    iid]
      SfxMsgFid{} -> []
      SfxRestart{} -> []
      SfxCollideTile{} -> []
      SfxTaunt{} -> []

    pointsProjBody :: Actor -> [Point] -> PosAtomic
    pointsProjBody :: Actor -> [Point] -> PosAtomic
    pointsProjBody Actor
    body [Point]
    ps =
      if Actor -> Bool
    bproj Actor
    body
      then LevelId -> [Point] -> PosAtomic
    PosSight (Actor -> LevelId
    blid Actor
    body) [Point]
    ps
      else FactionId -> LevelId -> [Point] -> PosAtomic
    PosFidAndSight (Actor -> FactionId
    bfid Actor
    body) (Actor -> LevelId
    blid Actor
    body) [Point]
    ps

    posProjBody :: Actor -> PosAtomic
    posProjBody :: Actor -> PosAtomic
    posProjBody Actor
    body = Actor -> [Point] -> PosAtomic
    pointsProjBody Actor
    body [Actor -> Point
    bpos Actor
    body]

    singleAid :: MonadStateRead m => ActorId -> m PosAtomic
    singleAid :: forall (m :: * -> *). MonadStateRead m => ActorId -> m PosAtomic
    singleAid ActorId
    aid = do
      body <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      return $! posProjBody body

    doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic
    doubleAid :: forall (m :: * -> *).
    MonadStateRead m =>
    ActorId -> ActorId -> m PosAtomic
    doubleAid ActorId
    source ActorId
    target = do
      sb <- (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
      tb <- getsState $ getActorBody target
      -- No @PosFidAndSight@ instead of @PosSight@, because both positions
      -- need to be seen to have the enemy actor in client's state.
      return $! assert (blid sb == blid tb) $ PosSight (blid sb) [bpos sb, bpos tb]

    singleContainerStash :: MonadStateRead m => Container -> m PosAtomic
    singleContainerStash :: forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerStash (CFloor LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point
    p]
    singleContainerStash (CEmbed LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point
    p]
    singleContainerStash (CActor ActorId
    aid CStore
    cstore) = 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
      mlidPos <- lidPosOfStash b cstore
      return $! maybe (posProjBody b)
                      (\(LevelId, Point)
    lidPos -> [(LevelId, Point)] -> PosAtomic
    PosSightLevels [(LevelId, Point)
    lidPos, (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)])
                        -- the actor's position is needed so that a message
                        -- about the actor is not sent to a client that doesn't
                        -- know the actor; actor's faction is ignored, because
                        -- for these operations actor doesn't vanish
                      mlidPos
    singleContainerStash (CTrunk FactionId
    fid LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> LevelId -> [Point] -> PosAtomic
    PosFidAndSight FactionId
    fid LevelId
    lid [Point
    p]

    singleContainerActor :: MonadStateRead m => Container -> m PosAtomic
    singleContainerActor :: forall (m :: * -> *). MonadStateRead m => Container -> m PosAtomic
    singleContainerActor (CFloor LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point
    p]
    singleContainerActor (CEmbed LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! LevelId -> [Point] -> PosAtomic
    PosSight LevelId
    lid [Point
    p]
    singleContainerActor (CActor ActorId
    aid CStore
    _) = 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
      return $! posProjBody b
        -- stash position is ignored, because for these operations, nothing
        -- is added to that position; the store name is only used for flavour text
    singleContainerActor (CTrunk FactionId
    fid LevelId
    lid Point
    p) = PosAtomic -> m PosAtomic
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PosAtomic -> m PosAtomic) -> PosAtomic -> m PosAtomic
    forall a b. (a -> b) -> a -> b
    $! FactionId -> LevelId -> [Point] -> PosAtomic
    PosFidAndSight FactionId
    fid LevelId
    lid [Point
    p]

    lidPosOfStash :: MonadStateRead m
                  => Actor -> CStore -> m (Maybe (LevelId, Point))
    lidPosOfStash :: forall (m :: * -> *).
    MonadStateRead m =>
    Actor -> CStore -> m (Maybe (LevelId, Point))
    lidPosOfStash Actor
    b CStore
    cstore =
      case CStore
    cstore of
        CStore
    CStash -> do
          mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
    -> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
    forall a b. (a -> b) -> a -> b
    $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
          case mstash of
            Just{} -> Maybe (LevelId, Point) -> m (Maybe (LevelId, Point))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LevelId, Point)
    mstash
            Maybe (LevelId, Point)
    Nothing -> String -> m (Maybe (LevelId, Point))
    forall a. HasCallStack => String -> a
    error (String -> m (Maybe (LevelId, Point)))
    -> String -> m (Maybe (LevelId, Point))
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> Actor -> String
    forall v. Show v => String -> v -> String
    `showFailure` Actor
    b
        CStore
    _ -> Maybe (LevelId, Point) -> m (Maybe (LevelId, Point))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LevelId, Point)
    forall a. Maybe a
    Nothing

    -- | Decompose an atomic action that is outside a client's visiblity.
    -- The decomposed actions give less information that the original command,
    -- but some of them may fall within the visibility range of the client.
    -- The original action may give more information than even the total sum
    -- of all actions it's broken into. E.g., @UpdMoveActor@
    -- informs about the continued existence of the actor between
    -- moves vs popping out of existence and then back in.
    --
    -- This is computed in server's @State@ from before performing the command.
    breakUpdAtomic :: MonadStateRead m => UpdAtomic -> m [UpdAtomic]
    breakUpdAtomic :: forall (m :: * -> *).
    MonadStateRead m =>
    UpdAtomic -> m [UpdAtomic]
    breakUpdAtomic UpdAtomic
    cmd = case UpdAtomic
    cmd of
      UpdCreateItem Bool
    verbose ItemId
    iid Item
    item ItemQuant
    kit (CActor ActorId
    aid CStore
    CStash) -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) ->
            [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
    UpdCreateItem Bool
    verbose ItemId
    iid Item
    item ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos)]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, Item) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, Item
    item)
      UpdDestroyItem Bool
    verbose ItemId
    iid Item
    item ItemQuant
    kit (CActor ActorId
    aid CStore
    CStash) -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) ->
            [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
    UpdDestroyItem Bool
    verbose ItemId
    iid Item
    item ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos)]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, Item) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, Item
    item)
      UpdSpotItem Bool
    verbose ItemId
    iid ItemQuant
    kit (CActor ActorId
    aid CStore
    CStash) -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdSpotItem Bool
    verbose ItemId
    iid ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos)]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemId
    iid)
      UpdLoseItem Bool
    verbose ItemId
    iid ItemQuant
    kit (CActor ActorId
    aid CStore
    CStash) -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdLoseItem Bool
    verbose ItemId
    iid ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos)]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemId
    iid)
      UpdSpotItemBag Bool
    verbose (CActor ActorId
    aid CStore
    CStash) ItemBag
    bag -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> Container -> ItemBag -> UpdAtomic
    UpdSpotItemBag Bool
    verbose (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos) ItemBag
    bag]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemBag) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemBag
    bag)
      UpdLoseItemBag Bool
    verbose (CActor ActorId
    aid CStore
    CStash) ItemBag
    bag -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> Container -> ItemBag -> UpdAtomic
    UpdLoseItemBag Bool
    verbose (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos) ItemBag
    bag]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemBag) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemBag
    bag)
      UpdMoveItem ItemId
    iid Int
    k ActorId
    aid CStore
    CStash CStore
    store2 -> 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 CStash
        let (k1, it1) = bag EM.! iid
            kit = Bool -> ItemQuant -> ItemQuant
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    k1) (Int
    k, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    k ItemTimers
    it1)
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdLoseItem Bool
    True ItemId
    iid ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos)
                                    , Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdSpotItem Bool
    True ItemId
    iid ItemQuant
    kit (ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    store2) ]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemId
    iid)
      UpdMoveItem ItemId
    iid Int
    k ActorId
    aid CStore
    store1 CStore
    CStash -> 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 store1
        let (k1, it1) = bag EM.! iid
            kit = Bool -> ItemQuant -> ItemQuant
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    k1) (Int
    k, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    k ItemTimers
    it1)
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdLoseItem Bool
    True ItemId
    iid ItemQuant
    kit (ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    store1)
                                    , Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
    UpdSpotItem Bool
    True ItemId
    iid ItemQuant
    kit (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos) ]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemId
    iid)
      UpdMoveActor ActorId
    aid Point
    fromP Point
    toP -> do
        -- We assume other factions don't see leaders and we know the actor's
        -- faction always sees the atomic command and no other commands
        -- may be inserted between the two below, so the leader doesn't
        -- need to be updated, even when aid is the leader.
        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
        return [ UpdLoseActor aid b
               , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ]
      UpdDisplaceActor ActorId
    source ActorId
    target -> do
        sb <- (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
        tb <- getsState $ getActorBody target
        -- The order ensures the invariant that no two big actors occupy the same
        -- position is maintained. The actions about leadership are required
        -- to keep faction data (identify of the leader) consistent with actor
        -- data (the actor that is the leader exists). Here, for speed
        -- and simplicity we violate the property that in a faction
        -- that has leaders, if any eligible actor is alive,
        -- the leader is set, because for a moment there may be no leader,
        -- even though other actors of the faction may exist.
        msleader <- getsState $ gleader . (EM.! bfid sb) . sfactionD
        mtleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD
        return $ [ UpdLeadFaction (bfid sb) msleader Nothing
                 | Just source == msleader ]
                 ++ [ UpdLeadFaction (bfid tb) mtleader Nothing
                    | Just target == mtleader ]
                 ++ [ UpdLoseActor source sb
                    , UpdLoseActor target tb
                    , UpdSpotActor source sb { bpos = bpos tb
                                             , boldpos = Just $ bpos sb }
                    , UpdSpotActor target tb { bpos = bpos sb
                                             , boldpos = Just $ bpos tb } ]
                 ++ [ UpdLeadFaction (bfid sb) Nothing msleader
                    | Just source == msleader ]
                 ++ [ UpdLeadFaction (bfid tb) Nothing mtleader
                    | Just target == mtleader ]
      UpdTimeItem ItemId
    iid (CActor ActorId
    aid CStore
    CStash) ItemTimers
    fromIt ItemTimers
    toIt -> 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
        mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> FactionDict
    sfactionD State
    s FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
        case mstash of
          Just (LevelId
    lid, Point
    pos) -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
    UpdTimeItem ItemId
    iid (LevelId -> Point -> Container
    CFloor LevelId
    lid Point
    pos) ItemTimers
    fromIt ItemTimers
    toIt]
          Maybe (LevelId, Point)
    Nothing -> String -> m [UpdAtomic]
    forall a. HasCallStack => String -> a
    error (String -> m [UpdAtomic]) -> String -> m [UpdAtomic]
    forall a b. (a -> b) -> a -> b
    $ String
    "manipulating void stash" String -> (ActorId, Actor, ItemId) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    aid, Actor
    b, ItemId
    iid)
      UpdAtomic
    _ -> [UpdAtomic] -> m [UpdAtomic]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    -- | What is the main map level the @PosAtomic@ refers to, if any.
    lidOfPos :: PosAtomic -> Maybe LevelId
    lidOfPos :: PosAtomic -> Maybe LevelId
    lidOfPos PosAtomic
    posAtomic =
      case PosAtomic
    posAtomic of
        PosSight LevelId
    lid [Point]
    _ -> LevelId -> Maybe LevelId
    forall a. a -> Maybe a
    Just LevelId
    lid
        PosFidAndSight FactionId
    _ LevelId
    lid [Point]
    _ -> LevelId -> Maybe LevelId
    forall a. a -> Maybe a
    Just LevelId
    lid
        PosSmell LevelId
    lid [Point]
    _ -> LevelId -> Maybe LevelId
    forall a. a -> Maybe a
    Just LevelId
    lid
        PosSightLevels [] -> Maybe LevelId
    forall a. Maybe a
    Nothing
        PosSightLevels ((LevelId
    lid, Point
    _) : [(LevelId, Point)]
    _) -> LevelId -> Maybe LevelId
    forall a. a -> Maybe a
    Just LevelId
    lid
        PosFid{} -> Maybe LevelId
    forall a. Maybe a
    Nothing
        PosFidAndSer{} -> Maybe LevelId
    forall a. Maybe a
    Nothing
        PosAtomic
    PosSer -> Maybe LevelId
    forall a. Maybe a
    Nothing
        PosAtomic
    PosAll -> Maybe LevelId
    forall a. Maybe a
    Nothing
        PosAtomic
    PosNone -> Maybe LevelId
    forall a. Maybe a
    Nothing

    -- | Given the client, its perception and an atomic command, determine
    -- if the client notices the command.
    seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool
    seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool
    seenAtomicCli Bool
    knowEvents FactionId
    fid PerLid
    perLid PosAtomic
    posAtomic =
      let per :: LevelId -> Perception
    per = (PerLid
    perLid PerLid -> LevelId -> Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.!)
      in case PosAtomic
    posAtomic of
        PosSight LevelId
    lid [Point]
    ps -> (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` Perception -> EnumSet Point
    totalVisible (LevelId -> Perception
    per LevelId
    lid)) [Point]
    ps Bool -> Bool -> Bool
    || Bool
    knowEvents
        PosFidAndSight FactionId
    fid2 LevelId
    lid [Point]
    ps ->
          FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid2 Bool -> Bool -> Bool
    || (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` Perception -> EnumSet Point
    totalVisible (LevelId -> Perception
    per LevelId
    lid)) [Point]
    ps Bool -> Bool -> Bool
    || Bool
    knowEvents
        PosSmell LevelId
    lid [Point]
    ps -> (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` Perception -> EnumSet Point
    totalSmelled (LevelId -> Perception
    per LevelId
    lid)) [Point]
    ps Bool -> Bool -> Bool
    || Bool
    knowEvents
        PosSightLevels [(LevelId, Point)]
    l ->
          let visible :: (LevelId, Point) -> Bool
    visible (LevelId
    lid, Point
    pos) = Point
    pos Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` Perception -> EnumSet Point
    totalVisible (LevelId -> Perception
    per LevelId
    lid)
          in ((LevelId, Point) -> Bool) -> [(LevelId, Point)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (LevelId, Point) -> Bool
    visible [(LevelId, Point)]
    l Bool -> Bool -> Bool
    || Bool
    knowEvents
        PosFid FactionId
    fid2 -> FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid2
        PosFidAndSer FactionId
    fid2 -> FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid2
        PosAtomic
    PosSer -> Bool
    False
        PosAtomic
    PosAll -> Bool
    True
        PosAtomic
    PosNone -> Bool
    False

    -- | Determine whether the server would see a command that has
    -- the given visibilty conditions.
    seenAtomicSer :: PosAtomic -> Bool
    seenAtomicSer :: PosAtomic -> Bool
    seenAtomicSer PosAtomic
    posAtomic =
      case PosAtomic
    posAtomic of
        PosFid FactionId
    _ -> Bool
    False
        PosAtomic
    PosNone -> String -> Bool
    forall a. HasCallStack => String -> a
    error (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "no position possible" String -> PosAtomic -> String
    forall v. Show v => String -> v -> String
    `showFailure` PosAtomic
    posAtomic
        PosAtomic
    _ -> Bool
    True