Cleanup compiler warnings

ghcidOutput

@@ -1,105 +1 @@
-/home/justin/Haskell/loop/src/Polyhedra.hs:68:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
+All good (596 modules, at 10:48:32)
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘[Point3]’ not matched:
-            []
-            [_]
-            [_, _]
-   |
-68 |     (a:b:c:_) = xs
-   |     ^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Polyhedra/Geodesic.hs:59:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘[[a]]’ not matched:
-            []
-            [_]
-   |
-59 |     (f0:f1:fs) = rotateTo ((== n) . head) vss
-   |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/SimpleTrie.hs:36:13: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding: Patterns of type ‘[a]’ not matched: []
-   |
-36 |         let (z : zs) = xs
-   |             ^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/SimpleTrie.hs:45:13: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding: Patterns of type ‘[(a, c)]’ not matched: []
-   |
-45 |         let ((z1, z2) : zs) = xs
-   |             ^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/WdP2f.hs:12:13: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘Maybe (Point2, Point2)’ not matched: Nothing
-   |
-12 |         let Just (a, b) = w ^? cWorld . lWorld . doors . ix drid . drPos
-   |             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Debug/Picture.hs:118:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding: Patterns of type ‘[Point2]’ not matched: []
-    |
-118 |     (p : ps) =
-    |     ^^^^^^^^^^...
-/home/justin/Haskell/loop/src/Dodge/Debug/Picture.hs:302:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding: Patterns of type ‘[Point2]’ not matched: []
-    |
-302 |     (x : xs) = w ^. wCam . camBoundBox
-    |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/RandomHelp.hs:36:9: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘([a], [a])’ not matched: (_, [])
-   |
-36 |     let (zs, w : ws) = splitAt i ys
-   |         ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/RandomHelp.hs:51:17: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘([b], [b])’ not matched: (_, [])
-   |
-51 |             let (as, b : bs) = splitAt rand ys
-   |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:177:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘([Float], StdGen)’ not matched:
-            ([], _)
-            ([_], _)
-            ([_, _], _)
-            ([_, _, _], _)
-    |
-177 |     (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w)
-    |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Tile.hs:36:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
-    Pattern match(es) are non-exhaustive
-    In a pattern binding:
-        Patterns of type ‘[Point2]’ not matched:
-            []
-            [_]
-   |
-36 |     (c:d:_) = poly
-   |     ^^^^^^^^^^^^^^
-/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:54:22: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict]
-    The prefix use of a ‘$’ would denote an untyped splice
-      were the TemplateHaskell extension enabled.
-    Suggested fix: Add whitespace after the ‘$’.
-   |
-54 |         shuffleLinks $(roomRectAutoLinks w h){_rmPmnts = []}
-   |                      ^
-/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:120:44: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict]
-    The prefix use of a ‘$’ would denote an untyped splice
-      were the TemplateHaskell extension enabled.
-    Suggested fix: Add whitespace after the ‘$’.
-    |
-120 |     let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
-    |                                            ^
-/home/justin/Haskell/loop/src/Dodge/Room/RezBox.hs:122:29: warning: [GHC-47082] [-Woperator-whitespace-ext-conflict]
-    The prefix use of a ‘$’ would denote an untyped splice
-      were the TemplateHaskell extension enabled.
-    Suggested fix: Add whitespace after the ‘$’.
-    |
-122 |         tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door] $
-    |                             ^

src/Dodge/Debug/Picture.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 module Dodge.Debug.Picture where
 
 import Control.Lens
@@ -5,19 +6,21 @@ import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import qualified Data.Set as S
 import Dodge.Base
 import Dodge.Creature.Picture.Awareness
 import Dodge.Data.Universe
-
 import Dodge.GameRoom
 import Dodge.Graph
 import Dodge.Path
 import Dodge.Picture.SizeInvariant
 import Dodge.Render.InfoBox
+import Dodge.Render.Label
 import Dodge.Render.List
 import Dodge.ShortShow
 import Dodge.SoundLogic.LoadSound
 import Dodge.Viewpoints
+import Dodge.WorldEvent.ThingsHit
 import Dodge.Zoning
 import Dodge.Zoning.Base
 import Geometry
@@ -28,9 +31,6 @@ import Picture
 import SDL (MouseButton (..))
 import ShortShow
 import Sound.Data
-import qualified Data.Set as S
-import Dodge.Render.Label
-import Dodge.WorldEvent.ThingsHit
 
 printPoint :: Point2 -> Picture
 printPoint p = color white $ uncurryV translate p $ fold [circle 3, scale 0.05 0.05 $ text (show p)]
@@ -107,11 +107,13 @@ drawCollisionTest w = fromMaybe mempty $ do
     return $
         setLayer DebugLayer (color orange $ line [a, b])
             <> foldMap (drawCrossCol red . fst) (thingHit a b w)
+
 --            <> foldMap (drawCross . _crPos) (crsNearSeg a b w)
 --            <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
 --            <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
 --            <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b)
 
+-- # OPTIONS -Wno-incomplete-uni-patterns #-}
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
 drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
   where
@@ -337,7 +339,6 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
       where
         p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
 
-
 drawCrInfo :: Configuration -> World -> Picture
 drawCrInfo cfig w =
     setLayer FixedCoordLayer $
@@ -345,14 +346,14 @@ drawCrInfo cfig w =
             mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
   where
     cam = w ^. wCam
---    drawPathing :: Configuration -> World -> Picture
+    --    drawPathing :: Configuration -> World -> Picture
---    drawPathing cfig w =
+    --    drawPathing cfig w =
---        setLayer DebugLayer $
+    --        setLayer DebugLayer $
---            foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
+    --            foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
---                <> foldMap dispInc (graphToIncidence gr)
+    --                <> foldMap dispInc (graphToIncidence gr)
---      where
+    --      where
---        dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
+    --        dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
---        gr = w ^. cWorld . pathGraph
+    --        gr = w ^. cWorld . pathGraph
 
     crDisplayInfo :: Creature -> Maybe (Point2, [String])
     crDisplayInfo cr
@@ -396,4 +397,3 @@ edgeToPic poly pe
   where
     sp = _peStart pe
     ep = _peEnd pe
-

src/Dodge/HeldUse.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 {-# LANGUAGE TupleSections #-}
 
 module Dodge.HeldUse (
@@ -5,8 +6,8 @@ module Dodge.HeldUse (
     mcUseHeld,
 ) where
 
-import Control.Monad
 import Color
+import Control.Monad
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Base.Coordinate
@@ -162,6 +163,7 @@ makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
     dir = _crDir cr + _mzRot mz
 
+--{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
 muzFlareAt col tranv dir w =
     w & randGen .~ g
@@ -169,10 +171,10 @@ muzFlareAt col tranv dir w =
   where
     thepic =
         setLayer BloomNoZWrite . translate3 tranv . color col . rotate dir . polygon $
-                [ V2 0 0
+            [ V2 0 0
-                , V2 a (- b)
+            , V2 a (- b)
-                , V2 c d
+            , V2 c d
-                ]
+            ]
     thestate = replicateM 4 $ state $ randomR (2, 20)
     (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w)
 

src/Dodge/Room/RezBox.hs

@@ -1,5 +1,6 @@
 module Dodge.Room.RezBox where
 
+import Control.Monad
 import qualified Data.Set as S
 import Dodge.Cleat
 import Dodge.Data.GenWorld
@@ -18,7 +19,6 @@ import Geometry
 import LensHelp
 import Padding
 import RandomHelp
-import Control.Monad
 
 rezBox :: LightSource -> Room
 rezBox ls =
@@ -51,8 +51,9 @@ rezBoxesWp = do
     let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
     let isnorth = S.member (OnEdge North) . _rlType
     centralRoom <-
-        shuffleLinks $(roomRectAutoLinks w h){_rmPmnts = []}
+        shuffleLinks $
-            & rmLinks %~ setLinkType InLink isnorth
+            (roomRectAutoLinks w h){_rmPmnts = []}
+                & rmLinks %~ setLinkType InLink isnorth
     onwardpassage <- shootOutPassage
     let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
     let rezrooms =
@@ -117,10 +118,11 @@ rezBoxes = do
         shuffleLinks $
             (roomRectAutoLinks w h){_rmPmnts = []}
                 & rmLinks %~ setInLinks bottomEdgeTest
-    let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
-    return $
+    return
-        tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door] $
+        . tToBTree "rezBoxes"
-            Node centralRoom (replicate (n -1) dbox ++ [Node (cleatOnward door) []])
+        . treeFromTrunk [rezBox thecol, door]
+        $ Node centralRoom (replicate (n -1) dbox ++ [Node (cleatOnward door) []])
 
 rezColor :: RandomGen g => State g LightSource
 rezColor = do

src/Dodge/WdP2f.hs

@@ -1,10 +1,14 @@
-module Dodge.WdP2f where
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
+module Dodge.WdP2f 
+    ( doWdP2f
+    ) where
 
 import Control.Lens
 import Dodge.Data.World
 import Geometry.Data
 import Geometry.Vector
 
+-- # OPTIONS -Wno-incomplete-uni-patterns #-}
 doWdP2f :: WdP2f -> World -> (Point2, Float)
 doWdP2f x = case x of
     WdP2f0 -> const (0, 0)

src/Polyhedra.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 module Polyhedra
     ( translateXY
     , rotateXY

src/Polyhedra/Geodesic.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 {-# LANGUAGE TupleSections #-}
 module Polyhedra.Geodesic
     where

src/RandomHelp.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 {- Helpers for random generation.  -}
 module RandomHelp (
     module System.Random,
@@ -29,6 +30,7 @@ takeOneWeighted ws xs = state (randomR (0, sum ws)) >>= (\w -> return (xs !! i w
         | otherwise = 1 + i (y - z) zs
     i _ _ = 0
 
+--{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 takeOneMore :: RandomGen g => ([a], [a]) -> State g ([a], [a])
 takeOneMore (_, []) = error "trying to takeOneMore from empty list"
 takeOneMore (xs, ys) = do
@@ -119,9 +121,3 @@ randsSpread (a, b) i
 
 randsOnCirc :: RandomGen g => Int -> State g [Float]
 randsOnCirc = randsSpread (0, 2 * pi)
-
---randsOnCirc i
---    | i <= 0    = error "tried to take <= 0 randsOnCirc"
---    | otherwise = zipWith (+) [x,2*x..] <$> replicateM i (state $ randomR (0,x))
---  where
---    x = 2*pi/fromIntegral i

src/SimpleTrie.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module SimpleTrie where
@@ -29,6 +30,7 @@ lookupTrie :: Ord a => [a] -> Trie a b -> Maybe b
 lookupTrie (k : ks) t = _trieChildren t M.!? k >>= lookupTrie ks
 lookupTrie [] t = _trieMVal t
 
+-- # OPTIONS -Wno-incomplete-uni-patterns #-}
 multiLookupTrie :: Ord a => [a] -> Trie a b -> [([a], b)]
 multiLookupTrie xs t@(Trie my ch)
     | null xs || null ch = maybe [] (\y -> [([], y)]) my

src/Tile.hs

@@ -1,39 +1,46 @@
-module Tile
+{-# OPTIONS -Wno-incomplete-uni-patterns #-}
-    ( tileTexCoords
+module Tile (
-    , makeTileFromPoly
+    tileTexCoords,
-    , baseFloorTileSize
+    makeTileFromPoly,
-    )
+    baseFloorTileSize,
-     where
+) where
+
 import Data.Tile
 import Geometry
 
 tileTexCoords :: Tile -> [Point2]
-tileTexCoords t = map 
+tileTexCoords t =
-    (calcTexCoord (_tileZero t) tangent (- vNormal tangent))
+    map
-    (_tilePoly t)
+        (calcTexCoord (_tileZero t) tangent (- vNormal tangent))
+        (_tilePoly t)
   where
     tangent = _tileTangentPos t - _tileZero t
 
-calcTexCoord
+calcTexCoord ::
-    :: Point2   -- ^ tile (0,0)
+    -- | tile (0,0)
-    -> Point2   -- ^ tile tangent
+    Point2 ->
-    -> Point2   -- ^ tile cotangent
+    -- | tile tangent
-    -> Point2   -- ^ world point
+    Point2 ->
-    -> Point2
+    -- | tile cotangent
+    Point2 ->
+    -- | world point
+    Point2 ->
+    Point2
 calcTexCoord zp tangent cotangent p = V2 (f tangent) (f cotangent)
   where
     f t = closestPointOnLineParam zp (zp + t) p
 
-
+-- # OPTIONS -Wno-incomplete-uni-patterns #-}
 makeTileFromPoly :: [Point2] -> Float -> Tile
-makeTileFromPoly poly z = Tile
+makeTileFromPoly poly z =
-    { _tilePoly = poly
+    Tile
-    , _tileZero = c
+        { _tilePoly = poly
-    , _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
+        , _tileZero = c
-    , _tileArrayZ = z
+        , _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
-    }
+        , _tileArrayZ = z
+        }
   where
-    (c:d:_) = poly
+    (c : d : _) = poly
 
 baseFloorTileSize :: Float
 baseFloorTileSize = 50