LambdaHack 0.6.1.0 → 0.6.2.0

raw patch · 116 files changed

+1620/−1452 lines, 116 filesdep ~assert-failuredep ~basedep ~vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: assert-failure, base, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• Game/LambdaHack/Atomic/CmdAtomic.hs +71/−70
• Game/LambdaHack/Atomic/HandleAtomicWrite.hs +25/−25
• Game/LambdaHack/Atomic/MonadStateWrite.hs +14/−14
• Game/LambdaHack/Atomic/PosAtomicRead.hs +11/−10
• Game/LambdaHack/Client.hs +5/−1
• Game/LambdaHack/Client/AI.hs +3/−3
• Game/LambdaHack/Client/AI/ConditionM.hs +1/−1
• Game/LambdaHack/Client/AI/HandleAbilityM.hs +13/−13
• Game/LambdaHack/Client/AI/PickActorM.hs +5/−5
• Game/LambdaHack/Client/AI/PickTargetM.hs +10/−8
• Game/LambdaHack/Client/Bfs.hs +3/−3
• Game/LambdaHack/Client/BfsM.hs +1/−1
• Game/LambdaHack/Client/CommonM.hs +5/−5
• Game/LambdaHack/Client/HandleAtomicM.hs +29/−22
• Game/LambdaHack/Client/LoopM.hs +3/−5
• Game/LambdaHack/Client/Preferences.hs +28/−23
• Game/LambdaHack/Client/State.hs +27/−27
• Game/LambdaHack/Client/UI.hs +2/−1
• Game/LambdaHack/Client/UI/ActorUI.hs +6/−6
• Game/LambdaHack/Client/UI/Config.hs +22/−22
• Game/LambdaHack/Client/UI/DisplayAtomicM.hs +30/−29
• Game/LambdaHack/Client/UI/DrawM.hs +15/−9
• Game/LambdaHack/Client/UI/EffectDescription.hs +4/−4
• Game/LambdaHack/Client/UI/Frontend.hs +7/−7
• Game/LambdaHack/Client/UI/Frontend/Common.hs +6/−6
• Game/LambdaHack/Client/UI/Frontend/Curses.hs +5/−4
• Game/LambdaHack/Client/UI/Frontend/Dom.hs +11/−5
• Game/LambdaHack/Client/UI/Frontend/Gtk.hs +4/−4
• Game/LambdaHack/Client/UI/Frontend/Sdl.hs +11/−9
• Game/LambdaHack/Client/UI/Frontend/Vty.hs +1/−0
• Game/LambdaHack/Client/UI/HandleHelperM.hs +29/−24
• Game/LambdaHack/Client/UI/HandleHumanGlobalM.hs +39/−30
• Game/LambdaHack/Client/UI/HandleHumanLocalM.hs +52/−34
• Game/LambdaHack/Client/UI/HumanCmd.hs +28/−28
• Game/LambdaHack/Client/UI/InventoryM.hs +23/−21
• Game/LambdaHack/Client/UI/ItemDescription.hs +15/−12
• Game/LambdaHack/Client/UI/ItemSlot.hs +3/−3
• Game/LambdaHack/Client/UI/Key.hs +7/−7
• Game/LambdaHack/Client/UI/KeyBindings.hs +13/−13
• Game/LambdaHack/Client/UI/MonadClientUI.hs +2/−2
• Game/LambdaHack/Client/UI/Msg.hs +4/−4
• Game/LambdaHack/Client/UI/Overlay.hs +15/−9
• Game/LambdaHack/Client/UI/RunM.hs +4/−4
• Game/LambdaHack/Client/UI/SessionUI.hs +46/−43
• Game/LambdaHack/Client/UI/Slideshow.hs +1/−1
• Game/LambdaHack/Client/UI/SlideshowM.hs +9/−6
• Game/LambdaHack/Common/Actor.hs +22/−22
• Game/LambdaHack/Common/ActorState.hs +6/−6
• Game/LambdaHack/Common/ClientOptions.hs +21/−21
• Game/LambdaHack/Common/Color.hs +6/−4
• Game/LambdaHack/Common/ContentDef.hs +6/−6
• Game/LambdaHack/Common/Dice.hs +7/−9
• Game/LambdaHack/Common/Faction.hs +25/−25
• Game/LambdaHack/Common/Flavour.hs +2/−2
• Game/LambdaHack/Common/Frequency.hs +5/−5
• Game/LambdaHack/Common/HighScore.hs +9/−9
• Game/LambdaHack/Common/Item.hs +40/−40
• Game/LambdaHack/Common/ItemStrongest.hs +6/−5
• Game/LambdaHack/Common/JSFile.hs +2/−2
• Game/LambdaHack/Common/Kind.hs +16/−15
• Game/LambdaHack/Common/KindOps.hs +15/−15
• Game/LambdaHack/Common/Level.hs +28/−28
• Game/LambdaHack/Common/Misc.hs +4/−12
• Game/LambdaHack/Common/MonadStateRead.hs +1/−1
• Game/LambdaHack/Common/Perception.hs +2/−2
• Game/LambdaHack/Common/Point.hs +5/−5
• Game/LambdaHack/Common/PointArray.hs +3/−7
• Game/LambdaHack/Common/Prelude.hs +1/−1
• Game/LambdaHack/Common/Random.hs +9/−9
• Game/LambdaHack/Common/Request.hs +10/−10
• Game/LambdaHack/Common/Response.hs +6/−6
• Game/LambdaHack/Common/RingBuffer.hs +4/−4
• Game/LambdaHack/Common/Save.hs +18/−8
• Game/LambdaHack/Common/State.hs +10/−10
• Game/LambdaHack/Common/Tile.hs +4/−4
• Game/LambdaHack/Common/Time.hs +12/−9
• Game/LambdaHack/Common/Vector.hs +7/−8
• Game/LambdaHack/Content/CaveKind.hs +34/−34
• Game/LambdaHack/Content/ItemKind.hs +69/−62
• Game/LambdaHack/Content/ModeKind.hs +21/−21
• Game/LambdaHack/Content/PlaceKind.hs +8/−8
• Game/LambdaHack/Content/RuleKind.hs +14/−14
• Game/LambdaHack/Content/TileKind.hs +31/−31
• Game/LambdaHack/SampleImplementation/SampleMonadClient.hs +12/−11
• Game/LambdaHack/SampleImplementation/SampleMonadServer.hs +12/−14
• Game/LambdaHack/Server/BroadcastAtomic.hs +1/−1
• Game/LambdaHack/Server/CommonM.hs +36/−15
• Game/LambdaHack/Server/DebugM.hs +8/−8
• Game/LambdaHack/Server/DungeonGen.hs +9/−8
• Game/LambdaHack/Server/DungeonGen/Area.hs +6/−6
• Game/LambdaHack/Server/DungeonGen/AreaRnd.hs +7/−7
• Game/LambdaHack/Server/DungeonGen/Cave.hs +13/−13
• Game/LambdaHack/Server/DungeonGen/Place.hs +20/−19
• Game/LambdaHack/Server/Fov.hs +9/−9
• Game/LambdaHack/Server/FovDigital.hs +3/−3
• Game/LambdaHack/Server/HandleAtomicM.hs +3/−3
• Game/LambdaHack/Server/HandleEffectM.hs +65/−58
• Game/LambdaHack/Server/HandleRequestM.hs +9/−8
• Game/LambdaHack/Server/ItemM.hs +1/−2
• Game/LambdaHack/Server/ItemRev.hs +5/−4
• Game/LambdaHack/Server/LoopM.hs +16/−16
• Game/LambdaHack/Server/PeriodicM.hs +16/−9
• Game/LambdaHack/Server/ProtocolM.hs +7/−9
• Game/LambdaHack/Server/StartM.hs +12/−14
• Game/LambdaHack/Server/State.hs +48/−48
• GameDefinition/Content/CaveKind.hs +17/−16
• GameDefinition/Content/ItemKind.hs +32/−28
• GameDefinition/Content/ItemKindActor.hs +9/−9
• GameDefinition/Content/ItemKindBlast.hs +17/−18
• GameDefinition/Content/ItemKindOrgan.hs +3/−4
• GameDefinition/Content/RuleKind.hs +1/−1
• GameDefinition/PLAYING.md +11/−3
• GameDefinition/TieKnot.hs +1/−1
• LambdaHack.cabal +27/−24
• test/test.hs +4/−0

@@ -1,3 +1,26 @@+## [v0.6.2.0, aka 'Zoom out'](https://github.com/LambdaHack/LambdaHack/compare/v0.6.1.0...v0.6.2.0)++- make fireworks slower and so easier to spot+- make rattlesnake deeper but more common+- announce no effect of activation+- describe original and current faction of an actor+- highlight dominated actors+- mark organs with comma instead of percent and gems with dollar+- make the healing cave dangerous to prevent camping+- slightly balance various content+- by default move item the same as last time+- often spawn between heroes and stairs going deeper+- fix totalUsefulness computation for negative effects+- fix abandoning distant enemy target despite no alternatives+- fix slow pushing of actors+- fix a crash when many actors run towards stairs+- hotfix: Pass zoom keys through to the browser+- help players find the info about changing the font size+- depend on GHC >= 8.0 and new vector+- specialize client code already in SampleMonadClient.hs+- enable StrictData in all modules+- replace 'failure' with 'error' that now shows call stack+ ## [v0.6.1.0, aka 'Breaking one rule at a time'](https://github.com/LambdaHack/LambdaHack/compare/v0.6.0.0...v0.6.1.0)  - fix redrawing after window minimized and restored

@@ -46,8 +46,8 @@ -- | Abstract syntax of atomic commands, that is, atomic game state -- transformations. data CmdAtomic =-    UpdAtomic !UpdAtomic  -- ^ atomic updates-  | SfxAtomic !SfxAtomic  -- ^ atomic special effects+    UpdAtomic UpdAtomic  -- ^ atomic updates+  | SfxAtomic SfxAtomic  -- ^ atomic special effects   deriving (Show, Eq, Generic)  instance Binary CmdAtomic@@ -58,58 +58,58 @@ -- that help clients determine whether and how to communicate them to players. data UpdAtomic =   -- Create/destroy actors and items.-    UpdCreateActor !ActorId !Actor ![(ItemId, Item)]-  | UpdDestroyActor !ActorId !Actor ![(ItemId, Item)]-  | UpdCreateItem !ItemId !Item !ItemQuant !Container-  | UpdDestroyItem !ItemId !Item !ItemQuant !Container-  | UpdSpotActor !ActorId !Actor ![(ItemId, Item)]-  | UpdLoseActor !ActorId !Actor ![(ItemId, Item)]-  | UpdSpotItem !Bool !ItemId !Item !ItemQuant !Container-  | UpdLoseItem !Bool !ItemId !Item !ItemQuant !Container+    UpdCreateActor ActorId Actor [(ItemId, Item)]+  | UpdDestroyActor ActorId Actor [(ItemId, Item)]+  | UpdCreateItem ItemId Item ItemQuant Container+  | UpdDestroyItem ItemId Item ItemQuant Container+  | UpdSpotActor ActorId Actor [(ItemId, Item)]+  | UpdLoseActor ActorId Actor [(ItemId, Item)]+  | UpdSpotItem Bool ItemId Item ItemQuant Container+  | UpdLoseItem Bool ItemId Item ItemQuant Container   -- Move actors and items.-  | UpdMoveActor !ActorId !Point !Point-  | UpdWaitActor !ActorId !Bool-  | UpdDisplaceActor !ActorId !ActorId-  | UpdMoveItem !ItemId !Int !ActorId !CStore !CStore+  | UpdMoveActor ActorId Point Point+  | UpdWaitActor ActorId Bool+  | UpdDisplaceActor ActorId ActorId+  | UpdMoveItem ItemId Int ActorId CStore CStore   -- Change actor attributes.-  | UpdRefillHP !ActorId !Int64-  | UpdRefillCalm !ActorId !Int64-  | UpdTrajectory !ActorId !(Maybe ([Vector], Speed)) !(Maybe ([Vector], Speed))+  | UpdRefillHP ActorId Int64+  | UpdRefillCalm ActorId Int64+  | UpdTrajectory ActorId (Maybe ([Vector], Speed)) (Maybe ([Vector], Speed))   -- Change faction attributes.-  | UpdQuitFaction !FactionId !(Maybe Status) !(Maybe Status)-  | UpdLeadFaction !FactionId !(Maybe ActorId) !(Maybe ActorId)-  | UpdDiplFaction !FactionId !FactionId !Diplomacy !Diplomacy-  | UpdTacticFaction !FactionId !Tactic !Tactic-  | UpdAutoFaction !FactionId !Bool-  | UpdRecordKill !ActorId !(Kind.Id ItemKind) !Int+  | UpdQuitFaction FactionId (Maybe Status) (Maybe Status)+  | UpdLeadFaction FactionId (Maybe ActorId) (Maybe ActorId)+  | UpdDiplFaction FactionId FactionId Diplomacy Diplomacy+  | UpdTacticFaction FactionId Tactic Tactic+  | UpdAutoFaction FactionId Bool+  | UpdRecordKill ActorId (Kind.Id ItemKind) Int   -- Alter map.-  | UpdAlterTile !LevelId !Point !(Kind.Id TileKind) !(Kind.Id TileKind)-  | UpdAlterExplorable !LevelId !Int-  | UpdSearchTile !ActorId !Point !(Kind.Id TileKind)-  | UpdHideTile !ActorId !Point !(Kind.Id TileKind)-  | UpdSpotTile !LevelId ![(Point, Kind.Id TileKind)]-  | UpdLoseTile !LevelId ![(Point, Kind.Id TileKind)]-  | UpdAlterSmell !LevelId !Point !Time !Time-  | UpdSpotSmell !LevelId ![(Point, Time)]-  | UpdLoseSmell !LevelId ![(Point, Time)]+  | UpdAlterTile LevelId Point (Kind.Id TileKind) (Kind.Id TileKind)+  | UpdAlterExplorable LevelId Int+  | UpdSearchTile ActorId Point (Kind.Id TileKind)+  | UpdHideTile ActorId Point (Kind.Id TileKind)+  | UpdSpotTile LevelId [(Point, Kind.Id TileKind)]+  | UpdLoseTile LevelId [(Point, Kind.Id TileKind)]+  | UpdAlterSmell LevelId Point Time Time+  | UpdSpotSmell LevelId [(Point, Time)]+  | UpdLoseSmell LevelId [(Point, Time)]   -- Assorted.-  | UpdTimeItem !ItemId !Container !ItemTimer !ItemTimer-  | UpdAgeGame ![LevelId]-  | UpdUnAgeGame ![LevelId]-  | UpdDiscover !Container !ItemId !(Kind.Id ItemKind) !ItemSeed-  | UpdCover !Container !ItemId !(Kind.Id ItemKind) !ItemSeed-  | UpdDiscoverKind !Container !ItemId !(Kind.Id ItemKind)-  | UpdCoverKind !Container !ItemId !(Kind.Id ItemKind)-  | UpdDiscoverSeed !Container !ItemId !ItemSeed-  | UpdCoverSeed !Container !ItemId !ItemSeed-  | UpdPerception !LevelId !Perception !Perception-  | UpdRestart !FactionId !DiscoveryKind !PerLid !State !Challenge !DebugModeCli-  | UpdRestartServer !State-  | UpdResume !FactionId !PerLid-  | UpdResumeServer !State-  | UpdKillExit !FactionId+  | UpdTimeItem ItemId Container ItemTimer ItemTimer+  | UpdAgeGame [LevelId]+  | UpdUnAgeGame [LevelId]+  | UpdDiscover Container ItemId (Kind.Id ItemKind) ItemSeed+  | UpdCover Container ItemId (Kind.Id ItemKind) ItemSeed+  | UpdDiscoverKind Container ItemId (Kind.Id ItemKind)+  | UpdCoverKind Container ItemId (Kind.Id ItemKind)+  | UpdDiscoverSeed Container ItemId ItemSeed+  | UpdCoverSeed Container ItemId ItemSeed+  | UpdPerception LevelId Perception Perception+  | UpdRestart FactionId DiscoveryKind PerLid State Challenge DebugModeCli+  | UpdRestartServer State+  | UpdResume FactionId PerLid+  | UpdResumeServer State+  | UpdKillExit FactionId   | UpdWriteSave-  | UpdMsgAll !Text+  | UpdMsgAll Text   deriving (Show, Eq, Generic)  instance Binary UpdAtomic@@ -117,41 +117,42 @@ -- | Abstract syntax of atomic special effects, that is, atomic commands -- that only display special effects and don't change the state. data SfxAtomic =-    SfxStrike !ActorId !ActorId !ItemId !CStore-  | SfxRecoil !ActorId !ActorId !ItemId !CStore-  | SfxSteal !ActorId !ActorId !ItemId !CStore-  | SfxRelease !ActorId !ActorId !ItemId !CStore-  | SfxProject !ActorId !ItemId !CStore-  | SfxReceive !ActorId !ItemId !CStore-  | SfxApply !ActorId !ItemId !CStore-  | SfxCheck !ActorId !ItemId !CStore-  | SfxTrigger !ActorId !Point-  | SfxShun !ActorId !Point-  | SfxEffect !FactionId !ActorId !IK.Effect !Int64-  | SfxMsgFid !FactionId !SfxMsg+    SfxStrike ActorId ActorId ItemId CStore+  | SfxRecoil ActorId ActorId ItemId CStore+  | SfxSteal ActorId ActorId ItemId CStore+  | SfxRelease ActorId ActorId ItemId CStore+  | SfxProject ActorId ItemId CStore+  | SfxReceive ActorId ItemId CStore+  | SfxApply ActorId ItemId CStore+  | SfxCheck ActorId ItemId CStore+  | SfxTrigger ActorId Point+  | SfxShun ActorId Point+  | SfxEffect FactionId ActorId IK.Effect Int64+  | SfxMsgFid FactionId SfxMsg   deriving (Show, Eq, Generic)  instance Binary SfxAtomic  data SfxMsg =-    SfxUnexpected !ReqFailure-  | SfxLoudUpd !Bool !UpdAtomic-  | SfxLoudStrike !Bool !(Kind.Id ItemKind) !Int-  | SfxLoudSummon !Bool !(GroupName ItemKind) !Dice.Dice+    SfxUnexpected ReqFailure+  | SfxLoudUpd Bool UpdAtomic+  | SfxLoudStrike Bool (Kind.Id ItemKind) Int+  | SfxLoudSummon Bool (GroupName ItemKind) Dice.Dice   | SfxFizzles+  | SfxNothingHappens   | SfxVoidDetection-  | SfxSummonLackCalm !ActorId+  | SfxSummonLackCalm ActorId   | SfxLevelNoMore   | SfxLevelPushed-  | SfxBracedImmune !ActorId+  | SfxBracedImmune ActorId   | SfxEscapeImpossible   | SfxTransImpossible-  | SfxIdentifyNothing !CStore-  | SfxPurposeNothing !CStore-  | SfxPurposeTooFew !Int !Int+  | SfxIdentifyNothing CStore+  | SfxPurposeNothing CStore+  | SfxPurposeTooFew Int Int   | SfxPurposeUnique   | SfxColdFish-  | SfxTimerExtended !ActorId !ItemId !CStore+  | SfxTimerExtended ActorId ItemId CStore   deriving (Show, Eq, Generic)  instance Binary SfxMsg

@@ -105,15 +105,15 @@ updCreateActor aid body ais = do   -- Add actor to @sactorD@.   let f Nothing = Just body-      f (Just b) = assert `failure` "actor already added"-                          `twith` (aid, body, b)+      f (Just b) = error $ "actor already added"+                           `showFailure` (aid, body, b)   modifyState $ updateActorD $ EM.alter f aid   -- Add actor to @sprio@.   let g Nothing = Just [aid]       g (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS         assert (aid `notElem` l `blame` "actor already added"-                                `twith` (aid, body, l))+                                `swith` (aid, body, l)) #endif         (Just $ aid : l)   updateLevel (blid body) $ updateActorMap (EM.alter g (bpos body))@@ -124,7 +124,7 @@     let h item1 item2 =           assert (itemsMatch item1 item2                   `blame` "inconsistent created actor items"-                  `twith` (aid, body, iid, item1, item2))+                  `swith` (aid, body, iid, item1, item2))                  item2 -- keep the first found level     modifyState $ updateItemD $ EM.insertWith h iid item @@ -146,18 +146,18 @@   -- Assert that actor's items belong to @sitemD@. Do not remove those   -- that do not appear anywhere else, for simplicity and speed.   let !_A = assert (allB match ais `blame` "destroyed actor items not found"-                    `twith` (aid, body, ais, itemD)) ()+                    `swith` (aid, body, ais, itemD)) ()   -- Remove actor from @sactorD@.-  let f Nothing = assert `failure` "actor already removed" `twith` (aid, body)+  let f Nothing = error $ "actor already removed" `showFailure` (aid, body)       f (Just b) = assert (b == body `blame` "inconsistent destroyed actor body"-                                     `twith` (aid, body, b)) Nothing+                                     `swith` (aid, body, b)) Nothing   modifyState $ updateActorD $ EM.alter f aid   -- Remove actor from @lactor@.-  let g Nothing = assert `failure` "actor already removed" `twith` (aid, body)+  let g Nothing = error $ "actor already removed" `showFailure` (aid, body)       g (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS         assert (aid `elem` l `blame` "actor already removed"-                             `twith` (aid, body, l))+                             `swith` (aid, body, l)) #endif         (let l2 = delete aid l          in if null l2 then Nothing else Just l2)@@ -189,7 +189,7 @@                         Nothing -> False                         Just item0 -> itemsMatch item0 item)                     `blame` "item already removed"-                    `twith` (iid, item, itemD)) ()+                    `swith` (iid, item, itemD)) ()   deleteItemContainer iid kit c  updMoveActor :: MonadStateWrite m => ActorId -> Point -> Point -> m ()@@ -197,7 +197,7 @@   body <- getsState $ getActorBody aid   let !_A = assert (fromP == bpos body                     `blame` "unexpected moved actor position"-                    `twith` (aid, fromP, toP, bpos body, body)) ()+                    `swith` (aid, fromP, toP, bpos body, body)) ()       newBody = body {bpos = toP, boldpos = Just fromP}   updateActor aid $ const newBody   moveActorMap aid body newBody@@ -207,7 +207,7 @@   b <- getsState $ getActorBody aid   let !_A = assert (toWait /= bwait b                     `blame` "unexpected waited actor time"-                    `twith` (aid, toWait, bwait b, b)) ()+                    `swith` (aid, toWait, bwait b, b)) ()   updateActor aid $ \body -> body {bwait = toWait}  updDisplaceActor :: MonadStateWrite m => ActorId -> ActorId -> m ()@@ -230,7 +230,7 @@   b <- getsState $ getActorBody aid   bag <- getsState $ getBodyStoreBag b c1   case iid `EM.lookup` bag of-    Nothing -> assert `failure` (iid, k, aid, c1, c2)+    Nothing -> error $ "" `showFailure` (iid, k, aid, c1, c2)     Just (_, it) -> do       deleteItemActor iid (k, take k it) aid c1       insertItemActor iid (k, take k it) aid c2@@ -276,7 +276,7 @@   body <- getsState $ getActorBody aid   let !_A = assert (fromT == btrajectory body                     `blame` "unexpected actor trajectory"-                    `twith` (aid, fromT, toT, body)) ()+                    `swith` (aid, fromT, toT, body)) ()   updateActor aid $ \b -> b {btrajectory = toT}  updQuitFaction :: MonadStateWrite m@@ -286,7 +286,7 @@   fact <- getsState $ (EM.! fid) . sfactionD   let !_A = assert (fromSt == gquit fact                     `blame` "unexpected actor quit status"-                    `twith` (fid, fromSt, toSt, fact)) ()+                    `swith` (fid, fromSt, toSt, fact)) ()   let adj fa = fa {gquit = toSt}   updateFaction fid adj @@ -305,7 +305,7 @@                     `blame` (fid, source, target, mtb, fact)) ()   let !_A = assert (source == _gleader fact                     `blame` "unexpected actor leader"-                    `twith` (fid, source, target, mtb, fact)) ()+                    `swith` (fid, source, target, mtb, fact)) ()   let adj fa = fa {_gleader = target}   updateFaction fid adj @@ -318,7 +318,7 @@     let !_A = assert (fromDipl == EM.findWithDefault Unknown fid2 (gdipl fact1)                       && fromDipl == EM.findWithDefault Unknown fid1 (gdipl fact2)                       `blame` "unexpected actor diplomacy status"-                      `twith` (fid1, fid2, fromDipl, toDipl, fact1, fact2)) ()+                      `swith` (fid1, fid2, fromDipl, toDipl, fact1, fact2)) ()     let adj fid fact = fact {gdipl = EM.insert fid toDipl (gdipl fact)}     updateFaction fid1 (adj fid2)     updateFaction fid2 (adj fid1)@@ -375,7 +375,7 @@   let adj ts = assert (ts PointArray.! p == fromTile                        || ts PointArray.! p == Tile.hideAs cotile fromTile                        `blame` "unexpected altered tile kind"-                       `twith` (lid, p, fromTile, toTile, ts PointArray.! p))+                       `swith` (lid, p, fromTile, toTile, ts PointArray.! p))                $ ts PointArray.// [(p, toTile)]   updateLevel lid $ updateTile adj   case ( Tile.isExplorable coTileSpeedup fromTile@@ -431,25 +431,25 @@   let fromSm = if fromSm' == timeZero then Nothing else Just fromSm'       toSm = if toSm' == timeZero then Nothing else Just toSm'       alt sm = assert (sm == fromSm `blame` "unexpected tile smell"-                                    `twith` (lid, p, fromSm, toSm, sm)) toSm+                                    `swith` (lid, p, fromSm, toSm, sm)) toSm   updateLevel lid $ updateSmell $ EM.alter alt p  updSpotSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m () updSpotSmell lid sms = assert (not $ null sms) $ do   let alt sm Nothing = Just sm-      alt sm (Just oldSm) = assert `failure` "smell already added"-                                   `twith` (lid, sms, sm, oldSm)+      alt sm (Just oldSm) = error $ "smell already added"+                                    `showFailure` (lid, sms, sm, oldSm)       f (p, sm) = EM.alter (alt sm) p       upd m = foldr f m sms   updateLevel lid $ updateSmell upd  updLoseSmell :: MonadStateWrite m => LevelId -> [(Point, Time)] -> m () updLoseSmell lid sms = assert (not $ null sms) $ do-  let alt sm Nothing = assert `failure` "smell already removed"-                              `twith` (lid, sms, sm)+  let alt sm Nothing = error $ "smell already removed"+                               `showFailure` (lid, sms, sm)       alt sm (Just oldSm) =         assert (sm == oldSm `blame` "unexpected lost smell"-                            `twith` (lid, sms, sm, oldSm)) Nothing+                            `swith` (lid, sms, sm, oldSm)) Nothing       f (p, sm) = EM.alter (alt sm) p       upd m = foldr f m sms   updateLevel lid $ updateSmell upd@@ -464,7 +464,7 @@       let !_A = assert (fromIt == it `blame` (k, it, iid, c, fromIt, toIt)) ()       deleteItemContainer iid (k, fromIt) c       insertItemContainer iid (k, toIt) c-    Nothing -> assert `failure` (bag, iid, c, fromIt, toIt)+    Nothing -> error $ "" `showFailure` (bag, iid, c, fromIt, toIt)  -- | Age the game. updAgeGame :: MonadStateWrite m => [LevelId] -> m ()

@@ -43,12 +43,12 @@  moveActorMap :: MonadStateWrite m => ActorId -> Actor -> Actor -> m () moveActorMap aid body newBody = do-  let rmActor Nothing = assert `failure` "actor already removed"-                               `twith` (aid, body)+  let rmActor Nothing = error $ "actor already removed"+                                `showFailure` (aid, body)       rmActor (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS         assert (aid `elem` l `blame` "actor already removed"-                             `twith` (aid, body, l))+                             `swith` (aid, body, l)) #endif         (let l2 = delete aid l          in if null l2 then Nothing else Just l2)@@ -56,7 +56,7 @@       addActor (Just l) = #ifdef WITH_EXPENSIVE_ASSERTIONS         assert (aid `notElem` l `blame` "actor already added"-                                `twith` (aid, body, l))+                                `swith` (aid, body, l)) #endif         (Just $ aid : l)       updActor = EM.alter addActor (bpos newBody)@@ -82,13 +82,13 @@ -- perhaps it's applied automatically due to INLINABLE. updateActor :: MonadStateWrite m => ActorId -> (Actor -> Actor) -> m () updateActor aid f = do-  let alt Nothing = assert `failure` "no body to update" `twith` aid+  let alt Nothing = error $ "no body to update" `showFailure` aid       alt (Just b) = Just $ f b   modifyState $ updateActorD $ EM.alter alt aid  updateFaction :: MonadStateWrite m => FactionId -> (Faction -> Faction) -> m () updateFaction fid f = do-  let alt Nothing = assert `failure` "no faction to update" `twith` fid+  let alt Nothing = error $ "no faction to update" `showFailure` fid       alt (Just fact) = Just $ f fact   modifyState $ updateFactionD $ EM.alter alt fid @@ -168,7 +168,7 @@   CFloor lid pos -> deleteItemFloor iid kit lid pos   CEmbed lid pos -> deleteItemEmbed iid kit lid pos   CActor aid store -> deleteItemActor iid kit aid store-  CTrunk{} -> assert `failure` c+  CTrunk{} -> error $ "" `showFailure` c  deleteItemFloor :: MonadStateWrite m                 => ItemId -> ItemQuant -> LevelId -> Point -> m ()@@ -176,8 +176,8 @@   let rmFromFloor (Just bag) =         let nbag = rmFromBag kit iid bag         in if EM.null nbag then Nothing else Just nbag-      rmFromFloor Nothing = assert `failure` "item already removed"-                                   `twith` (iid, kit, lid, pos)+      rmFromFloor Nothing = error $ "item already removed"+                                    `showFailure` (iid, kit, lid, pos)   in updateLevel lid $ updateFloor $ EM.alter rmFromFloor pos  deleteItemEmbed :: MonadStateWrite m@@ -186,8 +186,8 @@   let rmFromFloor (Just bag) =         let nbag = rmFromBag kit iid bag         in if EM.null nbag then Nothing else Just nbag-      rmFromFloor Nothing = assert `failure` "item already removed"-                                   `twith` (iid, kit, lid, pos)+      rmFromFloor Nothing = error $ "item already removed"+                                    `showFailure` (iid, kit, lid, pos)   in updateLevel lid $ updateEmbed $ EM.alter rmFromFloor pos  deleteItemActor :: MonadStateWrite m@@ -229,11 +229,11 @@ -- so that @DestroyItem kit (CreateItem kit x) == x@. rmFromBag :: ItemQuant -> ItemId -> ItemBag -> ItemBag rmFromBag kit@(k, rmIt) iid bag =-  let rfb Nothing = assert `failure` "rm from empty slot" `twith` (k, iid, bag)+  let rfb Nothing = error $ "rm from empty slot" `showFailure` (k, iid, bag)       rfb (Just (n, it)) =         case compare n k of-          LT -> assert `failure` "rm more than there is"-                       `twith` (n, kit, iid, bag)+          LT -> error $ "rm more than there is"+                        `showFailure` (n, kit, iid, bag)           EQ -> assert (rmIt == it `blame` (rmIt, it, n, kit, iid, bag)) Nothing           GT -> assert (rmIt == take k it                         `blame` (rmIt, take k it, n, kit, iid, bag))

@@ -31,12 +31,12 @@ -- based on the position of the command, etc. Note that the server -- sees and smells all positions. data PosAtomic =-    PosSight !LevelId ![Point]  -- ^ whomever sees all the positions, notices-  | PosFidAndSight ![FactionId] !LevelId ![Point]+    PosSight LevelId [Point]    -- ^ whomever sees all the positions, notices+  | PosFidAndSight [FactionId] LevelId [Point]                                 -- ^ observers and the faction notice-  | PosSmell !LevelId ![Point]  -- ^ whomever smells all the positions, notices-  | PosFid !FactionId           -- ^ only the faction notices-  | PosFidAndSer !(Maybe LevelId) !FactionId  -- ^ faction and server notices+  | PosSmell LevelId [Point]    -- ^ whomever smells all the positions, notices+  | PosFid FactionId            -- ^ only the faction notices+  | PosFidAndSer (Maybe LevelId) FactionId  -- ^ faction and server notices   | PosSer                      -- ^ only the server notices   | PosAll                      -- ^ everybody notices   | PosNone                     -- ^ never broadcasted, but sent manually@@ -80,8 +80,9 @@               else PosFidAndSight [bfid b] (blid b) [fromP, toP]   UpdWaitActor aid _ -> singleAid aid   UpdDisplaceActor source target -> doubleAid source target-  UpdMoveItem _ _ _ _ CSha -> assert `failure` cmd  -- shared stash is private-  UpdMoveItem _ _ _ CSha _ ->  assert `failure` cmd+  UpdMoveItem _ _ _ _ CSha ->+    error $ "" `showFailure` cmd  -- shared stash is private+  UpdMoveItem _ _ _ CSha _ ->  error $ "" `showFailure` cmd   UpdMoveItem _ _ aid _ _ -> singleAid aid   UpdRefillHP aid _ -> singleAid aid   UpdRefillCalm aid _ -> singleAid aid@@ -234,14 +235,14 @@     PosFidAndSer _ fid2 -> fid == fid2     PosSer -> False     PosAll -> True-    PosNone -> assert `failure` "no position possible" `twith` fid+    PosNone -> error $ "no position possible" `showFailure` fid  -- Not needed ATM, but may be a coincidence. seenAtomicSer :: PosAtomic -> Bool seenAtomicSer posAtomic =   case posAtomic of     PosFid _ -> False-    PosNone -> assert `failure` "no position possible" `twith` posAtomic+    PosNone -> error $ "no position possible" `showFailure` posAtomic     _ -> True  -- | Generate the atomic updates that jointly perform a given item move.@@ -262,7 +263,7 @@ containerMoveItem verbose iid k c1 c2 = do   bag <- getsState $ getContainerBag c1   case iid `EM.lookup` bag of-    Nothing -> assert `failure` (iid, k, c1, c2)+    Nothing -> error $ "" `showFailure` (iid, k, c1, c2)     Just (_, it) -> do       item <- getsState $ getItemBody iid       return [ UpdLoseItem verbose iid item (k, take k it) c1

@@ -3,10 +3,14 @@ -- See -- <https://github.com/LambdaHack/LambdaHack/wiki/Client-server-architecture>. module Game.LambdaHack.Client-  ( -- * Re-exported from "Game.LambdaHack.Client.LoopClient"+  ( -- * Re-exported from "Game.LambdaHack.Client.LoopM"     loopCli+    -- * Re-exported from "Game.LambdaHack.Client.UI"+  , KeyKind, SessionUI, emptySessionUI+  , Config, applyConfigToDebug, configCmdline, mkConfig   ) where  import Prelude ()  import Game.LambdaHack.Client.LoopM+import Game.LambdaHack.Client.UI

@@ -83,15 +83,15 @@   body <- getsState $ getActorBody aid   let !_A = assert (bfid body == side                     `blame` "AI tries to move enemy actor"-                    `twith` (aid, bfid body, side)) ()+                    `swith` (aid, bfid body, side)) ()   let !_A = assert (isNothing (btrajectory body)                     `blame` "AI gets to manually move its projectiles"-                    `twith` (aid, bfid body, side)) ()+                    `swith` (aid, bfid body, side)) ()   stratAction <- actionStrategy aid retry   let bestAction = bestVariant stratAction       !_A = assert (not (nullFreq bestAction)  -- equiv to nullStrategy                     `blame` "no AI action for actor"-                    `twith` (stratAction, aid, body)) ()+                    `swith` (stratAction, aid, body)) ()   -- Run the AI: chose an action from those given by the AI strategy.   rndToAction $ frequency bestAction 

@@ -160,7 +160,7 @@   condShineWouldBetray <- condShineWouldBetrayM aid   condAimEnemyPresent <- condAimEnemyPresentM aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough b ar       condNotCalmEnough = not calmE       heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.

@@ -65,7 +65,7 @@ actionStrategy aid retry = do   body <- getsState $ getActorBody aid   scondInMelee <- getsClient scondInMelee-  let condInMelee = fromMaybe (assert `failure` condInMelee)+  let condInMelee = fromMaybe (error $ "" `showFailure` condInMelee)                               (scondInMelee EM.! blid body)   condAimEnemyPresent <- condAimEnemyPresentM aid   condAimEnemyRemembered <- condAimEnemyRememberedM aid@@ -87,7 +87,7 @@   condTgtNonmoving <- condTgtNonmovingM aid   explored <- getsClient sexplored   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       lidExplored = ES.member (blid body) explored       panicFleeL = fleeL ++ badVic       condHpTooLow = hpTooLow body ar@@ -307,7 +307,7 @@   -- and the server will ignore and warn (and content may avoid that,   -- e.g., making all rings identified)   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough b ar       isWeapon (_, _, _, itemFull) = isMelee $ itemBase itemFull       filterWeapon | onlyWeapon = filter isWeapon@@ -339,7 +339,7 @@ equipItems aid = do   body <- getsState $ getActorBody aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough body ar   eqpAssocs <- fullAssocsClient aid [CEqp]   invAssocs <- fullAssocsClient aid [CInv]@@ -402,7 +402,7 @@ yieldUnneeded aid = do   body <- getsState $ getActorBody aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough body ar   eqpAssocs <- fullAssocsClient aid [CEqp]   condShineWouldBetray <- condShineWouldBetrayM aid@@ -440,7 +440,7 @@ unEquipItems aid = do   body <- getsState $ getActorBody aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough body ar   eqpAssocs <- fullAssocsClient aid [CEqp]   invAssocs <- fullAssocsClient aid [CInv]@@ -534,7 +534,7 @@ meleeBlocker aid = do   b <- getsState $ getActorBody aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)   fact <- getsState $ (EM.! bfid b) . sfactionD   actorSk <- currentSkillsClient aid   mtgtMPath <- getsClient $ EM.lookup aid . stargetD@@ -553,7 +553,7 @@         Just aim -> getsState $ posToAssocs aim (blid b)       case lBlocker of         (aid2, body2) : _ -> do-          let ar2 = fromMaybe (assert `failure` aid2)+          let ar2 = fromMaybe (error $ "" `showFailure` aid2)                               (EM.lookup aid2 actorAspect)           -- No problem if there are many projectiles at the spot. We just           -- attack the first one.@@ -638,7 +638,7 @@           benList <- condProjectListM skill aid           localTime <- getsState $ getLocalTime (blid b)           let coeff CGround = 2  -- pickup turn saved-              coeff COrgan = assert `failure` benList+              coeff COrgan = error $ "" `showFailure` benList               coeff CEqp = 100000  -- must hinder currently               coeff CInv = 1               coeff CSha = 1@@ -678,7 +678,7 @@   condAimEnemyPresent <- condAimEnemyPresentM aid   localTime <- getsState $ getLocalTime (blid b)   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       calmE = calmEnough b ar       condNotCalmEnough = not calmE       heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.@@ -725,7 +725,7 @@            then firstAidItem            else not $ hpEnough b ar && firstAidItem       coeff CGround = 2  -- pickup turn saved-      coeff COrgan = assert `failure` benList+      coeff COrgan = error $ "" `showFailure` benList       coeff CEqp = 1       coeff CInv = 1       coeff CSha = 1@@ -972,10 +972,10 @@          return $ Just $ RequestAnyAbility $ ReqMove dir          -- The potential invisible actor is hit.        | alterSkill < Tile.alterMinWalk coTileSpeedup t ->-         assert `failure` "AI causes AlterUnwalked" `twith` (source, dir)+         error $ "AI causes AlterUnwalked" `showFailure` (source, dir)        | EM.member tpos $ lfloor lvl ->          -- Only possible if items allowed inside unwalkable tiles.-         assert `failure` "AI causes AlterBlockItem" `twith` (source, dir)+         error $ "AI causes AlterBlockItem" `showFailure` (source, dir)        | otherwise ->          -- Not walkable, but alter skill suffices, so search or alter the tile.          return $ Just $ RequestAnyAbility $ ReqAlter tpos

@@ -36,7 +36,7 @@ pickActorToMove maidToAvoid = do   actorAspect <- getsClient sactorAspect   mleader <- getsClient _sleader-  let oldAid = fromMaybe (assert `failure` maidToAvoid) mleader+  let oldAid = fromMaybe (error $ "" `showFailure` maidToAvoid) mleader   oldBody <- getsState $ getActorBody oldAid   let side = bfid oldBody       arena = blid oldBody@@ -59,7 +59,7 @@         -- melee-less trying to flee, first aid, etc.).         snd (autoDungeonLevel fact) && isNothing maidToAvoid       -> pickOld-    [] -> assert `failure` (oldAid, oldBody)+    [] -> error $ "" `showFailure` (oldAid, oldBody)     [_] -> pickOld  -- Keep the leader: he is alone on the level.     _ -> do       -- At this point we almost forget who the old leader was@@ -93,9 +93,9 @@           -- This should be kept in sync with @actionStrategy@.           actorVulnerable ((aid, body), _) = do             scondInMelee <- getsClient scondInMelee-            let condInMelee = fromMaybe (assert `failure` condInMelee)+            let condInMelee = fromMaybe (error $ "" `showFailure` condInMelee)                                         (scondInMelee EM.! blid body)-                ar = fromMaybe (assert `failure` aid)+                ar = fromMaybe (error $ "" `showFailure` aid)                                (EM.lookup aid actorAspect)             threatDistL <- meleeThreatDistList aid             (fleeL, _) <- fleeList aid@@ -270,7 +270,7 @@ useTactics oldAid = do   oldBody <- getsState $ getActorBody oldAid   scondInMelee <- getsClient scondInMelee-  let condInMelee = fromMaybe (assert `failure` condInMelee)+  let condInMelee = fromMaybe (error $ "" `showFailure` condInMelee)                               (scondInMelee EM.! blid oldBody)   mleader <- getsClient _sleader   let !_A = assert (mleader /= Just oldAid) ()

@@ -54,10 +54,10 @@   side <- getsClient sside   let !_A = assert (bfid body == side                     `blame` "AI tries to move an enemy actor"-                    `twith` (aid, body, side)) ()+                    `swith` (aid, body, side)) ()   let !_A = assert (isNothing (btrajectory body) && not (bproj body)                     `blame` "AI gets to manually move its projectiles"-                    `twith` (aid, body, side)) ()+                    `swith` (aid, body, side)) ()   stratTarget <- targetStrategy aid   if nullStrategy stratTarget then do     -- Melee in progress and the actor can't contribute@@ -94,11 +94,11 @@   -- set of abilities as the leader, anyway) and set his target accordingly.   actorAspect <- getsClient sactorAspect   let lalter = salter EM.! blid b-      condInMelee = fromMaybe (assert `failure` condInMelee)+      condInMelee = fromMaybe (error $ "" `showFailure` condInMelee)                               (scondInMelee EM.! blid b)       stdRuleset = Kind.stdRuleset corule       nearby = rnearby stdRuleset-      ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+      ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       actorMaxSk = aSkills ar       alterSkill = EM.findWithDefault 0 AbAlter actorMaxSk   lvl@Level{lxsize, lysize} <- getLevel $ blid b@@ -135,7 +135,7 @@                _ -> Nothing  -- veered off the path              AndPath{pathList=[],..}->                Nothing  -- path to the goal was partial; let's target again-             NoPath -> assert `failure` ()+             NoPath -> error $ "" `showFailure` tap     Nothing -> return Nothing  -- no target assigned yet   fact <- getsState $ (EM.! bfid b) . sfactionD   allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)@@ -169,7 +169,8 @@             -- + 2 from foe being 2 away from friend before he closed in             -- + 1 for as a margin for ambush, given than actors exploring             -- can't physically keep adjacent all the time-            n | condInMelee = if attacksFriends then 4 else 0+            n | aAggression ar >= 2 = rangedNearby  -- boss never waits+              | condInMelee = if attacksFriends then 4 else 0               | otherwise = meleeNearby             nonmoving = EM.findWithDefault 0 AbMove actorMaxSkE <= 0         return {-keep lazy-} $@@ -180,7 +181,7 @@       -- targeted, which is fine, since he is weakened by ranged, so should be       -- meleed ASAP, even if without friends.       targetableRanged body =-        not condInMelee+        (not condInMelee || aAggression ar >= 2)  -- boss fires at will         && chessDist (bpos body) (bpos b) < rangedNearby         && condCanProject       targetableEnemy (aidE, body) = do@@ -320,7 +321,8 @@       updateTgt tap@TgtAndPath{tapPath=AndPath{..},tapTgt} = case tapTgt of         TEnemy a permit -> do           body <- getsState $ getActorBody a-          if | (condInMelee || not focused)  -- prefers closer foes+          if | (condInMelee  -- fight close foes or nobody at all+                || not focused && not (null nearbyFoes))  -- prefers closer foes                && a `notElem` map fst nearbyFoes  -- old one not close enough                || blid body /= blid b  -- wrong level                || actorDying body  -- foe already dying

@@ -129,9 +129,9 @@   in bfs (succ minKnownBfs) [PointArray.pindex axsize source]  data AndPath =-    AndPath { pathList :: ![Point]-            , pathGoal :: !Point    -- needn't be @last pathList@-            , pathLen  :: !Int      -- needn't be @length pathList@+    AndPath { pathList :: [Point]+            , pathGoal :: Point    -- needn't be @last pathList@+            , pathLen  :: Int      -- needn't be @length pathList@             }   | NoPath   deriving (Show, Generic)

@@ -85,7 +85,7 @@   Kind.COps{coTileSpeedup} <- getsState scops   let (oldBfsArr, oldBfsPath) = case bfsAndPathOld of         BfsAndPath{bfsArr, bfsPath} -> (bfsArr, bfsPath)-        BfsInvalid -> assert `failure` (bfsAndPathOld, aid, target)+        BfsInvalid -> error $ "" `showFailure` (bfsAndPathOld, aid, target)   let bfsArr = oldBfsArr   if not canMove   then return (bfsArr, NoPath)

@@ -38,8 +38,8 @@ getPerFid :: MonadClient m => LevelId -> m Perception getPerFid lid = do   fper <- getsClient sfper-  let assFail = assert `failure` "no perception at given level"-                       `twith` (lid, fper)+  let assFail = error $ "no perception at given level"+                        `showFailure` (lid, fper)   return $! EM.findWithDefault assFail lid fper  -- | Calculate the position of an actor's target.@@ -88,7 +88,7 @@           in if | accessU -> - nUnknown                 | accessFirst -> -10000                 | otherwise -> minBound-        Nothing -> assert `failure` (body, fpos, epsOld)+        Nothing -> error $ "" `showFailure` (body, fpos, epsOld)       tryLines curEps (acc, _) | curEps == epsOld + dist = acc       tryLines curEps (acc, bestScore) =         let curScore = calcScore curEps@@ -106,12 +106,12 @@   actorAspect <- getsClient sactorAspect   case EM.lookup aid actorAspect of     Just aspectRecord -> return $ aSkills aspectRecord  -- keep it lazy-    Nothing -> assert `failure` aid+    Nothing -> error $ "" `showFailure` aid  currentSkillsClient :: MonadClient m => ActorId -> m Ability.Skills currentSkillsClient aid = do   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)   body <- getsState $ getActorBody aid   side <- getsClient sside   -- Newest Leader in _sleader, not yet in sfactionD.

@@ -86,7 +86,7 @@            , UpdAlterTile (blid b) p fromTile toTile  -- reveal tile            ]       else assert (t == toTile `blame` "LoseTile fails to reset memory"-                               `twith` (aid, p, fromTile, toTile, b, t, cmd))+                               `swith` (aid, p, fromTile, toTile, b, t, cmd))                   [cmd]  -- Already knows the tile fully, only confirm.   UpdHideTile{} -> return []  -- will be fleshed out when Undo completed   UpdSpotTile lid ts -> do@@ -275,7 +275,7 @@                         || mleader == target                           -- we changed the leader ourselves                         `blame` "unexpected leader"-                        `twith` (cmd, mleader)) ()+                        `swith` (cmd, mleader)) ()       modifyClient $ \cli -> cli {_sleader = target}   UpdAutoFaction{} ->     -- @condBFS@ depends on the setting we change here (e.g., smarkSuspect).@@ -379,9 +379,11 @@  createActor :: MonadClient m => ActorId -> Actor -> [(ItemId, Item)] -> m () createActor aid b ais = do-  let affect3 tap@TgtAndPath{..} = case tapTgt of-        TPoint (TEnemyPos a permit) _ _ | a == aid ->-          TgtAndPath (TEnemy a permit) NoPath+  side <- getsClient sside+  let newPermit = bfid b == side+      affect3 tap@TgtAndPath{..} = case tapTgt of+        TPoint (TEnemyPos a _) _ _ | a == aid ->+          TgtAndPath (TEnemy a newPermit) NoPath         _ -> tap   modifyClient $ \cli -> cli {stargetD = EM.map affect3 (stargetD cli)}   aspectRecord <- aspectRecordFromActorClient b ais@@ -457,7 +459,7 @@               || maybe False (not . ES.null) (interAlready outPer)   when unset $ do -}-    let adj Nothing = assert `failure` "no perception to alter" `twith` lid+    let adj Nothing = error $ "no perception to alter" `showFailure` lid         adj (Just per) = Just $ addPer (diffPer per outPer) inPer         f = EM.alter adj lid     modifyClient $ \cli -> cli {sfper = f (sfper cli)}@@ -475,8 +477,11 @@       kmMean = meanAspect kind       benefit = totalUsefulness cops fact (IK.ieffects kind) kmMean item       f Nothing = Just KindMean{..}-      f Just{} = assert `failure` "already discovered"-                        `twith` (c, iid, kmKind)+      f Just{} = error $ "already discovered"+                         `showFailure` (c, iid, kmKind)+  -- This adds to @sdiscoBenefit@ only @iid@ and not any other items+  -- that share the same @jkindIx@, so this is broken if such items+  -- are not fully IDed from the start.   modifyClient $ \cli ->     cli { sdiscoKind = EM.alter f (jkindIx item) (sdiscoKind cli)         , sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli) }@@ -491,10 +496,10 @@ coverKind :: MonadClient m => Container -> ItemId -> Kind.Id ItemKind -> m () coverKind c iid ik = do   item <- getsState $ getItemBody iid-  let f Nothing = assert `failure` "already covered" `twith` (c, iid, ik)+  let f Nothing = error $ "already covered" `showFailure` (c, iid, ik)       f (Just KindMean{kmKind}) =         assert (ik == kmKind `blame` "unexpected covered item kind"-                             `twith` (ik, kmKind)) Nothing+                             `swith` (ik, kmKind)) Nothing   -- For now, undoing @sdiscoBenefit@ is too much work.   modifyClient $ \cli ->     cli {sdiscoKind = EM.alter f (jkindIx item) (sdiscoKind cli)}@@ -514,16 +519,19 @@   item <- getsState $ getItemBody iid   totalDepth <- getsState stotalDepth   case EM.lookup (jkindIx item) discoKind of-    Nothing -> assert `failure` "kind not known"-                      `twith` (c, iid, seed)+    Nothing -> error $ "kind not known"+                       `showFailure` (c, iid, seed)     Just KindMean{kmKind} -> do       Level{ldepth} <- getLevel $ jlid item       let kind = okind kmKind           aspects = seedToAspect seed kind ldepth totalDepth           benefit = totalUsefulness cops fact (IK.ieffects kind) aspects item           f Nothing = Just aspects-          f Just{} = assert `failure` "already discovered"-                            `twith` (c, iid, seed)+          f Just{} = error $ "already discovered"+                             `showFailure` (c, iid, seed)+  -- This adds to @sdiscoBenefit@ only @iid@ and not any other items+  -- that share the same @jkindIx@, so this is broken if such items+  -- are not fully IDed from the start.       modifyClient $ \cli ->         cli { sdiscoAspect = EM.alter f iid (sdiscoAspect cli)             , sdiscoBenefit = EM.insert iid benefit (sdiscoBenefit cli) }@@ -533,7 +541,7 @@  coverSeed :: MonadClient m => Container -> ItemId -> ItemSeed -> m () coverSeed c iid seed = do-  let f Nothing = assert `failure` "already covered" `twith` (c, iid, seed)+  let f Nothing = error $ "already covered" `showFailure` (c, iid, seed)       f Just{} = Nothing  -- checking that old and new agree is too much work   -- For now, undoing @sdiscoBenefit@ is too much work.   modifyClient $ \cli -> cli {sdiscoAspect = EM.alter f iid (sdiscoAspect cli)}@@ -569,13 +577,12 @@       g bap1 bap2 = bfsArr bap1 == bfsArr bap2       subBfs = EM.isSubmapOfBy g   let !_A1 = assert (salter == alter-                     `blame` ("wrong accumulated salter on" <+> tshow side)-                     `twith` (salter, alter)) ()+                     `blame` "wrong accumulated salter on side"+                     `swith` (side, salter, alter)) ()       !_A2 = assert (sactorAspect == actorAspect-                     `blame` ("wrong accumulated sactorAspect on"-                              <+> tshow side)-                     `twith` (sactorAspect, actorAspect)) ()+                     `blame` "wrong accumulated sactorAspect on side"+                     `swith` (side, sactorAspect, actorAspect)) ()       !_A3 = assert (sbfsD `subBfs` bfsD-                     `blame` ("wrong accumulated sbfsD on" <+> tshow side)-                     `twith` (sbfsD, bfsD)) ()+                     `blame` "wrong accumulated sbfsD on side"+                     `swith` (side, sbfsD, bfsD)) ()   return ()

@@ -9,8 +9,6 @@  import Game.LambdaHack.Common.Prelude -import qualified Data.Text as T- import Game.LambdaHack.Atomic import Game.LambdaHack.Client.HandleResponseM import Game.LambdaHack.Client.MonadClient@@ -81,10 +79,10 @@     (True, RespUpdAtomic UpdRestart{}) ->       when hasUI $ msgAdd "Ignoring an old savefile and starting a new game."     (False, RespUpdAtomic UpdResume{}) ->-      assert `failure`-        T.unpack ("Savefile of client" <+> tshow side <+> "not usable.")+      error $ "Savefile of client " ++ show side ++ " not usable."+              `showFailure` ()     (False, RespUpdAtomic UpdRestart{}) -> return ()-    _ -> assert `failure` "unexpected command" `twith` (side, restored, cmd1)+    _ -> error $ "unexpected command" `showFailure` (side, restored, cmd1)   handleResponse cmd1   -- State and client state now valid.   debugPossiblyPrint $ "UI client" <+> tshow side <+> "started."

@@ -309,7 +309,8 @@         let scaleChargeBens bens               | timeout <= 3 = bens               | otherwise = map (\eff ->-                  min eff (eff * avgItemDelay `divUp` timeout)) bens+                  if avgItemDelay >= timeout then eff+                  else eff * avgItemDelay `divUp` timeout) bens             (cself, cfoe) = unzip $ map (effectToBenefit cops fact)                                         (stripRecharging effects)         in (scaleChargeBens cself, scaleChargeBens cfoe)@@ -344,30 +345,34 @@       -- because they are applied to self. If they are periodic we can't       -- effectively apply them, becasue they are never recharged,       -- because they activate as soon as recharged.-      benApply = (effSelf + effDice  -- hits self with dice too, when applying-                  + if periodic then 0 else sum chargeSelf)-                 `divUp` if durable then 1 else durabilityMult+      benApply = max 0 $  -- because optional; I don't need to apply+        (effSelf + effDice  -- hits self with dice too, when applying+         + if periodic then 0 else sum chargeSelf)+        `divUp` if durable then 1 else durabilityMult       -- For melee, we add the foe part.-      benMelee = (effFoe + effDice  -- @AddHurtMelee@ already in @eqpSum@-                  + if periodic then 0 else sum chargeFoe)-                 `divUp` if durable then 1 else durabilityMult+      benMelee = min 0 $+        (effFoe + effDice  -- @AddHurtMelee@ already in @eqpSum@+         + if periodic then 0 else sum chargeFoe)+        `divUp` if durable then 1 else durabilityMult       -- The periodic effects, if any, are activated when projectile flies,       -- but not when it hits, so they are not added to @benFling@.       -- However, if item is not periodic, the recharging effects       -- are activated at projectile impact, hence their value is added.-      benFling = effFoe + benFlingDice -- nothing in @eqpSum@; normally not worn-                 + if periodic then 0 else sum chargeFoe+      benFling = min 0 $+        effFoe + benFlingDice -- nothing in @eqpSum@; normally not worn+        + if periodic then 0 else sum chargeFoe       benFlingDice | jdamage item <= 0 = 0  -- speedup-                   | otherwise = min 0 $-        let hurtMult = 100 + min 99 (max (-99) (aHurtMelee aspects))-              -- assumes no enemy armor and no block-            dmg = Dice.meanDice (jdamage item)-            rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100-            -- For simplicity, we ignore range bonus/malus and @Lobable@.-            IK.ThrowMod{IK.throwVelocity} = strengthToThrow item-            speed = speedFromWeight (jweight item) throwVelocity-        in fromEnum $ - modifyDamageBySpeed rawDeltaHP speed * 10 `div` oneM-             -- 1 damage valued at 10, just as in @damageUsefulness@+                   | otherwise = assert (v <= 0) v+       where+        hurtMult = 100 + min 99 (max (-99) (aHurtMelee aspects))+          -- assumes no enemy armor and no block+        dmg = Dice.meanDice (jdamage item)+        rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100+        -- For simplicity, we ignore range bonus/malus and @Lobable@.+        IK.ThrowMod{IK.throwVelocity} = strengthToThrow item+        speed = speedFromWeight (jweight item) throwVelocity+        v = fromEnum $ - modifyDamageBySpeed rawDeltaHP speed * 10 `div` oneM+          -- 1 damage valued at 10, just as in @damageUsefulness@       -- For equipment benefit, we take into account only the self       -- value of the recharging effects, because they applied to self.       -- We don't add a bonus @averageTurnValue@ to the value of periodic@@ -393,14 +398,14 @@           ( True  -- equip, melee crucial, and only weapons in eqp can be used           , if durable             then eqpSum-                 + max 0 (max benApply (- benMelee))  -- apply or melee or not-            else max 0 (- benMelee))  -- melee is predominant+                 + max benApply (- benMelee)  -- apply or melee or not+            else - benMelee)  -- melee is predominant         | goesIntoEqp item && eqpSum > 0 =  -- weapon or other equippable           ( True  -- equip; long time bonus usually outweighs fling or apply           , eqpSum  -- possibly spent turn equipping, so reap the benefits             + if durable-              then max 0 benApply  -- apply or not but don't fling+              then benApply  -- apply or not but don't fling               else 0)  -- don't remove from equipment by using up         | otherwise =-          (False, max 0 (max benApply (- benFling)))  -- apply or fling+          (False, max benApply (- benFling))  -- apply or fling   in Benefit{..}

@@ -44,47 +44,47 @@ -- -- Data invariant: if @_sleader@ is @Nothing@ then so is @srunning@. data StateClient = StateClient-  { seps          :: !Int           -- ^ a parameter of the aiming digital line-  , stargetD      :: !(EM.EnumMap ActorId TgtAndPath)+  { seps          :: Int           -- ^ a parameter of the aiming digital line+  , stargetD      :: EM.EnumMap ActorId TgtAndPath                                    -- ^ targets of our actors in the dungeon-  , sexplored     :: !(ES.EnumSet LevelId)+  , sexplored     :: ES.EnumSet LevelId                                    -- ^ the set of fully explored levels-  , sbfsD         :: !(EM.EnumMap ActorId BfsAndPath)+  , sbfsD         :: EM.EnumMap ActorId BfsAndPath                                    -- ^ pathfinding distances for our actors                                    --   and paths to their targets, if any-  , sundo         :: ![CmdAtomic]   -- ^ atomic commands performed to date-  , sdiscoKind    :: !DiscoveryKind    -- ^ remembered item discoveries-  , sdiscoAspect  :: !DiscoveryAspect  -- ^ remembered aspects of items-  , sdiscoBenefit :: !DiscoveryBenefit  -- ^ remembered AI benefits of items-  , sactorAspect  :: !ActorAspect   -- ^ best known actor aspect data-  , sfper         :: !PerLid        -- ^ faction perception indexed by levels-  , salter        :: !AlterLid      -- ^ cached alter ability data for positions-  , srandom       :: !R.StdGen      -- ^ current random generator-  , _sleader      :: !(Maybe ActorId)+  , sundo         :: [CmdAtomic]   -- ^ atomic commands performed to date+  , sdiscoKind    :: DiscoveryKind     -- ^ remembered item discoveries+  , sdiscoAspect  :: DiscoveryAspect   -- ^ remembered aspects of items+  , sdiscoBenefit :: DiscoveryBenefit  -- ^ remembered AI benefits of items+  , sactorAspect  :: ActorAspect   -- ^ best known actor aspect data+  , sfper         :: PerLid        -- ^ faction perception indexed by levels+  , salter        :: AlterLid      -- ^ cached alter ability data for positions+  , srandom       :: R.StdGen      -- ^ current random generator+  , _sleader      :: Maybe ActorId                                    -- ^ candidate new leader of the faction;                                    --   Faction._gleader is the old leader-  , _sside        :: !FactionId     -- ^ faction controlled by the client-  , squit         :: !Bool          -- ^ exit the game loop-  , scurChal      :: !Challenge     -- ^ current game challenge setup-  , snxtChal      :: !Challenge     -- ^ next game challenge setup-  , snxtScenario  :: !Int           -- ^ next game scenario number-  , smarkSuspect  :: !Int           -- ^ mark suspect features-  , scondInMelee  :: !(EM.EnumMap LevelId (Maybe Bool))-                                    -- ^ condInMelee value, unless invalidated-  , svictories    :: !(EM.EnumMap (Kind.Id ModeKind) (M.Map Challenge Int))+  , _sside        :: FactionId     -- ^ faction controlled by the client+  , squit         :: Bool          -- ^ exit the game loop+  , scurChal      :: Challenge     -- ^ current game challenge setup+  , snxtChal      :: Challenge     -- ^ next game challenge setup+  , snxtScenario  :: Int           -- ^ next game scenario number+  , smarkSuspect  :: Int           -- ^ mark suspect features+  , scondInMelee  :: EM.EnumMap LevelId (Maybe Bool)+                                   -- ^ condInMelee value, unless invalidated+  , svictories    :: EM.EnumMap (Kind.Id ModeKind) (M.Map Challenge Int)       -- ^ won games at particular difficulty levels-  , sdebugCli     :: !DebugModeCli  -- ^ client debugging mode+  , sdebugCli     :: DebugModeCli  -- ^ client debugging mode   }   deriving Show  data BfsAndPath =     BfsInvalid-  | BfsAndPath { bfsArr  :: !(PointArray.Array BfsDistance)-               , bfsPath :: !(EM.EnumMap Point AndPath)+  | BfsAndPath { bfsArr  :: PointArray.Array BfsDistance+               , bfsPath :: EM.EnumMap Point AndPath                }   deriving Show -data TgtAndPath = TgtAndPath {tapTgt :: !Target, tapPath :: !AndPath}+data TgtAndPath = TgtAndPath {tapTgt :: Target, tapPath :: AndPath}   deriving (Show, Generic)  instance Binary TgtAndPath@@ -142,7 +142,7 @@   let side1 = bfid $ getActorBody leader s       side2 = sside cli   in assert (side1 == side2 `blame` "enemy actor becomes our leader"-                            `twith` (side1, side2, leader, s))+                            `swith` (side1, side2, leader, s))      $ cli {_sleader = Just leader}  sside :: StateClient -> FactionId

@@ -8,7 +8,8 @@   , putSession, queryUI   , displayRespUpdAtomicUI, displayRespSfxAtomicUI     -- * Startup-  , KeyKind, SessionUI(..), emptySessionUI, Config+  , KeyKind, SessionUI(..), emptySessionUI+  , Config, applyConfigToDebug, configCmdline, mkConfig   , ChanFrontend, chanFrontend, frontendShutdown     -- * Operations exposed for LoopClient   , ColorMode(..)

@@ -24,10 +24,10 @@ import Game.LambdaHack.Common.State  data ActorUI = ActorUI-  { bsymbol  :: !Char         -- ^ individual map symbol-  , bname    :: !Text         -- ^ individual name-  , bpronoun :: !Text         -- ^ individual pronoun-  , bcolor   :: !Color.Color  -- ^ individual map color+  { bsymbol  :: Char         -- ^ individual map symbol+  , bname    :: Text         -- ^ individual name+  , bpronoun :: Text         -- ^ individual pronoun+  , bcolor   :: Color.Color  -- ^ individual map color   }   deriving (Show, Eq, Generic) @@ -52,7 +52,7 @@ ppContainer CFloor{} = "nearby" ppContainer CEmbed{} = "embedded nearby" ppContainer (CActor _ cstore) = ppCStoreIn cstore-ppContainer c@CTrunk{} = assert `failure` c+ppContainer c@CTrunk{} = error $ "" `showFailure` c  ppCStore :: CStore -> (Text, Text) ppCStore CGround = ("on", "the ground")@@ -79,7 +79,7 @@   CEmbed{} -> ["embedded nearby"]   CActor aid store -> let owner = ownerFun aid                       in ppCStoreWownW addPrepositions store owner-  CTrunk{} -> assert `failure` c+  CTrunk{} -> error $ "" `showFailure` c  verbCStore :: CStore -> Text verbCStore CGround = "drop"

@@ -14,7 +14,6 @@ import qualified Data.Ini.Reader as Ini import qualified Data.Ini.Types as Ini import qualified Data.Map.Strict as M-import qualified Data.Text as T import Game.LambdaHack.Common.ClientOptions import GHC.Generics (Generic) import System.FilePath@@ -31,23 +30,23 @@ -- is a part of a game client. data Config = Config   { -- commands-    configCommands      :: ![(K.KM, CmdTriple)]+    configCommands      :: [(K.KM, CmdTriple)]     -- hero names-  , configHeroNames     :: ![(Int, (Text, Text))]+  , configHeroNames     :: [(Int, (Text, Text))]     -- ui-  , configVi            :: !Bool  -- ^ the option for Vi keys takes precendence-  , configLaptop        :: !Bool  -- ^ because the laptop keys are the default-  , configGtkFontFamily :: !Text-  , configSdlFontFile   :: !Text-  , configSdlTtfSizeAdd :: !Int-  , configSdlFonSizeAdd :: !Int-  , configFontSize      :: !Int-  , configColorIsBold   :: !Bool-  , configHistoryMax    :: !Int-  , configMaxFps        :: !Int-  , configNoAnim        :: !Bool-  , configRunStopMsgs   :: !Bool-  , configCmdline       :: ![String]+  , configVi            :: Bool  -- ^ the option for Vi keys takes precendence+  , configLaptop        :: Bool  -- ^ because the laptop keys are the default+  , configGtkFontFamily :: Text+  , configSdlFontFile   :: Text+  , configSdlTtfSizeAdd :: Int+  , configSdlFonSizeAdd :: Int+  , configFontSize      :: Int+  , configColorIsBold   :: Bool+  , configHistoryMax    :: Int+  , configMaxFps        :: Int+  , configNoAnim        :: Bool+  , configRunStopMsgs   :: Bool+  , configCmdline       :: [String]   }   deriving (Show, Generic) @@ -63,22 +62,22 @@                 Just _ ->                   let (key, def) = read keydef                   in (K.mkKM key, def :: CmdTriple)-                Nothing -> assert `failure` "wrong macro id" `twith` ident+                Nothing -> error $ "wrong macro id" `showFailure` ident             section = Ini.allItems "extra_commands" cfg         in map mkCommand section       configHeroNames =         let toNumber (ident, nameAndPronoun) =               case stripPrefix "HeroName_" ident of                 Just n -> (read n, read nameAndPronoun)-                Nothing -> assert `failure` "wrong hero name id" `twith` ident+                Nothing -> error $ "wrong hero name id" `showFailure` ident             section = Ini.allItems "hero_names" cfg         in map toNumber section       getOption :: forall a. Read a => String -> a       getOption optionName =         let lookupFail :: forall b. String -> b             lookupFail err =-              assert `failure` ("config file access failed:" <+> T.pack err)-                     `twith` (optionName, cfg)+              error $ "config file access failed"+                      `showFailure` (err, optionName, cfg)             s = fromMaybe (lookupFail "") $ Ini.getOption "ui" optionName cfg         in either lookupFail id $ readEither s       configVi = getOption "movementViKeys_hjklyubn"@@ -104,7 +103,8 @@   let stdRuleset = Kind.stdRuleset corule       cfgUIName = rcfgUIName stdRuleset       sUIDefault = rcfgUIDefault stdRuleset-      cfgUIDefault = either (assert `failure`) id $ Ini.parse sUIDefault+      cfgUIDefault = either (error . ("" `showFailure`)) id+                     $ Ini.parse sUIDefault   dataDir <- appDataDir   let userPath = dataDir </> cfgUIName   cfgUser <- if benchmark then return Ini.emptyConfig else do@@ -113,7 +113,7 @@       then return Ini.emptyConfig       else do         sUser <- readFile userPath-        return $! either (assert `failure`) id $ Ini.parse sUser+        return $! either (error . ("" `showFailure`)) id $ Ini.parse sUser   let cfgUI = M.unionWith M.union cfgUser cfgUIDefault  -- user cfg preferred       conf = parseConfig cfgUI   -- Catch syntax errors in complex expressions ASAP,

@@ -98,7 +98,7 @@         void $ updateItemSlot CGround Nothing iid         itemVerbMU iid kit (MU.Text $ "appear" <+> ppContainer c) c         markDisplayNeeded lid-      CTrunk{} -> assert `failure` c+      CTrunk{} -> error $ "" `showFailure` c     stopPlayBack   UpdDestroyItem iid _ kit c -> do     itemVerbMU iid kit "disappear" c@@ -199,8 +199,11 @@          mleader <- getsClient _sleader          when (Just aid == mleader) $ do            actorAspect <- getsClient sactorAspect-           let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)-           when (bhp b >= xM (aMaxHP ar) && aMaxHP ar > 0 && n > 0) $ do+           let ar = fromMaybe (error $ "" `showFailure` aid)+                              (EM.lookup aid actorAspect)+           -- Regenerating actors never stop gaining HP, so we need to stop+           -- reporting it after they reach full HP for the first time.+           when (bhp b >= xM (aMaxHP ar) && bhp b - n < xM (aMaxHP ar)) $ do              actorVerbMU aid bUI "recover your health fully"              stopPlayBack   UpdRefillCalm aid calmDelta ->@@ -459,7 +462,7 @@   factionD <- getsState sfactionD   -- The item may no longer be in @c@, but it was   case iid `EM.lookup` bag of-    Nothing -> assert `failure` (aid, verb, iid, cstore)+    Nothing -> error $ "" `showFailure` (aid, verb, iid, cstore)     Just kit@(k, _) -> do       itemToF <- itemToFullClient       let lid = blid body@@ -476,14 +479,10 @@               in MU.Phrase [name, stats]             Right n ->               assert (n <= k `blame` (aid, verb, iid, cstore))-              $ let itemSecret = itemNoDisco (itemBase itemFull, n)-                    (_, _, secretName, secretAE) =-                      partItem side factionD cstore localTime itemSecret-                    name = MU.Phrase [secretName, secretAE]-                    nameList = if n == 1-                               then ["the", name]-                               else ["the", MU.Text $ tshow n, MU.Ws name]-                in MU.Phrase nameList+              $ let (_, _, name1, stats) =+                      partItemShort side factionD cstore localTime itemFull+                    name = if n == 1 then name1 else MU.CarWs n name1+                in MU.Phrase ["the", name, stats]           msg = makeSentence [MU.SubjectVerbSg subject verb, object]       msgAdd msg @@ -671,7 +670,8 @@         itemAidVerbMU aid (MU.Text verb) iid (Right k) cstore2       else when (not (bproj b) && bhp b > 0) $  -- don't announce death drops         itemAidVerbMU aid (MU.Text verb) iid (Left $ Just k) cstore2-    Nothing -> assert `failure` (iid, k, aid, cstore1, cstore2, itemSlots)+    Nothing -> error $+      "" `showFailure` (iid, k, aid, cstore1, cstore2, itemSlots)  quitFactionUI :: MonadClientUI m => FactionId -> Maybe Status -> m () quitFactionUI fid toSt = do@@ -724,7 +724,7 @@                    then "This time for real."                    else "Somebody couldn't stand the heat." )         Just Status{stOutcome=Restart, stNewGame=Nothing} ->-          assert `failure` (fid, toSt)+          error $ "" `showFailure` (fid, toSt)         Nothing -> (Nothing, Nothing)  -- server wipes out Camping for savefile   case startingPart of     Nothing -> return ()@@ -760,9 +760,9 @@             keys = [K.spaceKM, K.escKM] ++ concatMap (keyOfEKM . fst) allOKX             examItem slot =               case EM.lookup slot lSlots of-                Nothing -> assert `failure` slot+                Nothing -> error $ "" `showFailure` slot                 Just iid -> case EM.lookup iid bag of-                  Nothing -> assert `failure` iid+                  Nothing -> error $ "" `showFailure` iid                   Just kit@(k, _) -> do                     factionD <- getsState sfactionD                     let itemFull = itemToF iid kit@@ -788,7 +788,7 @@                 case ekm of                   Left km | km == K.spaceKM -> return True                   Left km | km == K.escKM -> return False-                  Left _ -> assert `failure` ekm+                  Left _ -> error $ "" `showFailure` ekm                   Right slot -> do                     go2 <- examItem slot                     if go2 then viewItems pointer2 else return True@@ -949,10 +949,7 @@             msgAdd $ makeSentence               [MU.SubjectVerbSg subject verb, MU.Text fidSourceName, "control"]           stopPlayBack-        IK.Impress -> actorVerbMU aid bUI $-          if fidSource == bfid b-          then "remember forgone allegiance suddenly"-          else "be awestruck"+        IK.Impress -> actorVerbMU aid bUI $ "be awestruck"         IK.Summon grp p -> do           let verb = if bproj b then "lure" else "summon"               object = if p == 1@@ -1024,11 +1021,11 @@         IK.ApplyPerfume ->           msgAdd "The fragrance quells all scents in the vicinity."         IK.OneOf{} -> return ()-        IK.OnSmash{} -> assert `failure` sfx-        IK.Recharging{} -> assert `failure` sfx+        IK.OnSmash{} -> error $ "" `showFailure` sfx+        IK.Recharging{} -> error $ "" `showFailure` sfx         IK.Temporary t -> actorVerbMU aid bUI $ MU.Text t-        IK.Unique -> assert `failure` sfx-        IK.Periodic -> assert `failure` sfx+        IK.Unique -> error $ "" `showFailure` sfx+        IK.Periodic -> error $ "" `showFailure` sfx   SfxMsgFid _ sfxMsg -> do     mleader <- getsClient _sleader     case mleader of@@ -1058,7 +1055,7 @@             else "rumble"           UpdAlterExplorable _ k -> if k > 0 then "grinding noise"                                              else "fizzing noise"-          _ -> assert `failure` cmd+          _ -> error $ "" `showFailure` cmd         distant = if local then [] else ["distant"]         msg = makeSentence [ "you hear"                            , MU.AW $ MU.Phrase $ distant ++ [sound] ]@@ -1082,6 +1079,7 @@                  else MU.Ws $ MU.Text $ tshow grp     return $! makeSentence ["you hear", verb, object]   SfxFizzles -> return "It flashes and fizzles."+  SfxNothingHappens -> return "Nothing happens."   SfxVoidDetection -> return "Nothing new detected."   SfxSummonLackCalm aid -> do     msbUI <- getsSession $ EM.lookup aid . sactorUI@@ -1124,8 +1122,9 @@         (_, _, name, stats) =           partItem (bfid b) factionD cstore localTime itemFull         storeOwn = ppCStoreWownW True cstore aidPhrase+        cond = if jsymbol (itemBase itemFull) == '+' then ["condition"] else []     return $! makeSentence $-      ["the", name, stats] ++ storeOwn ++ ["will now last longer"]+      ["the", name, stats] ++ cond ++ storeOwn ++ ["will now last longer"]  setLastSlot :: MonadClientUI m => ActorId -> ItemId -> CStore -> m () setLastSlot aid iid cstore = do@@ -1134,7 +1133,7 @@     ItemSlots itemSlots _ <- getsSession sslots     case lookup iid $ map swap $ EM.assocs itemSlots of       Just slastSlot -> modifySession $ \sess -> sess {slastSlot}-      Nothing -> assert `failure` (iid, cstore, aid)+      Nothing -> error $ "" `showFailure` (iid, cstore, aid)  strike :: MonadClientUI m        => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()@@ -1167,7 +1166,9 @@           if isOrgan           then partItemShortWownW side factionD spronoun COrgan localTime           else partItemShortAW side factionD cstore localTime-        msg | bhp tb <= 0 || hurtMult > 90 = makeSentence $  -- minor armor+        msg | bhp tb <= 0  -- incapacitated, so doesn't actively block+              || hurtMult > 90  -- at most minor armor+              || jdamage (itemBase itemFull) <= 0 = makeSentence $               [MU.SubjectVerbSg spart verb, tpart]               ++ if bproj sb                  then []

@@ -71,7 +71,8 @@       b <- getsState $ getActorBody aid       bUI <- getsSession $ getActorUI aid       actorAspect <- getsClient sactorAspect-      let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+      let ar = fromMaybe (error $ "" `showFailure` aid)+                         (EM.lookup aid actorAspect)           percentage = 100 * bhp b `div` xM (max 5 $ aMaxHP ar)           chs n = "[" <> T.replicate n "*"                       <> T.replicate (4 - n) "_" <> "]"@@ -172,7 +173,7 @@   let {-# INLINE viewItemBag #-}       viewItemBag _ floorBag = case EM.toDescList floorBag of         (iid, _) : _ -> viewItem $ getItemBody iid s-        [] -> assert `failure` "lfloor not sparse" `twith` ()+        [] -> error $ "lfloor not sparse" `showFailure` ()       viewSmell :: Point -> Time -> Color.AttrCharW32       {-# INLINE viewSmell #-}       viewSmell p0 sml =@@ -269,24 +270,29 @@ drawFrameActor drawnLevelId = do   SessionUI{sselected} <- getSession   Level{lxsize, lactor} <- getLevel drawnLevelId+  side <- getsClient sside   mleader <- getsClient _sleader   s <- getState   sactorUI <- getsSession sactorUI   let {-# INLINE viewActor #-}       viewActor _ as = case as of         aid : _ ->-          let Actor{bhp, bproj} = getActorBody aid s+          let Actor{bhp, bproj, bfid, btrunk} = getActorBody aid s               ActorUI{bsymbol, bcolor} = sactorUI EM.! aid+              Item{jfid} = getItemBody btrunk s               symbol | bhp > 0 || bproj = bsymbol                      | otherwise = '%'-              bg = case mleader of+              dominated = maybe False (/= bfid) jfid+              bg = if bproj then Color.HighlightNone else case mleader of                 Just leader | aid == leader -> Color.HighlightRed-                _ -> if aid `ES.notMember` sselected-                     then Color.HighlightNone-                     else Color.HighlightBlue+                _ -> if | aid `ES.member` sselected -> Color.HighlightBlue+                        | dominated -> if bfid == side  -- dominated by us+                                       then Color.HighlightWhite+                                       else Color.HighlightMagenta+                        | otherwise -> Color.HighlightNone           in Color.attrCharToW32              $ Color.AttrChar Color.Attr{fg=bcolor, bg} symbol-        [] -> assert `failure` "lactor not sparse" `twith` ()+        [] -> error $ "lactor not sparse" `showFailure` ()       mapVAL :: forall a s. (Point -> a -> Color.AttrCharW32) -> [(Point, a)]              -> FrameST s       {-# INLINE mapVAL #-}@@ -505,7 +511,7 @@     Just leader -> do       actorAspect <- getsClient sactorAspect       s <- getState-      let ar = fromMaybe (assert `failure` leader)+      let ar = fromMaybe (error $ "" `showFailure` leader)                          (EM.lookup leader actorAspect)           showTrunc :: Show a => a -> String           showTrunc = (\t -> if length t > 3 then "***" else t) . show

@@ -39,10 +39,10 @@                             <+> if d > 1 then "burns" else "burn")     Explode t -> "of" <+> tshow t <+> "explosion"     RefillHP p | p > 0 -> "of healing" <+> wrapInParens (affixBonus p)-    RefillHP 0 -> assert `failure` effect+    RefillHP 0 -> error $ "" `showFailure` effect     RefillHP p -> "of wounding" <+> wrapInParens (affixBonus p)     RefillCalm p | p > 0 -> "of soothing" <+> wrapInParens (affixBonus p)-    RefillCalm 0 -> assert `failure` effect+    RefillCalm 0 -> error $ "" `showFailure` effect     RefillCalm p -> "of dismaying" <+> wrapInParens (affixBonus p)     Dominate -> "of domination"     Impress -> "of impression"@@ -69,7 +69,7 @@             Just p -> makePhrase [MU.CarWs p "move"]       in "of speed surge for" <+> moves     Teleport dice | dice <= 0 ->-      assert `failure` effect+      error $ "" `showFailure` effect     Teleport dice | dice <= 9 -> "of blinking" <+> wrapInParens (tshow dice)     Teleport dice -> "of teleport" <+> wrapInParens (tshow dice)     CreateItem COrgan grp tim ->@@ -126,7 +126,7 @@   EqpSlotAbAlter -> "Those unskilled in alteration equip it."   EqpSlotAbProject -> "Those unskilled in flinging equip it."   EqpSlotAbApply -> "Those unskilled in applying items equip it."-  _ -> assert `failure` "should not be used in content" `twith` es+  _ -> error $ "should not be used in content" `showFailure` es  slotToName :: EqpSlot -> Text slotToName eqpSlot =

@@ -44,12 +44,12 @@ -- | The instructions sent by clients to the raw frontend. data FrontReq :: * -> * where   -- | Show a frame.-  FrontFrame :: {frontFrame :: !FrameForall} -> FrontReq ()+  FrontFrame :: {frontFrame :: FrameForall} -> FrontReq ()   -- | Perform an explicit delay of the given length.-  FrontDelay :: !Int -> FrontReq ()+  FrontDelay :: Int -> FrontReq ()   -- | Flush frames, display a frame and ask for a keypress.-  FrontKey :: { frontKeyKeys  :: ![K.KM]-              , frontKeyFrame :: !FrameForall } -> FrontReq KMP+  FrontKey :: { frontKeyKeys  :: [K.KM]+              , frontKeyFrame :: FrameForall } -> FrontReq KMP   -- | Inspect the fkeyPressed MVar.   FrontPressed :: FrontReq Bool   -- | discard a key in the queue, if any.@@ -66,9 +66,9 @@ newtype ChanFrontend = ChanFrontend (forall a. FrontReq a -> IO a)  data FSession = FSession-  { fautoYesRef   :: !(IORef Bool)-  , fasyncTimeout :: !(Async ())-  , fdelay        :: !(MVar Int)+  { fautoYesRef   :: IORef Bool+  , fasyncTimeout :: Async ()+  , fdelay        :: MVar Int   }  -- | Display a prompt, wait for any of the specified keys (for any key,

@@ -17,14 +17,14 @@ import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Common.Point -data KMP = KMP { kmpKeyMod  :: !K.KM-               , kmpPointer :: !Point }+data KMP = KMP { kmpKeyMod  :: K.KM+               , kmpPointer :: Point }  data RawFrontend = RawFrontend-  { fdisplay  :: !(SingleFrame -> IO ())-  , fshutdown :: !(IO ())-  , fshowNow  :: !(MVar ())-  , fchanKey  :: !(STM.TQueue KMP)+  { fdisplay  :: SingleFrame -> IO ()+  , fshutdown :: IO ()+  , fshowNow  :: MVar ()+  , fchanKey  :: STM.TQueue KMP   }  startupBound :: (MVar RawFrontend -> IO ()) -> IO RawFrontend

@@ -26,8 +26,8 @@  -- | Session data maintained by the frontend. data FrontendSession = FrontendSession-  { swin    :: !C.Window  -- ^ the window to draw to-  , sstyles :: !(M.Map (Color.Color, Color.Color) C.CursesStyle)+  { swin    :: C.Window  -- ^ the window to draw to+  , sstyles :: M.Map (Color.Color, Color.Color) C.CursesStyle       -- ^ map from fore/back colour pairs to defined curses styles   } @@ -46,7 +46,7 @@           , bg <- [Color.Black, Color.Blue, Color.White, Color.BrBlack] ]   nr <- C.colorPairs   when (nr < length s) $-    C.end >> (assert `failure` "terminal has too few color pairs" `twith` nr)+    C.end >> (error $ "terminal has too few color pairs" `showFailure` nr)   let (ks, vs) = unzip s   ws <- C.convertStyles vs   let swin = C.stdScr@@ -103,7 +103,8 @@                     Color.HighlightGrey ->                       if fg /= Color.BrBlack                       then (fg, Color.BrBlack)-                      else (fg, Color.defFG) ]+                      else (fg, Color.defFG)+                    _ -> (fg, Color.Black) ]   C.refresh  keyTranslate :: C.Key -> K.KM

@@ -53,9 +53,9 @@  -- | Session data maintained by the frontend. data FrontendSession = FrontendSession-  { scurrentWindow :: !Window-  , scharCells     :: !(V.Vector (HTMLTableCellElement, CSSStyleDeclaration))-  , spreviousFrame :: !(IORef SingleFrame)+  { scurrentWindow :: Window+  , scharCells     :: V.Vector (HTMLTableCellElement, CSSStyleDeclaration)+  , spreviousFrame :: IORef SingleFrame   }  extraBlankMargin :: Int@@ -140,8 +140,10 @@     --   putStrLn $ "modifier: " ++ show modifier     when (key == K.Esc) $ IO.liftIO $ resetChanKey (fchanKey rf)     IO.liftIO $ saveKMP rf modifierNoShift key originPoint-    -- Pass through C-+ and others, disable special behaviour on Tab.-    when (modifier `elem` [K.NoModifier, K.Shift, K.Control]) $ do+    -- Pass through C-+ and others, but disable special behaviour on Tab, etc.+    let browserKeys = "+-0tTnNdxcv"+    unless (modifier == K.Alt+            || modifier == K.Control && key `elem` map K.Char browserKeys) $ do       preventDefault       stopPropagation   -- Handle mouseclicks, per-cell.@@ -265,6 +267,10 @@             setProp style "border-color" $ Color.colorToRGB Color.BrYellow           Color.HighlightGrey ->             setProp style "border-color" $ Color.colorToRGB Color.BrBlack+          Color.HighlightWhite ->+            setProp style "border-color" $ Color.colorToRGB Color.White+          Color.HighlightMagenta ->+            setProp style "border-color" $ Color.colorToRGB Color.Magenta   !prevFrame <- readIORef spreviousFrame   writeIORef spreviousFrame curFrame   -- This continues asynchronously, if can't otherwise.

@@ -1,6 +1,4 @@-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-unused-do-bind #-}-#endif -- | Text frontend based on Gtk. module Game.LambdaHack.Client.UI.Frontend.Gtk   ( startup, frontendName@@ -33,8 +31,8 @@  -- | Session data maintained by the frontend. data FrontendSession = FrontendSession-  { sview :: !TextView             -- ^ the widget to draw to-  , stags :: !(IM.IntMap TextTag)  -- ^ text color tags for fg/bg+  { sview :: TextView           -- ^ the widget to draw to+  , stags :: IM.IntMap TextTag  -- ^ text color tags for fg/bg   }  -- | The name of the frontend.@@ -70,6 +68,8 @@           if fg /= Color.BrBlack           then (fg, Color.BrBlack)           else (fg, Color.defFG)+        Color.Attr{fg} ->+          (fg, Color.Black)   ttt <- textTagTableNew   stags <- IM.fromDistinctAscList <$>              mapM (\ak -> do

@@ -42,14 +42,14 @@  -- | Session data maintained by the frontend. data FrontendSession = FrontendSession-  { swindow           :: !SDL.Window-  , srenderer         :: !SDL.Renderer-  , sfont             :: !TTF.Font-  , satlas            :: !(IORef FontAtlas)-  , stexture          :: !(IORef SDL.Texture)-  , spreviousFrame    :: !(IORef SingleFrame)-  , sforcedShutdown   :: !(IORef Bool)-  , sdisplayPermitted :: !(MVar Bool)+  { swindow           :: SDL.Window+  , srenderer         :: SDL.Renderer+  , sfont             :: TTF.Font+  , satlas            :: IORef FontAtlas+  , stexture          :: IORef SDL.Texture+  , spreviousFrame    :: IORef SingleFrame+  , sforcedShutdown   :: IORef Bool+  , sdisplayPermitted :: MVar Bool   }  -- | The name of the frontend.@@ -73,7 +73,7 @@                | otherwise = fontFileName   fontFileExists <- doesFileExist fontFile   unless fontFileExists $-    assert `failure` "Font file does not exist: " ++ fontFile+    fail $ "Font file does not exist: " ++ fontFile   let fontSize = fromJust sfontSize   TTF.initialize   sfont <- TTF.load fontFile fontSize@@ -248,6 +248,8 @@               Color.HighlightBlue -> normalizeAc Color.Blue               Color.HighlightYellow -> normalizeAc Color.BrYellow               Color.HighlightGrey -> normalizeAc Color.BrBlack+              Color.HighlightWhite -> normalizeAc Color.White+              Color.HighlightMagenta -> normalizeAc Color.BrMagenta         -- https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf_42.html#SEC42         textTexture <- case EM.lookup ac atlas of           Nothing -> do

@@ -124,6 +124,7 @@           if fg /= Color.BrBlack           then (fg, Color.BrBlack)           else (fg, Color.defFG)+        _ -> (fg, Color.Black)   in hack fg1 $ hack bg1 $        defAttr { attrForeColor = SetTo (aToc fg1)                , attrBackColor = SetTo (aToc bg1) }

@@ -141,7 +141,7 @@     (np, b, _) : _ -> do       success <- pickLeader verbose np       let !_A = assert (success `blame` "same leader"-                                `twith` (leader, np, b)) ()+                                `swith` (leader, np, b)) ()       return Nothing  -- | Switches current member to the previous in the whole dungeon, wrapping.@@ -158,7 +158,7 @@     (np, b, _) : _ -> do       success <- pickLeader verbose np       let !_A = assert (success `blame` "same leader"-                                `twith` (leader, np, b)) ()+                                `swith` (leader, np, b)) ()       return Nothing  partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)]@@ -186,7 +186,7 @@       bodyUI <- getsSession $ getActorUI aid       let !_A = assert (not (bproj body)                         `blame` "projectile chosen as the leader"-                        `twith` (aid, body)) ()+                        `swith` (aid, body)) ()       -- Even if it's already the leader, give his proper name, not 'you'.       let subject = partActor bodyUI       when verbose $ msgAdd $ makeSentence [subject, "picked as a leader"]@@ -273,7 +273,7 @@ statsOverlay aid = do   b <- getsState $ getActorBody aid   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)       prSlot :: (Y, SlotChar) -> IK.EqpSlot -> (Text, KYX)       prSlot (y, c) eqpSlot =         let statName = slotToName eqpSlot@@ -288,33 +288,38 @@   return (map textToAL ts, kxs)  pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)-pickNumber askNumber kAll = do+pickNumber askNumber kAll = assert (kAll >= 1) $ do   let shownKeys = [ K.returnKM, K.mkChar '+', K.mkChar '-'                   , K.spaceKM, K.escKM ]       frontKeyKeys = K.backspaceKM : shownKeys ++ map K.mkChar ['0'..'9']-      gatherNumber pointer kCurRaw = do-        let kCur = min kAll $ max 1 kCurRaw-            kprompt = "Choose number:" <+> tshow kCur+      gatherNumber pointer kCur = assert (1 <= kCur && kCur <= kAll) $ do+        let kprompt = "Choose number:" <+> tshow kCur         promptAdd kprompt         sli <- reportToSlideshow shownKeys-        (Left kkm, pointer2) <-+        (ekkm, pointer2) <-           displayChoiceScreen ColorFull False pointer sli frontKeyKeys-        case K.key kkm of-          K.Char '+' ->-            gatherNumber pointer2 $ if kCur + 1 > kAll then 1 else kCur + 1-          K.Char '-' ->-            gatherNumber pointer2 $ if kCur - 1 < 1 then kAll else kCur - 1-          K.Char l | kCur == kAll ->  gatherNumber pointer2 $ Char.digitToInt l-          K.Char l -> gatherNumber pointer2 $ kCur * 10 + Char.digitToInt l-          K.BackSpace -> gatherNumber pointer2 $ kCur `div` 10-          K.Return -> return $ Right kCur-          K.Esc -> weaveJust <$> failWith "never mind"-          K.Space -> return $ Left Nothing-          _ -> assert `failure` "unexpected key:" `twith` kkm-  if | kAll == 0 -> assert `failure` askNumber-     | kAll == 1 || not askNumber -> return $ Right kAll+        case ekkm of+          Left kkm ->+            case K.key kkm of+              K.Char '+' ->+                gatherNumber pointer2 $ if kCur + 1 > kAll then 1 else kCur + 1+              K.Char '-' ->+                gatherNumber pointer2 $ if kCur - 1 < 1 then kAll else kCur - 1+              K.Char l | kCur * 10 + Char.digitToInt l > kAll ->+                gatherNumber pointer2+                $ if Char.digitToInt l == 0+                  then kAll+                  else min kAll (Char.digitToInt l)+              K.Char l -> gatherNumber pointer2 $ kCur * 10 + Char.digitToInt l+              K.BackSpace -> gatherNumber pointer2 $ max 1 (kCur `div` 10)+              K.Return -> return $ Right kCur+              K.Esc -> weaveJust <$> failWith "never mind"+              K.Space -> return $ Left Nothing+              _ -> error $ "unexpected key" `showFailure` kkm+          Right sc -> error $ "unexpected slot char" `showFailure` sc+  if | kAll == 1 || not askNumber -> return $ Right kAll      | otherwise -> do          res <- gatherNumber 0 kAll          case res of-           Right k | k <= 0 -> assert `failure` (res, kAll)+           Right k | k <= 0 -> error $ "" `showFailure` (res, kAll)            _ -> return res

@@ -308,7 +308,7 @@         -- Select adjacent actor by bumping into him. Takes no time.         success <- pickLeader True target         let !_A = assert (success `blame` "bump self"-                                  `twith` (leader, target, tb)) ()+                                  `swith` (leader, target, tb)) ()         failWith "by bumping"       else         -- Attacking does not require full access, adjacency is enough.@@ -382,7 +382,7 @@        -- Displacing requires full access.        if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then          case posToAidsLvl tpos lvl of-           [] -> assert `failure` (leader, sb, target, tb)+           [] -> error $ "" `showFailure` (leader, sb, target, tb)            [_] -> return $ Right $ ReqDisplace target            _ -> failSer DisplaceProjectiles        else failSer DisplaceAccess@@ -502,7 +502,7 @@             arena <- getArenaUI             runOutcome <- multiActorGoTo arena c paramOld             case runOutcome of-              Left stopMsg -> failWith stopMsg+              Left stopMsg -> return $ Left stopMsg               Right (finalGoal, dir) ->                 moveRunHuman initialStep finalGoal run False dir           _ -> do@@ -523,12 +523,10 @@                 moveRunHuman initialStep finalGoal run False dir  multiActorGoTo :: MonadClientUI m-               => LevelId -> Point -> RunParams-               -> m (Either Text (Bool, Vector))+               => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector)) multiActorGoTo arena c paramOld =   case paramOld of-    RunParams{runMembers = []} ->-      return $ Left "selected actors no longer there"+    RunParams{runMembers = []} -> failWith "selected actors no longer there"     RunParams{runMembers = r : rs, runWaiting} -> do       onLevel <- getsState $ memActor r arena       if not onLevel then do@@ -545,11 +543,9 @@         xhairMoused <- getsSession sxhairMoused         case mpath of           _ | xhairMoused && isNothing (accessBfs bfs c) ->-            return $ Left "no route to crosshair"-          NoPath -> return $ Left "no route to crosshair"-          AndPath{pathList=[]} ->-            -- This actor already at goal; will be caught in goToXhair.-            return $ Left ""+            failWith "no route to crosshair"+          NoPath -> failWith "no route to crosshair"+          AndPath{pathList=[]} -> failWith "almost there"           AndPath{pathList = p1 : _} -> do             let finalGoal = p1 == c                 dir = towards (bpos b) p1@@ -563,7 +559,7 @@                 -- to avoid cycles. When all wait for each other, fail.                 multiActorGoTo arena c paramNew{runWaiting=runWaiting + 1}               _ ->-                return $ Left "actor in the way"+                failWith "actor in the way"  -- * RunOnceToXhair @@ -637,11 +633,18 @@   -- and the server will ignore and warn (and content may avoid that,   -- e.g., making all rings identified)   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  lastItemMove <- getsSession slastItemMove+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar-      cLegal | calmE = cLegalRaw-             | destCStore == CSha = []-             | otherwise = delete CSha cLegalRaw+      cLegalE | calmE = cLegalRaw+              | destCStore == CSha = []+              | otherwise = delete CSha cLegalRaw+      cLegal = case lastItemMove of+        Just (lastFrom, lastDest) | lastDest == destCStore+                                    && lastFrom `elem` cLegalE ->+          lastFrom : delete lastFrom cLegalE+        _ -> cLegalE       prompt = makePhrase ["What to", verb]       promptEqp = makePhrase ["What consumable to", verb]       (promptGeneric, psuit) =@@ -658,9 +661,12 @@                  (\_ _ _ cCur -> promptGeneric <+> ppItemDialogModeFrom cCur)                  cLegalRaw cLegal (not auto) True   case ggi of-    Right (l, (MStore fromCStore, _)) -> return $ Right (fromCStore, l)+    Right (l, (MStore fromCStore, _)) -> do+      modifySession $ \sess ->+        sess {slastItemMove = Just (fromCStore, destCStore)}+      return $ Right (fromCStore, l)     Left err -> failWith err-    _ -> assert `failure` ggi+    _ -> error $ "" `showFailure` ggi  moveItems :: forall m. MonadClientUI m           => [CStore] -> (CStore, [(ItemId, ItemFull)]) -> CStore@@ -670,7 +676,8 @@   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect   discoBenefit <- getsClient sdiscoBenefit-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar       ret4 :: MonadClientUI m            => [(ItemId, ItemFull)]@@ -718,7 +725,7 @@     l4 <- ret4 l 0 []     return $! case l4 of       Left err -> Left err-      Right [] -> assert `failure` l+      Right [] -> error $ "" `showFailure` l       Right lr -> Right $ ReqMoveItems lr  -- * Project@@ -747,7 +754,8 @@   leader <- getLeaderUI   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar   if not calmE && fromCStore == CSha then failSer ItemNotCalm   else do@@ -793,7 +801,8 @@   leader <- getLeaderUI   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar   if not calmE && fromCStore == CSha then failSer ItemNotCalm   else do@@ -973,7 +982,7 @@       _ | km == K.escKM -> return $ Left Nothing       Just (_desc, _cats, cmd) -> cmdAction cmd       Nothing -> weaveJust <$> failWith "never mind"-    Right _slot -> assert `failure` ekm+    Right _slot -> error $ "" `showFailure` ekm  -- * ItemMenu @@ -992,7 +1001,7 @@         Nothing -> weaveJust <$> failWith "no item to open Item Menu for"         Just kit -> do           actorAspect <- getsClient sactorAspect-          let ar = fromMaybe (assert `failure` leader)+          let ar = fromMaybe (error $ "" `showFailure` leader)                              (EM.lookup leader actorAspect)           itemToF <- itemToFullClient           lidV <- viewedLevelUI@@ -1069,10 +1078,10 @@                        modifySession $ \sess ->                          sess {sitemSel = Just (newCStore, iid)}                        itemMenuHuman cmdAction-                _ -> assert `failure` km+                _ -> error $ "" `showFailure` km               Just (_desc, _cats, cmd) -> cmdAction cmd               Nothing -> weaveJust <$> failWith "never mind"-            Right _slot -> assert `failure` ekm+            Right _slot -> error $ "" `showFailure` ekm     Nothing -> weaveJust <$> failWith "no item to open Item Menu for"  -- * ChooseItemMenu@@ -1166,7 +1175,7 @@     Left km -> case km `lookup` kds of       Just (_desc, cmd) -> cmdAction cmd       Nothing -> weaveJust <$> failWith "never mind"-    Right _slot -> assert `failure` ekm+    Right _slot -> error $ "" `showFailure` ekm  -- | Display the main menu. mainMenuHuman :: MonadClientUI m@@ -1209,7 +1218,7 @@         0 -> "off"         1 -> "on"         2 -> "all"-        _ -> assert `failure` n+        _ -> error $ "" `showFailure` n       tsuspect = "suspect terrain:" <+> offOnAll markSuspect       tvisible = "visible zone:" <+> offOn markVision       tsmell = "smell clues:" <+> offOn  markSmell@@ -1223,7 +1232,7 @@       bindingLen = 30       gameInfo = map T.unpack                    [ T.justifyLeft bindingLen ' ' ""-                   , T.justifyLeft bindingLen ' ' "Game settings:"+                   , T.justifyLeft bindingLen ' ' "Convenience settings:"                    , T.justifyLeft bindingLen ' ' "" ]   generateMenu cmdAction kds gameInfo "settings" 

@@ -174,7 +174,7 @@             localTime <- getsState $ getLocalTime (blid b)             factionD <- getsState sfactionD             actorAspect <- getsClient sactorAspect-            let ar = fromMaybe (assert `failure` leader)+            let ar = fromMaybe (error $ "" `showFailure` leader)                                (EM.lookup leader actorAspect)                 attrLine = itemDesc (bfid b) factionD (aHurtMelee ar)                                     store localTime itemFull@@ -202,7 +202,7 @@                 Just (_, store) -> (leader, store)                 Nothing -> case found of                   (aid, (_, store)) : _ -> (aid, store)-                  [] -> assert `failure` iid+                  [] -> error $ "" `showFailure` iid           modifySession $ \sess -> sess {sitemSel = Just (bestStore, iid)}           arena <- getArenaUI           b2 <- getsState $ getActorBody newAid@@ -213,21 +213,21 @@              | otherwise -> do                void $ pickLeader True newAid                return $ Right c2-        MStats -> assert `failure` ggi+        MStats -> error $ "" `showFailure` ggi         MLoreItem -> displayLore CGround           (makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember"                         , "item lore" ])         MLoreOrgan -> displayLore COrgan           (makeSentence [ MU.SubjectVerbSg (partActor bUI) "remember"                         , "organ lore" ])-    (Left _, (MStats, ekm)) -> case ekm of-      Right slot -> do+    (Left err, (MStats, ekm)) -> case ekm of+      Right slot -> assert (err == "stats") $ do         let eqpSlot = statSlots !! fromJust (elemIndex slot allZeroSlots)         leader <- getLeaderUI         b <- getsState $ getActorBody leader         bUI <- getsSession $ getActorUI leader         actorAspect <- getsClient sactorAspect-        let ar = fromMaybe (assert `failure` leader)+        let ar = fromMaybe (error $ "" `showFailure` leader)                            (EM.lookup leader actorAspect)             valueText = slotToDecorator eqpSlot b $ prEqpSlot eqpSlot ar             prompt2 = makeSentence@@ -248,7 +248,8 @@   leader <- getLeaderUI   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)   let calmE = calmEnough b ar       cLegalRaw = [CGround, CInv, CSha, CEqp]       cLegal | calmE = cLegalRaw@@ -271,7 +272,7 @@           modifySession $ \sess -> sess {sitemSel = Just (fromCStore, iid)}           return Nothing         Left err -> failMsg err-        _ -> assert `failure` ggi+        _ -> error $ "" `showFailure` ggi  permittedProjectClient :: MonadClientUI m                        => [Char] -> m (ItemFull -> Either ReqFailure Bool)@@ -281,7 +282,8 @@   actorSk <- leaderSkillsClientUI   let skill = EM.findWithDefault 0 AbProject actorSk   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar   return $ permittedProject False skill calmE triggerSyms @@ -296,8 +298,8 @@   Level{lxsize, lysize} <- getLevel lid   case bla lxsize lysize eps spos tpos of     Nothing -> return $ Just ProjectAimOnself-    Just [] -> assert `failure` "project from the edge of level"-                      `twith` (spos, tpos, sb)+    Just [] -> error $ "project from the edge of level"+                       `showFailure` (spos, tpos, sb)     Just (pos : _) -> do       lvl <- getLevel lid       let t = lvl `at` pos@@ -342,13 +344,13 @@       let pos = bpos body       if blid body == lidV       then findNewEps False pos-      else assert `failure` (xhair, body, lidV)+      else error $ "" `showFailure` (xhair, body, lidV)     TPoint TEnemyPos{} _ _ ->       return $ Left "selected opponent not visible"     TPoint _ lid pos ->       if lid == lidV       then findNewEps True pos-      else assert `failure` (xhair, lidV)+      else error $ "" `showFailure` (xhair, lidV)     TVector v -> do       Level{lxsize, lysize} <- getLevel lidV       let shifted = shiftBounded lxsize lysize (bpos b) v@@ -366,7 +368,7 @@       sxhair <- getsSession sxhair       mpos <- xhairToPos       case mpos of-        Nothing -> assert `failure` sxhair+        Nothing -> error $ "" `showFailure` sxhair         Just pos -> do           munit <- projectCheck pos           case munit of@@ -407,7 +409,8 @@   leader <- getLeaderUI   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar       cLegalRaw = [CGround, CInv, CSha, CEqp]       cLegal | calmE = cLegalRaw@@ -427,7 +430,7 @@       modifySession $ \sess -> sess {sitemSel = Just (fromCStore, iid)}       return Nothing     Left err -> failMsg err-    _ -> assert `failure` ggi+    _ -> error $ "" `showFailure` ggi  permittedApplyClient :: MonadClientUI m                      => [Char] -> m (ItemFull -> Either ReqFailure Bool)@@ -437,7 +440,8 @@   actorSk <- leaderSkillsClientUI   let skill = EM.findWithDefault 0 AbApply actorSk   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar   localTime <- getsState $ getLocalTime (blid b)   return $ permittedApply localTime skill calmE triggerSyms@@ -618,11 +622,11 @@             promptAdd "Try to survive a few seconds more, if you can."           Right SlotChar{..} | slotChar == 'a' ->             displayOneReport slotPrefix-          _ -> assert `failure` ekm+          _ -> error $ "" `showFailure` ekm       displayOneReport :: Int -> m ()       displayOneReport histSlot = do         let timeReport = case drop histSlot rh of-              [] -> assert `failure` histSlot+              [] -> error $ "" `showFailure` histSlot               tR : _ -> tR             ov0 = splitReportForHistory lxsize timeReport             prompt = makeSentence@@ -639,7 +643,7 @@           K.Up -> displayOneReport $ histSlot - 1           K.Down -> displayOneReport $ histSlot + 1           K.Esc -> promptAdd "Try to learn from your previous mistakes."-          _ -> assert `failure` km+          _ -> error $ "" `showFailure` km   displayAllHistory  -- * MarkVision@@ -721,6 +725,7 @@   case saimMode of     Nothing -> return ()     Just aimMode -> do+      side <- getsClient sside       leader <- getLeaderUI       let lidV = aimLevelId aimMode       lvl <- getLevel lidV@@ -735,23 +740,36 @@       seps <- getsClient seps       mnewEps <- makeLine False b p seps       itemToF <- itemToFullClient+      factionD <- getsState sfactionD+      s <- getState       let aims = isJust mnewEps           enemyMsg = case inhabitants of             [] -> ""             (_, body) : rest ->-                 -- Even if it's the leader, give his proper name, not 'you'.-                 let subjects = map (\(_, _, bUI) ->-                       partActor bUI) inhabitantsUI-                     subject = MU.WWandW subjects-                     verb = "be here"-                     desc =-                       if not (null rest)  -- many actors, only list names-                       then ""-                       else case itemDisco $ itemToF (btrunk body) (1, []) of-                         Nothing -> ""  -- no details, only show the name-                         Just ItemDisco{itemKind} -> IK.idesc itemKind-                     pdesc = if desc == "" then "" else "(" <> desc <> ")"-                 in makeSentence [MU.SubjectVerbSg subject verb] <+> pdesc+              let Item{jfid} = getItemBody (btrunk body) s+                  bfact = factionD EM.! bfid body+                  -- Even if it's the leader, give his proper name, not 'you'.+                  subjects = map (\(_, _, bUI) -> partActor bUI)+                                 inhabitantsUI+                  subject = MU.WWandW subjects+                  verb = "be here"+                  factDesc = case jfid of+                    Just tfid | tfid /= bfid body ->+                      let dominatedBy = if bfid body == side+                                        then "us"+                                        else gname bfact+                          tfact = factionD EM.! tfid+                      in "Originally of" <+> gname tfact+                         <> ", now fighting for" <+> dominatedBy <> "."+                    _ | bfid body == side -> ""  -- just one of us+                    _ -> "One of" <+> gname bfact <> "."+                  idesc = case itemDisco $ itemToF (btrunk body) (1, []) of+                    Nothing -> ""  -- no details, only show the name+                    Just ItemDisco{itemKind} -> IK.idesc itemKind+                  -- If many actors (projectiles), only list names.+                  desc = if not (null rest) then "" else factDesc <+> idesc+                  pdesc = if desc == "" then "" else "(" <> desc <> ")"+              in makeSentence [MU.SubjectVerbSg subject verb] <+> pdesc           canSee = ES.member p (totalVisible per)           vis | isUknownSpace $ lvl `at` p = "that is"               | not canSee = "you remember"@@ -768,7 +786,7 @@ moveXhairHuman dir n = do   leader <- getLeaderUI   saimMode <- getsSession saimMode-  let lidV = maybe (assert `failure` leader) aimLevelId saimMode+  let lidV = maybe (error $ "" `showFailure` leader) aimLevelId saimMode   Level{lxsize, lysize} <- getLevel lidV   lpos <- getsState $ bpos . getActorBody leader   sxhair <- getsSession sxhair

@@ -85,29 +85,29 @@ -- | Abstract syntax of player commands. data HumanCmd =     -- Meta.-    Macro ![String]-  | ByArea ![(CmdArea, HumanCmd)]  -- if outside the areas, do nothing-  | ByAimMode {exploration :: !HumanCmd, aiming :: !HumanCmd}-  | ByItemMode {ts :: ![Trigger], notChosen :: !HumanCmd, chosen :: !HumanCmd}-  | ComposeIfLocal !HumanCmd !HumanCmd-  | ComposeUnlessError !HumanCmd !HumanCmd-  | Compose2ndLocal !HumanCmd !HumanCmd-  | LoopOnNothing !HumanCmd+    Macro [String]+  | ByArea [(CmdArea, HumanCmd)]  -- if outside the areas, do nothing+  | ByAimMode {exploration :: HumanCmd, aiming :: HumanCmd}+  | ByItemMode {ts :: [Trigger], notChosen :: HumanCmd, chosen :: HumanCmd}+  | ComposeIfLocal HumanCmd HumanCmd+  | ComposeUnlessError HumanCmd HumanCmd+  | Compose2ndLocal HumanCmd HumanCmd+  | LoopOnNothing HumanCmd     -- Global.     -- These usually take time.   | Wait   | Wait10-  | MoveDir !Vector-  | RunDir !Vector+  | MoveDir Vector+  | RunDir Vector   | RunOnceAhead   | MoveOnceToXhair   | RunOnceToXhair   | ContinueToXhair-  | MoveItem ![CStore] !CStore !(Maybe MU.Part) !Bool-  | Project ![Trigger]-  | Apply ![Trigger]-  | AlterDir ![Trigger]-  | AlterWithPointer ![Trigger]+  | MoveItem [CStore] CStore (Maybe MU.Part) Bool+  | Project [Trigger]+  | Apply [Trigger]+  | AlterDir [Trigger]+  | AlterWithPointer [Trigger]   | Help   | ItemMenu   | MainMenu@@ -124,18 +124,18 @@     -- Local. Below this line, commands do not notify the server.   | Clear   | SortSlots-  | ChooseItem !ItemDialogMode-  | ChooseItemMenu !ItemDialogMode-  | ChooseItemProject ![Trigger]-  | ChooseItemApply ![Trigger]-  | PickLeader !Int+  | ChooseItem ItemDialogMode+  | ChooseItemMenu ItemDialogMode+  | ChooseItemProject [Trigger]+  | ChooseItemApply [Trigger]+  | PickLeader Int   | PickLeaderWithPointer   | MemberCycle   | MemberBack   | SelectActor   | SelectNone   | SelectWithPointer-  | Repeat !Int+  | Repeat Int   | Record   | History   | MarkVision@@ -148,16 +148,16 @@   | Accept   | TgtClear   | ItemClear-  | MoveXhair !Vector !Int+  | MoveXhair Vector Int   | AimTgt   | AimFloor   | AimEnemy   | AimItem-  | AimAscend !Int-  | EpsIncr !Bool+  | AimAscend Int+  | EpsIncr Bool   | XhairUnknown   | XhairItem-  | XhairStair !Bool+  | XhairStair Bool   | XhairPointerFloor   | XhairPointerEnemy   | AimPointerFloor@@ -187,12 +187,12 @@   _ -> False  data Trigger =-    ApplyItem {verb :: !MU.Part, object :: !MU.Part, symbol :: !Char}-  | AlterFeature {verb :: !MU.Part, object :: !MU.Part, feature :: !TK.Feature}+    ApplyItem {verb :: MU.Part, object :: MU.Part, symbol :: Char}+  | AlterFeature {verb :: MU.Part, object :: MU.Part, feature :: TK.Feature}   deriving (Show, Eq, Ord, Generic)  instance Read Trigger where-  readsPrec = assert `failure` "parsing of Trigger not implemented" `twith` ()+  readsPrec = error $ "parsing of Trigger not implemented" `showFailure` ()  instance NFData Trigger 

@@ -101,7 +101,7 @@   case soc of     Left err -> return $ Left err     Right ([(iid, itemFull)], cekm) -> return $ Right ((iid, itemFull), cekm)-    Right _ -> assert `failure` soc+    Right _ -> error $ "" `showFailure` soc  -- | Display all items from a store and let the human player choose any -- or switch to any other store.@@ -125,7 +125,7 @@   case soc of     (Left err, cekm) -> return (Left err, cekm)     (Right [(iid, itemFull)], cekm) -> return (Right (iid, itemFull), cekm)-    (Right{}, _) -> assert `failure` soc+    (Right{}, _) -> error $ "" `showFailure` soc  -- | Let the human player choose a single, preferably suitable, -- item from a list of items. Don't display stores empty for all actors.@@ -220,7 +220,7 @@       ItemSlots itemSlots organSlots <- getsSession sslots       let isOrgan = cCur `elem` [MStore COrgan, MLoreOrgan]           lSlots = if isOrgan then organSlots else itemSlots-          slotChar = fromMaybe (assert `failure` (iid, lSlots))+          slotChar = fromMaybe (error $ "" `showFailure` (iid, lSlots))                      $ lookup iid $ map swap $ EM.assocs lSlots       return (Right [(iid, itemToF iid k)], (cCur, Right slotChar))     _ ->@@ -228,11 +228,11 @@                  0 cCur cRest ISuitable  data DefItemKey m = DefItemKey-  { defLabel  :: Either Text K.KM  -- ^ can be undefined if not @defCond@-  , defCond   :: !Bool+  { defLabel  :: Either Text K.KM+  , defCond   :: Bool   , defAction :: Either K.KM SlotChar-              -> m ( Either Text [(ItemId, ItemFull)]-                   , (ItemDialogMode, Either K.KM SlotChar) )+                 -> m ( Either Text [(ItemId, ItemFull)]+                      , (ItemDialogMode, Either K.KM SlotChar) )   }  data Suitability =@@ -259,7 +259,8 @@   body <- getsState $ getActorBody leader   bodyUI <- getsSession $ getActorUI leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)   fact <- getsState $ (EM.! bfid body) . sfactionD   hs <- partyAfterLeader leader   bagAll <- getsState $ \s -> accessModeBag leader s cCur@@ -307,7 +308,7 @@       revCmd dflt cmd = case M.lookup cmd brevMap of         Nothing -> dflt         Just (k : _) -> k-        Just [] -> assert `failure` brevMap+        Just [] -> error $ "" `showFailure` brevMap       keyDefs :: [(K.KM, DefItemKey m)]       keyDefs = filter (defCond . snd) $         [ let km = K.mkChar '?'@@ -378,9 +379,9 @@                 (cCurAfterCalm, cRestAfterCalm) = case cRest ++ mcCur of                   c1@(MStore CSha) : c2 : rest | not calmE ->                     (c2, c1 : rest)-                  [MStore CSha] | not calmE -> assert `failure` cRest+                  [MStore CSha] | not calmE -> error $ "" `showFailure` cRest                   c1 : rest -> (c1, rest)-                  [] -> assert `failure` cRest+                  [] -> error $ "" `showFailure` cRest             recCall numPrefix cCurAfterCalm cRestAfterCalm itemDialogState         }       useMultipleDef defLabel = DefItemKey@@ -406,12 +407,12 @@             let slot = case ekm of                   Left K.KM{key} -> case key of                     K.Char l -> SlotChar numPrefix l-                    _ -> assert `failure` "unexpected key:"-                                `twith` K.showKey key+                    _ -> error $ "unexpected key:"+                                 `showFailure` K.showKey key                   Right sl -> sl             in case EM.lookup slot bagItemSlotsAll of-              Nothing -> assert `failure` "unexpected slot"-                                `twith` (slot, bagItemSlots)+              Nothing -> error $ "unexpected slot"+                                 `showFailure` (slot, bagItemSlots)               Just iid -> return $! getResult (Right slot) iid         }       (bagFiltered, promptChosen) =@@ -431,10 +432,10 @@                 let slot = case ekm of                       Left K.KM{key} -> case key of                         K.Char l -> SlotChar numPrefix l-                        _ -> assert `failure` "unexpected key:"-                                    `twith` K.showKey key+                        _ -> error $ "unexpected key:"+                                     `showFailure` K.showKey key                       Right sl -> sl-                in return (Left "", (MStats, Right slot))+                in return (Left "stats", (MStats, Right slot))             }       runDefItemKey keyDefs statsDef io slotKeys promptChosen MStats     _ -> do@@ -444,7 +445,7 @@       runDefItemKey keyDefs lettersDef io slotKeys promptChosen cCur  keyOfEKM :: Int -> Either [K.KM] SlotChar -> Maybe K.KM-keyOfEKM _ (Left kms) = assert `failure` kms+keyOfEKM _ (Left kms) = error $ "" `showFailure` kms keyOfEKM numPrefix (Right SlotChar{..}) | slotPrefix == numPrefix =   Just $ K.mkChar slotChar keyOfEKM _ _ = Nothing@@ -458,13 +459,14 @@   let newLegal = cCur : cRest  -- not updated in any way yet   b <- getsState $ getActorBody leader   actorAspect <- getsClient sactorAspect-  let ar = fromMaybe (assert `failure` leader) (EM.lookup leader actorAspect)+  let ar = fromMaybe (error $ "" `showFailure` leader)+                     (EM.lookup leader actorAspect)       calmE = calmEnough b ar       legalAfterCalm = case newLegal of         c1@(MStore CSha) : c2 : rest | not calmE -> (c2, c1 : rest)         [MStore CSha] | not calmE -> (MStore CGround, newLegal)         c1 : rest -> (c1, rest)-        [] -> assert `failure` (cCur, cRest)+        [] -> error $ "" `showFailure` (cCur, cRest)   return legalAfterCalm  -- We don't create keys from slots in @okx@, so they have to be

@@ -1,6 +1,6 @@ -- | Descripitons of items. module Game.LambdaHack.Client.UI.ItemDescription-  ( partItem, partItemHigh, partItemWs, partItemWsRanged+  ( partItem, partItemShort, partItemHigh, partItemWs, partItemWsRanged   , partItemShortAW, partItemMediumAW, partItemShortWownW   , viewItem, show64With2   ) where@@ -63,10 +63,11 @@           effTs = filter (not . T.null) effTsRaw                   ++ if ranged then rangedDamage else []           lsource = case jfid $ itemBase itemFull of-            Nothing -> []-            Just fid -> ["by" <+> if fid == side-                                  then "us"-                                  else gname (factionD EM.! fid)]+            Just fid | jname (itemBase itemFull) `elem` ["impressed"] ->+              ["by" <+> if fid == side+                        then "us"+                        else gname (factionD EM.! fid)]+            _ -> []           ts = lsource                ++ take n effTs                ++ ["(...)" | length effTs > n]@@ -133,13 +134,13 @@                          Just (IK.Timeout t) ->                            "(every" <+> reduce_a t <> ":"                            <+> rechargingTs <> ")"-                         _ -> assert `failure` mtimeout+                         _ -> error $ "" `showFailure` mtimeout                      | otherwise -> case mtimeout of                          Nothing -> ""                          Just (IK.Timeout t) ->                            "(timeout" <+> reduce_a t <> ":"                            <+> rechargingTs <> ")"-                         _ -> assert `failure` mtimeout+                         _ -> error $ "" `showFailure` mtimeout                 onSmash = if T.null onSmashTs then ""                           else "(on smash:" <+> onSmashTs <> ")"                 elab = case find elabel effects of@@ -188,6 +189,10 @@          -> CStore -> Time -> ItemFull -> (Bool, Bool, MU.Part, MU.Part) partItem side factionD = partItemN side factionD False 5 4 +partItemShort :: FactionId -> FactionDict+              -> CStore -> Time -> ItemFull -> (Bool, Bool, MU.Part, MU.Part)+partItemShort side factionD = partItemN side factionD False 4 4+ partItemHigh :: FactionId -> FactionDict              -> CStore -> Time -> ItemFull -> (Bool, Bool, MU.Part, MU.Part) partItemHigh side factionD = partItemN side factionD False 10 100@@ -215,8 +220,7 @@ partItemShortAW :: FactionId -> FactionDict                 -> CStore -> Time -> ItemFull -> MU.Part partItemShortAW side factionD c localTime itemFull =-  let (_, unique, name, _) =-        partItemN side factionD False 4 4 c localTime itemFull+  let (_, unique, name, _) = partItemShort side factionD c localTime itemFull   in if unique      then MU.Phrase ["the", name]      else MU.AW name@@ -231,10 +235,9 @@      else MU.AW $ MU.Phrase [name, stats]  partItemShortWownW :: FactionId -> FactionDict-              -> MU.Part -> CStore -> Time -> ItemFull -> MU.Part+                   -> MU.Part -> CStore -> Time -> ItemFull -> MU.Part partItemShortWownW side factionD partA c localTime itemFull =-  let (_, _, name, _) =-        partItemN side factionD False 4 4 c localTime itemFull+  let (_, _, name, _) = partItemShort side factionD c localTime itemFull   in MU.WownW partA name  viewItem :: Item -> Color.AttrCharW32

@@ -23,7 +23,7 @@ import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.State -data SlotChar = SlotChar {slotPrefix :: !Int, slotChar :: !Char}+data SlotChar = SlotChar {slotPrefix :: Int, slotChar :: Char}   deriving (Show, Eq)  instance Ord SlotChar where@@ -42,8 +42,8 @@         c100 = c0 - if c0 > 150 then 100 else 0     in SlotChar n (chr c100) -data ItemSlots = ItemSlots !(EM.EnumMap SlotChar ItemId)-                           !(EM.EnumMap SlotChar ItemId)+data ItemSlots = ItemSlots (EM.EnumMap SlotChar ItemId)+                           (EM.EnumMap SlotChar ItemId)   deriving Show  instance Binary ItemSlots where

@@ -41,9 +41,9 @@   | Insert   | Delete   | Home-  | KP !Char      -- ^ a keypad key for a character (digits and operators)-  | Char !Char    -- ^ a single printable character-  | Fun !Int      -- ^ function key+  | KP Char      -- ^ a keypad key for a character (digits and operators)+  | Char Char    -- ^ a single printable character+  | Fun Int      -- ^ function key   | LeftButtonPress    -- ^ left mouse button pressed   | MiddleButtonPress  -- ^ middle mouse button pressed   | RightButtonPress   -- ^ right mouse button pressed@@ -52,7 +52,7 @@   | RightButtonRelease   -- ^ right mouse button released   | WheelNorth  -- ^ mouse wheel rotated north   | WheelSouth  -- ^ mouse wheel rotated south-  | Unknown !String -- ^ an unknown key, registered to warn the user+  | Unknown String -- ^ an unknown key, registered to warn the user   | DeadKey   deriving (Ord, Eq, Generic) @@ -72,8 +72,8 @@  instance NFData Modifier -data KM = KM { modifier :: !Modifier-             , key      :: !Key }+data KM = KM { modifier :: Modifier+             , key      :: Key }   deriving (Ord, Eq, Generic)  instance Binary KM@@ -249,7 +249,7 @@ mkKM :: String -> KM mkKM s = let mkKey sk =                case keyTranslate sk of-                 Unknown _ -> assert `failure` "unknown key" `twith` s+                 Unknown _ -> error $ "unknown key" `showFailure` s                  key -> key          in case s of            'S':'-':rest -> KM Shift (mkKey rest)

@@ -23,10 +23,10 @@  -- | Bindings and other information about human player commands. data Binding = Binding-  { bcmdMap  :: !(M.Map K.KM CmdTriple)   -- ^ binding of keys to commands-  , bcmdList :: ![(K.KM, CmdTriple)]      -- ^ the properly ordered list-                                          --   of commands for the help menu-  , brevMap  :: !(M.Map HumanCmd [K.KM])  -- ^ and from commands to their keys+  { bcmdMap  :: M.Map K.KM CmdTriple   -- ^ binding of keys to commands+  , bcmdList :: [(K.KM, CmdTriple)]    -- ^ the properly ordered list+                                       --   of commands for the help menu+  , brevMap  :: M.Map HumanCmd [K.KM]  -- ^ and from commands to their keys   }  -- | Binding of keys to movement and other standard commands,@@ -61,8 +61,8 @@         ++ K.moveBinding configVi configLaptop              (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v))              (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v))-      rejectRepetitions t1 t2 = assert `failure` "duplicate key"-                                       `twith` (t1, t2)+      rejectRepetitions t1 t2 = error $ "duplicate key"+                                        `showFailure` (t1, t2)   in Binding   { bcmdMap = M.fromListWith rejectRepetitions       [ (k, triple)@@ -181,21 +181,21 @@     keySel sel key =       let cmd = case M.lookup key bcmdMap of             Just (_, _, cmd2) -> cmd2-            Nothing -> assert `failure` key+            Nothing -> error $ "" `showFailure` key           caCmds = case cmd of             ByAimMode{..} -> case sel (exploration, aiming) of               ByArea l -> sort l-              _ -> assert `failure` cmd-            _ -> assert `failure` cmd+              _ -> error $ "" `showFailure` cmd+            _ -> error $ "" `showFailure` cmd           caMakeChoice (ca, cmd2) =             let (km, desc) = case M.lookup cmd2 brevMap of                   Just ks ->                     let descOfKM km2 = case M.lookup km2 bcmdMap of                           Just (_, "", _) -> Nothing                           Just (_, desc2, _) -> Just (km2, desc2)-                          Nothing -> assert `failure` km2+                          Nothing -> error $ "" `showFailure` km2                     in case mapMaybe descOfKM ks of-                      [] -> assert `failure` (ks, cmd2)+                      [] -> error $ "" `showFailure` (ks, cmd2)                       kmdesc3 : _ -> kmdesc3                   Nothing -> (key, "(not described:" <+> tshow cmd2 <> ")")             in (ca, Left km, desc)@@ -209,7 +209,7 @@           f (ca1, Left km1, _) (ca2, Left km2, _) y = assert (ca1 == ca2)             [ (Left [km1], (y, keyM + 3, keyB + keyM + 3))             , (Left [km2], (y, keyB + keyM + 5, 2 * keyB + keyM + 5)) ]-          f c d e = assert `failure` (c, d, e)+          f c d e = error $ "" `showFailure` (c, d, e)           kxs = concat $ zipWith3 f kst1 kst2 [offset + length header..]           render (ca1, _, desc1) (_, _, desc2) =             fmm (areaDescription ca1) desc1 desc2@@ -247,7 +247,7 @@ okxsN Binding{..} offset n greyedOut cat header footer =   let fmt k h = " " <> T.justifyLeft n ' ' k <+> h       coImage :: HumanCmd -> [K.KM]-      coImage cmd = M.findWithDefault (assert `failure` cmd) cmd brevMap+      coImage cmd = M.findWithDefault (error $ "" `showFailure` cmd) cmd brevMap       disp = T.intercalate " or " . map (T.pack . K.showKM)       keys :: [(Either [K.KM] SlotChar, (Bool, Text))]       keys = [ (Left kms, (greyedOut cmd, fmt (disp kms) desc))

@@ -153,7 +153,7 @@ getLeaderUI = do   cli <- getClient   case _sleader cli of-    Nothing -> assert `failure` "leader expected but not found" `twith` cli+    Nothing -> error $ "leader expected but not found" `showFailure` cli     Just leader -> return leader  getArenaUI :: MonadClientUI m => m LevelId@@ -383,7 +383,7 @@   else do     side <- getsClient sside     prefix <- getsClient $ ssavePrefixCli . sdebugCli-    let fileName = prefix <.> Save.saveNameCli side+    let fileName = prefix <> Save.saveNameCli cops side     res <- liftIO $ Save.restoreGame cops fileName     let stdRuleset = Kind.stdRuleset corule         cfgUIName = rcfgUIName stdRuleset

@@ -43,8 +43,8 @@  -- | The type of a single game message. data Msg = Msg-  { msgLine :: !AttrLine  -- ^ the colours and characters of the message-  , msgHist :: !Bool      -- ^ whether message should be recorded in history+  { msgLine :: AttrLine  -- ^ the colours and characters of the message+  , msgHist :: Bool      -- ^ whether message should be recorded in history   }   deriving (Show, Eq, Generic) @@ -60,7 +60,7 @@  -- * Report -data RepMsgN = RepMsgN {repMsg :: !Msg, _repN :: !Int}+data RepMsgN = RepMsgN {repMsg :: Msg, _repN :: Int}   deriving (Show, Generic)  instance Binary RepMsgN@@ -127,7 +127,7 @@ -- * History  -- | The history of reports. This is a ring buffer of the given length-data History = History !Time !Report !(RB.RingBuffer UAttrLine)+data History = History Time Report (RB.RingBuffer UAttrLine)   deriving (Show, Generic)  instance Binary History

@@ -98,8 +98,11 @@       IK.ThrowMod{IK.throwVelocity, IK.throwLinger} = strengthToThrow itemBase       speed = speedFromWeight (jweight itemBase) throwVelocity       range = rangeFromSpeedAndLinger speed throwLinger-      tspeed = "When thrown, it flies with speed of"-               <+> tshow (fromSpeed speed `divUp` 10)+      tspeed | speed < speedLimp = "When thrown, it drops at once."+             | speed < speedWalk = "When thrown, it travels only one meter and drops immediately."+             | otherwise =+               "When thrown, it flies with speed of"+               <+> tshow (fromSpeed speed `div` 10)                <> if throwLinger /= 100                   then " m/s and range" <+> tshow range <+> "m."                   else " m/s."@@ -156,15 +159,18 @@           (tshow $ fromIntegral weight / (1000 :: Double), "kg")         | otherwise = (tshow weight, "g")       onLevel = "on level" <+> tshow (abs $ fromEnum $ jlid itemBase) <> "."+      discoFirst = (if unique then "Discovered" else "First seen")+                   <+> onLevel+      whose fid = gname (factionD EM.! fid)       sourceDesc =         case jfid itemBase of-          Just fid -> "First created"-                      <+> (if fid == side-                           then "by us"-                           else "by" <+> gname (factionD EM.! fid))-                      <+> onLevel-          Nothing -> (if unique then "Discovered" else "First seen")-                     <+> onLevel+          Just fid | jsymbol itemBase `elem` ['+'] ->+            "Caused by" <+> (if fid == side then "us" else whose fid)+            <> ". First observed" <+> onLevel+          Just fid ->+            "Coming from" <+> whose fid+            <> "." <+> discoFirst+          _ -> discoFirst       colorSymbol = viewItem itemBase       blurb =         " "

@@ -103,7 +103,7 @@ continueRunDir :: MonadClientUI m                => RunParams -> m (Either Text Vector) continueRunDir params = case params of-  RunParams{ runMembers = [] } -> assert `failure` params+  RunParams{ runMembers = [] } -> error $ "" `showFailure` params   RunParams{ runLeader            , runMembers = aid : _            , runInitial } -> do@@ -121,7 +121,7 @@       cops@Kind.COps{cotile} <- getsState scops       rbody <- getsState $ getActorBody runLeader       let rposHere = bpos rbody-          rposLast = fromMaybe (assert `failure` (runLeader, rbody))+          rposLast = fromMaybe (error $ "" `showFailure` (runLeader, rbody))                                (boldpos rbody)           -- Match run-leader dir, because we want runners to keep formation.           dir = rposHere `vectorToFrom` rposLast@@ -161,7 +161,7 @@   let lid = blid body   lvl <- getLevel lid   let posHere = bpos body-      posLast = fromMaybe (assert `failure` (aid, body)) (boldpos body)+      posLast = fromMaybe (error $ "" `showFailure` (aid, body)) (boldpos body)       dirLast = posHere `vectorToFrom` posLast   let openableDir dir = Tile.isOpenable cotile (lvl `at` (posHere `shift` dir))       dirEnterable dir = enterableDir cops lvl posHere dir || openableDir dir@@ -192,7 +192,7 @@       posHasItems pos = EM.member pos $ lfloor lvl       posThere = posHere `shift` dir       actorsThere = posToAidsLvl posThere lvl-  let posLast = fromMaybe (assert `failure` (aid, body)) (boldpos body)+  let posLast = fromMaybe (error $ "" `showFailure` (aid, body)) (boldpos body)       dirLast = posHere `vectorToFrom` posLast       -- This is supposed to work on unit vectors --- diagonal, as well as,       -- vertical and horizontal.

@@ -37,39 +37,40 @@ -- Some of it is saved, some is reset when a new playing session starts. -- An important component is a frontend session. data SessionUI = SessionUI-  { sxhair         :: !Target             -- ^ the common xhair-  , sactorUI       :: !ActorDictUI        -- ^ assigned actor UI presentations-  , sslots         :: !ItemSlots          -- ^ map from slots to items-  , slastSlot      :: !SlotChar           -- ^ last used slot-  , schanF         :: !ChanFrontend       -- ^ connection with the frontend-  , sbinding       :: !Binding            -- ^ binding of keys to commands-  , sconfig        :: !Config-  , saimMode       :: !(Maybe AimMode)    -- ^ aiming mode-  , sxhairMoused   :: !Bool               -- ^ last mouse aiming not vacuus-  , sitemSel       :: !(Maybe (CStore, ItemId))  -- ^ selected item, if any-  , sselected      :: !(ES.EnumSet ActorId)-                                      -- ^ the set of currently selected actors-  , srunning       :: !(Maybe RunParams)-                                      -- ^ parameters of the current run, if any-  , _sreport       :: !Report        -- ^ current messages-  , shistory       :: !History       -- ^ history of messages-  , spointer       :: !Point         -- ^ mouse pointer position-  , slastRecord    :: !LastRecord    -- ^ state of key sequence recording-  , slastPlay      :: ![K.KM]        -- ^ state of key sequence playback-  , slastLost      :: !(ES.EnumSet ActorId)-                                      -- ^ actors that just got out of sight-  , swaitTimes     :: !Int           -- ^ player just waited this many times-  , smarkVision    :: !Bool          -- ^ mark leader and party FOV-  , smarkSmell     :: !Bool          -- ^ mark smell, if the leader can smell-  , smenuIxMap     :: !(M.Map String Int)-                                     -- ^ indices of last used menu items-  , sdisplayNeeded :: !Bool          -- ^ something to display on current level-  , skeysHintMode  :: !KeysHintMode  -- ^ how to show keys hints when no messages-  , sstart         :: !POSIXTime     -- ^ this session start time-  , sgstart        :: !POSIXTime     -- ^ this game start time-  , sallTime       :: !Time          -- ^ clips from start of session to current game start-  , snframes       :: !Int           -- ^ this game current frame count-  , sallNframes    :: !Int           -- ^ frame count from start of session to current game start+  { sxhair         :: Target             -- ^ the common xhair+  , sactorUI       :: ActorDictUI        -- ^ assigned actor UI presentations+  , sslots         :: ItemSlots          -- ^ map from slots to items+  , slastSlot      :: SlotChar           -- ^ last used slot+  , slastItemMove  :: Maybe (CStore, CStore)  -- ^ last item move stores+  , schanF         :: ChanFrontend       -- ^ connection with the frontend+  , sbinding       :: Binding            -- ^ binding of keys to commands+  , sconfig        :: Config+  , saimMode       :: Maybe AimMode      -- ^ aiming mode+  , sxhairMoused   :: Bool               -- ^ last mouse aiming not vacuus+  , sitemSel       :: Maybe (CStore, ItemId)  -- ^ selected item, if any+  , sselected      :: ES.EnumSet ActorId+                                    -- ^ the set of currently selected actors+  , srunning       :: Maybe RunParams+                                    -- ^ parameters of the current run, if any+  , _sreport       :: Report        -- ^ current messages+  , shistory       :: History       -- ^ history of messages+  , spointer       :: Point         -- ^ mouse pointer position+  , slastRecord    :: LastRecord    -- ^ state of key sequence recording+  , slastPlay      :: [K.KM]        -- ^ state of key sequence playback+  , slastLost      :: ES.EnumSet ActorId+                                    -- ^ actors that just got out of sight+  , swaitTimes     :: Int           -- ^ player just waited this many times+  , smarkVision    :: Bool          -- ^ mark leader and party FOV+  , smarkSmell     :: Bool          -- ^ mark smell, if the leader can smell+  , smenuIxMap     :: M.Map String Int+                                    -- ^ indices of last used menu items+  , sdisplayNeeded :: Bool          -- ^ something to display on current level+  , skeysHintMode  :: KeysHintMode  -- ^ how to show keys hints when no messages+  , sstart         :: POSIXTime     -- ^ this session start time+  , sgstart        :: POSIXTime     -- ^ this game start time+  , sallTime       :: Time          -- ^ clips from start of session to current game start+  , snframes       :: Int           -- ^ this game current frame count+  , sallNframes    :: Int           -- ^ frame count from start of session to current game start   }  -- | Current aiming mode of a client.@@ -78,12 +79,12 @@  -- | Parameters of the current run. data RunParams = RunParams-  { runLeader  :: !ActorId         -- ^ the original leader from run start-  , runMembers :: ![ActorId]       -- ^ the list of actors that take part-  , runInitial :: !Bool            -- ^ initial run continuation by any-                                   --   run participant, including run leader-  , runStopMsg :: !(Maybe Text)    -- ^ message with the next stop reason-  , runWaiting :: !Int             -- ^ waiting for others to move out of the way+  { runLeader  :: ActorId         -- ^ the original leader from run start+  , runMembers :: [ActorId]       -- ^ the list of actors that take part+  , runInitial :: Bool            -- ^ initial run continuation by any+                                  --   run participant, including run leader+  , runStopMsg :: Maybe Text      -- ^ message with the next stop reason+  , runWaiting :: Int             -- ^ waiting for others to move out of the way   }   deriving (Show) @@ -106,8 +107,9 @@     , sactorUI = EM.empty     , sslots = ItemSlots EM.empty EM.empty     , slastSlot = SlotChar 0 'Z'+    , slastItemMove = Nothing     , schanF = ChanFrontend $ const $-        assert `failure` ("emptySessionUI: ChanFrontend " :: String)+        error $ "emptySessionUI: ChanFrontend" `showFailure` ()     , sbinding = Binding M.empty [] M.empty     , sconfig     , saimMode = Nothing@@ -142,7 +144,7 @@  getActorUI :: ActorId -> SessionUI -> ActorUI getActorUI aid sess =-  EM.findWithDefault (assert `failure` (aid, sactorUI sess)) aid+  EM.findWithDefault (error $ "" `showFailure` (aid, sactorUI sess)) aid   $ sactorUI sess  instance Binary SessionUI where@@ -176,8 +178,9 @@     smarkVision <- get     smarkSmell <- get     sdisplayNeeded <- get-    let schanF = ChanFrontend $ const $-          assert `failure` ("Binary: ChanFrontend" :: String)+    let slastItemMove = Nothing+        schanF = ChanFrontend $ const $+          error $ "Binary: ChanFrontend" `showFailure` ()         sbinding = Binding M.empty [] M.empty         sxhairMoused = True         spointer = originPoint

@@ -37,7 +37,7 @@ toSlideshow :: [OKX] -> Slideshow toSlideshow okxs = Slideshow $ addFooters False okxs  where-  addFooters _ [] = assert `failure` okxs+  addFooters _ [] = error $ "" `showFailure` okxs   addFooters _ [(als, [])] =     [( als ++ [stringToAL endMsg]      , [(Left [K.safeSpaceKM], (length als, 0, 15))] )]

@@ -87,7 +87,7 @@             => ColorMode -> [K.KM] -> Slideshow -> m K.KM getConfirms dm extraKeys slides = do   (ekm, _) <- displayChoiceScreen dm False 0 slides extraKeys-  return $! either id (assert `failure` ekm) ekm+  return $! either id (error $ "" `showFailure` ekm) ekm  -- This is the only source of menus and so, effectively, UI modes. displayChoiceScreen :: forall m . MonadClientUI m@@ -122,7 +122,7 @@       maxIx = length (concatMap snd frs) - 1       page :: Int -> m (Either K.KM SlotChar, Int)       page pointer = assert (pointer >= 0) $ case findKYX pointer frs of-        Nothing -> assert `failure` "no menu keys" `twith` frs+        Nothing -> error $ "no menu keys" `showFailure` frs         Just ((ov, kyxs), (ekm, (y, x1, x2)), ixOnPage) -> do           let highableAttrs =                 [Color.defAttr, Color.defAttr {Color.fg = Color.BrBlack}]@@ -145,7 +145,7 @@                 case K.key ikm of                   K.Return | ekm /= Left [K.returnKM] -> case ekm of                     Left (km : _) -> interpretKey km-                    Left [] -> assert `failure` ikm+                    Left [] -> error $ "" `showFailure` ikm                     Right c -> return (Right c, pointer)                   K.LeftButtonRelease -> do                     Point{..} <- getsSession spointer@@ -157,8 +157,11 @@                                  then return (Left K.spaceKM, pointer)                                  else ignoreKey                       Just (ckm, _) -> case ckm of-                        Left (km : _) -> interpretKey km-                        Left [] -> assert `failure` ikm+                        Left (km : _) ->+                          if K.key km == K.Return && km `elem` keys+                          then return (Left km, pointer)+                          else interpretKey km+                        Left [] -> error $ "" `showFailure` ikm                         Right c  -> return (Right c, pointer)                   K.RightButtonRelease ->                     if | ikm `elem` keys -> return (Left ikm, pointer)@@ -189,7 +192,7 @@                   _ | K.key ikm `elem` [K.PgDn, K.WheelSouth] ->                     page (min maxIx (pointer + pageLen - ixOnPage))                   K.Space -> ignoreKey-                  _ -> assert `failure` "unknown key" `twith` ikm+                  _ -> error $ "unknown key" `showFailure` ikm           pkm <- promptGetKey dm ov1 sfBlank legalKeys           interpretKey pkm   (km, pointer) <- if null frs

@@ -38,34 +38,34 @@ -- to the original value from @ActorKind@ over time. E.g., HP. data Actor = Actor   { -- The trunk of the actor's body (present also in @borgan@ or @beqp@)-    btrunk      :: !ItemId+    btrunk      :: ItemId      -- Resources-  , bhp         :: !Int64        -- ^ current hit points * 1M-  , bhpDelta    :: !ResDelta     -- ^ HP delta this turn * 1M-  , bcalm       :: !Int64        -- ^ current calm * 1M-  , bcalmDelta  :: !ResDelta     -- ^ calm delta this turn * 1M+  , bhp         :: Int64        -- ^ current hit points * 1M+  , bhpDelta    :: ResDelta     -- ^ HP delta this turn * 1M+  , bcalm       :: Int64        -- ^ current calm * 1M+  , bcalmDelta  :: ResDelta     -- ^ calm delta this turn * 1M      -- Location-  , bpos        :: !Point        -- ^ current position-  , boldpos     :: !(Maybe Point)-                                 -- ^ previous position, if any-  , blid        :: !LevelId      -- ^ current level-  , bfid        :: !FactionId    -- ^ faction the actor currently belongs to-  , btrajectory :: !(Maybe ([Vector], Speed))-                                 -- ^ trajectory the actor must-                                 --   travel and his travel speed+  , bpos        :: Point        -- ^ current position+  , boldpos     :: (Maybe Point)+                                -- ^ previous position, if any+  , blid        :: LevelId      -- ^ current level+  , bfid        :: FactionId    -- ^ faction the actor currently belongs to+  , btrajectory :: (Maybe ([Vector], Speed))+                                -- ^ trajectory the actor must+                                --   travel and his travel speed      -- Items-  , borgan      :: !ItemBag      -- ^ organs-  , beqp        :: !ItemBag      -- ^ personal equipment-  , binv        :: !ItemBag      -- ^ personal inventory pack-  , bweapon     :: !Int          -- ^ number of weapons among eqp and organs+  , borgan      :: ItemBag      -- ^ organs+  , beqp        :: ItemBag      -- ^ personal equipment+  , binv        :: ItemBag      -- ^ personal inventory pack+  , bweapon     :: Int          -- ^ number of weapons among eqp and organs      -- Assorted-  , bwait       :: !Bool         -- ^ is the actor waiting right now?-  , bproj       :: !Bool         -- ^ is a projectile? (shorthand only,-                                 --   this can be deduced from btrunk)+  , bwait       :: Bool         -- ^ is the actor waiting right now?+  , bproj       :: Bool         -- ^ is a projectile? (shorthand only,+                                --   this can be deduced from btrunk)   }   deriving (Show, Eq, Generic) @@ -73,8 +73,8 @@  -- The resource changes in the tuple are negative and positive, respectively. data ResDelta = ResDelta-  { resCurrentTurn  :: !(Int64, Int64)  -- ^ resource change this player turn-  , resPreviousTurn :: !(Int64, Int64)  -- ^ resource change last player turn+  { resCurrentTurn  :: (Int64, Int64)  -- ^ resource change this player turn+  , resPreviousTurn :: (Int64, Int64)  -- ^ resource change last player turn   }   deriving (Show, Eq, Generic) 

@@ -74,7 +74,7 @@  getItemBody :: ItemId -> State -> Item getItemBody iid s =-  let assFail = assert `failure` "item body not found" `twith` (iid, s)+  let assFail = error $ "item body not found" `showFailure` (iid, s)   in EM.findWithDefault assFail iid $ sitemD s  bagAssocs :: State -> ItemBag -> [(ItemId, Item)]@@ -184,7 +184,7 @@   CEmbed lid p -> getEmbedBag lid p s   CActor aid cstore -> let b = getActorBody aid s                        in getBodyStoreBag b cstore s-  CTrunk{} -> assert `failure` c+  CTrunk{} -> error $ "" `showFailure` c  getFloorBag :: LevelId -> Point -> State -> ItemBag getFloorBag lid p s = EM.findWithDefault EM.empty p@@ -315,13 +315,13 @@   CFloor{} -> CGround   CEmbed{} -> CGround   CActor _ cstore -> cstore-  CTrunk{} -> assert `failure` c+  CTrunk{} -> error $ "" `showFailure` c  aidFromC :: Container -> Maybe ActorId aidFromC CFloor{} = Nothing aidFromC CEmbed{} = Nothing aidFromC (CActor aid _) = Just aid-aidFromC c@CTrunk{} = assert `failure` c+aidFromC c@CTrunk{} = error $ "" `showFailure` c  -- | Determine the dungeon level of the container. If the item is in a shared -- stash, the level depends on which actor asks.@@ -329,13 +329,13 @@ lidFromC (CFloor lid _) _ = lid lidFromC (CEmbed lid _) _ = lid lidFromC (CActor aid _) s = blid $ getActorBody aid s-lidFromC c@CTrunk{} _ = assert `failure` c+lidFromC c@CTrunk{} _ = error $ "" `showFailure` c  posFromC :: Container -> State -> Point posFromC (CFloor _ pos) _ = pos posFromC (CEmbed _ pos) _ = pos posFromC (CActor aid _) s = bpos $ getActorBody aid s-posFromC c@CTrunk{} _ = assert `failure` c+posFromC c@CTrunk{} _ = error $ "" `showFailure` c  isEscape :: LevelId -> Point -> State -> Bool isEscape lid p s =

@@ -12,46 +12,46 @@ import GHC.Generics (Generic)  data DebugModeCli = DebugModeCli-  { sgtkFontFamily    :: !(Maybe Text)+  { sgtkFontFamily    :: Maybe Text       -- ^ Font family to use for the GTK main game window.-  , sdlFontFile       :: !(Maybe Text)+  , sdlFontFile       :: Maybe Text       -- ^ Font file to use for the SDL2 main game window.-  , sdlTtfSizeAdd     :: !(Maybe Int)+  , sdlTtfSizeAdd     :: Maybe Int       -- ^ Pixels to add to map cells on top of scalable font max glyph height.-  , sdlFonSizeAdd     :: !(Maybe Int)+  , sdlFonSizeAdd     :: Maybe Int       -- ^ Pixels to add to map cells on top of .fon font max glyph height.-  , sfontSize         :: !(Maybe Int)+  , sfontSize         :: Maybe Int       -- ^ Font size to use for the main game window.-  , scolorIsBold      :: !(Maybe Bool)+  , scolorIsBold      :: Maybe Bool       -- ^ Whether to use bold attribute for colorful characters.-  , smaxFps           :: !(Maybe Int)+  , smaxFps           :: Maybe Int       -- ^ Maximal frames per second.       -- This is better low and fixed, to avoid jerkiness and delays       -- that tell the player there are many intelligent enemies on the level.       -- That's better than scaling AI sofistication down based       -- on the FPS setting and machine speed.-  , sdisableAutoYes   :: !Bool+  , sdisableAutoYes   :: Bool       -- ^ Never auto-answer all prompts, even if under AI control.-  , snoAnim           :: !(Maybe Bool)+  , snoAnim           :: Maybe Bool       -- ^ Don't show any animations.-  , snewGameCli       :: !Bool+  , snewGameCli       :: Bool       -- ^ Start a new game, overwriting the save file.-  , sbenchmark        :: !Bool+  , sbenchmark        :: Bool       -- ^ Don't create directories and files and show time stats.-  , stitle            :: !(Maybe Text)-  , sfontDir          :: !(Maybe FilePath)-  , ssavePrefixCli    :: !String+  , stitle            :: Maybe Text+  , sfontDir          :: Maybe FilePath+  , ssavePrefixCli    :: String       -- ^ Prefix of the save game file name.-  , sfrontendTeletype :: !Bool+  , sfrontendTeletype :: Bool       -- ^ Whether to use the stdout/stdin frontend.-  , sfrontendNull     :: !Bool+  , sfrontendNull     :: Bool       -- ^ Whether to use null (no input/output) frontend.-  , sfrontendLazy     :: !Bool+  , sfrontendLazy     :: Bool       -- ^ Whether to use lazy (output not even calculated) frontend.-  , sdbgMsgCli        :: !Bool+  , sdbgMsgCli        :: Bool       -- ^ Show clients' internal debug messages.-  , sstopAfterSeconds :: !(Maybe Int)-  , sstopAfterFrames  :: !(Maybe Int)+  , sstopAfterSeconds :: Maybe Int+  , sstopAfterFrames  :: Maybe Int   }   deriving (Show, Eq, Generic) @@ -72,7 +72,7 @@   , sbenchmark = False   , stitle = Nothing   , sfontDir = Nothing-  , ssavePrefixCli = "save"+  , ssavePrefixCli = ""   , sfrontendTeletype = False   , sfrontendNull = False   , sfrontendLazy = False

@@ -65,6 +65,8 @@   | HighlightBlue   | HighlightYellow   | HighlightGrey+  | HighlightWhite+  | HighlightMagenta   deriving (Show, Eq, Ord, Enum, Bounded, Generic)  instance Binary Highlight where@@ -75,8 +77,8 @@  -- | Text attributes: foreground and backgroud colors. data Attr = Attr-  { fg :: !Color      -- ^ foreground colour-  , bg :: !Highlight  -- ^ backgroud highlight+  { fg :: Color      -- ^ foreground colour+  , bg :: Highlight  -- ^ backgroud highlight   }   deriving (Show, Eq, Ord) @@ -90,8 +92,8 @@ defAttr = Attr defFG HighlightNone  data AttrChar = AttrChar-  { acAttr :: !Attr-  , acChar :: !Char+  { acAttr :: Attr+  , acChar :: Char   }   deriving (Show, Eq, Ord) 

@@ -21,14 +21,14 @@  -- | The general type of a particular game content, e.g., item kinds. data ContentDef a = ContentDef-  { getSymbol      :: !(a -> Char)     -- ^ symbol, e.g., to print on the map-  , getName        :: !(a -> Text)     -- ^ name, e.g., to show to the player-  , getFreq        :: !(a -> Freqs a)  -- ^ frequency within groups-  , validateSingle :: !(a -> [Text])+  { getSymbol      :: a -> Char     -- ^ symbol, e.g., to print on the map+  , getName        :: a -> Text     -- ^ name, e.g., to show to the player+  , getFreq        :: a -> Freqs a  -- ^ frequency within groups+  , validateSingle :: a -> [Text]       -- ^ validate a content item and list all offences-  , validateAll    :: !([a] -> [Text])+  , validateAll    :: [a] -> [Text]       -- ^ validate the whole defined content of this type and list all offences-  , content        :: !(V.Vector a)    -- ^ all content of this type+  , content        :: V.Vector a    -- ^ all content of this type   }  contentFromList :: [a] -> V.Vector a

@@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric, FlexibleInstances, TypeSynonymInstances #-}-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-orphans #-}-#endif -- | Representation of dice for parameters scaled with current level depth. module Game.LambdaHack.Common.Dice   ( -- * Frequency distribution for casting dice scaled with level depth@@ -101,9 +99,9 @@ -- Dice like 100d100 lead to enormous lists, so we help a bit -- by keeping simple dice nonstrict below. data Dice = Dice-  { diceConst :: SimpleDice-  , diceLevel :: SimpleDice-  , diceMult  :: !Int+  { diceConst :: ~SimpleDice+  , diceLevel :: ~SimpleDice+  , diceMult  :: Int   }   deriving (Eq, Ord, Generic) @@ -130,7 +128,7 @@     Dice (scaleFreq ds1 dc1 + scaleFreq ds2 dc2)          (scaleFreq ds1 dl1 + scaleFreq ds2 dl2)          (if ds1 == 1 && ds2 == 1 then 1 else-            assert `failure` (ds1, ds2, "|*| must be at top level" :: Text))+            error $ "|*| must be at top level" `showFailure` (ds1, ds2))   (Dice dc1 dl1 ds1) * (Dice dc2 dl2 ds2) =     -- Hacky, but necessary (unless we forgo general multiplication and     -- stick to multiplications by a scalar from the left and from the right).@@ -149,12 +147,12 @@          (scaleFreq ds1 dc1 * scaleFreq ds2 dl2           + scaleFreq ds1 dl1 * scaleFreq ds2 dc2)          (if ds1 == 1 && ds2 == 1 then 1 else-            assert `failure` (ds1, ds2, "|*| must be at top level" :: Text))+            error $ "|*| must be at top level" `showFailure` (ds1, ds2))   (Dice dc1 dl1 ds1) - (Dice dc2 dl2 ds2) =     Dice (scaleFreq ds1 dc1 - scaleFreq ds2 dc2)          (scaleFreq ds1 dl1 - scaleFreq ds2 dl2)          (if ds1 == 1 && ds2 == 1 then 1 else-            assert `failure` (ds1, ds2, "|*| must be at top level" :: Text))+            error $ "|*| must be at top level" `showFailure` (ds1, ds2))   negate = affectBothDice negate   abs = affectBothDice abs   signum = affectBothDice signum@@ -213,7 +211,7 @@  -- | Dice for rolling a pair of integer parameters pertaining to, -- respectively, the X and Y cartesian 2D coordinates.-data DiceXY = DiceXY !Dice !Dice+data DiceXY = DiceXY Dice Dice   deriving (Show, Eq, Ord, Generic)  instance Hashable DiceXY

@@ -39,18 +39,18 @@ type FactionDict = EM.EnumMap FactionId Faction  data Faction = Faction-  { gname     :: !Text            -- ^ individual name-  , gcolor    :: !Color.Color     -- ^ color of actors or their frames-  , gplayer   :: !Player          -- ^ the player spec for this faction-  , ginitial  :: ![(Int, Int, GroupName ItemKind)]  -- ^ initial actors-  , gdipl     :: !Dipl            -- ^ diplomatic mode-  , gquit     :: !(Maybe Status)  -- ^ cause of game end/exit-  , _gleader  :: !(Maybe ActorId) -- ^ the leader of the faction; don't use-                                  --   in place of _sleader on clients!-  , gsha      :: !ItemBag         -- ^ faction's shared inventory-  , gvictims  :: !(EM.EnumMap (Kind.Id ItemKind) Int)  -- ^ members killed-  , gvictimsD :: !(EM.EnumMap (Kind.Id ModeKind)-                              (IM.IntMap (EM.EnumMap (Kind.Id ItemKind) Int)))+  { gname     :: Text            -- ^ individual name+  , gcolor    :: Color.Color     -- ^ color of actors or their frames+  , gplayer   :: Player          -- ^ the player spec for this faction+  , ginitial  :: [(Int, Int, GroupName ItemKind)]  -- ^ initial actors+  , gdipl     :: Dipl            -- ^ diplomatic mode+  , gquit     :: Maybe Status    -- ^ cause of game end/exit+  , _gleader  :: Maybe ActorId   -- ^ the leader of the faction; don't use+                                 --   in place of _sleader on clients+  , gsha      :: ItemBag         -- ^ faction's shared inventory+  , gvictims  :: EM.EnumMap (Kind.Id ItemKind) Int  -- ^ members killed+  , gvictimsD :: EM.EnumMap (Kind.Id ModeKind)+                            (IM.IntMap (EM.EnumMap (Kind.Id ItemKind) Int))       -- ^ members killed in the past, by game mode and difficulty level   }   deriving (Show, Eq, Ord, Generic)@@ -71,10 +71,10 @@  -- | Current game status. data Status = Status-  { stOutcome :: !Outcome  -- ^ current game outcome-  , stDepth   :: !Int      -- ^ depth of the final encounter-  , stNewGame :: !(Maybe (GroupName ModeKind))-                           -- ^ new game group to start, if any+  { stOutcome :: Outcome  -- ^ current game outcome+  , stDepth   :: Int      -- ^ depth of the final encounter+  , stNewGame :: Maybe (GroupName ModeKind)+                          -- ^ new game group to start, if any   }   deriving (Show, Eq, Ord, Generic) @@ -82,21 +82,21 @@  -- | The type of na actor target. data Target =-    TEnemy !ActorId !Bool+    TEnemy ActorId Bool     -- ^ target an actor; cycle only trough seen foes, unless the flag is set-  | TPoint !TGoal !LevelId !Point  -- ^ target a concrete spot-  | TVector !Vector         -- ^ target position relative to actor+  | TPoint TGoal LevelId Point  -- ^ target a concrete spot+  | TVector Vector         -- ^ target position relative to actor   deriving (Show, Eq, Ord, Generic)  instance Binary Target  data TGoal =-    TEnemyPos !ActorId !Bool+    TEnemyPos ActorId Bool     -- ^ last seen position of the targeted actor-  | TEmbed !ItemBag !Point+  | TEmbed ItemBag Point     -- ^ in @TPoint (TEmbed bag p) _ q@ usually @bag@ is embbedded in @p@     --   and @q@ is an adjacent open tile-  | TItem !ItemBag+  | TItem ItemBag   | TSmell   | TUnknown   | TKnown@@ -106,9 +106,9 @@ instance Binary TGoal  data Challenge = Challenge-  { cdiff :: !Int   -- ^ game difficulty level (HP bonus or malus)-  , cwolf :: !Bool  -- ^ lone wolf challenge (only one starting character)-  , cfish :: !Bool  -- ^ cold fish challenge (no healing from enemies)+  { cdiff :: Int   -- ^ game difficulty level (HP bonus or malus)+  , cwolf :: Bool  -- ^ lone wolf challenge (only one starting character)+  , cfish :: Bool  -- ^ cold fish challenge (no healing from enemies)   }   deriving (Show, Eq, Ord, Generic) 

@@ -30,8 +30,8 @@  -- | The type of item flavours. data Flavour = Flavour-  { fancyName :: !FancyName  -- ^ how fancy should the colour description be-  , baseColor :: !Color      -- ^ the colour of the flavour+  { fancyName :: FancyName  -- ^ how fancy should the colour description be+  , baseColor :: Color      -- ^ the colour of the flavour   }   deriving (Show, Eq, Ord, Generic) 

@@ -32,9 +32,9 @@ -- the expected equalities, unless they do some kind of normalization -- (see 'Dice'). data Frequency a = Frequency-  { runFrequency  :: ![(Int, a)]  -- ^ give acces to raw frequency values-  , nameFrequency :: Text         -- ^ short description for debug, etc.;-                                  --   keep it lazy, because it's rarely used+  { runFrequency  :: [(Int, a)]  -- ^ give acces to raw frequency values+  , nameFrequency :: ~Text       -- ^ short description for debug, etc.;+                                 --   keep it lazy, because it's rarely used   }   deriving (Show, Eq, Ord, Foldable, Traversable, Generic) @@ -89,7 +89,7 @@ -- by a positive integer constant. scaleFreq :: Show a => Int -> Frequency a -> Frequency a scaleFreq n (Frequency xs name) =-  assert (n > 0 `blame` "non-positive frequency scale" `twith` (name, n, xs)) $+  assert (n > 0 `blame` "non-positive frequency scale" `swith` (name, n, xs)) $   Frequency (map (first (* n)) xs) name  -- | Change the description of the frequency.@@ -120,7 +120,7 @@ -- it in the other code higher up, which would equate 1d0 with 1d1. meanFreq :: Frequency Int -> Int meanFreq fr@(Frequency xs _) = case xs of-  [] -> assert `failure` fr+  [] -> error $ "empty frequency" `showFailure` fr   _ -> let sumX = sum [ p * x | (p, x) <- xs ]            sumP = sum $ map fst xs        in sumX `divUp` sumP

@@ -32,14 +32,14 @@ -- | A single score record. Records are ordered in the highscore table, -- from the best to the worst, in lexicographic ordering wrt the fields below. data ScoreRecord = ScoreRecord-  { points       :: !Int        -- ^ the score-  , negTime      :: !Time       -- ^ game time spent (negated, so less better)-  , date         :: !POSIXTime  -- ^ date of the last game interruption-  , status       :: !Status     -- ^ reason of the game interruption-  , challenge    :: !Challenge  -- ^ challenge setup of the game-  , gplayerName  :: !Text       -- ^ name of the faction's gplayer-  , ourVictims   :: !(EM.EnumMap (Kind.Id ItemKind) Int)  -- ^ allies lost-  , theirVictims :: !(EM.EnumMap (Kind.Id ItemKind) Int)  -- ^ foes killed+  { points       :: Int        -- ^ the score+  , negTime      :: Time       -- ^ game time spent (negated, so less better)+  , date         :: POSIXTime  -- ^ date of the last game interruption+  , status       :: Status     -- ^ reason of the game interruption+  , challenge    :: Challenge  -- ^ challenge setup of the game+  , gplayerName  :: Text       -- ^ name of the faction's gplayer+  , ourVictims   :: EM.EnumMap (Kind.Id ItemKind) Int  -- ^ allies lost+  , theirVictims :: EM.EnumMap (Kind.Id ItemKind) Int  -- ^ foes killed   }   deriving (Eq, Ord, Show, Generic) @@ -88,7 +88,7 @@  getRecord :: Int -> ScoreTable -> ScoreRecord getRecord pos (ScoreTable table) =-  fromMaybe (assert `failure` (pos, table))+  fromMaybe (error $ "" `showFailure` (pos, table))   $ listToMaybe $ drop (pred pos) table  -- | Empty score table

@@ -49,8 +49,8 @@   deriving (Show, Eq, Ord, Enum, Ix.Ix, Hashable, Binary)  data KindMean = KindMean-  { kmKind :: !(Kind.Id IK.ItemKind)-  , kmMean :: !AspectRecord+  { kmKind :: Kind.Id IK.ItemKind+  , kmMean :: AspectRecord   }   deriving (Show, Eq, Generic) @@ -68,11 +68,11 @@ -- 4. the (usually negative) benefit of hitting a foe in meleeing with the item -- 5. the (usually negative) benefit of flinging an item at an opponent data Benefit = Benefit-  { benInEqp  :: Bool-  , benPickup :: Int-  , benApply  :: Int-  , benMelee  :: Int-  , benFling  :: Int+  { benInEqp  :: ~Bool+  , benPickup :: ~Int+  , benApply  :: ~Int+  , benMelee  :: ~Int+  , benFling  :: ~Int   }   deriving (Show, Generic) @@ -87,19 +87,19 @@   deriving (Show, Eq, Ord, Enum, Hashable, Binary)  data AspectRecord = AspectRecord-  { aTimeout     :: !Int-  , aHurtMelee   :: !Int-  , aArmorMelee  :: !Int-  , aArmorRanged :: !Int-  , aMaxHP       :: !Int-  , aMaxCalm     :: !Int-  , aSpeed       :: !Int-  , aSight       :: !Int-  , aSmell       :: !Int-  , aShine       :: !Int-  , aNocto       :: !Int-  , aAggression  :: !Int-  , aSkills      :: !Ability.Skills+  { aTimeout     :: Int+  , aHurtMelee   :: Int+  , aArmorMelee  :: Int+  , aArmorRanged :: Int+  , aMaxHP       :: Int+  , aMaxCalm     :: Int+  , aSpeed       :: Int+  , aSight       :: Int+  , aSmell       :: Int+  , aShine       :: Int+  , aNocto       :: Int+  , aAggression  :: Int+  , aSkills      :: Ability.Skills   }   deriving (Show, Eq, Ord, Generic) @@ -151,19 +151,19 @@ -- Tiny speedup from making fields non-strict (1%, a bit more GC, less alloc). -- The fields of @KindMean@ also need to be non-strict then, otherwise slowdown. data ItemDisco = ItemDisco-  { itemKindId     :: !(Kind.Id IK.ItemKind)-  , itemKind       :: !IK.ItemKind-  , itemAspectMean :: !AspectRecord-  , itemAspect     :: !(Maybe AspectRecord)+  { itemKindId     :: Kind.Id IK.ItemKind+  , itemKind       :: IK.ItemKind+  , itemAspectMean :: AspectRecord+  , itemAspect     :: Maybe AspectRecord   }   deriving Show  -- No speedup from making fields non-strict. data ItemFull = ItemFull-  { itemBase  :: !Item-  , itemK     :: !Int-  , itemTimer :: !ItemTimer-  , itemDisco :: !(Maybe ItemDisco)+  { itemBase  :: Item+  , itemK     :: Int+  , itemTimer :: ItemTimer+  , itemDisco :: Maybe ItemDisco   }   deriving Show @@ -189,16 +189,16 @@ -- and draw an unidentified item. Full information about item is available -- through the @jkindIx@ index as soon as the item is identified. data Item = Item-  { jkindIx  :: !ItemKindIx    -- ^ index pointing to the kind of the item-  , jlid     :: !LevelId       -- ^ lowest level the item was created at-  , jfid     :: !(Maybe FactionId)-                               -- ^ the faction that created the item, if any-  , jsymbol  :: !Char          -- ^ map symbol-  , jname    :: !Text          -- ^ generic name-  , jflavour :: !Flavour       -- ^ flavour-  , jfeature :: ![IK.Feature]  -- ^ public properties-  , jweight  :: !Int           -- ^ weight in grams, obvious enough-  , jdamage  :: !Dice.Dice     -- ^ impact damage of this particular weapon+  { jkindIx  :: ItemKindIx    -- ^ index pointing to the kind of the item+  , jlid     :: LevelId       -- ^ lowest level the item was created at+  , jfid     :: Maybe FactionId+                              -- ^ the faction that created the item, if any+  , jsymbol  :: Char          -- ^ map symbol+  , jname    :: Text          -- ^ generic name+  , jflavour :: Flavour       -- ^ flavour+  , jfeature :: [IK.Feature]  -- ^ public properties+  , jweight  :: Int           -- ^ weight in grams, obvious enough+  , jdamage  :: Dice.Dice     -- ^ impact damage of this particular weapon   }   deriving (Show, Eq, Generic) @@ -207,8 +207,8 @@ instance Binary Item  data ItemSource =-    ItemSourceLevel !LevelId-  | ItemSourceFaction !FactionId+    ItemSourceLevel LevelId+  | ItemSourceFaction FactionId   deriving (Show, Eq, Generic)  instance Hashable ItemSource

@@ -60,7 +60,7 @@   in case strengthEffect p item of     [] -> Nothing     [x] -> Just x-    xs -> assert `failure` (xs, item)+    xs -> error $ "" `showFailure` (xs, item)  strengthToThrow :: Item -> ThrowMod strengthToThrow item =@@ -69,13 +69,13 @@   in case concatMap p (jfeature item) of     [] -> ThrowMod 100 100     [x] -> x-    xs -> assert `failure` (xs, item)+    xs -> error $ "" `showFailure` (xs, item)  computeTrajectory :: Int -> Int -> Int -> [Point] -> ([Vector], (Speed, Int)) computeTrajectory weight throwVelocity throwLinger path =   let speed = speedFromWeight weight throwVelocity       trange = rangeFromSpeedAndLinger speed throwLinger-      btrajectory = pathToTrajectory $ take trange path+      btrajectory = pathToTrajectory $ take (trange + 1) path   in (btrajectory, (speed, trange))  itemTrajectory :: Item -> [Point] -> ([Vector], (Speed, Int))@@ -100,7 +100,7 @@     EqpSlotAddSpeed -> aSpeed     EqpSlotAddSight -> aSight     EqpSlotLightSource -> aShine-    EqpSlotWeapon -> assert `failure` ar+    EqpSlotWeapon -> error $ "" `showFailure` ar     EqpSlotMiscAbility ->       EM.findWithDefault 0 Ability.AbWait aSkills       + EM.findWithDefault 0 Ability.AbMoveItem aSkills@@ -126,7 +126,8 @@   in length it1 < itemK  damageUsefulness :: Item -> Int-damageUsefulness item = min 1000 (10 * Dice.meanDice (jdamage item))+damageUsefulness item = let v = min 1000 (10 * Dice.meanDice (jdamage item))+                        in assert (v >= 0) v  strongestMelee :: Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFull)]                -> [(Int, (ItemId, ItemFull))]

@@ -70,7 +70,7 @@   storage <- getLocalStorage win   mitem <- getItem storage path   case mitem of-    Nothing -> assert `failure` "Fatal error: no file " ++ path+    Nothing -> fail $ "Fatal error: no file " ++ path     Just item -> return item  renameFile :: FilePath -> FilePath -> IO ()@@ -79,7 +79,7 @@   storage <- getLocalStorage win   mitem <- getItem storage path   case mitem :: Maybe String of-    Nothing -> assert `failure` "Fatal error: no file " ++ path+    Nothing -> fail $ "Fatal error: no file " ++ path     Just item -> do       setItem storage path2 item  -- overwrites       removeItem storage path

@@ -45,19 +45,19 @@       allOffences = validateAll $ V.toList content   in assert (allB correct $ V.toList content) $      assert (null singleOffenders `blame` "some content items not valid"-                                  `twith` singleOffenders) $+                                  `swith` singleOffenders) $      assert (null allOffences `blame` "the content set not valid"-                              `twith` allOffences)+                              `swith` allOffences)      -- By this point 'content' can be GCd.      Ops        { okind = \ !i -> content V.! fromEnum i        , ouniqGroup = \ !cgroup ->-           let freq = let assFail = assert `failure` "no unique group"-                                           `twith` (cgroup, kindFreq)+           let freq = let assFail = error $ "no unique group"+                                            `showFailure` (cgroup, kindFreq)                       in M.findWithDefault assFail cgroup kindFreq            in case freq of              [(n, (i, _))] | n > 0 -> i-             l -> assert `failure` "not unique" `twith` (l, cgroup, kindFreq)+             l -> error $ "not unique" `showFailure` (l, cgroup, kindFreq)        , opick = \ !cgroup !p ->            case M.lookup cgroup kindFreq of              Just freqRaw ->@@ -81,21 +81,22 @@        , ofoldlGroup' = \cgroup f z ->            case M.lookup cgroup kindFreq of              Just freq -> foldl' (\acc (p, (i, a)) -> f acc p i a) z freq-             _ -> assert `failure` "no group '" <> tshow cgroup-                                   <> "' among content that has groups"-                                   <+> tshow (M.keys kindFreq)+             _ -> error $ "no group '" ++ show cgroup+                                       ++ "' among content that has groups "+                                       ++ show (M.keys kindFreq)+                          `showFailure` ()        , olength = V.length content        }  -- | Operations for all content types, gathered together. data COps = COps-  { cocave        :: !(Ops CaveKind)     -- server only-  , coitem        :: !(Ops ItemKind)-  , comode        :: !(Ops ModeKind)     -- server only-  , coplace       :: !(Ops PlaceKind)    -- server only, so far-  , corule        :: !(Ops RuleKind)-  , cotile        :: !(Ops TileKind)-  , coTileSpeedup :: !TileSpeedup+  { cocave        :: Ops CaveKind   -- server only+  , coitem        :: Ops ItemKind+  , comode        :: Ops ModeKind   -- server only+  , coplace       :: Ops PlaceKind  -- server only, so far+  , corule        :: Ops RuleKind+  , cotile        :: Ops TileKind+  , coTileSpeedup :: TileSpeedup   }  instance Show COps where

@@ -19,19 +19,19 @@  -- | Content operations for the content of type @a@. data Ops a = Ops-  { okind         :: !(Id a -> a)  -- ^ content element at given id-  , ouniqGroup    :: !(GroupName a -> Id a)-                                   -- ^ the id of the unique member of-                                   --   a singleton content group-  , opick         :: !(GroupName a -> (a -> Bool) -> Rnd (Maybe (Id a)))-                                   -- ^ pick a random id belonging to a group-                                   --   and satisfying a predicate-  , ofoldrWithKey :: !(forall b. (Id a -> a -> b -> b) -> b -> b)-                                   -- ^ fold over all content elements of @a@-  , ofoldlWithKey' :: !(forall b. (b -> Id a -> a -> b) -> b -> b)-                                   -- ^ fold strictly over all content @a@-  , ofoldlGroup'  :: !(forall b.-                     GroupName a -> (b -> Int -> Id a -> a -> b) -> b -> b)-                                   -- ^ fold over the given group only-  , olength       :: !Int          -- ^ size of content @a@+  { okind          :: Id a -> a  -- ^ content element at given id+  , ouniqGroup     :: GroupName a -> Id a+                                 -- ^ the id of the unique member of+                                 --   a singleton content group+  , opick          :: GroupName a -> (a -> Bool) -> Rnd (Maybe (Id a))+                                 -- ^ pick a random id belonging to a group+                                 --   and satisfying a predicate+  , ofoldrWithKey  :: forall b. (Id a -> a -> b -> b) -> b -> b+                                 -- ^ fold over all content elements of @a@+  , ofoldlWithKey' :: forall b. (b -> Id a -> a -> b) -> b -> b+                                 -- ^ fold strictly over all content @a@+  , ofoldlGroup'   :: forall b.+                      GroupName a -> (b -> Int -> Id a -> a -> b) -> b -> b+                                 -- ^ fold over the given group only+  , olength        :: Int        -- ^ size of content @a@   }

@@ -39,7 +39,7 @@   let (minD, maxD) =         case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of           (Just ((s, _), _), Just ((e, _), _)) -> (s, e)-          _ -> assert `failure` "null dungeon" `twith` dungeon+          _ -> error $ "null dungeon" `showFailure` dungeon       ln = max minD $ min maxD $ toEnum $ fromEnum lid + if up then 1 else -1   in case EM.lookup ln dungeon of     Just _ | ln /= lid -> [ln]@@ -64,15 +64,15 @@           Just isnd -> (False, isnd)           Nothing -> case mup of             Just forcedUp -> (forcedUp, 0)  -- for ascending via, e.g., spells-            Nothing -> assert `failure` "no stairs at" `twith` (lid, pos)+            Nothing -> error $ "no stairs at" `showFailure` (lid, pos)       !_A = assert (maybe True (== up) mup) ()   in case ascendInBranch dungeon up lid of     [] | isJust mup -> (lid, pos)  -- spell fizzles-    [] -> assert `failure` "no dungeon level to go to" `twith` (lid, pos)+    [] -> error $ "no dungeon level to go to" `showFailure` (lid, pos)     ln : _ -> let lvlDest = dungeon EM.! ln                   stairsDest = (if up then snd else fst) (lstair lvlDest)               in if length stairsDest < i + 1-                 then assert `failure` "no stairs at index" `twith` (lid, pos)+                 then error $ "no stairs at index" `showFailure` (lid, pos)                  else (ln, stairsDest !! i)  -- | Items located on map tiles.@@ -90,40 +90,40 @@ -- | A view on single, inhabited dungeon level. "Remembered" fields -- carry a subset of the info in the client copies of levels. data Level = Level-  { ldepth      :: !AbsDepth   -- ^ absolute depth of the level-  , lfloor      :: !ItemFloor  -- ^ remembered items lying on the floor-  , lembed      :: !ItemFloor  -- ^ items embedded in the tile-  , lactor      :: !ActorMap   -- ^ seen actors at positions on the level-  , ltile       :: !TileMap    -- ^ remembered level map-  , lxsize      :: !X          -- ^ width of the level-  , lysize      :: !Y          -- ^ height of the level-  , lsmell      :: !SmellMap   -- ^ remembered smells on the level-  , ldesc       :: !Text       -- ^ level description-  , lstair      :: !([Point], [Point])-                               -- ^ positions of (up, down) stairs-  , lseen       :: !Int        -- ^ currently remembered clear tiles-  , lexplorable :: !Int        -- ^ total number of explorable tiles-  , ltime       :: !Time       -- ^ local time on the level (possibly frozen)-  , lactorCoeff :: !Int        -- ^ the lower, the more monsters spawn-  , lactorFreq  :: !(Freqs ItemKind)-                               -- ^ frequency of spawned actors; [] for clients-  , litemNum    :: !Int        -- ^ number of initial items, 0 for clients-  , litemFreq   :: !(Freqs ItemKind)-                               -- ^ frequency of initial items; [] for clients-  , lescape     :: ![Point]    -- ^ positions of IK.Escape tiles-  , lnight      :: !Bool+  { ldepth      :: AbsDepth   -- ^ absolute depth of the level+  , lfloor      :: ItemFloor  -- ^ remembered items lying on the floor+  , lembed      :: ItemFloor  -- ^ items embedded in the tile+  , lactor      :: ActorMap   -- ^ seen actors at positions on the level+  , ltile       :: TileMap    -- ^ remembered level map+  , lxsize      :: X          -- ^ width of the level+  , lysize      :: Y          -- ^ height of the level+  , lsmell      :: SmellMap   -- ^ remembered smells on the level+  , ldesc       :: Text       -- ^ level description+  , lstair      :: ([Point], [Point])+                              -- ^ positions of (up, down) stairs+  , lseen       :: Int        -- ^ currently remembered clear tiles+  , lexplorable :: Int        -- ^ total number of explorable tiles+  , ltime       :: Time       -- ^ local time on the level (possibly frozen)+  , lactorCoeff :: Int        -- ^ the lower, the more monsters spawn+  , lactorFreq  :: Freqs ItemKind+                              -- ^ frequency of spawned actors; [] for clients+  , litemNum    :: Int        -- ^ number of initial items, 0 for clients+  , litemFreq   :: Freqs ItemKind+                              -- ^ frequency of initial items; [] for clients+  , lescape     :: [Point]    -- ^ positions of IK.Escape tiles+  , lnight      :: Bool   }   deriving (Show, Eq)  assertSparseItems :: ItemFloor -> ItemFloor assertSparseItems m =   assert (EM.null (EM.filter EM.null m)-          `blame` "null floors found" `twith` m) m+          `blame` "null floors found" `swith` m) m  assertSparseActors :: ActorMap -> ActorMap assertSparseActors m =   assert (EM.null (EM.filter null m)-          `blame` "null actor lists found" `twith` m) m+          `blame` "null actor lists found" `swith` m) m  -- | Query for tile kinds on the map. at :: Level -> Point -> Kind.Id TileKind

@@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TypeFamilies #-}-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-orphans #-}-#endif -- | Hacks that haven't found their home yet. module Game.LambdaHack.Common.Misc   ( -- * Game object identifiers@@ -97,10 +95,10 @@  -- | Item container type. data Container =-    CFloor !LevelId !Point-  | CEmbed !LevelId !Point-  | CActor !ActorId !CStore-  | CTrunk !FactionId !LevelId !Point   -- ^ for bootstrapping actor bodies+    CFloor LevelId Point+  | CEmbed LevelId Point+  | CActor ActorId CStore+  | CTrunk FactionId LevelId Point   -- ^ for bootstrapping actor bodies   deriving (Show, Eq, Ord, Generic)  instance Binary Container@@ -197,12 +195,6 @@ instance (Enum k, Binary k) => Binary (ES.EnumSet k) where   put m = put (ES.size m) >> mapM_ put (ES.toAscList m)   get = ES.fromDistinctAscList <$> get--#if !MIN_VERSION_binary(0,8,0)-instance Binary (Fixed.Fixed a) where-  put (Fixed.MkFixed a) = put a-  get = Fixed.MkFixed `liftM` get-#endif  instance Binary Time.NominalDiffTime where   get = fmap realToFrac (get :: Get Fixed.Pico)

@@ -56,7 +56,7 @@   let (minD, maxD) =         case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of           (Just ((s, _), _), Just ((e, _), _)) -> (s, e)-          _ -> assert `failure` "empty dungeon" `twith` dungeon+          _ -> error $ "empty dungeon" `showFailure` dungeon       f [] = 0       f ((ln, _, _) : _) = ln   return $! max minD $ min maxD $ toEnum $ f $ ginitial fact

@@ -52,8 +52,8 @@  -- | The type representing the perception of a faction on a level. data Perception = Perception-  { psight :: !PerVisible-  , psmell :: !PerSmelled+  { psight :: PerVisible+  , psmell :: PerSmelled   }   deriving (Show, Eq, Generic) 

@@ -26,8 +26,8 @@ -- and down, so that the (0, 0) point is in the top-left corner of the screen. -- Coordinates are never negative. data Point = Point-  { px :: !X-  , py :: !Y+  { px :: X+  , py :: Y   }   deriving (Eq, Ord, Generic) @@ -54,7 +54,7 @@ #ifdef WITH_EXPENSIVE_ASSERTIONS     assert (x >= 0 && y >= 0 && x <= maxLevelDim && y <= maxLevelDim             `blame` "invalid point coordinates"-            `twith` (x, y))+            `swith` (x, y)) #endif     (x + unsafeShiftL y maxLevelDimExponent)   toEnum n = Point (n .&. maxLevelDim) (unsafeShiftR n maxLevelDimExponent)@@ -135,8 +135,8 @@      result        | x0 == x1 = map (Point x0) (fromTo1 y0 y1)        | y0 == y1 = map (`Point` y0) (fromTo1 x0 x1)-       | otherwise = assert `failure` "diagonal fromTo"-                            `twith` ((x0, y0), (x1, y1))+       | otherwise = error $ "diagonal fromTo"+                             `showFailure` ((x0, y0), (x1, y1))  in result  originPoint :: Point

@@ -17,11 +17,7 @@ import Control.Monad.ST.Strict import Data.Binary import Data.Vector.Binary ()-#if MIN_VERSION_vector(0,11,0) import qualified Data.Vector.Fusion.Bundle as Bundle-#else-import qualified Data.Vector.Fusion.Stream as Bundle-#endif import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as VM@@ -30,9 +26,9 @@  -- | Arrays indexed by @Point@. data GArray w c = Array-  { axsize  :: !X-  , aysize  :: !Y-  , avector :: !(U.Vector w)+  { axsize  :: X+  , aysize  :: Y+  , avector :: U.Vector w   }   deriving Eq 

@@ -25,7 +25,7 @@ import Data.Maybe import Data.Monoid.Compat -import Control.Exception.Assert.Sugar+import Control.Exception.Assert.Sugar (allB, assert, blame, showFailure, swith)  import Data.Text (Text) 

@@ -40,7 +40,7 @@  -- | Get any element of a list with equal probability. oneOf :: [a] -> Rnd a-oneOf [] = assert `failure` "oneOf []" `twith` ()+oneOf [] = error $ "oneOf []" `showFailure` () oneOf xs = do   r <- randomR (0, length xs - 1)   return $! xs !! r@@ -53,20 +53,20 @@ -- | Randomly choose an item according to the distribution. rollFreq :: Show a => Frequency a -> R.StdGen -> (a, R.StdGen) rollFreq fr g = case runFrequency fr of-  [] -> assert `failure` "choice from an empty frequency"-               `twith` nameFrequency fr-  [(n, x)] | n <= 0 -> assert `failure` "singleton void frequency"-                              `twith` (nameFrequency fr, n, x)+  [] -> error $ "choice from an empty frequency"+                `showFailure` nameFrequency fr+  [(n, x)] | n <= 0 -> error $ "singleton void frequency"+                               `showFailure` (nameFrequency fr, n, x)   [(_, x)] -> (x, g)  -- speedup   fs -> let sumf = foldl' (\ !acc (!n, _) -> acc + n) 0 fs             (r, ng) = R.randomR (1, sumf) g             frec :: Int -> [(Int, a)] -> a-            frec !m [] = assert `failure` "impossible roll"-                                `twith` (nameFrequency fr, fs, m)+            frec !m [] = error $ "impossible roll"+                                 `showFailure` (nameFrequency fr, fs, m)             frec m ((n, x) : _) | m <= n = x             frec m ((n, _) : xs) = frec (m - n) xs         in assert (sumf > 0 `blame` "frequency with nothing to pick"-                            `twith` (nameFrequency fr, fs))+                            `swith` (nameFrequency fr, fs))              (frec r fs, ng)  -- | Fractional chance.@@ -86,7 +86,7 @@ castDice (AbsDepth n) (AbsDepth depth) dice = do   let !_A = assert (n >= 0 && n <= depth                     `blame` "invalid depth for dice rolls"-                    `twith` (n, depth)) ()+                    `swith` (n, depth)) ()   dc <- frequency $ Dice.diceConst dice   dl <- frequency $ Dice.diceLevel dice   return $! (dc + (dl * max 0 (n - 1)) `div` max 1 (depth - 1))

@@ -41,16 +41,16 @@ data ReqUI =     ReqUINop   | ReqUITimed RequestAnyAbility-  | ReqUIGameRestart !(GroupName ModeKind) !Challenge+  | ReqUIGameRestart (GroupName ModeKind) Challenge   | ReqUIGameExit   | ReqUIGameSave-  | ReqUITactic !Tactic+  | ReqUITactic Tactic   | ReqUIAutomate   deriving Show  type RequestUI = (ReqUI, Maybe ActorId) -data RequestAnyAbility = forall a. RequestAnyAbility !(RequestTimed a)+data RequestAnyAbility = forall a. RequestAnyAbility (RequestTimed a)  deriving instance Show RequestAnyAbility @@ -59,15 +59,15 @@  -- | Client-server requests that take game time. Sent by both AI and UI clients. data RequestTimed :: Ability -> * where-  ReqMove :: !Vector -> RequestTimed 'AbMove-  ReqMelee :: !ActorId -> !ItemId -> !CStore -> RequestTimed 'AbMelee-  ReqDisplace :: !ActorId -> RequestTimed 'AbDisplace-  ReqAlter :: !Point -> RequestTimed 'AbAlter+  ReqMove :: Vector -> RequestTimed 'AbMove+  ReqMelee :: ActorId -> ItemId -> CStore -> RequestTimed 'AbMelee+  ReqDisplace :: ActorId -> RequestTimed 'AbDisplace+  ReqAlter :: Point -> RequestTimed 'AbAlter   ReqWait :: RequestTimed 'AbWait   ReqWait10 :: RequestTimed 'AbWait-  ReqMoveItems :: ![(ItemId, Int, CStore, CStore)] -> RequestTimed 'AbMoveItem-  ReqProject :: !Point -> !Int -> !ItemId -> !CStore -> RequestTimed 'AbProject-  ReqApply :: !ItemId -> !CStore -> RequestTimed 'AbApply+  ReqMoveItems :: [(ItemId, Int, CStore, CStore)] -> RequestTimed 'AbMoveItem+  ReqProject :: Point -> Int -> ItemId -> CStore -> RequestTimed 'AbProject+  ReqApply :: ItemId -> CStore -> RequestTimed 'AbApply  deriving instance Show (RequestTimed a) 

@@ -17,9 +17,9 @@  -- | Abstract syntax of client commands for both AI and UI clients. data Response =-    RespUpdAtomic !UpdAtomic-  | RespQueryAI !ActorId-  | RespSfxAtomic !SfxAtomic+    RespUpdAtomic UpdAtomic+  | RespQueryAI ActorId+  | RespSfxAtomic SfxAtomic   | RespQueryUI   deriving Show @@ -27,7 +27,7 @@  -- | Connection channel between the server and a single client. data ChanServer = ChanServer-  { responseS  :: !(CliSerQueue Response)-  , requestAIS :: !(CliSerQueue RequestAI)-  , requestUIS :: !(Maybe (CliSerQueue RequestUI))+  { responseS  :: CliSerQueue Response+  , requestAIS :: CliSerQueue RequestAI+  , requestUIS :: Maybe (CliSerQueue RequestUI)   }

@@ -15,10 +15,10 @@ import GHC.Generics (Generic)  data RingBuffer a = RingBuffer-  { rbCarrier :: !(Seq.Seq a)-  , rbMaxSize :: !Int-  , rbNext    :: !Int-  , rbLength  :: !Int+  { rbCarrier :: Seq.Seq a+  , rbMaxSize :: Int+  , rbNext    :: Int+  , rbLength  :: Int   }   deriving (Show, Generic) 

@@ -137,13 +137,23 @@   T.hPutStrLn stdout t   hFlush stdout -saveNameCli :: FactionId -> String-saveNameCli side =-  let n = fromEnum side  -- we depend on the numbering hack to number saves-  in (if n > 0-      then "human_" ++ show n-      else "computer_" ++ show (-n))+saveNameCli :: Kind.COps -> FactionId -> String+saveNameCli cops side =+  let gameShortName =+        case T.words $ rtitle $ Kind.stdRuleset $ Kind.corule cops of+          w : _ -> T.unpack w+          _ -> "Game"+      n = fromEnum side  -- we depend on the numbering hack to number saves+  in gameShortName+     ++ (if n > 0+         then ".human_" ++ show n+         else ".computer_" ++ show (-n))      ++ ".sav" -saveNameSer :: String-saveNameSer = "server.sav"+saveNameSer :: Kind.COps -> String+saveNameSer cops =+  let gameShortName =+        case T.words $ rtitle $ Kind.stdRuleset $ Kind.corule cops of+          w : _ -> T.unpack w+          _ -> "Game"+  in gameShortName ++ ".server.sav"

@@ -34,15 +34,15 @@ -- in the client copies of the state. Clients never directly change -- their @State@, but apply atomic actions sent by the server to do so. data State = State-  { _sdungeon    :: !Dungeon      -- ^ remembered dungeon-  , _stotalDepth :: !AbsDepth     -- ^ absolute dungeon depth, for item creation-  , _sactorD     :: !ActorDict    -- ^ remembered actors in the dungeon-  , _sitemD      :: !ItemDict     -- ^ remembered items in the dungeon-  , _sfactionD   :: !FactionDict  -- ^ remembered sides still in game-  , _stime       :: !Time         -- ^ global game time, for UI display only-  , _scops       :: Kind.COps     -- ^ remembered content-  , _shigh       :: !HighScore.ScoreDict  -- ^ high score table-  , _sgameModeId :: !(Kind.Id ModeKind)  -- ^ current game mode+  { _sdungeon    :: Dungeon      -- ^ remembered dungeon+  , _stotalDepth :: AbsDepth     -- ^ absolute dungeon depth, for item creation+  , _sactorD     :: ActorDict    -- ^ remembered actors in the dungeon+  , _sitemD      :: ItemDict     -- ^ remembered items in the dungeon+  , _sfactionD   :: FactionDict  -- ^ remembered sides still in game+  , _stime       :: Time         -- ^ global game time, for UI display only+  , _scops       :: ~Kind.COps   -- ^ remembered content+  , _shigh       :: HighScore.ScoreDict  -- ^ high score table+  , _sgameModeId :: Kind.Id ModeKind     -- ^ current game mode   }   deriving (Show, Eq) @@ -197,5 +197,5 @@     _stime <- get     _shigh <- get     _sgameModeId <- get-    let _scops = assert `failure` "overwritten by recreated cops" `twith` ()+    let _scops = error $ "overwritten by recreated cops" `showFailure` ()     return $! State{..}

@@ -232,7 +232,7 @@   let getTo (TK.OpenTo grp) acc = grp : acc       getTo _ acc = acc   case foldr getTo [] $ TK.tfeature $ okind t of-    [grp] -> fromMaybe (assert `failure` grp) <$> opick grp (const True)+    [grp] -> fromMaybe (error $ "" `showFailure` grp) <$> opick grp (const True)     _ -> return t  closeTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)@@ -240,7 +240,7 @@   let getTo (TK.CloseTo grp) acc = grp : acc       getTo _ acc = acc   case foldr getTo [] $ TK.tfeature $ okind t of-    [grp] -> fromMaybe (assert `failure` grp) <$> opick grp (const True)+    [grp] -> fromMaybe (error $ "" `showFailure` grp) <$> opick grp (const True)     _ -> return t  embeddedItems :: Kind.Ops TileKind -> Kind.Id TileKind -> [GroupName ItemKind]@@ -257,7 +257,7 @@     [] -> return t     groups -> do       grp <- oneOf groups-      fromMaybe (assert `failure` grp) <$> opick grp (const True)+      fromMaybe (error $ "" `showFailure` grp) <$> opick grp (const True)  obscureAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind) obscureAs Kind.Ops{okind, opick} t = do@@ -267,7 +267,7 @@     [] -> return t     groups -> do       grp <- oneOf groups-      fromMaybe (assert `failure` grp) <$> opick grp (const True)+      fromMaybe (error $ "" `showFailure` grp) <$> opick grp (const True)  hideAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind hideAs Kind.Ops{okind, ouniqGroup} t =

@@ -1,14 +1,14 @@ {-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-} -- | Game time and speed. module Game.LambdaHack.Common.Time-  ( Time, timeZero, timeClip, timeTurn, timeEpsilon+  ( Time, timeZero, timeClip, timeTurn, timeSecond, timeEpsilon   , absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate   , timeFit, timeFitUp   , Delta(..), timeShift, timeDeltaToFrom   , timeDeltaSubtract, timeDeltaReverse, timeDeltaScale, timeDeltaPercent   , timeDeltaToDigit, ticksPerMeter   , Speed, toSpeed, fromSpeed-  , speedZero, speedWalk, speedThrust, modifyDamageBySpeed+  , speedZero, speedWalk, speedLimp, speedThrust, modifyDamageBySpeed   , speedScale, timeDeltaDiv, speedAdd, speedNegate   , speedFromWeight, rangeFromSpeedAndLinger   ) where@@ -24,7 +24,7 @@ -- | Game time in ticks. The time dimension. -- One tick is 1 microsecond (one millionth of a second), -- one turn is 0.5 s.-newtype Time = Time Int64+newtype Time = Time {timeTicks :: Int64}   deriving (Show, Eq, Ord, Enum, Bounded, Binary)  -- | One-dimentional vectors. Introduced to tell apart the 2 uses of Time:@@ -64,10 +64,8 @@ turnsInSecond = 2  -- | This many ticks fits in a single second. Do not export,-_ticksInSecond :: Int64-_ticksInSecond =-  let Time ticksInTurn = timeTurn-  in ticksInTurn * turnsInSecond+timeSecond :: Time+timeSecond = Time $ timeTicks timeTurn * turnsInSecond  -- | Absolute time addition, e.g., for summing the total game session time -- from the times of individual games.@@ -124,7 +122,7 @@ {-# INLINE timeDeltaScale #-} timeDeltaScale (Delta (Time t)) s = Delta (Time (t * fromIntegral s)) --- | Take the given percent of the time vector..+-- | Take the given percent of the time vector. timeDeltaPercent :: Delta Time -> Int -> Delta Time {-# INLINE timeDeltaPercent #-} timeDeltaPercent (Delta (Time t)) s =@@ -182,6 +180,11 @@ speedWalk :: Speed speedWalk = Speed $ 2 * sInMs +-- | Limp speed (1 m/s) that suffices to move one tile in two turns.+-- This is the minimal speed for projectiles to fly just one space and drop.+speedLimp :: Speed+speedLimp = Speed sInMs+ -- | Sword thrust speed (10 m/s). Base weapon damages, both melee and ranged, -- are given assuming this speed and ranged damage is modified -- accordingly when projectile speeds differ. Differences in melee@@ -221,7 +224,7 @@ ticksPerMeter :: Speed -> Delta Time {-# INLINE ticksPerMeter #-} ticksPerMeter (Speed v) =-  Delta $ Time $ _ticksInSecond * sInMs `divUp` max minimalSpeed v+  Delta $ Time $ timeTicks timeSecond * sInMs `divUp` max minimalSpeed v  -- | Calculate projectile speed from item weight in grams -- and velocity percent modifier.

@@ -29,8 +29,8 @@ -- and down, so that the (1, 1) vector points to the bottom-right corner -- of the screen. data Vector = Vector-  { vx :: !X-  , vy :: !Y+  { vx :: X+  , vy :: Y   }   deriving (Show, Read, Eq, Ord, Generic) @@ -100,7 +100,7 @@  compassText :: Vector -> Text compassText v = let m = EM.fromList $ zip moves longMoveTexts-                    assFail = assert `failure` "not a unit vector" `twith` v+                    assFail = error $ "not a unit vector" `showFailure` v                 in EM.findWithDefault assFail v m  -- | Vectors of all cardinal direction unit moves, clockwise, starting north.@@ -210,7 +210,7 @@ -- (in the euclidean metric) maximally align with the original vector. normalize :: Double -> Double -> Vector normalize dx dy =-  assert (dx /= 0 || dy /= 0 `blame` "can't normalize zero" `twith` (dx, dy)) $+  assert (dx /= 0 || dy /= 0 `blame` "can't normalize zero" `swith` (dx, dy)) $   let angle :: Double       angle = atan (dy / dx) / (pi / 2)       dxy | angle <= -0.75 && angle >= -1.25 = (0, -1)@@ -218,8 +218,7 @@           | angle <= 0.25  = (1, 0)           | angle <= 0.75  = (1, 1)           | angle <= 1.25  = (0, 1)-          | otherwise = assert `failure` "impossible angle"-                               `twith` (dx, dy, angle)+          | otherwise = error $ "impossible angle" `showFailure` (dx, dy, angle)   in if dx >= 0      then uncurry Vector dxy      else neg $ uncurry Vector dxy@@ -229,7 +228,7 @@   let res = normalize (fromIntegral vx) (fromIntegral vy)   in assert (not (isUnit v) || v == res              `blame` "unit vector gets untrivially normalized"-             `twith` (v, res))+             `swith` (v, res))      res  -- | Given two distinct positions, determine the direction (a unit vector)@@ -240,5 +239,5 @@ -- the two points. towards :: Point -> Point -> Vector towards pos0 pos1 =-  assert (pos0 /= pos1 `blame` "towards self" `twith` (pos0, pos1))+  assert (pos0 /= pos1 `blame` "towards self" `swith` (pos0, pos1))   $ normalizeVector $ pos1 `vectorToFrom` pos0

@@ -20,40 +20,40 @@ -- | Parameters for the generation of dungeon levels. -- Warning: for efficiency, avoid embedded items in any of the common tiles. data CaveKind = CaveKind-  { csymbol         :: !Char         -- ^ a symbol-  , cname           :: !Text         -- ^ short description-  , cfreq           :: !(Freqs CaveKind)  -- ^ frequency within groups-  , cxsize          :: !X            -- ^ X size of the whole cave-  , cysize          :: !Y            -- ^ Y size of the whole cave-  , cgrid           :: !Dice.DiceXY  -- ^ the dimensions of the grid of places-  , cminPlaceSize   :: !Dice.DiceXY  -- ^ minimal size of places; for merging-  , cmaxPlaceSize   :: !Dice.DiceXY  -- ^ maximal size of places-  , cdarkChance     :: !Dice.Dice    -- ^ the chance a place is dark-  , cnightChance    :: !Dice.Dice    -- ^ the chance the cave is dark-  , cauxConnects    :: !Rational     -- ^ a proportion of extra connections-  , cmaxVoid        :: !Rational     -- ^ at most this proportion of rooms void-  , cminStairDist   :: !Int          -- ^ minimal distance between stairs-  , cextraStairs    :: !Dice.Dice    -- ^ extra stairs on top of from above-  , cdoorChance     :: !Chance       -- ^ the chance of a door in an opening-  , copenChance     :: !Chance       -- ^ if there's a door, is it open?-  , chidden         :: !Int          -- ^ if not open, hidden one in n times-  , cactorCoeff     :: !Int          -- ^ the lower, the more monsters spawn-  , cactorFreq      :: !(Freqs ItemKind)  -- ^ actor groups to consider-  , citemNum        :: !Dice.Dice    -- ^ the number of items in the cave-  , citemFreq       :: !(Freqs ItemKind)-                                     -- ^ item groups to consider-  , cplaceFreq      :: !(Freqs PlaceKind)-                                     -- ^ place groups to consider-  , cpassable       :: !Bool         -- ^ are passable default tiles permitted-  , cdefTile        :: !(GroupName TileKind)  -- ^ the default cave tile-  , cdarkCorTile    :: !(GroupName TileKind)  -- ^ the dark cave corridor tile-  , clitCorTile     :: !(GroupName TileKind)  -- ^ the lit cave corridor tile-  , cfillerTile     :: !(GroupName TileKind)  -- ^ the filler wall-  , couterFenceTile :: !(GroupName TileKind)  -- ^ the outer fence wall-  , clegendDarkTile :: !(GroupName TileKind)  -- ^ the dark place plan legend-  , clegendLitTile  :: !(GroupName TileKind)  -- ^ the lit place plan legend-  , cescapeGroup    :: !(Maybe (GroupName PlaceKind))  -- ^ escape, if any-  , cstairFreq      :: !(Freqs PlaceKind)+  { csymbol         :: Char         -- ^ a symbol+  , cname           :: Text         -- ^ short description+  , cfreq           :: Freqs CaveKind  -- ^ frequency within groups+  , cxsize          :: X            -- ^ X size of the whole cave+  , cysize          :: Y            -- ^ Y size of the whole cave+  , cgrid           :: Dice.DiceXY  -- ^ the dimensions of the grid of places+  , cminPlaceSize   :: Dice.DiceXY  -- ^ minimal size of places; for merging+  , cmaxPlaceSize   :: Dice.DiceXY  -- ^ maximal size of places+  , cdarkChance     :: Dice.Dice    -- ^ the chance a place is dark+  , cnightChance    :: Dice.Dice    -- ^ the chance the cave is dark+  , cauxConnects    :: Rational     -- ^ a proportion of extra connections+  , cmaxVoid        :: Rational     -- ^ at most this proportion of rooms void+  , cminStairDist   :: Int          -- ^ minimal distance between stairs+  , cextraStairs    :: Dice.Dice    -- ^ extra stairs on top of from above+  , cdoorChance     :: Chance       -- ^ the chance of a door in an opening+  , copenChance     :: Chance       -- ^ if there's a door, is it open?+  , chidden         :: Int          -- ^ if not open, hidden one in n times+  , cactorCoeff     :: Int          -- ^ the lower, the more monsters spawn+  , cactorFreq      :: Freqs ItemKind  -- ^ actor groups to consider+  , citemNum        :: Dice.Dice    -- ^ the number of items in the cave+  , citemFreq       :: Freqs ItemKind+                                    -- ^ item groups to consider+  , cplaceFreq      :: Freqs PlaceKind+                                    -- ^ place groups to consider+  , cpassable       :: Bool         -- ^ are passable default tiles permitted+  , cdefTile        :: GroupName TileKind  -- ^ the default cave tile+  , cdarkCorTile    :: GroupName TileKind  -- ^ the dark cave corridor tile+  , clitCorTile     :: GroupName TileKind  -- ^ the lit cave corridor tile+  , cfillerTile     :: GroupName TileKind  -- ^ the filler wall+  , couterFenceTile :: GroupName TileKind  -- ^ the outer fence wall+  , clegendDarkTile :: GroupName TileKind  -- ^ the dark place plan legend+  , clegendLitTile  :: GroupName TileKind  -- ^ the lit place plan legend+  , cescapeGroup    :: Maybe (GroupName PlaceKind)  -- ^ escape, if any+  , cstairFreq      :: Freqs PlaceKind       -- ^ place groups to consider for stairs; in this case the rarity       --   of items in the group does not affect group choice   }

@@ -29,21 +29,21 @@  -- | Item properties that are fixed for a given kind of items. data ItemKind = ItemKind-  { isymbol  :: !Char              -- ^ map symbol-  , iname    :: !Text              -- ^ generic name-  , ifreq    :: !(Freqs ItemKind)  -- ^ frequency within groups-  , iflavour :: ![Flavour]         -- ^ possible flavours-  , icount   :: !Dice.Dice         -- ^ created in that quantity-  , irarity  :: !Rarity            -- ^ rarity on given depths-  , iverbHit :: !MU.Part           -- ^ the verb&noun for applying and hit-  , iweight  :: !Int               -- ^ weight in grams-  , idamage  :: ![(Int, Dice.Dice)]  -- ^ frequency of basic impact damage-  , iaspects :: ![Aspect]          -- ^ keep the aspect continuously-  , ieffects :: ![Effect]          -- ^ cause the effect when triggered-  , ifeature :: ![Feature]         -- ^ public properties-  , idesc    :: !Text              -- ^ description-  , ikit     :: ![(GroupName ItemKind, CStore)]-                                   -- ^ accompanying organs and items+  { isymbol  :: Char              -- ^ map symbol+  , iname    :: Text              -- ^ generic name+  , ifreq    :: Freqs ItemKind    -- ^ frequency within groups+  , iflavour :: [Flavour]         -- ^ possible flavours+  , icount   :: Dice.Dice         -- ^ created in that quantity+  , irarity  :: Rarity            -- ^ rarity on given depths+  , iverbHit :: MU.Part           -- ^ the verb&noun for applying and hit+  , iweight  :: Int               -- ^ weight in grams+  , idamage  :: [(Int, Dice.Dice)]  -- ^ frequency of basic impact damage+  , iaspects :: [Aspect]          -- ^ keep the aspect continuously+  , ieffects :: [Effect]          -- ^ cause the effect when triggered+  , ifeature :: [Feature]         -- ^ public properties+  , idesc    :: Text              -- ^ description+  , ikit     :: [(GroupName ItemKind, CStore)]+                                  -- ^ accompanying organs and items   }   deriving Show  -- No Eq and Ord to make extending it logically sound @@ -52,43 +52,43 @@ -- are possible. Constructors are sorted vs increasing impact/danger. data Effect =     -- Ordinary effects.-    ELabel !Text        -- ^ secret (learned as effect) label of the item-  | EqpSlot !EqpSlot    -- ^ AI and UI flag that leaks item properties-  | Burn !Dice.Dice-  | Explode !(GroupName ItemKind)+    ELabel Text        -- ^ secret (learned as effect) label of the item+  | EqpSlot EqpSlot    -- ^ AI and UI flag that leaks item properties+  | Burn Dice.Dice+  | Explode (GroupName ItemKind)       -- ^ explode, producing this group of blasts-  | RefillHP !Int-  | RefillCalm !Int+  | RefillHP Int+  | RefillCalm Int   | Dominate   | Impress-  | Summon !(GroupName ItemKind) !Dice.Dice-  | Ascend !Bool+  | Summon (GroupName ItemKind) Dice.Dice+  | Ascend Bool   | Escape-  | Paralyze !Dice.Dice  -- ^ expressed in game clips-  | InsertMove !Dice.Dice  -- ^ expressed in game turns-  | Teleport !Dice.Dice-  | CreateItem !CStore !(GroupName ItemKind) !TimerDice+  | Paralyze Dice.Dice  -- ^ expressed in game clips+  | InsertMove Dice.Dice  -- ^ expressed in game turns+  | Teleport Dice.Dice+  | CreateItem CStore (GroupName ItemKind) TimerDice       -- ^ create an item of the group and insert into the store with the given       --   random timer-  | DropItem !Int !Int !CStore !(GroupName ItemKind)+  | DropItem Int Int CStore (GroupName ItemKind)   | PolyItem   | Identify-  | Detect !Int-  | DetectActor !Int-  | DetectItem !Int-  | DetectExit !Int-  | DetectHidden !Int-  | SendFlying !ThrowMod-  | PushActor !ThrowMod-  | PullActor !ThrowMod+  | Detect Int+  | DetectActor Int+  | DetectItem Int+  | DetectExit Int+  | DetectHidden Int+  | SendFlying ThrowMod+  | PushActor ThrowMod+  | PullActor ThrowMod   | DropBestWeapon-  | ActivateInv !Char   -- ^ symbol @' '@ means all+  | ActivateInv Char   -- ^ symbol @' '@ means all   | ApplyPerfume     -- Exotic effects follow.-  | OneOf ![Effect]-  | OnSmash !Effect     -- ^ trigger if item smashed (not applied nor meleed)-  | Recharging !Effect  -- ^ this effect inactive until timeout passes-  | Temporary !Text+  | OneOf [Effect]+  | OnSmash Effect     -- ^ trigger if item smashed (not applied nor meleed)+  | Recharging Effect  -- ^ this effect inactive until timeout passes+  | Temporary Text       -- ^ the item is temporary, vanishes at even void Periodic activation,       --   unless Durable and not Fragile, and shows message with       --   this verb at last copy activation or at each activation@@ -121,8 +121,8 @@  data TimerDice =     TimerNone-  | TimerGameTurn !Dice.Dice-  | TimerActorTurn !Dice.Dice+  | TimerGameTurn Dice.Dice+  | TimerActorTurn Dice.Dice   deriving (Eq, Ord, Generic)  instance Show TimerDice where@@ -137,27 +137,27 @@ -- | Aspects of items. Those that are named @Add*@ are additive -- (starting at 0) for all items wielded by an actor and they affect the actor. data Aspect =-    Timeout !Dice.Dice         -- ^ some effects disabled until item recharges;-                               --   expressed in game turns-  | AddHurtMelee !Dice.Dice    -- ^ percentage damage bonus in melee-  | AddArmorMelee !Dice.Dice   -- ^ percentage armor bonus against melee-  | AddArmorRanged !Dice.Dice  -- ^ percentage armor bonus against ranged-  | AddMaxHP !Dice.Dice        -- ^ maximal hp-  | AddMaxCalm !Dice.Dice      -- ^ maximal calm-  | AddSpeed !Dice.Dice        -- ^ speed in m/10s (not of a projectile!)-  | AddSight !Dice.Dice        -- ^ FOV radius, where 1 means a single tile-  | AddSmell !Dice.Dice        -- ^ smell radius, where 1 means a single tile-  | AddShine !Dice.Dice        -- ^ shine radius, where 1 means a single tile-  | AddNocto !Dice.Dice        -- ^ noctovision radius, where 1 is single tile-  | AddAggression !Dice.Dice   -- ^ aggression, especially closing in for melee-  | AddAbility !Ability.Ability !Dice.Dice  -- ^ bonus to an ability+    Timeout Dice.Dice         -- ^ some effects disabled until item recharges;+                              --   expressed in game turns+  | AddHurtMelee Dice.Dice    -- ^ percentage damage bonus in melee+  | AddArmorMelee Dice.Dice   -- ^ percentage armor bonus against melee+  | AddArmorRanged Dice.Dice  -- ^ percentage armor bonus against ranged+  | AddMaxHP Dice.Dice        -- ^ maximal hp+  | AddMaxCalm Dice.Dice      -- ^ maximal calm+  | AddSpeed Dice.Dice        -- ^ speed in m/10s (not of a projectile)+  | AddSight Dice.Dice        -- ^ FOV radius, where 1 means a single tile+  | AddSmell Dice.Dice        -- ^ smell radius, where 1 means a single tile+  | AddShine Dice.Dice        -- ^ shine radius, where 1 means a single tile+  | AddNocto Dice.Dice        -- ^ noctovision radius, where 1 is single tile+  | AddAggression Dice.Dice   -- ^ aggression, especially closing in for melee+  | AddAbility Ability.Ability Dice.Dice  -- ^ bonus to an ability   deriving (Show, Eq, Ord, Generic)  -- | Parameters modifying a throw of a projectile or flight of pushed actor. -- Not additive and don't start at 0. data ThrowMod = ThrowMod-  { throwVelocity :: !Int  -- ^ fly with this percentage of base throw speed-  , throwLinger   :: !Int  -- ^ fly for this percentage of 2 turns+  { throwVelocity :: Int  -- ^ fly with this percentage of base throw speed+  , throwLinger   :: Int  -- ^ fly for this percentage of 2 turns   }   deriving (Show, Eq, Ord, Generic) @@ -169,7 +169,7 @@     Fragile            -- ^ drop and break at target tile, even if no hit   | Lobable            -- ^ drop at target tile, even if no hit   | Durable            -- ^ don't break even when hitting or applying-  | ToThrow !ThrowMod  -- ^ parameters modifying a throw+  | ToThrow ThrowMod   -- ^ parameters modifying a throw   | Identified         -- ^ the item starts identified   | Applicable         -- ^ AI and UI flag: consider applying   | Equipable          -- ^ AI and UI flag: consider equipping (independent of@@ -177,7 +177,7 @@   | Meleeable          -- ^ AI and UI flag: consider meleeing with   | Precious           -- ^ AI and UI flag: don't risk identifying by use                        --   also, can't throw or apply if not calm enough;-  | Tactic !Tactic     -- ^ overrides actor's tactic+  | Tactic Tactic      -- ^ overrides actor's tactic   deriving (Show, Eq, Ord, Generic)  data EqpSlot =@@ -256,6 +256,7 @@   [ "iname longer than 23" | T.length iname > 23 ]   ++ [ "icount < 0" | icount < 0 ]   ++ validateRarity irarity+  ++ validateDamage idamage   -- Reject duplicate Timeout, because it's not additive.   ++ (let timeoutAspect :: Aspect -> Bool           timeoutAspect Timeout{} = True@@ -275,7 +276,7 @@          ++ [ "EqpSlot specified but not Equipable nor Meleeable"             | length ts > 0 && Equipable `notElem` ifeature                             && Meleeable `notElem` ifeature ])-  ++ ["Reduntand Equipable or Meleeable" | Equipable `elem` ifeature+  ++ ["Redundant Equipable or Meleeable" | Equipable `elem` ifeature                                            && Meleeable `elem` ifeature]   ++ (let f :: Effect -> Bool           f Temporary{} = True@@ -310,6 +311,12 @@ validateDups ItemKind{..} feat =   let ts = filter (== feat) ifeature   in ["more than one" <+> tshow feat <+> "specification" | length ts > 1]++validateDamage :: [(Int, Dice.Dice)] -> [Text]+validateDamage = concatMap validateDice+ where+  validateDice (_, dice) = [ "potentially negative dice:" <+> tshow dice+                           | Dice.minDice dice < 0]  -- | Validate all item kinds. validateAllItemKind :: [ItemKind] -> [Text]

@@ -25,12 +25,12 @@  -- | Game mode specification. data ModeKind = ModeKind-  { msymbol :: !Char    -- ^ a symbol-  , mname   :: !Text    -- ^ short description-  , mfreq   :: !(Freqs ModeKind)  -- ^ frequency within groups-  , mroster :: !Roster  -- ^ players taking part in the game-  , mcaves  :: !Caves   -- ^ arena of the game-  , mdesc   :: !Text    -- ^ description+  { msymbol :: Char    -- ^ a symbol+  , mname   :: Text    -- ^ short description+  , mfreq   :: Freqs ModeKind  -- ^ frequency within groups+  , mroster :: Roster  -- ^ players taking part in the game+  , mcaves  :: Caves   -- ^ arena of the game+  , mdesc   :: Text    -- ^ description   }   deriving Show @@ -41,11 +41,11 @@  -- | The specification of players for the game mode. data Roster = Roster-  { rosterList  :: ![(Player, [(Int, Dice.Dice, GroupName ItemKind)])]+  { rosterList  :: [(Player, [(Int, Dice.Dice, GroupName ItemKind)])]       -- ^ players in the particular team and levels, numbers and groups       --   of their initial members-  , rosterEnemy :: ![(Text, Text)]  -- ^ the initial enmity matrix-  , rosterAlly  :: ![(Text, Text)]  -- ^ the initial aliance matrix+  , rosterEnemy :: [(Text, Text)]  -- ^ the initial enmity matrix+  , rosterAlly  :: [(Text, Text)]  -- ^ the initial aliance matrix   }   deriving (Show, Eq) @@ -75,22 +75,22 @@  -- | Properties of a particular player. data Player = Player-  { fname        :: !Text        -- ^ name of the player-  , fgroups      :: ![GroupName ItemKind]+  { fname        :: Text        -- ^ name of the player+  , fgroups      :: [GroupName ItemKind]                                  -- ^ names of actor groups that may naturally                                  --   fall under player's control, e.g., upon                                  --   spawning or summoning-  , fskillsOther :: !Skills      -- ^ fixed skill modifiers to the non-leader+  , fskillsOther :: Skills      -- ^ fixed skill modifiers to the non-leader                                  --   actors; also summed with skills implied                                  --   by ftactic (which is not fixed)-  , fcanEscape   :: !Bool        -- ^ the player can escape the dungeon-  , fneverEmpty  :: !Bool        -- ^ the faction declared killed if no actors-  , fhiCondPoly  :: !HiCondPoly  -- ^ score polynomial for the player-  , fhasGender   :: !Bool        -- ^ whether actors have gender-  , ftactic      :: !Tactic      -- ^ non-leaders behave according to this+  , fcanEscape   :: Bool        -- ^ the player can escape the dungeon+  , fneverEmpty  :: Bool        -- ^ the faction declared killed if no actors+  , fhiCondPoly  :: HiCondPoly  -- ^ score polynomial for the player+  , fhasGender   :: Bool        -- ^ whether actors have gender+  , ftactic      :: Tactic      -- ^ non-leaders behave according to this                                  --   tactic; can be changed during the game-  , fleaderMode  :: !LeaderMode  -- ^ the mode of switching the leader-  , fhasUI       :: !Bool        -- ^ does the faction have a UI client+  , fleaderMode  :: LeaderMode  -- ^ the mode of switching the leader+  , fhasUI       :: Bool        -- ^ does the faction have a UI client                                  --   (for control or passive observation)   }   deriving (Show, Eq, Ord, Generic)@@ -107,7 +107,7 @@ instance Binary LeaderMode  data AutoLeader = AutoLeader-  { autoDungeon :: !Bool+  { autoDungeon :: Bool       -- ^ leader switching between levels is automatically done by the server       --   and client is not permitted to change to leaders from other levels       --   (the frequency of leader level switching done by the server@@ -116,7 +116,7 @@       --   of the automatic switching, e.g., when the old leader dies       --   and no other actor of the faction resides on his level,       --   but the client (particularly UI) is expected to do changes as well-  , autoLevel   :: !Bool+  , autoLevel   :: Bool       -- ^ client is discouraged from leader switching (e.g., because       --   non-leader actors have the same skills as leader);       --   server is guaranteed to switch leader within a level very rarely,

@@ -15,14 +15,14 @@  -- | Parameters for the generation of small areas within a dungeon level. data PlaceKind = PlaceKind-  { psymbol   :: !Char          -- ^ a symbol-  , pname     :: !Text          -- ^ short description-  , pfreq     :: !(Freqs PlaceKind)  -- ^ frequency within groups-  , prarity   :: !Rarity        -- ^ rarity on given depths-  , pcover    :: !Cover         -- ^ how to fill whole place based on the corner-  , pfence    :: !Fence         -- ^ whether to fence place with solid border-  , ptopLeft  :: ![Text]        -- ^ plan of the top-left corner of the place-  , poverride :: ![(Char, GroupName TileKind)]  -- ^ legend override+  { psymbol   :: Char          -- ^ a symbol+  , pname     :: Text          -- ^ short description+  , pfreq     :: Freqs PlaceKind  -- ^ frequency within groups+  , prarity   :: Rarity        -- ^ rarity on given depths+  , pcover    :: Cover         -- ^ how to fill whole place based on the corner+  , pfence    :: Fence         -- ^ whether to fence place with solid border+  , ptopLeft  :: [Text]        -- ^ plan of the top-left corner of the place+  , poverride :: [(Char, GroupName TileKind)]  -- ^ legend override   }   deriving Show  -- No Eq and Ord to make extending it logically sound 

@@ -21,21 +21,21 @@ -- and then @RuleKind@ will become just a starting template, analogously -- as for the other content. data RuleKind = RuleKind-  { rsymbol         :: !Char      -- ^ a symbol-  , rname           :: !Text      -- ^ short description-  , rfreq           :: !(Freqs RuleKind)  -- ^ frequency within groups-  , rtitle          :: !Text      -- ^ title of the game (not lib)-  , rfontDir        :: !FilePath  -- ^ font directory for the game (not lib)-  , rexeVersion     :: !Version   -- ^ version of the game-  , rcfgUIName      :: !FilePath  -- ^ name of the UI config file-  , rcfgUIDefault   :: !String    -- ^ the default UI settings config file-  , rmainMenuArt    :: !Text      -- ^ the ASCII art for the Main Menu-  , rfirstDeathEnds :: !Bool      -- ^ whether first non-spawner actor death+  { rsymbol         :: Char      -- ^ a symbol+  , rname           :: Text      -- ^ short description+  , rfreq           :: Freqs RuleKind  -- ^ frequency within groups+  , rtitle          :: Text      -- ^ title of the game (not lib)+  , rfontDir        :: FilePath  -- ^ font directory for the game (not lib)+  , rexeVersion     :: Version   -- ^ version of the game+  , rcfgUIName      :: FilePath  -- ^ name of the UI config file+  , rcfgUIDefault   :: String    -- ^ the default UI settings config file+  , rmainMenuArt    :: Text      -- ^ the ASCII art for the Main Menu+  , rfirstDeathEnds :: Bool      -- ^ whether first non-spawner actor death                                   --   ends the game-  , rwriteSaveClips :: !Int       -- ^ game is saved that often-  , rleadLevelClips :: !Int       -- ^ server switches leader level that often-  , rscoresFile     :: !FilePath  -- ^ name of the scores file-  , rnearby         :: !Int       -- ^ what distance between actors is 'nearby'+  , rwriteSaveClips :: Int       -- ^ game is saved that often+  , rleadLevelClips :: Int       -- ^ server switches leader level that often+  , rscoresFile     :: FilePath  -- ^ name of the scores file+  , rnearby         :: Int       -- ^ what distance between actors is 'nearby'   }  -- | A dummy instance of the 'Show' class, to satisfy general requirments

@@ -37,36 +37,36 @@ -- Tile kind for unknown space has the minimal @KindOps.Id@ index. -- The @talter@ for unknown space is @1@ and no other tile kind has that value. data TileKind = TileKind-  { tsymbol  :: !Char         -- ^ map symbol-  , tname    :: !Text         -- ^ short description-  , tfreq    :: !(Freqs TileKind)  -- ^ frequency within groups-  , tcolor   :: !Color        -- ^ map color-  , tcolor2  :: !Color        -- ^ map color when not in FOV-  , talter   :: !Word8        -- ^ minimal skill needed to alter the tile-  , tfeature :: ![Feature]    -- ^ properties+  { tsymbol  :: Char         -- ^ map symbol+  , tname    :: Text         -- ^ short description+  , tfreq    :: Freqs TileKind  -- ^ frequency within groups+  , tcolor   :: Color        -- ^ map color+  , tcolor2  :: Color        -- ^ map color when not in FOV+  , talter   :: Word8        -- ^ minimal skill needed to alter the tile+  , tfeature :: [Feature]    -- ^ properties   }   deriving Show  -- No Eq and Ord to make extending it logically sound  -- | All possible terrain tile features. data Feature =-    Embed !(GroupName ItemKind)+    Embed (GroupName ItemKind)       -- ^ initially an item of this group is embedded;       --   we assume the item has effects and is supposed to be triggered-  | OpenTo !(GroupName TileKind)+  | OpenTo (GroupName TileKind)       -- ^ goes from a closed to (randomly closed or) open tile when altered-  | CloseTo !(GroupName TileKind)+  | CloseTo (GroupName TileKind)       -- ^ goes from an open to (randomly opened or) closed tile when altered-  | ChangeTo !(GroupName TileKind)+  | ChangeTo (GroupName TileKind)       -- ^ alters tile, but does not change walkability-  | HideAs !(GroupName TileKind)+  | HideAs (GroupName TileKind)       -- ^ when hidden, looks as the unique tile of the group    -- The following three are only used in dungeon generation.-  | BuildAs !(GroupName TileKind)+  | BuildAs (GroupName TileKind)       -- ^ when generating, may be transformed to the unique tile of the group-  | RevealAs !(GroupName TileKind)+  | RevealAs (GroupName TileKind)       -- ^ when generating in opening, can be revealed to belong to the group-  | ObscureAs !(GroupName TileKind)+  | ObscureAs (GroupName TileKind)       -- ^ when generating in solid wall, can be revealed to belong to the group    | Walkable             -- ^ actors can walk through@@ -95,21 +95,21 @@ instance NFData Feature  data TileSpeedup = TileSpeedup-  { isClearTab        :: !(Tab Bool)-  , isLitTab          :: !(Tab Bool)-  , isWalkableTab     :: !(Tab Bool)-  , isDoorTab         :: !(Tab Bool)-  , isChangableTab    :: !(Tab Bool)-  , isSuspectTab      :: !(Tab Bool)-  , isHideAsTab       :: !(Tab Bool)-  , consideredByAITab :: !(Tab Bool)-  , isOftenItemTab    :: !(Tab Bool)-  , isOftenActorTab   :: !(Tab Bool)-  , isNoItemTab       :: !(Tab Bool)-  , isNoActorTab      :: !(Tab Bool)-  , isEasyOpenTab     :: !(Tab Bool)-  , alterMinSkillTab  :: !(Tab Word8)-  , alterMinWalkTab   :: !(Tab Word8)+  { isClearTab        :: Tab Bool+  , isLitTab          :: Tab Bool+  , isWalkableTab     :: Tab Bool+  , isDoorTab         :: Tab Bool+  , isChangableTab    :: Tab Bool+  , isSuspectTab      :: Tab Bool+  , isHideAsTab       :: Tab Bool+  , consideredByAITab :: Tab Bool+  , isOftenItemTab    :: Tab Bool+  , isOftenActorTab   :: Tab Bool+  , isNoItemTab       :: Tab Bool+  , isNoActorTab      :: Tab Bool+  , isEasyOpenTab     :: Tab Bool+  , alterMinSkillTab  :: Tab Word8+  , alterMinWalkTab   :: Tab Word8   }  -- Vectors of booleans can be slower than arrays, because they are not packed,@@ -210,7 +210,7 @@       mapVis :: (TileKind -> Color)              -> M.Map (Char, Color) [(TileKind, IS.IntSet)]       mapVis f = M.fromListWith (++) $ listVis f-      isConfused [] =  assert `failure` lt+      isConfused [] = error $ "isConfused" `showFailure` lt       isConfused [_] = False       isConfused (hd : tl) =         any ((Indistinct `notElem`) . tfeature . fst) (hd : tl)

@@ -19,9 +19,9 @@ import qualified Control.Monad.IO.Class as IO import Control.Monad.Trans.State.Strict hiding (State) import GHC.Generics (Generic)-import System.FilePath  import Game.LambdaHack.Atomic+import Game.LambdaHack.Client import Game.LambdaHack.Client.HandleResponseM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State@@ -35,12 +35,12 @@ import Game.LambdaHack.Common.State  data CliState = CliState-  { cliState   :: !State              -- ^ current global state-  , cliClient  :: !StateClient        -- ^ current client state-  , cliSession :: !(Maybe SessionUI)  -- ^ UI state, empty for AI clients-  , cliDict    :: !ChanServer         -- ^ this client connection information-  , cliToSave  :: !(Save.ChanSave (State, StateClient, Maybe SessionUI))-                                      -- ^ connection to the save thread+  { cliState   :: State            -- ^ current global state+  , cliClient  :: StateClient      -- ^ current client state+  , cliSession :: Maybe SessionUI  -- ^ UI state, empty for AI clients+  , cliDict    :: ChanServer       -- ^ this client connection information+  , cliToSave  :: Save.ChanSave (State, StateClient, Maybe SessionUI)+                                   -- ^ connection to the save thread   }   deriving Generic @@ -129,15 +129,15 @@  -- | Init the client, then run an action, with a given session, -- state and history, in the @IO@ monad.-executorCli :: CliImplementation ()-            -> Maybe SessionUI+executorCli :: KeyKind -> Config -> DebugModeCli             -> Kind.COps+            -> Maybe SessionUI             -> FactionId             -> ChanServer             -> IO ()-executorCli m cliSession cops fid cliDict =+executorCli copsClient sconfig sdebugMode cops cliSession fid cliDict =   let stateToFileName (_, cli, _) =-        ssavePrefixCli (sdebugCli cli) <.> Save.saveNameCli (sside cli)+        ssavePrefixCli (sdebugCli cli) <> Save.saveNameCli cops (sside cli)       totalState cliToSave = CliState         { cliState = emptyState cops         , cliClient = emptyStateClient fid@@ -145,5 +145,6 @@         , cliToSave         , cliSession         }+      m = loopCli copsClient sconfig sdebugMode       exe = evalStateT (runCliImplementation m) . totalState   in Save.wrapInSaves cops stateToFileName exe