Merge pull request #33 from mtlstats/refactor

Refactor

package.yaml

@@ -11,13 +11,13 @@ extra-source-files:
 - ChangeLog.md
 
 # Metadata used when publishing your package
-# synopsis:            Short description of your package
+synopsis:            Hockey statistics tracker
-# category:            Web
+category:            Statistics
 
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
+description:         Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
 
 dependencies:
 - base >= 4.7 && < 5

src/Mtlstats/Actions.hs

@@ -27,9 +27,6 @@ module Mtlstats.Actions
   , startNewGame
   , addChar
   , removeChar
-  , overtimeCheck
-  , updateGameStats
-  , validateGameDate
   , createPlayer
   , createGoalie
   , editPlayer
@@ -37,24 +34,16 @@ module Mtlstats.Actions
   , addGoalie
   , resetCreatePlayerState
   , resetCreateGoalieState
-  , recordGoalAssists
-  , awardGoal
-  , awardAssist
-  , resetGoalData
-  , assignPMins
   , backHome
   , scrollUp
   , scrollDown
   ) where
 
 import Control.Monad.Trans.State (modify)
-import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
-import Data.Time.Calendar (fromGregorianValid)
+import Lens.Micro ((^.), (&), (.~), (%~))
-import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
 
 import Mtlstats.Types
-import Mtlstats.Util
 
 -- | Starts a new season
 startNewSeason :: ProgState -> ProgState
@@ -82,65 +71,6 @@ removeChar = inputBuffer %~ \case
   ""  -> ""
   str -> init str
 
--- | Determines whether or not to perform a check for overtime
-overtimeCheck :: ProgState -> ProgState
-overtimeCheck s
-  | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
-    s & progMode.gameStateL
-    %~ (homeScore .~ Nothing)
-    .  (awayScore .~ Nothing)
-  | fromMaybe False $ gameWon $ s^.progMode.gameStateL =
-    s & progMode.gameStateL.overtimeFlag ?~ False
-  | otherwise  = s
-
--- | Adjusts the game stats based on the results of the current game
-updateGameStats :: ProgState -> ProgState
-updateGameStats s = fromMaybe s $ do
-  let gs = s^.progMode.gameStateL
-  gType  <- gs^.gameType
-  won    <- gameWon gs
-  lost   <- gameLost gs
-  ot     <- gs^.overtimeFlag
-  tScore <- teamScore gs
-  oScore <- otherScore gs
-  let
-    hw  = if gType == HomeGame && won then 1 else 0
-    hl  = if gType == HomeGame && lost then 1 else 0
-    hot = if gType == HomeGame && ot then 1 else 0
-    hgf = if gType == HomeGame then tScore else 0
-    hga = if gType == HomeGame then oScore else 0
-    aw  = if gType == AwayGame && won then 1 else 0
-    al  = if gType == AwayGame && lost then 1 else 0
-    aot = if gType == AwayGame && ot then 1 else 0
-    agf = if gType == AwayGame then tScore else 0
-    aga = if gType == AwayGame then oScore else 0
-  Just $ s
-    & database.dbHomeGameStats
-      %~ (gmsWins         +~ hw)
-      .  (gmsLosses       +~ hl)
-      .  (gmsOvertime     +~ hot)
-      .  (gmsGoalsFor     +~ hgf)
-      .  (gmsGoalsAgainst +~ hga)
-    & database.dbAwayGameStats
-      %~ (gmsWins         +~ aw)
-      .  (gmsLosses       +~ al)
-      .  (gmsOvertime     +~ aot)
-      .  (gmsGoalsFor     +~ agf)
-      .  (gmsGoalsAgainst +~ aga)
-
--- | Validates the game date
-validateGameDate :: ProgState -> ProgState
-validateGameDate s = fromMaybe s $ do
-  y <- toInteger <$> s^.progMode.gameStateL.gameYear
-  m <- s^.progMode.gameStateL.gameMonth
-  d <- s^.progMode.gameStateL.gameDay
-  Just $ if null $ fromGregorianValid y m d
-    then s & progMode.gameStateL
-      %~ (gameYear  .~ Nothing)
-      .  (gameMonth .~ Nothing)
-      .  (gameDay   .~ Nothing)
-    else s
-
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
@@ -199,81 +129,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
   %~ (cgsNumber .~ Nothing)
   .  (cgsName   .~ "")
 
--- | Awards the goal and assists to the players
-recordGoalAssists :: ProgState -> ProgState
-recordGoalAssists ps = fromMaybe ps $ do
-  let gs = ps^.progMode.gameStateL
-  goalId <- gs^.goalBy
-  let assistIds = gs^.assistsBy
-  Just $ ps
-    & awardGoal goalId
-    & (\s -> foldr awardAssist s assistIds)
-    & progMode.gameStateL
-      %~ (goalBy              .~ Nothing)
-      .  (assistsBy           .~ [])
-      .  (pointsAccounted     %~ succ)
-      .  (confirmGoalDataFlag .~ False)
-
--- | Awards a goal to a player
-awardGoal
-  :: Int
-  -- ^ The player's index number
-  -> ProgState
-  -> ProgState
-awardGoal n ps = ps
-  & progMode.gameStateL.gamePlayerStats %~
-    (\m -> let
-      stats = M.findWithDefault newPlayerStats n m
-      in M.insert n (stats & psGoals %~ succ) m)
-  & database.dbPlayers %~ map
-    (\(i, p) -> if i == n
-      then p
-        & pYtd.psGoals      %~ succ
-        & pLifetime.psGoals %~ succ
-      else p) . zip [0..]
-
--- | Awards an assist to a player
-awardAssist
-  :: Int
-  -- ^ The player's index number
-  -> ProgState
-  -> ProgState
-awardAssist n ps = ps
-  & progMode.gameStateL.gamePlayerStats %~
-    (\m -> let
-      stats = M.findWithDefault newPlayerStats n m
-      in M.insert n (stats & psAssists %~ succ) m)
-  & database.dbPlayers %~ map
-    (\(i, p) -> if i == n
-      then p
-        & pYtd.psAssists      %~ succ
-        & pLifetime.psAssists %~ succ
-      else p) . zip [0..]
-
--- | Resets the entered data for the current goal
-resetGoalData :: ProgState -> ProgState
-resetGoalData ps = ps & progMode.gameStateL
-  %~ (goalBy              .~ Nothing)
-  .  (assistsBy           .~ [])
-  .  (confirmGoalDataFlag .~ False)
-
--- | Adds penalty minutes to a player
-assignPMins
-  :: Int
-  -- ^ The number of minutes to add
-  -> ProgState
-  -> ProgState
-assignPMins mins s = fromMaybe s $ do
-  n <- s^.progMode.gameStateL.gameSelectedPlayer
-  Just $ s
-    & database.dbPlayers %~ modifyNth n
-      (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
-    & progMode.gameStateL
-      %~ ( gamePlayerStats %~ updateMap n newPlayerStats
-           (psPMin +~ mins)
-         )
-      .  (gameSelectedPlayer .~ Nothing)
-
 -- | Resets the program state back to the main menu
 backHome :: ProgState -> ProgState
 backHome

src/Mtlstats/Actions/NewGame.hs

@@ -0,0 +1,173 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Actions.NewGame
+  ( overtimeCheck
+  , updateGameStats
+  , validateGameDate
+  , recordGoalAssists
+  , awardGoal
+  , awardAssist
+  , resetGoalData
+  , assignPMins
+  ) where
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Time.Calendar (fromGregorianValid)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
+
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Determines whether or not to perform a check for overtime
+overtimeCheck :: ProgState -> ProgState
+overtimeCheck s
+  | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
+    s & progMode.gameStateL
+    %~ (homeScore .~ Nothing)
+    .  (awayScore .~ Nothing)
+  | fromMaybe False $ gameWon $ s^.progMode.gameStateL =
+    s & progMode.gameStateL.overtimeFlag ?~ False
+  | otherwise  = s
+
+-- | Adjusts the game stats based on the results of the current game
+updateGameStats :: ProgState -> ProgState
+updateGameStats s = fromMaybe s $ do
+  let gs = s^.progMode.gameStateL
+  gType  <- gs^.gameType
+  won    <- gameWon gs
+  lost   <- gameLost gs
+  ot     <- gs^.overtimeFlag
+  tScore <- teamScore gs
+  oScore <- otherScore gs
+  let
+    hw  = if gType == HomeGame && won then 1 else 0
+    hl  = if gType == HomeGame && lost then 1 else 0
+    hot = if gType == HomeGame && ot then 1 else 0
+    hgf = if gType == HomeGame then tScore else 0
+    hga = if gType == HomeGame then oScore else 0
+    aw  = if gType == AwayGame && won then 1 else 0
+    al  = if gType == AwayGame && lost then 1 else 0
+    aot = if gType == AwayGame && ot then 1 else 0
+    agf = if gType == AwayGame then tScore else 0
+    aga = if gType == AwayGame then oScore else 0
+  Just $ s
+    & database.dbHomeGameStats
+      %~ (gmsWins         +~ hw)
+      .  (gmsLosses       +~ hl)
+      .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
+    & database.dbAwayGameStats
+      %~ (gmsWins         +~ aw)
+      .  (gmsLosses       +~ al)
+      .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
+
+-- | Validates the game date
+validateGameDate :: ProgState -> ProgState
+validateGameDate s = fromMaybe s $ do
+  y <- toInteger <$> s^.progMode.gameStateL.gameYear
+  m <- s^.progMode.gameStateL.gameMonth
+  d <- s^.progMode.gameStateL.gameDay
+  Just $ if null $ fromGregorianValid y m d
+    then s & progMode.gameStateL
+      %~ (gameYear  .~ Nothing)
+      .  (gameMonth .~ Nothing)
+      .  (gameDay   .~ Nothing)
+    else s
+
+-- | Awards the goal and assists to the players
+recordGoalAssists :: ProgState -> ProgState
+recordGoalAssists ps = fromMaybe ps $ do
+  let gs = ps^.progMode.gameStateL
+  goalId <- gs^.goalBy
+  let assistIds = gs^.assistsBy
+  Just $ ps
+    & awardGoal goalId
+    & (\s -> foldr awardAssist s assistIds)
+    & progMode.gameStateL
+      %~ (goalBy              .~ Nothing)
+      .  (assistsBy           .~ [])
+      .  (pointsAccounted     %~ succ)
+      .  (confirmGoalDataFlag .~ False)
+
+-- | Awards a goal to a player
+awardGoal
+  :: Int
+  -- ^ The player's index number
+  -> ProgState
+  -> ProgState
+awardGoal n ps = ps
+  & progMode.gameStateL.gamePlayerStats %~
+    (\m -> let
+      stats = M.findWithDefault newPlayerStats n m
+      in M.insert n (stats & psGoals %~ succ) m)
+  & database.dbPlayers %~ map
+    (\(i, p) -> if i == n
+      then p
+        & pYtd.psGoals      %~ succ
+        & pLifetime.psGoals %~ succ
+      else p) . zip [0..]
+
+-- | Awards an assist to a player
+awardAssist
+  :: Int
+  -- ^ The player's index number
+  -> ProgState
+  -> ProgState
+awardAssist n ps = ps
+  & progMode.gameStateL.gamePlayerStats %~
+    (\m -> let
+      stats = M.findWithDefault newPlayerStats n m
+      in M.insert n (stats & psAssists %~ succ) m)
+  & database.dbPlayers %~ map
+    (\(i, p) -> if i == n
+      then p
+        & pYtd.psAssists      %~ succ
+        & pLifetime.psAssists %~ succ
+      else p) . zip [0..]
+
+-- | Resets the entered data for the current goal
+resetGoalData :: ProgState -> ProgState
+resetGoalData ps = ps & progMode.gameStateL
+  %~ (goalBy              .~ Nothing)
+  .  (assistsBy           .~ [])
+  .  (confirmGoalDataFlag .~ False)
+
+-- | Adds penalty minutes to a player
+assignPMins
+  :: Int
+  -- ^ The number of minutes to add
+  -> ProgState
+  -> ProgState
+assignPMins mins s = fromMaybe s $ do
+  n <- s^.progMode.gameStateL.gameSelectedPlayer
+  Just $ s
+    & database.dbPlayers %~ modifyNth n
+      (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
+    & progMode.gameStateL
+      %~ ( gamePlayerStats %~ updateMap n newPlayerStats
+           (psPMin +~ mins)
+         )
+      .  (gameSelectedPlayer .~ Nothing)

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -19,12 +19,13 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Actions.GoalieInput
+module Mtlstats.Actions.NewGame.GoalieInput
   ( finishGoalieEntry
   , recordGoalieStats
   , setGameGoalie
   ) where
 
+import Control.Monad (void)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.), (&), (.~), (%~), (+~))
@@ -42,10 +43,10 @@ finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
 recordGoalieStats :: ProgState -> ProgState
 recordGoalieStats s = fromMaybe s $ do
   let gs = s^.progMode.gameStateL
-  gid    <- gs^.gameSelectedGoalie
+  gid   <- gs^.gameSelectedGoalie
-  goalie <- nth gid $ s^.database.dbGoalies
+  mins  <- gs^.gameGoalieMinsPlayed
-  mins   <- gs^.gameGoalieMinsPlayed
+  goals <- gs^.gameGoalsAllowed
-  goals  <- gs^.gameGoalsAllowed
+  void $ nth gid $ s^.database.dbGoalies
 
   let
     gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats

src/Mtlstats/Control.hs

@@ -21,25 +21,20 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (join, when)
+import Control.Monad (join)
-import Control.Monad.Extra (ifM)
 import Control.Monad.Trans.State (gets, modify)
-import Data.Char (toUpper)
+import Data.Maybe (fromJust)
-import Data.Maybe (fromJust, fromMaybe, isJust)
+import Lens.Micro ((^.))
-import Lens.Micro ((^.), (.~), (%~))
 import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Control.EditPlayer
-import Mtlstats.Control.GoalieInput
+import Mtlstats.Control.NewGame
-import Mtlstats.Format
 import Mtlstats.Handlers
 import Mtlstats.Menu
 import Mtlstats.Prompt
-import Mtlstats.Report
 import Mtlstats.Types
-import Mtlstats.Util
 
 -- | Reads the program state and returs the apropriate controller to
 -- run
@@ -47,21 +42,7 @@ dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
   MainMenu  -> mainMenuC
   NewSeason -> newSeasonC
-  NewGame gs
+  NewGame _ -> newGameC s
-    | null $ gs^.gameYear             -> gameYearC
-    | null $ gs^.gameMonth            -> gameMonthC
-    | null $ gs^.gameDay              -> gameDayC
-    | null $ gs^.gameType             -> gameTypeC
-    | null $ gs^.otherTeam            -> otherTeamC
-    | null $ gs^.homeScore            -> homeScoreC
-    | null $ gs^.awayScore            -> awayScoreC
-    | null $ gs^.overtimeFlag         -> overtimeFlagC
-    | not $ gs^.dataVerified          -> verifyDataC
-    | fromJust (unaccountedPoints gs) -> goalInput gs
-    | isJust $ gs^.gameSelectedPlayer -> getPMinsC
-    | not $ gs^.gamePMinsRecorded     -> pMinPlayerC
-    | not $ gs^.gameGoalieAssigned    -> goalieInput s
-    | otherwise                       -> reportC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
     | null $ cps^.cpsName     -> getPlayerNameC
@@ -87,219 +68,6 @@ newSeasonC = Controller
     return True
   }
 
-gameYearC :: Controller
-gameYearC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt gameYearPrompt s
-  , handleController = \e -> do
-    promptHandler gameYearPrompt e
-    return True
-  }
-
-gameMonthC :: Controller
-gameMonthC = Controller
-  { drawController = \s -> do
-    header s
-    drawMenu gameMonthMenu
-  , handleController = \e -> do
-    menuHandler gameMonthMenu e
-    return True
-  }
-
-gameDayC :: Controller
-gameDayC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt gameDayPrompt s
-  , handleController = \e -> do
-    promptHandler gameDayPrompt e
-    modify validateGameDate
-    return True
-  }
-
-gameTypeC :: Controller
-gameTypeC = Controller
-  { drawController = \s -> do
-    header s
-    drawMenu gameTypeMenu
-  , handleController = \e -> do
-    menuHandler gameTypeMenu e
-    return True
-  }
-
-otherTeamC :: Controller
-otherTeamC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt otherTeamPrompt s
-  , handleController = \e -> do
-    promptHandler otherTeamPrompt e
-    return True
-  }
-
-homeScoreC :: Controller
-homeScoreC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt homeScorePrompt s
-  , handleController = \e -> do
-    promptHandler homeScorePrompt e
-    return True
-  }
-
-awayScoreC :: Controller
-awayScoreC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt awayScorePrompt s
-  , handleController = \e -> do
-    promptHandler awayScorePrompt e
-    modify overtimeCheck
-    return True
-  }
-
-overtimeFlagC :: Controller
-overtimeFlagC = Controller
-  { drawController = \s -> do
-    header s
-    C.drawString "Did the game go into overtime?  (Y/N)"
-    return C.CursorInvisible
-  , handleController = \e -> do
-    modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
-    return True
-  }
-
-verifyDataC :: Controller
-verifyDataC = Controller
-  { drawController = \s -> do
-    let gs = s^.progMode.gameStateL
-    header s
-    C.drawString "\n"
-    C.drawString $ "      Date: " ++ gameDate gs ++ "\n"
-    C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
-    C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
-    C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
-    C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
-    C.drawString $ "  Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
-    C.drawString "Is the above information correct?  (Y/N)"
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case ynHandler e of
-      Just True  -> do
-        modify $ progMode.gameStateL.dataVerified .~ True
-        modify updateGameStats
-      Just False -> modify $ progMode.gameStateL .~ newGameState
-      Nothing    -> return ()
-    return True
-  }
-
-goalInput :: GameState -> Controller
-goalInput gs
-  | null (gs^.goalBy            ) = recordGoalC
-  | not (gs^.confirmGoalDataFlag) = recordAssistC
-  | otherwise                     = confirmGoalDataC
-
-recordGoalC :: Controller
-recordGoalC = Controller
-  { drawController = \s -> let
-    (game, goal) = gameGoal s
-    in drawPrompt (recordGoalPrompt game goal) s
-  , handleController = \e -> do
-    (game, goal) <- gets gameGoal
-    promptHandler (recordGoalPrompt game goal) e
-    return True
-  }
-
-recordAssistC :: Controller
-recordAssistC = Controller
-  { drawController = \s -> let
-    (game, goal, assist) = gameGoalAssist s
-    in drawPrompt (recordAssistPrompt game goal assist) s
-  , handleController = \e -> do
-    (game, goal, assist) <- gets gameGoalAssist
-    promptHandler (recordAssistPrompt game goal assist) e
-    return True
-  }
-
-confirmGoalDataC :: Controller
-confirmGoalDataC = Controller
-  { drawController = \s -> do
-    let
-      (game, goal) = gameGoal s
-      gs           = s^.progMode.gameStateL
-      players      = s^.database.dbPlayers
-      msg          = unlines $
-        [ "          Game: " ++ padNum 2 game
-        , "          Goal: " ++ show goal
-        , "Goal scored by: " ++
-          playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
-        ] ++
-        map
-          (\pid -> "   Assisted by: " ++
-            playerSummary (fromJust $ nth pid players))
-          (gs^.assistsBy) ++
-        [ ""
-        , "Is the above information correct? (Y/N)"
-        ]
-    C.drawString msg
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case ynHandler e of
-      Just True  -> modify recordGoalAssists
-      Just False -> modify resetGoalData
-      Nothing    -> return ()
-    return True
-  }
-
-pMinPlayerC :: Controller
-pMinPlayerC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt pMinPlayerPrompt s
-  , handleController = \e -> do
-    promptHandler pMinPlayerPrompt e
-    return True
-  }
-
-getPMinsC :: Controller
-getPMinsC = Controller
-  { drawController = \s -> do
-    header s
-    C.drawString $ fromMaybe "" $ do
-      pid    <- s^.progMode.gameStateL.gameSelectedPlayer
-      player <- nth pid $ s^.database.dbPlayers
-      Just $ playerSummary player ++ "\n"
-    drawPrompt assignPMinsPrompt s
-  , handleController = \e -> do
-    promptHandler assignPMinsPrompt e
-    return True
-  }
-
-reportC :: Controller
-reportC = Controller
-  { drawController = \s -> do
-    (rows, cols) <- C.windowSize
-    C.drawString $ unlines $ slice
-      (s^.scrollOffset)
-      (fromInteger $ pred rows)
-      (report (fromInteger $ pred cols) s)
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case e of
-      C.EventSpecialKey C.KeyUpArrow   -> modify scrollUp
-      C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
-      C.EventSpecialKey C.KeyHome      -> modify $ scrollOffset .~ 0
-      C.EventSpecialKey _              -> modify backHome
-      C.EventCharacter _               -> modify backHome
-      _                                -> return ()
-    return True
-  }
-
-header :: ProgState -> C.Update ()
-header s = C.drawString $
-  "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
-
 getPlayerNumC :: Controller
 getPlayerNumC = Controller
   { drawController   = drawPrompt playerNumPrompt
@@ -381,15 +149,3 @@ confirmCreateGoalieC = Controller
       Nothing -> return ()
     return True
   }
-
-gameGoal :: ProgState -> (Int, Int)
-gameGoal s =
-  ( s^.database.dbGames
-  , succ $ s^.progMode.gameStateL.pointsAccounted
-  )
-
-gameGoalAssist :: ProgState -> (Int, Int, Int)
-gameGoalAssist s = let
-  (game, goal) = gameGoal s
-  assist       = succ $ length $ s^.progMode.gameStateL.assistsBy
-  in (game, goal, assist)

src/Mtlstats/Control/NewGame.hs

@@ -0,0 +1,283 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.NewGame (newGameC) where
+
+import Control.Monad.Trans.State (gets, modify)
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Lens.Micro ((^.), (.~))
+import qualified UI.NCurses as C
+
+import Mtlstats.Actions
+import Mtlstats.Actions.NewGame
+import Mtlstats.Control.NewGame.GoalieInput
+import Mtlstats.Format
+import Mtlstats.Handlers
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Prompt.NewGame
+import Mtlstats.Report
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Dispatcher for a new game
+newGameC :: ProgState -> Controller
+newGameC s = let
+  gs = s^.progMode.gameStateL
+  in if null $ gs^.gameYear               then gameYearC
+  else if null $ gs^.gameMonth            then gameMonthC
+  else if null $ gs^.gameDay              then gameDayC
+  else if null $ gs^.gameType             then gameTypeC
+  else if null $ gs^.otherTeam            then otherTeamC
+  else if null $ gs^.homeScore            then homeScoreC
+  else if null $ gs^.awayScore            then awayScoreC
+  else if null $ gs^.overtimeFlag         then overtimeFlagC
+  else if not $ gs^.dataVerified          then verifyDataC
+  else if fromJust (unaccountedPoints gs) then goalInput gs
+  else if isJust $ gs^.gameSelectedPlayer then getPMinsC
+  else if not $ gs^.gamePMinsRecorded     then pMinPlayerC
+  else if not $ gs^.gameGoalieAssigned    then goalieInputC s
+  else reportC
+
+gameYearC :: Controller
+gameYearC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt gameYearPrompt s
+  , handleController = \e -> do
+    promptHandler gameYearPrompt e
+    return True
+  }
+
+gameMonthC :: Controller
+gameMonthC = Controller
+  { drawController = \s -> do
+    header s
+    drawMenu gameMonthMenu
+  , handleController = \e -> do
+    menuHandler gameMonthMenu e
+    return True
+  }
+
+gameDayC :: Controller
+gameDayC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt gameDayPrompt s
+  , handleController = \e -> do
+    promptHandler gameDayPrompt e
+    modify validateGameDate
+    return True
+  }
+
+gameTypeC :: Controller
+gameTypeC = Controller
+  { drawController = \s -> do
+    header s
+    drawMenu gameTypeMenu
+  , handleController = \e -> do
+    menuHandler gameTypeMenu e
+    return True
+  }
+
+otherTeamC :: Controller
+otherTeamC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt otherTeamPrompt s
+  , handleController = \e -> do
+    promptHandler otherTeamPrompt e
+    return True
+  }
+
+homeScoreC :: Controller
+homeScoreC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt homeScorePrompt s
+  , handleController = \e -> do
+    promptHandler homeScorePrompt e
+    return True
+  }
+
+awayScoreC :: Controller
+awayScoreC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt awayScorePrompt s
+  , handleController = \e -> do
+    promptHandler awayScorePrompt e
+    modify overtimeCheck
+    return True
+  }
+
+overtimeFlagC :: Controller
+overtimeFlagC = Controller
+  { drawController = \s -> do
+    header s
+    C.drawString "Did the game go into overtime?  (Y/N)"
+    return C.CursorInvisible
+  , handleController = \e -> do
+    modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
+    return True
+  }
+
+verifyDataC :: Controller
+verifyDataC = Controller
+  { drawController = \s -> do
+    let gs = s^.progMode.gameStateL
+    header s
+    C.drawString "\n"
+    C.drawString $ "      Date: " ++ gameDate gs ++ "\n"
+    C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
+    C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
+    C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
+    C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
+    C.drawString $ "  Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
+    C.drawString "Is the above information correct?  (Y/N)"
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True  -> do
+        modify $ progMode.gameStateL.dataVerified .~ True
+        modify updateGameStats
+      Just False -> modify $ progMode.gameStateL .~ newGameState
+      Nothing    -> return ()
+    return True
+  }
+
+goalInput :: GameState -> Controller
+goalInput gs
+  | null (gs^.goalBy            ) = recordGoalC
+  | not (gs^.confirmGoalDataFlag) = recordAssistC
+  | otherwise                     = confirmGoalDataC
+
+recordGoalC :: Controller
+recordGoalC = Controller
+  { drawController = \s -> let
+    (game, goal) = gameGoal s
+    in drawPrompt (recordGoalPrompt game goal) s
+  , handleController = \e -> do
+    (game, goal) <- gets gameGoal
+    promptHandler (recordGoalPrompt game goal) e
+    return True
+  }
+
+recordAssistC :: Controller
+recordAssistC = Controller
+  { drawController = \s -> let
+    (game, goal, assist) = gameGoalAssist s
+    in drawPrompt (recordAssistPrompt game goal assist) s
+  , handleController = \e -> do
+    (game, goal, assist) <- gets gameGoalAssist
+    promptHandler (recordAssistPrompt game goal assist) e
+    return True
+  }
+
+confirmGoalDataC :: Controller
+confirmGoalDataC = Controller
+  { drawController = \s -> do
+    let
+      (game, goal) = gameGoal s
+      gs           = s^.progMode.gameStateL
+      players      = s^.database.dbPlayers
+      msg          = unlines $
+        [ "          Game: " ++ padNum 2 game
+        , "          Goal: " ++ show goal
+        , "Goal scored by: " ++
+          playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
+        ] ++
+        map
+          (\pid -> "   Assisted by: " ++
+            playerSummary (fromJust $ nth pid players))
+          (gs^.assistsBy) ++
+        [ ""
+        , "Is the above information correct? (Y/N)"
+        ]
+    C.drawString msg
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True  -> modify recordGoalAssists
+      Just False -> modify resetGoalData
+      Nothing    -> return ()
+    return True
+  }
+
+pMinPlayerC :: Controller
+pMinPlayerC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt pMinPlayerPrompt s
+  , handleController = \e -> do
+    promptHandler pMinPlayerPrompt e
+    return True
+  }
+
+getPMinsC :: Controller
+getPMinsC = Controller
+  { drawController = \s -> do
+    header s
+    C.drawString $ fromMaybe "" $ do
+      pid    <- s^.progMode.gameStateL.gameSelectedPlayer
+      player <- nth pid $ s^.database.dbPlayers
+      Just $ playerSummary player ++ "\n"
+    drawPrompt assignPMinsPrompt s
+  , handleController = \e -> do
+    promptHandler assignPMinsPrompt e
+    return True
+  }
+
+reportC :: Controller
+reportC = Controller
+  { drawController = \s -> do
+    (rows, cols) <- C.windowSize
+    C.drawString $ unlines $ slice
+      (s^.scrollOffset)
+      (fromInteger $ pred rows)
+      (report (fromInteger $ pred cols) s)
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case e of
+      C.EventSpecialKey C.KeyUpArrow   -> modify scrollUp
+      C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
+      C.EventSpecialKey C.KeyHome      -> modify $ scrollOffset .~ 0
+      C.EventSpecialKey _              -> modify backHome
+      C.EventCharacter _               -> modify backHome
+      _                                -> return ()
+    return True
+  }
+
+header :: ProgState -> C.Update ()
+header s = C.drawString $
+  "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
+
+gameGoal :: ProgState -> (Int, Int)
+gameGoal s =
+  ( s^.database.dbGames
+  , succ $ s^.progMode.gameStateL.pointsAccounted
+  )
+
+gameGoalAssist :: ProgState -> (Int, Int, Int)
+gameGoalAssist s = let
+  (game, goal) = gameGoal s
+  assist       = succ $ length $ s^.progMode.gameStateL.assistsBy
+  in (game, goal, assist)

src/Mtlstats/Control/NewGame/GoalieInput.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Control.GoalieInput (goalieInput) where
+module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
 
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.))
@@ -28,13 +28,13 @@ import qualified UI.NCurses as C
 import Mtlstats.Format
 import Mtlstats.Menu
 import Mtlstats.Prompt
-import Mtlstats.Prompt.GoalieInput
+import Mtlstats.Prompt.NewGame.GoalieInput
 import Mtlstats.Types
 import Mtlstats.Util
 
 -- | The dispatcher for handling goalie input
-goalieInput :: ProgState -> Controller
+goalieInputC :: ProgState -> Controller
-goalieInput s = let
+goalieInputC s = let
   gs = s^.progMode.gameStateL
   in if gs^.gameGoaliesRecorded
     then selectGameGoalieC s

src/Mtlstats/Menu.hs

@@ -49,7 +49,7 @@ import System.EasyFile
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
-import qualified Mtlstats.Actions.GoalieInput as GI
+import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
 import Mtlstats.Config
 import Mtlstats.Types
 import Mtlstats.Types.Menu

src/Mtlstats/Prompt.hs

@@ -31,11 +31,6 @@ module Mtlstats.Prompt (
   numPrompt,
   selectPrompt,
   -- * Individual prompts
-  gameYearPrompt,
-  gameDayPrompt,
-  otherTeamPrompt,
-  homeScorePrompt,
-  awayScorePrompt,
   playerNumPrompt,
   playerNamePrompt,
   playerPosPrompt,
@@ -43,10 +38,6 @@ module Mtlstats.Prompt (
   goalieNamePrompt,
   selectPlayerPrompt,
   selectGoaliePrompt,
-  recordGoalPrompt,
-  recordAssistPrompt,
-  pMinPlayerPrompt,
-  assignPMinsPrompt,
   playerToEditPrompt
 ) where
 
@@ -55,15 +46,13 @@ import Control.Monad.Extra (whenJust)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
-import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.), (&), (.~), (?~))
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Lens.Micro.Extras (view)
 import Text.Read (readMaybe)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Config
-import Mtlstats.Format
 import Mtlstats.Types
 import Mtlstats.Util
 
@@ -179,31 +168,6 @@ selectPrompt params = Prompt
     _ -> return ()
   }
 
--- | Prompts for the game year
-gameYearPrompt :: Prompt
-gameYearPrompt = numPrompt "Game year: " $
-  modify . (progMode.gameStateL.gameYear ?~)
-
--- | Prompts for the day of the month the game took place
-gameDayPrompt :: Prompt
-gameDayPrompt = numPrompt "Day of month: " $
-  modify . (progMode.gameStateL.gameDay ?~)
-
--- | Prompts for the other team name
-otherTeamPrompt :: Prompt
-otherTeamPrompt = strPrompt "Other team: " $
-  modify . (progMode.gameStateL.otherTeam .~)
-
--- | Prompts for the home score
-homeScorePrompt :: Prompt
-homeScorePrompt = numPrompt "Home score: " $
-  modify . (progMode.gameStateL.homeScore ?~)
-
--- | Prompts for the away score
-awayScorePrompt :: Prompt
-awayScorePrompt = numPrompt "Away score: " $
-  modify . (progMode.gameStateL.awayScore ?~)
-
 -- | Prompts for a new player's number
 playerNumPrompt :: Prompt
 playerNumPrompt = numPrompt "Player number: " $
@@ -285,52 +249,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
     modify $ progMode .~ CreateGoalie cgs
   }
 
--- | Prompts for the player who scored the goal
-recordGoalPrompt
-  :: Int
-  -- ^ The game number
-  -> Int
-  -- ^ The goal number
-  -> Prompt
-recordGoalPrompt game goal = selectPlayerPrompt
-  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
-  ++ "Who scored goal number " ++ show goal ++ "? "
-  ) $ modify . (progMode.gameStateL.goalBy .~)
-
--- | Prompts for a player who assisted the goal
-recordAssistPrompt
-  :: Int
-  -- ^ The game number
-  -> Int
-  -- ^ The goal nuber
-  -> Int
-  -- ^ The assist number
-  -> Prompt
-recordAssistPrompt game goal assist = selectPlayerPrompt
-  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
-  ++ "Goal: " ++ show goal ++ "\n"
-  ++ "Assist #" ++ show assist ++ ": "
-  ) $ \case
-    Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-    Just n  -> do
-      modify $ progMode.gameStateL.assistsBy %~ (++[n])
-      nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
-      when (nAssists >= maxAssists) $
-        modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-
--- | Prompts for the player to assign penalty minutes to
-pMinPlayerPrompt :: Prompt
-pMinPlayerPrompt = selectPlayerPrompt
-  "Assign penalty minutes to: " $
-  \case
-    Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded  .~ True
-    Just n  -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-
--- | Prompts for the number of penalty mintues to assign to the player
-assignPMinsPrompt :: Prompt
-assignPMinsPrompt = numPrompt "Penalty minutes: " $
-  modify . assignPMins
-
 playerToEditPrompt :: Prompt
 playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
   modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

src/Mtlstats/Prompt/NewGame.hs

@@ -0,0 +1,115 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Prompt.NewGame
+  ( gameYearPrompt
+  , gameDayPrompt
+  , otherTeamPrompt
+  , homeScorePrompt
+  , awayScorePrompt
+  , recordGoalPrompt
+  , recordAssistPrompt
+  , pMinPlayerPrompt
+  , assignPMinsPrompt
+  ) where
+
+import Control.Monad (when)
+import Control.Monad.Trans.State (gets, modify)
+import Lens.Micro ((^.), (.~), (?~), (%~))
+
+import Mtlstats.Actions.NewGame
+import Mtlstats.Config
+import Mtlstats.Format
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompts for the game year
+gameYearPrompt :: Prompt
+gameYearPrompt = numPrompt "Game year: " $
+  modify . (progMode.gameStateL.gameYear ?~)
+
+-- | Prompts for the day of the month the game took place
+gameDayPrompt :: Prompt
+gameDayPrompt = numPrompt "Day of month: " $
+  modify . (progMode.gameStateL.gameDay ?~)
+
+-- | Prompts for the other team name
+otherTeamPrompt :: Prompt
+otherTeamPrompt = strPrompt "Other team: " $
+  modify . (progMode.gameStateL.otherTeam .~)
+
+-- | Prompts for the home score
+homeScorePrompt :: Prompt
+homeScorePrompt = numPrompt "Home score: " $
+  modify . (progMode.gameStateL.homeScore ?~)
+
+-- | Prompts for the away score
+awayScorePrompt :: Prompt
+awayScorePrompt = numPrompt "Away score: " $
+  modify . (progMode.gameStateL.awayScore ?~)
+
+-- | Prompts for the player who scored the goal
+recordGoalPrompt
+  :: Int
+  -- ^ The game number
+  -> Int
+  -- ^ The goal number
+  -> Prompt
+recordGoalPrompt game goal = selectPlayerPrompt
+  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
+  ++ "Who scored goal number " ++ show goal ++ "? "
+  ) $ modify . (progMode.gameStateL.goalBy .~)
+
+-- | Prompts for a player who assisted the goal
+recordAssistPrompt
+  :: Int
+  -- ^ The game number
+  -> Int
+  -- ^ The goal nuber
+  -> Int
+  -- ^ The assist number
+  -> Prompt
+recordAssistPrompt game goal assist = selectPlayerPrompt
+  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
+  ++ "Goal: " ++ show goal ++ "\n"
+  ++ "Assist #" ++ show assist ++ ": "
+  ) $ \case
+    Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
+    Just n  -> do
+      modify $ progMode.gameStateL.assistsBy %~ (++[n])
+      nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
+      when (nAssists >= maxAssists) $
+        modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
+
+-- | Prompts for the player to assign penalty minutes to
+pMinPlayerPrompt :: Prompt
+pMinPlayerPrompt = selectPlayerPrompt
+  "Assign penalty minutes to: " $
+  \case
+    Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded  .~ True
+    Just n  -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
+
+-- | Prompts for the number of penalty mintues to assign to the player
+assignPMinsPrompt :: Prompt
+assignPMinsPrompt = numPrompt "Penalty minutes: " $
+  modify . assignPMins

src/Mtlstats/Prompt/NewGame/GoalieInput.hs

@@ -21,19 +21,16 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 {-# LANGUAGE LambdaCase #-}
 
-module Mtlstats.Prompt.GoalieInput
+module Mtlstats.Prompt.NewGame.GoalieInput
   ( selectGameGoaliePrompt
   , goalieMinsPlayedPrompt
   , goalsAllowedPrompt
   ) where
 
-import Control.Monad (when)
+import Control.Monad.Trans.State (modify)
-import Control.Monad.Trans.State (gets, modify)
+import Lens.Micro ((?~))
-import Data.Maybe (fromMaybe)
-import Lens.Micro ((^.), (.~), (?~))
 
-import Mtlstats.Actions.GoalieInput
+import Mtlstats.Actions.NewGame.GoalieInput
-import Mtlstats.Config
 import Mtlstats.Prompt
 import Mtlstats.Types
 

src/Mtlstats/Types/Menu.hs

@@ -38,7 +38,6 @@ module Mtlstats.Types.Menu (
 
 import Lens.Micro ((^.))
 import Lens.Micro.TH (makeLenses)
-import qualified UI.NCurses as C
 
 import Mtlstats.Types
 

test/Actions/NewGame/GoalieInputSpec.hs

@@ -19,14 +19,14 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Actions.GoalieInputSpec (spec) where
+module Actions.NewGame.GoalieInputSpec (spec) where
 
 import qualified Data.Map as M
 import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (&), (.~), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
-import Mtlstats.Actions.GoalieInput
+import Mtlstats.Actions.NewGame.GoalieInput
 import Mtlstats.Types
 import Mtlstats.Util
 

test/Actions/NewGameSpec.hs

@@ -0,0 +1,483 @@
+{-
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Actions.NewGameSpec (spec) where
+
+import Control.Monad (replicateM)
+import qualified Data.Map as M
+import Data.Maybe (fromJust)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
+
+import Mtlstats.Actions.NewGame
+import Mtlstats.Types
+import Mtlstats.Util
+
+import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
+import qualified TypesSpec as TS
+
+spec :: Spec
+spec = describe "NewGame" $ do
+  overtimeCheckSpec
+  updateGameStatsSpec
+  validateGameDateSpec
+  recordGoalAssistsSpec
+  awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
+  assignPMinsSpec
+  GoalieInput.spec
+
+overtimeCheckSpec :: Spec
+overtimeCheckSpec = describe "overtimeCheck" $ do
+
+  context "tie game" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 1)
+          .  (awayScore ?~ 1)
+        & overtimeCheck
+
+    it "should clear the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Nothing
+
+    it "should clear the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Nothing
+
+    it "should leave the overtimeFlag blank" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
+
+  context "game won" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 2)
+          .  (awayScore ?~ 1)
+        & overtimeCheck
+
+    it "should not change the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Just 2
+
+    it "should not change the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Just 1
+
+    it "should set the overtimeCheck flag to False" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
+
+  context "game lost" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 1)
+          .  (awayScore ?~ 2)
+        & overtimeCheck
+
+    it "should not change the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Just 1
+
+    it "should not change the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Just 2
+
+    it "should leave the overtimeCheck flag blank" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
+
+updateGameStatsSpec :: Spec
+updateGameStatsSpec = describe "updateGameStats" $ do
+  let
+
+    baseStats = newGameStats
+      & gmsWins         .~ 1
+      & gmsLosses       .~ 1
+      & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 1
+
+    s t h a o = newProgState
+      & progMode.gameStateL
+        %~ (gameType     .~ t)
+        .  (homeScore    .~ h)
+        .  (awayScore    .~ a)
+        .  (overtimeFlag .~ o)
+      & database
+        %~ (dbHomeGameStats .~ baseStats)
+        .  (dbAwayGameStats .~ baseStats)
+
+    db hw hl ho hf ha aw al ao af aa = newDatabase
+      & dbHomeGameStats
+        %~ (gmsWins         .~ hw)
+        .  (gmsLosses       .~ hl)
+        .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
+      & dbAwayGameStats
+        %~ (gmsWins         .~ aw)
+        .  (gmsLosses       .~ al)
+        .  (gmsOvertime     .~ ao)
+        .  (gmsGoalsFor     .~ af)
+        .  (gmsGoalsAgainst .~ aa)
+
+  context "home win" $
+    it "should record a home win" $ let
+      s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
+
+  context "home loss" $
+    it "should record a home loss" $ let
+      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just False)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
+
+  context "home overtime loss" $
+    it "should record a home overtime" $ let
+      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
+
+  context "away win" $
+    it "should record an away win" $ let
+      s'  = s (Just AwayGame) (Just 1) (Just 2) (Just False)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
+
+  context "away loss" $
+    it "should record an away loss" $ let
+      s'  = s (Just AwayGame) (Just 2) (Just 1) (Just False)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
+
+  context "away overtime loss" $
+    it "should record an away overtime" $ let
+      s'  = s (Just AwayGame) (Just 2) (Just 1) (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
+
+  context "missing game type" $
+    it "should not change anything" $ let
+      s'  = s Nothing (Just 1) (Just 2) (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 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)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 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)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 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
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
+
+validateGameDateSpec :: Spec
+validateGameDateSpec = describe "validateGameDate" $ do
+
+  context "valid date" $
+    it "should leave the date unchanged" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 6)
+            .  (gameDay   ?~ 25)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Just 25
+
+  context "invalid date" $
+    it "should clear the date" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 2)
+            .  (gameDay   ?~ 30)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Nothing
+      s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
+  context "missing day" $
+    it "should not change anything" $ do
+      let
+
+        gs = newGameState
+          & gameYear  ?~ 2019
+          & gameMonth ?~ 6
+
+        s = newProgState
+          & progMode.gameStateL .~ gs
+          & validateGameDate
+
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
+recordGoalAssistsSpec :: Spec
+recordGoalAssistsSpec = describe "recordGoalAssists" $ do
+  let
+    joe   = newPlayer 1 "Joe"   "centre"
+    bob   = newPlayer 2 "Bob"   "defense"
+    steve = newPlayer 3 "Steve" "forward"
+    dave  = newPlayer 4 "Dave"  "somewhere"
+    frank = newPlayer 5 "Frank" "elsewhere"
+    ps
+      = newProgState
+      & database.dbPlayers .~ [joe, bob, steve, dave, frank]
+      & progMode.gameStateL
+        %~ (goalBy              ?~ 0)
+        .  (assistsBy           .~ [1, 2])
+        .  (confirmGoalDataFlag .~ True)
+      & recordGoalAssists
+
+  mapM_
+    (\(name, n, goals, assists) -> context name $ do
+      let
+        player = (ps^.database.dbPlayers) !! n
+        stats  = M.findWithDefault newPlayerStats n $
+          ps^.progMode.gameStateL.gamePlayerStats
+
+      it ("should set the year-to-date goals to " ++ show goals) $
+        player^.pYtd.psGoals `shouldBe` goals
+
+      it ("should set the lifetime goals to " ++ show goals) $
+        player^.pLifetime.psGoals `shouldBe` goals
+
+      it ("should set the game goals to " ++ show goals) $
+        stats^.psAssists `shouldBe` assists
+
+      it ("should set the year-to-date assists to " ++ show assists) $
+        player^.pYtd.psAssists `shouldBe` assists
+
+      it ("should set the lifetime assists to " ++ show assists) $
+        player^.pLifetime.psAssists `shouldBe` assists
+
+      it ("should set the game assists to " ++ show assists) $
+        stats^.psAssists `shouldBe` assists)
+
+    --  name,    index, goals, assists
+    [ ( "Joe",   0,     1,     0       )
+    , ( "Bob",   1,     0,     1       )
+    , ( "Steve", 2,     0,     1       )
+    , ( "Dave",  3,     0,     0       )
+    ]
+
+  it "should clear the goalBy value" $
+    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
+
+  it "should clear the assistsBy list" $
+    ps^.progMode.gameStateL.assistsBy `shouldBe` []
+
+  it "should increment the pointsAccounted counter" $
+    ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
+
+  it "should clear the confirmGoalDataFlag" $
+    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
+
+awardGoalSpec :: Spec
+awardGoalSpec = describe "awardGoal" $ do
+  let
+    joe
+      = newPlayer 2 "Joe" "centre"
+      & pYtd.psGoals      .~ 1
+      & pLifetime.psGoals .~ 2
+    bob
+      = newPlayer 3 "Bob" "defense"
+      & pYtd.psGoals      .~ 3
+      & pLifetime.psGoals .~ 4
+    db
+      = newDatabase
+      & dbPlayers .~ [joe, bob]
+    joeStats
+      = newPlayerStats
+      & psGoals .~ 1
+    ps
+      = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
+      & database .~ db
+
+  mapM_
+    (\(pName, pid, ytd, lt, game) ->
+      context pName $ do
+        let
+          ps'    = awardGoal pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ pName ++ "'s year-to-date goals") $
+          player^.pYtd.psGoals `shouldBe` ytd
+
+        it ("should increment " ++ pName ++ "'s lifetime goals") $
+          player^.pLifetime.psGoals `shouldBe` lt
+
+        it ("should increment " ++ pName ++ "'s game goals") $
+          gStats^.psGoals `shouldBe` game)
+    --  player name, player id, ytd goals, lifetime goals, game goals
+    [ ( "Joe",       0,         2,         3,              2          )
+    , ( "Bob",       1,         4,         5,              1          )
+    ]
+
+  context "invalid index" $ let
+    ps' = awardGoal 2 ps
+    in it "should not change the database" $
+      ps'^.database `shouldBe` db
+
+  context "negative index" $ let
+    ps' = awardGoal (-1) ps
+    in it "should not change the database" $
+      ps'^.database `shouldBe` db
+
+awardAssistSpec :: Spec
+awardAssistSpec = describe "awardAssist" $ do
+  let
+    joe
+      = newPlayer 1 "Joe" "centre"
+      & pYtd.psAssists      .~ 1
+      & pLifetime.psAssists .~ 2
+    bob
+      = newPlayer 2 "Bob" "defense"
+      & pYtd.psAssists      .~ 3
+      & pLifetime.psAssists .~ 4
+    joeStats
+      = newPlayerStats
+      & psAssists .~ 1
+    ps
+      = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
+      & database.dbPlayers .~ [joe, bob]
+
+  mapM_
+    (\(pName, pid, ytd, lt, game) ->
+      context pName $ do
+        let
+          ps' = awardAssist pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ pName ++ "'s year-to-date assists") $
+          player^.pYtd.psAssists `shouldBe` ytd
+
+        it ("should increment " ++ pName ++ "'s lifetime assists") $
+          player^.pLifetime.psAssists `shouldBe` lt
+
+        it ("should increment " ++ pName ++ "'s game assists") $
+          gStats^.psAssists `shouldBe` game)
+    --  player name, player id, ytd assists, lifetime assists, game assists
+    [ ( "Joe",       0,         2,           3,                2            )
+    , ( "Bob",       1,         4,           5,                1            )
+    ]
+
+  context "invalid index" $ let
+    ps' = awardAssist (-1) ps
+    in it "should not change anything" $
+      ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
+
+resetGoalDataSpec :: Spec
+resetGoalDataSpec = describe "resetGoalData" $ do
+  players <- runIO $ replicateM 5 TS.makePlayer
+  let
+    gs
+      = newGameState
+      & goalBy              ?~ 1
+      & assistsBy           .~ [2, 3]
+      & confirmGoalDataFlag .~ True
+    ps
+      = newProgState
+      & database.dbPlayers  .~ players
+      & progMode.gameStateL .~ gs
+      & resetGoalData
+
+  it "should clear the goalBy value" $
+    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
+
+  it "should clear the assists by list" $
+    ps^.progMode.gameStateL.assistsBy `shouldBe` []
+
+  it "should clear confirmGoalDataFlag" $
+    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
+
+assignPMinsSpec :: Spec
+assignPMinsSpec = describe "assignPMins" $ let
+
+  bob = newPlayer 2 "Bob" "centre"
+    & pYtd.psPMin      .~ 3
+    & pLifetime.psPMin .~ 4
+
+  joe = newPlayer 3 "Joe" "defense"
+    & pYtd.psPMin      .~ 5
+    & pLifetime.psPMin .~ 6
+
+  ps pid = newProgState
+    & database.dbPlayers .~ [bob, joe]
+    & progMode.gameStateL
+      %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
+      .  (gameSelectedPlayer .~ pid)
+
+  in mapM_
+    (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
+      context ("selectedPlayer = " ++ show pid) $ do
+        let ps' = assignPMins 2 $ ps pid
+
+        mapM_
+          (\(name, pid', lt, ytd, game) -> context name $ do
+            let
+              player = fromJust $ nth pid' $ ps'^.database.dbPlayers
+              gStats = ps'^.progMode.gameStateL.gamePlayerStats
+              pStats = M.findWithDefault newPlayerStats pid' gStats
+
+            context "lifetime penalty minutes" $
+              it ("should be " ++ show lt) $
+                player^.pLifetime.psPMin `shouldBe` lt
+
+            context "year-to-date penalty minutes" $
+              it ("should be " ++ show ytd) $
+                player^.pYtd.psPMin `shouldBe` ytd
+
+            context "game penalty minutes" $
+              it ("should be " ++ show game) $
+                pStats^.psPMin `shouldBe` game)
+
+          --  name,  index, lifetime, ytd,    game
+          [ ( "Bob", 0,     bobLt,    bobYtd, bobGame )
+          , ( "Joe", 1,     joeLt,    joeYtd, joeGame )
+          ]
+
+        it "should set selectedPlayer to Nothing" $
+          ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
+
+    --  index,   bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
+    [ ( Just 0,  6,      5,       4,        6,      5,       0        )
+    , ( Just 1,  4,      3,       2,        8,      7,       2        )
+    , ( Just 2,  4,      3,       2,        6,      5,       0        )
+    , ( Nothing, 4,      3,       2,        6,      5,       0        )
+    ]

test/ActionsSpec.hs

@@ -24,16 +24,12 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
-import qualified Data.Map as M
+import Lens.Micro ((^.), (&), (.~), (?~))
-import Data.Maybe (fromJust)
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
-import System.Random (randomRIO)
 import Test.Hspec
   ( Spec
   , context
   , describe
   , it
-  , runIO
   , shouldBe
   , shouldNotBe
   , shouldSatisfy
@@ -41,9 +37,8 @@ import Test.Hspec
 
 import Mtlstats.Actions
 import Mtlstats.Types
-import Mtlstats.Util
 
-import qualified Actions.GoalieInputSpec as GoalieInput
+import qualified Actions.NewGameSpec as NewGame
 import qualified TypesSpec as TS
 
 spec :: Spec
@@ -53,9 +48,6 @@ spec = describe "Mtlstats.Actions" $ do
   resetYtdSpec
   addCharSpec
   removeCharSpec
-  overtimeCheckSpec
-  updateGameStatsSpec
-  validateGameDateSpec
   createPlayerSpec
   createGoalieSpec
   editPlayerSpec
@@ -63,15 +55,10 @@ spec = describe "Mtlstats.Actions" $ do
   addGoalieSpec
   resetCreatePlayerStateSpec
   resetCreateGoalieStateSpec
-  recordGoalAssistsSpec
-  awardGoalSpec
-  awardAssistSpec
-  resetGoalDataSpec
-  assignPMinsSpec
   backHomeSpec
   scrollUpSpec
   scrollDownSpec
-  GoalieInput.spec
+  NewGame.spec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -99,8 +86,8 @@ startNewGameSpec = describe "startNewGame" $ do
 resetYtdSpec :: Spec
 resetYtdSpec = describe "resetYtd" $
   it "should reset the year-to-date stats for all players" $ do
-    ps <- replicateM 2 makePlayer
+    ps <- replicateM 2 TS.makePlayer
-    gs <- replicateM 2 makeGoalie
+    gs <- replicateM 2 TS.makeGoalie
     let
       s = newProgState
         & database . dbPlayers .~ ps
@@ -160,202 +147,6 @@ removeCharSpec = describe "removeChar" $ do
         & removeChar
       in s ^. inputBuffer `shouldBe` "fo"
 
-overtimeCheckSpec = describe "overtimeCheck" $ do
-
-  context "tie game" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 1)
-          .  (awayScore ?~ 1)
-        & overtimeCheck
-
-    it "should clear the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Nothing
-
-    it "should clear the away score" $
-      s^.progMode.gameStateL.awayScore `shouldBe` Nothing
-
-    it "should leave the overtimeFlag blank" $
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
-
-  context "game won" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 2)
-          .  (awayScore ?~ 1)
-        & overtimeCheck
-
-    it "should not change the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Just 2
-
-    it "should not change the away score" $
-      s^.progMode.gameStateL.awayScore `shouldBe` Just 1
-
-    it "should set the overtimeCheck flag to False" $
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
-
-  context "game lost" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 1)
-          .  (awayScore ?~ 2)
-        & overtimeCheck
-
-    it "should not change the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Just 1
-
-    it "should not change the away score" $
-      s^.progMode.gameStateL.awayScore `shouldBe` Just 2
-
-    it "should leave the overtimeCheck flag blank" $
-      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
-
-updateGameStatsSpec :: Spec
-updateGameStatsSpec = describe "updateGameStats" $ do
-  let
-
-    baseStats = newGameStats
-      & gmsWins         .~ 1
-      & gmsLosses       .~ 1
-      & gmsOvertime     .~ 1
-      & gmsGoalsFor     .~ 1
-      & gmsGoalsAgainst .~ 1
-
-    s t h a o = newProgState
-      & progMode.gameStateL
-        %~ (gameType     .~ t)
-        .  (homeScore    .~ h)
-        .  (awayScore    .~ a)
-        .  (overtimeFlag .~ o)
-      & database
-        %~ (dbHomeGameStats .~ baseStats)
-        .  (dbAwayGameStats .~ baseStats)
-
-    db hw hl ho hf ha aw al ao af aa = newDatabase
-      & dbHomeGameStats
-        %~ (gmsWins         .~ hw)
-        .  (gmsLosses       .~ hl)
-        .  (gmsOvertime     .~ ho)
-        .  (gmsGoalsFor     .~ hf)
-        .  (gmsGoalsAgainst .~ ha)
-      & dbAwayGameStats
-        %~ (gmsWins         .~ aw)
-        .  (gmsLosses       .~ al)
-        .  (gmsOvertime     .~ ao)
-        .  (gmsGoalsFor     .~ af)
-        .  (gmsGoalsAgainst .~ aa)
-
-  context "home win" $
-    it "should record a home win" $ let
-      s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
-
-  context "home loss" $
-    it "should record a home loss" $ let
-      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just False)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
-
-  context "home overtime loss" $
-    it "should record a home overtime" $ let
-      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just True)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
-
-  context "away win" $
-    it "should record an away win" $ let
-      s'  = s (Just AwayGame) (Just 1) (Just 2) (Just False)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
-
-  context "away loss" $
-    it "should record an away loss" $ let
-      s'  = s (Just AwayGame) (Just 2) (Just 1) (Just False)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
-
-  context "away overtime loss" $
-    it "should record an away overtime" $ let
-      s'  = s (Just AwayGame) (Just 2) (Just 1) (Just True)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
-
-  context "missing game type" $
-    it "should not change anything" $ let
-      s'  = s Nothing (Just 1) (Just 2) (Just True)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 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)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 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)
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 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
-      db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
-
-validateGameDateSpec :: Spec
-validateGameDateSpec = describe "validateGameDate" $ do
-
-  context "valid date" $
-    it "should leave the date unchanged" $ do
-      let
-        s = newProgState
-          & progMode.gameStateL
-            %~ (gameYear  ?~ 2019)
-            .  (gameMonth ?~ 6)
-            .  (gameDay   ?~ 25)
-          & validateGameDate
-      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
-      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
-      s^.progMode.gameStateL.gameDay   `shouldBe` Just 25
-
-  context "invalid date" $
-    it "should clear the date" $ do
-      let
-        s = newProgState
-          & progMode.gameStateL
-            %~ (gameYear  ?~ 2019)
-            .  (gameMonth ?~ 2)
-            .  (gameDay   ?~ 30)
-          & validateGameDate
-      s^.progMode.gameStateL.gameYear  `shouldBe` Nothing
-      s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
-      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
-
-  context "missing day" $
-    it "should not change anything" $ do
-      let
-
-        gs = newGameState
-          & gameYear  ?~ 2019
-          & gameMonth ?~ 6
-
-        s = newProgState
-          & progMode.gameStateL .~ gs
-          & validateGameDate
-
-      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
-      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
-      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
-
 createPlayerSpec :: Spec
 createPlayerSpec = describe "createPlayer" $
   it "should change the mode appropriately" $ let
@@ -440,281 +231,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
     newProgState & progMode.createGoalieStateL .~ cgs
   in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
 
-recordGoalAssistsSpec :: Spec
-recordGoalAssistsSpec = describe "recordGoalAssists" $ do
-  let
-    joe   = newPlayer 1 "Joe"   "centre"
-    bob   = newPlayer 2 "Bob"   "defense"
-    steve = newPlayer 3 "Steve" "forward"
-    dave  = newPlayer 4 "Dave"  "somewhere"
-    frank = newPlayer 5 "Frank" "elsewhere"
-    ps
-      = newProgState
-      & database.dbPlayers .~ [joe, bob, steve, dave, frank]
-      & progMode.gameStateL
-        %~ (goalBy              ?~ 0)
-        .  (assistsBy           .~ [1, 2])
-        .  (confirmGoalDataFlag .~ True)
-      & recordGoalAssists
-
-  mapM_
-    (\(name, n, goals, assists) -> context name $ do
-      let
-        player = (ps^.database.dbPlayers) !! n
-        stats  = M.findWithDefault newPlayerStats n $
-          ps^.progMode.gameStateL.gamePlayerStats
-
-      it ("should set the year-to-date goals to " ++ show goals) $
-        player^.pYtd.psGoals `shouldBe` goals
-
-      it ("should set the lifetime goals to " ++ show goals) $
-        player^.pLifetime.psGoals `shouldBe` goals
-
-      it ("should set the game goals to " ++ show goals) $
-        stats^.psAssists `shouldBe` assists
-
-      it ("should set the year-to-date assists to " ++ show assists) $
-        player^.pYtd.psAssists `shouldBe` assists
-
-      it ("should set the lifetime assists to " ++ show assists) $
-        player^.pLifetime.psAssists `shouldBe` assists
-
-      it ("should set the game assists to " ++ show assists) $
-        stats^.psAssists `shouldBe` assists)
-
-    --  name,    index, goals, assists
-    [ ( "Joe",   0,     1,     0       )
-    , ( "Bob",   1,     0,     1       )
-    , ( "Steve", 2,     0,     1       )
-    , ( "Dave",  3,     0,     0       )
-    ]
-
-  it "should clear the goalBy value" $
-    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
-
-  it "should clear the assistsBy list" $
-    ps^.progMode.gameStateL.assistsBy `shouldBe` []
-
-  it "should increment the pointsAccounted counter" $
-    ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
-
-  it "should clear the confirmGoalDataFlag" $
-    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
-
-awardGoalSpec :: Spec
-awardGoalSpec = describe "awardGoal" $ do
-  let
-    joe
-      = newPlayer 2 "Joe" "centre"
-      & pYtd.psGoals      .~ 1
-      & pLifetime.psGoals .~ 2
-    bob
-      = newPlayer 3 "Bob" "defense"
-      & pYtd.psGoals      .~ 3
-      & pLifetime.psGoals .~ 4
-    db
-      = newDatabase
-      & dbPlayers .~ [joe, bob]
-    joeStats
-      = newPlayerStats
-      & psGoals .~ 1
-    ps
-      = newProgState
-      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
-      & database .~ db
-
-  mapM_
-    (\(pName, pid, ytd, lt, game) ->
-      context pName $ do
-        let
-          ps'    = awardGoal pid ps
-          player = (ps'^.database.dbPlayers) !! pid
-          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
-
-        it ("should increment " ++ pName ++ "'s year-to-date goals") $
-          player^.pYtd.psGoals `shouldBe` ytd
-
-        it ("should increment " ++ pName ++ "'s lifetime goals") $
-          player^.pLifetime.psGoals `shouldBe` lt
-
-        it ("should increment " ++ pName ++ "'s game goals") $
-          gStats^.psGoals `shouldBe` game)
-    --  player name, player id, ytd goals, lifetime goals, game goals
-    [ ( "Joe",       0,         2,         3,              2          )
-    , ( "Bob",       1,         4,         5,              1          )
-    ]
-
-  context "invalid index" $ let
-    ps' = awardGoal 2 ps
-    in it "should not change the database" $
-      ps'^.database `shouldBe` db
-
-  context "negative index" $ let
-    ps' = awardGoal (-1) ps
-    in it "should not change the database" $
-      ps'^.database `shouldBe` db
-
-awardAssistSpec :: Spec
-awardAssistSpec = describe "awardAssist" $ do
-  let
-    joe
-      = newPlayer 1 "Joe" "centre"
-      & pYtd.psAssists      .~ 1
-      & pLifetime.psAssists .~ 2
-    bob
-      = newPlayer 2 "Bob" "defense"
-      & pYtd.psAssists      .~ 3
-      & pLifetime.psAssists .~ 4
-    joeStats
-      = newPlayerStats
-      & psAssists .~ 1
-    ps
-      = newProgState
-      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
-      & database.dbPlayers .~ [joe, bob]
-
-  mapM_
-    (\(pName, pid, ytd, lt, game) ->
-      context pName $ do
-        let
-          ps' = awardAssist pid ps
-          player = (ps'^.database.dbPlayers) !! pid
-          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
-
-        it ("should increment " ++ pName ++ "'s year-to-date assists") $
-          player^.pYtd.psAssists `shouldBe` ytd
-
-        it ("should increment " ++ pName ++ "'s lifetime assists") $
-          player^.pLifetime.psAssists `shouldBe` lt
-
-        it ("should increment " ++ pName ++ "'s game assists") $
-          gStats^.psAssists `shouldBe` game)
-    --  player name, player id, ytd assists, lifetime assists, game assists
-    [ ( "Joe",       0,         2,           3,                2            )
-    , ( "Bob",       1,         4,           5,                1            )
-    ]
-
-  context "invalid index" $ let
-    ps' = awardAssist (-1) ps
-    in it "should not change anything" $
-      ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
-
-resetGoalDataSpec :: Spec
-resetGoalDataSpec = describe "resetGoalData" $ do
-  players <- runIO $ replicateM 5 makePlayer
-  let
-    gs
-      = newGameState
-      & goalBy              ?~ 1
-      & assistsBy           .~ [2, 3]
-      & confirmGoalDataFlag .~ True
-    ps
-      = newProgState
-      & database.dbPlayers  .~ players
-      & progMode.gameStateL .~ gs
-      & resetGoalData
-
-  it "should clear the goalBy value" $
-    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
-
-  it "should clear the assists by list" $
-    ps^.progMode.gameStateL.assistsBy `shouldBe` []
-
-  it "should clear confirmGoalDataFlag" $
-    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
-
-assignPMinsSpec :: Spec
-assignPMinsSpec = describe "assignPMins" $ let
-
-  bob = newPlayer 2 "Bob" "centre"
-    & pYtd.psPMin      .~ 3
-    & pLifetime.psPMin .~ 4
-
-  joe = newPlayer 3 "Joe" "defense"
-    & pYtd.psPMin      .~ 5
-    & pLifetime.psPMin .~ 6
-
-  ps pid = newProgState
-    & database.dbPlayers .~ [bob, joe]
-    & progMode.gameStateL
-      %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
-      .  (gameSelectedPlayer .~ pid)
-
-  in mapM_
-    (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
-      context ("selectedPlayer = " ++ show pid) $ do
-        let ps' = assignPMins 2 $ ps pid
-
-        mapM_
-          (\(name, pid', lt, ytd, game) -> context name $ do
-            let
-              player = fromJust $ nth pid' $ ps'^.database.dbPlayers
-              gStats = ps'^.progMode.gameStateL.gamePlayerStats
-              pStats = M.findWithDefault newPlayerStats pid' gStats
-
-            context "lifetime penalty minutes" $
-              it ("should be " ++ show lt) $
-                player^.pLifetime.psPMin `shouldBe` lt
-
-            context "year-to-date penalty minutes" $
-              it ("should be " ++ show ytd) $
-                player^.pYtd.psPMin `shouldBe` ytd
-
-            context "game penalty minutes" $
-              it ("should be " ++ show game) $
-                pStats^.psPMin `shouldBe` game)
-
-          --  name,  index, lifetime, ytd,    game
-          [ ( "Bob", 0,     bobLt,    bobYtd, bobGame )
-          , ( "Joe", 1,     joeLt,    joeYtd, joeGame )
-          ]
-
-        it "should set selectedPlayer to Nothing" $
-          ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
-
-    --  index,   bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
-    [ ( Just 0,  6,      5,       4,        6,      5,       0        )
-    , ( Just 1,  4,      3,       2,        8,      7,       2        )
-    , ( Just 2,  4,      3,       2,        6,      5,       0        )
-    , ( Nothing, 4,      3,       2,        6,      5,       0        )
-    ]
-
-makePlayer :: IO Player
-makePlayer = Player
-  <$> makeNum
-  <*> makeName
-  <*> makeName
-  <*> makePlayerStats
-  <*> makePlayerStats
-
-makeGoalie :: IO Goalie
-makeGoalie = Goalie
-  <$> makeNum
-  <*> makeName
-  <*> makeGoalieStats
-  <*> makeGoalieStats
-
-makePlayerStats :: IO PlayerStats
-makePlayerStats = PlayerStats
-  <$> makeNum
-  <*> makeNum
-  <*> makeNum
-
-makeGoalieStats :: IO GoalieStats
-makeGoalieStats = GoalieStats
-  <$> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-
-makeNum :: IO Int
-makeNum = randomRIO (1, 10)
-
-makeName :: IO String
-makeName = replicateM 10 $ randomRIO ('A', 'Z')
-
 backHomeSpec :: Spec
 backHomeSpec = describe "backHome" $ do
   let
@@ -755,6 +271,7 @@ scrollUpSpec = describe "scrollUp" $ do
       ps' = scrollUp ps
       in ps'^.scrollOffset `shouldBe` 0
 
+scrollDownSpec :: Spec
 scrollDownSpec = describe "scrollDown" $
   it "should increase the scroll offset" $ let
     ps  = newProgState & scrollOffset .~ 10

test/ReportSpec.hs

@@ -21,7 +21,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module ReportSpec (spec) where
 
-import Lens.Micro ((&), (?~), (%~))
+import Lens.Micro ((&), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Report

test/TypesSpec.hs

@@ -21,13 +21,21 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 {-# LANGUAGE OverloadedStrings, RankNTypes #-}
 
-module TypesSpec (Comparable (..), spec) where
+module TypesSpec
+  ( Comparable (..)
+  , spec
+  , makePlayer
+  , makeGoalie
+  , makePlayerStats
+  , makeGoalieStats
+  ) where
 
+import Control.Monad (replicateM)
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
-import Data.ByteString.Lazy (ByteString)
 import qualified Data.HashMap.Strict as HM
 import Lens.Micro (Lens', (&), (^.), (.~), (?~))
+import System.Random (randomRIO)
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Config
@@ -764,6 +772,47 @@ bob = newPlayer 3 "Bob" "defense"
 steve :: Player
 steve = newPlayer 5 "Steve" "forward"
 
+-- | Creates a 'Player'
+makePlayer :: IO Player
+makePlayer = Player
+  <$> makeNum
+  <*> makeName
+  <*> makeName
+  <*> makePlayerStats
+  <*> makePlayerStats
+
+-- | Creates a 'Goalie'
+makeGoalie :: IO Goalie
+makeGoalie = Goalie
+  <$> makeNum
+  <*> makeName
+  <*> makeGoalieStats
+  <*> makeGoalieStats
+
+-- | Creates a 'PlayerStats' value
+makePlayerStats :: IO PlayerStats
+makePlayerStats = PlayerStats
+  <$> makeNum
+  <*> makeNum
+  <*> makeNum
+
+-- | Creates a 'GoalieStats' value
+makeGoalieStats :: IO GoalieStats
+makeGoalieStats = GoalieStats
+  <$> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+
+
+makeNum :: IO Int
+makeNum = randomRIO (1, 10)
+
+makeName :: IO String
+makeName = replicateM 10 $ randomRIO ('A', 'Z')
+
 instance Comparable GoalieStats where
   compareTest actual expected = mapM_
     (\(name, lens) -> describe name $