Refactor updates

src/Dodge/Update.hs

@@ -348,34 +348,46 @@ updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
 updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
 updateIMl' fim fup w = foldl' (flip fup) w (fim w)
 
+
 updateCreatureGroups :: World -> World
 updateCreatureGroups w =
     w & cWorld . lWorld . creatureGroups
         %~ IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp)
 
+updateObjMapMaybe 
+    :: (([a] -> Identity [a]) -> LWorld -> Identity LWorld) 
+    -> (a -> Maybe a) 
+    -> World 
+    -> World
+updateObjMapMaybe p f = cWorld . lWorld . p %~ mapMaybe f
+
+updateObjCatMaybes
+    :: ALens' LWorld [a] 
+    -> (World -> a -> (World, Maybe a))
+    -> World 
+    -> World
+updateObjCatMaybes p f w = w' & cWorld . lWorld . p #~ catMaybes newxs
+  where
+    (w', newxs) = mapAccumR f w $ w ^# cWorld . lWorld . p
+
 updateDistortions :: World -> World
-updateDistortions = cWorld . lWorld . distortions %~ mapMaybe updateDistortion
+updateDistortions = updateObjMapMaybe distortions updateDistortion
+--updateDistortions = cWorld . lWorld . distortions %~ mapMaybe updateDistortion
 
 updateLightSources :: World -> World
-updateLightSources = cWorld . lWorld . tempLightSources %~ f
-  where
-    f = mapMaybe (\b -> updateTempLightSource (_tlsUpdate b) b)
-
-updateRadarBlips :: World -> World
-updateRadarBlips = cWorld . lWorld . radarBlips %~ mapMaybe updateRadarBlip
-
-updateFlares :: World -> World
-updateFlares = cWorld . lWorld . flares %~ mapMaybe updateFlare
+updateLightSources = updateObjMapMaybe tempLightSources (\b -> updateTempLightSource (_tlsUpdate b) b)
 
 updateTeslaArcs :: World -> World
-updateTeslaArcs w = w' & cWorld . lWorld . teslaArcs .~ catMaybes newtas
-  where
-    (w', newtas) = mapAccumR moveTeslaArc w $ w ^. cWorld . lWorld . teslaArcs
+updateTeslaArcs = updateObjCatMaybes teslaArcs moveTeslaArc
+
+updateRadarBlips :: World -> World
+updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip
+
+updateFlares :: World -> World
+updateFlares = updateObjMapMaybe flares updateFlare
 
 updateTractorBeams :: World -> World
-updateTractorBeams w = w' & cWorld . lWorld . tractorBeams .~ catMaybes newtas
-  where
-    (w', newtas) = mapAccumR updateTractorBeam w $ w ^. cWorld . lWorld . tractorBeams
+updateTractorBeams = updateObjCatMaybes tractorBeams updateTractorBeam
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateBullets :: World -> World
@@ -384,34 +396,22 @@ updateBullets w = updateInstantBullets $ set (cWorld . lWorld . bullets) (catMay
     (w', ps) = mapAccumR updateBullet w $ w ^. cWorld . lWorld . bullets
 
 updateShockwaves :: World -> World
-updateShockwaves w = w' & cWorld . lWorld . shockwaves .~ catMaybes newflames
-  where
-    (w', newflames) = mapAccumR updateShockwave w $ w ^. cWorld . lWorld . shockwaves
+updateShockwaves = updateObjCatMaybes shockwaves updateShockwave
 
 updateFlames :: World -> World
-updateFlames w = w' & cWorld . lWorld . flames .~ catMaybes newflames
-  where
-    (w', newflames) = mapAccumR moveFlame w $ w ^. cWorld . lWorld . flames
+updateFlames = updateObjCatMaybes flames moveFlame
 
 updateEnergyBalls :: World -> World
-updateEnergyBalls w = w' & cWorld . lWorld . energyBalls .~ catMaybes newebs
-  where
-    (w', newebs) = mapAccumR moveEnergyBall w $ w ^. cWorld . lWorld . energyBalls
+updateEnergyBalls = updateObjCatMaybes energyBalls moveEnergyBall 
 
 updateRadarSweeps :: World -> World
-updateRadarSweeps w = w' & cWorld . lWorld . radarSweeps .~ catMaybes newradarSweeps
-  where
-    (w', newradarSweeps) = mapAccumR updateRadarSweep w $ w ^. cWorld . lWorld . radarSweeps
+updateRadarSweeps = updateObjCatMaybes radarSweeps updateRadarSweep
 
 updateSparks :: World -> World
-updateSparks w = w' & cWorld . lWorld . sparks .~ catMaybes newsparks
-  where
-    (w', newsparks) = mapAccumR moveSpark w $ w ^. cWorld . lWorld . sparks
+updateSparks = updateObjCatMaybes sparks moveSpark
 
 updatePosEvents :: World -> World
-updatePosEvents w = w' & cWorld . lWorld . posEvents .~ catMaybes newposEvents
-  where
-    (w', newposEvents) = mapAccumR updatePosEvent w $ w ^. cWorld . lWorld . posEvents
+updatePosEvents = updateObjCatMaybes posEvents updatePosEvent
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
 --updateParticles :: World -> World
@@ -562,10 +562,7 @@ mvGust _ gu
                 & guTime -~ 1
 
 updateClouds :: World -> World
-updateClouds w = w' & cWorld . lWorld . clouds .~ catMaybes mclouds
-  where
-    --    cls = _clouds w
-    (w', mclouds) = mapAccumR updateCloud w (w ^. cWorld . lWorld . clouds)
+updateClouds = updateObjCatMaybes clouds updateCloud
 
 cloudEffect :: Cloud -> World -> World
 cloudEffect cl = case _clType cl of