Move toward diagnosing state update leak

src/Dodge/Creature/ChaseCrit.hs

@@ -34,13 +34,14 @@ smallChaseCrit = chaseCrit
     }
 chaseCrit :: Creature
 chaseCrit = defaultCreature
-    { _crUpdate = stateUpdate $ impulsiveAIR $ 
+    { _crUpdate = stateUpdate $ --dummyUpdate
-        doStrategyActionsR >=>
+        impulsiveAIR $ 
-        performActionsR >=>
+        --doStrategyActionsR >=>
-        overrideMeleeCloseTargetR >=>
+        --performActionsR >=>
-        chaseTargetR targetYouLOS >=>
+        --overrideMeleeCloseTargetR >=>
-        basicPerceptionUpdateR [0] >=>
+        --chaseTargetR targetYouLOS >=>
-        targetYouWhenCognizantR >=>
+        --basicPerceptionUpdateR [0] >=>
+        --targetYouWhenCognizantR >=>
         return . (crMeleeCooldown . _Just %~ max 0 . subtract 1)
     , _crHP = 300
     , _crPict = basicCrPict green

src/Dodge/Creature/Inanimate.hs

@@ -14,7 +14,7 @@ import Dodge.Creature.State
 import Dodge.LightSources
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.Sound
-import Dodge.Creature.Update hiding (CRUpdate)
+import Dodge.Creature.Update
 import Picture
 import qualified IntMapHelp as IM
 import Geometry
@@ -25,6 +25,7 @@ import Polyhedra
 import Control.Lens
 import qualified Control.Foldl as L
 --import qualified Data.Vector.Fusion.Stream.Monadic as VS
+import Data.Monoid
 
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
@@ -61,7 +62,7 @@ polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
 polyToTriFold _ = []
 
 initialiseLamp :: Float -> CRUpdate
-initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i)
+initialiseLamp h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
   where
     i = _crID cr
     addLS = over lightSources (IM.insert i (lightAt (V3 x y h) i))

src/Dodge/Creature/Rationality.hs

@@ -15,6 +15,7 @@ import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
 import Control.Monad.Reader
+import Data.Monoid
 
 composeInternalAIs 
     :: [World -> Creature -> Creature]
@@ -25,36 +26,30 @@ composeInternalAIs fs w c = foldr ($ w) c fs
 
 impulsiveAIR
     :: (Creature -> Reader World Creature)
-    -> World
-    -> (World -> World, StdGen)
     -> Creature
-    -> ((World -> World, StdGen) , Maybe Creature)
+    -> World
-impulsiveAIR impf w (f,g) = followImpulses w (f,g') . ($ w) . runReader . impf
+    -> (Endo World , Maybe Creature)
-  where
+impulsiveAIR impf cr w = followImpulses w . ($ w) . runReader $ impf cr
-    (g',_) = split g
 
-impulsiveAI 
+--impulsiveAI 
-    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
+--    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
-    -> World 
+--    -> World 
-    -> (World -> World,StdGen) 
+--    -> (World -> World,StdGen) 
-    -> Creature 
+--    -> Creature 
-    -> ((World -> World,StdGen), Maybe Creature)
+--    -> ((World -> World,StdGen), Maybe Creature)
-impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
+--impulsiveAI impF w (f,g) = followImpulses w (f,g) . impF w
 
 -- needs cleanup
 followImpulses 
     :: World 
-    -> (World -> World,StdGen) 
     -> Creature 
-    -> ((World -> World,StdGen), Maybe Creature)
+    -> (Endo World, Maybe Creature)
-followImpulses w (f,g) cr
+followImpulses w cr
-    = (\(f''' ,cr') -> ((f''',g'),Just cr'))
+    = (\(f''' ,cr') -> (Endo f''',Just cr'))
     $ foldr 
-        (\imp (f' , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f', cr''))
+        (\imp (f , cr') -> let (f'', cr'') = followImpulse cr' w imp in (f'' . f , cr''))
-        (f, cr) 
+        (id, cr) 
         (_crImpulse $ _crActionPlan cr)
-  where
-    g' = snd $ genWord8 g
 
 followImpulse
     :: Creature

src/Dodge/Creature/State.hs

@@ -32,24 +32,19 @@ import System.Random
 --import qualified Data.Map as M
 import Data.Monoid
 
-type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
+dummyUpdate :: CRUpdate
+dummyUpdate cr _ = (Endo id, Just cr)
 
-
-meleeCooldown :: CRUpdate -> CRUpdate
-meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
 -- | The movement is updated before the ai in order to correctly set the oldpos.
--- the whole of this update cycle could do with a rethink, it is becoming
--- convoluted
 stateUpdate :: CRUpdate -> CRUpdate
-stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of
+stateUpdate u cr w = case u (updateMovement cr) w of
-        ((f',g') , maybeCr) -> 
+    (f, maybeCr) -> 
-            (   (invSideEff cr . movementSideEff cr . deathEff . f'
+        ( Endo $ invSideEff cr . movementSideEff cr . deathEff . appEndo f
-                , g')
         , fmap (stepReloading . stepItemUseCooldown . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr
         )
   where   
-    crOrCorpse cr''' 
+    crOrCorpse cr' 
-        | cr''' ^. crHP > 0 = Just cr'''
+        | cr' ^. crHP > 0 = Just cr'
         | otherwise      = Nothing
     deathEff 
         | cr ^.crHP > 0 = id
@@ -80,6 +75,9 @@ velocity to carry across frames.
 crFriction :: Creature -> Point2 -> Point2
 crFriction _ _ = V2 0 0
 
+meleeCooldown :: CRUpdate -> CRUpdate
+meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
+
 doDamage :: Creature -> Creature
 doDamage cr = set (crState . crDamage) [] 
     $ over (crState . crPastDamage) (forceFoldable . take 10 . (dams :) ) damagedCr
@@ -135,16 +133,15 @@ weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
   where 
     cid = _crID cr
 
-updateMovement :: StdGen -> Creature -> Creature
+updateMovement :: Creature -> Creature
-updateMovement g cr 
+updateMovement cr 
     | isFrictionless cr = over crPos (+.+ momentum) $ setOldPos cr
     | otherwise = updateWalkCycle $ setOldPos cr
   where
     momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
     momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
                | otherwise          = momentum'
-    momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
+    momentum = momentum''
-    (randAng,_) = randomR (0,2*pi) g
 
 isFrictionless :: Creature -> Bool
 isFrictionless cr = case cr ^? crStance . carriage of
@@ -169,29 +166,30 @@ decreaseToZero :: Int -> Int
 decreaseToZero x = max 0 (x - 1) 
 
 onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
-onDeath h u w (f,g) cr 
+onDeath h u cr w
-    | _crHP cr > 0 = u w (f,g) cr
+    | _crHP cr > 0 = u cr w
-    | otherwise    = ( ( h cr . f, g ) , Nothing )
+    | otherwise    = ( Endo $ h cr , Nothing )
 
 updateBarrel 
-    :: World 
+    :: Creature 
-    -> (World -> World,StdGen) 
+    -> World
-    -> Creature 
+    -> (Endo World, Maybe Creature)
-    -> ((World -> World , StdGen), Maybe Creature)
+updateBarrel cr _
-updateBarrel _ (f,g) cr 
+    | _crHP cr > 0 = (Endo id, newCr)
-    | _crHP cr > 0 = ((f, g), newCr)
+    | otherwise    = (Endo id, Nothing)
-    | otherwise   = ((f, g), Nothing)
   where 
     newCr = Just $ doDamage cr
 
--- it is easy to leave off the "f" here 
+-- should generate the sparks externally using new random generators
--- should find some better way of doing all this that is less prone to error
+updateExpBarrel 
-updateExpBarrel :: 
+    :: Creature 
-    World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
+    -> World
-updateExpBarrel _ (f,g) cr 
+    -> (Endo World, Maybe Creature)
-    | _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr)
+updateExpBarrel cr w 
-    | otherwise   = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing)
+    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
+    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
   where 
+    g = _randGen w
     damages = _crDamage $ _crState cr
     pierceSparks :: [World -> World]
     pierceSparks 
@@ -200,7 +198,6 @@ updateExpBarrel _ (f,g) cr
     as =  randomRs (-0.7,0.7) g
     colids = randomRs (0,11) g
     times = randomRs (2,5) g
-    (g',_) = split g
     poss = _piercedPoints $ _crSpState $ _crState cr
     --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
     newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr

src/Dodge/Creature/Update.hs

@@ -2,14 +2,14 @@ module Dodge.Creature.Update
   where
 import Dodge.Data
 
-import System.Random
+--import System.Random
+import Data.Monoid
 -- combinators for helping with dealing with creature update
 
-type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 
 unrandUpdate 
     :: (Creature -> World -> World) 
     -> (Creature -> Maybe Creature)
     -> CRUpdate
 {-# INLINE unrandUpdate #-}
-unrandUpdate h cF _ (f,g) cr = ( ( h cr . f , g) , cF cr )
+unrandUpdate h cF cr _ = ( Endo (h cr) , cF cr )

src/Dodge/Creature/YourControl.hs

@@ -16,11 +16,15 @@ import qualified SDL
 --import Data.Maybe
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
-import System.Random
+--import System.Random
+import Data.Monoid
 {- | The AI equivalent for your control. -}
-yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
+yourControl 
-yourControl w (f,g) cr = 
+    :: Creature 
-    ( (updateUsingInput . f, g)
+    -> World
+    -> (Endo World, Maybe Creature)
+yourControl cr w = 
+    ( Endo updateUsingInput 
     , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
     )
   where 

src/Dodge/Data.hs

@@ -44,6 +44,8 @@ import qualified Data.IntSet as IS
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import SDL (Scancode, MouseButton)
+import Data.Monoid
+type CRUpdate = Creature -> World -> (Endo World, Maybe Creature)
 data World = World 
     { _keys                 :: !(S.Set Scancode)
     , _mouseButtons         :: !(S.Set MouseButton)
@@ -157,10 +159,9 @@ data Creature = Creature
     , _crID             :: Int
     , _crPict           :: Creature -> World -> Picture
     , _crUpdate     
-        :: World 
+        :: Creature 
-        -> (World -> World,StdGen) 
+        -> World 
-        -> Creature 
+        -> (Endo World, Maybe Creature)
-        -> ((World -> World,StdGen), Maybe Creature)
     , _crRad            :: Float
     , _crMass           :: Float
     , _crHP             :: Int

src/Dodge/Default.hs

@@ -19,6 +19,7 @@ import Picture
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 import Data.List
+import Data.Monoid
 
 defaultCreature :: Creature
 defaultCreature = Creature
@@ -29,7 +30,7 @@ defaultCreature = Creature
     , _crMvDir  = 0
     , _crID     = 1
     , _crPict   = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10
-    , _crUpdate = \ _ f cr -> (f , Just cr)
+    , _crUpdate = \cr _ -> (Endo id , Just cr)
     , _crRad    = 10
     , _crMass   = 10
     , _crHP     = 100

src/Dodge/Update.hs

@@ -30,7 +30,7 @@ import qualified Data.IntMap.Lazy as IM
 import qualified Data.Map as M
 import Control.Lens
 import Data.Monoid
-import System.Random
+--import System.Random
 
 update :: World -> World
 update = update' . pushSideEffects
@@ -131,20 +131,10 @@ updateParticles w = set particles (catMaybes ps) w'
   where 
     (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
 
-updateCreatures' :: World -> World
-updateCreatures' w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
-  where 
-    ((f,newG),crs) = 
-        IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) $ _creatures w
-
-updateToTM :: (World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)) -> World -> Creature -> (Endo World,  Maybe Creature)
-updateToTM u w cr = case u w (id,_randGen w) cr of
-    ((f,_),mcr) -> (Endo f,mcr)
-
 updateCreatures :: World -> World
-updateCreatures w = appEndo f $ creatures .~ IM.mapMaybe id m $ w
+updateCreatures w = appEndo f $ w & creatures .~ IM.mapMaybe id m
   where
-    (f,m) = traverse (\cr -> updateToTM (_crUpdate cr) w cr) (_creatures w)
+    (f,m) = traverse (\cr -> _crUpdate cr cr w) (_creatures w)
 
 {- |
 Apply door mechanisms.  -}