linted

src/Commons.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-
 module Commons where
 
 import Affection
@@ -26,7 +24,7 @@ toR :: Double -> Double
 toR deg = deg * pi / 180
 
 wrapAround :: (Fractional t, Ord t, Num t) => V2 t -> t -> V2 t
-wrapAround (V2 nx ny) width = (V2 nnx nny)
+wrapAround (V2 nx ny) width = V2 nnx nny
   where
     nnx
       | nx > 800 + half = nx - (800 + width)
@@ -119,4 +117,4 @@ drawHaskelloid (Haskelloid pos _ rot _ div img) = do
   ctx <- nano <$> getAffection
   liftIO $ drawImage ctx img (pos - fmap (/2) dim) dim rot 255
   where
-    dim = (fmap (/ fromIntegral div) (V2 100 100))
+    dim = fmap (/ fromIntegral div) (V2 100 100)

src/InGame.hs

@@ -77,8 +77,8 @@ shoot = do
   ud <- getAffection
   let Ship{..} = ship ud
       npew = Pew ppos pVel pewTTL
-      ppos = sPos + ((V2 0 25) `rotVec` sRot)
+      ppos = sPos + (V2 0 25 `rotVec` sRot)
-      pVel = sVel + ((V2 0 pewVel) `rotVec` sRot)
+      pVel = sVel + (V2 0 pewVel `rotVec` sRot)
   putAffection ud
     { shots = npew : shots ud
     }
@@ -88,7 +88,7 @@ accelShip vel = do
   ud <- getAffection
   dt <- getDelta
   let s    = ship ud
-      nVel = sVel s + fmap (realToFrac dt *) ((V2 0 vel) `rotVec` sRot s)
+      nVel = sVel s + fmap (realToFrac dt *) (V2 0 vel `rotVec` sRot s)
   putAffection ud
     { ship = s
       { sVel = nVel
@@ -101,15 +101,15 @@ rotateShip deg = do
   dt <- getDelta
   putAffection ud
     { ship = (ship ud)
-      { sRot = (sRot $ ship ud) - deg * realToFrac dt
+      { sRot = sRot (ship ud) - deg * realToFrac dt
       }
     }
 
 rotVec :: (Num a, Floating a) => V2 a -> a -> V2 a
 rotVec (V2 x y) deg = V2 nx ny
   where
-    nx   = x * (cos $ dtor deg) + y * (sin $ dtor deg)
+    nx   = x * cos (dtor deg) + y * sin (dtor deg)
-    ny   = x * (sin $ dtor deg) - y * (cos $ dtor deg)
+    ny   = x * sin (dtor deg) - y * cos (dtor deg)
     dtor = (pi / 180 *)
 
 updateGame :: Double -> Affection UserData ()
@@ -162,7 +162,7 @@ checkShotDown =
       let ndiv = hDiv + 1
       if ndiv > 5
       then return []
-      else return $
+      else return
         [ Haskelloid hPos (V2 n1velx n1vely) n1rot n1pitch ndiv hImg
         , Haskelloid hPos (V2 n2velx n2vely) n2rot n2pitch ndiv hImg
         ]
@@ -211,36 +211,34 @@ drawGame = do
   mapM_ drawHaskelloid (haskelloids ud)
   mapM_ drawPew (shots ud)
   case wonlost ud of
-    Just Lost -> liftIO $ do
+    Just x -> drawWonLost x
-      let ctx = nano ud
-      save ctx
-      fontSize ctx 120
-      fontFace ctx "modulo"
-      textAlign ctx (S.fromList [AlignCenter,AlignTop])
-      fillColor ctx (rgba 255 255 255 255)
-      textBox ctx 0 200 800 "YOU LOST!"
-      fillColor ctx (rgba 255 128 0 255)
-      fontSize ctx 40
-      textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again"
-      restore ctx
-    Just Won -> liftIO $ do
-      let ctx = nano ud
-      save ctx
-      fontSize ctx 120
-      fontFace ctx "modulo"
-      textAlign ctx (S.fromList [AlignCenter,AlignTop])
-      fillColor ctx (rgba 255 255 255 255)
-      textBox ctx 0 200 800 "YOU WON!"
-      fillColor ctx (rgba 128 255 0 255)
-      fontSize ctx 40
-      textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again"
-      restore ctx
     Nothing -> drawShip (ship ud)
 
+drawWonLost :: WonLost -> Affection UserData ()
+drawWonLost wl = do
+  ctx <- nano <$> getAffection
+  liftIO $ do
+    let color = case wl of
+          Won -> rgba 128 255 0 255
+          Lost -> rgba 255 128 0 255
+        text = case wl of
+          Won -> "YOU WON!"
+          Lost -> "YOU LOsT!"
+    save ctx
+    fontSize ctx 120
+    fontFace ctx "modulo"
+    textAlign ctx (S.fromList [AlignCenter,AlignTop])
+    fillColor ctx (rgba 255 255 255 255)
+    textBox ctx 0 200 800 text
+    fillColor ctx color
+    fontSize ctx 40
+    textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again"
+    restore ctx
+
 drawShip :: Ship -> Affection UserData ()
 drawShip Ship{..} = do
   ctx <- nano <$> getAffection
-  liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255
+  liftIO $ drawImage ctx sImg (sPos - fmap (/2) dim) dim sRot 255
   where
     dim = V2 40 40
 

src/Init.hs

@@ -56,8 +56,8 @@ load = do
     exitFailure
   liftIO $ logIO A.Debug "Initializing subsystems"
   subs <- Subsystems
-    <$> (return . Window =<< newTVarIO [])
+    <$> (Window <$> newTVarIO [])
-    <*> (return . Keyboard =<< newTVarIO [])
+    <*> (Keyboard <$> newTVarIO [])
   liftIO $ logIO A.Debug "Setting viewport"
   GL.viewport $= (GL.Position 0 0, GL.Size 800 600)
   liftIO $ logIO A.Debug "Returning UserData"

src/Main.hs

@@ -41,7 +41,7 @@ main = do
     , eventLoop      = handle
     , updateLoop     = update
     , drawLoop       = draw
-    , cleanUp        = (\_ -> return ())
+    , cleanUp        = \_ -> return ()
     }
 
 pre :: Affection UserData ()

src/Menu.hs

@@ -24,7 +24,7 @@ import Foreign.C.Types
 import Types
 import Commons
 
-loadMenu :: (Affection UserData ()) -> Affection UserData ()
+loadMenu :: Affection UserData () -> Affection UserData ()
 loadMenu stateChange = do
   liftIO $ logIO A.Debug "Loading Menu"
   ud <- getAffection
@@ -54,12 +54,12 @@ updateMenu sec = do
   ud <- getAffection
   let nhs = map (updateHaskelloid sec) (haskelloids ud)
   case fade ud of
-    FadeIn ttl -> do
+    FadeIn ttl ->
       putAffection ud
         { fade = if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1
         , haskelloids = nhs
         }
-    FadeOut ttl -> do
+    FadeOut ttl ->
       putAffection ud
         { fade = if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1
         , haskelloids = nhs
@@ -72,8 +72,8 @@ drawMenu = do
   liftIO $ do
     let ctx = nano ud
         alpha fio = case fio of
-          FadeIn d  -> (floor (255 * (1 - d)))
+          FadeIn d  -> floor (255 * (1 - d))
-          FadeOut d -> (floor (255 * d))
+          FadeOut d -> floor (255 * d)
     save ctx
     fontSize ctx 120
     fontFace ctx "modulo"

src/Types.hs

@@ -85,7 +85,7 @@ instance Participant Window WindowMessage UserData where
     return $ MsgId uuid MsgWindowEmptyEvent
 
   partUnSubscribe (Window t) (MsgId uuid _) =
-    liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid))
+    liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
     where
       filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool
       filterMsg (u, _) p = u /= p
@@ -106,7 +106,7 @@ instance Participant Keyboard KeyboardMessage UserData where
     return $ MsgId uuid MsgKeyboardEmptyEvent
 
   partUnSubscribe (Keyboard t) (MsgId uuid _) =
-    liftIO $ atomically $ modifyTVar' t (filter (flip filterMsg uuid))
+    liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
     where
       filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool
       filterMsg (u, _) p = u /= p