added callbacks to CreatePlayerState

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
@@ -203,7 +210,11 @@ data CreatePlayerState = CreatePlayerState
   -- ^ The player's name
   , _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
@@ -476,6 +487,8 @@ newCreatePlayerState = CreatePlayerState
   { _cpsNumber          = Nothing
   , _cpsName            = ""
   , _cpsPosition        = ""
+  , _cpsSuccessCallback = return ()
+  , _cpsFailureCallback = return ()
   }
 
 -- | Constructor for a 'Database'

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" $
@@ -255,22 +255,26 @@ 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'
+      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'
+      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'
+      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'
+      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

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