version 0.5.0

Assign wins/losses/ties to goalies

ChangeLog.md

@@ -1,3 +1,26 @@
 # Changelog for mtlstats
 
-## Unreleased changes
+## 0.5.0
+
+- Fixed player creation bug
+- Prompt for goalie informaiton on game data entry
+- Implemented player editing
+
+## v0.4.0
+
+- Record penalty minutes
+- Calculate total game statistics
+- Generate year-to-date statistics report
+
+## v0.3.0
+
+- Record goals and assists
+- Track goals for and goals against
+
+## v0.2.0
+
+- Overtime losses don't count in the loss column
+- Confirm game data with user before updating stats
+- Implemented player creation
+- Goal points are now assigned to players
+- Loading/saving of database

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.1.0
+version:             0.5.0
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"
@@ -22,6 +22,8 @@ description:         Please see the README on GitHub at <https://github.com/jlam
 dependencies:
 - base >= 4.7 && < 5
 - aeson >= 1.4.4.0 && < 1.5
+- containers >= 0.6.0.1 && < 0.7
+- easy-file >= 0.2.2 && < 0.3
 - extra >= 1.6.17 && < 1.7
 - microlens-th >= 0.4.2.3 && < 0.5
 - ncurses >= 0.2.16 && < 0.3

src/Mtlstats.hs

@@ -19,15 +19,23 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Mtlstats (initState, mainLoop) where
 
+import Control.Exception (IOException, catch)
 import Control.Monad (void)
 import Control.Monad.Extra (whenM)
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.State (get, gets)
-import Data.Maybe (fromJust)
+import Data.Aeson (decodeFileStrict)
+import Data.Maybe (fromJust, fromMaybe)
+import Lens.Micro ((&), (.~))
+import System.EasyFile (getAppUserDataDirectory, (</>))
 import qualified UI.NCurses as C
 
+import Mtlstats.Config
 import Mtlstats.Control
 import Mtlstats.Types
 
@@ -36,7 +44,15 @@ initState :: C.Curses ProgState
 initState = do
   C.setEcho False
   void $ C.setCursorMode C.CursorInvisible
-  return newProgState
+  db <- liftIO $ do
+    dir <- getAppUserDataDirectory appName
+    let dbFile = dir </> dbFname
+    fromMaybe newDatabase <$> catch
+      (decodeFileStrict dbFile)
+      (\(_ :: IOException) -> return Nothing)
+  return
+    $ newProgState
+    & database .~ db
 
 -- | Main program loop
 mainLoop :: Action ()

src/Mtlstats/Actions.hs

@@ -30,13 +30,31 @@ module Mtlstats.Actions
   , overtimeCheck
   , updateGameStats
   , validateGameDate
+  , createPlayer
+  , createGoalie
+  , editPlayer
+  , 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 (over, (^.), (&), (.~), (?~), (%~), (+~))
 
 import Mtlstats.Types
+import Mtlstats.Util
 
 -- | Starts a new season
 startNewSeason :: ProgState -> ProgState
@@ -78,26 +96,37 @@ overtimeCheck s
 -- | Adjusts the game stats based on the results of the current game
 updateGameStats :: ProgState -> ProgState
 updateGameStats s = fromMaybe s $ do
-  gType <- s^.progMode.gameStateL.gameType
+  let gs = s^.progMode.gameStateL
-  won   <- gameWon $ s^.progMode.gameStateL
+  gType  <- gs^.gameType
-  lost  <- gameLost $ s^.progMode.gameStateL
+  won    <- gameWon gs
-  ot    <- s^.progMode.gameStateL.overtimeFlag
+  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)
+      %~ (gmsWins         +~ hw)
-      .  (gmsLosses +~ hl)
+      .  (gmsLosses       +~ hl)
-      .  (gmsOvertime +~ hot)
+      .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
     & database.dbAwayGameStats
-      %~ (gmsWins +~ aw)
+      %~ (gmsWins         +~ aw)
-      .  (gmsLosses +~ al)
+      .  (gmsLosses       +~ al)
-      .  (gmsOvertime +~ aot)
+      .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
 
 -- | Validates the game date
 validateGameDate :: ProgState -> ProgState
@@ -111,3 +140,151 @@ validateGameDate s = fromMaybe s $ do
       .  (gameMonth .~ Nothing)
       .  (gameDay   .~ Nothing)
     else s
+
+-- | Starts player creation mode
+createPlayer :: ProgState -> ProgState
+createPlayer = let
+  callback = modify $ progMode .~ MainMenu
+  cps = newCreatePlayerState
+    & cpsSuccessCallback .~ callback
+    & cpsFailureCallback .~ callback
+  in progMode .~ CreatePlayer cps
+
+-- | Starts goalie creation mode
+createGoalie :: ProgState -> ProgState
+createGoalie = let
+  callback = modify $ progMode .~ MainMenu
+  cgs = newCreateGoalieState
+    & cgsSuccessCallback .~ callback
+    & cgsFailureCallback .~ callback
+  in progMode .~ CreateGoalie cgs
+
+-- | Starts the player editing process
+editPlayer :: ProgState -> ProgState
+editPlayer = progMode .~ EditPlayer newEditPlayerState
+
+-- | Adds the entered player to the roster
+addPlayer :: ProgState -> ProgState
+addPlayer s = fromMaybe s $ do
+  let cps = s^.progMode.createPlayerStateL
+  num <- cps^.cpsNumber
+  let
+    name   = cps^.cpsName
+    pos    = cps^.cpsPosition
+    player = newPlayer num name pos
+  Just $ s & database.dbPlayers
+    %~ (++[player])
+
+-- | Adds the entered goalie to the roster
+addGoalie :: ProgState -> ProgState
+addGoalie s = fromMaybe s $ do
+  let cgs = s^.progMode.createGoalieStateL
+  num <- cgs^.cgsNumber
+  let
+    name   = cgs^.cgsName
+    goalie = newGoalie num name
+  Just $ s & database.dbGoalies
+    %~ (++[goalie])
+
+-- | Resets the 'CreatePlayerState' value
+resetCreatePlayerState :: ProgState -> ProgState
+resetCreatePlayerState = progMode.createPlayerStateL
+  %~ (cpsNumber   .~ Nothing)
+  .  (cpsName     .~ "")
+  .  (cpsPosition .~ "")
+
+-- | Resets the 'CreateGoalieState' value
+resetCreateGoalieState :: ProgState -> ProgState
+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
+  = (progMode     .~ MainMenu)
+  . (inputBuffer  .~ "")
+  . (scrollOffset .~ 0)
+
+-- | Scrolls the display up
+scrollUp :: ProgState -> ProgState
+scrollUp = scrollOffset %~ max 0 . pred
+
+-- | Scrolls the display down
+scrollDown :: ProgState -> ProgState
+scrollDown = scrollOffset %~ succ

src/Mtlstats/Actions/GoalieInput.hs

@@ -0,0 +1,108 @@
+{- |
+
+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.GoalieInput
+  ( finishGoalieEntry
+  , recordGoalieStats
+  , setGameGoalie
+  ) where
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.), (&), (.~), (%~), (+~))
+
+import Mtlstats.Config
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Attempts to finish game goalie entry
+finishGoalieEntry :: ProgState -> ProgState
+finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
+  .~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
+
+-- | Records the goalie's game stats
+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
+
+  let
+    gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
+    bumpVal   = if gameStats^.gsGames == 0
+      then 1
+      else 0
+
+    bumpStats gs = gs
+      & gsGames        +~ bumpVal
+      & gsMinsPlayed   +~ mins
+      & gsGoalsAllowed +~ goals
+
+    tryFinish = if mins >= gameLength
+      then finishGoalieEntry
+      else id
+
+  Just $ s
+    & progMode.gameStateL
+      %~ (gameGoalieStats    %~ updateMap gid newGoalieStats bumpStats)
+      .  (gameSelectedGoalie   .~ Nothing)
+      .  (gameGoalieMinsPlayed .~ Nothing)
+      .  (gameGoalsAllowed     .~ Nothing)
+    & database.dbGoalies
+      %~ modifyNth gid (\goalie -> goalie
+         & gYtd      %~ bumpStats
+         & gLifetime %~ bumpStats)
+    & tryFinish
+
+-- | Records the win, loss, or tie to a specific 'Goalie'
+setGameGoalie
+  :: Int
+  -- ^ The goalie's index
+  -> ProgState
+  -> ProgState
+setGameGoalie gid s = fromMaybe s $ do
+  let gs = s^.progMode.gameStateL
+  won  <- gameWon gs
+  lost <- gameLost gs
+  tied <- gs^.overtimeFlag
+  let
+    w = if won then 1 else 0
+    l = if lost then 1 else 0
+    t = if tied then 1 else 0
+
+    updateStats gs = gs
+      & gsWins   +~ w
+      & gsLosses +~ l
+      & gsTies   +~ t
+
+    updateGoalie g = g
+      & gYtd      %~ updateStats
+      & gLifetime %~ updateStats
+
+    updateGameState gs = gs
+      & gameGoalieStats %~ updateMap gid newGoalieStats updateStats
+      & gameGoalieAssigned .~ True
+
+  Just $ s
+    & database.dbGoalies  %~ modifyNth gid updateGoalie
+    & progMode.gameStateL %~ updateGameState

src/Mtlstats/Config.hs

@@ -24,3 +24,23 @@ module Mtlstats.Config where
 -- | The name of the team whose stats we're tracking
 myTeam :: String
 myTeam = "MONTREAL"
+
+-- | The maximum number of function keys
+maxFunKeys :: Int
+maxFunKeys = 9
+
+-- | The application name
+appName :: String
+appName = "mtlstats"
+
+-- | The database filename
+dbFname :: String
+dbFname = "database.json"
+
+-- | The maximum number of assists
+maxAssists :: Int
+maxAssists = 2
+
+-- | The length of a typical game (in minutes)
+gameLength :: Int
+gameLength = 60

src/Mtlstats/Control.hs

@@ -21,138 +21,375 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (when)
+import Control.Monad (join, when)
-import Control.Monad.Trans.State (modify)
+import Control.Monad.Extra (ifM)
+import Control.Monad.Trans.State (gets, modify)
 import Data.Char (toUpper)
-import Lens.Micro ((^.), (.~))
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Lens.Micro ((^.), (.~), (%~))
+import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Control.EditPlayer
+import Mtlstats.Control.GoalieInput
 import Mtlstats.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
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-
+  MainMenu  -> mainMenuC
-  MainMenu -> Controller
+  NewSeason -> newSeasonC
-    { drawController   = const $ drawMenu mainMenu
-    , handleController = menuHandler mainMenu
-    }
-
-  NewSeason -> Controller
-    { drawController   = const $ drawMenu newSeasonMenu
-    , handleController = \e -> do
-      menuHandler newSeasonMenu e
-      return True
-    }
-
   NewGame gs
+    | 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
+    | null $ cps^.cpsPosition -> getPlayerPosC
+    | otherwise               -> confirmCreatePlayerC
+  CreateGoalie cgs
+    | null $ cgs^.cgsNumber -> getGoalieNumC
+    | null $ cgs^.cgsName   -> getGoalieNameC
+    | otherwise             -> confirmCreateGoalieC
+  EditPlayer eps -> editPlayerC eps
 
-    | null $ gs^.gameYear -> Controller
+mainMenuC :: Controller
-      { drawController = \s -> do
+mainMenuC = Controller
-        header s
+  { drawController   = const $ drawMenu mainMenu
-        drawPrompt gameYearPrompt s
+  , handleController = menuHandler mainMenu
-      , handleController = \e -> do
+  }
-        promptHandler gameYearPrompt e
-        return True
-      }
 
-    | null $ gs^.gameMonth -> Controller
+newSeasonC :: Controller
-      { drawController = \s -> do
+newSeasonC = Controller
-        header s
+  { drawController   = const $ drawMenu newSeasonMenu
-        drawMenu gameMonthMenu
+  , handleController = \e -> do
-      , handleController = \e -> do
+    menuHandler newSeasonMenu e
-        menuHandler gameMonthMenu e
+    return True
-        return True
+  }
-      }
 
-    | null $ gs^.gameDay -> Controller
+gameYearC :: Controller
-      { drawController = \s -> do
+gameYearC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt gameDayPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameYearPrompt s
-        promptHandler gameDayPrompt e
+  , handleController = \e -> do
-        modify validateGameDate
+    promptHandler gameYearPrompt e
-        return True
+    return True
-      }
+  }
 
-    | null $ gs^.gameType -> Controller
+gameMonthC :: Controller
-      { drawController = \s -> do
+gameMonthC = Controller
-        header s
+  { drawController = \s -> do
-        drawMenu gameTypeMenu
+    header s
-      , handleController = \e -> do
+    drawMenu gameMonthMenu
-        menuHandler gameTypeMenu e
+  , handleController = \e -> do
-        return True
+    menuHandler gameMonthMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.otherTeam -> Controller
+gameDayC :: Controller
-      { drawController = \s -> do
+gameDayC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt otherTeamPrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt gameDayPrompt s
-        promptHandler otherTeamPrompt e
+  , handleController = \e -> do
-        return True
+    promptHandler gameDayPrompt e
-      }
+    modify validateGameDate
+    return True
+  }
 
-    | null $ gs^.homeScore -> Controller
+gameTypeC :: Controller
-      { drawController = \s -> do
+gameTypeC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt homeScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawMenu gameTypeMenu
-        promptHandler homeScorePrompt e
+  , handleController = \e -> do
-        return True
+    menuHandler gameTypeMenu e
-      }
+    return True
+  }
 
-    | null $ gs^.awayScore -> Controller
+otherTeamC :: Controller
-      { drawController = \s -> do
+otherTeamC = Controller
-        header s
+  { drawController = \s -> do
-        drawPrompt awayScorePrompt s
+    header s
-      , handleController = \e -> do
+    drawPrompt otherTeamPrompt s
-        promptHandler awayScorePrompt e
+  , handleController = \e -> do
-        modify overtimeCheck
+    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
-        return True
+      Just False -> modify $ progMode.gameStateL .~ newGameState
-      }
+      Nothing    -> return ()
+    return True
+  }
 
-    | null $ gs^.overtimeFlag -> Controller
+goalInput :: GameState -> Controller
-      { drawController = \s -> do
+goalInput gs
-        header s
+  | null (gs^.goalBy            ) = recordGoalC
-        C.drawString "Did the game go into overtime?  (Y/N)"
+  | not (gs^.confirmGoalDataFlag) = recordAssistC
-        return C.CursorInvisible
+  | otherwise                     = confirmGoalDataC
-      , handleController = \e -> do
-        overtimePrompt e
-        modify updateGameStats
-        return True
-      }
 
-    | otherwise -> Controller
+recordGoalC :: Controller
-      { drawController = \s -> do
+recordGoalC = Controller
-        (_, cols) <- C.windowSize
+  { drawController = \s -> let
-        C.drawString $ report (fromInteger $ pred cols) s
+    (game, goal) = gameGoal s
-        return C.CursorInvisible
+    in drawPrompt (recordGoalPrompt game goal) s
-      , handleController = \e -> do
+  , handleController = \e -> do
-        when
+    (game, goal) <- gets gameGoal
-          (case e of
+    promptHandler (recordGoalPrompt game goal) e
-            C.EventCharacter _  -> True
+    return True
-            C.EventSpecialKey _ -> True
+  }
-            _                   -> False) $
+
-          modify $ progMode .~ MainMenu
+recordAssistC :: Controller
-        return True
+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"
 
-overtimePrompt :: C.Event -> Action ()
+getPlayerNumC :: Controller
-overtimePrompt (C.EventCharacter c) = modify $
+getPlayerNumC = Controller
-  progMode.gameStateL.overtimeFlag .~ case toUpper c of
+  { drawController   = drawPrompt playerNumPrompt
-    'Y' -> Just True
+  , handleController = \e -> do
-    'N' -> Just False
+    promptHandler playerNumPrompt e
-    _   -> Nothing
+    return True
-overtimePrompt _ = return ()
+  }
+
+getPlayerNameC :: Controller
+getPlayerNameC = Controller
+  { drawController   = drawPrompt playerNamePrompt
+  , handleController = \e -> do
+    promptHandler playerNamePrompt e
+    return True
+  }
+
+getPlayerPosC :: Controller
+getPlayerPosC = Controller
+  { drawController   = drawPrompt playerPosPrompt
+  , handleController = \e -> do
+    promptHandler playerPosPrompt e
+    return True
+  }
+
+confirmCreatePlayerC :: Controller
+confirmCreatePlayerC = Controller
+  { drawController = \s -> do
+    let cps = s^.progMode.createPlayerStateL
+    C.drawString $ "  Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
+    C.drawString $ "    Player name: " ++ cps^.cpsName ++ "\n"
+    C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
+    C.drawString "Create player: are you sure?  (Y/N)"
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True -> do
+        modify addPlayer
+        join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
+      Just False ->
+        join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
+      Nothing -> return ()
+    return True
+  }
+
+getGoalieNumC :: Controller
+getGoalieNumC = Controller
+  { drawController = drawPrompt goalieNumPrompt
+  , handleController = \e -> do
+    promptHandler goalieNumPrompt e
+    return True
+  }
+
+getGoalieNameC :: Controller
+getGoalieNameC = Controller
+  { drawController = drawPrompt goalieNamePrompt
+  , handleController = \e -> do
+    promptHandler goalieNamePrompt e
+    return True
+  }
+
+confirmCreateGoalieC :: Controller
+confirmCreateGoalieC = Controller
+  { drawController = \s -> do
+    let cgs = s^.progMode.createGoalieStateL
+    C.drawString $ unlines
+      [ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
+      , "  Goalie name: " ++ cgs^.cgsName
+      , ""
+      , "Create goalie: are you sure?  (Y/N)"
+      ]
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True -> do
+        modify addGoalie
+        join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
+      Just False ->
+        join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
+      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/EditPlayer.hs

@@ -0,0 +1,143 @@
+{- |
+
+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.EditPlayer (editPlayerC) where
+
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import qualified UI.NCurses as C
+
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Prompt.EditPlayer
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Dispatcher/controller for the player edit mode
+editPlayerC :: EditPlayerState -> Controller
+editPlayerC eps
+  | null $ eps^.epsSelectedPlayer = selectPlayerC
+  | otherwise = case eps^.epsMode of
+    EPMenu       -> menuC
+    EPNumber     -> numberC
+    EPName       -> nameC
+    EPPosition   -> positionC
+    EPYtdGoals   -> ytdGoalsC
+    EPYtdAssists -> ytdAssistsC
+    EPYtdPMin    -> ytdPMinC
+    EPLtGoals    -> ltGoalsC
+    EPLtAssists  -> ltAssistsC
+    EPLtPMin     -> ltPMinC
+
+selectPlayerC :: Controller
+selectPlayerC = Controller
+  { drawController   = drawPrompt playerToEditPrompt
+  , handleController = \e -> do
+    promptHandler playerToEditPrompt e
+    return True
+  }
+
+menuC :: Controller
+menuC = Controller
+  { drawController = \s -> do
+    let
+      header = fromMaybe "" $ do
+        pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
+        p   <- nth pid $ s^.database.dbPlayers
+        Just $ playerDetails p ++ "\n"
+    C.drawString header
+    drawMenu editPlayerMenu
+  , handleController = \e -> do
+    menuHandler editPlayerMenu e
+    return True
+  }
+
+numberC :: Controller
+numberC = Controller
+  { drawController = drawPrompt editPlayerNumPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerNumPrompt e
+    return True
+  }
+
+nameC :: Controller
+nameC = Controller
+  { drawController   = drawPrompt editPlayerNamePrompt
+  , handleController = \e -> do
+    promptHandler editPlayerNamePrompt e
+    return True
+  }
+
+positionC :: Controller
+positionC = Controller
+  { drawController   = drawPrompt editPlayerPosPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerPosPrompt e
+    return True
+  }
+
+ytdGoalsC :: Controller
+ytdGoalsC = Controller
+  { drawController   = drawPrompt editPlayerYtdGoalsPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerYtdGoalsPrompt e
+    return True
+  }
+
+ytdAssistsC :: Controller
+ytdAssistsC = Controller
+  { drawController   = drawPrompt editPlayerYtdAssistsPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerYtdAssistsPrompt e
+    return True
+  }
+
+ytdPMinC :: Controller
+ytdPMinC = Controller
+  { drawController   = drawPrompt editPlayerYtdPMinPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerYtdPMinPrompt e
+    return True
+  }
+
+ltGoalsC :: Controller
+ltGoalsC = Controller
+  { drawController   = drawPrompt editPlayerLtGoalsPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerLtGoalsPrompt e
+    return True
+  }
+
+ltAssistsC :: Controller
+ltAssistsC = Controller
+  { drawController   = drawPrompt editPlayerLtAssistsPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerLtAssistsPrompt e
+    return True
+  }
+
+ltPMinC :: Controller
+ltPMinC = Controller
+  { drawController   = drawPrompt editPlayerLtPMinPrompt
+  , handleController = \e -> do
+    promptHandler editPlayerLtPMinPrompt e
+    return True
+  }

src/Mtlstats/Control/GoalieInput.hs

@@ -0,0 +1,66 @@
+{- |
+
+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.GoalieInput (goalieInput) where
+
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import qualified UI.NCurses as C
+
+import Mtlstats.Format
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Prompt.GoalieInput
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | The dispatcher for handling goalie input
+goalieInput :: ProgState -> Controller
+goalieInput s = let
+  gs = s^.progMode.gameStateL
+  in if gs^.gameGoaliesRecorded
+    then selectGameGoalieC s
+  else if null $ gs^.gameSelectedGoalie
+    then selectGoalieC
+  else if null $ gs^.gameGoalieMinsPlayed
+    then minsPlayedC
+  else goalsAllowedC
+
+selectGoalieC :: Controller
+selectGoalieC = promptController selectGameGoaliePrompt
+
+minsPlayedC :: Controller
+minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
+
+goalsAllowedC :: Controller
+goalsAllowedC = promptControllerWith header goalsAllowedPrompt
+
+selectGameGoalieC :: ProgState -> Controller
+selectGameGoalieC = menuController . gameGoalieMenu
+
+header :: ProgState -> C.Update ()
+header s = C.drawString $ unlines
+  [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
+  , fromMaybe "" $ do
+    n <- s^.progMode.gameStateL.gameSelectedGoalie
+    g <- nth n $ s^.database.dbGoalies
+    Just $ goalieSummary g
+  ]

src/Mtlstats/Handlers.hs

@@ -0,0 +1,33 @@
+{- |
+
+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.Handlers (ynHandler) where
+
+import Data.Char (toUpper)
+import qualified UI.NCurses as C
+
+-- | Handler for a yes/no prompt
+ynHandler :: C.Event -> Maybe Bool
+ynHandler (C.EventCharacter c) = case toUpper c of
+  'Y' -> Just True
+  'N' -> Just False
+  _   -> Nothing
+ynHandler _ = Nothing

src/Mtlstats/Menu.hs

@@ -21,23 +21,48 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Menu (
   -- * Menu Functions
+  menuController,
   drawMenu,
   menuHandler,
   -- * Menus
   mainMenu,
   newSeasonMenu,
   gameMonthMenu,
-  gameTypeMenu
+  gameTypeMenu,
+  editPlayerMenu,
+  gameGoalieMenu
 ) where
 
-import Control.Monad.Trans.State (modify)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.State (gets, modify)
+import Data.Aeson (encodeFile)
 import Data.Char (toUpper)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
 import Lens.Micro ((^.), (.~), (?~))
+import Lens.Micro.Extras (view)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , getAppUserDataDirectory
+  , (</>)
+  )
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import qualified Mtlstats.Actions.GoalieInput as GI
+import Mtlstats.Config
 import Mtlstats.Types
 import Mtlstats.Types.Menu
+import Mtlstats.Util
+
+-- | Generates a simple 'Controller' for a Menu
+menuController :: Menu () -> Controller
+menuController menu = Controller
+  { drawController   = const $ drawMenu menu
+  , handleController = \e -> do
+    menuHandler menu e
+    return True
+  }
 
 -- | The draw function for a 'Menu'
 drawMenu :: Menu a -> C.Update C.CursorMode
@@ -60,7 +85,19 @@ mainMenu = Menu "*** MAIN MENU ***" True
     modify startNewSeason >> return True
   , MenuItem '2' "New Game" $
     modify startNewGame >> return True
-  , MenuItem '3' "Exit" $
+  , MenuItem '3' "Create Player" $
+    modify createPlayer >> return True
+  , MenuItem '4' "Create Goalie" $
+    modify createGoalie >> return True
+  , MenuItem '5' "Edit Player" $
+    modify editPlayer >> return True
+  , MenuItem '6' "Exit" $ do
+    db <- gets $ view database
+    liftIO $ do
+      dir <- getAppUserDataDirectory appName
+      let dbFile = dir </> dbFname
+      createDirectoryIfMissing True dir
+      encodeFile dbFile db
     return False
   ]
 
@@ -102,3 +139,36 @@ gameTypeMenu = Menu "Game type:" ()
   , MenuItem '2' "Away Game" $
     modify $ progMode.gameStateL.gameType ?~ AwayGame
   ]
+
+-- | The player edit menu
+editPlayerMenu :: Menu ()
+editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
+  (\(ch, label, mode) -> MenuItem ch label $ case mode of
+    Nothing -> modify $ progMode .~ MainMenu
+    Just m  -> modify $ progMode.editPlayerStateL.epsMode .~ m)
+  [ ( '1', "Change number",         Just EPNumber     )
+  , ( '2', "Change name",           Just EPName       )
+  , ( '3', "Change position",       Just EPPosition   )
+  , ( '4', "YTD goals",             Just EPYtdGoals   )
+  , ( '5', "YTD assists",           Just EPYtdAssists )
+  , ( '6', "YTD penalty mins",      Just EPYtdPMin    )
+  , ( '7', "Lifetime goals",        Just EPLtGoals    )
+  , ( '8', "Lifetime assists",      Just EPLtAssists  )
+  , ( '9', "Lifetime penalty mins", Just EPLtPMin     )
+  , ( '0', "Finished editing",      Nothing           )
+  ]
+
+-- | Game goalie selection menu
+gameGoalieMenu :: ProgState -> Menu ()
+gameGoalieMenu s = let
+  title   = "Which goalie should get credit for the game?"
+  gids    = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats
+  goalies = mapMaybe
+    (\n -> do
+      goalie <- nth n $ s^.database.dbGoalies
+      Just (n, goalie))
+    gids
+  in Menu title () $ map
+    (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
+      modify $ GI.setGameGoalie gid) $
+    zip ['1'..] goalies

src/Mtlstats/Prompt.hs

@@ -19,31 +19,53 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Mtlstats.Prompt (
   -- * Prompt Functions
   drawPrompt,
   promptHandler,
+  promptControllerWith,
+  promptController,
   strPrompt,
   numPrompt,
+  selectPrompt,
   -- * Individual prompts
   gameYearPrompt,
   gameDayPrompt,
   otherTeamPrompt,
   homeScorePrompt,
-  awayScorePrompt
+  awayScorePrompt,
+  playerNumPrompt,
+  playerNamePrompt,
+  playerPosPrompt,
+  goalieNumPrompt,
+  goalieNamePrompt,
+  selectPlayerPrompt,
+  selectGoaliePrompt,
+  recordGoalPrompt,
+  recordAssistPrompt,
+  pMinPlayerPrompt,
+  assignPMinsPrompt,
+  playerToEditPrompt
 ) where
 
 import Control.Monad (when)
+import Control.Monad.Extra (whenJust)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
-import Lens.Micro ((^.), (.~), (?~))
+import Data.Maybe (fromMaybe)
+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
 
 -- | Draws the prompt to the screen
 drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
@@ -63,10 +85,35 @@ promptHandler p (C.EventCharacter c) = let
    modify $ addChar c'
 promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
   modify removeChar
-promptHandler p (C.EventSpecialKey (C.KeyFunction k)) =
+promptHandler p (C.EventSpecialKey k) =
-  promptFunctionKey p k
+  promptSpecialKey p k
 promptHandler _ _ = return ()
 
+-- | Builds a controller out of a prompt with a header
+promptControllerWith
+  :: (ProgState -> C.Update ())
+  -- ^ The header
+  -> Prompt
+  -- ^ The prompt to use
+  -> Controller
+  -- ^ The resulting controller
+promptControllerWith header prompt = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt prompt s
+  , handleController = \e -> do
+    promptHandler prompt e
+    return True
+  }
+
+-- | Builds a controller out of a prompt
+promptController
+  :: Prompt
+  -- ^ The prompt to use
+  -> Controller
+  -- ^ The resulting controller
+promptController = promptControllerWith (const $ return ())
+
 -- | Builds a string prompt
 strPrompt
   :: String
@@ -75,10 +122,10 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
+  { promptDrawer     = drawSimplePrompt pStr
-  , promptCharCheck   = const True
+  , promptCharCheck  = const True
-  , promptAction      = act
+  , promptAction     = act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Builds a numeric prompt
@@ -89,10 +136,47 @@ numPrompt
   -- ^ The callback function for the result
   -> Prompt
 numPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
+  { promptDrawer     = drawSimplePrompt pStr
-  , promptCharCheck   = isDigit
+  , promptCharCheck  = isDigit
-  , promptAction      = \inStr -> forM_ (readMaybe inStr) act
+  , promptAction     = \inStr -> forM_ (readMaybe inStr) act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
+  }
+
+-- | Builds a selection prompt
+selectPrompt :: SelectParams a -> Prompt
+selectPrompt params = Prompt
+  { promptDrawer = \s -> do
+    let sStr = s^.inputBuffer
+    C.drawString $ spPrompt params ++ sStr
+    (row, col) <- C.cursorPosition
+    C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
+    let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
+    C.drawString $ unlines $ map
+      (\(n, (_, x)) -> let
+        desc = spElemDesc params x
+        in "F" ++ show n ++ ") " ++ desc)
+      results
+    C.moveCursor row col
+  , promptCharCheck = const True
+  , promptAction = \sStr -> if null sStr
+    then spCallback params Nothing
+    else do
+      db <- gets (^.database)
+      case spSearchExact params sStr db of
+        Nothing -> spNotFound params sStr
+        Just n  -> spCallback params $ Just n
+  , promptSpecialKey = \case
+    C.KeyFunction rawK -> do
+      sStr <- gets (^.inputBuffer)
+      db   <- gets (^.database)
+      let
+        n       = pred $ fromInteger rawK
+        results = spSearch params sStr db
+      when (n < maxFunKeys) $
+        whenJust (nth n results) $ \(n, _) -> do
+          modify $ inputBuffer .~ ""
+          spCallback params $ Just n
+    _ -> return ()
   }
 
 -- | Prompts for the game year
@@ -120,5 +204,136 @@ awayScorePrompt :: Prompt
 awayScorePrompt = numPrompt "Away score: " $
   modify . (progMode.gameStateL.awayScore ?~)
 
+-- | Prompts for a new player's number
+playerNumPrompt :: Prompt
+playerNumPrompt = numPrompt "Player number: " $
+  modify . (progMode.createPlayerStateL.cpsNumber ?~)
+
+-- | Prompts for a new player's name
+playerNamePrompt :: Prompt
+playerNamePrompt = strPrompt "Player name: " $
+  modify . (progMode.createPlayerStateL.cpsName .~)
+
+-- | Prompts for a new player's position
+playerPosPrompt :: Prompt
+playerPosPrompt = strPrompt "Player position: " $
+  modify . (progMode.createPlayerStateL.cpsPosition .~)
+
+-- | Prompts tor the goalie's number
+goalieNumPrompt :: Prompt
+goalieNumPrompt = numPrompt "Goalie number: " $
+  modify . (progMode.createGoalieStateL.cgsNumber ?~)
+
+-- | Prompts for the goalie's name
+goalieNamePrompt :: Prompt
+goalieNamePrompt = strPrompt "Goalie name: " $
+  modify . (progMode.createGoalieStateL.cgsName .~)
+
+-- | Selects a player (creating one if necessary)
+selectPlayerPrompt
+  :: String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the payer as
+  -- input)
+  -> Prompt
+selectPlayerPrompt pStr callback = selectPrompt SelectParams
+  { spPrompt       = pStr
+  , spSearchHeader = "Player select:"
+  , spSearch       = \sStr db -> playerSearch sStr (db^.dbPlayers)
+  , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
+  , spElemDesc     = playerSummary
+  , spCallback     = callback
+  , spNotFound     = \sStr -> do
+    mode <- gets (^.progMode)
+    let
+      cps = newCreatePlayerState
+        & cpsName .~ sStr
+        & cpsSuccessCallback .~ do
+          modify $ progMode .~ mode
+          index <- pred . length <$> gets (^.database.dbPlayers)
+          callback $ Just index
+        & cpsFailureCallback .~ modify (progMode .~ mode)
+    modify $ progMode .~ CreatePlayer cps
+  }
+
+-- | Selects a goalie (creating one if necessary)
+selectGoaliePrompt
+  :: String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the goalie as
+  -- input)
+  -> Prompt
+selectGoaliePrompt pStr callback = selectPrompt SelectParams
+  { spPrompt       = pStr
+  , spSearchHeader = "Goalie select:"
+  , spSearch       = \sStr db -> goalieSearch sStr (db^.dbGoalies)
+  , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
+  , spElemDesc     = goalieSummary
+  , spCallback     = callback
+  , spNotFound     = \sStr -> do
+    mode <- gets (^.progMode)
+    let
+      cgs = newCreateGoalieState
+        & cgsName .~ sStr
+        & cgsSuccessCallback .~ do
+          modify $ progMode .~ mode
+          index <- pred . length <$> gets (^.database.dbGoalies)
+          callback $ Just index
+        & cgsFailureCallback .~ modify (progMode .~ mode)
+    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 .~)
+
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Prompt/EditPlayer.hs

@@ -0,0 +1,92 @@
+{- |
+
+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.EditPlayer
+  ( editPlayerNumPrompt
+  , editPlayerNamePrompt
+  , editPlayerPosPrompt
+  , editPlayerYtdGoalsPrompt
+  , editPlayerYtdAssistsPrompt
+  , editPlayerYtdPMinPrompt
+  , editPlayerLtGoalsPrompt
+  , editPlayerLtAssistsPrompt
+  , editPlayerLtPMinPrompt
+  ) where
+
+import Control.Monad.Extra (whenJustM)
+import Control.Monad.Trans.State (gets, modify)
+import Lens.Micro ((^.), (.~), (%~))
+
+import Mtlstats.Prompt
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Prompt to edit a player's number
+editPlayerNumPrompt :: Prompt
+editPlayerNumPrompt = numPrompt "Player number: " $
+  editPlayer . (pNumber .~)
+
+-- | Prompt to edit a player's name
+editPlayerNamePrompt :: Prompt
+editPlayerNamePrompt = strPrompt "Player name: " $
+  editPlayer . (pName .~)
+
+-- | Prompt to edit a player's position
+editPlayerPosPrompt :: Prompt
+editPlayerPosPrompt = strPrompt "Player position: " $
+  editPlayer . (pPosition .~)
+
+-- | Prompt to edit a player's year-to-date goals
+editPlayerYtdGoalsPrompt :: Prompt
+editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
+  editPlayer . (pYtd.psGoals .~)
+
+-- | Prompt to edit a player's year-to-date assists
+editPlayerYtdAssistsPrompt :: Prompt
+editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
+  editPlayer . (pYtd.psAssists .~)
+
+-- | Prompt to edit a player's year-to-date penalty minutes
+editPlayerYtdPMinPrompt :: Prompt
+editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
+  editPlayer . (pYtd.psPMin .~)
+
+-- | Prompt to edit a player's lifetime goals
+editPlayerLtGoalsPrompt :: Prompt
+editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
+  editPlayer . (pLifetime.psGoals .~)
+
+-- | Prompt to edit a player's lifetime assists
+editPlayerLtAssistsPrompt :: Prompt
+editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
+  editPlayer . (pLifetime.psAssists .~)
+
+-- | Prompt to edit a player's lifetime penalty minutes
+editPlayerLtPMinPrompt :: Prompt
+editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
+  editPlayer . (pLifetime.psPMin .~)
+
+editPlayer :: (Player -> Player) -> Action ()
+editPlayer f =
+  whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
+    modify
+      $ (database.dbPlayers %~ modifyNth pid f)
+      . (progMode.editPlayerStateL.epsMode .~ EPMenu)

src/Mtlstats/Prompt/GoalieInput.hs

@@ -0,0 +1,56 @@
+{- |
+
+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.GoalieInput
+  ( selectGameGoaliePrompt
+  , goalieMinsPlayedPrompt
+  , goalsAllowedPrompt
+  ) where
+
+import Control.Monad (when)
+import Control.Monad.Trans.State (gets, modify)
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.), (.~), (?~))
+
+import Mtlstats.Actions.GoalieInput
+import Mtlstats.Config
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompts for a goalie who played in the game
+selectGameGoaliePrompt :: Prompt
+selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
+  \case
+    Nothing -> modify finishGoalieEntry
+    Just n  -> modify $ progMode.gameStateL.gameSelectedGoalie  ?~ n
+
+-- | Prompts for the number of minutes the goalie has played
+goalieMinsPlayedPrompt :: Prompt
+goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
+  modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~)
+
+-- | Prompts for the number of goals the goalie allowed
+goalsAllowedPrompt :: Prompt
+goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
+  modify (progMode.gameStateL.gameGoalsAllowed ?~ n)
+  modify recordGoalieStats

src/Mtlstats/Report.hs

@@ -19,14 +19,16 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Report (report) where
+module Mtlstats.Report (report, gameDate, playerNameColWidth) where
 
+import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.))
 
 import Mtlstats.Config
 import Mtlstats.Format
 import Mtlstats.Types
+import Mtlstats.Util
 
 -- | Generates the report
 report
@@ -34,12 +36,21 @@ report
   -- ^ The number of columns for the report
   -> ProgState
   -- ^ The program state
-  -> String
+  -> [String]
-report width s = unlines $ fromMaybe [] $ do
+report width s
+  =  standingsReport width s
+  ++ [""]
+  ++ gameStatsReport width s
+  ++ [""]
+  ++ yearToDateStatsReport width s
+
+standingsReport :: Int -> ProgState -> [String]
+standingsReport width s = fromMaybe [] $ do
   let
     db     = s^.database
     gs     = s^.progMode.gameStateL
     gNum   = db^.dbGames
+    date   = gameDate gs
     hTeam  = homeTeam gs
     aTeam  = awayTeam gs
     hStats = db^.dbHomeGameStats
@@ -47,10 +58,6 @@ report width s = unlines $ fromMaybe [] $ do
     tStats = addGameStats hStats aStats
   hScore <- gs^.homeScore
   aScore <- gs^.awayScore
-  month  <- month <$> gs^.gameMonth
-  day    <- padNum 2 <$> gs^.gameDay
-  year   <- show <$> gs^.gameYear
-  let date = month ++ " " ++ day ++ " " ++ year
   Just
     [ overlay
       ("GAME NUMBER " ++ padNum 2 gNum)
@@ -66,6 +73,8 @@ report width s = unlines $ fromMaybe [] $ do
       ++ right 4 "W"
       ++ right 4 "L"
       ++ right 4 "OT"
+      ++ right 4 "GF"
+      ++ right 4 "GA"
       ++ right 4 "P"
     , centre width
       $  left 11 "HOME"
@@ -75,16 +84,81 @@ report width s = unlines $ fromMaybe [] $ do
       ++ showStats aStats
     , centre width
       $  replicate 11 ' '
-      ++ replicate (2 + 4 * 4) '-'
+      ++ replicate (2 + 4 * 6) '-'
     , centre width
       $  left 11 "TOTALS"
       ++ showStats tStats
     ]
 
+gameStatsReport :: Int -> ProgState -> [String]
+gameStatsReport width s = playerReport width "GAME" $
+  fromMaybe [] $ mapM
+    (\(pid, stats) -> do
+      p <- nth pid $ s^.database.dbPlayers
+      Just (p, stats))
+    (M.toList $ s^.progMode.gameStateL.gamePlayerStats)
+
+yearToDateStatsReport :: Int -> ProgState -> [String]
+yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
+  map (\p -> (p, p^.pYtd)) $
+  filter playerIsActive $ s^.database.dbPlayers
+
+gameDate :: GameState -> String
+gameDate gs = fromMaybe "" $ do
+  year  <- show <$> gs^.gameYear
+  month <- month <$> gs^.gameMonth
+  day   <- padNum 2 <$> gs^.gameDay
+  Just $ month ++ " " ++ day ++ " " ++ year
+
+playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
+playerReport width label ps = let
+  nameWidth = playerNameColWidth $ map fst ps
+  tStats    = foldr (addPlayerStats . snd) newPlayerStats ps
+  in
+    [ centre width (label ++ " STATISTICS")
+    , ""
+    , centre width
+      $  "NO. "
+      ++ left nameWidth "PLAYER"
+      ++ right 3 "G"
+      ++ right 6 "A"
+      ++ right 6 "P"
+      ++ right 6 "PM"
+    ] ++ map
+      (\(p, stats) -> centre width
+        $  right 2 (show $ p^.pNumber)
+        ++ "  "
+        ++ left nameWidth (p^.pName)
+        ++ right 3 (show $ stats^.psGoals)
+        ++ right 6 (show $ stats^.psAssists)
+        ++ right 6 (show $ psPoints stats)
+        ++ right 6 (show $ stats^.psPMin))
+      ps ++
+    [ centre width
+      $  replicate (4 + nameWidth) ' '
+      ++ replicate (3 + 3 * 6) '-'
+    , overlay
+      (label ++ " TOTALS")
+      ( centre width
+        $  replicate (4 + nameWidth) ' '
+        ++ right 3 (show $ tStats^.psGoals)
+        ++ right 6 (show $ tStats^.psAssists)
+        ++ right 6 (show $ psPoints tStats)
+        ++ right 6 (show $ tStats^.psPMin)
+      )
+    ]
+
+playerNameColWidth :: [Player] -> Int
+playerNameColWidth = foldr
+  (\player current -> max current $ succ $ length $ player^.pName)
+  10
+
 showStats :: GameStats -> String
 showStats gs
   =  right 2 (show $ gmsGames gs)
   ++ right 4 (show $ gs^.gmsWins)
   ++ right 4 (show $ gs^.gmsLosses)
   ++ right 4 (show $ gs^.gmsOvertime)
+  ++ right 4 (show $ gs^.gmsGoalsFor)
+  ++ right 4 (show $ gs^.gmsGoalsAgainst)
   ++ right 4 (show $ gmsPoints gs)

src/Mtlstats/Types.hs

@@ -26,9 +26,13 @@ module Mtlstats.Types (
   Controller (..),
   Action,
   ProgState (..),
-  GameState (..),
   ProgMode (..),
+  GameState (..),
   GameType (..),
+  CreatePlayerState (..),
+  CreateGoalieState (..),
+  EditPlayerState (..),
+  EditPlayerMode (..),
   Database (..),
   Player (..),
   PlayerStats (..),
@@ -36,13 +40,18 @@ module Mtlstats.Types (
   GoalieStats (..),
   GameStats (..),
   Prompt (..),
+  SelectParams (..),
   -- * Lenses
   -- ** ProgState Lenses
   database,
   progMode,
   inputBuffer,
+  scrollOffset,
   -- ** ProgMode Lenses
   gameStateL,
+  createPlayerStateL,
+  createGoalieStateL,
+  editPlayerStateL,
   -- ** GameState Lenses
   gameYear,
   gameMonth,
@@ -52,6 +61,34 @@ module Mtlstats.Types (
   homeScore,
   awayScore,
   overtimeFlag,
+  dataVerified,
+  pointsAccounted,
+  goalBy,
+  assistsBy,
+  gamePlayerStats,
+  confirmGoalDataFlag,
+  gameSelectedPlayer,
+  gamePMinsRecorded,
+  gameGoalieStats,
+  gameSelectedGoalie,
+  gameGoalieMinsPlayed,
+  gameGoalsAllowed,
+  gameGoaliesRecorded,
+  gameGoalieAssigned,
+  -- ** CreatePlayerState Lenses
+  cpsNumber,
+  cpsName,
+  cpsPosition,
+  cpsSuccessCallback,
+  cpsFailureCallback,
+  -- ** CreateGoalieState Lenses
+  cgsNumber,
+  cgsName,
+  cgsSuccessCallback,
+  cgsFailureCallback,
+  -- ** EditPlayerState Lenses
+  epsSelectedPlayer,
+  epsMode,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -77,7 +114,6 @@ module Mtlstats.Types (
   gsGames,
   gsMinsPlayed,
   gsGoalsAllowed,
-  gsGoalsAgainst,
   gsWins,
   gsLosses,
   gsTies,
@@ -85,9 +121,14 @@ module Mtlstats.Types (
   gmsWins,
   gmsLosses,
   gmsOvertime,
+  gmsGoalsFor,
+  gmsGoalsAgainst,
   -- * Constructors
   newProgState,
   newGameState,
+  newCreatePlayerState,
+  newCreateGoalieState,
+  newEditPlayerState,
   newDatabase,
   newPlayer,
   newPlayerStats,
@@ -103,12 +144,25 @@ module Mtlstats.Types (
   gameWon,
   gameLost,
   gameTied,
+  unaccountedPoints,
   -- ** GameStats Helpers
   gmsGames,
   gmsPoints,
   addGameStats,
   -- ** Player Helpers
-  pPoints
+  playerSearch,
+  playerSearchExact,
+  modifyPlayer,
+  playerSummary,
+  playerDetails,
+  playerIsActive,
+  -- ** PlayerStats Helpers
+  psPoints,
+  addPlayerStats,
+  -- ** Goalie Helpers
+  goalieSearch,
+  goalieSearchExact,
+  goalieSummary
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -124,6 +178,9 @@ import Data.Aeson
   , (.:)
   , (.=)
   )
+import Data.List (isInfixOf)
+import qualified Data.Map as M
+import Data.Maybe (listToMaybe)
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 import qualified UI.NCurses as C
@@ -143,40 +200,85 @@ type Action a = StateT ProgState C.Curses a
 
 -- | Represents the program state
 data ProgState = ProgState
-  { _database    :: Database
+  { _database     :: Database
   -- ^ The data to be saved
-  , _progMode    :: ProgMode
+  , _progMode     :: ProgMode
   -- ^ The program's mode
-  , _inputBuffer :: String
+  , _inputBuffer  :: String
   -- ^ Buffer for user input
-  } deriving (Eq, Show)
+  , _scrollOffset :: Int
-
+  -- ^ The scrolling offset for the display
--- | The game state
+  }
-data GameState = GameState
-  { _gameYear     :: Maybe Int
-  -- ^ The year the game took place
-  , _gameMonth    :: Maybe Int
-  -- ^ The month the game took place
-  , _gameDay      :: Maybe Int
-  -- ^ The day of the month the game took place
-  , _gameType     :: Maybe GameType
-  -- ^ The type of game (home/away)
-  , _otherTeam    :: String
-  -- ^ The name of the other team
-  , _homeScore    :: Maybe Int
-  -- ^ The home team's score
-  , _awayScore    :: Maybe Int
-  -- ^ The away team's score
-  , _overtimeFlag :: Maybe Bool
-  -- ^ Indicates whether or not the game went into overtime
-  } deriving (Eq, Show)
 
 -- | The program mode
 data ProgMode
   = MainMenu
   | NewSeason
   | NewGame GameState
-  deriving (Eq, Show)
+  | CreatePlayer CreatePlayerState
+  | CreateGoalie CreateGoalieState
+  | EditPlayer EditPlayerState
+
+instance Show ProgMode where
+  show MainMenu         = "MainMenu"
+  show NewSeason        = "NewSeason"
+  show (NewGame _)      = "NewGame"
+  show (CreatePlayer _) = "CreatePlayer"
+  show (CreateGoalie _) = "CreateGoalie"
+  show (EditPlayer _)   = "EditPlayer"
+
+-- | The game state
+data GameState = GameState
+  { _gameYear            :: Maybe Int
+  -- ^ The year the game took place
+  , _gameMonth           :: Maybe Int
+  -- ^ The month the game took place
+  , _gameDay             :: Maybe Int
+  -- ^ The day of the month the game took place
+  , _gameType            :: Maybe GameType
+  -- ^ The type of game (home/away)
+  , _otherTeam           :: String
+  -- ^ The name of the other team
+  , _homeScore           :: Maybe Int
+  -- ^ The home team's score
+  , _awayScore           :: Maybe Int
+  -- ^ The away team's score
+  , _overtimeFlag        :: Maybe Bool
+  -- ^ Indicates whether or not the game went into overtime
+  , _dataVerified        :: Bool
+  -- ^ Set to 'True' when the user confirms the entered data
+  , _pointsAccounted     :: Int
+  -- ^ The number of game points accounted for
+  , _goalBy              :: Maybe Int
+  -- ^ The index number of the player who scored the most recently
+  -- entered goal
+  , _assistsBy            :: [Int]
+  -- ^ The index numbers of the players who have assisted the most
+  -- recently entered goal
+  , _gamePlayerStats      :: M.Map Int PlayerStats
+  -- ^ The player stats accumulated over the game
+  , _confirmGoalDataFlag  :: Bool
+  -- ^ Set when the user confirms the goal data
+  , _gameSelectedPlayer   :: Maybe Int
+  -- ^ Index number of the selected 'Player'
+  , _gamePMinsRecorded    :: Bool
+  -- ^ Set when the penalty mintes have been recorded
+  , _gameGoalieStats      :: M.Map Int GoalieStats
+  -- ^ The goalie stats accumulated over the game
+  , _gameSelectedGoalie   :: Maybe Int
+  -- ^ Index number of the selected 'Goalie'
+  , _gameGoalieMinsPlayed :: Maybe Int
+  -- ^ The number of minutes the currently selected goalie played in
+  -- the game
+  , _gameGoalsAllowed     :: Maybe Int
+  -- ^ The number of goals the currently selected goalie allowed in
+  -- the game
+  , _gameGoaliesRecorded  :: Bool
+  -- ^ Set when the user confirms that all goalie info has been entered
+  , _gameGoalieAssigned   :: Bool
+  -- ^ Set to 'True' when the goalie has been selected who will be
+  -- given the win/loss/tie
+  } deriving (Eq, Show)
 
 -- | The type of game
 data GameType
@@ -184,6 +286,54 @@ data GameType
   | AwayGame
   deriving (Eq, Show)
 
+-- | Player creation status
+data CreatePlayerState = CreatePlayerState
+  { _cpsNumber          :: Maybe Int
+  -- ^ The player's number
+  , _cpsName            :: String
+  -- ^ The player's name
+  , _cpsPosition        :: String
+  -- ^ The player's position
+  , _cpsSuccessCallback :: Action ()
+  -- ^ The function to call on success
+  , _cpsFailureCallback :: Action ()
+  -- ^ The function to call on failure
+  }
+
+-- | Goalie creation status
+data CreateGoalieState = CreateGoalieState
+  { _cgsNumber    :: Maybe Int
+  -- ^ The goalie's number
+  , _cgsName      :: String
+  -- ^ The goalie's name
+  , _cgsSuccessCallback :: Action ()
+  -- ^ The function to call on success
+  , _cgsFailureCallback :: Action ()
+  -- ^ The function to call on failure
+  }
+
+-- | Player edit status
+data EditPlayerState = EditPlayerState
+  { _epsSelectedPlayer :: Maybe Int
+  -- ^ The index number of the player being edited
+  , _epsMode           :: EditPlayerMode
+  -- ^ The editing mode
+  }
+
+-- | Player editing mode
+data EditPlayerMode
+  = EPMenu
+  | EPNumber
+  | EPName
+  | EPPosition
+  | EPYtdGoals
+  | EPYtdAssists
+  | EPYtdPMin
+  | EPLtGoals
+  | EPLtAssists
+  | EPLtPMin
+  deriving (Eq, Show)
+
 -- | Represents the database
 data Database = Database
   { _dbPlayers       :: [Player]
@@ -325,8 +475,6 @@ data GoalieStats = GoalieStats
   -- ^ The number of minutes played
   , _gsGoalsAllowed :: Int
   -- ^ The number of goals allowed
-  , _gsGoalsAgainst :: Int
-  -- ^ The number of goals against
   , _gsWins         :: Int
   -- ^ The number of wins
   , _gsLosses       :: Int
@@ -340,38 +488,39 @@ instance FromJSON GoalieStats where
     <$> v .: "games"
     <*> v .: "mins_played"
     <*> v .: "goals_allowed"
-    <*> v .: "goals_against"
     <*> v .: "wins"
     <*> v .: "losses"
     <*> v .: "ties"
 
 instance ToJSON GoalieStats where
-  toJSON (GoalieStats g m al ag w l t) = object
+  toJSON (GoalieStats g m a w l t) = object
     [ "games"         .= g
     , "mins_played"   .= m
-    , "goals_allowed" .= al
+    , "goals_allowed" .= a
-    , "goals_against" .= ag
     , "wins"          .= w
     , "losses"        .= l
     , "ties"          .= t
     ]
-  toEncoding (GoalieStats g m al ag w l t) = pairs $
+  toEncoding (GoalieStats g m a w l t) = pairs $
-      "games"         .= g  <>
+      "games"         .= g <>
-      "mins_played"   .= m  <>
+      "mins_played"   .= m <>
-      "goals_allowed" .= al <>
+      "goals_allowed" .= a <>
-      "goals_against" .= ag <>
+      "wins"          .= w <>
-      "wins"          .= w  <>
+      "losses"        .= l <>
-      "losses"        .= l  <>
       "ties"          .= t
 
 -- | Game statistics
 data GameStats = GameStats
-  { _gmsWins     :: Int
+  { _gmsWins         :: Int
   -- ^ Games won
-  , _gmsLosses   :: Int
+  , _gmsLosses       :: Int
   -- ^ Games lost
-  , _gmsOvertime :: Int
+  , _gmsOvertime     :: Int
   -- ^ Games lost in overtime
+  , _gmsGoalsFor     :: Int
+  -- ^ Goals for the team
+  , _gmsGoalsAgainst :: Int
+  -- ^ Goals against the team
   } deriving (Eq, Show)
 
 instance FromJSON GameStats where
@@ -379,32 +528,59 @@ instance FromJSON GameStats where
     <$> v .: "wins"
     <*> v .: "losses"
     <*> v .: "overtime"
+    <*> v .: "goals_for"
+    <*> v .: "goals_against"
 
 instance ToJSON GameStats where
-  toJSON (GameStats w l ot) = object
+  toJSON (GameStats w l ot gf ga) = object
-    [ "wins"     .= w
+    [ "wins"          .= w
-    , "losses"   .= l
+    , "losses"        .= l
-    , "overtime" .= ot
+    , "overtime"      .= ot
+    , "goals_for"     .= gf
+    , "goals_against" .= ga
     ]
-  toEncoding (GameStats w l ot) = pairs $
+  toEncoding (GameStats w l ot gf ga) = pairs $
-    "wins"     .= w  <>
+    "wins"          .= w  <>
-    "losses"   .= l  <>
+    "losses"        .= l  <>
-    "overtime" .= ot
+    "overtime"      .= ot <>
+    "goals_for"     .= gf <>
+    "goals_against" .= ga
 
 -- | Defines a user prompt
 data Prompt = Prompt
-  { promptDrawer      :: ProgState -> C.Update ()
+  { promptDrawer     :: ProgState -> C.Update ()
-  -- ^ Draws the prompt to thr screen
+  -- ^ Draws the prompt to the screen
-  , promptCharCheck   :: Char -> Bool
+  , promptCharCheck  :: Char -> Bool
   -- ^ Determines whether or not the character is valid
-  , promptAction      :: String -> Action ()
+  , promptAction     :: String -> Action ()
   -- ^ Action to perform when the value is entered
-  , promptFunctionKey :: Integer -> Action ()
+  , promptSpecialKey :: C.Key -> Action ()
-  -- ^ Action to perform when a function key is pressed
+  -- ^ Action to perform when a special key is pressed
+  }
+
+-- | Parameters for a search prompt
+data SelectParams a = SelectParams
+  { spPrompt       :: String
+  -- ^ The search prompt
+  , spSearchHeader :: String
+  -- ^ The header to display at the top of the search list
+  , spSearch       :: String -> Database -> [(Int, a)]
+  -- ^ The search function
+  , spSearchExact  :: String -> Database -> Maybe Int
+  -- ^ Search function looking for an exact match
+  , spElemDesc     :: a -> String
+  -- ^ Provides a string description of an element
+  , spCallback     :: Maybe Int -> Action ()
+  -- ^ The function when the selection is made
+  , spNotFound     :: String -> Action ()
+  -- ^ The function to call when the selection doesn't exist
   }
 
 makeLenses ''ProgState
 makeLenses ''GameState
+makeLenses ''CreatePlayerState
+makeLenses ''CreateGoalieState
+makeLenses ''EditPlayerState
 makeLenses ''Database
 makeLenses ''Player
 makeLenses ''PlayerStats
@@ -419,25 +595,87 @@ gameStateL = lens
     _          -> newGameState)
   (\_ gs -> NewGame gs)
 
+createPlayerStateL :: Lens' ProgMode CreatePlayerState
+createPlayerStateL = lens
+  (\case
+    CreatePlayer cps -> cps
+    _                -> newCreatePlayerState)
+  (\_ cps -> CreatePlayer cps)
+
+createGoalieStateL :: Lens' ProgMode CreateGoalieState
+createGoalieStateL = lens
+  (\case
+    CreateGoalie cgs -> cgs
+    _                -> newCreateGoalieState)
+  (\_ cgs -> CreateGoalie cgs)
+
+editPlayerStateL :: Lens' ProgMode EditPlayerState
+editPlayerStateL = lens
+  (\case
+    EditPlayer eps -> eps
+    _              -> newEditPlayerState)
+  (\_ eps -> EditPlayer eps)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
-  { _database    = newDatabase
+  { _database     = newDatabase
-  , _progMode    = MainMenu
+  , _progMode     = MainMenu
-  , _inputBuffer = ""
+  , _inputBuffer  = ""
+  , _scrollOffset = 0
   }
 
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameYear     = Nothing
+  { _gameYear             = Nothing
-  , _gameMonth    = Nothing
+  , _gameMonth            = Nothing
-  , _gameDay      = Nothing
+  , _gameDay              = Nothing
-  , _gameType     = Nothing
+  , _gameType             = Nothing
-  , _otherTeam    = ""
+  , _otherTeam            = ""
-  , _homeScore    = Nothing
+  , _homeScore            = Nothing
-  , _awayScore    = Nothing
+  , _awayScore            = Nothing
-  , _overtimeFlag = Nothing
+  , _overtimeFlag         = Nothing
+  , _dataVerified         = False
+  , _pointsAccounted      = 0
+  , _goalBy               = Nothing
+  , _assistsBy            = []
+  , _gamePlayerStats      = M.empty
+  , _confirmGoalDataFlag  = False
+  , _gameSelectedPlayer   = Nothing
+  , _gamePMinsRecorded    = False
+  , _gameGoalieStats      = M.empty
+  , _gameSelectedGoalie   = Nothing
+  , _gameGoalieMinsPlayed = Nothing
+  , _gameGoalsAllowed     = Nothing
+  , _gameGoaliesRecorded  = False
+  , _gameGoalieAssigned   = False
+  }
+
+-- | Constructor for a 'CreatePlayerState'
+newCreatePlayerState :: CreatePlayerState
+newCreatePlayerState = CreatePlayerState
+  { _cpsNumber          = Nothing
+  , _cpsName            = ""
+  , _cpsPosition        = ""
+  , _cpsSuccessCallback = return ()
+  , _cpsFailureCallback = return ()
+  }
+
+-- | Constructor for a 'CreateGoalieState'
+newCreateGoalieState :: CreateGoalieState
+newCreateGoalieState = CreateGoalieState
+  { _cgsNumber          = Nothing
+  , _cgsName            = ""
+  , _cgsSuccessCallback = return ()
+  , _cgsFailureCallback = return ()
+  }
+
+-- | Constructor for an 'EditPlayerState'
+newEditPlayerState :: EditPlayerState
+newEditPlayerState = EditPlayerState
+  { _epsSelectedPlayer = Nothing
+  , _epsMode           = EPMenu
   }
 
 -- | Constructor for a 'Database'
@@ -495,7 +733,6 @@ newGoalieStats = GoalieStats
   { _gsGames        = 0
   , _gsMinsPlayed   = 0
   , _gsGoalsAllowed = 0
-  , _gsGoalsAgainst = 0
   , _gsWins         = 0
   , _gsLosses       = 0
   , _gsTies         = 0
@@ -504,9 +741,11 @@ newGoalieStats = GoalieStats
 -- | Constructor for a 'GameStats' value
 newGameStats :: GameStats
 newGameStats = GameStats
-  { _gmsWins     = 0
+  { _gmsWins         = 0
-  , _gmsLosses   = 0
+  , _gmsLosses       = 0
-  , _gmsOvertime = 0
+  , _gmsOvertime     = 0
+  , _gmsGoalsFor     = 0
+  , _gmsGoalsAgainst = 0
   }
 
 -- | Determines the team's score
@@ -545,15 +784,26 @@ gameWon gs = (>) <$> teamScore gs <*> otherScore gs
 
 -- | Checks if the game was lost
 gameLost :: GameState -> Maybe Bool
-gameLost gs = (<) <$> teamScore gs <*> otherScore gs
+gameLost gs = do
+  ot    <- gs^.overtimeFlag
+  team  <- teamScore gs
+  other <- otherScore gs
+  Just $ not ot && other > team
 
 -- | Checks if the game has tied
 gameTied :: GameState -> Maybe Bool
 gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
 
+-- | Checks for unaccounted points
+unaccountedPoints :: GameState -> Maybe Bool
+unaccountedPoints gs = do
+  scored <- teamScore gs
+  let accounted = gs^.pointsAccounted
+  Just $ scored > accounted
+
 -- | Calculates the number of games played
 gmsGames :: GameStats -> Int
-gmsGames gs = gs^.gmsWins + gs^.gmsLosses
+gmsGames gs = gs^.gmsWins + gs^.gmsLosses + gs^.gmsOvertime
 
 -- | Calculates the number of points
 gmsPoints :: GameStats -> Int
@@ -562,11 +812,121 @@ gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
 -- | Adds two 'GameStats' values together
 addGameStats :: GameStats -> GameStats -> GameStats
 addGameStats s1 s2 = GameStats
-  { _gmsWins     = s1^.gmsWins + s2^.gmsWins
+  { _gmsWins         = s1^.gmsWins + s2^.gmsWins
-  , _gmsLosses   = s1^.gmsLosses + s2^.gmsLosses
+  , _gmsLosses       = s1^.gmsLosses + s2^.gmsLosses
-  , _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
+  , _gmsOvertime     = s1^.gmsOvertime + s2^.gmsOvertime
+  , _gmsGoalsFor     = s1^.gmsGoalsFor + s2^.gmsGoalsFor
+  , _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
   }
 
+-- | Searches through a list of players
+playerSearch
+  :: String
+  -- ^ The search string
+  -> [Player]
+  -- ^ The list of players to search
+  -> [(Int, Player)]
+  -- ^ The matching players with their index numbers
+playerSearch sStr =
+  filter (match sStr) .
+  zip [0..]
+  where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
+
+-- | Searches for a player by exact match on name
+playerSearchExact
+  :: String
+  -- ^ The player's name
+  -> [Player]
+  -- ^ The list of players to search
+  -> Maybe (Int, Player)
+  -- ^ The player's index and value
+playerSearchExact sStr =
+  listToMaybe .
+  filter (match sStr) .
+  zip [0..]
+  where match sStr (_, p) = p^.pName == sStr
+
+-- | Modifies a player with a given name
+modifyPlayer
+  :: (Player -> Player)
+  -- ^ The modification function
+  -> String
+  -- ^ The player's name
+  -> [Player]
+  -- ^ The list of players to modify
+  -> [Player]
+  -- ^ The modified list
+modifyPlayer f n = map
+  (\p -> if p^.pName == n
+    then f p
+    else p)
+
+-- | Provides a short summary string for a player
+playerSummary :: Player -> String
+playerSummary p =
+  p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
+
+-- | Provides a detailed string describing a 'Player'
+playerDetails :: Player -> String
+playerDetails p = unlines
+  [ "               Number: " ++ show (p^.pNumber)
+  , "                 Name: " ++ p^.pName
+  , "             Position: " ++ p^.pPosition
+  , "            YTD goals: " ++ show (p^.pYtd.psGoals)
+  , "          YTD assists: " ++ show (p^.pYtd.psAssists)
+  , "     YTD penalty mins: " ++ show (p^.pYtd.psPMin)
+  , "       Lifetime goals: " ++ show (p^.pLifetime.psGoals)
+  , "     Lifetime assists: " ++ show (p^.pLifetime.psAssists)
+  , "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
+  ]
+
+-- | Determines whether or not a player has been active in the current
+-- season/year
+playerIsActive :: Player -> Bool
+playerIsActive = do
+  stats <- (^.pYtd)
+  return
+    $  stats^.psGoals   /= 0
+    || stats^.psAssists /= 0
+    || stats^.psPMin    /= 0
+
 -- | Calculates a player's points
-pPoints :: PlayerStats -> Int
+psPoints :: PlayerStats -> Int
-pPoints s = s^.psGoals + s^.psAssists
+psPoints s = s^.psGoals + s^.psAssists
+
+-- | Adds two 'PlayerStats' together
+addPlayerStats :: PlayerStats -> PlayerStats -> PlayerStats
+addPlayerStats s1 s2 = newPlayerStats
+  & psGoals   .~ s1^.psGoals + s2^.psGoals
+  & psAssists .~ s1^.psAssists + s2^.psAssists
+  & psPMin    .~ s1^.psPMin + s2^.psPMin
+
+-- | Searches a list of goalies
+goalieSearch
+  :: String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> [(Int, Goalie)]
+  -- ^ The search results with their corresponding index numbers
+goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
+  zip [0..]
+
+-- | Searches a list of goalies for an exact match
+goalieSearchExact
+  :: String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> Maybe (Int, Goalie)
+  -- ^ The result with its index number
+goalieSearchExact sStr goalies = let
+  results = filter (\(_, goalie) -> sStr == goalie^.gName) $
+    zip [0..] goalies
+  in case results of
+    []       -> Nothing
+    result:_ -> Just result
+
+-- | Provides a description string for a 'Goalie'
+goalieSummary :: Goalie -> String
+goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"

src/Mtlstats/Util.hs

@@ -0,0 +1,77 @@
+{- |
+
+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.Util (nth, modifyNth, updateMap, slice) where
+
+import qualified Data.Map as M
+
+-- | Attempt to select the element from a list at a given index
+nth
+  :: Int
+  -- ^ The index
+  -> [a]
+  -- ^ The list
+  -> Maybe a
+nth _ [] = Nothing
+nth n (x:xs)
+  | n == 0    = Just x
+  | n < 0     = Nothing
+  | otherwise = nth (pred n) xs
+
+-- | Attempt to modify the index at a given index in a list
+modifyNth
+  :: Int
+  -- ^ The index
+  -> (a -> a)
+  -- ^ The modification function
+  -> [a]
+  -- ^ The list
+  -> [a]
+modifyNth n f = map (\(i, x) -> if i == n then f x else x)
+  . zip [0..]
+
+-- | Modify a value indexed by a given key in a map using a default
+-- initial value if not present
+updateMap
+  :: Ord k
+  => k
+  -- ^ The key
+  -> a
+  -- ^ The default initial value
+  -> (a -> a)
+  -- ^ The modification function
+  -> M.Map k a
+  -- ^ The map
+  -> M.Map k a
+updateMap k def f m = let
+  x = M.findWithDefault def k m
+  in M.insert k (f x) m
+
+-- | Selects a section of a list
+slice
+  :: Int
+  -- ^ The index to start at
+  -> Int
+  -- ^ The number of elements to take
+  -> [a]
+  -- ^ The list to take a subset of
+  -> [a]
+slice offset len = take len . drop offset

test/Actions/GoalieInputSpec.hs

@@ -0,0 +1,291 @@
+{-
+
+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.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.Types
+import Mtlstats.Util
+
+import qualified TypesSpec as TS
+
+spec :: Spec
+spec = describe "Mtlstats.Actions.GoalieInput" $ do
+  finishGoalieEntrySpec
+  recordGoalieStatsSpec
+  setGameGoalieSpec
+
+finishGoalieEntrySpec :: Spec
+finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
+  let
+    progState stats = newProgState
+      & progMode.gameStateL.gameGoalieStats .~ stats
+      & finishGoalieEntry
+
+  context "no goalie data" $
+    it "should not set goaliesRecorded" $ let
+      s = progState M.empty
+      in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
+
+  context "goalie data" $
+    it "should set goaliesRecorded" $ let
+      s = progState $ M.fromList [(1, newGoalieStats)]
+      in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
+
+recordGoalieStatsSpec :: Spec
+recordGoalieStatsSpec = describe "recordGoalieStats" $ let
+  goalieStats games mins goals = newGoalieStats
+    & gsGames        .~ games
+    & gsMinsPlayed   .~ mins
+    & gsGoalsAllowed .~ goals
+
+  joe = newGoalie 2 "Joe"
+    & gYtd      .~ goalieStats 10 11 12
+    & gLifetime .~ goalieStats 20 21 22
+
+  bob = newGoalie 3 "Bob"
+    & gYtd      .~ goalieStats 30 31 32
+    & gLifetime .~ goalieStats 40 41 42
+
+  gameState n mins goals = newGameState
+    & gameGoalieStats      .~ M.fromList [(1, goalieStats 1 2 3)]
+    & gameSelectedGoalie   .~ n
+    & gameGoalieMinsPlayed .~ mins
+    & gameGoalsAllowed     .~ goals
+
+  progState n mins goals = newProgState
+    & database.dbGoalies  .~ [joe, bob]
+    & progMode.gameStateL .~ gameState n mins goals
+
+  in mapM_
+    (\(name, gid, mins, goals, joeData, bobData, reset) -> let
+      s = recordGoalieStats $ progState gid mins goals
+      in context name $ do
+
+        mapM_
+          (\( name
+            , gid
+            , ( gGames
+              , gMins
+              , gGoals
+              , ytdGames
+              , ytdMins
+              , ytdGoals
+              , ltGames
+              , ltMins
+              , ltGoals
+              )
+            ) -> context name $ do
+              let
+                gs     = s^.progMode.gameStateL.gameGoalieStats
+                game   = M.findWithDefault newGoalieStats gid gs
+                goalie = fromJust $ nth gid $ s^.database.dbGoalies
+                ytd    = goalie^.gYtd
+                lt     = goalie^.gLifetime
+
+              context "game" $
+                game `TS.compareTest` goalieStats gGames gMins gGoals
+
+              context "year-to-date" $
+                ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
+
+              context "lifetime" $
+                lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
+
+          [ ( "checking Joe", 0, joeData )
+          , ( "checking Bob", 1, bobData )
+          ]
+
+        context "selected goalie" $ let
+          expected = if reset then Nothing else gid
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
+
+        context "minutes played" $ let
+          expected = if reset then Nothing else mins
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
+
+        context "goals allowed" $ let
+          expected = if reset then Nothing else goals
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
+
+    [ ( "updating Joe"
+      , Just 0
+      , Just 1
+      , Just 2
+      , (1, 1, 2, 11, 12, 14, 21, 22, 24)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , True
+      )
+    , ( "updating Bob"
+      , Just 1
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 3, 5, 30, 32, 34, 40, 42, 44)
+      , True
+      )
+    , ( "goalie out of bounds"
+      , Just 2
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing goalie"
+      , Nothing
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing minutes"
+      , Just 0
+      , Nothing
+      , Just 1
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing goals"
+      , Just 0
+      , Just 1
+      , Nothing
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    ]
+
+setGameGoalieSpec :: Spec
+setGameGoalieSpec = describe "setGameGoalie" $ let
+
+  goalieStats w l t = newGoalieStats
+    & gsWins   .~ w
+    & gsLosses .~ l
+    & gsTies   .~ t
+
+  bob = newGoalie 2 "Bob"
+    & gYtd      .~ goalieStats 10 11 12
+    & gLifetime .~ goalieStats 20 21 22
+
+  joe = newGoalie 3 "Joe"
+    & gYtd      .~ goalieStats 30 31 32
+    & gLifetime .~ goalieStats 40 41 42
+
+  gameState h a ot = newGameState
+    & gameType        ?~ HomeGame
+    & homeScore       ?~ h
+    & awayScore       ?~ a
+    & overtimeFlag    ?~ ot
+
+  winningGame = gameState 1 0 False
+  losingGame  = gameState 0 1 False
+  tiedGame    = gameState 0 1 True
+
+  in mapM_
+    (\(label, gameState, gid, bobData, joeData) -> context label $ let
+
+      progState = newProgState
+        & database.dbGoalies  .~ [bob, joe]
+        & progMode.gameStateL .~ gameState
+        & setGameGoalie gid
+
+      in mapM_
+        (\( label
+          , gid
+          , ( gWins
+            , gLosses
+            , gTies
+            , ytdWins
+            , ytdLosses
+            , ytdTies
+            , ltWins
+            , ltLosses
+            , ltTies
+            )
+          ) -> context label $ do
+            let
+              goalie = (progState^.database.dbGoalies) !! gid
+              gameStats = progState^.progMode.gameStateL.gameGoalieStats
+              game      = M.findWithDefault newGoalieStats gid gameStats
+              ytd       = goalie^.gYtd
+              lifetime  = goalie^.gLifetime
+
+            mapM_
+              (\(label, expected, actual) -> context label $
+                expected `TS.compareTest` actual)
+              [ ( "game stats",     game,     goalieStats gWins   gLosses   gTies   )
+              , ( "YTD stats",      ytd,      goalieStats ytdWins ytdLosses ytdTies )
+              , ( "lifetime stats", lifetime, goalieStats ltWins  ltLosses  ltTies  )
+              ]
+
+            it "should set the gameGoalieAssigned flag" $
+              progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
+        [ ( "checking Bob", 0, bobData )
+        , ( "checking Joe", 1, joeData )
+        ])
+    [ ( "Bob wins"
+      , winningGame
+      , 0
+      , ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
+      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+      )
+    , ( "Bob loses"
+      , losingGame
+      , 0
+      , ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
+      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+      )
+    , ( "Bob ties"
+      , tiedGame
+      , 0
+      , ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
+      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+      )
+    , ( "Joe wins"
+      , winningGame
+      , 1
+      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+      , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
+      )
+    , ( "Joe loses"
+      , losingGame
+      , 1
+      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+      , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
+      )
+    , ( "Joe ties"
+      , tiedGame
+      , 1
+      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+      , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
+      )
+    ]

test/ActionsSpec.hs

@@ -19,15 +19,32 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
+import qualified Data.Map as M
+import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import System.Random (randomRIO)
-import Test.Hspec (Spec, context, describe, it, shouldBe, shouldNotBe)
+import Test.Hspec
+  ( Spec
+  , context
+  , describe
+  , it
+  , runIO
+  , shouldBe
+  , shouldNotBe
+  , shouldSatisfy
+  )
 
 import Mtlstats.Actions
 import Mtlstats.Types
+import Mtlstats.Util
+
+import qualified Actions.GoalieInputSpec as GoalieInput
+import qualified TypesSpec as TS
 
 spec :: Spec
 spec = describe "Mtlstats.Actions" $ do
@@ -39,6 +56,22 @@ spec = describe "Mtlstats.Actions" $ do
   overtimeCheckSpec
   updateGameStatsSpec
   validateGameDateSpec
+  createPlayerSpec
+  createGoalieSpec
+  editPlayerSpec
+  addPlayerSpec
+  addGoalieSpec
+  resetCreatePlayerStateSpec
+  resetCreateGoalieStateSpec
+  recordGoalAssistsSpec
+  awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
+  assignPMinsSpec
+  backHomeSpec
+  scrollUpSpec
+  scrollDownSpec
+  GoalieInput.spec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -48,7 +81,7 @@ startNewSeasonSpec = describe "startNewSeason" $ do
       & startNewSeason
 
   it "should set the progState to NewSeason" $
-    s ^. progMode `shouldBe` NewSeason
+    show (s^.progMode) `shouldBe` "NewSeason"
 
   it "should set the number of games to 0" $
     s ^. database . dbGames `shouldBe` 0
@@ -61,7 +94,7 @@ startNewGameSpec = describe "startNewGame" $ do
     s ^. database . dbGames `shouldBe` 1
 
   it "should set the mode to NewGame" $
-    s ^. progMode `shouldBe` NewGame newGameState
+    show (s^.progMode) `shouldBe` "NewGame"
 
 resetYtdSpec :: Spec
 resetYtdSpec = describe "resetYtd" $
@@ -93,14 +126,12 @@ resetYtdSpec = describe "resetYtd" $
         ytd ^. gsGames        `shouldBe`    0
         ytd ^. gsMinsPlayed   `shouldBe`    0
         ytd ^. gsGoalsAllowed `shouldBe`    0
-        ytd ^. gsGoalsAgainst `shouldBe`    0
         ytd ^. gsWins         `shouldBe`    0
         ytd ^. gsLosses       `shouldBe`    0
         ytd ^. gsTies         `shouldBe`    0
         lt ^. gsGames         `shouldNotBe` 0
         lt ^. gsMinsPlayed    `shouldNotBe` 0
         lt ^. gsGoalsAllowed  `shouldNotBe` 0
-        lt ^. gsGoalsAgainst  `shouldNotBe` 0
         lt ^. gsWins          `shouldNotBe` 0
         lt ^. gsLosses        `shouldNotBe` 0
         lt ^. gsTies          `shouldNotBe` 0) $
@@ -190,9 +221,11 @@ updateGameStatsSpec = describe "updateGameStats" $ do
   let
 
     baseStats = newGameStats
-      & gmsWins     .~ 1
+      & gmsWins         .~ 1
-      & gmsLosses   .~ 1
+      & gmsLosses       .~ 1
-      & gmsOvertime .~ 1
+      & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 1
 
     s t h a o = newProgState
       & progMode.gameStateL
@@ -204,71 +237,79 @@ updateGameStatsSpec = describe "updateGameStats" $ do
         %~ (dbHomeGameStats .~ baseStats)
         .  (dbAwayGameStats .~ baseStats)
 
-    db hw hl ho aw al ao = newDatabase
+    db hw hl ho hf ha aw al ao af aa = newDatabase
       & dbHomeGameStats
-        %~ (gmsWins     .~ hw)
+        %~ (gmsWins         .~ hw)
-        .  (gmsLosses   .~ hl)
+        .  (gmsLosses       .~ hl)
-        .  (gmsOvertime .~ ho)
+        .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
       & dbAwayGameStats
-        %~ (gmsWins     .~ aw)
+        %~ (gmsWins         .~ aw)
-        .  (gmsLosses   .~ al)
+        .  (gmsLosses       .~ al)
-        .  (gmsOvertime .~ ao)
+        .  (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 1 1 1
+      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 1 1 1
+      in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
 
   context "home overtime loss" $
-    it "should record a home loss and overtime" $ let
+    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 2 2 1 1 1
+      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 2 1 1
+      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 2 1
+      in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
 
   context "away overtime loss" $
-    it "should record an away loss and overtime" $ let
+    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 2 2
+      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)
+      s'  = s Nothing (Just 1) (Just 2) (Just True)
-      in updateGameStats s' `shouldBe` s'
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing home score" $
     it "should not change anything" $ let
-      s' = s (Just HomeGame) Nothing (Just 1) (Just True)
+      s'  = s (Just HomeGame) Nothing (Just 1) (Just True)
-      in updateGameStats s' `shouldBe` s'
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing away score" $
     it "should not change anything" $ let
-      s' = s (Just HomeGame) (Just 1) Nothing (Just True)
+      s'  = s (Just HomeGame) (Just 1) Nothing (Just True)
-      in updateGameStats s' `shouldBe` s'
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing overtime flag" $
     it "should not change anything" $ let
-      s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
+      s'  = s (Just HomeGame) (Just 1) (Just 2) Nothing
-      in updateGameStats s' `shouldBe` s'
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
 validateGameDateSpec :: Spec
 validateGameDateSpec = describe "validateGameDate" $ do
@@ -315,6 +356,329 @@ validateGameDateSpec = describe "validateGameDate" $ do
       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
+    s = createPlayer newProgState
+    in show (s^.progMode) `shouldBe` "CreatePlayer"
+
+createGoalieSpec :: Spec
+createGoalieSpec = describe "createGoalie" $
+  it "should change the mode appropriately" $ let
+    s = createGoalie newProgState
+    in show (s^.progMode) `shouldBe` "CreateGoalie"
+
+editPlayerSpec :: Spec
+editPlayerSpec = describe "editPlayer" $
+  it "should change the mode appropriately" $ let
+    s = editPlayer newProgState
+    in show (s^.progMode) `shouldBe` "EditPlayer"
+
+addPlayerSpec :: Spec
+addPlayerSpec = describe "addPlayer" $ do
+  let
+    p1 = newPlayer 1 "Joe" "centre"
+    p2 = newPlayer 2 "Bob" "defense"
+    db = newDatabase
+      & dbPlayers .~ [p1]
+    s pm = newProgState
+      & progMode .~ pm
+      & database .~ db
+
+  context "data available" $
+    it "should create the player" $ let
+      s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
+        & cpsNumber   ?~ 2
+        & cpsName     .~ "Bob"
+        & cpsPosition .~ "defense"
+      in s'^.database.dbPlayers `shouldBe` [p1, p2]
+
+  context "data unavailable" $
+    it "should not create the player" $ let
+      s' = addPlayer $ s MainMenu
+      in s'^.database.dbPlayers `shouldBe` [p1]
+
+addGoalieSpec :: Spec
+addGoalieSpec = describe "addGoalie" $ do
+  let
+    g1 = newGoalie 2 "Joe"
+    g2 = newGoalie 3 "Bob"
+    db = newDatabase
+      & dbGoalies .~ [g1]
+    s pm = newProgState
+      & database .~ db
+      & progMode .~ pm
+
+  context "data available" $
+    it "should create the goalie" $ let
+      s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
+        & cgsNumber ?~ 3
+        & cgsName   .~ "Bob"
+      in s'^.database.dbGoalies `shouldBe` [g1, g2]
+
+  context "data unavailable" $
+    it "should not create the goalie" $ let
+      s' = addGoalie $ s MainMenu
+      in s'^.database.dbGoalies `shouldBe` [g1]
+
+resetCreatePlayerStateSpec :: Spec
+resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
+  cps = newCreatePlayerState
+    & cpsNumber   ?~ 1
+    & cpsName     .~ "Joe"
+    & cpsPosition .~ "centre"
+  ps  = resetCreatePlayerState $
+    newProgState & progMode.createPlayerStateL .~ cps
+  in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
+
+resetCreateGoalieStateSpec :: Spec
+resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
+  cgs = newCreateGoalieState
+    & cgsNumber ?~ 1
+    & cgsName   .~ "Joe"
+  ps = resetCreateGoalieState $
+    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
@@ -344,10 +708,55 @@ makeGoalieStats = GoalieStats
   <*> 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
+    input = newProgState
+      & progMode.gameStateL .~ newGameState
+      & inputBuffer         .~ "foo"
+      & scrollOffset        .~ 123
+    result = backHome input
+
+  it "should set the program mode back to MainMenu" $
+    result^.progMode `shouldSatisfy` \case
+      MainMenu -> True
+      _        -> False
+
+  it "should clear the input buffer" $
+    result^.inputBuffer `shouldBe` ""
+
+  it "should reset the scroll offset" $
+    result^.scrollOffset `shouldBe` 0
+
+scrollUpSpec :: Spec
+scrollUpSpec = describe "scrollUp" $ do
+
+  context "scrolled down" $
+    it "should decrease the scroll offset by one" $ let
+      ps  = newProgState & scrollOffset .~ 10
+      ps' = scrollUp ps
+      in ps'^.scrollOffset `shouldBe` 9
+
+  context "at top" $
+    it "should keep the scroll offset at zero" $ let
+      ps = scrollUp newProgState
+      in ps^.scrollOffset `shouldBe` 0
+
+  context "above top" $
+    it "should return the scroll offset to zero" $ let
+      ps  = newProgState & scrollOffset .~ (-10)
+      ps' = scrollUp ps
+      in ps'^.scrollOffset `shouldBe` 0
+
+scrollDownSpec = describe "scrollDown" $
+  it "should increase the scroll offset" $ let
+    ps  = newProgState & scrollOffset .~ 10
+    ps' = scrollDown ps
+    in ps'^.scrollOffset `shouldBe` 11

test/HandlersSpec.hs

@@ -0,0 +1,46 @@
+{-
+
+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 HandlersSpec (spec) where
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+import qualified UI.NCurses as C
+
+import Mtlstats.Handlers
+
+spec :: Spec
+spec = describe "Mtlstats.Handlers"
+  ynHandlerSpec
+
+ynHandlerSpec :: Spec
+ynHandlerSpec = describe "ynHandler" $ mapM_
+  (\(desc, event, expected) ->
+    context desc $
+      it ("should be " ++ show expected) $
+        ynHandler event `shouldBe` expected)
+  --  description,   event,                expected
+  [ ( "Y pressed",   C.EventCharacter 'Y', Just True  )
+  , ( "y pressed",   C.EventCharacter 'y', Just True  )
+  , ( "N pressed",   C.EventCharacter 'N', Just False )
+  , ( "n pressed",   C.EventCharacter 'n', Just False )
+  , ( "x pressed",   C.EventCharacter 'x', Nothing    )
+  , ( "other event", C.EventResized,       Nothing    )
+  ]

test/ReportSpec.hs

@@ -0,0 +1,65 @@
+{-
+
+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 ReportSpec (spec) where
+
+import Lens.Micro ((&), (?~), (%~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Report
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Mtlstats.Report" $ do
+  gameDateSpec
+  playerNameColWidthSpec
+
+gameDateSpec :: Spec
+gameDateSpec = describe "gameDate" $ do
+
+  context "valid gameDate" $
+    it "should format the date" $ let
+      gs = newGameState
+        & gameYear  ?~ 1980
+        & gameMonth ?~ 6
+        & gameDay   ?~ 25
+      in gameDate gs `shouldBe` "JUN 25 1980"
+
+  context "invalid date" $
+    it "should return an empty string" $
+      gameDate newGameState `shouldBe` ""
+
+playerNameColWidthSpec :: Spec
+playerNameColWidthSpec = describe "playerNameColWidth" $ do
+  let
+    short1 = newPlayer 1 "short" "foo"
+    short2 = newPlayer 2 "shorty" "bar"
+    long   = newPlayer 3 "123456789012345" "baz"
+
+  mapM_
+    (\(label, players, expected) -> context label $
+      it ("should be " ++ show expected) $
+        playerNameColWidth players `shouldBe` expected)
+    --  label,         players,          expected
+    [ ( "empty list",  [],               10       )
+    , ( "short names", [short1, short2], 10       )
+    , ( "long name",   [short1, long],   16       )
+    ]

test/Spec.hs

@@ -23,10 +23,16 @@ import Test.Hspec (hspec)
 
 import qualified ActionsSpec as Actions
 import qualified FormatSpec as Format
+import qualified HandlersSpec as Handlers
+import qualified ReportSpec as Report
 import qualified TypesSpec as Types
+import qualified UtilSpec as Util
 
 main :: IO ()
 main = hspec $ do
   Types.spec
   Actions.spec
   Format.spec
+  Handlers.spec
+  Report.spec
+  Util.spec

test/TypesSpec.hs

@@ -21,7 +21,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 {-# LANGUAGE OverloadedStrings, RankNTypes #-}
 
-module TypesSpec (spec) where
+module TypesSpec (Comparable (..), spec) where
 
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
@@ -35,6 +35,9 @@ import Mtlstats.Types
 
 import qualified Types.MenuSpec as Menu
 
+class Comparable a where
+  compareTest :: a -> a -> Spec
+
 spec :: Spec
 spec = describe "Mtlstats.Types" $ do
   playerSpec
@@ -42,6 +45,9 @@ spec = describe "Mtlstats.Types" $ do
   gameStatsSpec
   databaseSpec
   gameStateLSpec
+  createPlayerStateLSpec
+  createGoalieStateLSpec
+  editPlayerStateLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -49,10 +55,21 @@ spec = describe "Mtlstats.Types" $ do
   gameWonSpec
   gameLostSpec
   gameTiedSpec
+  unaccountedPointsSpec
   gmsGamesSpec
   gmsPointsSpec
   addGameStatsSpec
-  pPointsSpec
+  playerSearchSpec
+  playerSearchExactSpec
+  modifyPlayerSpec
+  playerSummarySpec
+  playerDetailsSpec
+  playerIsActiveSpec
+  psPointsSpec
+  addPlayerStatsSpec
+  goalieSearchSpec
+  goalieSearchExactSpec
+  goalieSummarySpec
   Menu.spec
 
 playerSpec :: Spec
@@ -71,16 +88,79 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
 gameStateLSpec :: Spec
 gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   -- getters
-  [ ( MainMenu,              newGameState )
+  [ ( "missing state", MainMenu,              newGameState )
-  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "home game",     NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "away game",     NewGame $ gs AwayGame, gs AwayGame  )
   ]
   -- setters
-  [ ( MainMenu,              gs HomeGame  )
+  [ ( "set home",     MainMenu,              gs HomeGame  )
-  , ( NewGame $ gs HomeGame, gs AwayGame  )
+  , ( "home to away", NewGame $ gs HomeGame, gs AwayGame  )
-  , ( NewGame $ gs HomeGame, newGameState )
+  , ( "away to home", NewGame $ gs AwayGame, gs HomeGame  )
+  , ( "clear home",   NewGame $ gs HomeGame, newGameState )
+  , ( "clear away",   NewGame $ gs AwayGame, newGameState )
   ]
   where gs t = newGameState & gameType ?~ t
 
+createPlayerStateLSpec :: Spec
+createPlayerStateLSpec = describe "createPlayerStateL" $
+  lensSpec createPlayerStateL
+  -- getters
+  [ ( "missing state", MainMenu,          newCreatePlayerState )
+  , ( "with state",    CreatePlayer cps1, cps1                 )
+  ]
+  -- setters
+  [ ( "missing state", MainMenu,          cps1                 )
+  , ( "change state",  CreatePlayer cps1, cps2                 )
+  , ( "clear state",   CreatePlayer cps1, newCreatePlayerState )
+  ]
+  where
+    cps1 = newCreatePlayerState
+      & cpsNumber    ?~ 1
+      & cpsName      .~ "Joe"
+      & cpsPosition  .~ "centre"
+    cps2 = newCreatePlayerState
+      & cpsNumber   ?~ 2
+      & cpsName     .~ "Bob"
+      & cpsPosition .~ "defense"
+
+createGoalieStateLSpec :: Spec
+createGoalieStateLSpec = describe "createGoalieStateL" $
+  lensSpec createGoalieStateL
+  -- getters
+  [ ( "missing state", MainMenu,          newCreateGoalieState )
+  , ( "with state",    CreateGoalie cgs1, cgs1                 )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,          cgs1                 )
+  , ( "change state", CreateGoalie cgs1, cgs2                 )
+  , ( "clear state",  CreateGoalie cgs1, newCreateGoalieState )
+  ]
+  where
+    cgs1 = newCreateGoalieState
+      & cgsNumber    ?~ 1
+      & cgsName      .~ "Joe"
+    cgs2 = newCreateGoalieState
+      & cgsNumber ?~ 2
+      & cgsName   .~ "Bob"
+
+editPlayerStateLSpec :: Spec
+editPlayerStateLSpec = describe "editPlayerStateL" $
+  lensSpec editPlayerStateL
+  -- getters
+  [ ( "missing state", MainMenu,        newEditPlayerState )
+  , ( "withState",     EditPlayer eps1, eps1               )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,        eps1               )
+  , ( "change state", EditPlayer eps1, eps2               )
+  , ( "clear state",  EditPlayer eps1, newEditPlayerState )
+  ]
+  where
+    eps1 = newEditPlayerState
+      & epsSelectedPlayer ?~ 1
+    eps2 = newEditPlayerState
+      & epsSelectedPlayer ?~ 2
+
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
   let
@@ -141,24 +221,23 @@ jsonSpec x j = do
       decode (encode x) `shouldBe` Just x
 
 lensSpec
-  :: (Eq a, Show s, Show a)
+  :: Comparable a
   => Lens' s a
-  -> [(s, a)]
+  -> [(String, s, a)]
-  -> [(s, a)]
+  -> [(String, s, a)]
   -> Spec
-lensSpec l gs ss = do
+lensSpec lens getters setters = do
 
   context "getters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $
-      it ("should be " ++ show x) $
+      compareTest (s^.lens) x)
-        s ^. l `shouldBe` x)
+    getters
-    gs
 
   context "setters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $ let
-      it ("should set to " ++ show x) $
+      s' = s & lens .~ x
-        (s & l .~ x) ^. l `shouldBe` x)
+      in compareTest (s'^.lens) x)
-    ss
+    setters
 
 player :: Player
 player = newPlayer 1 "Joe" "centre"
@@ -205,34 +284,36 @@ goalieStats n = newGoalieStats
   & gsGames        .~ n
   & gsMinsPlayed   .~ n + 1
   & gsGoalsAllowed .~ n + 2
-  & gsGoalsAgainst .~ n + 3
+  & gsWins         .~ n + 3
-  & gsWins         .~ n + 4
+  & gsLosses       .~ n + 4
-  & gsLosses       .~ n + 5
+  & gsTies         .~ n + 5
-  & gsTies         .~ n + 6
 
 goalieStatsJSON :: Int -> Value
 goalieStatsJSON n = Object $ HM.fromList
   [ ( "games",         toJSON n       )
   , ( "mins_played",   toJSON $ n + 1 )
   , ( "goals_allowed", toJSON $ n + 2 )
-  , ( "goals_against", toJSON $ n + 3 )
+  , ( "wins",          toJSON $ n + 3 )
-  , ( "wins",          toJSON $ n + 4 )
+  , ( "losses",        toJSON $ n + 4 )
-  , ( "losses",        toJSON $ n + 5 )
+  , ( "ties",          toJSON $ n + 5 )
-  , ( "ties",          toJSON $ n + 6 )
   ]
 
 gameStats :: Int -> GameStats
 gameStats n = GameStats
-  { _gmsWins     = n
+  { _gmsWins         = n
-  , _gmsLosses   = n + 1
+  , _gmsLosses       = n + 1
-  , _gmsOvertime = n + 2
+  , _gmsOvertime     = n + 2
+  , _gmsGoalsFor     = n + 3
+  , _gmsGoalsAgainst = n + 4
   }
 
 gameStatsJSON :: Int -> Value
 gameStatsJSON n = Object $ HM.fromList
-  [ ( "wins",     toJSON n       )
+  [ ( "wins",          toJSON n       )
-  , ( "losses",   toJSON $ n + 1 )
+  , ( "losses",        toJSON $ n + 1 )
-  , ( "overtime", toJSON $ n + 2 )
+  , ( "overtime",      toJSON $ n + 2 )
+  , ( "goals_for",     toJSON $ n + 3 )
+  , ( "goals_against", toJSON $ n + 4 )
   ]
 
 db :: Database
@@ -320,30 +401,36 @@ gameWonSpec = describe "gameWon" $ mapM_
 
 gameLostSpec :: Spec
 gameLostSpec = describe "gameLost" $ mapM_
-  (\(t, h, a, expected) -> let
+  (\(t, h, a, ot, expected) -> let
     desc = "game type: " ++ show t ++
       ", home score: " ++ show h ++
-      ", away score: " ++ show a
+      ", away score: " ++ show a ++
+      ", overtimr flag: " ++ show ot
     gs = newGameState
-      & gameType  .~ t
+      & gameType     .~ t
-      & homeScore .~ h
+      & homeScore    .~ h
-      & awayScore .~ a
+      & awayScore    .~ a
+      & overtimeFlag .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gameLost gs `shouldBe` expected)
-  --  gameType,      homeScore, awayScore, expected
+  --  gameType,      homeScore, awayScore, overtimeFlag, expected
-  [ ( Just HomeGame, Just 1,    Just 1,    Just False )
+  [ ( Just HomeGame, Just 1,    Just 1,    Just False,   Just False )
-  , ( Just HomeGame, Just 1,    Just 2,    Just True  )
+  , ( Just HomeGame, Just 1,    Just 2,    Just False,   Just True  )
-  , ( Just HomeGame, Just 2,    Just 1,    Just False )
+  , ( Just HomeGame, Just 1,    Just 2,    Just True,    Just False )
-  , ( Just AwayGame, Just 1,    Just 1,    Just False )
+  , ( Just HomeGame, Just 2,    Just 1,    Just False,   Just False )
-  , ( Just AwayGame, Just 1,    Just 2,    Just False )
+  , ( Just AwayGame, Just 1,    Just 1,    Just False,   Just False )
-  , ( Just AwayGame, Just 2,    Just 1,    Just True  )
+  , ( Just AwayGame, Just 1,    Just 2,    Just False,   Just False )
-  , ( Nothing,       Just 1,    Just 2,    Nothing    )
+  , ( Just AwayGame, Just 2,    Just 1,    Just False,   Just True  )
-  , ( Just HomeGame, Nothing,   Just 1,    Nothing    )
+  , ( Just AwayGame, Just 2,    Just 1,    Just True,    Just False )
-  , ( Just AwayGame, Nothing,   Just 1,    Nothing    )
+  , ( Nothing,       Just 1,    Just 2,    Just False,   Nothing    )
-  , ( Just HomeGame, Just 1,    Nothing,   Nothing    )
+  , ( Just HomeGame, Nothing,   Just 1,    Just False,   Nothing    )
-  , ( Just AwayGame, Just 1,    Nothing,   Nothing    )
+  , ( Just AwayGame, Nothing,   Just 1,    Just False,   Nothing    )
-  , ( Nothing,       Nothing,   Nothing,   Nothing    )
+  , ( Just HomeGame, Just 1,    Nothing,   Just False,   Nothing    )
+  , ( Just AwayGame, Just 1,    Nothing,   Just False,   Nothing    )
+  , ( Just HomeGame, Just 1,    Just 2,    Nothing,      Nothing    )
+  , ( Just AwayGame, Just 1,    Just 2,    Nothing,      Nothing    )
+  , ( Nothing,       Nothing,   Nothing,   Just False,   Nothing    )
   ]
 
 gameTiedSpec :: Spec
@@ -364,33 +451,65 @@ gameTiedSpec = describe "gameTied" $ mapM_
   , ( Just 1,  Just 2,  Just False )
   ]
 
+unaccountedPointsSpec :: Spec
+unaccountedPointsSpec = describe "unaccounted points" $ do
+  context "no data" $
+    it "should return Nothing" $
+      unaccountedPoints newGameState `shouldBe` Nothing
+
+  context "unaccounted points" $
+    it "should return True" $ let
+      gs = newGameState
+        & gameType  ?~ HomeGame
+        & homeScore ?~ 1
+      in unaccountedPoints gs `shouldBe` Just True
+
+  context "all points accounted" $
+    it "should return False" $ let
+      gs = newGameState
+        & gameType        ?~ HomeGame
+        & homeScore       ?~ 1
+        & pointsAccounted .~ 1
+      in unaccountedPoints gs `shouldBe` Just False
+
+  context "more points accounted" $
+    it "should return True" $ let
+      gs = newGameState
+        & gameType        ?~ HomeGame
+        & homeScore       ?~ 1
+        & pointsAccounted .~ 2
+      in unaccountedPoints gs `shouldBe` Just False
+
 gmsGamesSpec :: Spec
 gmsGamesSpec = describe "gmsGames" $ mapM_
-  (\(w, l, expected) -> let
+  (\(w, l, ot, expected) -> let
     desc = "wins: " ++ show w ++
-      ", losses: " ++ show l
+      ", losses: " ++ show l ++
+      ", overtime: " ++ show ot
     gs = newGameStats
-      & gmsWins   .~ w
+      & gmsWins     .~ w
-      & gmsLosses .~ l
+      & gmsLosses   .~ l
+      & gmsOvertime .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gmsGames gs `shouldBe` expected)
-  --  wins, losses, expected
+  --  wins, losses, overtime, expected
-  [ ( 0,    0,      0        )
+  [ ( 0,    0,      0,        0        )
-  , ( 1,    0,      1        )
+  , ( 1,    0,      0,        1        )
-  , ( 0,    1,      1        )
+  , ( 0,    1,      0,        1        )
-  , ( 1,    1,      2        )
+  , ( 0,    0,      1,        1        )
-  , ( 2,    3,      5        )
+  , ( 1,    1,      1,        3        )
+  , ( 2,    3,      5,        10       )
   ]
 
 gmsPointsSpec :: Spec
 gmsPointsSpec = describe "gmsPoints" $ mapM_
   (\(w, l, ot, expected) -> let
-    gs = GameStats
+    gs
-      { _gmsWins     = w
+      = newGameStats
-      , _gmsLosses   = l
+      & gmsWins     .~ w
-      , _gmsOvertime = ot
+      & gmsLosses   .~ l
-      }
+      & gmsOvertime .~ ot
     in context (show gs) $
       it ("should be " ++ show expected) $
         gmsPoints gs `shouldBe` expected)
@@ -408,27 +527,140 @@ addGameStatsSpec = describe "addGameStats" $
   it "should add the values" $ let
 
     s1 = GameStats
-      { _gmsWins     = 1
+      { _gmsWins         = 1
-      , _gmsLosses   = 3
+      , _gmsLosses       = 2
-      , _gmsOvertime = 2
+      , _gmsOvertime     = 3
+      , _gmsGoalsFor     = 4
+      , _gmsGoalsAgainst = 5
       }
 
     s2 = GameStats
-      { _gmsWins     = 4
+      { _gmsWins         = 6
-      , _gmsLosses   = 6
+      , _gmsLosses       = 7
-      , _gmsOvertime = 5
+      , _gmsOvertime     = 8
+      , _gmsGoalsFor     = 9
+      , _gmsGoalsAgainst = 10
       }
 
     expected = GameStats
-      { _gmsWins     = 5
+      { _gmsWins         = 7
-      , _gmsLosses   = 9
+      , _gmsLosses       = 9
-      , _gmsOvertime = 7
+      , _gmsOvertime     = 11
+      , _gmsGoalsFor     = 13
+      , _gmsGoalsAgainst = 15
       }
 
     in addGameStats s1 s2 `shouldBe` expected
 
-pPointsSpec :: Spec
+playerSearchSpec :: Spec
-pPointsSpec = describe "pPoints" $ mapM_
+playerSearchSpec = describe "playerSearch" $ mapM_
+  (\(sStr, expected) -> context sStr $
+    it ("should return " ++ show expected) $ let
+      ps = [joe, bob, steve]
+      in playerSearch sStr ps `shouldBe` expected)
+  --  search, result
+  [ ( "Joe",  [(0, joe)]             )
+  , ( "o",    [(0, joe), (1, bob)]   )
+  , ( "e",    [(0, joe), (2, steve)] )
+  , ( "x",    []                     )
+  ]
+
+playerSearchExactSpec :: Spec
+playerSearchExactSpec = describe "playerSearchExact" $ mapM_
+  (\(sStr, expected) -> context sStr $
+    it ("should be " ++ show expected) $ let
+      ps = [joe, bob, steve]
+      in playerSearchExact sStr ps `shouldBe` expected)
+  --  search,  result
+  [ ( "Joe",   Just (0, joe)   )
+  , ( "Bob",   Just (1, bob)   )
+  , ( "Steve", Just (2, steve) )
+  , ( "Sam",   Nothing         )
+  , ( "",      Nothing         )
+  ]
+
+modifyPlayerSpec :: Spec
+modifyPlayerSpec = describe "modifyPlayer" $ mapM_
+  (\(pName, j, b, s) -> let
+    modifier = pLifetime.psGoals .~ 1
+    players = modifyPlayer modifier pName [joe, bob, steve]
+    in context ("modify " ++ pName) $ do
+
+      context "Joe's lifetime goals" $
+        it ("should be " ++ show j) $
+          head players ^. pLifetime.psGoals `shouldBe` j
+
+      context "Bob's lifetime goals" $
+        it ("should be " ++ show b) $
+          (players !! 1) ^. pLifetime.psGoals `shouldBe` b
+
+      context "Steve's lifetime goals" $
+        it ("should be " ++ show 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             )
+  , ( "Steve",     0,           0,           1             )
+  , ( "Sam",       0,           0,           0             )
+  ]
+
+playerSummarySpec :: Spec
+playerSummarySpec = describe "playerSummary" $
+  it "should be \"Joe (2) center\"" $
+    playerSummary joe `shouldBe` "Joe (2) center"
+
+playerDetailsSpec :: Spec
+playerDetailsSpec = describe "playerDetails" $
+  it "should give a detailed description" $ let
+
+    player = newPlayer 1 "Joe" "centre"
+      & pYtd .~ PlayerStats
+        { _psGoals   = 2
+        , _psAssists = 3
+        , _psPMin    = 4
+        }
+      & pLifetime .~ PlayerStats
+        { _psGoals   = 5
+        , _psAssists = 6
+        , _psPMin    = 7
+        }
+
+    expected = unlines
+      [ "               Number: 1"
+      , "                 Name: Joe"
+      , "             Position: centre"
+      , "            YTD goals: 2"
+      , "          YTD assists: 3"
+      , "     YTD penalty mins: 4"
+      , "       Lifetime goals: 5"
+      , "     Lifetime assists: 6"
+      , "Lifetime penalty mins: 7"
+      ]
+
+    in playerDetails player `shouldBe` expected
+
+playerIsActiveSpec :: Spec
+playerIsActiveSpec = describe "playerIsActive" $ do
+  let
+    pState = newPlayerStats
+      & psGoals   .~ 10
+      & psAssists .~ 11
+      & psPMin    .~ 12
+    player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
+
+  mapM_
+    (\(label, player', expected) -> context label $
+      it ("should be " ++ show expected) $
+        playerIsActive player' `shouldBe` expected)
+    --  label,                player,                       expected
+    [ ( "not active",         player,                       False    )
+    , ( "has goal",           player & pYtd.psGoals   .~ 1, True     )
+    , ( "has assist",         player & pYtd.psAssists .~ 1, True     )
+    , ( "has penalty minute", player & pYtd.psPMin    .~ 1, True     )
+    ]
+
+psPointsSpec :: Spec
+psPointsSpec = describe "psPoints" $ mapM_
   (\(goals, assists, points) -> let
     desc = "goals: " ++ show goals ++
       ", assists: " ++ show assists
@@ -437,10 +669,153 @@ pPointsSpec = describe "pPoints" $ mapM_
       psAssists .~ assists
     in context desc $
       it ("should be " ++ show points) $
-        pPoints stats `shouldBe` points)
+        psPoints stats `shouldBe` points)
   --  goals, assists, points
   [ ( 0,     0,       0      )
   , ( 1,     0,       1      )
   , ( 0,     1,       1      )
   , ( 2,     3,       5      )
   ]
+
+addPlayerStatsSpec :: Spec
+addPlayerStatsSpec = describe "addPlayerStats" $ do
+  let
+    s1
+      = newPlayerStats
+      & psGoals   .~ 1
+      & psAssists .~ 2
+      & psPMin    .~ 3
+    s2
+      = newPlayerStats
+      & psGoals   .~ 4
+      & psAssists .~ 5
+      & psPMin    .~ 6
+    s3 = addPlayerStats s1 s2
+
+  describe "psGoals" $
+    it "should be 5" $
+      s3^.psGoals `shouldBe` 5
+
+  describe "psAssists" $
+    it "should be 7" $
+      s3^.psAssists `shouldBe` 7
+
+  describe "psPMin" $
+    it "should be 9" $
+      s3^.psPMin `shouldBe` 9
+
+goalieSearchSpec :: Spec
+goalieSearchSpec = describe "goalieSearch" $ do
+  let
+    goalies =
+      [ newGoalie 2 "Joe"
+      , newGoalie 3 "Bob"
+      , newGoalie 5 "Steve"
+      ]
+    result n = (n, goalies!!n)
+
+  context "partial match" $
+    it "should return Joe and Steve" $
+      goalieSearch "e" goalies `shouldBe` [result 0, result 2]
+
+  context "no match" $
+    it "should return an empty list" $
+      goalieSearch "x" goalies `shouldBe` []
+
+  context "exact match" $
+    it "should return Steve" $
+      goalieSearch "Bob" goalies `shouldBe` [result 1]
+
+goalieSearchExactSpec :: Spec
+goalieSearchExactSpec = describe "goalieSearchExact" $ do
+  let
+    goalies =
+      [ newGoalie 2 "Joe"
+      , newGoalie 3 "Bob"
+      , newGoalie 5 "Steve"
+      ]
+    result n = (n, goalies!!n)
+
+  mapM_
+    (\(name, num) -> context name $
+      it ("should return " ++ name) $
+        goalieSearchExact name goalies `shouldBe` Just (result num))
+    --  name,    num
+    [ ( "Joe",   0   )
+    , ( "Bob",   1   )
+    , ( "Steve", 2   )
+    ]
+
+  context "Greg" $
+    it "should return Nothing" $
+      goalieSearchExact "Greg" goalies `shouldBe` Nothing
+
+goalieSummarySpec :: Spec
+goalieSummarySpec = describe "goalieSummary" $
+  it "should provide a summary string" $
+    goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
+
+joe :: Player
+joe = newPlayer 2 "Joe" "center"
+
+bob :: Player
+bob = newPlayer 3 "Bob" "defense"
+
+steve :: Player
+steve = newPlayer 5 "Steve" "forward"
+
+instance Comparable GoalieStats where
+  compareTest actual expected = mapM_
+    (\(name, lens) -> describe name $
+      it ("should be " ++ show (expected^.lens)) $
+        actual^.lens `shouldBe` expected^.lens)
+    --  name,             lens
+    [ ( "gsGames",        gsGames        )
+    , ( "gsMinsPlayed",   gsMinsPlayed   )
+    , ( "gsGoalsAllowed", gsGoalsAllowed )
+    , ( "gsWins",         gsWins         )
+    , ( "gsLosses",       gsLosses       )
+    , ( "gsTies",         gsTies         )
+    ]
+
+instance Comparable GameState where
+  compareTest actual expected =
+    it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+
+instance Comparable CreatePlayerState where
+  compareTest actual expected = do
+
+    describe "cpsNumber" $
+      it ("should be " ++ show (expected^.cpsNumber)) $
+        actual^.cpsNumber `shouldBe` expected^.cpsNumber
+
+    describe "cpsName" $
+      it ("should be " ++ expected^.cpsName) $
+        actual^.cpsName `shouldBe` expected^.cpsName
+
+    describe "cpsPosition" $
+      it ("should be " ++ expected^.cpsPosition) $
+        actual^.cpsPosition `shouldBe` expected^.cpsPosition
+
+instance Comparable EditPlayerState where
+  compareTest actual expected = do
+
+    describe "epsSelectedPlayer" $
+      it ("should be " ++ show (expected^.epsSelectedPlayer)) $
+        actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
+
+    describe "epsMode" $
+      it ("should be " ++ show (expected^.epsMode)) $
+        actual^.epsMode `shouldBe` expected^.epsMode
+
+instance Comparable CreateGoalieState where
+  compareTest actual expected = do
+
+    describe "cgsNuber" $
+      it("should be " ++ show (expected^.cgsNumber)) $
+        actual^.cgsNumber `shouldBe` expected^.cgsNumber
+
+    describe "cgsName" $
+      it ("should be " ++ expected^.cgsName) $
+        actual^.cgsName `shouldBe` expected^.cgsName

test/UtilSpec.hs

@@ -0,0 +1,94 @@
+{-
+
+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 UtilSpec (spec) where
+
+import qualified Data.Map as M
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Util
+
+spec :: Spec
+spec = describe "Mtlstats.Util" $ do
+  nthSpec
+  modifyNthSpec
+  updateMapSpec
+  sliceSpec
+
+nthSpec :: Spec
+nthSpec = describe "nth" $ mapM_
+  (\(n, expected) -> context (show n) $
+    it ("should be " ++ show expected) $ let
+      xs = ["foo", "bar", "baz"]
+      in nth n xs `shouldBe` expected)
+  --  index, expected
+  [ ( 0,     Just "foo" )
+  , ( 1,     Just "bar" )
+  , ( 2,     Just "baz" )
+  , ( 3,     Nothing    )
+  , ( -1,    Nothing    )
+  ]
+
+modifyNthSpec  :: Spec
+modifyNthSpec = describe "modifyNth" $ do
+
+  context "in bounds" $
+    it "should modify the value" $
+      modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
+
+  context "out of bounds" $
+    it "should not modify the value" $
+      modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
+
+  context "negative index" $
+    it "should not modify the value" $
+      modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
+
+updateMapSpec :: Spec
+updateMapSpec = describe "updateMap" $ do
+  let
+    input = M.fromList [(1, 2), (3, 5)]
+
+  context "key found" $ let
+    expected = M.fromList [(1, 3), (3, 5)]
+    in it "should update the value" $
+      updateMap 1 10 succ input `shouldBe` expected
+
+  context "key not found" $ let
+    expected = M.fromList [(1, 2), (3, 5), (10, 11)]
+    in it "should create a new value and update the default" $
+      updateMap 10 10 succ input `shouldBe` expected
+
+sliceSpec :: Spec
+sliceSpec = describe "slice" $ do
+  let list = [2, 4, 6, 8]
+
+  context "sublist" $
+    it "should return the sublist" $
+      slice 1 2 list `shouldBe` [4, 6]
+
+  context "too large" $
+    it "should return as much of the list as possible" $
+      slice 1 100 list `shouldBe` [4, 6, 8]
+
+  context "negative offset" $
+    it "should return the correct number of elements from the beginning" $
+      slice (-10) 2 list `shouldBe` [2, 4]