version 0.6.0

fixed new season menu

ChangeLog.md

@@ -1,5 +1,10 @@
 # Changelog for mtlstats
 
+## 0.6.0
+- Generate lifetime statistics report
+- Implemented goalie editing
+- Reset game standings on new season
+
 ## 0.5.0
 
 - Fixed player creation bug

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.5.0
+version:             0.6.0
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"
@@ -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
@@ -33,6 +33,10 @@ dependencies:
 - bytestring
 - microlens
 
+ghc-options:
+  - -Wall
+  - -Werror
+
 library:
   source-dirs: src
 

src/Mtlstats/Actions.hs

@@ -24,37 +24,28 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module Mtlstats.Actions
   ( startNewSeason
   , resetYtd
+  , resetStandings
   , startNewGame
   , addChar
   , removeChar
-  , overtimeCheck
-  , updateGameStats
-  , validateGameDate
   , createPlayer
   , createGoalie
   , editPlayer
+  , editGoalie
   , addPlayer
   , 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
@@ -66,6 +57,12 @@ resetYtd
   = (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
   . (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
 
+-- | Resets game standings
+resetStandings :: ProgState -> ProgState
+resetStandings = database
+  %~ ( dbHomeGameStats .~ newGameStats)
+  .  ( dbAwayGameStats .~ newGameStats)
+
 -- | Starts a new game
 startNewGame :: ProgState -> ProgState
 startNewGame
@@ -82,65 +79,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
@@ -163,6 +101,10 @@ createGoalie = let
 editPlayer :: ProgState -> ProgState
 editPlayer = progMode .~ EditPlayer newEditPlayerState
 
+-- | Starts the 'Goalie' editing process
+editGoalie :: ProgState -> ProgState
+editGoalie = progMode .~ EditGoalie newEditGoalieState
+
 -- | Adds the entered player to the roster
 addPlayer :: ProgState -> ProgState
 addPlayer s = fromMaybe s $ do
@@ -199,81 +141,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/EditGoalie.hs

@@ -0,0 +1,164 @@
+{- |
+
+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.EditGoalie
+  ( editGoalieNumber
+  , editGoalieName
+  , editGoalieYtdGames
+  , editGoalieYtdMins
+  , editGoalieYtdGoals
+  , editGoalieYtdWins
+  , editGoalieYtdLosses
+  , editGoalieYtdTies
+  , editGoalieLtGames
+  , editGoalieLtMins
+  , editGoalieLtGoals
+  , editGoalieLtWins
+  , editGoalieLtLosses
+  , editGoalieLtTies
+  ) where
+
+import Control.Monad (void)
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.), (&), (.~), (%~))
+
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Edits a goalie's number
+editGoalieNumber
+  :: Int
+  -- ^ New goalie number
+  -> ProgState
+  -> ProgState
+editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
+
+-- | Edits a goalie's name
+editGoalieName
+  :: String
+  -- ^ The new name
+  -> ProgState
+  -> ProgState
+editGoalieName name = editGoalie (gName .~ name) EGMenu
+
+-- | Edits a goalie's YTD games
+editGoalieYtdGames
+  :: Int
+  -- ^ The number of games played
+  -> ProgState
+  -> ProgState
+editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
+
+-- | Edits a goalie's YTD minutes
+editGoalieYtdMins
+  :: Int
+  -- ^ The number of minutes played
+  -> ProgState
+  -> ProgState
+editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
+
+-- | Edits a goalie's YTD goals allowed
+editGoalieYtdGoals
+  :: Int
+  -- ^ The number of goals
+  -> ProgState
+  -> ProgState
+editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
+
+-- | Edits a goalie's YTD wins
+editGoalieYtdWins
+  :: Int
+  -- ^ The number of wins
+  -> ProgState
+  -> ProgState
+editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
+
+-- | Edits a goalie's YTD losses
+editGoalieYtdLosses
+  :: Int
+  -- ^ The number of losses
+  -> ProgState
+  -> ProgState
+editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
+
+-- | Edits a goalie's YTD ties
+editGoalieYtdTies
+  :: Int
+  -- ^ The number of ties
+  -> ProgState
+  -> ProgState
+editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
+
+-- | Edits a goalie's lifetime games played
+editGoalieLtGames
+  :: Int
+  -- ^ The number of games
+  -> ProgState
+  -> ProgState
+editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
+
+-- | Edits a goalie's lifetime minutes played
+editGoalieLtMins
+  :: Int
+  -- ^ The number of minutes
+  -> ProgState
+  -> ProgState
+editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
+
+-- | Edits a goalie's lifetime goals allowed
+editGoalieLtGoals
+  :: Int
+  -- ^ The number of goals
+  -> ProgState
+  -> ProgState
+editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
+
+-- | Edits a goalie's lifetime wins
+editGoalieLtWins
+  :: Int
+  -- ^ The number of wins
+  -> ProgState
+  -> ProgState
+editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
+
+-- | Edits a goalie's lifetime losses
+editGoalieLtLosses
+  :: Int
+  -- ^ The number of losses
+  -> ProgState
+  -> ProgState
+editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
+
+-- | Edits a goalie's lifetime ties
+editGoalieLtTies
+  :: Int
+  -- ^ The number of ties
+  -> ProgState
+  -> ProgState
+editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
+
+editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
+editGoalie f mode s = fromMaybe s $ do
+  gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+  void $ nth gid $ s^.database.dbGoalies
+  Just $ s
+    & database.dbGoalies %~ modifyNth gid f
+    & progMode.editGoalieStateL.egsMode .~ mode

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 ((^.), (&), (.~), (%~), (+~))
@@ -43,9 +44,9 @@ recordGoalieStats :: ProgState -> ProgState
 recordGoalieStats s = fromMaybe s $ do
   let gs = s^.progMode.gameStateL
   gid   <- gs^.gameSelectedGoalie
-  goalie <- nth gid $ s^.database.dbGoalies
   mins  <- gs^.gameGoalieMinsPlayed
   goals <- gs^.gameGoalsAllowed
+  void $ nth gid $ s^.database.dbGoalies
 
   let
     gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
       then 1
       else 0
 
-    bumpStats gs = gs
+    bumpStats
-      & gsGames        +~ bumpVal
+      = (gsGames        +~ bumpVal)
-      & gsMinsPlayed   +~ mins
+      . (gsMinsPlayed   +~ mins)
-      & gsGoalsAllowed +~ goals
+      . (gsGoalsAllowed +~ goals)
 
     tryFinish = if mins >= gameLength
       then finishGoalieEntry
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
     l = if lost then 1 else 0
     t = if tied then 1 else 0
 
-    updateStats gs = gs
+    updateStats
-      & gsWins   +~ w
+      = (gsWins   +~ w)
-      & gsLosses +~ l
+      . (gsLosses +~ l)
-      & gsTies   +~ t
+      . (gsTies   +~ t)
 
-    updateGoalie g = g
+    updateGoalie
-      & gYtd      %~ updateStats
+      = (gYtd      %~ updateStats)
-      & gLifetime %~ updateStats
+      . (gLifetime %~ updateStats)
 
-    updateGameState gs = gs
+    updateGameState
-      & gameGoalieStats %~ updateMap gid newGoalieStats updateStats
+      = (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
-      & gameGoalieAssigned .~ True
+      . (gameGoalieAssigned .~ True)
 
   Just $ s
     & database.dbGoalies  %~ modifyNth gid updateGoalie

src/Mtlstats/Control.hs

@@ -21,25 +21,21 @@ 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.EditGoalie
 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 +43,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
@@ -72,6 +54,7 @@ dispatch s = case s^.progMode of
     | null $ cgs^.cgsName   -> getGoalieNameC
     | otherwise             -> confirmCreateGoalieC
   EditPlayer eps -> editPlayerC eps
+  EditGoalie egs -> editGoalieC egs
 
 mainMenuC :: Controller
 mainMenuC = Controller
@@ -87,219 +70,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 +151,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/EditGoalie.hs

@@ -0,0 +1,137 @@
+{- |
+
+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.Control.EditGoalie (editGoalieC) where
+
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import UI.NCurses as C
+
+import Mtlstats.Menu
+import Mtlstats.Menu.EditGoalie
+import Mtlstats.Prompt
+import Mtlstats.Prompt.EditGoalie
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Controller/dispatcher for editing a 'Goalie'
+editGoalieC :: EditGoalieState -> Controller
+editGoalieC egs
+  | null $ egs^.egsSelectedGoalie = selectC
+  | otherwise = editC $ egs^.egsMode
+
+selectC :: Controller
+selectC = promptController goalieToEditPrompt
+
+editC :: EditGoalieMode -> Controller
+editC = \case
+  EGMenu      -> menuC
+  EGNumber    -> numberC
+  EGName      -> nameC
+  EGYtd       -> ytdMenuC
+  EGLifetime  -> lifetimeMenuC
+  EGYtdGames  -> ytdGamesC
+  EGYtdMins   -> ytdMinsC
+  EGYtdGoals  -> ytdGoalsC
+  EGYtdWins   -> ytdWinsC
+  EGYtdLosses -> ytdLossesC
+  EGYtdTies   -> ytdTiesC
+  EGLtGames   -> ltGamesC
+  EGLtMins    -> ltMinsC
+  EGLtGoals   -> ltGoalsC
+  EGLtWins    -> ltWinsC
+  EGLtLosses  -> ltLossesC
+  EGLtTies    -> ltTiesC
+
+menuC :: Controller
+menuC = menuControllerWith header editGoalieMenu
+
+numberC :: Controller
+numberC = promptController editGoalieNumberPrompt
+
+nameC :: Controller
+nameC = promptController editGoalieNamePrompt
+
+ytdMenuC :: Controller
+ytdMenuC = menuControllerWith header editGoalieYtdMenu
+
+lifetimeMenuC :: Controller
+lifetimeMenuC = menuControllerWith header editGoalieLtMenu
+
+ytdGamesC :: Controller
+ytdGamesC = promptController editGoalieYtdGamesPrompt
+
+ytdMinsC :: Controller
+ytdMinsC = promptController editGoalieYtdMinsPrompt
+
+ytdGoalsC :: Controller
+ytdGoalsC = promptController editGoalieYtdGoalsPrompt
+
+ytdWinsC :: Controller
+ytdWinsC = promptController editGoalieYtdWinsPrompt
+
+ytdLossesC :: Controller
+ytdLossesC = promptController editGoalieYtdLossesPrompt
+
+ytdTiesC :: Controller
+ytdTiesC = promptController editGoalieYtdTiesPrompt
+
+ltGamesC :: Controller
+ltGamesC = promptController editGoalieLtGamesPrompt
+
+ltMinsC :: Controller
+ltMinsC = promptController editGoalieLtMinsPrompt
+
+ltGoalsC :: Controller
+ltGoalsC = promptController editGoalieLtGoalsPrompt
+
+ltWinsC :: Controller
+ltWinsC = promptController editGoalieLtWinsPrompt
+
+ltLossesC :: Controller
+ltLossesC = promptController editGoalieLtLossesPrompt
+
+ltTiesC :: Controller
+ltTiesC = promptController editGoalieLtTiesPrompt
+
+header :: ProgState -> C.Update ()
+header s = C.drawString $ fromMaybe "" $ do
+  gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+  g   <- nth gid $ s^.database.dbGoalies
+  Just $ unlines
+    [ "         Goalie number: " ++ show (g^.gNumber)
+    , "           Goalie name: " ++ g^.gName
+    , "      YTD games played: " ++ show (g^.gYtd.gsGames)
+    , "       YTD mins played: " ++ show (g^.gYtd.gsMinsPlayed)
+    , "     YTD goals allowed: " ++ show (g^.gYtd.gsGoalsAllowed)
+    , "              YTD wins: " ++ show (g^.gYtd.gsWins)
+    , "            YTD losses: " ++ show (g^.gYtd.gsLosses)
+    , "              YTD ties: " ++ show (g^.gYtd.gsTies)
+    , " Lifetime games played: " ++ show (g^.gLifetime.gsGames)
+    , "  Lifetime mins played: " ++ show (g^.gLifetime.gsMinsPlayed)
+    , "Lifetime goals allowed: " ++ show (g^.gLifetime.gsGoalsAllowed)
+    , "         Lifetime wins: " ++ show (g^.gLifetime.gsWins)
+    , "       Lifetime losses: " ++ show (g^.gLifetime.gsLosses)
+    , "         Lifetime ties: " ++ show (g^.gLifetime.gsTies)
+    , ""
+    ]

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

@@ -22,6 +22,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module Mtlstats.Menu (
   -- * Menu Functions
   menuController,
+  menuControllerWith,
   drawMenu,
   menuHandler,
   -- * Menus
@@ -49,7 +50,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
@@ -57,8 +58,20 @@ import Mtlstats.Util
 
 -- | Generates a simple 'Controller' for a Menu
 menuController :: Menu () -> Controller
-menuController menu = Controller
+menuController = menuControllerWith $ const $ return ()
-  { drawController   = const $ drawMenu menu
+
+-- | Generate a simple 'Controller' for a 'Menu' with a header
+menuControllerWith
+  :: (ProgState -> C.Update ())
+  -- ^ Generates the header
+  -> Menu ()
+  -- ^ The menu
+  -> Controller
+  -- ^ The resulting controller
+menuControllerWith header menu = Controller
+  { drawController = \s -> do
+    header s
+    drawMenu menu
   , handleController = \e -> do
     menuHandler menu e
     return True
@@ -91,7 +104,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
     modify createGoalie >> return True
   , MenuItem '5' "Edit Player" $
     modify editPlayer >> return True
-  , MenuItem '6' "Exit" $ do
+  , MenuItem '6' "Edit Goalie" $
+    modify editGoalie >> return True
+  , MenuItem 'X' "Exit" $ do
     db <- gets $ view database
     liftIO $ do
       dir <- getAppUserDataDirectory appName
@@ -104,11 +119,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
 -- | The new season menu
 newSeasonMenu :: Menu ()
 newSeasonMenu = Menu "*** SEASON TYPE ***" ()
-  [ MenuItem '1' "Regular Season" $ do
+  [ MenuItem 'R' "Regular Season" $ modify
-    modify resetYtd
+    $ resetYtd
-    modify startNewGame
+    . resetStandings
-  , MenuItem '2' "Playoffs" $
+    . startNewGame
-    modify startNewGame
+  , MenuItem 'P' "Playoffs" $ modify
+    $ resetStandings
+    . startNewGame
   ]
 
 -- | Requests the month in which the game took place

src/Mtlstats/Menu/EditGoalie.hs

@@ -0,0 +1,80 @@
+{- |
+
+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.Menu.EditGoalie
+  ( editGoalieMenu
+  , editGoalieYtdMenu
+  , editGoalieLtMenu
+  ) where
+
+import Control.Monad.Trans.State (modify)
+import Data.Maybe (maybe)
+import Lens.Micro ((.~))
+
+import Mtlstats.Types
+import Mtlstats.Types.Menu
+
+-- | The 'Goalie' edit menu
+editGoalieMenu :: Menu ()
+editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
+  (\(key, label, val) -> MenuItem key label $ modify $ maybe
+    (progMode .~ MainMenu)
+    (progMode.editGoalieStateL.egsMode .~)
+    val)
+  --  key, label,                 value
+  [ ( '1', "Edit number",         Just EGNumber   )
+  , ( '2', "Edit name",           Just EGName     )
+  , ( '3', "Edit YTD stats",      Just EGYtd      )
+  , ( '4', "Edit Lifetime stats", Just EGLifetime )
+  , ( 'R', "Return to Main Menu", Nothing         )
+  ]
+
+-- | The 'Goalie' YTD edit menu
+editGoalieYtdMenu :: Menu ()
+editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
+  --  key, label,                 value
+  [ ( '1', "Edit YTD games",      EGYtdGames  )
+  , ( '2', "Edit YTD minutes",    EGYtdMins   )
+  , ( '3', "Edit YTD goals",      EGYtdGoals  )
+  , ( '4', "Edit YTD wins",       EGYtdWins   )
+  , ( '5', "Edit YTD losses",     EGYtdLosses )
+  , ( '6', "Edit YTD ties",       EGYtdTies   )
+  , ( 'R', "Return to edit menu", EGMenu      )
+  ]
+
+-- | The 'Goalie' lifetime edit menu
+editGoalieLtMenu :: Menu ()
+editGoalieLtMenu = editMenu
+  "*** EDIT GOALTENDER LIFETIME ***"
+  --  key, label,                   value
+  [ ( '1', "Edit lifetime games",   EGLtGames  )
+  , ( '2', "Edit lifetime minutes", EGLtMins   )
+  , ( '3', "Edit lifetime goals",   EGLtGoals  )
+  , ( '4', "Edit lifetime wins",    EGLtWins   )
+  , ( '5', "Edit lifetime losses",  EGLtLosses )
+  , ( '6', "Edit lifetime ties",    EGLtTies   )
+  , ( 'R', "Return to edit menu",   EGMenu     )
+  ]
+
+editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
+editMenu title = Menu title () . map
+  (\(key, label, val) -> MenuItem key label $
+    modify $ progMode.editGoalieStateL.egsMode .~ val)

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
 
@@ -173,37 +162,12 @@ selectPrompt params = Prompt
         n       = pred $ fromInteger rawK
         results = spSearch params sStr db
       when (n < maxFunKeys) $
-        whenJust (nth n results) $ \(n, _) -> do
+        whenJust (nth n results) $ \(sel, _) -> do
           modify $ inputBuffer .~ ""
-          spCallback params $ Just n
+          spCallback params $ Just sel
     _ -> 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/EditGoalie.hs

@@ -0,0 +1,120 @@
+{- |
+
+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.Prompt.EditGoalie
+  ( goalieToEditPrompt
+  , editGoalieNumberPrompt
+  , editGoalieNamePrompt
+  , editGoalieYtdGamesPrompt
+  , editGoalieYtdMinsPrompt
+  , editGoalieYtdGoalsPrompt
+  , editGoalieYtdWinsPrompt
+  , editGoalieYtdLossesPrompt
+  , editGoalieYtdTiesPrompt
+  , editGoalieLtGamesPrompt
+  , editGoalieLtMinsPrompt
+  , editGoalieLtGoalsPrompt
+  , editGoalieLtWinsPrompt
+  , editGoalieLtLossesPrompt
+  , editGoalieLtTiesPrompt
+  ) where
+
+import Control.Monad.Trans.State (modify)
+import Lens.Micro ((.~))
+
+import Mtlstats.Actions.EditGoalie
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompt to select a 'Goalie' for editing
+goalieToEditPrompt :: Prompt
+goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
+  modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
+
+-- | Prompt to edit a goalie's number
+editGoalieNumberPrompt :: Prompt
+editGoalieNumberPrompt = numPrompt "Goalie number: " $
+  modify . editGoalieNumber
+
+-- | Prompt to edit a goalie's name
+editGoalieNamePrompt :: Prompt
+editGoalieNamePrompt = strPrompt "Goalie name: " $
+  modify . editGoalieName
+
+-- | Prompt to edit a goalie's YTD games played
+editGoalieYtdGamesPrompt :: Prompt
+editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
+  modify . editGoalieYtdGames
+
+-- | Prompt to edit a goalie's YTD minutes played
+editGoalieYtdMinsPrompt :: Prompt
+editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
+  modify . editGoalieYtdMins
+
+-- | Prompt to edit a goalie's YTD goales allowed
+editGoalieYtdGoalsPrompt :: Prompt
+editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
+  modify . editGoalieYtdGoals
+
+-- | Prompt to edit a goalie's YTD wins
+editGoalieYtdWinsPrompt :: Prompt
+editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
+  modify . editGoalieYtdWins
+
+-- | Prompt to edit a goalie's YTD losses
+editGoalieYtdLossesPrompt :: Prompt
+editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
+  modify . editGoalieYtdLosses
+
+-- | Prompt to edit a goalie's YTD ties
+editGoalieYtdTiesPrompt :: Prompt
+editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
+  modify . editGoalieYtdTies
+
+-- | Prompt to edit a goalie's lifetime games played
+editGoalieLtGamesPrompt :: Prompt
+editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
+  modify . editGoalieLtGames
+
+-- | Prompt to edit a goalie's lifetime minutes played
+editGoalieLtMinsPrompt :: Prompt
+editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
+  modify . editGoalieLtMins
+
+-- | Prompt to edit a goalie's lifetime goals allowed
+editGoalieLtGoalsPrompt :: Prompt
+editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
+  modify . editGoalieLtGoals
+
+-- | Prompt to edit a goalie's lifetime wins
+editGoalieLtWinsPrompt :: Prompt
+editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
+  modify . editGoalieLtWins
+
+-- | Prompt to edit a goalie's lifetime losses
+editGoalieLtLossesPrompt :: Prompt
+editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
+  modify . editGoalieLtLosses
+
+-- | Prompt to edit a goalie's lifetime ties
+editGoalieLtTiesPrompt :: Prompt
+editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
+  modify . editGoalieLtTies

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/Report.hs

@@ -43,6 +43,8 @@ report width s
   ++ gameStatsReport width s
   ++ [""]
   ++ yearToDateStatsReport width s
+  ++ [""]
+  ++ lifetimeStatsReport width s
 
 standingsReport :: Int -> ProgState -> [String]
 standingsReport width s = fromMaybe [] $ do
@@ -103,12 +105,16 @@ yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
   map (\p -> (p, p^.pYtd)) $
   filter playerIsActive $ s^.database.dbPlayers
 
+lifetimeStatsReport :: Int -> ProgState -> [String]
+lifetimeStatsReport width s = playerReport width "LIFETIME" $
+  map (\p -> (p, p^.pLifetime)) $ s^.database.dbPlayers
+
 gameDate :: GameState -> String
 gameDate gs = fromMaybe "" $ do
-  year  <- show <$> gs^.gameYear
+  y <- show <$> gs^.gameYear
-  month <- month <$> gs^.gameMonth
+  m <- month <$> gs^.gameMonth
-  day   <- padNum 2 <$> gs^.gameDay
+  d <- padNum 2 <$> gs^.gameDay
-  Just $ month ++ " " ++ day ++ " " ++ year
+  Just $ m ++ " " ++ d ++ " " ++ y
 
 playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
 playerReport width label ps = let

src/Mtlstats/Types.hs

@@ -33,6 +33,8 @@ module Mtlstats.Types (
   CreateGoalieState (..),
   EditPlayerState (..),
   EditPlayerMode (..),
+  EditGoalieState (..),
+  EditGoalieMode (..),
   Database (..),
   Player (..),
   PlayerStats (..),
@@ -52,6 +54,7 @@ module Mtlstats.Types (
   createPlayerStateL,
   createGoalieStateL,
   editPlayerStateL,
+  editGoalieStateL,
   -- ** GameState Lenses
   gameYear,
   gameMonth,
@@ -89,6 +92,9 @@ module Mtlstats.Types (
   -- ** EditPlayerState Lenses
   epsSelectedPlayer,
   epsMode,
+  -- ** EditGoalieState Lenses
+  egsSelectedGoalie,
+  egsMode,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -129,6 +135,7 @@ module Mtlstats.Types (
   newCreatePlayerState,
   newCreateGoalieState,
   newEditPlayerState,
+  newEditGoalieState,
   newDatabase,
   newPlayer,
   newPlayerStats,
@@ -218,6 +225,7 @@ data ProgMode
   | CreatePlayer CreatePlayerState
   | CreateGoalie CreateGoalieState
   | EditPlayer EditPlayerState
+  | EditGoalie EditGoalieState
 
 instance Show ProgMode where
   show MainMenu         = "MainMenu"
@@ -226,6 +234,7 @@ instance Show ProgMode where
   show (CreatePlayer _) = "CreatePlayer"
   show (CreateGoalie _) = "CreateGoalie"
   show (EditPlayer _)   = "EditPlayer"
+  show (EditGoalie _)   = "EditGoalie"
 
 -- | The game state
 data GameState = GameState
@@ -334,6 +343,34 @@ data EditPlayerMode
   | EPLtPMin
   deriving (Eq, Show)
 
+-- | 'Goalie' edit status
+data EditGoalieState = EditGoalieState
+  { _egsSelectedGoalie :: Maybe Int
+  -- ^ The index number of the 'Goalie' being edited
+  , _egsMode           :: EditGoalieMode
+  }
+
+-- | 'Goalie' editing mode
+data EditGoalieMode
+  = EGMenu
+  | EGNumber
+  | EGName
+  | EGYtd
+  | EGLifetime
+  | EGYtdGames
+  | EGYtdMins
+  | EGYtdGoals
+  | EGYtdWins
+  | EGYtdLosses
+  | EGYtdTies
+  | EGLtGames
+  | EGLtMins
+  | EGLtGoals
+  | EGLtWins
+  | EGLtLosses
+  | EGLtTies
+  deriving (Eq, Show)
+
 -- | Represents the database
 data Database = Database
   { _dbPlayers       :: [Player]
@@ -581,6 +618,7 @@ makeLenses ''GameState
 makeLenses ''CreatePlayerState
 makeLenses ''CreateGoalieState
 makeLenses ''EditPlayerState
+makeLenses ''EditGoalieState
 makeLenses ''Database
 makeLenses ''Player
 makeLenses ''PlayerStats
@@ -616,6 +654,13 @@ editPlayerStateL = lens
     _              -> newEditPlayerState)
   (\_ eps -> EditPlayer eps)
 
+editGoalieStateL :: Lens' ProgMode EditGoalieState
+editGoalieStateL = lens
+  (\case
+    EditGoalie egs -> egs
+    _              -> newEditGoalieState)
+  (\_ egs -> EditGoalie egs)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
@@ -678,6 +723,13 @@ newEditPlayerState = EditPlayerState
   , _epsMode           = EPMenu
   }
 
+-- | Constructor for an 'EditGoalieState' value
+newEditGoalieState :: EditGoalieState
+newEditGoalieState = EditGoalieState
+  { _egsSelectedGoalie = Nothing
+  , _egsMode           = EGMenu
+  }
+
 -- | Constructor for a 'Database'
 newDatabase :: Database
 newDatabase = Database
@@ -828,9 +880,8 @@ playerSearch
   -> [(Int, Player)]
   -- ^ The matching players with their index numbers
 playerSearch sStr =
-  filter (match sStr) .
+  filter match . zip [0..]
-  zip [0..]
+  where match (_, p) = sStr `isInfixOf` (p^.pName)
-  where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
 
 -- | Searches for a player by exact match on name
 playerSearchExact
@@ -841,10 +892,8 @@ playerSearchExact
   -> Maybe (Int, Player)
   -- ^ The player's index and value
 playerSearchExact sStr =
-  listToMaybe .
+  listToMaybe . filter match . zip [0..]
-  filter (match sStr) .
+  where match (_, p) = p^.pName == sStr
-  zip [0..]
-  where match sStr (_, p) = p^.pName == sStr
 
 -- | Modifies a player with a given name
 modifyPlayer

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/EditGoalieSpec.hs

@@ -0,0 +1,537 @@
+{-
+
+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.EditGoalieSpec (spec) where
+
+import Data.Maybe (fromJust)
+import Lens.Micro ((^.), (&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Actions.EditGoalie
+import Mtlstats.Types
+import Mtlstats.Util
+
+spec :: Spec
+spec = describe "EditGoalie" $ do
+  editGoalieNumberSpec
+  editGoalieNameSpec
+  editGoalieYtdGamesSpec
+  editGoalieYtdMinsSpec
+  editGoalieYtdGoalsSpec
+  editGoalieYtdWinsSpec
+  editGoalieYtdLossesSpec
+  editGoalieYtdTiesSpec
+  editGoalieLtGamesSpec
+  editGoalieLtMinsSpec
+  editGoalieLtGoalsSpec
+  editGoalieLtWinsSpec
+  editGoalieLtLossesSpec
+  editGoalieLtTiesSpec
+
+editGoalieNumberSpec :: Spec
+editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
+  (editGoalieNumber 5)
+  EGNumber
+  (uncurry newGoalie)
+  [ ( "set Joe"
+    , Just 0
+    , (5, "Joe")
+    , (3, "Bob")
+    , EGMenu
+    )
+  , ( "set Bob"
+    , Just 1
+    , (2, "Joe")
+    , (5, "Bob")
+    , EGMenu
+    )
+  , ( "out of bounds"
+    , Just 2
+    , (2, "Joe")
+    , (3, "Bob")
+    , EGNumber
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , (2, "Joe")
+    , (3, "Bob")
+    , EGNumber
+    )
+  ]
+
+editGoalieNameSpec :: Spec
+editGoalieNameSpec = describe "editGoalieName" $ editTest
+  (editGoalieName "foo")
+  EGName
+  (uncurry newGoalie)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "foo" )
+    , ( 3, "Bob" )
+    , EGMenu
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe" )
+    , ( 3, "foo" )
+    , EGMenu
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe" )
+    , ( 3, "Bob" )
+    , EGName
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe" )
+    , ( 3, "Bob" )
+    , EGName
+    )
+  ]
+
+editGoalieYtdGamesSpec :: Spec
+editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
+  (editGoalieYtdGames 1)
+  EGYtdGames
+  (\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdGames
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdGames
+    )
+  ]
+
+editGoalieYtdMinsSpec :: Spec
+editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
+  (editGoalieYtdMins 1)
+  EGYtdMins
+  (\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , (2, "Joe", 0 )
+    , (3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdMins
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdMins
+    )
+  ]
+
+editGoalieYtdGoalsSpec :: Spec
+editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
+  (editGoalieYtdGoals 1)
+  EGYtdGoals
+  (\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdGoals
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdGoals
+    )
+  ]
+
+editGoalieYtdWinsSpec :: Spec
+editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
+  (editGoalieYtdWins 1)
+  EGYtdWins
+  (\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdWins
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdWins
+    )
+  ]
+
+editGoalieYtdLossesSpec :: Spec
+editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
+  (editGoalieYtdLosses 1)
+  EGYtdLosses
+  (\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdLosses
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdLosses
+    )
+  ]
+
+editGoalieYtdTiesSpec :: Spec
+editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
+  (editGoalieYtdTies 1)
+  EGYtdTies
+  (\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGYtd
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGYtd
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdTies
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGYtdTies
+    )
+  ]
+
+editGoalieLtGamesSpec :: Spec
+editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
+  (editGoalieLtGames 1)
+  EGLtGames
+  (\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtGames
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtGames
+    )
+  ]
+
+editGoalieLtMinsSpec :: Spec
+editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
+  (editGoalieLtMins 1)
+  EGLtMins
+  (\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtMins
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtMins
+    )
+  ]
+
+editGoalieLtGoalsSpec :: Spec
+editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
+  (editGoalieLtGoals 1)
+  EGLtGoals
+  (\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtGoals
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtGoals
+    )
+  ]
+
+editGoalieLtWinsSpec :: Spec
+editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
+  (editGoalieLtWins 1)
+  EGLtWins
+  (\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtWins
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtWins
+    )
+  ]
+
+editGoalieLtLossesSpec :: Spec
+editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
+  (editGoalieLtLosses 1)
+  EGLtLosses
+  (\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtLosses
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtLosses
+    )
+  ]
+
+editGoalieLtTiesSpec :: Spec
+editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
+  (editGoalieLtTies 1)
+  EGLtTies
+  (\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
+  [ ( "set Joe"
+    , Just 0
+    , ( 2, "Joe", 1 )
+    , ( 3, "Bob", 0 )
+    , EGLifetime
+    )
+  , ( "set Bob"
+    , Just 1
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 1 )
+    , EGLifetime
+    )
+  , ( "out of bounds"
+    , Just 2
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtTies
+    )
+  , ( "no goalie selected"
+    , Nothing
+    , ( 2, "Joe", 0 )
+    , ( 3, "Bob", 0 )
+    , EGLtTies
+    )
+  ]
+
+editTest
+  :: (ProgState -> ProgState)
+  -> EditGoalieMode
+  -> (a -> Goalie)
+  -> [(String, Maybe Int, a, a, EditGoalieMode)]
+  -> Spec
+editTest func setMode mkGoalie params = do
+  mapM_
+    (\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
+      let
+        egs = newEditGoalieState
+          & egsSelectedGoalie .~ setGid
+          & egsMode           .~ setMode
+
+        ps = func $ progState $ EditGoalie egs
+
+      mapM_
+        (\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
+          actual   = fromJust $ nth chkGid $ ps^.database.dbGoalies
+          expected = mkGoalie goalieData
+          in it ("should be " ++ show expected) $
+            actual `shouldBe` expected)
+        --  label,       goalie ID, goalie data
+        [ ( "check Joe", 0,         joeData     )
+        , ( "check Bob", 1,         bobData     )
+        ]
+
+      context "check mode" $
+        it ("should be " ++ show expectMode) $
+          ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
+
+    params
+
+  context "wrong progMode" $ do
+    let ps = func $ progState MainMenu
+
+    it "should not change the database" $
+      ps^.database `shouldBe` db
+
+    it "should not change the progMode" $
+      show (ps^.progMode) `shouldBe` "MainMenu"
+
+joe :: Goalie
+joe = newGoalie 2 "Joe"
+
+bob :: Goalie
+bob = newGoalie 3 "Bob"
+
+db :: Database
+db = newDatabase & dbGoalies .~ [joe, bob]
+
+progState :: ProgMode -> ProgState
+progState mode = newProgState
+  & progMode .~ mode
+  & database .~ db

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
 
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
     & progMode.gameStateL .~ gameState n mins goals
 
   in mapM_
-    (\(name, gid, mins, goals, joeData, bobData, reset) -> let
+    (\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
-      s = recordGoalieStats $ progState gid mins goals
+      s = recordGoalieStats $ progState setGid mins goals
-      in context name $ do
+      in context setName $ do
 
         mapM_
-          (\( name
+          (\( chkName
-            , gid
+            , chkGid
             , ( gGames
               , gMins
               , gGoals
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
               , ltMins
               , ltGoals
               )
-            ) -> context name $ do
+            ) -> context chkName $ do
               let
                 gs     = s^.progMode.gameStateL.gameGoalieStats
-                game   = M.findWithDefault newGoalieStats gid gs
+                game   = M.findWithDefault newGoalieStats chkGid gs
-                goalie = fromJust $ nth gid $ s^.database.dbGoalies
+                goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
                 ytd    = goalie^.gYtd
                 lt     = goalie^.gLifetime
 
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
           ]
 
         context "selected goalie" $ let
-          expected = if reset then Nothing else gid
+          expected = if reset then Nothing else setGid
           in it ("should be " ++ show expected) $
             (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
 
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
   tiedGame    = gameState 0 1 True
 
   in mapM_
-    (\(label, gameState, gid, bobData, joeData) -> context label $ let
+    (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
 
       progState = newProgState
         & database.dbGoalies  .~ [bob, joe]
-        & progMode.gameStateL .~ gameState
+        & progMode.gameStateL .~ gs
-        & setGameGoalie gid
+        & setGameGoalie setGid
 
       in mapM_
-        (\( label
+        (\( chkLabel
-          , gid
+          , chkGid
           , ( gWins
             , gLosses
             , gTies
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
             , ltLosses
             , ltTies
             )
-          ) -> context label $ do
+          ) -> context chkLabel $ do
             let
-              goalie = (progState^.database.dbGoalies) !! gid
+              goalie = (progState^.database.dbGoalies) !! chkGid
               gameStats = progState^.progMode.gameStateL.gameGoalieStats
-              game      = M.findWithDefault newGoalieStats gid gameStats
+              game      = M.findWithDefault newGoalieStats chkGid gameStats
               ytd       = goalie^.gYtd
               lifetime  = goalie^.gLifetime
 
             mapM_
-              (\(label, expected, actual) -> context label $
+              (\(label', expected, actual) -> context label' $
                 expected `TS.compareTest` actual)
               [ ( "game stats",     game,     goalieStats gWins   gLosses   gTies   )
               , ( "YTD stats",      ytd,      goalieStats ytdWins ytdLosses ytdTies )

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_
+    (\(name, pid, ytd, lt, game) ->
+      context name $ do
+        let
+          ps'    = awardGoal pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ name ++ "'s year-to-date goals") $
+          player^.pYtd.psGoals `shouldBe` ytd
+
+        it ("should increment " ++ name ++ "'s lifetime goals") $
+          player^.pLifetime.psGoals `shouldBe` lt
+
+        it ("should increment " ++ name ++ "'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_
+    (\(name, pid, ytd, lt, game) ->
+      context name $ do
+        let
+          ps' = awardAssist pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ name ++ "'s year-to-date assists") $
+          player^.pYtd.psAssists `shouldBe` ytd
+
+        it ("should increment " ++ name ++ "'s lifetime assists") $
+          player^.pLifetime.psAssists `shouldBe` lt
+
+        it ("should increment " ++ name ++ "'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,9 @@ import Test.Hspec
 
 import Mtlstats.Actions
 import Mtlstats.Types
-import Mtlstats.Util
 
-import qualified Actions.GoalieInputSpec as GoalieInput
+import qualified Actions.EditGoalieSpec as EditGoalie
+import qualified Actions.NewGameSpec as NewGame
 import qualified TypesSpec as TS
 
 spec :: Spec
@@ -51,27 +47,22 @@ spec = describe "Mtlstats.Actions" $ do
   startNewSeasonSpec
   startNewGameSpec
   resetYtdSpec
+  resetStandingsSpec
   addCharSpec
   removeCharSpec
-  overtimeCheckSpec
-  updateGameStatsSpec
-  validateGameDateSpec
   createPlayerSpec
   createGoalieSpec
   editPlayerSpec
+  editGoalieSpec
   addPlayerSpec
   addGoalieSpec
   resetCreatePlayerStateSpec
   resetCreateGoalieStateSpec
-  recordGoalAssistsSpec
-  awardGoalSpec
-  awardAssistSpec
-  resetGoalDataSpec
-  assignPMinsSpec
   backHomeSpec
   scrollUpSpec
   scrollDownSpec
-  GoalieInput.spec
+  NewGame.spec
+  EditGoalie.spec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -99,8 +90,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
@@ -137,6 +128,41 @@ resetYtdSpec = describe "resetYtd" $
         lt ^. gsTies          `shouldNotBe` 0) $
       s ^. database . dbGoalies
 
+resetStandingsSpec :: Spec
+resetStandingsSpec = describe "resetStandings" $ do
+  let
+    home = GameStats
+      { _gmsWins         = 1
+      , _gmsLosses       = 2
+      , _gmsOvertime     = 3
+      , _gmsGoalsFor     = 4
+      , _gmsGoalsAgainst = 5
+      }
+
+    away = GameStats
+      { _gmsWins         = 6
+      , _gmsLosses       = 7
+      , _gmsOvertime     = 8
+      , _gmsGoalsFor     = 9
+      , _gmsGoalsAgainst = 10
+      }
+
+    db = newDatabase
+      & dbHomeGameStats .~ home
+      & dbAwayGameStats .~ away
+
+    ps = newProgState
+      & database .~ db
+      & resetStandings
+
+  context "home standings" $
+    it "should be reset" $
+      ps^.database.dbHomeGameStats `shouldBe` newGameStats
+
+  context "away standings" $
+    it "should be reset" $
+      ps^.database.dbAwayGameStats `shouldBe` newGameStats
+
 addCharSpec :: Spec
 addCharSpec = describe "addChar" $
   it "should add the character to the input buffer" $ let
@@ -160,202 +186,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
@@ -374,6 +204,12 @@ editPlayerSpec = describe "editPlayer" $
     s = editPlayer newProgState
     in show (s^.progMode) `shouldBe` "EditPlayer"
 
+editGoalieSpec :: Spec
+editGoalieSpec = describe "editGoalie" $
+  it "should change the mode appropriately" $ let
+    s = editGoalie newProgState
+    in show (s^.progMode) `shouldBe` "EditGoalie"
+
 addPlayerSpec :: Spec
 addPlayerSpec = describe "addPlayer" $ do
   let
@@ -440,281 +276,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 +316,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
@@ -48,6 +56,7 @@ spec = describe "Mtlstats.Types" $ do
   createPlayerStateLSpec
   createGoalieStateLSpec
   editPlayerStateLSpec
+  editGoalieStateLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -161,6 +170,24 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
     eps2 = newEditPlayerState
       & epsSelectedPlayer ?~ 2
 
+editGoalieStateLSpec :: Spec
+editGoalieStateLSpec = describe "editGoalieStateL" $
+  lensSpec editGoalieStateL
+  -- getters
+  [ ( "missing state", MainMenu,        newEditGoalieState )
+  , ( "with state",    EditGoalie egs1, egs1               )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,        egs1               )
+  , ( "change state", EditGoalie egs1, egs2               )
+  , ( "clear state",  EditGoalie egs1, newEditGoalieState )
+  ]
+  where
+    egs1 = newEditGoalieState
+      & egsSelectedGoalie ?~ 1
+    egs2 = newEditGoalieState
+      & egsSelectedGoalie ?~ 2
+
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
   let
@@ -581,22 +608,22 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
 
 modifyPlayerSpec :: Spec
 modifyPlayerSpec = describe "modifyPlayer" $ mapM_
-  (\(pName, j, b, s) -> let
+  (\(name, j, b, s) -> let
     modifier = pLifetime.psGoals .~ 1
-    players = modifyPlayer modifier pName [joe, bob, steve]
+    players = modifyPlayer modifier name [joe, bob, steve]
-    in context ("modify " ++ pName) $ do
+    in context ("modify " ++ name) $ do
 
       context "Joe's lifetime goals" $
         it ("should be " ++ show j) $
-          head players ^. pLifetime.psGoals `shouldBe` j
+          head players^.pLifetime.psGoals `shouldBe` j
 
       context "Bob's lifetime goals" $
         it ("should be " ++ show b) $
-          (players !! 1) ^. pLifetime.psGoals `shouldBe` b
+          (players !! 1)^.pLifetime.psGoals `shouldBe` b
 
       context "Steve's lifetime goals" $
         it ("should be " ++ show s) $
-          last players ^. pLifetime.psGoals `shouldBe` s)
+          last players^.pLifetime.psGoals `shouldBe` s)
   --  player name, Joe's goals, Bob's goals, Steve's goals
   [ ( "Joe",       1,           0,           0             )
   , ( "Bob",       0,           1,           0             )
@@ -613,7 +640,7 @@ playerDetailsSpec :: Spec
 playerDetailsSpec = describe "playerDetails" $
   it "should give a detailed description" $ let
 
-    player = newPlayer 1 "Joe" "centre"
+    p = newPlayer 1 "Joe" "centre"
       & pYtd .~ PlayerStats
         { _psGoals   = 2
         , _psAssists = 3
@@ -637,26 +664,26 @@ playerDetailsSpec = describe "playerDetails" $
       , "Lifetime penalty mins: 7"
       ]
 
-    in playerDetails player `shouldBe` expected
+    in playerDetails p `shouldBe` expected
 
 playerIsActiveSpec :: Spec
 playerIsActiveSpec = describe "playerIsActive" $ do
   let
-    pState = newPlayerStats
+    pStats = newPlayerStats
       & psGoals   .~ 10
       & psAssists .~ 11
       & psPMin    .~ 12
-    player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
+    p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
 
   mapM_
-    (\(label, player', expected) -> context label $
+    (\(label, p', expected) -> context label $
       it ("should be " ++ show expected) $
-        playerIsActive player' `shouldBe` expected)
+        playerIsActive p' `shouldBe` expected)
     --  label,                player,                  expected
-    [ ( "not active",         player,                       False    )
+    [ ( "not active",         p,                       False    )
-    , ( "has goal",           player & pYtd.psGoals   .~ 1, True     )
+    , ( "has goal",           p & pYtd.psGoals   .~ 1, True     )
-    , ( "has assist",         player & pYtd.psAssists .~ 1, True     )
+    , ( "has assist",         p & pYtd.psAssists .~ 1, True     )
-    , ( "has penalty minute", player & pYtd.psPMin    .~ 1, True     )
+    , ( "has penalty minute", p & pYtd.psPMin    .~ 1, True     )
     ]
 
 psPointsSpec :: Spec
@@ -764,6 +791,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 $
@@ -809,6 +877,17 @@ instance Comparable EditPlayerState where
       it ("should be " ++ show (expected^.epsMode)) $
         actual^.epsMode `shouldBe` expected^.epsMode
 
+instance Comparable EditGoalieState where
+  compareTest actual expected = do
+
+    describe "egsSelectedGoalie" $
+      it ("should be " ++ show (expected^.egsSelectedGoalie)) $
+        actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
+
+    describe "egsMode" $
+      it ("should be " ++ show (expected^.egsMode)) $
+        actual^.egsMode `shouldBe` expected^.egsMode
+
 instance Comparable CreateGoalieState where
   compareTest actual expected = do
 

test/UtilSpec.hs

@@ -49,18 +49,19 @@ nthSpec = describe "nth" $ mapM_
 
 modifyNthSpec  :: Spec
 modifyNthSpec = describe "modifyNth" $ do
+  let list = [1, 2, 3] :: [Int]
 
   context "in bounds" $
     it "should modify the value" $
-      modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
+      modifyNth 1 succ list `shouldBe` [1, 3, 3]
 
   context "out of bounds" $
     it "should not modify the value" $
-      modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
+      modifyNth 3 succ list `shouldBe` [1, 2, 3]
 
   context "negative index" $
     it "should not modify the value" $
-      modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
+      modifyNth (-1) succ list `shouldBe` [1, 2, 3]
 
 updateMapSpec :: Spec
 updateMapSpec = describe "updateMap" $ do
@@ -68,7 +69,7 @@ updateMapSpec = describe "updateMap" $ do
     input = M.fromList [(1, 2), (3, 5)]
 
   context "key found" $ let
-    expected = M.fromList [(1, 3), (3, 5)]
+    expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
     in it "should update the value" $
       updateMap 1 10 succ input `shouldBe` expected
 
@@ -79,7 +80,7 @@ updateMapSpec = describe "updateMap" $ do
 
 sliceSpec :: Spec
 sliceSpec = describe "slice" $ do
-  let list = [2, 4, 6, 8]
+  let list = [2, 4, 6, 8] :: [Int]
 
   context "sublist" $
     it "should return the sublist" $