From af2cd56c810a9101a9536ae1b0b016fdeabbb650 Mon Sep 17 00:00:00 2001 From: Govind Krishna Joshi Date: Mon, 13 Jul 2015 00:42:34 +0530 Subject: [PATCH] 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" []