Merge branch 'engine-govind'

.gitignore

@@ -15,3 +15,11 @@ cabal.sandbox.config
 *.prof
 *.aux
 *.hp
+
+# Vim
+[._]*.s[a-w][a-z]
+[._]s[a-w][a-z]
+*.un~
+Session.vim
+.netrwhist
+*~

Main.hs

@@ -0,0 +1,7 @@
+module Main where
+
+import           Hastron.Game.Engine
+import           Hastron.Server.Types
+
+main :: IO()
+main = putStrLn "Hello World"

Setup.hs

@@ -1,2 +1,2 @@
-import Distribution.Simple
+import           Distribution.Simple
 main = defaultMain

hastron.cabal

@@ -1,31 +1,50 @@
--- Initial hastron.cabal generated by cabal init.  For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
 name:                hastron
 version:             0.1.0.0
--- synopsis:
--- description:
 license:             MIT
 license-file:        LICENSE
 author:              Abhinav Sarkar
 maintainer:          abhinav@abhinavsarkar.net
--- copyright:
 category:            Game
 build-type:          Simple
 extra-source-files:  README.md
 cabal-version:       >=1.10
 
+library
+  default-language:   Haskell2010
+  ghc-options:        -Wall
+  hs-source-dirs:     src
+  exposed-modules: 
+    Hastron.Server.Types
+    Hastron.Utils
+    Hastron.Game.Player
+    Hastron.Game.Types
+    Hastron.Game.Engine
+  build-depends:    
+    base >=4.7 && <4.9,
+    text >=1.2 && <1.3,
+    unordered-containers >=0.2.5 && <0.3,
+    hashable >=1.2 && <1.3
+
+
 executable hastron
   main-is:             Main.hs
-  other-modules:       Hastron.Server.Types
-  -- other-extensions:
-  build-depends:       base >=4.7 && <4.9,
-                       text >=1.2 && <1.3,
-                       unordered-containers >=0.2.5 && <0.3,
-                       dlist >= 0.7 && <0.8,
-                       mtl >= 2.2 && <2.3,
-                       bifunctors >=5 && <6,
-                       hashable >=1.2 && <1.3
-  hs-source-dirs:      src
-  default-language:    Haskell2010
   ghc-options:         -Wall
+  build-depends:       
+    base >=4.7 && <4.9,
+    hastron
+  default-language:    Haskell2010
+
+test-suite test
+  type:               exitcode-stdio-1.0
+  ghc-options:        -Wall
+  default-language:   Haskell2010
+  hs-source-dirs:     tests
+  main-is:            TestMain.hs
+  build-depends:      
+    base >=4.7 && <4.9,
+    hastron, 
+    tasty >=0.10 && <0.11,
+    tasty-hunit >=0.9 && <0.10,
+    tasty-quickcheck >=0.8 && <0.9,
+    QuickCheck >=2.8 && <2.9
+

src/Hastron/Game/Engine.hs

@@ -34,7 +34,7 @@ stepGameEngine gameSettings gameMap player =
   . (\rwst -> execRWST rwst gameSettings (gameMap, player))
   . _runGameEngine
 
-move :: TimeInterval -> GameEngine ()
+move :: Int -> GameEngine ()
 move timeElapsed = do
   state    <- get
   settings <- ask
@@ -48,7 +48,7 @@ move timeElapsed = do
       where
         (x, y)               = playerPosition
         (Velocity speed dir) = playerVelocity
-        PlayerBoost{ .. }    = playerBoost
+        PlayerBoost{ .. }      = playerBoost
         dist                 =
           timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
 
@@ -95,6 +95,9 @@ rightTurn Right = Down
 rightTurn Up    = Right
 rightTurn Down  = Left
 
+noTurn :: Direction -> Direction
+noTurn = id
+
 turn :: (Direction -> Direction) -> GameEngine ()
 turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
   player { playerVelocity = Velocity speed $ turnFn dir }
@@ -103,21 +106,21 @@ changeBoost :: Bool -> GameEngine ()
 changeBoost boostActive = modify . second $ \player@Player{ .. } ->
   player { playerBoost = playerBoost { boostActive = boostActive } }
 
-refillBoost :: Timestamp -> GameEngine ()
+refillBoost :: Int -> GameEngine ()
 refillBoost timeElapsed = do
   (gameMap, player@Player{ .. }) <- get
   GameSettings{ .. }             <- ask
   let boostFuel'   = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
-      playerBoost' = playerBoost { boostFuel = boostFuel playerBoost + boostFuel' }
+      playerBoost' = playerBoost { boostFuel = boostFuel' }
   put (gameMap, player { playerBoost = playerBoost' })
   tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
 
-stepGame :: Game -> Timestamp -> InEvent -> (Game, [OutEvent])
+stepGame :: Game -> Int -> InEvent -> (Game, [OutEvent])
 stepGame game@Game{ gameMap = gameMap@GameMap{ .. }, .. } time = stepGame'
   where
     stepGame' (InPlayerTurnLeft playerId)                = stepEvent playerId $ turn leftTurn
     stepGame' (InPlayerTurnRight playerId)               = stepEvent playerId $ turn rightTurn
-    stepGame' (InPlayerIdle playerId)                    = stepEvent playerId $ return ()
+    stepGame' (InPlayerIdle playerId)                    = stepEvent playerId $ turn noTurn
     stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive
 
     stepEvent pId step =
@@ -141,7 +144,7 @@ stepGame game@Game{ gameMap = gameMap@GameMap{ .. }, .. } time = stepGame'
 
     score (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
 
-runGame :: Game -> [(Timestamp, InEvent)] -> (Game, [OutEvent])
+runGame :: Game -> [(Int, InEvent)] -> (Game, [OutEvent])
 runGame initialGame =
   foldl (\(game, outEvents) (time, inEvent) ->
             fmap (outEvents ++) $ stepGame game time inEvent)

src/Hastron/Game/Player.hs

@@ -0,0 +1,26 @@
+module Hastron.Game.Player where
+
+import           Hastron.Game.Types
+import qualified Hastron.Utils      as Utils
+
+turn :: Direction -> Player -> Player
+turn dir player = player { playerVelocity = changeDirection (playerVelocity player) dir }
+  where changeDirection (Velocity v _) d = Velocity v d
+
+turnRight :: Player -> Player
+turnRight player = turn (Utils.nextEnum (direction player)) player
+
+turnLeft :: Player -> Player
+turnLeft player = turn (Utils.prevEnum (direction player)) player
+
+direction :: Player -> Direction
+direction Player {playerVelocity=(Velocity _ dir)} = dir
+
+toggleBoost :: PlayerBoost -> PlayerBoost
+toggleBoost boost@(PlayerBoost { boostActive = curr }) = boost { boostActive = not curr }
+
+updateBoostValue :: (Double -> Double) -> PlayerBoost -> PlayerBoost
+updateBoostValue func boost@(PlayerBoost {boostFuel = fuel}) = boost { boostFuel = func fuel }
+
+changeState :: PlayerState -> Player -> Player
+changeState new player = player { playerState = new }

src/Hastron/Game/Types.hs

@@ -7,78 +7,79 @@ import           Data.HashSet        (HashSet)
 import qualified Data.HashSet        as Set
 import           Data.Tuple          (swap)
 
-type Point          = (Int, Int)
+type Point = (Int, Int)
 
-type Timestamp      = Int
+data Direction = Left
+               | Up
+               | Right
+               | Down
+               deriving (Show, Eq, Ord, Enum, Bounded)
 
-type TimeInterval   = Int
+data Velocity = Velocity Int Direction deriving (Show, Eq, Ord)
 
-data Direction      = Left | Right | Up | Down deriving (Show, Eq, Ord, Enum)
+type PlayerId = Int
 
-data Velocity       = Velocity Int Direction deriving (Show, Eq, Ord)
+data PlayerState = PlayerAlive
+                 | PlayerDead
+                 | PlayerDisconnected
+                 | PlayerLeft
+                 deriving (Show, Eq, Ord, Enum, Bounded)
 
-type PlayerId       = Int
+type PlayerTrail = [Point]
 
-data PlayerState    = PlayerAlive
-                    | PlayerDead
-                    | PlayerDisconnected
-                    | PlayerLeft
-                    deriving (Show, Eq, Ord, Enum)
+data PlayerBoost = PlayerBoost { boostActive :: Bool
+                               , boostFuel   :: Int
+                               } deriving (Show, Eq)
 
-type PlayerTrail    = [Point]
+type PlayerScore = Int
 
-data PlayerBoost    = PlayerBoost { boostActive :: Bool
-                                  , boostFuel   :: Int
-                                  } deriving (Show, Eq)
-
-type PlayerScore    = Int
-
-data Player         = Player { playerId            :: PlayerId
-                             , playerState         :: PlayerState
-                             , playerPosition      :: Point
-                             , playerVelocity      :: Velocity
-                             , playerTrail         :: PlayerTrail
-                             , playerBoost         :: PlayerBoost
-                             , playerScore         :: PlayerScore
-                             , playerLastEventTime :: Int
-                             } deriving (Show, Eq)
+data Player = Player { playerId            :: PlayerId
+                     , playerState         :: PlayerState
+                     , playerPosition      :: Point
+                     , playerVelocity      :: Velocity
+                     , playerTrail         :: PlayerTrail
+                     , playerBoost         :: PlayerBoost
+                     , playerScore         :: PlayerScore
+                     , playerLastEventTime :: Int
+                     } deriving (Show, Eq)
 
 data PlayerEndState = PlayerWinner | PlayerLoser | PlayerDropped
-                      deriving (Show, Eq, Ord, Enum)
+                      deriving (Show, Eq, Ord, Enum, Bounded)
 
-data GameState      = GameStarted | GameInit | GameFinished
-                      deriving (Show, Eq, Ord, Enum)
+data GameState = GameStarted | GameInit | GameFinished
+                 deriving (Show, Eq, Ord, Enum)
 
-data GameMap        = GameMap { size                 :: Int
-                              , gameMapBlockedPoints :: HashSet Point
-                              } deriving (Show, Eq)
+data GameMap = GameMap { size                 :: Int
+                       , gameMapBlockedPoints :: HashSet Point }
+               deriving (Show, Eq)
 
-data GameSettings   = GameSettings { gameBoostFactor       :: Int
-                                   , gameBoostRefillFactor :: Double
-                                   } deriving (Show, Eq)
-
-data Game           = Game { gamePlayers  :: HashMap PlayerId Player
-                           , gameState    :: GameState
-                           , gameSettings :: GameSettings
-                           , gameMap      :: GameMap
-                           } deriving (Show, Eq)
-
-type GameResult     = HashMap PlayerId (PlayerScore, PlayerEndState)
-
-data InEvent        = InPlayerTurnLeft PlayerId
-                    | InPlayerTurnRight PlayerId
-                    | InPlayerBoostChange PlayerId Bool
-                    | InPlayerStateChange PlayerId PlayerState
-                    | InPlayerIdle PlayerId
-                    deriving (Show, Eq, Ord)
-
-data OutEvent       = OutPlayerPosition PlayerId Point Direction
-                    | OutPlayerStateChange PlayerId PlayerState
-                    | OutPlayerBoostChange PlayerId PlayerBoost
-                    | OutGameStateChange GameState
-                    | OutGameOver GameResult
+data GameSettings = GameSettings { gameBoostFactor       :: Int
+                                 , gameBoostRefillFactor :: Double
+                                 }
                     deriving (Show, Eq)
 
+data Game = Game { gamePlayers  :: HashMap PlayerId Player
+                 , gameState    :: GameState
+                 , gameSettings :: GameSettings
+                 , gameMap      :: GameMap
+                 } deriving (Show, Eq)
+
+type GameResult = HashMap PlayerId (PlayerScore, PlayerEndState)
+
+data InEvent = InPlayerTurnLeft PlayerId
+             | InPlayerTurnRight PlayerId
+             | InPlayerBoostChange PlayerId Bool
+             | InPlayerStateChange PlayerId PlayerState
+             | InPlayerIdle PlayerId
+             deriving (Show, Eq, Ord)
+
+data OutEvent = OutPlayerPosition PlayerId Point Direction
+              | OutPlayerStateChange PlayerId PlayerState
+              | OutPlayerBoostChange PlayerId PlayerBoost
+              | OutGameStateChange GameState
+              | OutGameOver GameResult
+              deriving (Show, Eq)
+
 newGameMap :: Int -> GameMap
 newGameMap size = GameMap size $ Set.fromList borderPoints
   where
@@ -86,18 +87,18 @@ newGameMap size = GameMap size $ Set.fromList borderPoints
                    in xs ++ map swap xs
 
 newGame :: Int -> GameSettings -> Game
-newGame size gameSettings = Game { gamePlayers  = Map.empty
-                                 , gameState    = GameInit
-                                 , gameSettings = gameSettings
-                                 , gameMap      = newGameMap size
-                                 }
+newGame size gameSettings = Game { gamePlayers   = Map.empty
+                                  , gameState    = GameInit
+                                  , gameSettings = gameSettings
+                                  , gameMap      = newGameMap size
+                                  }
 
 newPlayer :: Int -> Point -> Velocity -> Int -> Player
 newPlayer pId pos velocity boost =
   Player pId PlayerAlive pos velocity [pos] (PlayerBoost False boost) 0 0
 
 addPlayer :: Game -> Player -> Game
-addPlayer game@Game{ gameMap = gameMap@GameMap{ .. }, .. } player@Player{ .. } =
+addPlayer game@Game{gameMap = gameMap@GameMap{..}, ..} player@Player{..} =
   game { gamePlayers = Map.insert playerId player gamePlayers
        , gameMap     = gameMap { gameMapBlockedPoints =
-                                   Set.insert playerPosition gameMapBlockedPoints } }
+                                   Set.insert playerPosition gameMapBlockedPoints }}

src/Hastron/Utils.hs

@@ -0,0 +1,11 @@
+module Hastron.Utils where
+
+nextEnum :: (Enum a, Bounded a) => a -> a
+nextEnum = turnEnum 1
+
+prevEnum :: (Enum a, Bounded a) => a -> a
+prevEnum = turnEnum (-1)
+
+turnEnum :: (Enum a, Bounded a) => Int -> a -> a
+turnEnum n e = toEnum $ mod (sum [fromEnum e, n]) enumLength
+  where enumLength = succ (fromEnum (maxBound `asTypeOf` e))

src/Main.hs

@@ -1,7 +0,0 @@
-module Main where
-
-import Hastron.Server.Types
-import Hastron.Game.Engine
-
-main :: IO()
-main = putStrLn "Hello World"

tests/Hastron/Game/TestPlayer.hs

@@ -0,0 +1,63 @@
+module Hastron.Game.TestPlayer where
+
+import qualified Test.QuickCheck.Arbitrary as Arbit
+import qualified Test.Tasty                as Test
+import qualified Test.Tasty.QuickCheck     as QC
+
+import qualified Hastron.Game.Player       as Player
+import qualified Hastron.Game.Types        as Types
+import qualified Hastron.Utils             as Utils
+
+properties :: Test.TestTree
+properties = Test.testGroup "Player Properties"
+  [ QC.testProperty "Turn player right" prop_turn_player_right
+  , QC.testProperty "Turn player left" prop_turn_player_left
+  ]
+
+-- | Arbitrary instance declarations
+instance Arbit.Arbitrary Types.Direction where
+  arbitrary = Arbit.arbitraryBoundedEnum
+
+instance Arbit.Arbitrary Types.Velocity where
+  arbitrary = do
+    vel <- Arbit.arbitrary
+    dir <- Arbit.arbitrary
+    return $ Types.Velocity vel dir
+
+instance Arbit.Arbitrary Types.PlayerState where
+  arbitrary = Arbit.arbitraryBoundedEnum
+
+instance Arbit.Arbitrary Types.PlayerBoost where
+  arbitrary = do
+    active <- Arbit.arbitrary
+    fuel <- Arbit.arbitrary
+    return Types.PlayerBoost { Types.boostActive = active, Types.boostFuel = fuel }
+
+instance Arbit.Arbitrary Types.Player where
+  arbitrary = do
+    id <- Arbit.arbitrary
+    state <- Arbit.arbitrary
+    position <- Arbit.arbitrary
+    velocity <- Arbit.arbitrary
+    trail <- Arbit.arbitrary
+    boost <- Arbit.arbitrary
+    score <- Arbit.arbitrary
+    return Types.Player { Types.playerId = id
+                        , Types.playerState = state
+                        , Types.playerPosition = position
+                        , Types.playerVelocity = velocity
+                        , Types.playerTrail = trail
+                        , Types.playerBoost = boost
+                        , Types.playerScore = score
+                        }
+
+
+instance Arbit.Arbitrary Types.PlayerEndState where
+  arbitrary = Arbit.arbitraryBoundedEnum
+
+-- | Properties 
+prop_turn_player_right :: Types.Player -> Bool
+prop_turn_player_right player = (Player.direction . Player.turnRight) player == (Utils.nextEnum . Player.direction) player
+
+prop_turn_player_left :: Types.Player -> Bool
+prop_turn_player_left player = (Player.direction . Player.turnLeft) player == (Utils.prevEnum . Player.direction) player

tests/Hastron/TestUtils.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Hastron.TestUtils (properties) where
+
+import qualified Test.QuickCheck.Arbitrary as Arbit
+import qualified Test.Tasty                as Test
+import qualified Test.Tasty.QuickCheck     as QC
+
+import qualified Hastron.Utils             as Utils
+
+newtype Enum' a = Enum' a
+  deriving (Eq, Bounded, Enum, Show)
+
+instance (Enum a, Bounded a) => Arbit.Arbitrary (Enum' a) where
+  arbitrary = Arbit.arbitraryBoundedEnum
+
+properties :: Test.TestTree
+properties = Test.testGroup "Utils Properties"
+  [ QC.testProperty "Additive inverse for turning" $
+      \n e -> prop_additive_turning_inverse (n :: Int) (e :: Enum' Char)
+  ]
+
+prop_additive_turning_inverse :: (Eq a, Show a, Enum a, Bounded a) => Int -> Enum' a -> Bool
+prop_additive_turning_inverse n (Enum' e) = e == ((Utils.turnEnum n) . (Utils.turnEnum (-n))) e

tests/TestMain.hs

@@ -0,0 +1,23 @@
+module Main where
+
+import qualified Test.Tasty              as Tasty
+
+import qualified Hastron.Game.TestPlayer as Player
+import qualified Hastron.TestUtils       as Utils
+
+main :: IO ()
+main = Tasty.defaultMain tests
+
+tests :: Tasty.TestTree
+tests = Tasty.testGroup "Tests" [properties, unitTests]
+
+unitTests :: Tasty.TestTree
+unitTests = Tasty.testGroup "Unit Tests" [hUnitTests]
+
+properties :: Tasty.TestTree
+properties = Tasty.testGroup "Quickcheck properties" [ Utils.properties
+                                                     , Player.properties
+                                                     ]
+
+hUnitTests :: Tasty.TestTree
+hUnitTests = Tasty.testGroup "HUnit unit tests" []