From 15e1fbc0606dbc9cb72bb06c67d08bfd49d3e853 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Fri, 10 Dec 2021 02:56:14 +0000
Subject: [PATCH] Fix space leak when assigning targeted creature

---
 src/Dodge/Creature.hs                 |  2 +-
 src/Dodge/Creature/Impulse.hs         | 22 +++++++++++++---------
 src/Dodge/Creature/Impulse/UseItem.hs |  9 +++++----
 src/Dodge/Creature/Perception.hs      |  7 +++++++
 src/Dodge/Creature/ReaderUpdate.hs    |  3 ++-
 src/Dodge/Creature/SentinelAI.hs      |  3 ++-
 src/Dodge/Creature/State.hs           |  5 +++--
 7 files changed, 33 insertions(+), 18 deletions(-)

diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs
index 087ba3684..631cf1430 100644
--- a/src/Dodge/Creature.hs
+++ b/src/Dodge/Creature.hs
@@ -69,7 +69,7 @@ spawnerCrit = defaultCreature
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
     { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate' $ impulsiveAI' $
+    , _crUpdate = stateUpdate' $ impulsiveAI $
         sentinelFireType (const shootTillEmpty)
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs
index 25f8a15d3..f00dd05ea 100644
--- a/src/Dodge/Creature/Impulse.hs
+++ b/src/Dodge/Creature/Impulse.hs
@@ -1,7 +1,7 @@
 module Dodge.Creature.Impulse
     ( impulsiveAIR
+--    , impulsiveAI
     , impulsiveAI
-    , impulsiveAI'
     ) where
 import Dodge.Data
 import Dodge.Creature.Vocalization
@@ -15,6 +15,7 @@ import System.Random
 import Control.Lens
 import Control.Monad.Reader
 import Data.Bifunctor
+--import Data.Maybe
 
 impulsiveAIR
     :: (Creature -> Reader World Creature)
@@ -23,17 +24,17 @@ impulsiveAIR
     -> (World -> World , Maybe Creature)
 impulsiveAIR impf cr w = second Just $ followImpulses w . ($ w) . runReader $ impf cr
 
+--impulsiveAI :: (World -> Creature -> Creature)
+--    -> Creature
+--    -> World
+--    -> (World -> World , Maybe Creature)
+--impulsiveAI impf cr w = second Just $ followImpulses w $ impf w cr
+
 impulsiveAI :: (World -> Creature -> Creature)
-    -> Creature
-    -> World
-    -> (World -> World , Maybe Creature)
-impulsiveAI impf cr w = second Just $ followImpulses w $ impf w cr
-
-impulsiveAI' :: (World -> Creature -> Creature)
     -> Creature
     -> World
     -> (World -> World , Creature)
-impulsiveAI' impf cr w = followImpulses w $ impf w cr
+impulsiveAI impf cr w = followImpulses w $ impf w cr
 
 followImpulses :: World -> Creature -> (World -> World, Creature)
 followImpulses w cr = foldr 
@@ -70,6 +71,10 @@ followImpulse cr w imp = case imp of
     ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (f tcr)
         _ -> (id,cr)
+--    ImpulseUseTarget f -> fromMaybe (id,cr) $ do
+--        cid <- cr ^? crIntention . targetCr . _Just
+--        tcr <- w ^? creatures . ix cid
+--        return $ followImpulse cr w (f tcr)
     ImpulseUseAheadPos f -> followImpulse cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     MvForward -> (id, crMvForward speed cr)
     MvTurnToward p -> (id, creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr)
@@ -86,4 +91,3 @@ followImpulse cr w imp = case imp of
     hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
         . soundStart (CrSound cid) cpos hitS Nothing
     addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams 
-
diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs
index c9281f98e..b1021b889 100644
--- a/src/Dodge/Creature/Impulse/UseItem.hs
+++ b/src/Dodge/Creature/Impulse/UseItem.hs
@@ -8,7 +8,7 @@ import Dodge.Data
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
---import Data.Maybe
+import Data.Maybe
 
 useItem :: Int -> World -> World
 useItem cid w = itemEffect cr it w
@@ -17,9 +17,10 @@ useItem cid w = itemEffect cr it w
     it = _crInv cr IM.! _crInvSel cr
 
 tryUseItem :: Creature -> World -> World
-tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
-    Just cr -> itemEffect cr (_crInv cr IM.! _crInvSel cr) w
-    Nothing -> w
+tryUseItem cr' w = fromMaybe w $ do
+    cr <- w ^? creatures . ix (_crID cr')
+    it <- cr ^? crInv . ix (_crInvSel cr)
+    return $ itemEffect cr it w
 
 itemEffect :: Creature -> Item -> World -> World
 itemEffect cr it w = case it ^? itUse of
diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs
index d261e269b..2f555579c 100644
--- a/src/Dodge/Creature/Perception.hs
+++ b/src/Dodge/Creature/Perception.hs
@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Creature.Perception
     ( perceptionUpdate
+    , perceptionUp
     , perceptionUpdate'
     , newSounds
     )
@@ -36,6 +37,12 @@ perceptionUpdate'
     -> Creature
     -> Creature
 perceptionUpdate' is w cr = rememberSounds' w $ basicAwarenessUpdate' $ basicAttentionUpdate' is w cr 
+--perceptionUpdate' is w cr = basicAwarenessUpdate' $ basicAttentionUpdate' is w cr 
+
+perceptionUp :: Int -> World -> Creature -> Creature
+perceptionUp i w cr | canSee i (_crID cr) w = cr & crPerception . crAwarenessLevel . at i ?~ Cognizant 100
+    | otherwise = cr & crPerception . crAwarenessLevel . at i .~ Nothing
+    
 
 {- | Update a creatures awareness based upon the creatures' current direction
  of attention -}
diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs
index 5ac4a4ea6..9f29322aa 100644
--- a/src/Dodge/Creature/ReaderUpdate.hs
+++ b/src/Dodge/Creature/ReaderUpdate.hs
@@ -201,5 +201,6 @@ targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenes
 
 targetYouWhenCognizant :: World -> Creature -> Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of
-    Just (Cognizant _)  -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
+-- so this caused a space leak: be careful with ?~
+    Just (Cognizant _)  -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
     _                   -> cr & crIntention . targetCr .~ Nothing
diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs
index 6334a4baf..47add5681 100644
--- a/src/Dodge/Creature/SentinelAI.hs
+++ b/src/Dodge/Creature/SentinelAI.hs
@@ -63,7 +63,8 @@ sentinelFireType f = chainCreatureUpdatesLR
         )
       , (crAwayFromPost, goToPostStrat)
       ] 
-    , Left $ perceptionUpdate' [0]
+--    , Left $ perceptionUpdate' [0]
+    , Left $ perceptionUp 0
     , Right doStrategyActions
     , Right reloadOverride
     , Left targetYouWhenCognizant
diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs
index 4f01305a9..abeb561bd 100644
--- a/src/Dodge/Creature/State.hs
+++ b/src/Dodge/Creature/State.hs
@@ -46,7 +46,8 @@ stateUpdate :: CRUpdate -> Creature -> World -> World
 stateUpdate f cr w = let (fw,mcr) = stateUpdateDamage doDamage f cr w
     in fw $ w & creatures . at (_crID cr) .~ mcr
 
-stateUpdate' :: CRUpdate' -> Creature -> World -> World
+stateUpdate' :: (Creature -> World -> (World -> World, Creature)) 
+    -> Creature -> World -> World
 stateUpdate' f cr w = let (fw,mcr) = stateUpdateDamage' doDamage f cr w
     in fw $ w & creatures . at (_crID cr) .~ mcr
 
@@ -73,7 +74,7 @@ stateUpdateDamage' :: (Creature -> Creature) -> CRUpdate' -> CRUpdate
 stateUpdateDamage' damageupdate u cr w = case u (updateMovement cr) w of
     (f, upcr) -> 
         ( invSideEff upcr . movementSideEff cr . deathEff . f
-        , (stepReloading . damageupdate) <$> crOrCorpse upcr
+        , stepReloading . damageupdate <$> crOrCorpse upcr
         )
   where   
     crOrCorpse cr'