Determine thunk leak when marking seen walls

src/Dodge/LevelGen/Block.hs

@@ -4,15 +4,10 @@ module Dodge.LevelGen.Block
     )
     where
 import Dodge.Data
---import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Zone
---import Dodge.SoundLogic
---import Dodge.SoundLogic.LoadSound
---import Dodge.WorldEvent.Sound
 import Dodge.LevelGen.Pathing
 import Dodge.Default.Wall
---import Dodge.RandomHelp
 import Geometry
 import qualified IntMapHelp as IM
 import Color
@@ -31,7 +26,7 @@ addBlock
 addBlock (p:ps) hp col isSeeThrough hps w 
     | hp <= 0 && null hps = w
     | hp <= 0 = addBlock (p:ps) (head hps + hp) col isSeeThrough (tail hps) w
-    | otherwise = w  
+    | otherwise = w
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
         & walls  %~ IM.union panes
         & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = is, _blHPs = hp:hps, _blShadows=[]})
@@ -40,13 +35,13 @@ addBlock (p:ps) hp col isSeeThrough hps w
     lns = zip (p:ps) (ps ++ [p])
     i = IM.newKey $ _walls w
     is = [i.. i + length lns-1]
-    panes = IM.fromList $ zip is $ zipWith 
-        (\j (a,b) -> defaultWall 
+    panes = IM.fromList $ zipWith 
+        (\j (a,b) -> (,) j defaultWall 
             { _wlLine = (a,b)
             , _wlID = j
             , _wlColor = col
             , _wlIsSeeThrough = isSeeThrough
-            , _wlBlockID = Just blid
+            , _wlBlockID = Just' blid
             }
         ) is lns
     wallInZone wl 
@@ -59,7 +54,6 @@ addBlock (p:ps) hp col isSeeThrough hps w
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
 addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
----- TODO add block list to world
 putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> (Int,World)
 putBlock (p:ps) i c b is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 

src/Dodge/LevelGen/LineBlock.hs

@@ -19,7 +19,7 @@ putLineBlock
     -> World 
     -> (Int, World)
 putLineBlock basePane blockWidth depth a b w = (,) 0 
-    $ removePathsCrossing a b $ foldr insertBlock (insertBlocks' w) listBlocks
+    $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
   where 
     d = dist a b
     rot = argV (b -.- a)
@@ -33,9 +33,9 @@ putLineBlock basePane blockWidth depth a b w = (,) 0
     linesAt p = makeLoopPairs $ cornersAt p
     k = IM.newKey $ _walls w
     blid = IM.newKey $ _blocks w
-    insertBlock' i = over blocks 
-        $ IM.insert (i+blid) Block {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
-    insertBlocks' = flip (foldr insertBlock') is
+    insertBlock i = over blocks $ IM.insert (i+blid) Block 
+        {_blID = i + blid, _blWallIDs = ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
+    insertBlocks = flip (foldr insertBlock) is
     ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
     visibilityAt i 
         | i == 0             = [ True,True,False,True]
@@ -45,14 +45,12 @@ putLineBlock basePane blockWidth depth a b w = (,) 0
         | i == 0             = ksAtI 1
         | i == numBlocks - 1 = ksAtI $ numBlocks - 2
         | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
-    makeBlockAt :: Point2 -> Int -> [Wall]
-    makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
+    makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
     makePane i visStatus k' ps = basePane 
         {_wlID = k'
-        ,_wlBlockID = Just $ i + blid
+        ,_wlBlockID = Just' $ i + blid
         ,_wlLine = ps
         ,_wlDraw = visStatus
         }
-    listBlocks = concat $ zipWith makeBlockAt blockCenPs is
-    insertBlock :: Wall -> World -> World
-    insertBlock wl = over walls $ IM.insert (_wlID wl) wl
+    listWalls = concat $ zipWith makeWallAt blockCenPs is
+    insertWall wl = over walls $ IM.insert (_wlID wl) wl