justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup compiler warnings

Browse Source
This commit is contained in:
justin
2024-10-22 10:48:44 +01:00
parent c0b1092fb6
commit 65f05b93f8
10 changed files with 72 additions and 161 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -105
View File
@@ -1,105 +1 @@
/home/justin/Haskell/loop/src/Polyhedra.hs:68:5: warning: [GHC-62161] [-Wincomplete-uni-patterns]
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] $
| ^
All good (596 modules, at 10:48:32)
src/Dodge/Debug/Picture.hs
+14 -14
View File
@@ -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 cfig w =
-- setLayer DebugLayer $
-- foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
-- <> foldMap dispInc (graphToIncidence gr)
-- where
-- dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
-- gr = w ^. cWorld . pathGraph
-- drawPathing :: Configuration -> World -> Picture
-- drawPathing cfig w =
-- setLayer DebugLayer $
-- foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
-- <> foldMap dispInc (graphToIncidence gr)
-- where
-- dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
-- 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
+7 -5
View File
@@ -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 a (- b)
, V2 c d
]
[ V2 0 0
, V2 a (- b)
, 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
+9 -7
View File
@@ -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 = []}
& rmLinks %~ setLinkType InLink isnorth
shuffleLinks $
(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
return $
tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door] $
Node centralRoom (replicate (n -1) dbox ++ [Node (cleatOnward door) []])
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
return
. tToBTree "rezBoxes"
. 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
+5 -1
View File
@@ -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
View File
@@ -1,3 +1,4 @@
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
module Polyhedra
( translateXY
, rotateXY
src/Polyhedra/Geodesic.hs
+1
View File
@@ -1,3 +1,4 @@
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE TupleSections #-}
module Polyhedra.Geodesic
where
src/RandomHelp.hs
+2 -6
View File
@@ -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
+2
View File
@@ -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
+30 -23
View File
@@ -1,39 +1,46 @@
module Tile
( tileTexCoords
, makeTileFromPoly
, baseFloorTileSize
)
where
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
module Tile (
tileTexCoords,
makeTileFromPoly,
baseFloorTileSize,
) where
import Data.Tile
import Geometry
tileTexCoords :: Tile -> [Point2]
tileTexCoords t = map
(calcTexCoord (_tileZero t) tangent (- vNormal tangent))
(_tilePoly t)
tileTexCoords t =
map
(calcTexCoord (_tileZero t) tangent (- vNormal tangent))
(_tilePoly t)
where
tangent = _tileTangentPos t - _tileZero t
calcTexCoord
:: Point2 -- ^ tile (0,0)
-> Point2 -- ^ tile tangent
-> Point2 -- ^ tile cotangent
-> Point2 -- ^ world point
-> Point2
calcTexCoord ::
-- | tile (0,0)
Point2 ->
-- | tile tangent
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
{ _tilePoly = poly
, _tileZero = c
, _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
, _tileArrayZ = z
}
makeTileFromPoly poly z =
Tile
{ _tilePoly = poly
, _tileZero = c
, _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
, _tileArrayZ = z
}
where
(c:d:_) = poly
(c : d : _) = poly
baseFloorTileSize :: Float
baseFloorTileSize = 50