implemented setHomeGame and setAwayGame

src/Mtlstats/Actions.hs

@@ -19,13 +19,17 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Mtlstats.Actions
   ( startNewSeason
   , resetYtd
   , startNewGame
+  , setHomeGame
+  , setAwayGame
   ) where
 
-import Lens.Micro ((.~), (%~))
+import Lens.Micro (over, (&), (.~), (%~))
 
 import Mtlstats.Types
 
@@ -44,3 +48,15 @@ startNewGame :: ProgState -> ProgState
 startNewGame
   = (progMode .~ NewGame newGameState)
   . (database . dbGames .~ 0)
+
+-- | Sets the game type to 'HomeGame'
+setHomeGame :: ProgState -> ProgState
+setHomeGame = over progMode $ \case
+  NewGame gs -> NewGame (gs & gameType .~ Just HomeGame)
+  _ -> NewGame $ newGameState & gameType .~ Just HomeGame
+
+-- | Sets the game type to 'AwayGame'
+setAwayGame :: ProgState -> ProgState
+setAwayGame = over progMode $ \case
+  NewGame gs -> NewGame (gs & gameType .~ Just AwayGame)
+  _ -> NewGame $ newGameState & gameType .~ Just AwayGame

src/Mtlstats/Events.hs

@@ -22,7 +22,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module Mtlstats.Events (handleEvent) where
 
 import Control.Monad.Trans.State (StateT, gets, modify)
-import Lens.Micro ((.~))
+import Lens.Micro ((^.), (.~))
 import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
@@ -40,4 +40,6 @@ handleEvent e = do
   case m of
     MainMenu   -> menuHandler mainMenu e
     NewSeason  -> menuHandler newSeasonMenu e >> return True
-    NewGame _ -> return True
+    NewGame gs -> if null $ gs ^. gameType
+      then menuHandler gameTypeMenu e >> return True
+      else undefined

src/Mtlstats/Menu.hs

@@ -25,11 +25,12 @@ module Mtlstats.Menu (
   menuHandler,
   -- * Menus
   mainMenu,
-  newSeasonMenu
+  newSeasonMenu,
+  gameTypeMenu
 ) where
 
 import Control.Monad.Trans.State (StateT, modify)
-import Lens.Micro ((^.))
+import Lens.Micro ((^.), (.~))
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
@@ -67,3 +68,12 @@ newSeasonMenu = Menu "*** SEASON TYPE ***" ()
   , MenuItem '2' "Playoffs" $
     modify startNewGame
   ]
+
+-- | The game type menu (home/away)
+gameTypeMenu :: Menu ()
+gameTypeMenu = Menu "*** GAME TYPE ***" ()
+  [ MenuItem '1' "Home Game" $
+    modify setHomeGame
+  , MenuItem '2' "Away Game" $
+    modify setAwayGame
+  ]

test/ActionsSpec.hs

@@ -24,7 +24,7 @@ module ActionsSpec (spec) where
 import Control.Monad (replicateM)
 import Lens.Micro ((&), (.~), (^.))
 import System.Random (randomRIO)
-import Test.Hspec (Spec, describe, it, shouldBe, shouldNotBe)
+import Test.Hspec (Spec, context, describe, it, shouldBe, shouldNotBe)
 
 import Mtlstats.Actions
 import Mtlstats.Types
@@ -34,6 +34,8 @@ spec = describe "Mtlstats.Actions" $ do
   startNewSeasonSpec
   startNewGameSpec
   resetYtdSpec
+  setHomeGameSpec
+  setAwayGameSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -104,6 +106,38 @@ resetYtdSpec = describe "resetYtd" $
         lt ^. gsTies          `shouldNotBe` 0) $
       s ^. database . dbGoalies
 
+setHomeGameSpec :: Spec
+setHomeGameSpec = describe "setHomeGame" $ do
+  let m = NewGame $ newGameState & gameType .~ Just HomeGame
+
+  context "unexpected mode" $
+    it "should set the game type" $ let
+      s = setHomeGame newProgState
+      in s ^. progMode `shouldBe` m
+
+  context "NewGame mode" $
+    it "should set the game type" $ let
+      s = newProgState
+        & progMode .~ NewGame newGameState
+        & setHomeGame
+      in s ^. progMode `shouldBe` m
+
+setAwayGameSpec :: Spec
+setAwayGameSpec = describe "setAwayGame" $ do
+  let m = NewGame $ newGameState & gameType .~ Just AwayGame
+
+  context "unexpected mode" $
+    it "should set the game type" $ let
+      s = setAwayGame newProgState
+      in s ^. progMode `shouldBe` m
+
+  context "NewGame mode" $
+    it "should set the game type" $ let
+      s = newProgState
+        & progMode .~ NewGame newGameState
+        & setAwayGame
+      in s ^. progMode `shouldBe` m
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum