From fc3df3a86d2ab70df6562b4d9809c1f43c322f32 Mon Sep 17 00:00:00 2001 From: Govind Krishna Joshi Date: Sat, 11 Jul 2015 12:08:24 +0530 Subject: [PATCH 1/4] Cabal configure to run tests --- .gitignore | 8 ++++++++ hastron.cabal | 12 ++++++++++++ 2 files changed, 20 insertions(+) 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/hastron.cabal b/hastron.cabal index 33410fa..1c2e6ea 100644 --- a/hastron.cabal +++ b/hastron.cabal @@ -25,3 +25,15 @@ executable hastron hashable >=1.2 && <1.3 hs-source-dirs: src default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: tests + main-is: TestMain.hs + build-depends: + base >=4.7 && <4.9, + tasty >=0.10 && <0.11, + tasty-hunit >=0.9 && <0.10, + tasty-quickcheck >=0.8 && <0.9 + From 4bbea62c27d77f5e0cde498d528d00199f9b7b02 Mon Sep 17 00:00:00 2001 From: Govind Krishna Joshi Date: Sat, 11 Jul 2015 12:20:02 +0530 Subject: [PATCH 2/4] Adding dummy test module --- tests/TestMain.hs | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 tests/TestMain.hs diff --git a/tests/TestMain.hs b/tests/TestMain.hs new file mode 100644 index 0000000..d547ccf --- /dev/null +++ b/tests/TestMain.hs @@ -0,0 +1,3 @@ +module TestMain where + + From a61e874b163b1259ed992a3ab25f6f56d4efa947 Mon Sep 17 00:00:00 2001 From: Govind Krishna Joshi Date: Sun, 12 Jul 2015 19:41:47 +0530 Subject: [PATCH 3/4] Added testing setup with Tasty --- Player | 0 Setup.hs | 2 +- hastron.cabal | 21 +++++++++++---------- src/Hastron/Game/Player.hs | 17 +++++++++++++++++ src/Hastron/Game/Types.hs | 8 ++++++-- src/Hastron/Utils.hs | 11 +++++++++++ src/Main.hs | 1 + tests/Hastron/Game/Properties.hs | 5 +++++ tests/Hastron/Game/UnitTests.hs | 7 +++++++ tests/Hastron/TestUtils.hs | 24 ++++++++++++++++++++++++ tests/TestMain.hs | 20 +++++++++++++++++++- 11 files changed, 102 insertions(+), 14 deletions(-) create mode 100644 Player create mode 100644 src/Hastron/Game/Player.hs create mode 100644 src/Hastron/Utils.hs create mode 100644 tests/Hastron/Game/Properties.hs create mode 100644 tests/Hastron/Game/UnitTests.hs create mode 100644 tests/Hastron/TestUtils.hs 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 1c2e6ea..1ba7847 100644 --- a/hastron.cabal +++ b/hastron.cabal @@ -3,13 +3,10 @@ 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 @@ -17,23 +14,27 @@ cabal-version: >=1.10 executable hastron main-is: Main.hs + ghc-options: -Wall 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, - hashable >=1.2 && <1.3 + Hastron.Utils + build-depends: + base >=4.7 && <4.9, + text >=1.2 && <1.3, + unordered-containers >=0.2.5 && <0.3, + hashable >=1.2 && <1.3 hs-source-dirs: src default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 + ghc-options: -Wall default-language: Haskell2010 - hs-source-dirs: tests + hs-source-dirs: src, tests main-is: TestMain.hs build-depends: base >=4.7 && <4.9, tasty >=0.10 && <0.11, tasty-hunit >=0.9 && <0.10, - tasty-quickcheck >=0.8 && <0.9 + 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..2fa9c3e --- /dev/null +++ b/src/Hastron/Game/Player.hs @@ -0,0 +1,17 @@ +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 } + +turnRight :: Player -> Player +turnRight player = turn (Utils.nextEnum (direction player)) player + +direction :: Player -> Direction +direction Player {playerVelocity=(Velocity _ dir)} = dir + +changeDirection :: Velocity -> Direction -> Velocity +changeDirection (Velocity val _) dir = Velocity val dir diff --git a/src/Hastron/Game/Types.hs b/src/Hastron/Game/Types.hs index 2bbde81..f7b5506 100644 --- a/src/Hastron/Game/Types.hs +++ b/src/Hastron/Game/Types.hs @@ -1,10 +1,14 @@ module Hastron.Game.Types where -import Data.HashMap.Strict (HashMap) +import Data.HashMap.Strict (HashMap) 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 Double Direction deriving (Show, Eq, Ord) 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 index 63a8464..8c698fd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,7 @@ module Main where import Hastron.Server.Types +import Hastron.Utils main :: IO() main = putStrLn "Hello World" diff --git a/tests/Hastron/Game/Properties.hs b/tests/Hastron/Game/Properties.hs new file mode 100644 index 0000000..f1ee7ac --- /dev/null +++ b/tests/Hastron/Game/Properties.hs @@ -0,0 +1,5 @@ +module Hastron.Game.Properties where + +import qualified Test.Tasty as Test +import qualified Test.Test.Quickcheck as QC + diff --git a/tests/Hastron/Game/UnitTests.hs b/tests/Hastron/Game/UnitTests.hs new file mode 100644 index 0000000..82b8413 --- /dev/null +++ b/tests/Hastron/Game/UnitTests.hs @@ -0,0 +1,7 @@ +module Hastron.Game.UnitTests (unitTests) where + +import qualified Test.Tasty as Test + +unitTests :: Test.TestTree +unitTests = [] + diff --git a/tests/Hastron/TestUtils.hs b/tests/Hastron/TestUtils.hs new file mode 100644 index 0000000..b52f0cf --- /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 index d547ccf..264e078 100644 --- a/tests/TestMain.hs +++ b/tests/TestMain.hs @@ -1,3 +1,21 @@ -module TestMain where +module Main where +import qualified Test.Tasty as Tasty +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 + ] + +hUnitTests :: Tasty.TestTree +hUnitTests = Tasty.testGroup "HUnit unit tests" [] From af2cd56c810a9101a9536ae1b0b016fdeabbb650 Mon Sep 17 00:00:00 2001 From: Govind Krishna Joshi Date: Mon, 13 Jul 2015 00:42:34 +0530 Subject: [PATCH 4/4] Some refactoring & added player functions --- src/Main.hs => Main.hs | 0 hastron.cabal | 32 ++++++++++------ src/Hastron/Game/Player.hs | 15 ++++++-- src/Hastron/Game/Types.hs | 4 +- tests/Hastron/Game/Properties.hs | 5 --- tests/Hastron/Game/TestPlayer.hs | 63 ++++++++++++++++++++++++++++++++ tests/Hastron/Game/UnitTests.hs | 7 ---- tests/Hastron/TestUtils.hs | 2 +- tests/TestMain.hs | 8 ++-- 9 files changed, 104 insertions(+), 32 deletions(-) rename src/Main.hs => Main.hs (100%) delete mode 100644 tests/Hastron/Game/Properties.hs create mode 100644 tests/Hastron/Game/TestPlayer.hs delete mode 100644 tests/Hastron/Game/UnitTests.hs diff --git a/src/Main.hs b/Main.hs similarity index 100% rename from src/Main.hs rename to Main.hs diff --git a/hastron.cabal b/hastron.cabal index 1ba7847..4188db4 100644 --- a/hastron.cabal +++ b/hastron.cabal @@ -1,6 +1,3 @@ --- Initial hastron.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: hastron version: 0.1.0.0 license: MIT @@ -12,27 +9,40 @@ build-type: Simple extra-source-files: README.md cabal-version: >=1.10 -executable hastron - main-is: Main.hs - ghc-options: -Wall - other-modules: Hastron.Server.Types - Hastron.Utils - build-depends: +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 - hs-source-dirs: src + + +executable hastron-exec + main-is: Main.hs + 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: src, tests + 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, diff --git a/src/Hastron/Game/Player.hs b/src/Hastron/Game/Player.hs index 2fa9c3e..83c90cb 100644 --- a/src/Hastron/Game/Player.hs +++ b/src/Hastron/Game/Player.hs @@ -3,15 +3,24 @@ 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 -changeDirection :: Velocity -> Direction -> Velocity -changeDirection (Velocity val _) dir = Velocity val 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 f7b5506..c058027 100644 --- a/src/Hastron/Game/Types.hs +++ b/src/Hastron/Game/Types.hs @@ -18,7 +18,7 @@ data PlayerState = PlayerAlive | PlayerDead | PlayerDisconnected | PlayerLeft - deriving (Show, Eq, Ord, Enum) + deriving (Show, Eq, Ord, Enum, Bounded) type PlayerTrail = [Point] @@ -38,7 +38,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/tests/Hastron/Game/Properties.hs b/tests/Hastron/Game/Properties.hs deleted file mode 100644 index f1ee7ac..0000000 --- a/tests/Hastron/Game/Properties.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Hastron.Game.Properties where - -import qualified Test.Tasty as Test -import qualified Test.Test.Quickcheck as QC - 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/Game/UnitTests.hs b/tests/Hastron/Game/UnitTests.hs deleted file mode 100644 index 82b8413..0000000 --- a/tests/Hastron/Game/UnitTests.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Hastron.Game.UnitTests (unitTests) where - -import qualified Test.Tasty as Test - -unitTests :: Test.TestTree -unitTests = [] - diff --git a/tests/Hastron/TestUtils.hs b/tests/Hastron/TestUtils.hs index b52f0cf..5d8b2b0 100644 --- a/tests/Hastron/TestUtils.hs +++ b/tests/Hastron/TestUtils.hs @@ -16,7 +16,7 @@ instance (Enum a, Bounded a) => Arbit.Arbitrary (Enum' a) where properties :: Test.TestTree properties = Test.testGroup "Utils Properties" - [ QC.testProperty "Additive inverse for turning" $ + [ QC.testProperty "Additive inverse for turning" $ \n e -> prop_additive_turning_inverse (n :: Int) (e :: Enum' Char) ] diff --git a/tests/TestMain.hs b/tests/TestMain.hs index 264e078..a955a6b 100644 --- a/tests/TestMain.hs +++ b/tests/TestMain.hs @@ -1,8 +1,9 @@ module Main where -import qualified Test.Tasty as Tasty +import qualified Test.Tasty as Tasty -import qualified Hastron.TestUtils as Utils +import qualified Hastron.Game.TestPlayer as Player +import qualified Hastron.TestUtils as Utils main :: IO () main = Tasty.defaultMain tests @@ -15,7 +16,8 @@ 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" []