<commit_before>-- | Handle atomic commands received by the client.
module Game.LambdaHack.Client.HandleAtomicM
  ( MonadClientSetup(..)
  , cmdAtomicSemCli
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , invalidateInMelee, invalidateInMeleeDueToItem
  , wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs
  , createActor, destroyActor
  , addItemToDiscoBenefit, perception
  , discoverKind, discoverKindAndAspect, coverKind, coverAspectAndKind
  , discoverAspect, coverAspect
  , killExit
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Preferences
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import           Game.LambdaHack.Definition.Defs

-- | Client monad for saving a game.
class MonadClient m => MonadClientSetup m where
  saveClient    :: m ()

-- | Effect of atomic actions on client state. It is calculated
-- with the global state from after the command is executed
-- (except where the supplied @oldState@ is used).
cmdAtomicSemCli :: MonadClientSetup m => State -> UpdAtomic -> m ()
{-# INLINE cmdAtomicSemCli #-}
cmdAtomicSemCli oldState cmd = case cmd of
  UpdRegisterItems ais -> mapM_ (addItemToDiscoBenefit . fst) ais
  UpdCreateActor aid b ais -> createActor aid b ais
  UpdDestroyActor aid b _ -> destroyActor aid b True
  UpdCreateItem _ iid _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    addItemToDiscoBenefit iid
    invalidateInMeleeDueToItem aid store
  UpdCreateItem _ iid _ _ _ -> addItemToDiscoBenefit iid
  UpdDestroyItem _ _ _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdDestroyItem{} -> return ()
  UpdSpotActor aid b -> do
    ais <- getsState $ getCarriedAssocsAndTrunk b
    createActor aid b ais
  UpdLoseActor aid b -> destroyActor aid b False
  UpdSpotItem _ iid _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    addItemToDiscoBenefit iid
    invalidateInMeleeDueToItem aid store
  UpdSpotItem _ iid _ _ -> addItemToDiscoBenefit iid
  UpdLoseItem _ _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdLoseItem{} -> return ()
  UpdSpotItemBag _ (CActor aid store) bag -> do
    wipeBfsIfItemAffectsSkills [store] aid
    mapM_ addItemToDiscoBenefit $ EM.keys bag
    invalidateInMeleeDueToItem aid store
  UpdSpotItemBag _ _ bag ->
    mapM_ addItemToDiscoBenefit $ EM.keys bag
  UpdLoseItemBag _ (CActor aid store) _ -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdLoseItemBag{} -> return ()
  UpdMoveActor aid _ _ -> do
    invalidateBfsAid aid
    b <- getsState $ getActorBody aid
    -- BFS not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    invalidateInMelee (blid b)
  UpdWaitActor aid _fromW toW ->
    -- So that we can later ignore such actors when updating targets
    -- and not risk they being pushed/displaced and targets getting illegal.
    when (toW == WSleep) $
      modifyClient $ updateTarget aid (const Nothing)
  UpdDisplaceActor source target -> do
    invalidateBfsAid source
    invalidateBfsAid target
    b <- getsState $ getActorBody source
    -- BFS not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    invalidateInMelee (blid b)
  UpdMoveItem _ _ aid s1 s2 -> do
    wipeBfsIfItemAffectsSkills [s1, s2] aid
    invalidateInMeleeDueToItem aid s1
    invalidateInMeleeDueToItem aid s2
  UpdRefillHP{} -> return ()
  UpdRefillCalm{} -> return ()
  UpdTrajectory{} -> return ()
  UpdQuitFaction fid _ toSt _ -> do
    side <- getsClient sside
    gameModeId <- getsState sgameModeId
    when (side == fid) $ case toSt of
      Just Status{stOutcome=Camping} ->
        modifyClient $ \cli ->
          cli {scampings = ES.insert gameModeId $ scampings cli}
      Just Status{stOutcome=Restart} ->
        modifyClient $ \cli ->
          cli {srestarts = ES.insert gameModeId $ srestarts cli}
      Just Status{stOutcome} | stOutcome `elem` victoryOutcomes -> do
        scurChal <- getsClient scurChal
        let sing = M.singleton scurChal 1
            f = M.unionWith (+)
            g = EM.insertWith f gameModeId sing
        modifyClient $ \cli -> cli {svictories = g $ svictories cli}
      _ -> return ()
  UpdSpotStashFaction{} -> return ()
  UpdLoseStashFaction{} -> return ()
  UpdLeadFaction fid source target -> do
    side <- getsClient sside
    when (side == fid) $ do
      mleader <- getsClient sleader
      let !_A = assert (mleader == source
                          -- somebody changed the leader for us
                        || mleader == target
                          -- we changed the leader ourselves
                        `blame` "unexpected leader"
                        `swith` (cmd, mleader)) ()
      modifyClient $ \cli -> cli {_sleader = target}
  UpdDiplFaction{} -> return ()<commit_msg>Fix scondInMelee not being invalidated often enough<commit_after>-- | Handle atomic commands received by the client.
module Game.LambdaHack.Client.HandleAtomicM
  ( MonadClientSetup(..)
  , cmdAtomicSemCli
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , invalidateInMelee, invalidateInMeleeDueToItem
  , wipeBfsIfItemAffectsSkills, tileChangeAffectsBfs
  , createActor, destroyActor
  , addItemToDiscoBenefit, perception
  , discoverKind, discoverKindAndAspect, coverKind, coverAspectAndKind
  , discoverAspect, coverAspect
  , killExit
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Preferences
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.CaveKind as CK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import           Game.LambdaHack.Definition.Defs

-- | Client monad for saving a game.
class MonadClient m => MonadClientSetup m where
  saveClient    :: m ()

-- | Effect of atomic actions on client state. It is calculated
-- with the global state from after the command is executed
-- (except where the supplied @oldState@ is used).
cmdAtomicSemCli :: MonadClientSetup m => State -> UpdAtomic -> m ()
{-# INLINE cmdAtomicSemCli #-}
cmdAtomicSemCli oldState cmd = case cmd of
  UpdRegisterItems ais -> mapM_ (addItemToDiscoBenefit . fst) ais
  UpdCreateActor aid b ais -> createActor aid b ais
  UpdDestroyActor aid b _ -> destroyActor aid b True
  UpdCreateItem _ iid _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    addItemToDiscoBenefit iid
    invalidateInMeleeDueToItem aid store
  UpdCreateItem _ iid _ _ _ -> addItemToDiscoBenefit iid
  UpdDestroyItem _ _ _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdDestroyItem{} -> return ()
  UpdSpotActor aid b -> do
    ais <- getsState $ getCarriedAssocsAndTrunk b
    createActor aid b ais
  UpdLoseActor aid b -> destroyActor aid b False
  UpdSpotItem _ iid _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    addItemToDiscoBenefit iid
    invalidateInMeleeDueToItem aid store
  UpdSpotItem _ iid _ _ -> addItemToDiscoBenefit iid
  UpdLoseItem _ _ _ (CActor aid store) -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdLoseItem{} -> return ()
  UpdSpotItemBag _ (CActor aid store) bag -> do
    wipeBfsIfItemAffectsSkills [store] aid
    mapM_ addItemToDiscoBenefit $ EM.keys bag
    invalidateInMeleeDueToItem aid store
  UpdSpotItemBag _ _ bag ->
    mapM_ addItemToDiscoBenefit $ EM.keys bag
  UpdLoseItemBag _ (CActor aid store) _ -> do
    wipeBfsIfItemAffectsSkills [store] aid
    invalidateInMeleeDueToItem aid store
  UpdLoseItemBag{} -> return ()
  UpdMoveActor aid _ _ -> do
    invalidateBfsAid aid
    b <- getsState $ getActorBody aid
    -- BFS not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    invalidateInMelee (blid b)
  UpdWaitActor aid _fromW toW -> do
    -- So that we can later ignore such actors when updating targets
    -- and not risk they being pushed/displaced and targets getting illegal.
    when (toW == WSleep) $
      modifyClient $ updateTarget aid (const Nothing)
    b <- getsState $ getActorBody aid
    invalidateInMelee (blid b)  -- @bwatch@ checked in several places
  UpdDisplaceActor source target -> do
    invalidateBfsAid source
    invalidateBfsAid target
    b <- getsState $ getActorBody source
    -- BFS not invalidated, because distant actors may still move out
    -- of the way and close actors are considered when attempting to move
    -- and then BFS is invalidated, if needed.
    invalidateInMelee (blid b)
  UpdMoveItem _ _ aid s1 s2 -> do
    wipeBfsIfItemAffectsSkills [s1, s2] aid
    invalidateInMeleeDueToItem aid s1
    invalidateInMeleeDueToItem aid s2
  UpdRefillHP _ 0 -> return ()
  UpdRefillHP aid _ -> do
    b <- getsState $ getActorBody aid
    invalidateInMelee (blid b)  -- @bhp@ checked in several places
  UpdRefillCalm{} -> return ()
  UpdTrajectory{} -> return ()
  UpdQuitFaction fid _ toSt _ -> do
    side <- getsClient sside
    gameModeId <- getsState sgameModeId
    when (side == fid) $ case toSt of
      Just Status{stOutcome=Camping} ->
        modifyClient $ \cli ->
          cli {scampings = ES.insert gameModeId $ scampings cli}
      Just Status{stOutcome=Restart} ->
        modifyClient $ \cli ->
          cli {srestarts = ES.insert gameModeId $ srestarts cli}
      Just Status{stOutcome} | stOutcome `elem` victoryOutcomes -> do
        scurChal <- getsClient scurChal
        let sing = M.singleton scurChal 1
            f = M.unionWith (+)
            g = EM.insertWith f gameModeId sing
        modifyClient $ \cli -> cli {svictories = g $ svictories cli}
      _ -> return ()
  UpdSpotStashFaction{} -> return ()
  UpdLoseStashFaction{} -> return ()
  UpdLeadFaction fid source target -> do
    side <- getsClient sside
    when (side == fid) $ do
      mleader <- getsClient sleader
      let !_A = assert (mleader == source
                          -- somebody changed the leader for us
                        || mleader == target
                          -- we changed the leader ourselves
                        `blame` "unexpected leader"
                        `swith` (cmd, mleader)) ()
      modifyClient $ \cli -> cli {_sleader = target}
  UpdDiplFaction{} ->
    modifyClient $ \cli -> cli {scondInMelee = EM.empty}
{'fraction_non_alphanumeric': 0.06998989034917179, 'fraction_numerical': 0.0011664981724861965, 'mean_word_length': 2.8653441538923956, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 87, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5557263', 'n_tokens_mistral': 4073, 'n_tokens_neox': 3954, 'n_words': 1141}