{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Atomic.HandleAtomicWrite
( handleUpdAtomic
#ifdef EXPOSE_INTERNAL
, updRegisterItems, updCreateActor, updDestroyActor
, updCreateItem, updDestroyItem, updSpotItemBag, updLoseItemBag
, updMoveActor, updWaitActor, updDisplaceActor, updMoveItem
, updRefillHP, updRefillCalm
, updTrajectory, updQuitFaction, updSpotStashFaction, updLoseStashFaction
, updLeadFaction, updDiplFaction, updDoctrineFaction, updAutoFaction
, updRecordKill, updAlterTile, updAlterExplorable, updSearchTile
, updSpotTile, updLoseTile, updAlterSmell, updSpotSmell, updLoseSmell
, updTimeItem, updAgeGame, updUnAgeGame, ageLevel, updDiscover, updCover
, updDiscoverKind, discoverKind, updCoverKind
, updDiscoverAspect, discoverAspect, updCoverAspect
, updDiscoverServer, updCoverServer
, updRestart, updRestartServer, updResumeServer
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int64)
import Game.LambdaHack.Atomic.CmdAtomic
import Game.LambdaHack.Atomic.MonadStateWrite
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.PlaceKind as PK
import Game.LambdaHack.Content.TileKind (TileKind, unknownId)
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
handleUpdAtomic :: MonadStateWrite m => UpdAtomic -> m ()
handleUpdAtomic :: UpdAtomic -> m ()
handleUpdAtomic cmd :: UpdAtomic
cmd = case UpdAtomic
cmd of
UpdRegisterItems ais :: [(ItemId, Item)]
ais -> [(ItemId, Item)] -> m ()
forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
updRegisterItems [(ItemId, Item)]
ais
UpdCreateActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais -> ActorId -> Actor -> [(ItemId, Item)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> [(ItemId, Item)] -> m ()
updCreateActor ActorId
aid Actor
body [(ItemId, Item)]
ais
UpdDestroyActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais -> ActorId -> Actor -> [(ItemId, Item)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> [(ItemId, Item)] -> m ()
updDestroyActor ActorId
aid Actor
body [(ItemId, Item)]
ais
UpdCreateItem _ iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit c :: Container
c -> ItemId -> Item -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> ItemQuant -> Container -> m ()
updCreateItem ItemId
iid Item
item ItemQuant
kit Container
c
UpdDestroyItem _ iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit c :: Container
c -> ItemId -> Item -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> ItemQuant -> Container -> m ()
updDestroyItem ItemId
iid Item
item ItemQuant
kit Container
c
UpdSpotActor aid :: ActorId
aid body :: Actor
body -> ActorId -> Actor -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
updSpotActor ActorId
aid Actor
body
UpdLoseActor aid :: ActorId
aid body :: Actor
body -> ActorId -> Actor -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
updLoseActor ActorId
aid Actor
body
UpdSpotItem _ iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c -> ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
updSpotItem ItemId
iid ItemQuant
kit Container
c
UpdLoseItem _ iid :: ItemId
iid kit :: ItemQuant
kit c :: Container
c -> ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
updLoseItem ItemId
iid ItemQuant
kit Container
c
UpdSpotItemBag _ c :: Container
c bag :: ItemBag
bag -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Container -> ItemBag -> m ()
updSpotItemBag Container
c ItemBag
bag
UpdLoseItemBag _ c :: Container
c bag :: ItemBag
bag -> Container -> ItemBag -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Container -> ItemBag -> m ()
updLoseItemBag Container
c ItemBag
bag
UpdMoveActor aid :: ActorId
aid fromP :: Point
fromP toP :: Point
toP -> ActorId -> Point -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Point -> Point -> m ()
updMoveActor ActorId
aid Point
fromP Point
toP
UpdWaitActor aid :: ActorId
aid fromWS :: Watchfulness
fromWS toWS :: Watchfulness
toWS -> ActorId -> Watchfulness -> Watchfulness -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Watchfulness -> Watchfulness -> m ()
updWaitActor ActorId
aid Watchfulness
fromWS Watchfulness
toWS
UpdDisplaceActor source :: ActorId
source target :: ActorId
target -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> ActorId -> m ()
updDisplaceActor ActorId
source ActorId
target
UpdMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid c1 :: CStore
c1 c2 :: CStore
c2 -> ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
updMoveItem ItemId
iid Int
k ActorId
aid CStore
c1 CStore
c2
UpdRefillHP aid :: ActorId
aid n :: Int64
n -> ActorId -> Int64 -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
updRefillHP ActorId
aid Int64
n
UpdRefillCalm aid :: ActorId
aid n :: Int64
n -> ActorId -> Int64 -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Int64 -> m ()
updRefillCalm ActorId
aid Int64
n
UpdTrajectory aid :: ActorId
aid fromT :: Maybe ([Vector], Speed)
fromT toT :: Maybe ([Vector], Speed)
toT -> ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
updTrajectory ActorId
aid Maybe ([Vector], Speed)
fromT Maybe ([Vector], Speed)
toT
UpdQuitFaction fid :: FactionId
fid fromSt :: Maybe Status
fromSt toSt :: Maybe Status
toSt _ -> FactionId -> Maybe Status -> Maybe Status -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> Maybe Status -> Maybe Status -> m ()
updQuitFaction FactionId
fid Maybe Status
fromSt Maybe Status
toSt
UpdSpotStashFaction _ fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos -> FactionId -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> LevelId -> Point -> m ()
updSpotStashFaction FactionId
fid LevelId
lid Point
pos
UpdLoseStashFaction _ fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos -> FactionId -> LevelId -> Point -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> LevelId -> Point -> m ()
updLoseStashFaction FactionId
fid LevelId
lid Point
pos
UpdLeadFaction fid :: FactionId
fid source :: Maybe ActorId
source target :: Maybe ActorId
target -> FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
updLeadFaction FactionId
fid Maybe ActorId
source Maybe ActorId
target
UpdDiplFaction fid1 :: FactionId
fid1 fid2 :: FactionId
fid2 fromDipl :: Diplomacy
fromDipl toDipl :: Diplomacy
toDipl ->
FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
updDiplFaction FactionId
fid1 FactionId
fid2 Diplomacy
fromDipl Diplomacy
toDipl
UpdDoctrineFaction fid :: FactionId
fid toT :: Doctrine
toT fromT :: Doctrine
fromT -> FactionId -> Doctrine -> Doctrine -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> Doctrine -> Doctrine -> m ()
updDoctrineFaction FactionId
fid Doctrine
toT Doctrine
fromT
UpdAutoFaction fid :: FactionId
fid st :: Bool
st -> FactionId -> Bool -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> Bool -> m ()
updAutoFaction FactionId
fid Bool
st
UpdRecordKill aid :: ActorId
aid ikind :: ContentId ItemKind
ikind k :: Int
k -> ActorId -> ContentId ItemKind -> Int -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> ContentId ItemKind -> Int -> m ()
updRecordKill ActorId
aid ContentId ItemKind
ikind Int
k
UpdAlterTile lid :: LevelId
lid p :: Point
p fromTile :: ContentId TileKind
fromTile toTile :: ContentId TileKind
toTile -> LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m ()
updAlterTile LevelId
lid Point
p ContentId TileKind
fromTile ContentId TileKind
toTile
UpdAlterExplorable lid :: LevelId
lid delta :: Int
delta -> LevelId -> Int -> m ()
forall (m :: * -> *). MonadStateWrite m => LevelId -> Int -> m ()
updAlterExplorable LevelId
lid Int
delta
UpdAlterGold delta :: Int
delta -> Int -> m ()
forall (m :: * -> *). MonadStateWrite m => Int -> m ()
updAlterGold Int
delta
UpdSearchTile aid :: ActorId
aid p :: Point
p toTile :: ContentId TileKind
toTile -> ActorId -> Point -> ContentId TileKind -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Point -> ContentId TileKind -> m ()
updSearchTile ActorId
aid Point
p ContentId TileKind
toTile
UpdHideTile{} -> m ()
forall a. HasCallStack => a
undefined
UpdSpotTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updSpotTile LevelId
lid [(Point, ContentId TileKind)]
ts
UpdLoseTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts -> LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updLoseTile LevelId
lid [(Point, ContentId TileKind)]
ts
UpdSpotEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> LevelId -> [(Point, PlaceEntry)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, PlaceEntry)] -> m ()
updSpotEntry LevelId
lid [(Point, PlaceEntry)]
ts
UpdLoseEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts -> LevelId -> [(Point, PlaceEntry)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, PlaceEntry)] -> m ()
updLoseEntry LevelId
lid [(Point, PlaceEntry)]
ts
UpdAlterSmell lid :: LevelId
lid p :: Point
p fromSm :: Time
fromSm toSm :: Time
toSm -> LevelId -> Point -> Time -> Time -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> Point -> Time -> Time -> m ()
updAlterSmell LevelId
lid Point
p Time
fromSm Time
toSm
UpdSpotSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> LevelId -> [(Point, Time)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, Time)] -> m ()
updSpotSmell LevelId
lid [(Point, Time)]
sms
UpdLoseSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms -> LevelId -> [(Point, Time)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, Time)] -> m ()
updLoseSmell LevelId
lid [(Point, Time)]
sms
UpdTimeItem iid :: ItemId
iid c :: Container
c fromIt :: ItemTimers
fromIt toIt :: ItemTimers
toIt -> ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
updTimeItem ItemId
iid Container
c ItemTimers
fromIt ItemTimers
toIt
UpdAgeGame lids :: EnumSet LevelId
lids -> EnumSet LevelId -> m ()
forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
updAgeGame EnumSet LevelId
lids
UpdUnAgeGame lids :: EnumSet LevelId
lids -> EnumSet LevelId -> m ()
forall (m :: * -> *). MonadStateWrite m => EnumSet LevelId -> m ()
updUnAgeGame EnumSet LevelId
lids
UpdDiscover c :: Container
c iid :: ItemId
iid ik :: ContentId ItemKind
ik arItem :: AspectRecord
arItem -> Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
updDiscover Container
c ItemId
iid ContentId ItemKind
ik AspectRecord
arItem
UpdCover c :: Container
c iid :: ItemId
iid ik :: ContentId ItemKind
ik arItem :: AspectRecord
arItem -> Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
forall (m :: * -> *).
Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
updCover Container
c ItemId
iid ContentId ItemKind
ik AspectRecord
arItem
UpdDiscoverKind c :: Container
c ix :: ItemKindIx
ix ik :: ContentId ItemKind
ik -> Container -> ItemKindIx -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Container -> ItemKindIx -> ContentId ItemKind -> m ()
updDiscoverKind Container
c ItemKindIx
ix ContentId ItemKind
ik
UpdCoverKind c :: Container
c ix :: ItemKindIx
ix ik :: ContentId ItemKind
ik -> Container -> ItemKindIx -> ContentId ItemKind -> m ()
forall (m :: * -> *).
Container -> ItemKindIx -> ContentId ItemKind -> m ()
updCoverKind Container
c ItemKindIx
ix ContentId ItemKind
ik
UpdDiscoverAspect c :: Container
c iid :: ItemId
iid arItem :: AspectRecord
arItem -> Container -> ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Container -> ItemId -> AspectRecord -> m ()
updDiscoverAspect Container
c ItemId
iid AspectRecord
arItem
UpdCoverAspect c :: Container
c iid :: ItemId
iid arItem :: AspectRecord
arItem -> Container -> ItemId -> AspectRecord -> m ()
forall (m :: * -> *). Container -> ItemId -> AspectRecord -> m ()
updCoverAspect Container
c ItemId
iid AspectRecord
arItem
UpdDiscoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem -> ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> AspectRecord -> m ()
updDiscoverServer ItemId
iid AspectRecord
arItem
UpdCoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem -> ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> AspectRecord -> m ()
updCoverServer ItemId
iid AspectRecord
arItem
UpdPerception _ outPer :: Perception
outPer inPer :: Perception
inPer ->
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Perception -> Bool
nullPer Perception
outPer Bool -> Bool -> Bool
&& Perception -> Bool
nullPer Perception
inPer)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
UpdRestart _ _ s :: State
s _ _ _ -> State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
updRestart State
s
UpdRestartServer s :: State
s -> State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
updRestartServer State
s
UpdResume{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdResumeServer s :: State
s -> State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
updResumeServer State
s
UpdKillExit{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdWriteSave -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdHearFid{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updRegisterItems :: MonadStateWrite m => [(ItemId, Item)] -> m ()
updRegisterItems :: [(ItemId, Item)] -> m ()
updRegisterItems ais :: [(ItemId, Item)]
ais = do
let h :: Item -> Item -> Item
h item1 :: Item
item1 item2 :: Item
item2 =
Bool -> Item -> Item
forall a. HasCallStack => Bool -> a -> a
assert (Item -> Item -> Bool
itemsMatch Item
item1 Item
item2
Bool -> (String, (Item, Item, [(ItemId, Item)])) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "inconsistent added items"
String
-> (Item, Item, [(ItemId, Item)])
-> (String, (Item, Item, [(ItemId, Item)]))
forall v. String -> v -> (String, v)
`swith` (Item
item1, Item
item2, [(ItemId, Item)]
ais))
Item
item2
[(ItemId, Item)] -> ((ItemId, Item) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ [(ItemId, Item)]
ais (((ItemId, Item) -> m ()) -> m ())
-> ((ItemId, Item) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(iid :: ItemId
iid, item :: Item
item) -> do
let f :: State -> State
f = case Item -> ItemIdentity
jkind Item
item of
IdentityObvious _ -> State -> State
forall a. a -> a
id
IdentityCovered ix :: ItemKindIx
ix _ ->
(ItemIxMap -> ItemIxMap) -> State -> State
updateItemIxMap ((ItemIxMap -> ItemIxMap) -> State -> State)
-> (ItemIxMap -> ItemIxMap) -> State -> State
forall a b. (a -> b) -> a -> b
$ (EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId)
-> ItemKindIx -> EnumSet ItemId -> ItemIxMap -> ItemIxMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith EnumSet ItemId -> EnumSet ItemId -> EnumSet ItemId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union ItemKindIx
ix (ItemId -> EnumSet ItemId
forall k. Enum k => k -> EnumSet k
ES.singleton ItemId
iid)
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ State -> State
f (State -> State) -> (State -> State) -> State -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemDict -> ItemDict) -> State -> State
updateItemD ((Item -> Item -> Item) -> ItemId -> Item -> ItemDict -> ItemDict
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Item -> Item -> Item
h ItemId
iid Item
item)
updCreateActor :: MonadStateWrite m
=> ActorId -> Actor -> [(ItemId, Item)] -> m ()
updCreateActor :: ActorId -> Actor -> [(ItemId, Item)] -> m ()
updCreateActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais = do
[(ItemId, Item)] -> m ()
forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
updRegisterItems [(ItemId, Item)]
ais
ActorId -> Actor -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
updSpotActor ActorId
aid Actor
body
updDestroyActor :: MonadStateWrite m
=> ActorId -> Actor -> [(ItemId, Item)] -> m ()
updDestroyActor :: ActorId -> Actor -> [(ItemId, Item)] -> m ()
updDestroyActor aid :: ActorId
aid body :: Actor
body ais :: [(ItemId, Item)]
ais = do
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
let match :: (ItemId, Item) -> Bool
match (iid :: ItemId
iid, item :: Item
item) = Item -> Item -> Bool
itemsMatch (ItemDict
itemD ItemDict -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) Item
item
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (((ItemId, Item) -> Bool) -> [(ItemId, Item)] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (ItemId, Item) -> Bool
match [(ItemId, Item)]
ais Bool
-> (String, (ActorId, Actor, [(ItemId, Item)], ItemDict)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "destroyed actor items not found"
String
-> (ActorId, Actor, [(ItemId, Item)], ItemDict)
-> (String, (ActorId, Actor, [(ItemId, Item)], ItemDict))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, [(ItemId, Item)]
ais, ItemDict
itemD)) ()
ActorId -> Actor -> m ()
forall (m :: * -> *). MonadStateWrite m => ActorId -> Actor -> m ()
updLoseActor ActorId
aid Actor
body
updCreateItem :: MonadStateWrite m
=> ItemId -> Item -> ItemQuant -> Container -> m ()
updCreateItem :: ItemId -> Item -> ItemQuant -> Container -> m ()
updCreateItem iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit c :: Container
c = do
[(ItemId, Item)] -> m ()
forall (m :: * -> *). MonadStateWrite m => [(ItemId, Item)] -> m ()
updRegisterItems [(ItemId
iid, Item
item)]
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
updSpotItem ItemId
iid ItemQuant
kit Container
c
updDestroyItem :: MonadStateWrite m
=> ItemId -> Item -> ItemQuant -> Container -> m ()
updDestroyItem :: ItemId -> Item -> ItemQuant -> Container -> m ()
updDestroyItem iid :: ItemId
iid item :: Item
item kit :: ItemQuant
kit@(k :: Int
k, _) c :: Container
c = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert ((case ItemId
iid ItemId -> ItemDict -> Maybe Item
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemDict
itemD of
Nothing -> Bool
False
Just item0 :: Item
item0 -> Item -> Item -> Bool
itemsMatch Item
item0 Item
item)
Bool -> (String, (ItemId, Item, ItemDict)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "item already removed"
String
-> (ItemId, Item, ItemDict) -> (String, (ItemId, Item, ItemDict))
forall v. String -> v -> (String, v)
`swith` (ItemId
iid, Item
item, ItemDict
itemD)) ()
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
updLoseItem ItemId
iid ItemQuant
kit Container
c
updSpotActor :: MonadStateWrite m => ActorId -> Actor -> m ()
updSpotActor :: ActorId -> Actor -> m ()
updSpotActor aid :: ActorId
aid body :: Actor
body = do
let f :: Maybe Actor -> Maybe Actor
f Nothing = Actor -> Maybe Actor
forall a. a -> Maybe a
Just Actor
body
f (Just b :: Actor
b) = Bool -> Maybe Actor -> Maybe Actor
forall a. HasCallStack => Bool -> a -> a
assert (Actor
body Actor -> Actor -> Bool
forall a. Eq a => a -> a -> Bool
== Actor
b Bool -> (ActorId, Actor, Actor) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ActorId
aid, Actor
body, Actor
b)) (Maybe Actor -> Maybe Actor) -> Maybe Actor -> Maybe Actor
forall a b. (a -> b) -> a -> b
$
String -> Maybe Actor
forall a. String -> a
atomicFail (String -> Maybe Actor) -> String -> Maybe Actor
forall a b. (a -> b) -> a -> b
$ "actor already added" String -> (ActorId, Actor, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body, Actor
b)
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorDict -> ActorDict) -> State -> State
updateActorD ((ActorDict -> ActorDict) -> State -> State)
-> (ActorDict -> ActorDict) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Maybe Actor -> Maybe Actor) -> ActorId -> ActorDict -> ActorDict
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Actor -> Maybe Actor
f ActorId
aid
let g :: Maybe [ActorId] -> Maybe [ActorId]
g Nothing = [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId
aid]
g (Just l :: [ActorId]
l) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe [ActorId] -> Maybe [ActorId]
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
aid ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ActorId]
l Bool -> (String, (ActorId, Actor, [ActorId])) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "actor already added"
String
-> (ActorId, Actor, [ActorId])
-> (String, (ActorId, Actor, [ActorId]))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, [ActorId]
l))
#endif
([ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just ([ActorId] -> Maybe [ActorId]) -> [ActorId] -> Maybe [ActorId]
forall a b. (a -> b) -> a -> b
$ ActorId
aid ActorId -> [ActorId] -> [ActorId]
forall a. a -> [a] -> [a]
: [ActorId]
l)
let h :: Maybe ActorId -> Maybe ActorId
h Nothing = ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
h (Just aid2 :: ActorId
aid2) = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ "an actor already present there"
String -> (ActorId, Actor, ActorId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body, ActorId
aid2)
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel (Actor -> LevelId
blid Actor
body) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ if Actor -> Bool
bproj Actor
body
then (ProjectileMap -> ProjectileMap) -> Level -> Level
updateProjMap ((Maybe [ActorId] -> Maybe [ActorId])
-> Point -> ProjectileMap -> ProjectileMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe [ActorId] -> Maybe [ActorId]
g (Actor -> Point
bpos Actor
body))
else (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap ((Maybe ActorId -> Maybe ActorId)
-> Point -> BigActorMap -> BigActorMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ActorId -> Maybe ActorId
h (Actor -> Point
bpos Actor
body))
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ Actor -> State -> Skills
maxSkillsFromActor Actor
body
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills ((ActorMaxSkills -> ActorMaxSkills) -> State -> State)
-> (ActorMaxSkills -> ActorMaxSkills) -> State -> State
forall a b. (a -> b) -> a -> b
$ ActorId -> Skills -> ActorMaxSkills -> ActorMaxSkills
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid Skills
actorMaxSk
updLoseActor :: MonadStateWrite m => ActorId -> Actor -> m ()
updLoseActor :: ActorId -> Actor -> m ()
updLoseActor aid :: ActorId
aid body :: Actor
body = do
let f :: Maybe Actor -> Maybe Actor
f Nothing = String -> Maybe Actor
forall a. HasCallStack => String -> a
error (String -> Maybe Actor) -> String -> Maybe Actor
forall a b. (a -> b) -> a -> b
$ "actor already removed" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
f (Just b :: Actor
b) = Bool -> Maybe Actor -> Maybe Actor
forall a. HasCallStack => Bool -> a -> a
assert (Actor
b Actor -> Actor -> Bool
forall a. Eq a => a -> a -> Bool
== Actor
body Bool -> (String, (ActorId, Actor, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "inconsistent destroyed actor body"
String
-> (ActorId, Actor, Actor) -> (String, (ActorId, Actor, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, Actor
b)) Maybe Actor
forall a. Maybe a
Nothing
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorDict -> ActorDict) -> State -> State
updateActorD ((ActorDict -> ActorDict) -> State -> State)
-> (ActorDict -> ActorDict) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Maybe Actor -> Maybe Actor) -> ActorId -> ActorDict -> ActorDict
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Actor -> Maybe Actor
f ActorId
aid
let g :: Maybe [ActorId] -> Maybe [ActorId]
g Nothing = String -> Maybe [ActorId]
forall a. HasCallStack => String -> a
error (String -> Maybe [ActorId]) -> String -> Maybe [ActorId]
forall a b. (a -> b) -> a -> b
$ "actor already removed" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
g (Just l :: [ActorId]
l) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe [ActorId] -> Maybe [ActorId]
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
aid ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
l Bool -> (String, (ActorId, Actor, [ActorId])) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "actor already removed"
String
-> (ActorId, Actor, [ActorId])
-> (String, (ActorId, Actor, [ActorId]))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, [ActorId]
l))
#endif
(let l2 :: [ActorId]
l2 = ActorId -> [ActorId] -> [ActorId]
forall a. Eq a => a -> [a] -> [a]
delete ActorId
aid [ActorId]
l
in if [ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
l2 then Maybe [ActorId]
forall a. Maybe a
Nothing else [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId]
l2)
let h :: Maybe ActorId -> Maybe ActorId
h Nothing = String -> Maybe ActorId
forall a. HasCallStack => String -> a
error (String -> Maybe ActorId) -> String -> Maybe ActorId
forall a b. (a -> b) -> a -> b
$ "actor already removed" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
body)
h (Just _aid2 :: ActorId
_aid2) =
#ifdef WITH_EXPENSIVE_ASSERTIONS
Bool -> Maybe ActorId -> Maybe ActorId
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
_aid2 Bool -> (String, (ActorId, Actor, ActorId)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "actor already removed"
String
-> (ActorId, Actor, ActorId) -> (String, (ActorId, Actor, ActorId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, ActorId
_aid2))
#endif
Maybe ActorId
forall a. Maybe a
Nothing
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel (Actor -> LevelId
blid Actor
body) ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ if Actor -> Bool
bproj Actor
body
then (ProjectileMap -> ProjectileMap) -> Level -> Level
updateProjMap ((Maybe [ActorId] -> Maybe [ActorId])
-> Point -> ProjectileMap -> ProjectileMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe [ActorId] -> Maybe [ActorId]
g (Actor -> Point
bpos Actor
body))
else (BigActorMap -> BigActorMap) -> Level -> Level
updateBigMap ((Maybe ActorId -> Maybe ActorId)
-> Point -> BigActorMap -> BigActorMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe ActorId -> Maybe ActorId
h (Actor -> Point
bpos Actor
body))
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills ((ActorMaxSkills -> ActorMaxSkills) -> State -> State)
-> (ActorMaxSkills -> ActorMaxSkills) -> State -> State
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorMaxSkills -> ActorMaxSkills
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid
updSpotItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()
updSpotItem :: ItemId -> ItemQuant -> Container -> m ()
updSpotItem iid :: ItemId
iid kit :: ItemQuant
kit@(k :: Int
k, _) c :: Container
c = do
Item
item <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
insertItemContainer ItemId
iid ItemQuant
kit Container
c
case Container
c of
CActor aid :: ActorId
aid store :: CStore
store -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan])
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
item Int
k ActorId
aid
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updLoseItem :: MonadStateWrite m => ItemId -> ItemQuant -> Container -> m ()
updLoseItem :: ItemId -> ItemQuant -> Container -> m ()
updLoseItem iid :: ItemId
iid kit :: ItemQuant
kit@(k :: Int
k, _) c :: Container
c = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Item
item <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
deleteItemContainer ItemId
iid ItemQuant
kit Container
c
case Container
c of
CActor aid :: ActorId
aid store :: CStore
store -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan])
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
item (-Int
k) ActorId
aid
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updSpotItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()
updSpotItemBag :: Container -> ItemBag -> m ()
updSpotItemBag c :: Container
c bag :: ItemBag
bag =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
bag) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemBag -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemBag -> Container -> m ()
insertBagContainer ItemBag
bag Container
c
case Container
c of
CActor aid :: ActorId
aid store :: CStore
store ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
let ais :: [(ItemId, Item)]
ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemDict
itemD ItemDict -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)) ([ItemId] -> [(ItemId, Item)]) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
[(ItemId, Item)] -> ((ItemId, Item) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ [(ItemId, Item)]
ais (((ItemId, Item) -> m ()) -> m ())
-> ((ItemId, Item) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(iid :: ItemId
iid, item :: Item
item) ->
ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
item (ItemQuant -> Int
forall a b. (a, b) -> a
fst (ItemQuant -> Int) -> ItemQuant -> Int
forall a b. (a -> b) -> a -> b
$ ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) ActorId
aid
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updLoseItemBag :: MonadStateWrite m => Container -> ItemBag -> m ()
updLoseItemBag :: Container -> ItemBag -> m ()
updLoseItemBag c :: Container
c bag :: ItemBag
bag = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ItemBag -> Int
forall k a. EnumMap k a -> Int
EM.size ItemBag
bag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemBag -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemBag -> Container -> m ()
deleteBagContainer ItemBag
bag Container
c
case Container
c of
CActor aid :: ActorId
aid store :: CStore
store ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
let ais :: [(ItemId, Item)]
ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemDict
itemD ItemDict -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)) ([ItemId] -> [(ItemId, Item)]) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
[(ItemId, Item)] -> ((ItemId, Item) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ [(ItemId, Item)]
ais (((ItemId, Item) -> m ()) -> m ())
-> ((ItemId, Item) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(iid :: ItemId
iid, item :: Item
item) ->
ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
item (- (ItemQuant -> Int
forall a b. (a, b) -> a
fst (ItemQuant -> Int) -> ItemQuant -> Int
forall a b. (a -> b) -> a -> b
$ ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)) ActorId
aid
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m ()
updMoveActor :: ActorId -> Point -> Point -> m ()
updMoveActor aid :: ActorId
aid fromP :: Point
fromP toP :: Point
toP = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Point
fromP Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
toP) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Point
fromP Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
body
Bool -> (String, (ActorId, Point, Point, Point, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected moved actor position"
String
-> (ActorId, Point, Point, Point, Actor)
-> (String, (ActorId, Point, Point, Point, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Point
fromP, Point
toP, Actor -> Point
bpos Actor
body, Actor
body)) ()
newBody :: Actor
newBody = Actor
body {bpos :: Point
bpos = Point
toP, boldpos :: Maybe Point
boldpos = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
fromP}
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> Actor -> Actor
forall a b. a -> b -> a
const Actor
newBody
ActorId -> Actor -> Actor -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> Actor -> m ()
moveActorMap ActorId
aid Actor
body Actor
newBody
updWaitActor :: MonadStateWrite m
=> ActorId -> Watchfulness -> Watchfulness -> m ()
updWaitActor :: ActorId -> Watchfulness -> Watchfulness -> m ()
updWaitActor aid :: ActorId
aid fromWS :: Watchfulness
fromWS toWS :: Watchfulness
toWS = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Watchfulness
fromWS Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
toWS) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Watchfulness
fromWS Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Watchfulness
bwatch Actor
body
Bool
-> (String, (ActorId, Watchfulness, Watchfulness, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected actor wait state"
String
-> (ActorId, Watchfulness, Watchfulness, Actor)
-> (String, (ActorId, Watchfulness, Watchfulness, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Watchfulness
fromWS, Actor -> Watchfulness
bwatch Actor
body, Actor
body)) ()
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b -> Actor
b {bwatch :: Watchfulness
bwatch = Watchfulness
toWS}
updDisplaceActor :: MonadStateWrite m => ActorId -> ActorId -> m ()
updDisplaceActor :: ActorId -> ActorId -> m ()
updDisplaceActor source :: ActorId
source target :: ActorId
target = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
sbody <- (State -> Actor) -> m Actor
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
Actor
tbody <- (State -> Actor) -> m Actor
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
target
let spos :: Point
spos = Actor -> Point
bpos Actor
sbody
tpos :: Point
tpos = Actor -> Point
bpos Actor
tbody
snewBody :: Actor
snewBody = Actor
sbody {bpos :: Point
bpos = Point
tpos, boldpos :: Maybe Point
boldpos = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
spos}
tnewBody :: Actor
tnewBody = Actor
tbody {bpos :: Point
bpos = Point
spos, boldpos :: Maybe Point
boldpos = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
tpos}
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
source ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> Actor -> Actor
forall a b. a -> b -> a
const Actor
snewBody
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
target ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ Actor -> Actor -> Actor
forall a b. a -> b -> a
const Actor
tnewBody
ActorId -> Actor -> ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> Actor -> ActorId -> Actor -> m ()
swapActorMap ActorId
source Actor
sbody ActorId
target Actor
tbody
updMoveItem :: MonadStateWrite m
=> ItemId -> Int -> ActorId -> CStore -> CStore
-> m ()
updMoveItem :: ItemId -> Int -> ActorId -> CStore -> CStore -> m ()
updMoveItem iid :: ItemId
iid k :: Int
k aid :: ActorId
aid s1 :: CStore
s1 s2 :: CStore
s2 = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& CStore
s1 CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
s2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
b <- (State -> Actor) -> m Actor
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
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
s1
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemId, Int, ActorId, CStore, CStore) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, Int
k, ActorId
aid, CStore
s1, CStore
s2)
Just (_, it :: ItemTimers
it) -> do
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
deleteItemActor ItemId
iid (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it) ActorId
aid CStore
s1
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> ActorId -> CStore -> m ()
insertItemActor ItemId
iid (Int
k, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k ItemTimers
it) ActorId
aid CStore
s2
case CStore
s1 of
CEqp -> case CStore
s2 of
COrgan -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> do
Item
itemBase <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
itemBase (-Int
k) ActorId
aid
COrgan -> case CStore
s2 of
CEqp -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> do
Item
itemBase <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
itemBase (-Int
k) ActorId
aid
_ ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
s2 CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Item
itemBase <- (State -> Item) -> m Item
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Item) -> m Item) -> (State -> Item) -> m Item
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> Item
getItemBody ItemId
iid
ItemId -> Item -> Int -> ActorId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> Item -> Int -> ActorId -> m ()
addItemToActorMaxSkills ItemId
iid Item
itemBase Int
k ActorId
aid
updRefillHP :: MonadStateWrite m => ActorId -> Int64 -> m ()
updRefillHP :: ActorId -> Int64 -> m ()
updRefillHP aid :: ActorId
aid nRaw :: Int64
nRaw =
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
let newRawHP :: Int64
newRawHP = Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
nRaw
newHP :: Int64
newHP = if Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then Int64
newRawHP else Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max 0 Int64
newRawHP
n :: Int64
n = Int64
newHP Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bhp Actor
b
in Actor
b { bhp :: Int64
bhp = Int64
newHP
, bhpDelta :: ResDelta
bhpDelta = let oldD :: ResDelta
oldD = Actor -> ResDelta
bhpDelta Actor
b
in case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
n 0 of
EQ -> $WResDelta :: (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta { resCurrentTurn :: (Int64, Int64)
resCurrentTurn = (0, 0)
, resPreviousTurn :: (Int64, Int64)
resPreviousTurn = ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD }
LT -> ResDelta
oldD {resCurrentTurn :: (Int64, Int64)
resCurrentTurn =
( (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n
, (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) )}
GT -> ResDelta
oldD {resCurrentTurn :: (Int64, Int64)
resCurrentTurn =
( (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD)
, (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n )}
}
updRefillCalm :: MonadStateWrite m => ActorId -> Int64 -> m ()
updRefillCalm :: ActorId -> Int64 -> m ()
updRefillCalm aid :: ActorId
aid n :: Int64
n =
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b ->
Actor
b { bcalm :: Int64
bcalm = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max 0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n
, bcalmDelta :: ResDelta
bcalmDelta = let oldD :: ResDelta
oldD = Actor -> ResDelta
bcalmDelta Actor
b
in case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
n 0 of
EQ -> $WResDelta :: (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta { resCurrentTurn :: (Int64, Int64)
resCurrentTurn = (0, 0)
, resPreviousTurn :: (Int64, Int64)
resPreviousTurn = ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD }
LT -> ResDelta
oldD {resCurrentTurn :: (Int64, Int64)
resCurrentTurn =
( (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n
, (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) )}
GT -> ResDelta
oldD {resCurrentTurn :: (Int64, Int64)
resCurrentTurn =
( (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD)
, (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (ResDelta -> (Int64, Int64)
resCurrentTurn ResDelta
oldD) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
n )}
}
updTrajectory :: MonadStateWrite m
=> ActorId
-> Maybe ([Vector], Speed)
-> Maybe ([Vector], Speed)
-> m ()
updTrajectory :: ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> m ()
updTrajectory aid :: ActorId
aid fromT :: Maybe ([Vector], Speed)
fromT toT :: Maybe ([Vector], Speed)
toT = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe ([Vector], Speed)
fromT Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ([Vector], Speed)
toT) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe ([Vector], Speed)
fromT Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Maybe ([Vector], Speed)
btrajectory Actor
body
Bool
-> (String,
(ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed), Actor))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected actor trajectory"
String
-> (ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed),
Actor)
-> (String,
(ActorId, Maybe ([Vector], Speed), Maybe ([Vector], Speed), Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Maybe ([Vector], Speed)
fromT, Maybe ([Vector], Speed)
toT, Actor
body)) ()
ActorId -> (Actor -> Actor) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ActorId -> (Actor -> Actor) -> m ()
updateActor ActorId
aid ((Actor -> Actor) -> m ()) -> (Actor -> Actor) -> m ()
forall a b. (a -> b) -> a -> b
$ \b :: Actor
b -> Actor
b {btrajectory :: Maybe ([Vector], Speed)
btrajectory = Maybe ([Vector], Speed)
toT}
updQuitFaction :: MonadStateWrite m
=> FactionId -> Maybe Status -> Maybe Status
-> m ()
updQuitFaction :: FactionId -> Maybe Status -> Maybe Status -> m ()
updQuitFaction fid :: FactionId
fid fromSt :: Maybe Status
fromSt toSt :: Maybe Status
toSt = do
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe Status
fromSt Maybe Status -> Maybe Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Status
toSt Bool -> (FactionId, Maybe Status, Maybe Status) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (FactionId
fid, Maybe Status
fromSt, Maybe Status
toSt)) ()
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe Status
fromSt Maybe Status -> Maybe Status -> Bool
forall a. Eq a => a -> a -> Bool
== Faction -> Maybe Status
gquit Faction
fact
Bool
-> (String, (FactionId, Maybe Status, Maybe Status, Faction))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected actor quit status"
String
-> (FactionId, Maybe Status, Maybe Status, Faction)
-> (String, (FactionId, Maybe Status, Maybe Status, Faction))
forall v. String -> v -> (String, v)
`swith` (FactionId
fid, Maybe Status
fromSt, Maybe Status
toSt, Faction
fact)) ()
let adj :: Faction -> Faction
adj fa :: Faction
fa = Faction
fa {gquit :: Maybe Status
gquit = Maybe Status
toSt}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid Faction -> Faction
adj
updSpotStashFaction :: MonadStateWrite m
=> FactionId -> LevelId -> Point -> m ()
updSpotStashFaction :: FactionId -> LevelId -> Point -> m ()
updSpotStashFaction fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos = do
let adj :: Faction -> Faction
adj fa :: Faction
fa = Faction
fa {gstash :: Maybe (LevelId, Point)
gstash = (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Point
pos)}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid Faction -> Faction
adj
updLoseStashFaction :: MonadStateWrite m
=> FactionId -> LevelId -> Point -> m ()
updLoseStashFaction :: FactionId -> LevelId -> Point -> m ()
updLoseStashFaction fid :: FactionId
fid lid :: LevelId
lid pos :: Point
pos = do
let adj :: Faction -> Faction
adj fa :: Faction
fa = Bool -> Faction -> Faction
forall a. HasCallStack => Bool -> a -> a
assert (Faction -> Maybe (LevelId, Point)
gstash Faction
fa Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Point
pos)
Bool -> (String, (FactionId, LevelId, Point, Faction)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected lack of gstash"
String
-> (FactionId, LevelId, Point, Faction)
-> (String, (FactionId, LevelId, Point, Faction))
forall v. String -> v -> (String, v)
`swith` (FactionId
fid, LevelId
lid, Point
pos, Faction
fa))
(Faction -> Faction) -> Faction -> Faction
forall a b. (a -> b) -> a -> b
$ Faction
fa {gstash :: Maybe (LevelId, Point)
gstash = Maybe (LevelId, Point)
forall a. Maybe a
Nothing}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid Faction -> Faction
adj
updLeadFaction :: MonadStateWrite m
=> FactionId
-> Maybe ActorId
-> Maybe ActorId
-> m ()
updLeadFaction :: FactionId -> Maybe ActorId -> Maybe ActorId -> m ()
updLeadFaction fid :: FactionId
fid source :: Maybe ActorId
source target :: Maybe ActorId
target = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe ActorId
source Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull) ()
Maybe Actor
mtb <- (State -> Maybe Actor) -> m (Maybe Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Actor) -> m (Maybe Actor))
-> (State -> Maybe Actor) -> m (Maybe Actor)
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody State
s (ActorId -> Actor) -> Maybe ActorId -> Maybe Actor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
target
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> (Actor -> Bool) -> Maybe Actor -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> (Actor -> Bool) -> Actor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj) Maybe Actor
mtb
Bool
-> (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction)
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (FactionId
fid, Maybe ActorId
source, Maybe ActorId
target, Maybe Actor
mtb, Faction
fact)) ()
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Maybe ActorId
source Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Faction -> Maybe ActorId
gleader Faction
fact
Bool
-> (String,
(FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected actor leader"
String
-> (FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction)
-> (String,
(FactionId, Maybe ActorId, Maybe ActorId, Maybe Actor, Faction))
forall v. String -> v -> (String, v)
`swith` (FactionId
fid, Maybe ActorId
source, Maybe ActorId
target, Maybe Actor
mtb, Faction
fact)) ()
let adj :: Faction -> Faction
adj fa :: Faction
fa = Faction
fa {_gleader :: Maybe ActorId
_gleader = Maybe ActorId
target}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid Faction -> Faction
adj
updDiplFaction :: MonadStateWrite m
=> FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
updDiplFaction :: FactionId -> FactionId -> Diplomacy -> Diplomacy -> m ()
updDiplFaction fid1 :: FactionId
fid1 fid2 :: FactionId
fid2 fromDipl :: Diplomacy
fromDipl toDipl :: Diplomacy
toDipl =
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (FactionId
fid1 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
fid2 Bool -> Bool -> Bool
&& Diplomacy
fromDipl Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
/= Diplomacy
toDipl) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Faction
fact1 <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid1) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Faction
fact2 <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let !_A :: ()
_A =
Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Diplomacy
fromDipl Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
== Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Diplomacy
Unknown FactionId
fid2 (Faction -> EnumMap FactionId Diplomacy
gdipl Faction
fact1)
Bool -> Bool -> Bool
&& Diplomacy
fromDipl Diplomacy -> Diplomacy -> Bool
forall a. Eq a => a -> a -> Bool
== Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Diplomacy
Unknown FactionId
fid1 (Faction -> EnumMap FactionId Diplomacy
gdipl Faction
fact2)
Bool
-> (String,
(FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected actor diplomacy status"
String
-> (FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction)
-> (String,
(FactionId, FactionId, Diplomacy, Diplomacy, Faction, Faction))
forall v. String -> v -> (String, v)
`swith` (FactionId
fid1, FactionId
fid2, Diplomacy
fromDipl, Diplomacy
toDipl, Faction
fact1, Faction
fact2)) ()
let adj :: FactionId -> Faction -> Faction
adj fid :: FactionId
fid fact :: Faction
fact = Faction
fact {gdipl :: EnumMap FactionId Diplomacy
gdipl = FactionId
-> Diplomacy
-> EnumMap FactionId Diplomacy
-> EnumMap FactionId Diplomacy
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert FactionId
fid Diplomacy
toDipl (Faction -> EnumMap FactionId Diplomacy
gdipl Faction
fact)}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid1 (FactionId -> Faction -> Faction
adj FactionId
fid2)
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid2 (FactionId -> Faction -> Faction
adj FactionId
fid1)
updDoctrineFaction :: MonadStateWrite m
=> FactionId -> Ability.Doctrine -> Ability.Doctrine -> m ()
updDoctrineFaction :: FactionId -> Doctrine -> Doctrine -> m ()
updDoctrineFaction fid :: FactionId
fid toT :: Doctrine
toT fromT :: Doctrine
fromT = do
let adj :: Faction -> Faction
adj fact :: Faction
fact =
let player :: Player
player = Faction -> Player
gplayer Faction
fact
in Bool -> Faction -> Faction
forall a. HasCallStack => Bool -> a -> a
assert (Player -> Doctrine
fdoctrine Player
player Doctrine -> Doctrine -> Bool
forall a. Eq a => a -> a -> Bool
== Doctrine
fromT)
(Faction -> Faction) -> Faction -> Faction
forall a b. (a -> b) -> a -> b
$ Faction
fact {gplayer :: Player
gplayer = Player
player {fdoctrine :: Doctrine
fdoctrine = Doctrine
toT}}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid Faction -> Faction
adj
updAutoFaction :: MonadStateWrite m => FactionId -> Bool -> m ()
updAutoFaction :: FactionId -> Bool -> m ()
updAutoFaction fid :: FactionId
fid st :: Bool
st =
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction FactionId
fid (\fact :: Faction
fact ->
Bool -> Faction -> Faction
forall a. HasCallStack => Bool -> a -> a
assert (Faction -> Bool
isAIFact Faction
fact Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool
not Bool
st)
(Faction -> Faction) -> Faction -> Faction
forall a b. (a -> b) -> a -> b
$ Faction
fact {gplayer :: Player
gplayer = Bool -> Player -> Player
automatePlayer Bool
st (Faction -> Player
gplayer Faction
fact)})
updRecordKill :: MonadStateWrite m
=> ActorId -> ContentId ItemKind -> Int -> m ()
updRecordKill :: ActorId -> ContentId ItemKind -> Int -> m ()
updRecordKill aid :: ActorId
aid ikind :: ContentId ItemKind
ikind k :: Int
k = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let !_A :: Any -> Any
_A = Bool -> Any -> Any
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> (ActorId, Actor) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ActorId
aid, Actor
b))
let alterKind :: Maybe Int -> Maybe Int
alterKind mn :: Maybe Int
mn = let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int
mn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k
in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
adjFact :: Faction -> Faction
adjFact fact :: Faction
fact = Faction
fact {gvictims :: EnumMap (ContentId ItemKind) Int
gvictims = (Maybe Int -> Maybe Int)
-> ContentId ItemKind
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Int -> Maybe Int
alterKind ContentId ItemKind
ikind
(EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int)
-> EnumMap (ContentId ItemKind) Int
-> EnumMap (ContentId ItemKind) Int
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact}
FactionId -> (Faction -> Faction) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
FactionId -> (Faction -> Faction) -> m ()
updateFaction (Actor -> FactionId
bfid Actor
b) Faction -> Faction
adjFact
updAlterTile :: MonadStateWrite m
=> LevelId -> Point -> ContentId TileKind -> ContentId TileKind
-> m ()
updAlterTile :: LevelId
-> Point -> ContentId TileKind -> ContentId TileKind -> m ()
updAlterTile lid :: LevelId
lid p :: Point
p fromTile :: ContentId TileKind
fromTile toTile :: ContentId TileKind
toTile = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ContentId TileKind
fromTile ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentId TileKind
toTile) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
if ContentId TileKind
t ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentId TileKind
fromTile
then String -> m ()
forall a. String -> a
atomicFail "terrain to modify is different than assumed"
else do
let adj :: Array (ContentId TileKind) -> Array (ContentId TileKind)
adj ts :: Array (ContentId TileKind)
ts = Array (ContentId TileKind)
ts Array (ContentId TileKind)
-> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point
p, ContentId TileKind
toTile)]
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (Array (ContentId TileKind) -> Array (ContentId TileKind))
-> Level -> Level
updateTile Array (ContentId TileKind) -> Array (ContentId TileKind)
adj
case ( TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
fromTile
, TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
toTile ) of
(False, True) -> LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl2 :: Level
lvl2 -> Level
lvl2 {lseen :: Int
lseen = Level -> Int
lseen Level
lvl2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1}
(True, False) -> LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl2 :: Level
lvl2 -> Level
lvl2 {lseen :: Int
lseen = Level -> Int
lseen Level
lvl2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1}
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
updAlterExplorable :: MonadStateWrite m => LevelId -> Int -> m ()
updAlterExplorable :: LevelId -> Int -> m ()
updAlterExplorable lid :: LevelId
lid delta :: Int
delta = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
delta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl :: Level
lvl -> Level
lvl {lexpl :: Int
lexpl = Level -> Int
lexpl Level
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta}
updAlterGold :: MonadStateWrite m => Int -> m ()
updAlterGold :: Int -> m ()
updAlterGold delta :: Int
delta = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
delta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> State -> State
updateGold (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta)
updSearchTile :: MonadStateWrite m
=> ActorId -> Point -> ContentId TileKind -> m ()
updSearchTile :: ActorId -> Point -> ContentId TileKind -> m ()
updSearchTile aid :: ActorId
aid p :: Point
p toTile :: ContentId TileKind
toTile = do
COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Actor
b <- (State -> Actor) -> m Actor
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
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
if ContentId TileKind
t ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContentId TileKind
toTile
then String -> m ()
forall a. String -> a
atomicFail "tile already searched"
else Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ContentId TileKind -> Maybe (ContentId TileKind)
forall a. a -> Maybe a
Just ContentId TileKind
t Maybe (ContentId TileKind) -> Maybe (ContentId TileKind) -> Bool
forall a. Eq a => a -> a -> Bool
== ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
Tile.hideAs ContentData TileKind
cotile ContentId TileKind
toTile) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updLoseTile (Actor -> LevelId
blid Actor
b) [(Point
p, ContentId TileKind
t)]
LevelId -> [(Point, ContentId TileKind)] -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> [(Point, ContentId TileKind)] -> m ()
updSpotTile (Actor -> LevelId
blid Actor
b) [(Point
p, ContentId TileKind
toTile)]
updSpotTile :: MonadStateWrite m
=> LevelId -> [(Point, ContentId TileKind)] -> m ()
updSpotTile :: LevelId -> [(Point, ContentId TileKind)] -> m ()
updSpotTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, ContentId TileKind)] -> Bool
forall a. [a] -> Bool
null [(Point, ContentId TileKind)]
ts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let unk :: Array (ContentId TileKind) -> (Point, b) -> Bool
unk tileMap :: Array (ContentId TileKind)
tileMap (p :: Point
p, _) = Array (ContentId TileKind)
tileMap Array (ContentId TileKind) -> Point -> ContentId TileKind
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
p ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContentId TileKind
unknownId
adj :: Array (ContentId TileKind) -> Array (ContentId TileKind)
adj tileMap :: Array (ContentId TileKind)
tileMap = Bool -> Array (ContentId TileKind) -> Array (ContentId TileKind)
forall a. HasCallStack => Bool -> a -> a
assert (((Point, ContentId TileKind) -> Bool)
-> [(Point, ContentId TileKind)] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (Array (ContentId TileKind) -> (Point, ContentId TileKind) -> Bool
forall b. Array (ContentId TileKind) -> (Point, b) -> Bool
unk Array (ContentId TileKind)
tileMap) [(Point, ContentId TileKind)]
ts)
(Array (ContentId TileKind) -> Array (ContentId TileKind))
-> Array (ContentId TileKind) -> Array (ContentId TileKind)
forall a b. (a -> b) -> a -> b
$ Array (ContentId TileKind)
tileMap Array (ContentId TileKind)
-> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point, ContentId TileKind)]
ts
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (Array (ContentId TileKind) -> Array (ContentId TileKind))
-> Level -> Level
updateTile Array (ContentId TileKind) -> Array (ContentId TileKind)
adj
let f :: (Point, ContentId TileKind) -> m ()
f (_, t1 :: ContentId TileKind
t1) = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
t1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl :: Level
lvl -> Level
lvl {lseen :: Int
lseen = Level -> Int
lseen Level
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1}
((Point, ContentId TileKind) -> m ())
-> [(Point, ContentId TileKind)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Point, ContentId TileKind) -> m ()
f [(Point, ContentId TileKind)]
ts
updLoseTile :: MonadStateWrite m
=> LevelId -> [(Point, ContentId TileKind)] -> m ()
updLoseTile :: LevelId -> [(Point, ContentId TileKind)] -> m ()
updLoseTile lid :: LevelId
lid ts :: [(Point, ContentId TileKind)]
ts = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, ContentId TileKind)] -> Bool
forall a. [a] -> Bool
null [(Point, ContentId TileKind)]
ts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let matches :: Array a -> (Point, a) -> Bool
matches tileMap :: Array a
tileMap (p :: Point
p, ov :: a
ov) = Array a
tileMap Array a -> Point -> a
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ov
tu :: [(Point, ContentId TileKind)]
tu = ((Point, ContentId TileKind) -> (Point, ContentId TileKind))
-> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
forall a b. (a -> b) -> [a] -> [b]
map ((ContentId TileKind -> ContentId TileKind)
-> (Point, ContentId TileKind) -> (Point, ContentId TileKind)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (ContentId TileKind -> ContentId TileKind -> ContentId TileKind
forall a b. a -> b -> a
const ContentId TileKind
unknownId)) [(Point, ContentId TileKind)]
ts
adj :: Array (ContentId TileKind) -> Array (ContentId TileKind)
adj tileMap :: Array (ContentId TileKind)
tileMap = Bool -> Array (ContentId TileKind) -> Array (ContentId TileKind)
forall a. HasCallStack => Bool -> a -> a
assert (((Point, ContentId TileKind) -> Bool)
-> [(Point, ContentId TileKind)] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (Array (ContentId TileKind) -> (Point, ContentId TileKind) -> Bool
forall a. UnboxRepClass a => Array a -> (Point, a) -> Bool
matches Array (ContentId TileKind)
tileMap) [(Point, ContentId TileKind)]
ts)
(Array (ContentId TileKind) -> Array (ContentId TileKind))
-> Array (ContentId TileKind) -> Array (ContentId TileKind)
forall a b. (a -> b) -> a -> b
$ Array (ContentId TileKind)
tileMap Array (ContentId TileKind)
-> [(Point, ContentId TileKind)] -> Array (ContentId TileKind)
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point, ContentId TileKind)]
tu
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (Array (ContentId TileKind) -> Array (ContentId TileKind))
-> Level -> Level
updateTile Array (ContentId TileKind) -> Array (ContentId TileKind)
adj
let f :: (Point, ContentId TileKind) -> m ()
f (_, t1 :: ContentId TileKind
t1) = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TileSpeedup -> ContentId TileKind -> Bool
Tile.isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
t1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl :: Level
lvl -> Level
lvl {lseen :: Int
lseen = Level -> Int
lseen Level
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1}
((Point, ContentId TileKind) -> m ())
-> [(Point, ContentId TileKind)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Point, ContentId TileKind) -> m ()
f [(Point, ContentId TileKind)]
ts
updSpotEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m ()
updSpotEntry :: LevelId -> [(Point, PlaceEntry)] -> m ()
updSpotEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, PlaceEntry)] -> Bool
forall a. [a] -> Bool
null [(Point, PlaceEntry)]
ts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let alt :: PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
alt en :: PlaceEntry
en Nothing = PlaceEntry -> Maybe PlaceEntry
forall a. a -> Maybe a
Just PlaceEntry
en
alt en :: PlaceEntry
en (Just oldEn :: PlaceEntry
oldEn) = String -> Maybe PlaceEntry
forall a. String -> a
atomicFail (String -> Maybe PlaceEntry) -> String -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ "entry already added"
String
-> (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry)
-> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, [(Point, PlaceEntry)]
ts, PlaceEntry
en, PlaceEntry
oldEn)
f :: (Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
f (p :: Point
p, en :: PlaceEntry
en) = (Maybe PlaceEntry -> Maybe PlaceEntry)
-> Point -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
alt PlaceEntry
en) Point
p
upd :: EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
upd m :: EnumMap Point PlaceEntry
m = ((Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
-> EnumMap Point PlaceEntry
-> [(Point, PlaceEntry)]
-> EnumMap Point PlaceEntry
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
f EnumMap Point PlaceEntry
m [(Point, PlaceEntry)]
ts
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
-> Level -> Level
updateEntry EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
upd
updLoseEntry :: MonadStateWrite m => LevelId -> [(Point, PK.PlaceEntry)] -> m ()
updLoseEntry :: LevelId -> [(Point, PlaceEntry)] -> m ()
updLoseEntry lid :: LevelId
lid ts :: [(Point, PlaceEntry)]
ts = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, PlaceEntry)] -> Bool
forall a. [a] -> Bool
null [(Point, PlaceEntry)]
ts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let alt :: PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
alt en :: PlaceEntry
en Nothing = String -> Maybe PlaceEntry
forall a. HasCallStack => String -> a
error (String -> Maybe PlaceEntry) -> String -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ "entry already removed"
String -> (LevelId, [(Point, PlaceEntry)], PlaceEntry) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, [(Point, PlaceEntry)]
ts, PlaceEntry
en)
alt en :: PlaceEntry
en (Just oldEn :: PlaceEntry
oldEn) =
Bool -> Maybe PlaceEntry -> Maybe PlaceEntry
forall a. HasCallStack => Bool -> a -> a
assert (PlaceEntry
en PlaceEntry -> PlaceEntry -> Bool
forall a. Eq a => a -> a -> Bool
== PlaceEntry
oldEn Bool
-> (String,
(LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected lost entry"
String
-> (LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry)
-> (String,
(LevelId, [(Point, PlaceEntry)], PlaceEntry, PlaceEntry))
forall v. String -> v -> (String, v)
`swith` (LevelId
lid, [(Point, PlaceEntry)]
ts, PlaceEntry
en, PlaceEntry
oldEn)) Maybe PlaceEntry
forall a. Maybe a
Nothing
f :: (Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
f (p :: Point
p, en :: PlaceEntry
en) = (Maybe PlaceEntry -> Maybe PlaceEntry)
-> Point -> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (PlaceEntry -> Maybe PlaceEntry -> Maybe PlaceEntry
alt PlaceEntry
en) Point
p
upd :: EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
upd m :: EnumMap Point PlaceEntry
m = ((Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
-> EnumMap Point PlaceEntry
-> [(Point, PlaceEntry)]
-> EnumMap Point PlaceEntry
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Point, PlaceEntry)
-> EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
f EnumMap Point PlaceEntry
m [(Point, PlaceEntry)]
ts
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry)
-> Level -> Level
updateEntry EnumMap Point PlaceEntry -> EnumMap Point PlaceEntry
upd
updAlterSmell :: MonadStateWrite m => LevelId -> Point -> Time -> Time -> m ()
updAlterSmell :: LevelId -> Point -> Time -> Time -> m ()
updAlterSmell lid :: LevelId
lid p :: Point
p fromSm' :: Time
fromSm' toSm' :: Time
toSm' = do
let fromSm :: Maybe Time
fromSm = if Time
fromSm' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero then Maybe Time
forall a. Maybe a
Nothing else Time -> Maybe Time
forall a. a -> Maybe a
Just Time
fromSm'
toSm :: Maybe Time
toSm = if Time
toSm' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
timeZero then Maybe Time
forall a. Maybe a
Nothing else Time -> Maybe Time
forall a. a -> Maybe a
Just Time
toSm'
alt :: Maybe Time -> Maybe Time
alt sm :: Maybe Time
sm = Bool -> Maybe Time -> Maybe Time
forall a. HasCallStack => Bool -> a -> a
assert (Maybe Time
sm Maybe Time -> Maybe Time -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Time
fromSm Bool
-> (String, (LevelId, Point, Maybe Time, Maybe Time, Maybe Time))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected tile smell"
String
-> (LevelId, Point, Maybe Time, Maybe Time, Maybe Time)
-> (String, (LevelId, Point, Maybe Time, Maybe Time, Maybe Time))
forall v. String -> v -> (String, v)
`swith` (LevelId
lid, Point
p, Maybe Time
fromSm, Maybe Time
toSm, Maybe Time
sm)) Maybe Time
toSm
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (SmellMap -> SmellMap) -> Level -> Level
updateSmell ((SmellMap -> SmellMap) -> Level -> Level)
-> (SmellMap -> SmellMap) -> Level -> Level
forall a b. (a -> b) -> a -> b
$ (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe Time -> Maybe Time
alt Point
p
updSpotSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()
updSpotSmell :: LevelId -> [(Point, Time)] -> m ()
updSpotSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
sms) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let alt :: Time -> Maybe Time -> Maybe Time
alt sm :: Time
sm Nothing = Time -> Maybe Time
forall a. a -> Maybe a
Just Time
sm
alt sm :: Time
sm (Just oldSm :: Time
oldSm) = String -> Maybe Time
forall a. HasCallStack => String -> a
error (String -> Maybe Time) -> String -> Maybe Time
forall a b. (a -> b) -> a -> b
$ "smell already added"
String -> (LevelId, [(Point, Time)], Time, Time) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, [(Point, Time)]
sms, Time
sm, Time
oldSm)
f :: (Point, Time) -> SmellMap -> SmellMap
f (p :: Point
p, sm :: Time
sm) = (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (Time -> Maybe Time -> Maybe Time
alt Time
sm) Point
p
upd :: SmellMap -> SmellMap
upd m :: SmellMap
m = ((Point, Time) -> SmellMap -> SmellMap)
-> SmellMap -> [(Point, Time)] -> SmellMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Point, Time) -> SmellMap -> SmellMap
f SmellMap
m [(Point, Time)]
sms
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (SmellMap -> SmellMap) -> Level -> Level
updateSmell SmellMap -> SmellMap
upd
updLoseSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m ()
updLoseSmell :: LevelId -> [(Point, Time)] -> m ()
updLoseSmell lid :: LevelId
lid sms :: [(Point, Time)]
sms = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Point, Time)] -> Bool
forall a. [a] -> Bool
null [(Point, Time)]
sms) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let alt :: Time -> Maybe Time -> Maybe Time
alt sm :: Time
sm Nothing = String -> Maybe Time
forall a. HasCallStack => String -> a
error (String -> Maybe Time) -> String -> Maybe Time
forall a b. (a -> b) -> a -> b
$ "smell already removed"
String -> (LevelId, [(Point, Time)], Time) -> String
forall v. Show v => String -> v -> String
`showFailure` (LevelId
lid, [(Point, Time)]
sms, Time
sm)
alt sm :: Time
sm (Just oldSm :: Time
oldSm) =
Bool -> Maybe Time -> Maybe Time
forall a. HasCallStack => Bool -> a -> a
assert (Time
sm Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
oldSm Bool -> (String, (LevelId, [(Point, Time)], Time, Time)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "unexpected lost smell"
String
-> (LevelId, [(Point, Time)], Time, Time)
-> (String, (LevelId, [(Point, Time)], Time, Time))
forall v. String -> v -> (String, v)
`swith` (LevelId
lid, [(Point, Time)]
sms, Time
sm, Time
oldSm)) Maybe Time
forall a. Maybe a
Nothing
f :: (Point, Time) -> SmellMap -> SmellMap
f (p :: Point
p, sm :: Time
sm) = (Maybe Time -> Maybe Time) -> Point -> SmellMap -> SmellMap
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter (Time -> Maybe Time -> Maybe Time
alt Time
sm) Point
p
upd :: SmellMap -> SmellMap
upd m :: SmellMap
m = ((Point, Time) -> SmellMap -> SmellMap)
-> SmellMap -> [(Point, Time)] -> SmellMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Point, Time) -> SmellMap -> SmellMap
f SmellMap
m [(Point, Time)]
sms
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ (SmellMap -> SmellMap) -> Level -> Level
updateSmell SmellMap -> SmellMap
upd
updTimeItem :: MonadStateWrite m
=> ItemId -> Container -> ItemTimers -> ItemTimers
-> m ()
updTimeItem :: ItemId -> Container -> ItemTimers -> ItemTimers -> m ()
updTimeItem iid :: ItemId
iid c :: Container
c fromIt :: ItemTimers
fromIt toIt :: ItemTimers
toIt = Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimers
fromIt ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemTimers
toIt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Just (k :: Int
k, it :: ItemTimers
it) -> do
let !_A1 :: ()
_A1 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimers
fromIt ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimers
it Bool
-> (Int, ItemTimers, ItemId, Container, ItemTimers, ItemTimers)
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Int
k, ItemTimers
it, ItemId
iid, Container
c, ItemTimers
fromIt, ItemTimers
toIt)) ()
!_A2 :: ()
_A2 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
toIt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k Bool -> (Int, ItemTimers, ItemId, Container, ItemTimers) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Int
k, ItemTimers
toIt, ItemId
iid, Container
c, ItemTimers
fromIt)) ()
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
deleteItemContainer ItemId
iid (Int
k, ItemTimers
fromIt) Container
c
ItemId -> ItemQuant -> Container -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> ItemQuant -> Container -> m ()
insertItemContainer ItemId
iid (Int
k, ItemTimers
toIt) Container
c
Nothing -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String
-> (ItemBag, ItemId, Container, ItemTimers, ItemTimers) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemBag
bag, ItemId
iid, Container
c, ItemTimers
fromIt, ItemTimers
toIt)
updAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m ()
updAgeGame :: EnumSet LevelId -> m ()
updAgeGame lids :: EnumSet LevelId
lids = do
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (Time -> Time) -> State -> State
updateTime ((Time -> Time) -> State -> State)
-> (Time -> Time) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Time -> Delta Time -> Time) -> Delta Time -> Time -> Time
forall a b c. (a -> b -> c) -> b -> a -> c
flip Time -> Delta Time -> Time
timeShift (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
(LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Delta Time -> LevelId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Delta Time -> LevelId -> m ()
ageLevel (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)) ([LevelId] -> m ()) -> [LevelId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
lids
updUnAgeGame :: MonadStateWrite m => ES.EnumSet LevelId -> m ()
updUnAgeGame :: EnumSet LevelId -> m ()
updUnAgeGame lids :: EnumSet LevelId
lids = do
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (Time -> Time) -> State -> State
updateTime ((Time -> Time) -> State -> State)
-> (Time -> Time) -> State -> State
forall a b. (a -> b) -> a -> b
$ (Time -> Delta Time -> Time) -> Delta Time -> Time -> Time
forall a b c. (a -> b -> c) -> b -> a -> c
flip Time -> Delta Time -> Time
timeShift (Delta Time -> Delta Time
timeDeltaReverse (Delta Time -> Delta Time) -> Delta Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
(LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (Delta Time -> LevelId -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
Delta Time -> LevelId -> m ()
ageLevel (Delta Time -> Delta Time
timeDeltaReverse (Delta Time -> Delta Time) -> Delta Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)) ([LevelId] -> m ()) -> [LevelId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
lids
ageLevel :: MonadStateWrite m => Delta Time -> LevelId -> m ()
ageLevel :: Delta Time -> LevelId -> m ()
ageLevel delta :: Delta Time
delta lid :: LevelId
lid =
LevelId -> (Level -> Level) -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
LevelId -> (Level -> Level) -> m ()
updateLevel LevelId
lid ((Level -> Level) -> m ()) -> (Level -> Level) -> m ()
forall a b. (a -> b) -> a -> b
$ \lvl :: Level
lvl -> Level
lvl {ltime :: Time
ltime = Time -> Delta Time -> Time
timeShift (Level -> Time
ltime Level
lvl) Delta Time
delta}
updDiscover :: MonadStateWrite m
=> Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord
-> m ()
updDiscover :: Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
updDiscover _c :: Container
_c iid :: ItemId
iid ik :: ContentId ItemKind
ik arItem :: AspectRecord
arItem = do
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
COps{ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let kmIsConst :: Bool
kmIsConst = KindMean -> Bool
IA.kmConst (KindMean -> Bool) -> KindMean -> Bool
forall a b. (a -> b) -> a -> b
$ ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
ik ItemSpeedup
coItemSpeedup
DiscoveryKind
discoKind <- (State -> DiscoveryKind) -> m DiscoveryKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryKind
sdiscoKind
let discoverAtMostAspect :: m ()
discoverAtMostAspect = do
DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
if Bool
kmIsConst Bool -> Bool -> Bool
|| ItemId
iid ItemId -> DiscoveryAspect -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` DiscoveryAspect
discoAspect
then String -> m ()
forall a. String -> a
atomicFail "item already fully discovered"
else ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> AspectRecord -> m ()
discoverAspect ItemId
iid AspectRecord
arItem
case ItemId -> ItemDict -> Maybe Item
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemDict
itemD of
Nothing -> String -> m ()
forall a. String -> a
atomicFail "discovered item unheard of"
Just item :: Item
item -> case Item -> ItemIdentity
jkind Item
item of
IdentityObvious _ -> m ()
discoverAtMostAspect
IdentityCovered ix :: ItemKindIx
ix _ik :: ContentId ItemKind
_ik -> case ItemKindIx -> DiscoveryKind -> Maybe (ContentId ItemKind)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemKindIx
ix DiscoveryKind
discoKind of
Just{} -> m ()
discoverAtMostAspect
Nothing -> do
ItemKindIx -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemKindIx -> ContentId ItemKind -> m ()
discoverKind ItemKindIx
ix ContentId ItemKind
ik
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
kmIsConst (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> AspectRecord -> m ()
discoverAspect ItemId
iid AspectRecord
arItem
m ()
forall (m :: * -> *). MonadStateWrite m => m ()
resetActorMaxSkills
updCover :: Container -> ItemId -> ContentId ItemKind -> IA.AspectRecord -> m ()
updCover :: Container -> ItemId -> ContentId ItemKind -> AspectRecord -> m ()
updCover _c :: Container
_c _iid :: ItemId
_iid _ik :: ContentId ItemKind
_ik _arItem :: AspectRecord
_arItem = m ()
forall a. HasCallStack => a
undefined
updDiscoverKind :: MonadStateWrite m
=> Container -> ItemKindIx -> ContentId ItemKind -> m ()
updDiscoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m ()
updDiscoverKind _c :: Container
_c ix :: ItemKindIx
ix kmKind :: ContentId ItemKind
kmKind = do
DiscoveryKind
discoKind <- (State -> DiscoveryKind) -> m DiscoveryKind
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryKind
sdiscoKind
if ItemKindIx
ix ItemKindIx -> DiscoveryKind -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` DiscoveryKind
discoKind
then String -> m ()
forall a. String -> a
atomicFail "item kind already discovered"
else do
ItemKindIx -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemKindIx -> ContentId ItemKind -> m ()
discoverKind ItemKindIx
ix ContentId ItemKind
kmKind
m ()
forall (m :: * -> *). MonadStateWrite m => m ()
resetActorMaxSkills
discoverKind :: MonadStateWrite m => ItemKindIx -> ContentId ItemKind -> m ()
discoverKind :: ItemKindIx -> ContentId ItemKind -> m ()
discoverKind ix :: ItemKindIx
ix kindId :: ContentId ItemKind
kindId = do
let f :: Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind)
f Nothing = ContentId ItemKind -> Maybe (ContentId ItemKind)
forall a. a -> Maybe a
Just ContentId ItemKind
kindId
f Just{} = String -> Maybe (ContentId ItemKind)
forall a. HasCallStack => String -> a
error (String -> Maybe (ContentId ItemKind))
-> String -> Maybe (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ "already discovered" String -> (ItemKindIx, ContentId ItemKind) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemKindIx
ix, ContentId ItemKind
kindId)
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (DiscoveryKind -> DiscoveryKind) -> State -> State
updateDiscoKind ((DiscoveryKind -> DiscoveryKind) -> State -> State)
-> (DiscoveryKind -> DiscoveryKind) -> State -> State
forall a b. (a -> b) -> a -> b
$ \discoKind1 :: DiscoveryKind
discoKind1 ->
(Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind))
-> ItemKindIx -> DiscoveryKind -> DiscoveryKind
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe (ContentId ItemKind) -> Maybe (ContentId ItemKind)
f ItemKindIx
ix DiscoveryKind
discoKind1
updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m ()
updCoverKind :: Container -> ItemKindIx -> ContentId ItemKind -> m ()
updCoverKind _c :: Container
_c _ix :: ItemKindIx
_ix _ik :: ContentId ItemKind
_ik = m ()
forall a. HasCallStack => a
undefined
updDiscoverAspect :: MonadStateWrite m
=> Container -> ItemId -> IA.AspectRecord -> m ()
updDiscoverAspect :: Container -> ItemId -> AspectRecord -> m ()
updDiscoverAspect _c :: Container
_c iid :: ItemId
iid arItem :: AspectRecord
arItem = do
COps{ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
case ItemId -> ItemDict -> Maybe Item
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemDict
itemD of
Nothing -> String -> m ()
forall a. String -> a
atomicFail "discovered item unheard of"
Just item :: Item
item -> do
ContentId ItemKind
kindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ Item -> State -> ContentId ItemKind
getItemKindIdServer Item
item
DiscoveryAspect
discoAspect <- (State -> DiscoveryAspect) -> m DiscoveryAspect
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> DiscoveryAspect
sdiscoAspect
let kmIsConst :: Bool
kmIsConst = KindMean -> Bool
IA.kmConst (KindMean -> Bool) -> KindMean -> Bool
forall a b. (a -> b) -> a -> b
$ ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
kindId ItemSpeedup
coItemSpeedup
if Bool
kmIsConst Bool -> Bool -> Bool
|| ItemId
iid ItemId -> DiscoveryAspect -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` DiscoveryAspect
discoAspect
then String -> m ()
forall a. String -> a
atomicFail "item arItem already discovered"
else do
ItemId -> AspectRecord -> m ()
forall (m :: * -> *).
MonadStateWrite m =>
ItemId -> AspectRecord -> m ()
discoverAspect ItemId
iid AspectRecord
arItem
m ()
forall (m :: * -> *). MonadStateWrite m => m ()
resetActorMaxSkills
discoverAspect :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
discoverAspect :: ItemId -> AspectRecord -> m ()
discoverAspect iid :: ItemId
iid arItem :: AspectRecord
arItem = do
let f :: Maybe AspectRecord -> Maybe AspectRecord
f Nothing = AspectRecord -> Maybe AspectRecord
forall a. a -> Maybe a
Just AspectRecord
arItem
f Just{} = String -> Maybe AspectRecord
forall a. HasCallStack => String -> a
error (String -> Maybe AspectRecord) -> String -> Maybe AspectRecord
forall a b. (a -> b) -> a -> b
$ "already discovered" String -> (ItemId, AspectRecord) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, AspectRecord
arItem)
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
-> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
forall a b. (a -> b) -> a -> b
$ \discoAspect1 :: DiscoveryAspect
discoAspect1 ->
(Maybe AspectRecord -> Maybe AspectRecord)
-> ItemId -> DiscoveryAspect -> DiscoveryAspect
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe AspectRecord -> Maybe AspectRecord
f ItemId
iid DiscoveryAspect
discoAspect1
updCoverAspect :: Container -> ItemId -> IA.AspectRecord -> m ()
updCoverAspect :: Container -> ItemId -> AspectRecord -> m ()
updCoverAspect _c :: Container
_c _iid :: ItemId
_iid _arItem :: AspectRecord
_arItem = m ()
forall a. HasCallStack => a
undefined
updDiscoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
updDiscoverServer :: ItemId -> AspectRecord -> m ()
updDiscoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem =
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
-> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
forall a b. (a -> b) -> a -> b
$ \discoAspect1 :: DiscoveryAspect
discoAspect1 ->
ItemId -> AspectRecord -> DiscoveryAspect -> DiscoveryAspect
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ItemId
iid AspectRecord
arItem DiscoveryAspect
discoAspect1
updCoverServer :: MonadStateWrite m => ItemId -> IA.AspectRecord -> m ()
updCoverServer :: ItemId -> AspectRecord -> m ()
updCoverServer iid :: ItemId
iid arItem :: AspectRecord
arItem =
(State -> State) -> m ()
forall (m :: * -> *). MonadStateWrite m => (State -> State) -> m ()
modifyState ((State -> State) -> m ()) -> (State -> State) -> m ()
forall a b. (a -> b) -> a -> b
$ (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect ((DiscoveryAspect -> DiscoveryAspect) -> State -> State)
-> (DiscoveryAspect -> DiscoveryAspect) -> State -> State
forall a b. (a -> b) -> a -> b
$ \discoAspect1 :: DiscoveryAspect
discoAspect1 ->
Bool -> DiscoveryAspect -> DiscoveryAspect
forall a. HasCallStack => Bool -> a -> a
assert (DiscoveryAspect
discoAspect1 DiscoveryAspect -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid AspectRecord -> AspectRecord -> Bool
forall a. Eq a => a -> a -> Bool
== AspectRecord
arItem)
(DiscoveryAspect -> DiscoveryAspect)
-> DiscoveryAspect -> DiscoveryAspect
forall a b. (a -> b) -> a -> b
$ ItemId -> DiscoveryAspect -> DiscoveryAspect
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ItemId
iid DiscoveryAspect
discoAspect1
updRestart :: MonadStateWrite m => State -> m ()
updRestart :: State -> m ()
updRestart = State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
putState
updRestartServer :: MonadStateWrite m => State -> m ()
updRestartServer :: State -> m ()
updRestartServer = State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
putState
updResumeServer :: MonadStateWrite m => State -> m ()
updResumeServer :: State -> m ()
updResumeServer = State -> m ()
forall (m :: * -> *). MonadStateWrite m => State -> m ()
putState