-- | A set of atomic commands shared by client and server.
-- These are the largest building blocks that have no components
-- that can be observed in isolation.
--
-- We try to make atomic commands respect the laws of energy and mass
-- conservation, unless they really can't, e.g., monster spawning.
-- For example item removal from equipment, in isolation, is not an atomic
-- command, but item dropped from equipment to the ground is. This makes
-- it easier to undo the commands. In principle, the commands are the only
-- way to affect the basic game state ('State').
--
-- See
-- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>.
module Game.LambdaHack.Atomic.CmdAtomic
  ( CmdAtomic(..), UpdAtomic(..), HearMsg(..), SfxAtomic(..), SfxMsg(..)
  , undoUpdAtomic, undoSfxAtomic, undoCmdAtomic
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumSet as ES
import           Data.Int (Int64)
import qualified System.Random.SplitMix32 as SM

-- Dependence on ClientOptions is an anomaly. Instead, probably the raw
-- remaining commandline should be passed and parsed by the client to extract
-- client and ui options from and singnal an error if anything was left.

import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.Analytics
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | Abstract syntax of atomic commands, that is, atomic game state
-- transformations.
data CmdAtomic =
    UpdAtomic UpdAtomic  -- ^ atomic updates
  | SfxAtomic SfxAtomic  -- ^ atomic special effects
  deriving Int -> CmdAtomic -> ShowS
[CmdAtomic] -> ShowS
CmdAtomic -> String
(Int -> CmdAtomic -> ShowS)
-> (CmdAtomic -> String)
-> ([CmdAtomic] -> ShowS)
-> Show CmdAtomic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdAtomic] -> ShowS
$cshowList :: [CmdAtomic] -> ShowS
show :: CmdAtomic -> String
$cshow :: CmdAtomic -> String
showsPrec :: Int -> CmdAtomic -> ShowS
$cshowsPrec :: Int -> CmdAtomic -> ShowS
Show

-- TODO: needed in the future, if efect, to save undo information:
--
--  deriving (Show, Eq, Generic)
--
-- instance Binary CmdAtomic

-- | Abstract syntax of atomic updates, that is, atomic commands
-- that really change the 'State'. Most of them are an encoding of a game
-- state diff, though they also carry some intentional hints
-- that help clients determine whether and how to communicate it to players.
data UpdAtomic =
  -- Create/destroy actors and items.
    UpdRegisterItems [(ItemId, Item)]
  | UpdCreateActor ActorId Actor [(ItemId, Item)]
  | UpdDestroyActor ActorId Actor [(ItemId, Item)]
  | UpdCreateItem Bool ItemId Item ItemQuant Container
  | UpdDestroyItem Bool ItemId Item ItemQuant Container
  | UpdSpotActor ActorId Actor
  | UpdLoseActor ActorId Actor
  | UpdSpotItem Bool ItemId ItemQuant Container
  | UpdLoseItem Bool ItemId ItemQuant Container
  | UpdSpotItemBag Bool Container ItemBag
  | UpdLoseItemBag Bool Container ItemBag
  -- Move actors and items.
  | UpdMoveActor ActorId Point Point
  | UpdWaitActor ActorId Watchfulness Watchfulness
  | UpdDisplaceActor ActorId ActorId
  | UpdMoveItem ItemId Int ActorId CStore CStore
  -- Change actor attributes.
  | UpdRefillHP ActorId Int64
  | UpdRefillCalm ActorId Int64
  | UpdTrajectory ActorId (Maybe ([Vector], Speed)) (Maybe ([Vector], Speed))
  -- Change faction attributes.
  | UpdQuitFaction FactionId (Maybe Status) (Maybe Status)
                   (Maybe (FactionAnalytics, GenerationAnalytics))
  | UpdSpotStashFaction Bool FactionId LevelId Point
  | UpdLoseStashFaction Bool FactionId LevelId Point
  | UpdLeadFaction FactionId (Maybe ActorId) (Maybe ActorId)
  | UpdDiplFaction FactionId FactionId Diplomacy Diplomacy
  | UpdDoctrineFaction FactionId Ability.Doctrine Ability.Doctrine
  | UpdAutoFaction FactionId Bool
  | UpdRecordKill ActorId (ContentId ItemKind) Int
  -- Alter map.
  | UpdAlterTile LevelId Point (ContentId TileKind) (ContentId TileKind)
  | UpdAlterExplorable LevelId Int
  | UpdAlterGold Int
  | UpdSearchTile ActorId Point (ContentId TileKind)
  | UpdHideTile ActorId Point (ContentId TileKind)
  | UpdSpotTile LevelId [(Point, ContentId TileKind)]
  | UpdLoseTile LevelId [(Point, ContentId TileKind)]
  | UpdSpotEntry LevelId [(Point, PK.PlaceEntry)]
  | UpdLoseEntry LevelId [(Point, PK.PlaceEntry)]
  | UpdAlterSmell LevelId Point Time Time
  | UpdSpotSmell LevelId [(Point, Time)]
  | UpdLoseSmell LevelId [(Point, Time)]
  -- Assorted.
  | UpdTimeItem ItemId Container ItemTimers ItemTimers
  | UpdAgeGame (ES.EnumSet LevelId)
  | UpdUnAgeGame (ES.EnumSet LevelId)
  | UpdDiscover Container ItemId (ContentId ItemKind) IA.AspectRecord
      -- Here and below @Container@ is only used for presentation
      -- and when @CStash@ is not visible, but the item is, it won't
      -- break anything, because item identification is not registered globally.
  | UpdCover Container ItemId (ContentId ItemKind) IA.AspectRecord
  | UpdDiscoverKind Container ItemKindIx (ContentId ItemKind)
  | UpdCoverKind Container ItemKindIx (ContentId ItemKind)
  | UpdDiscoverAspect Container ItemId IA.AspectRecord
  | UpdCoverAspect Container ItemId IA.AspectRecord
  | UpdDiscoverServer ItemId IA.AspectRecord
  | UpdCoverServer ItemId IA.AspectRecord
  | UpdPerception LevelId Perception Perception
  | UpdRestart FactionId PerLid State Challenge ClientOptions SM.SMGen
  | UpdRestartServer State
  | UpdResume FactionId PerLid
  | UpdResumeServer State
  | UpdKillExit FactionId
  | UpdWriteSave
  | UpdHearFid FactionId (Maybe Int) HearMsg
      -- in @UpdAtomic@ to let AI analyze and count
  deriving Int -> UpdAtomic -> ShowS
[UpdAtomic] -> ShowS
UpdAtomic -> String
(Int -> UpdAtomic -> ShowS)
-> (UpdAtomic -> String)
-> ([UpdAtomic] -> ShowS)
-> Show UpdAtomic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdAtomic] -> ShowS
$cshowList :: [UpdAtomic] -> ShowS
show :: UpdAtomic -> String
$cshow :: UpdAtomic -> String
showsPrec :: Int -> UpdAtomic -> ShowS
$cshowsPrec :: Int -> UpdAtomic -> ShowS
Show

-- | Symbolic representation of text messages about heard noises,
-- sent by server to clients and shown to players and used by AI.
data HearMsg =
    HearUpd UpdAtomic
  | HearStrike (ContentId ItemKind)
  | HearSummon Bool (GroupName ItemKind) Dice.Dice
  | HearCollideTile
  | HearTaunt Text
  deriving Int -> HearMsg -> ShowS
[HearMsg] -> ShowS
HearMsg -> String
(Int -> HearMsg -> ShowS)
-> (HearMsg -> String) -> ([HearMsg] -> ShowS) -> Show HearMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HearMsg] -> ShowS
$cshowList :: [HearMsg] -> ShowS
show :: HearMsg -> String
$cshow :: HearMsg -> String
showsPrec :: Int -> HearMsg -> ShowS
$cshowsPrec :: Int -> HearMsg -> ShowS
Show

-- | Abstract syntax of atomic special effects, that is, atomic commands
-- that only display special effects and don't change 'State' nor client state.
data SfxAtomic =
    SfxStrike ActorId ActorId ItemId
  | SfxRecoil ActorId ActorId ItemId
  | SfxSteal ActorId ActorId ItemId
  | SfxRelease ActorId ActorId ItemId
  | SfxProject ActorId ItemId
  | SfxReceive ActorId ItemId
  | SfxApply ActorId ItemId
  | SfxCheck ActorId ItemId
  | SfxTrigger ActorId LevelId Point (ContentId TileKind)
  | SfxShun ActorId LevelId Point (ContentId TileKind)
  | SfxEffect FactionId ActorId ItemId IK.Effect Int64
  | SfxItemApplied ItemId Container
  | SfxMsgFid FactionId SfxMsg
  | SfxRestart
  | SfxCollideTile ActorId Point
  | SfxTaunt Bool ActorId
  deriving Int -> SfxAtomic -> ShowS
[SfxAtomic] -> ShowS
SfxAtomic -> String
(Int -> SfxAtomic -> ShowS)
-> (SfxAtomic -> String)
-> ([SfxAtomic] -> ShowS)
-> Show SfxAtomic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SfxAtomic] -> ShowS
$cshowList :: [SfxAtomic] -> ShowS
show :: SfxAtomic -> String
$cshow :: SfxAtomic -> String
showsPrec :: Int -> SfxAtomic -> ShowS
$cshowsPrec :: Int -> SfxAtomic -> ShowS
Show

-- | Symbolic representation of text messages sent by server to clients
-- and shown to players.
data SfxMsg =
    SfxUnexpected ReqFailure
  | SfxExpected Text ReqFailure
  | SfxExpectedEmbed ItemId LevelId ReqFailure
  | SfxFizzles ItemId Container
  | SfxNothingHappens ItemId Container
  | SfxNoItemsForTile [[(Int, GroupName ItemKind)]]
  | SfxVoidDetection IK.DetectKind
  | SfxUnimpressed ActorId
  | SfxSummonLackCalm ActorId
  | SfxSummonTooManyOwn ActorId
  | SfxSummonTooManyAll ActorId
  | SfxSummonFailure ActorId
  | SfxLevelNoMore
  | SfxLevelPushed
  | SfxBracedImmune ActorId
  | SfxEscapeImpossible
  | SfxStasisProtects
  | SfxWaterParalysisResisted
  | SfxTransImpossible
  | SfxIdentifyNothing
  | SfxPurposeNothing
  | SfxPurposeTooFew Int Int
  | SfxPurposeUnique
  | SfxPurposeNotCommon
  | SfxRerollNothing
  | SfxRerollNotRandom
  | SfxDupNothing
  | SfxDupUnique
  | SfxDupValuable
  | SfxColdFish
  | SfxReadyGoods
  | SfxTimerExtended ActorId ItemId CStore (Delta Time)
      -- This @CStore@ is only printed, so even @CStash@ is safe.
  | SfxCollideActor ActorId ActorId
  | SfxItemYield ItemId Int LevelId
  deriving Int -> SfxMsg -> ShowS
[SfxMsg] -> ShowS
SfxMsg -> String
(Int -> SfxMsg -> ShowS)
-> (SfxMsg -> String) -> ([SfxMsg] -> ShowS) -> Show SfxMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SfxMsg] -> ShowS
$cshowList :: [SfxMsg] -> ShowS
show :: SfxMsg -> String
$cshow :: SfxMsg -> String
showsPrec :: Int -> SfxMsg -> ShowS
$cshowsPrec :: Int -> SfxMsg -> ShowS
Show

undoUpdAtomic :: UpdAtomic -> Maybe UpdAtomic
undoUpdAtomic :: UpdAtomic -> Maybe UpdAtomic
undoUpdAtomic cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
  UpdRegisterItems{} -> Maybe UpdAtomic
forall a. Maybe a
Nothing  -- harmless and never forgotten
  UpdCreateActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdDestroyActor ActorId
aid Actor
body [(ItemId, Item)]
ais
  UpdDestroyActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdCreateActor ActorId
aid Actor
body [(ItemId, Item)]
ais
  UpdCreateItem verbose :: Bool
verbose iid :: ItemId
iid item :: Item
item k :: ItemQuant
k c :: Container
c ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
verbose ItemId
iid Item
item ItemQuant
k Container
c
  UpdDestroyItem verbose :: Bool
verbose iid :: ItemId
iid item :: Item
item k :: ItemQuant
k c :: Container
c ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem Bool
verbose ItemId
iid Item
item ItemQuant
k Container
c
  UpdSpotActor aid :: ActorId
aid body :: Actor
body -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
aid Actor
body
  UpdLoseActor aid :: ActorId
aid body :: Actor
body -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
aid Actor
body
  UpdSpotItem verbose :: Bool
verbose iid :: ItemId
iid k :: ItemQuant
k c :: Container
c -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
verbose ItemId
iid ItemQuant
k Container
c
  UpdLoseItem verbose :: Bool
verbose iid :: ItemId
iid k :: ItemQuant
k c :: Container
c -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
verbose ItemId
iid ItemQuant
k Container
c
  UpdSpotItemBag verbose :: Bool
verbose c :: Container
c bag :: ItemBag
bag -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> Container -> ItemBag -> UpdAtomic
UpdLoseItemBag Bool
verbose Container
c ItemBag
bag
  UpdLoseItemBag verbose :: Bool
verbose c :: Container
c bag :: ItemBag
bag -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> Container -> ItemBag -> UpdAtomic
UpdSpotItemBag Bool
verbose Container
c ItemBag
bag
  UpdMoveActor aid :: ActorId
aid fromP :: Point
fromP toP :: Point
toP -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> Point -> UpdAtomic
UpdMoveActor ActorId
aid Point
toP Point
fromP
  UpdWaitActor aid :: ActorId
aid fromWS :: Watchfulness
fromWS toWS :: Watchfulness
toWS -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
UpdWaitActor ActorId
aid Watchfulness
toWS Watchfulness
fromWS
  UpdDisplaceActor source :: ActorId
source target :: ActorId
target -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> UpdAtomic
UpdDisplaceActor ActorId
target ActorId
source
  UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid store1 :: CStore
store1 store2 :: CStore
store2 ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> Int -> ActorId -> CStore -> CStore -> UpdAtomic
UpdMoveItem ItemId
iid Int
k ActorId
aid CStore
store2 CStore
store1
  UpdRefillHP aid :: ActorId
aid n :: Int64
n -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid (-Int64
n)
  UpdRefillCalm aid :: ActorId
aid n :: Int64
n -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillCalm ActorId
aid (-Int64
n)
  UpdTrajectory aid :: ActorId
aid fromT :: Maybe ([Vector], Speed)
fromT toT :: Maybe ([Vector], Speed)
toT -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid Maybe ([Vector], Speed)
toT Maybe ([Vector], Speed)
fromT
  UpdQuitFaction fid :: FactionId
fid fromSt :: Maybe Status
fromSt toSt :: Maybe Status
toSt manalytics :: Maybe (FactionAnalytics, GenerationAnalytics)
manalytics ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ FactionId
-> Maybe Status
-> Maybe Status
-> Maybe (FactionAnalytics, GenerationAnalytics)
-> UpdAtomic
UpdQuitFaction FactionId
fid Maybe Status
toSt Maybe Status
fromSt Maybe (FactionAnalytics, GenerationAnalytics)
manalytics
  UpdSpotStashFaction verbose :: Bool
verbose fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdLoseStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos
  UpdLoseStashFaction verbose :: Bool
verbose fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
verbose FactionId
fid LevelId
lid Point
pos
  UpdLeadFaction fid :: FactionId
fid source :: Maybe ActorId
source target :: Maybe ActorId
target -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
fid Maybe ActorId
target Maybe ActorId
source
  UpdDiplFaction fid1 :: FactionId
fid1 fid2 :: FactionId
fid2 fromDipl :: Diplomacy
fromDipl toDipl :: Diplomacy
toDipl ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ FactionId -> FactionId -> Diplomacy -> Diplomacy -> UpdAtomic
UpdDiplFaction FactionId
fid1 FactionId
fid2 Diplomacy
toDipl Diplomacy
fromDipl
  UpdDoctrineFaction fid :: FactionId
fid toT :: Doctrine
toT fromT :: Doctrine
fromT -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ FactionId -> Doctrine -> Doctrine -> UpdAtomic
UpdDoctrineFaction FactionId
fid Doctrine
fromT Doctrine
toT
  UpdAutoFaction fid :: FactionId
fid st :: Bool
st -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
fid (Bool -> Bool
not Bool
st)
  UpdRecordKill aid :: ActorId
aid ikind :: ContentId ItemKind
ikind k :: Int
k -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ContentId ItemKind -> Int -> UpdAtomic
UpdRecordKill ActorId
aid ContentId ItemKind
ikind (-Int
k)
  UpdAlterTile lid :: LevelId
lid p :: Point
p fromTile :: ContentId TileKind
fromTile toTile :: ContentId TileKind
toTile ->
    UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> UpdAtomic
UpdAlterTile LevelId
lid Point
p ContentId TileKind
toTile ContentId TileKind
fromTile
  UpdAlterExplorable lid :: LevelId
lid delta :: Int
delta -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> Int -> UpdAtomic
UpdAlterExplorable LevelId
lid (-Int
delta)
  UpdAlterGold delta :: Int
delta -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Int -> UpdAtomic
UpdAlterGold (-Int
delta)
  UpdSearchTile aid :: ActorId
aid p :: Point
p toTile :: ContentId TileKind
toTile -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> ContentId TileKind -> UpdAtomic
UpdHideTile ActorId
aid Point
p ContentId TileKind
toTile
  UpdHideTile aid :: ActorId
aid p :: Point
p toTile :: ContentId TileKind
toTile -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> ContentId TileKind -> UpdAtomic
UpdSearchTile ActorId
aid Point
p ContentId TileKind
toTile
  UpdSpotTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, ContentId TileKind)] -> UpdAtomic
UpdLoseTile LevelId
lid [(Point, ContentId TileKind)]
ts
  UpdLoseTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, ContentId TileKind)] -> UpdAtomic
UpdSpotTile LevelId
lid [(Point, ContentId TileKind)]
ts
  UpdSpotEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
UpdLoseEntry LevelId
lid [(Point, PlaceEntry)]
ts
  UpdLoseEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
UpdSpotEntry LevelId
lid [(Point, PlaceEntry)]
ts
  UpdAlterSmell lid :: LevelId
lid p :: Point
p fromSm :: Time
fromSm toSm :: Time
toSm -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> Time -> Time -> UpdAtomic
UpdAlterSmell LevelId
lid Point
p Time
toSm Time
fromSm
  UpdSpotSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, Time)] -> UpdAtomic
UpdLoseSmell LevelId
lid [(Point, Time)]
sms
  UpdLoseSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, Time)] -> UpdAtomic
UpdSpotSmell LevelId
lid [(Point, Time)]
sms
  UpdTimeItem iid :: ItemId
iid c :: Container
c fromIt :: ItemTimers
fromIt toIt :: ItemTimers
toIt -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
UpdTimeItem ItemId
iid Container
c ItemTimers
toIt ItemTimers
fromIt
  UpdAgeGame lids :: EnumSet LevelId
lids -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> UpdAtomic
UpdUnAgeGame EnumSet LevelId
lids
  UpdUnAgeGame lids :: EnumSet LevelId
lids -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> UpdAtomic
UpdAgeGame EnumSet LevelId
lids
  UpdDiscover c :: Container
c iid :: ItemId
iid ik :: ContentId ItemKind
ik arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdCover Container
c ItemId
iid ContentId ItemKind
ik AspectRecord
arItem
  UpdCover c :: Container
c iid :: ItemId
iid ik :: ContentId ItemKind
ik arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
ik AspectRecord
arItem
  UpdDiscoverKind c :: Container
c ix :: ItemKindIx
ix ik :: ContentId ItemKind
ik -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container -> ItemKindIx -> ContentId ItemKind -> UpdAtomic
UpdCoverKind Container
c ItemKindIx
ix ContentId ItemKind
ik
  UpdCoverKind c :: Container
c ix :: ItemKindIx
ix ik :: ContentId ItemKind
ik -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container -> ItemKindIx -> ContentId ItemKind -> UpdAtomic
UpdDiscoverKind Container
c ItemKindIx
ix ContentId ItemKind
ik
  UpdDiscoverAspect c :: Container
c iid :: ItemId
iid arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container -> ItemId -> AspectRecord -> UpdAtomic
UpdCoverAspect Container
c ItemId
iid AspectRecord
arItem
  UpdCoverAspect c :: Container
c iid :: ItemId
iid arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ Container -> ItemId -> AspectRecord -> UpdAtomic
UpdDiscoverAspect Container
c ItemId
iid AspectRecord
arItem
  UpdDiscoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> AspectRecord -> UpdAtomic
UpdCoverServer ItemId
iid AspectRecord
arItem
  UpdCoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> AspectRecord -> UpdAtomic
UpdDiscoverServer ItemId
iid AspectRecord
arItem
  UpdPerception lid :: LevelId
lid outPer :: Perception
outPer inPer :: Perception
inPer -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just (UpdAtomic -> Maybe UpdAtomic) -> UpdAtomic -> Maybe UpdAtomic
forall a b. (a -> b) -> a -> b
$ LevelId -> Perception -> Perception -> UpdAtomic
UpdPerception LevelId
lid Perception
inPer Perception
outPer
  UpdRestart{} -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just UpdAtomic
cmd  -- here history ends; change direction
  UpdRestartServer{} -> UpdAtomic -> Maybe UpdAtomic
forall a. a -> Maybe a
Just UpdAtomic
cmd  -- here history ends; change direction
  UpdResume{} -> Maybe UpdAtomic
forall a. Maybe a
Nothing
  UpdResumeServer{} -> Maybe UpdAtomic
forall a. Maybe a
Nothing
  UpdKillExit{} -> Maybe UpdAtomic
forall a. Maybe a
Nothing
  UpdWriteSave -> Maybe UpdAtomic
forall a. Maybe a
Nothing
  UpdHearFid{} -> Maybe UpdAtomic
forall a. Maybe a
Nothing

undoSfxAtomic :: SfxAtomic -> SfxAtomic
undoSfxAtomic :: SfxAtomic -> SfxAtomic
undoSfxAtomic cmd :: SfxAtomic
cmd = case SfxAtomic
cmd of
  SfxStrike source :: ActorId
source target :: ActorId
target iid :: ItemId
iid -> ActorId -> ActorId -> ItemId -> SfxAtomic
SfxRecoil ActorId
source ActorId
target ItemId
iid
  SfxRecoil source :: ActorId
source target :: ActorId
target iid :: ItemId
iid -> ActorId -> ActorId -> ItemId -> SfxAtomic
SfxStrike ActorId
source ActorId
target ItemId
iid
  SfxSteal source :: ActorId
source target :: ActorId
target iid :: ItemId
iid -> ActorId -> ActorId -> ItemId -> SfxAtomic
SfxRelease ActorId
source ActorId
target ItemId
iid
  SfxRelease source :: ActorId
source target :: ActorId
target iid :: ItemId
iid -> ActorId -> ActorId -> ItemId -> SfxAtomic
SfxSteal ActorId
source ActorId
target ItemId
iid
  SfxProject aid :: ActorId
aid iid :: ItemId
iid -> ActorId -> ItemId -> SfxAtomic
SfxReceive ActorId
aid ItemId
iid
  SfxReceive aid :: ActorId
aid iid :: ItemId
iid -> ActorId -> ItemId -> SfxAtomic
SfxProject ActorId
aid ItemId
iid
  SfxApply aid :: ActorId
aid iid :: ItemId
iid -> ActorId -> ItemId -> SfxAtomic
SfxCheck ActorId
aid ItemId
iid
  SfxCheck aid :: ActorId
aid iid :: ItemId
iid -> ActorId -> ItemId -> SfxAtomic
SfxApply ActorId
aid ItemId
iid
  SfxTrigger aid :: ActorId
aid lid :: LevelId
lid p :: Point
p tile :: ContentId TileKind
tile -> ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic
SfxShun ActorId
aid LevelId
lid Point
p ContentId TileKind
tile
  SfxShun aid :: ActorId
aid lid :: LevelId
lid p :: Point
p tile :: ContentId TileKind
tile -> ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic
SfxTrigger ActorId
aid LevelId
lid Point
p ContentId TileKind
tile
  SfxEffect{} -> SfxAtomic
cmd  -- not ideal?
  SfxItemApplied{} -> SfxAtomic
cmd
  SfxMsgFid{} -> SfxAtomic
cmd
  SfxRestart -> SfxAtomic
cmd
  SfxCollideTile{} -> SfxAtomic
cmd
  SfxTaunt{} -> SfxAtomic
cmd

undoCmdAtomic :: CmdAtomic -> Maybe CmdAtomic
undoCmdAtomic :: CmdAtomic -> Maybe CmdAtomic
undoCmdAtomic (UpdAtomic cmd :: UpdAtomic
cmd) = UpdAtomic -> CmdAtomic
UpdAtomic (UpdAtomic -> CmdAtomic) -> Maybe UpdAtomic -> Maybe CmdAtomic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdAtomic -> Maybe UpdAtomic
undoUpdAtomic UpdAtomic
cmd
undoCmdAtomic (SfxAtomic sfx :: SfxAtomic
sfx) = CmdAtomic -> Maybe CmdAtomic
forall a. a -> Maybe a
Just (CmdAtomic -> Maybe CmdAtomic) -> CmdAtomic -> Maybe CmdAtomic
forall a b. (a -> b) -> a -> b
$ SfxAtomic -> CmdAtomic
SfxAtomic (SfxAtomic -> CmdAtomic) -> SfxAtomic -> CmdAtomic
forall a b. (a -> b) -> a -> b
$ SfxAtomic -> SfxAtomic
undoSfxAtomic SfxAtomic
sfx