From 6dd935018949649c1ed8bae3b2496f92ecbb2904 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 13 Sep 2019 02:26:03 -0400 Subject: [PATCH] added callbacks to CreatePlayerState --- src/Mtlstats/Types.hs | 31 ++++++++++++++++++++++--------- test/ActionsSpec.hs | 26 +++++++++++++++----------- test/TypesSpec.hs | 41 ++++++++++++++++++++++++++--------------- 3 files changed, 63 insertions(+), 35 deletions(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index be3701b..ba47c40 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -59,6 +59,8 @@ module Mtlstats.Types ( cpsNumber, cpsName, cpsPosition, + cpsSuccessCallback, + cpsFailureCallback, -- ** Database Lenses dbPlayers, dbGoalies, @@ -157,7 +159,7 @@ data ProgState = ProgState -- ^ The program's mode , _inputBuffer :: String -- ^ Buffer for user input - } deriving (Eq, Show) + } -- | The program mode data ProgMode @@ -165,7 +167,12 @@ data ProgMode | NewSeason | NewGame GameState | CreatePlayer CreatePlayerState - deriving (Eq, Show) + +instance Show ProgMode where + show MainMenu = "MainMenu" + show NewSeason = "NewSeason" + show (NewGame _) = "NewGame" + show (CreatePlayer _) = "CreatePlayer" -- | The game state data GameState = GameState @@ -197,13 +204,17 @@ data GameType -- | Player creation status data CreatePlayerState = CreatePlayerState - { _cpsNumber :: Maybe Int + { _cpsNumber :: Maybe Int -- ^ The player's number - , _cpsName :: String + , _cpsName :: String -- ^ The player's name - , _cpsPosition :: String + , _cpsPosition :: String -- ^ The player's position - } deriving (Eq, Show) + , _cpsSuccessCallback :: Action () + -- ^ The function to call on success + , _cpsFailureCallback :: Action () + -- ^ The function to call on failure + } -- | Represents the database data Database = Database @@ -473,9 +484,11 @@ newGameState = GameState -- | Constructor for a 'CreatePlayerState' newCreatePlayerState :: CreatePlayerState newCreatePlayerState = CreatePlayerState - { _cpsNumber = Nothing - , _cpsName = "" - , _cpsPosition = "" + { _cpsNumber = Nothing + , _cpsName = "" + , _cpsPosition = "" + , _cpsSuccessCallback = return () + , _cpsFailureCallback = return () } -- | Constructor for a 'Database' diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 470492f..f6ee2f4 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -50,7 +50,7 @@ startNewSeasonSpec = describe "startNewSeason" $ do & startNewSeason it "should set the progState to NewSeason" $ - s ^. progMode `shouldBe` NewSeason + show (s^.progMode) `shouldBe` "NewSeason" it "should set the number of games to 0" $ s ^. database . dbGames `shouldBe` 0 @@ -63,7 +63,7 @@ startNewGameSpec = describe "startNewGame" $ do s ^. database . dbGames `shouldBe` 1 it "should set the mode to NewGame" $ - s ^. progMode `shouldBe` NewGame newGameState + show (s^.progMode) `shouldBe` "NewGame" resetYtdSpec :: Spec resetYtdSpec = describe "resetYtd" $ @@ -254,23 +254,27 @@ updateGameStatsSpec = describe "updateGameStats" $ do context "missing game type" $ it "should not change anything" $ let - s' = s Nothing (Just 1) (Just 2) (Just True) - in updateGameStats s' `shouldBe` s' + s' = s Nothing (Just 1) (Just 2) (Just True) + db' = updateGameStats s' ^. database + in db' `shouldBe` db 1 1 1 1 1 1 context "missing home score" $ it "should not change anything" $ let - s' = s (Just HomeGame) Nothing (Just 1) (Just True) - in updateGameStats s' `shouldBe` s' + s' = s (Just HomeGame) Nothing (Just 1) (Just True) + db' = updateGameStats s' ^. database + in db' `shouldBe` db 1 1 1 1 1 1 context "missing away score" $ it "should not change anything" $ let - s' = s (Just HomeGame) (Just 1) Nothing (Just True) - in updateGameStats s' `shouldBe` s' + s' = s (Just HomeGame) (Just 1) Nothing (Just True) + db' = updateGameStats s' ^. database + in db' `shouldBe` db 1 1 1 1 1 1 context "missing overtime flag" $ it "should not change anything" $ let - s' = s (Just HomeGame) (Just 1) (Just 2) Nothing - in updateGameStats s' `shouldBe` s' + s' = s (Just HomeGame) (Just 1) (Just 2) Nothing + db' = updateGameStats s' ^. database + in db' `shouldBe` db 1 1 1 1 1 1 validateGameDateSpec :: Spec validateGameDateSpec = describe "validateGameDate" $ do @@ -321,7 +325,7 @@ createPlayerSpec :: Spec createPlayerSpec = describe "createPlayer" $ it "should change the mode appropriately" $ let s = createPlayer newProgState - in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState + in show (s^.progMode) `shouldBe` "CreatePlayer" addPlayerSpec :: Spec addPlayerSpec = describe "addPlayer" $ do diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 68a15d2..85c008c 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -83,21 +83,32 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL where gs t = newGameState & gameType ?~ t createPlayerStateLSpec :: Spec -createPlayerStateLSpec = describe "createPlayerStateL" $ - lensSpec createPlayerStateL - -- getters - [ ( MainMenu, newCreatePlayerState ) - , ( CreatePlayer $ cps 1 , cps 1 ) - ] - -- setters - [ ( MainMenu, cps 1 ) - , ( CreatePlayer $ cps 1, cps 2 ) - ] - where - cps n = newCreatePlayerState - & cpsNumber ?~ n - & cpsName .~ "foo" - & cpsPosition .~ "bar" +createPlayerStateLSpec = describe "createPlayerStateL" $ do + context "getters" $ do + context "state missing" $ let + pm = MainMenu + cps = pm^.createPlayerStateL + in it "should not have a number" $ + cps^.cpsNumber `shouldBe` Nothing + + context "existing state" $ let + pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 + cps = pm^.createPlayerStateL + in it "should have a number of 1" $ + cps^.cpsNumber `shouldBe` Just 1 + + context "setters" $ do + context "state missing" $ let + pm = MainMenu + pm' = pm & createPlayerStateL.cpsNumber ?~ 1 + in it "should set the player number to 1" $ + pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1 + + context "existing state" $ let + pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 + pm' = pm & createPlayerStateL.cpsNumber ?~ 2 + in it "should set the player number to 2" $ + pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2 teamScoreSpec :: Spec teamScoreSpec = describe "teamScore" $ do