content: -- | 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 (Show, 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 cmd = case cmd of
    UpdRegisterItems{} -> return PosNone
    UpdCreateActor _ body _ -> return $! posProjBody body
    UpdDestroyActor _ body _ -> return $! posProjBody body
    UpdCreateItem _ _ _ _ c -> singleContainerStash c
    UpdDestroyItem _ _ _ _ c -> singleContainerStash c
    UpdSpotActor _ body -> return $! posProjBody body
    UpdLoseActor _ body -> return $! posProjBody body
    UpdSpotItem _ _ _ c -> singleContainerStash c
    UpdLoseItem _ _ _ c -> singleContainerStash c
    UpdSpotItemBag _ c _ -> singleContainerStash c
    UpdLoseItemBag _ c _ -> singleContainerStash c
    UpdMoveActor aid fromP toP -> do
      b <- getsState $ getActorBody aid
      -- Non-projectile actors are never totally isolated from environment;
      -- they hear, feel air movement, etc.
      return $! pointsProjBody b [fromP, toP]
    UpdWaitActor aid _ _ -> singleAid aid
    UpdDisplaceActor source target -> doubleAid source target
    UpdMoveItem _ _ aid cstore1 cstore2 -> do
      b <- getsState $ getActorBody aid
      mlidPos1 <- lidPosOfStash b cstore1
      mlidPos2 <- lidPosOfStash b cstore2
      let mlidPos = mlidPos1 `mplus` mlidPos2
      return $! maybe (posProjBody b)
                      (\lidPos -> PosSightLevels [lidPos, (blid b, bpos b)])
                      mlidPos
    UpdRefillHP aid _ -> singleAid aid
    UpdRefillCalm aid _ -> singleAid aid
    UpdTrajectory aid _ _ -> singleAid aid
    UpdQuitFaction{} -> return PosAll
    UpdSpotStashFaction _ fid lid pos -> return $! PosFidAndSight fid lid [pos]
    UpdLoseStashFaction _ fid lid pos -> return $! PosFidAndSight fid lid [pos]
    UpdLeadFaction fid _ _ -> return $! PosFidAndSer fid
    UpdDiplFaction{} -> return PosAll
    UpdDoctrineFaction{} -> return PosAll  -- make faction lore fun
    UpdAutoFaction{} -> return PosAll
    UpdRecordKill aid _ _ -> singleAid aid
    UpdAlterTile lid p _ _ -> return $! PosSight lid [p]
    UpdAlterExplorable{} -> return PosAll
      -- Can't have @PosSight@, because we'd end up with many accessible
      -- unknown tiles, but the game reporting 'all seen'.
    UpdAlterGold{} -> return PosAll
    UpdSearchTile aid p _ -> do
      b <- getsState $ getActorBody aid
      return $! pointsProjBody b [bpos b, p]
    UpdHideTile aid p _ -> do
      b <- getsState $ getActorBody aid
      return $! pointsProjBody b [bpos b, p]
    UpdSpotTile lid ts -> do
      let ps = map fst ts
      return $! PosSight lid ps
    UpdLoseTile lid ts -> do
      let ps = map fst ts
      return $! PosSight lid ps
    UpdSpotEntry lid ts -> do
      let ps = map fst ts
      return $! PosSight lid ps
    UpdLoseEntry lid ts -> do
      let ps = map fst ts
      return $! PosSight lid ps
    UpdAlterSmell lid p _ _ -> return $! PosSmell lid [p]
    UpdSpotSmell lid sms -> do
      let ps = map fst sms
      return $! PosSmell lid ps
    UpdLoseSmell lid sms -> do
      let ps = map fst sms
      return $! PosSmell lid ps
    UpdTimeItem _ c _ _ -> singleContainerStash c
    UpdAgeGame _ -> return PosAll
    UpdUnAgeGame _ -> return PosAll
    UpdDiscover c _ _ _ -> singleContainerActor 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 c _ _ _ -> singleContainerActor c
    UpdDiscoverKind c _ _ -> singleContainerActor c
    UpdCoverKind c _ _ -> singleContainerActor c
    UpdDiscoverAspect c _ _ -> singleContainerActor c
    UpdCoverAspect c _ _ -> singleContainerActor c
    UpdDiscoverServer{} -> return PosSer
    UpdCoverServer{} -> return PosSer
    UpdPerception{} -> return PosNone
    UpdRestart fid _ _ _ _ _ -> return $! PosFid fid
    UpdRestartServer _ -> return PosSer
    UpdResume _ _ -> return PosNone
    UpdResumeServer _ -> return PosSer
    UpdKillExit fid -> return $! PosFid fid
    UpdWriteSave -> return PosAll
    UpdHearFid fid _ _ -> return $! PosFid fid
    UpdMuteMessages fid _ -> return $! PosFid fid
  
  -- | Produce the positions where the atomic special effect takes place.
  posSfxAtomic :: MonadStateRead m => SfxAtomic -> m PosAtomic
  posSfxAtomic cmd = case cmd of
    SfxStrike _ target _ -> singleAid target
    SfxRecoil _ target _ -> singleAid target
    SfxSteal _ target _ -> singleAid target
    SfxRelease _ target _ -> singleAid target
    SfxProject aid _ -> singleAid aid
    SfxReceive aid _ -> singleAid aid
    SfxApply aid _ -> singleAid aid
    SfxCheck aid _ -> singleAid aid
    SfxTrigger aid lid p _ -> do
      body <- getsState $ getActorBody aid
      return $! PosSightLevels [(lid, p), (blid body, bpos body)]
        -- @PosFidAndSightLevels@ would be better, but no big deal
    SfxShun aid lid p _ -> do
      body <- getsState $ getActorBody aid
      return $! PosSightLevels [(lid, p), (blid body, bpos body)]
    SfxEffect _ aid _ _ _ -> singleAid aid  -- sometimes we don't see source, OK
    SfxItemApplied _ _ c -> singleContainerActor c
    SfxMsgFid fid _ -> return $! PosFid fid
    SfxRestart -> return PosAll
    SfxCollideTile aid _ -> singleAid aid
    SfxTaunt _ aid -> singleAid aid
  
  -- | All items introduced by the atomic command, to be used in it.
  iidUpdAtomic :: UpdAtomic -> [ItemId]
  iidUpdAtomic cmd = case cmd of
    UpdRegisterItems{} -> []
    UpdCreateActor{} -> []  -- iids and items needed even on server
    UpdDestroyActor{} -> []
    UpdCreateItem{} -> []
    UpdDestroyItem{} -> []
    UpdSpotActor _ body -> getCarriedIidsAndTrunk body
    UpdLoseActor{} -> []  -- already seen, so items known
    UpdSpotItem _ iid _ _ -> [iid]
    UpdLoseItem{} -> []
    UpdSpotItemBag _ _ bag -> EM.keys 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 iid _ _ _ -> [iid]
    UpdAgeGame{} -> []
    UpdUnAgeGame{} -> []
    UpdDiscover _ iid _ _ -> [iid]
    UpdCover _ iid _ _ -> [iid]
    UpdDiscoverKind{} -> []
    UpdCoverKind{} -> []
    UpdDiscoverAspect _ iid _ -> [iid]
    UpdCoverAspect _ iid _ -> [iid]
    UpdDiscoverServer{} -> []  -- never sent to clients
    UpdCoverServer{} -> []
    UpdPerception{} -> []
    UpdRestart{} -> []
    UpdRestartServer{} -> []
    UpdResume{} -> []
    UpdResumeServer{} -> []
    UpdKillExit{} -> []
    UpdWriteSave -> []
    UpdHearFid{} -> []
    UpdMuteMessages{} -> []
  
  -- | All items introduced by the atomic special effect, to be used in it.
  iidSfxAtomic :: SfxAtomic -> [ItemId]
  iidSfxAtomic cmd = case cmd of
    SfxStrike _ _ iid -> [iid]
    SfxRecoil _ _ iid -> [iid]
    SfxSteal _ _ iid -> [iid]
    SfxRelease _ _ iid -> [iid]
    SfxProject _ iid -> [iid]
    SfxReceive _ iid -> [iid]
    SfxApply _ iid -> [iid]
    SfxCheck _ iid -> [iid]
    SfxTrigger{} -> []
    SfxShun{} -> []
    SfxEffect{} -> []
    SfxItemApplied _ iid _ -> [iid]
    SfxMsgFid{} -> []
    SfxRestart{} -> []
    SfxCollideTile{} -> []
    SfxTaunt{} -> []
  
  pointsProjBody :: Actor -> [Point] -> PosAtomic
  pointsProjBody body ps =
    if bproj body
    then PosSight (blid body) ps
    else PosFidAndSight (bfid body) (blid body) ps
  
  posProjBody :: Actor -> PosAtomic
  posProjBody body = pointsProjBody body [bpos body]
  
  singleAid :: MonadStateRead m => ActorId -> m PosAtomic
  singleAid aid = do
    body <- getsState $ getActorBody aid
    return $! posProjBody body
  
  doubleAid :: MonadStateRead m => ActorId -> ActorId -> m PosAtomic
  doubleAid source target = do
    sb <- getsState $ getActorBody 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 (CFloor lid p) = return $! PosSight lid [p]
  singleContainerStash (CEmbed lid p) = return $! PosSight lid [p]
  singleContainerStash (CActor aid cstore) = do
    b <- getsState $ getActorBody aid
    mlidPos <- lidPosOfStash b cstore
    return $! maybe (posProjBody b)
                    (\lidPos -> PosSightLevels [lidPos, (blid b, bpos 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 fid lid p) = return $! PosFidAndSight fid lid [p]
  
  singleContainerActor :: MonadStateRead m => Container -> m PosAtomic
  singleContainerActor (CFloor lid p) = return $! PosSight lid [p]
  singleContainerActor (CEmbed lid p) = return $! PosSight lid [p]
  singleContainerActor (CActor aid _) = do
    b <- getsState $ getActorBody 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 fid lid p) = return $! PosFidAndSight fid lid [p]
  
  lidPosOfStash :: MonadStateRead m
                => Actor -> CStore -> m (Maybe (LevelId, Point))
  lidPosOfStash b cstore =
    case cstore of
      CStash -> do
        mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
        case mstash of
          Just{} -> return mstash
          Nothing -> error $ "manipulating void stash" `showFailure` b
      _ -> return 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 cmd = case cmd of
    UpdCreateItem verbose iid item kit (CActor aid CStash) -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) ->
          return [UpdCreateItem verbose iid item kit (CFloor lid pos)]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, item)
    UpdDestroyItem verbose iid item kit (CActor aid CStash) -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) ->
          return [UpdDestroyItem verbose iid item kit (CFloor lid pos)]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, item)
    UpdSpotItem verbose iid kit (CActor aid CStash) -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [UpdSpotItem verbose iid kit (CFloor lid pos)]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)
    UpdLoseItem verbose iid kit (CActor aid CStash) -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [UpdLoseItem verbose iid kit (CFloor lid pos)]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)
    UpdSpotItemBag verbose (CActor aid CStash) bag -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [UpdSpotItemBag verbose (CFloor lid pos) bag]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, bag)
    UpdLoseItemBag verbose (CActor aid CStash) bag -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [UpdLoseItemBag verbose (CFloor lid pos) bag]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, bag)
    UpdMoveItem iid k aid CStash store2 -> do
      b <- getsState $ getActorBody aid
      bag <- getsState $ getBodyStoreBag b CStash
      let (k1, it1) = bag EM.! iid
          kit = assert (k <= k1) (k, take k it1)
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [ UpdLoseItem True iid kit (CFloor lid pos)
                                  , UpdSpotItem True iid kit (CActor aid store2) ]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)
    UpdMoveItem iid k aid store1 CStash -> do
      b <- getsState $ getActorBody aid
      bag <- getsState $ getBodyStoreBag b store1
      let (k1, it1) = bag EM.! iid
          kit = assert (k <= k1) (k, take k it1)
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [ UpdLoseItem True iid kit (CActor aid store1)
                                  , UpdSpotItem True iid kit (CFloor lid pos) ]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)
    UpdMoveActor aid fromP 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 <- getsState $ getActorBody aid
      return [ UpdLoseActor aid b
             , UpdSpotActor aid b {bpos = toP, boldpos = Just fromP} ]
    UpdDisplaceActor source target -> do
      sb <- getsState $ getActorBody 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 iid (CActor aid CStash) fromIt toIt -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> return [UpdTimeItem iid (CFloor lid pos) fromIt toIt]
        Nothing -> error $ "manipulating void stash" `showFailure` (aid, b, iid)
    _ -> return []
  
  -- | What is the main map level the @PosAtomic@ refers to, if any.
  lidOfPos :: PosAtomic -> Maybe LevelId
  lidOfPos posAtomic =
    case posAtomic of
      PosSight lid _ -> Just lid
      PosFidAndSight _ lid _ -> Just lid
      PosSmell lid _ -> Just lid
      PosSightLevels [] -> Nothing
      PosSightLevels ((lid, _) : _) -> Just lid
      PosFid{} -> Nothing
      PosFidAndSer{} -> Nothing
      PosSer -> Nothing
      PosAll -> Nothing
      PosNone -> Nothing
  
  -- | Given the client, its perception and an atomic command, determine
  -- if the client notices the command.
  seenAtomicCli :: Bool -> FactionId -> PerLid -> PosAtomic -> Bool
  seenAtomicCli knowEvents fid perLid posAtomic =
    let per = (perLid EM.!)
    in case posAtomic of
      PosSight lid ps -> all (`ES.member` totalVisible (per lid)) ps || knowEvents
      PosFidAndSight fid2 lid ps ->
        fid == fid2 || all (`ES.member` totalVisible (per lid)) ps || knowEvents
      PosSmell lid ps -> all (`ES.member` totalSmelled (per lid)) ps || knowEvents
      PosSightLevels l ->
        let visible (lid, pos) = pos `ES.member` totalVisible (per lid)
        in all visible l || knowEvents
      PosFid fid2 -> fid == fid2
      PosFidAndSer fid2 -> fid == fid2
      PosSer -> False
      PosAll -> True
      PosNone -> False
  
  -- | Determine whether the server would see a command that has
  -- the given visibilty conditions.
  seenAtomicSer :: PosAtomic -> Bool
  seenAtomicSer posAtomic =
    case posAtomic of
      PosFid _ -> False
      PosNone -> error $ "no position possible" `showFailure` posAtomic
      _ -> True
  