diff --git a/.gitignore b/.gitignore index 1fed3c3..8bfc1b1 100644 --- a/.gitignore +++ b/.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 +*~ diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..9066794 --- /dev/null +++ b/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Hastron.Game.Engine +import Hastron.Server.Types + +main :: IO() +main = putStrLn "Hello World" diff --git a/Player b/Player new file mode 100644 index 0000000..e69de29 diff --git a/Setup.hs b/Setup.hs index 9a994af..4467109 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/hastron.cabal b/hastron.cabal index 09212af..d7c2c6a 100644 --- a/hastron.cabal +++ b/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 + diff --git a/src/Hastron/Game/Player.hs b/src/Hastron/Game/Player.hs new file mode 100644 index 0000000..83c90cb --- /dev/null +++ b/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 } diff --git a/src/Hastron/Game/Types.hs b/src/Hastron/Game/Types.hs index d045909..3105be6 100644 --- a/src/Hastron/Game/Types.hs +++ b/src/Hastron/Game/Types.hs @@ -9,7 +9,11 @@ import Data.Tuple (swap) type Point = (Int, Int) -data Direction = Left | Right | Up | Down deriving (Show, Eq, Ord, Enum) +data Direction = Left + | Up + | Right + | Down + deriving (Show, Eq, Ord, Enum, Bounded) data Velocity = Velocity Int Direction deriving (Show, Eq, Ord) @@ -19,7 +23,7 @@ data PlayerState = PlayerAlive | PlayerDead | PlayerDisconnected | PlayerLeft - deriving (Show, Eq, Ord, Enum) + deriving (Show, Eq, Ord, Enum, Bounded) type PlayerTrail = [Point] @@ -40,7 +44,7 @@ data Player = Player { playerId :: PlayerId } 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) diff --git a/src/Hastron/Utils.hs b/src/Hastron/Utils.hs new file mode 100644 index 0000000..d2b30d2 --- /dev/null +++ b/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)) diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 index 431965b..0000000 --- a/src/Main.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import Hastron.Server.Types -import Hastron.Game.Engine - -main :: IO() -main = putStrLn "Hello World" diff --git a/tests/Hastron/Game/TestPlayer.hs b/tests/Hastron/Game/TestPlayer.hs new file mode 100644 index 0000000..949fbbb --- /dev/null +++ b/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 diff --git a/tests/Hastron/TestUtils.hs b/tests/Hastron/TestUtils.hs new file mode 100644 index 0000000..5d8b2b0 --- /dev/null +++ b/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 diff --git a/tests/TestMain.hs b/tests/TestMain.hs new file mode 100644 index 0000000..a955a6b --- /dev/null +++ b/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" []