Cleanup warnings

src/Dodge/LevelGen/Block.hs

@@ -1,6 +1,4 @@
-{- |
-Creation, update and destruction of destructible walls.
- -}
+{- | Creation, update and destruction of destructible walls.  -}
 module Dodge.LevelGen.Block where
 import Dodge.Data
 import Dodge.Base
@@ -13,6 +11,7 @@ import Picture.Data
 import Control.Lens
 import Control.Monad.State
 import Data.List
+import Data.Maybe
 import Data.Function
 import qualified Data.IntMap.Strict as IM
 import System.Random
@@ -37,19 +36,21 @@ Plays destruction sound and sets to be displayed other walls that were shadowed
 killBlock :: Wall -> World -> World
 killBlock bl w =  f bl . flip (foldr unshadow) (_blShadows bl) $ w
   where
-    f bl@Block{_blDegrades = (x:xs)} = degradeBlock bl . hitSound bl
-    f bl          = hitSound' bl
+    f :: Wall -> World -> World
+    f bl'
+        | isJust (bl ^? blDegrades . ix 0) = degradeBlock bl' . breakHitSound bl
+        | otherwise = hitSound' bl'
     pos = fst $ _wlLine bl
-    hitSound bl 
-        | _wlIsSeeThrough bl = mkSoundBreakGlass pos
+    breakHitSound bl' 
+        | _wlIsSeeThrough bl' = mkSoundBreakGlass pos
         | otherwise = soundMultiFrom sos soundid 25 0 
-    hitSound' bl 
-        | _wlIsSeeThrough bl = mkSoundSplinterGlass pos
+    hitSound' bl' 
+        | _wlIsSeeThrough bl' = mkSoundSplinterGlass pos
         | otherwise = soundMultiFrom sos soundid 25 0 
     sos = [BlockDegradeSound 0,BlockDegradeSound 1]
     (soundid,_) = randomR (29,32) $ _randGen w
     unshadow :: Int -> World -> World
-    unshadow bid w = case w ^? walls . ix bid of 
+    unshadow bid w' = case w' ^? walls . ix bid of 
         Just b -> 
             let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
             in w & wallsZone . ix x . ix y . ix bid . blVisible %~ const True
@@ -101,9 +102,9 @@ addBlock (p:ps) hp col isSeeThrough degradability w
         & wallsZone %~ flip (IM.foldr wallInZone) panes
         & walls     %~ IM.union panes
   where 
-    lines = zip (p:ps) (ps ++ [p])
+    lns = zip (p:ps) (ps ++ [p])
     i = newKey $ _walls w
-    is = [i.. i + length lines-1]
+    is = [i.. i + length lns-1]
     panes = IM.fromList $ zip is $ zipWith 
         (\j (a,b) -> Block 
             { _wlLine = (a,b)
@@ -117,7 +118,7 @@ addBlock (p:ps) hp col isSeeThrough degradability w
             , _blShadows = []
             , _blDegrades = degradability
             }
-        ) is lines
+        ) is lns
     wallInZone wl 
         | uncurry dist (_wlLine wl) <= 2*zoneSize 
             = insertIMInZone x y wlid wl
@@ -126,9 +127,12 @@ addBlock (p:ps) hp col isSeeThrough degradability w
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
+addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
 putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
 putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
-    where pairs = zip (p:ps) (ps ++ [p])
-          wWithBlock = addBlock (p:ps) i c b is w
+  where 
+    pairs = zip (p:ps) (ps ++ [p])
+    wWithBlock = addBlock (p:ps) i c b is w
+putBlock _ _ _ _ _ _ = error "Trying to put a block with incomplete polygon"