Refactor to Game.HSnake domain, some code cleanup

Author: Przemek Kaminski

driver/Main.hs

@@ -2,12 +2,12 @@ module Main where
 
 import Control.Lens
 
-import HSnake.AI
-import HSnake.Basic
-import HSnake.Game
-import HSnake.Graphics
-import HSnake.Player
-import HSnake.Snake
+import Game.HSnake.AI
+import Game.HSnake.Basic
+import Game.HSnake.Game
+import Game.HSnake.Graphics
+import Game.HSnake.Player
+import Game.HSnake.Snake
 
 import Control.Monad
 import Control.Monad.State
@@ -66,6 +66,7 @@ handleInputHuman gs (Just (SDL.Event _ (SDL.KeyboardEvent k))) =
   handleInputKeyboard gs k
 handleInputHuman _ _ = return ()
 
+handleInputKeyboard :: MonadState GameState m => GameState -> SDL.KeyboardEventData -> m ()
 handleInputKeyboard gs (SDL.KeyboardEventData _ SDL.Pressed False keysym) =
   case SDL.keysymKeycode keysym of
       SDL.KeycodeDown  -> do
@@ -104,11 +105,10 @@ loop = do
 
   gameState <- get
 
-  let ap = gameState^.applePosition
+  let apple = gameState^.applePosition
   let ps = gameState^.players
 
   if checkPlayersCollision ps
-      -- TODO: increase level
       then error "Game over"
       else return ()
 
@@ -129,7 +129,7 @@ loop = do
 
               drawGame
 
-              let appleEatersInd = findIndices (playerEatsApple ap) ps
+              let appleEatersInd = findIndices (playerEatsApple apple) ps
               if (length appleEatersInd > 0)
                   then do
                       newApplePosition <- liftIO $ getRandomApple (totalPlayersPosition ps)
@@ -159,9 +159,8 @@ computeAINextMoves = do
         gameState <- get
         put $ players .~ movedAI gameState $ gameState
     where
+        aiIndices gs = findIndices (not . isHuman) (gs^.players)
         movedAI gs = mapToIndices (\pl -> setNextPlayerDirection pl (computeAIPlayerMove pl gs)) (gs^.players) (aiIndices gs)
-            where
-                aiIndices gs = findIndices (not . isHuman) (gs^.players)
 
 
 updatePlayerDirections :: ReaderT AppConfig AppState ()
@@ -202,8 +201,7 @@ drawGame = do
 
     showGameMessages window gameState
 
-    --SDL.flip window
-    SDL.surfaceBlit gameScreen Nothing screen Nothing
+    _ <- SDL.surfaceBlit gameScreen Nothing screen Nothing
 
     SDL.updateWindowSurface window
 

haskell-snake.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 192b2c53b1c47172c4eb5a55573b1c4f70e7f7b0154cf198cf6d353efb1a6134
+-- hash: 60583e315dd2851d455eb1c3beba4cfd260b5fecb8b670efc23c1f0c6070679a
 
 name:           haskell-snake
 version:        1.0.0
@@ -26,13 +26,13 @@ source-repository head
 
 library
   exposed-modules:
-      HSnake.AI
-      HSnake.Basic
-      HSnake.Board
-      HSnake.Game
-      HSnake.Graphics
-      HSnake.Player
-      HSnake.Snake
+      Game.HSnake.AI
+      Game.HSnake.Basic
+      Game.HSnake.Board
+      Game.HSnake.Game
+      Game.HSnake.Graphics
+      Game.HSnake.Player
+      Game.HSnake.Snake
   other-modules:
       Paths_haskell_snake
   hs-source-dirs:

package.yaml

@@ -58,13 +58,13 @@ dependencies:
 library:
   source-dirs: src
   exposed-modules:
-    - HSnake.AI
-    - HSnake.Basic
-    - HSnake.Board
-    - HSnake.Game
-    - HSnake.Graphics
-    - HSnake.Player
-    - HSnake.Snake
+    - Game.HSnake.AI
+    - Game.HSnake.Basic
+    - Game.HSnake.Board
+    - Game.HSnake.Game
+    - Game.HSnake.Graphics
+    - Game.HSnake.Player
+    - Game.HSnake.Snake
 
 executable:
   main: Main.hs

src/HSnake/AI.hs renamed to src/Game/HSnake/AI.hs

@@ -1,11 +1,11 @@
-module HSnake.AI where
+module Game.HSnake.AI where
 
 import Control.Lens
 
-import HSnake.Basic
-import HSnake.Game
-import HSnake.Player
-import HSnake.Snake
+import Game.HSnake.Basic
+import Game.HSnake.Game
+import Game.HSnake.Player
+import Game.HSnake.Snake
 
 computeAIPlayerMove :: Player -> GameState -> Direction
 computeAIPlayerMove pl gameState = circleAIPlayer pl

src/HSnake/Basic.hs renamed to src/Game/HSnake/Basic.hs

@@ -1,5 +1,5 @@
 -- Basic.hs -- basic functions and datatypes
-module HSnake.Basic where
+module Game.HSnake.Basic where
 
 import Control.Lens
 

src/HSnake/Board.hs renamed to src/Game/HSnake/Board.hs

@@ -1,9 +1,9 @@
 -- Board.hs -- board logic
-module HSnake.Board where
+module Game.HSnake.Board where
 
 import Control.Lens
 
-import HSnake.Basic
+import Game.HSnake.Basic
 
 data Board = Board {
      _xSize   :: Int,

src/HSnake/Game.hs renamed to src/Game/HSnake/Game.hs

@@ -1,16 +1,16 @@
-module HSnake.Game where
+module Game.HSnake.Game where
 
-import HSnake.Basic
-import HSnake.Board
-import HSnake.Player
-import HSnake.Snake
+import Game.HSnake.Basic
+import Game.HSnake.Board
+import Game.HSnake.Player
+import Game.HSnake.Snake
 
 import Control.Lens
 import Data.Word
 
 data GameState = GameState {
      _players            :: [Player],
-     _applePosition      :: HSnake.Basic.Point,
+     _applePosition      :: Game.HSnake.Basic.Point,
      _board              :: Board,
      _level              :: Int,
      _lastTick           :: Word32
@@ -20,7 +20,7 @@ makeLenses ''GameState
 initialGameState :: GameState
 initialGameState = GameState
                  [initialPlayer, initialComputer]
-                 (HSnake.Basic.Point 0 0)
+                 (Game.HSnake.Basic.Point 0 0)
                  initialBoard
                  1
                  0

src/HSnake/Graphics.hs renamed to src/Game/HSnake/Graphics.hs

@@ -1,10 +1,10 @@
-module HSnake.Graphics where
+module Game.HSnake.Graphics where
 
-import HSnake.Basic
-import HSnake.Board
-import HSnake.Game
-import HSnake.Player
-import HSnake.Snake
+import Game.HSnake.Basic
+import Game.HSnake.Board
+import Game.HSnake.Game
+import Game.HSnake.Player
+import Game.HSnake.Snake
 
 
 import Control.Lens
@@ -57,8 +57,8 @@ rectHeight :: Int
 rectHeight = gameScreenHeight `div` numRectsY
 
 
-rectFromPoint :: HSnake.Basic.Point -> SDLRect
-rectFromPoint (HSnake.Basic.Point x y) = SDL.Rectangle startPoint size
+rectFromPoint :: Game.HSnake.Basic.Point -> SDLRect
+rectFromPoint (Game.HSnake.Basic.Point x y) = SDL.Rectangle startPoint size
                 where
                     startX = (x - 1)*rectWidth + 1
                     startY = (y - 1)*rectHeight + 1
@@ -68,7 +68,7 @@ rectFromPoint (HSnake.Basic.Point x y) = SDL.Rectangle startPoint size
                     size = V2 (fromIntegral width) (fromIntegral height)
 
 
-rects = [rectFromPoint (HSnake.Basic.Point ptx pty) | ptx <- [1..numRectsX], pty <- [1..numRectsY]]
+rects = [rectFromPoint (Game.HSnake.Basic.Point ptx pty) | ptx <- [1..numRectsX], pty <- [1..numRectsY]]
 rectsVec = DVS.generate (numRectsX * numRectsY)
   (\i -> rects !! i )
 
@@ -82,7 +82,7 @@ paintBoard :: SDL.Renderer -> IO ()
 paintBoard r = do
   paintRects r White
 
-paintApple :: SDL.Renderer -> HSnake.Basic.Point -> IO ()
+paintApple :: SDL.Renderer -> Game.HSnake.Basic.Point -> IO ()
 paintApple r ap = do
   setColor r Red
   SDL.fillRect r $ Just rect

src/HSnake/Player.hs renamed to src/Game/HSnake/Player.hs

@@ -1,9 +1,9 @@
-module HSnake.Player where
+module Game.HSnake.Player where
 
 import Control.Lens
 
-import HSnake.Basic
-import HSnake.Snake
+import Game.HSnake.Basic
+import Game.HSnake.Snake
 
 import Data.List
 
@@ -24,18 +24,21 @@ data Player = Player {
 
 makeLenses ''Player
 
+initialPlayer :: Player
 initialPlayer = Player
               Human
               initialSnake
               (initialSnake^.direction)
               Green
 
+initialPlayerBottom :: Player
 initialPlayerBottom = Player
               Human
               initialSnakeBottom
               (initialSnakeBottom^.direction)
               Green
 
+initialComputer :: Player
 initialComputer = Player
               AI
               initialSnakeBottom

src/HSnake/Snake.hs renamed to src/Game/HSnake/Snake.hs

@@ -1,9 +1,9 @@
 -- Snake.hs: Snake-control logic
-module HSnake.Snake where
+module Game.HSnake.Snake where
 
 import Control.Lens
 
-import HSnake.Basic
+import Game.HSnake.Basic
 
 import Data.List (nub, sort)
 
@@ -46,19 +46,26 @@ checkCollision snake = outOfBoundary || selfCollision
                     selfCollision = (length (nub snakePosition)) /= (length snakePosition)
 
 -- | Starting position & body
+initialSnakePosition :: [Point]
 initialSnakePosition = [Point 6 6]
+
+initialSnakePositionBottom :: [Point]
 initialSnakePositionBottom = [Point 6 11]
+
+initialSnake :: Snake
 initialSnake = Snake initialSnakePosition North 1
+
+initialSnakeBottom :: Snake
 initialSnakeBottom = Snake initialSnakePositionBottom North 1
 
 snakeEatsApple :: Snake -> Point -> Bool
 snakeEatsApple snake apple = apple `elem` (snake^.position)
 
 -- | Don't allow to change to opposite direction immediately
 tryChangeSnakeDirection :: Direction -> Direction -> Direction
-tryChangeSnakeDirection direction snakeDirection
-            | oppositeDirections direction snakeDirection = snakeDirection
-            | otherwise    = direction
+tryChangeSnakeDirection d sd
+  | oppositeDirections d sd = sd
+  | otherwise    = d
 
 changeSnakeDirection :: Snake -> Direction -> Snake
-changeSnakeDirection snake dir = direction .~ (tryChangeSnakeDirection dir (snake^.direction)) $ snake
+changeSnakeDirection s d = direction .~ (tryChangeSnakeDirection d (s^.direction)) $ s