Apply Hlints

app/Main.hs

@@ -32,7 +32,7 @@ import Control.Monad (when)
  
 import System.Random
 
-import qualified SDL as SDL
+import qualified SDL
 import qualified SDL.Mixer as Mix
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 
@@ -73,14 +73,14 @@ main = do
                       return $ preData & soundData  .~ newSoundData
                                        & frameTimer .~ endTicks
         )
-        (flip $ menuEvents $ handleEvent)
+        (flip $ menuEvents handleEvent)
-        (\w -> Just $ update w)
+        (Just . update)
     Mix.closeAudio
 
 checkForGlErrors :: IO ()
 checkForGlErrors = do
     errs <- errors
-    when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
+    when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
 
 setWindowSize :: Int -> Int -> World -> World
 setWindowSize x y w = w & windowX .~ fromIntegral x

src/Geometry.hs

@@ -17,6 +17,7 @@ import Data.List
 import Data.Maybe
 
 import Control.Applicative
+-- TODO add bang patterns
 
 alongLineBy :: Float -> Point2 -> Point2 -> Point2
 alongLineBy x a b = a +.+ y *.* normalizeV (b -.- a)
@@ -171,10 +172,10 @@ anyPolyssIntersect :: [[Point2]] -> [[Point2]] -> Bool
 anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y
 
 nRays :: Int -> [Point2]
-nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) $ (600,0)
+nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (600,0)
 
 nRaysRad :: Int -> Float -> [Point2]
-nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) $ (x,0)
+nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (x,0)
 
 -- angles go from 0 to 2pi, need to work out what is left of another
 
@@ -298,23 +299,26 @@ isOnLine l1 l2 p = errorClosestPointOnLineParam 10 l1 (l1 +.+ vNormal (l2 -.- l1
 -- generate an infinite list, and I don't know why
 divideLine :: Float -> Point2 -> Point2 -> [Point2]
 --divideLine x a b = map (\i -> a +.+ (i / (fromIntegral numPoints)) *.* (b -.- a)) 
-divideLine x a b = take 5000 $ map (\i -> a +.+ (i / (fromIntegral numPoints) *.* (b -.- a)) )
+divideLine x a b = take 5000 
-                       $ map fromIntegral ns
+    $ map (\i -> a +.+ (fromIntegral i / fromIntegral numPoints *.* (b -.- a)) )
-    where d = dist a b
+          ns
+  where 
+    d = dist a b
     numPoints = max 1 $ ceiling $ d / x
     ns = [0 .. numPoints]
 
 divideLineOddNumPoints :: Float -> Point2 -> Point2 -> [Point2]
 --divideLine x a b = map (\i -> a +.+ (i / (fromIntegral numPoints)) *.* (b -.- a)) 
-divideLineOddNumPoints x a b = take 5000 $ map (\i -> a +.+ (i / (fromIntegral numPoints) *.* (b -.- a)) )
+divideLineOddNumPoints x a b = take 5000 
-                       $ map fromIntegral ns
+    $ map (\i -> a +.+ (fromIntegral i / fromIntegral numPoints *.* (b -.- a)) )
-    where d = dist a b
+          ns
+  where 
+    d = dist a b
     numPoints' = max 1 $ ceiling $ d / x
     numPoints | even numPoints' = numPoints'
               | otherwise       = numPoints' + 1
     ns = [0 .. numPoints]
 
-
 -- pulled the following from the haskell wiki
 -- it seems to produce an infinite loop sometimes
 -- fuck that, don't trust random code on the internet
@@ -343,7 +347,8 @@ digitalLine (x1,y1) (x2,y2)
                                     | x <- intervalList x1 x2 ]
     | otherwise                 = [ ( ((x1-x2) * y + y1*x2 - y2*x1) `rdiv` (y1-y2)  , y)
                                     | y <- intervalList y1 y2 ]
-        where rdiv a b = round $ fromIntegral a / fromIntegral b
+  where 
+    rdiv a b = round $ fromIntegral a / fromIntegral b
 
 intervalList :: Int -> Int -> [Int]
 intervalList x y 
@@ -352,10 +357,11 @@ intervalList x y
 
 divideCircle :: Float -> Point2 -> Float -> [Point2]
 divideCircle x cen rad = map (cen +.+) $ nPointsOnCirc n rad
-    where n = ceiling $ rad * 2 * pi / x
+  where 
+    n = ceiling $ rad * 2 * pi / x
 
 nPointsOnCirc :: Int -> Float -> [Point2]
-nPointsOnCirc n rad = take n $ iterate (rotateV (2*pi/fromIntegral n)) $ (rad,0)
+nPointsOnCirc n rad = take n $ iterate (rotateV (2*pi/fromIntegral n)) (rad,0)
 
 lineInPolygon :: Point2 -> Point2 -> [Point2] -> Bool
 lineInPolygon a b ps = pointInPolygon a ps || pointInPolygon b ps 
@@ -364,7 +370,7 @@ lineInPolygon a b ps = pointInPolygon a ps || pointInPolygon b ps
 
 makeLoopPairs :: [Point2] -> [(Point2,Point2)]
 makeLoopPairs [] = error "tried to make loop with empty list of points"
-makeLoopPairs (x:[]) = error "tried to make loop with singleton list of points"
+makeLoopPairs [x] = error "tried to make loop with singleton list of points"
 makeLoopPairs (x:xs) = zip (x:xs) (xs ++ [x])
 
 -- note the pair is ordered

src/Loop.hs

@@ -90,7 +90,7 @@ applyEventsIO
     -> world
     -> [Event]
     -> IO (Maybe world)
-applyEventsIO fn w es = foldM (applyEventIO fn) (Just w) es
+applyEventsIO fn w = foldM (applyEventIO fn) (Just w)
 
 --eventCloseOrResize :: Event -> IO (Maybe Event)
 --eventCloseOrResize e = case eventPayload e of
@@ -105,7 +105,7 @@ applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (M
 applyEventIO fn mw e = case eventPayload e of
     QuitEvent           -> return Nothing
     WindowClosedEvent _ -> return Nothing
-    WindowSizeChangedEvent (WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y})
+    WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
                         -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
     _                   -> return $ mw >>= flip fn e
 

src/Picture.hs

@@ -1,5 +1,3 @@
---{-# LANGUAGE BangPatterns #-}
---{-# LANGUAGE Strict #-}
 module Picture
     ( module Picture.Data
     , polygon
@@ -75,7 +73,8 @@ bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 ->
 bezierQuad cola colc ra rc a b c 
     | a == b && b == c = blank
     | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
-    | otherwise = BezierQuad 0 [-- ( (0,0) , cola, (0,0), (0,0) )
+    | otherwise = BezierQuad 0 
+        [-- ( (0,0) , cola, (0,0), (0,0) )
          (aIn, cola, (fa aIn,fc aIn) , (1,0) )
         ,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
         ,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
@@ -84,18 +83,19 @@ bezierQuad cola colc ra rc a b c
         ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
         ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
         ]
-    where colb = mixColors 0.5 0.5 cola colc
+  where 
+    colb = mixColors 0.5 0.5 cola colc
     b2a | isLHS a b c = a -.- b
         | otherwise   = b -.- a
-          aRadVec = 0.5 * ra *.* (normalizeV $ vNormal b2a)
+    aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
     aX  = a -.- aRadVec
     aIn = a +.+ aRadVec
     b2c | isLHS a b c = b -.- c
         | otherwise   = c -.- b
-          cRadVec = 0.5 * rc *.* (normalizeV $ vNormal b2c)
+    cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
     cX  = c -.- cRadVec
     cIn = c +.+ cRadVec
-          bRadVec = 0.25 * (ra + rc) *.* (normalizeV $ a +.+ b -.- 2 *.* c)
+    bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
     bX  = b +.+ bRadVec
     bIn = b -.- bRadVec
     fa = extrapolate aX cX bX 
@@ -149,24 +149,22 @@ scale x y pic = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id pic
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
 rotate3 a (x,y,z) = (x',y',z)
-    where (x',y') = rotateV a (x,y)
+  where 
+    (x',y') = rotateV a (x,y)
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
 rotate a pic = OverPic (rotate3 a) id a id pic
 
---rotateRad a = Rotate a
---{-# INLINE rotateRad #-}
-
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
 pictures = Pictures
 
-
 makeArc :: Float -> (Float,Float) -> [Point2]
 {-# INLINE makeArc #-}
-makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
+makeArc rad (a,b) = zipWith rotateV as (repeat (0,rad))
-    where as = [a,a+step.. b]
+  where 
+    as = [a,a+step.. b]
     step = pi * 0.2
 
 circleSolid :: Float -> Picture
@@ -196,16 +194,15 @@ lineCol = LineCol 0
 thickLine :: [Point2] -> Float -> Picture
 {-# INLINE thickLine #-}
 thickLine ps t = pictures $ f ps
-    where f (x:y:ys) 
+  where 
+    f (x:y:ys) 
       | x == y      = f (x:ys)
-            | otherwise 
+      | otherwise   = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
-                     = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
     f _             = []
     n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
 
 thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
---thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth
 thickCircle rad wdth = thickArc 0 (2*pi) rad wdth
 
 arcSolid :: Float -> Float -> Float -> Picture
@@ -219,8 +216,6 @@ arc startA endA rad = thickArc startA endA rad 1
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
 thickArc = ThickArc 0
---thickArc startA endA rad wdth
---    = thickLine (makeArc rad (startA,endA)) wdth
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}

src/Shader.hs

@@ -27,7 +27,7 @@ import Codec.Picture
 
 import qualified Data.Vector.Storable as V
 
-import Control.Monad (when, forM, zipWithM_, forM_, foldM)
+import Control.Monad (when, unless, forM, zipWithM_, forM_, foldM)
 import Control.Lens
 
 import Data.Maybe (fromMaybe)
@@ -51,8 +51,9 @@ pokeShaders fss = traverse pokeShader fss
 
 pokeShader :: FullShader a -> F.FoldM IO a Int
 pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
-  where vao = _shaderVAO fs
+  where 
-        (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ vao
+    vao = _shaderVAO fs
+    (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets vao
     fls = _shaderPokeStrategy fs
 
 pokeRender :: (a -> [[[Float]]])
@@ -83,7 +84,8 @@ bindArrayBuffers numVs ps = do
 bindShaderBuffers :: [FullShader a] -> [Int] -> IO ()
 bindShaderBuffers fss is =
     zipWithM_ f fss is
-        where f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
+  where 
+    f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
 
 drawShaders :: [FullShader a] -> [Int] -> IO ()
 drawShaders fss is =
@@ -116,7 +118,7 @@ addTexture texturePath shad = do
                         (PixelData RGBA UnsignedByte ptr)
     generateMipmap' Texture2D
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
-    return $ shad & shaderTexture .~ Just (ShaderTexture {_textureObject = textureOb})
+    return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
 
 makeShader :: String -> [ShaderType] -> [(GLuint,Int)] -> PrimitiveMode -> (a -> [[[Float]]]) -> IO (FullShader a)
 makeShader s shaderlist alocs pm renStrat = do
@@ -198,7 +200,7 @@ makeShaderProgram str sources = do
 
     linkProgram shaderProgram
     linkingSuccess <- linkStatus shaderProgram
-    when (not linkingSuccess) $ do
+    unless linkingSuccess $ do
         infoLog <- get (programInfoLog shaderProgram)
         putStrLn $ str ++ ": Program Linking" ++ infoLog
 
@@ -210,7 +212,7 @@ compileAndCheckShader str (shaderType,sourceCode) = do
     shaderSourceBS theShader $= sourceCode
     compileShader theShader
     success <- compileStatus theShader
-    when (not success) $ do
+    unless success $ do
         infoLog <- get (shaderInfoLog theShader)
         putStrLn $ str ++ ": Shader compile: " ++ show shaderType ++ " : " ++ show infoLog
     return theShader