version 0.4.0

year-to-date statistics

ChangeLog.md

@@ -1,3 +1,20 @@
 # Changelog for mtlstats
 
-## Unreleased changes
+## 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.4.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,26 @@ module Mtlstats.Actions
   , overtimeCheck
   , updateGameStats
   , validateGameDate
+  , createPlayer
+  , addPlayer
+  , 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 +91,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
-  won   <- gameWon $ s^.progMode.gameStateL
-  lost  <- gameLost $ s^.progMode.gameStateL
-  ot    <- s^.progMode.gameStateL.overtimeFlag
+  let gs = s^.progMode.gameStateL
+  gType  <- gs^.gameType
+  won    <- gameWon gs
+  lost   <- gameLost gs
+  ot     <- gs^.overtimeFlag
+  tScore <- teamScore gs
+  oScore <- otherScore gs
   let
     hw  = if gType == HomeGame && won then 1 else 0
     hl  = if gType == HomeGame && lost then 1 else 0
     hot = if gType == HomeGame && ot then 1 else 0
+    hgf = if gType == HomeGame then tScore else 0
+    hga = if gType == HomeGame then oScore else 0
     aw  = if gType == AwayGame && won then 1 else 0
     al  = if gType == AwayGame && lost then 1 else 0
     aot = if gType == AwayGame && ot then 1 else 0
+    agf = if gType == AwayGame then tScore else 0
+    aga = if gType == AwayGame then oScore else 0
   Just $ s
     & database.dbHomeGameStats
       %~ (gmsWins         +~ hw)
       .  (gmsLosses       +~ hl)
       .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
     & database.dbAwayGameStats
       %~ (gmsWins         +~ aw)
       .  (gmsLosses       +~ al)
       .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
 
 -- | Validates the game date
 validateGameDate :: ProgState -> ProgState
@@ -111,3 +135,115 @@ validateGameDate s = fromMaybe s $ do
       .  (gameMonth .~ Nothing)
       .  (gameDay   .~ Nothing)
     else s
+
+-- | Starts player creation mode
+createPlayer :: ProgState -> ProgState
+createPlayer = let
+  cb = modify $ progMode .~ MainMenu
+  cps
+    = newCreatePlayerState
+    & cpsSuccessCallback .~ cb
+    & cpsFailureCallback .~ cb
+  in progMode .~ CreatePlayer cps
+
+-- | 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])
+
+-- | 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.selectedPlayer
+  Just $ s
+    & database.dbPlayers %~ modifyNth n
+      (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
+    & progMode.gameStateL
+      %~ ( gamePlayerStats %~ updateMap n newPlayerStats
+           (psPMin +~ mins)
+         )
+      .  (selectedPlayer .~ 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/Config.hs

@@ -24,3 +24,19 @@ 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

src/Mtlstats/Control.hs

@@ -21,39 +21,65 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (when)
-import Control.Monad.Trans.State (modify)
+import Control.Monad (join, when)
+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.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
+  NewSeason -> newSeasonC
+  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^.selectedPlayer     -> getPMinsC
+    | not $ gs^.pMinsRecorded         -> pMinPlayerC
+    | otherwise                       -> reportC
+  CreatePlayer cps
+    | null $ cps^.cpsNumber   -> getPlayerNumC
+    | null $ cps^.cpsName     -> getPlayerNameC
+    | null $ cps^.cpsPosition -> getPlayerPosC
+    | otherwise               -> confirmCreatePlayerC
 
-  MainMenu -> Controller
+mainMenuC :: Controller
+mainMenuC = Controller
   { drawController   = const $ drawMenu mainMenu
   , handleController = menuHandler mainMenu
   }
 
-  NewSeason -> Controller
+newSeasonC :: Controller
+newSeasonC = Controller
   { drawController   = const $ drawMenu newSeasonMenu
   , handleController = \e -> do
     menuHandler newSeasonMenu e
     return True
   }
 
-  NewGame gs
-
-    | null $ gs^.gameYear -> Controller
+gameYearC :: Controller
+gameYearC = Controller
   { drawController = \s -> do
     header s
     drawPrompt gameYearPrompt s
@@ -62,7 +88,8 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.gameMonth -> Controller
+gameMonthC :: Controller
+gameMonthC = Controller
   { drawController = \s -> do
     header s
     drawMenu gameMonthMenu
@@ -71,7 +98,8 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.gameDay -> Controller
+gameDayC :: Controller
+gameDayC = Controller
   { drawController = \s -> do
     header s
     drawPrompt gameDayPrompt s
@@ -81,7 +109,8 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.gameType -> Controller
+gameTypeC :: Controller
+gameTypeC = Controller
   { drawController = \s -> do
     header s
     drawMenu gameTypeMenu
@@ -90,7 +119,8 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.otherTeam -> Controller
+otherTeamC :: Controller
+otherTeamC = Controller
   { drawController = \s -> do
     header s
     drawPrompt otherTeamPrompt s
@@ -99,7 +129,8 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.homeScore -> Controller
+homeScoreC :: Controller
+homeScoreC = Controller
   { drawController = \s -> do
     header s
     drawPrompt homeScorePrompt s
@@ -108,40 +139,151 @@ dispatch s = case s^.progMode of
     return True
   }
 
-    | null $ gs^.awayScore -> Controller
+awayScoreC :: Controller
+awayScoreC = Controller
   { drawController = \s -> do
     header s
     drawPrompt awayScorePrompt s
   , handleController = \e -> do
     promptHandler awayScorePrompt e
     modify overtimeCheck
-        modify updateGameStats
     return True
   }
 
-    | null $ gs^.overtimeFlag -> Controller
+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
-        overtimePrompt e
-        modify updateGameStats
+    modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
     return True
   }
 
-    | otherwise -> Controller
+verifyDataC :: Controller
+verifyDataC = Controller
   { drawController = \s -> do
-        (_, cols) <- C.windowSize
-        C.drawString $ report (fromInteger $ pred cols) s
+    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
-        when
-          (case e of
-            C.EventCharacter _  -> True
-            C.EventSpecialKey _ -> True
-            _                   -> False) $
-          modify $ progMode .~ MainMenu
+    case ynHandler e of
+      Just True  -> do
+        modify $ progMode.gameStateL.dataVerified .~ True
+        modify updateGameStats
+      Just False -> modify $ progMode.gameStateL .~ newGameState
+      Nothing    -> return ()
+    return True
+  }
+
+goalInput :: GameState -> Controller
+goalInput gs
+  | null (gs^.goalBy            ) = recordGoalC
+  | not (gs^.confirmGoalDataFlag) = recordAssistC
+  | otherwise                     = confirmGoalDataC
+
+recordGoalC :: Controller
+recordGoalC = Controller
+  { drawController = \s -> let
+    (game, goal) = gameGoal s
+    in drawPrompt (recordGoalPrompt game goal) s
+  , handleController = \e -> do
+    (game, goal) <- gets gameGoal
+    promptHandler (recordGoalPrompt game goal) e
+    return True
+  }
+
+recordAssistC :: Controller
+recordAssistC = Controller
+  { drawController = \s -> let
+    (game, goal, assist) = gameGoalAssist s
+    in drawPrompt (recordAssistPrompt game goal assist) s
+  , handleController = \e -> do
+    (game, goal, assist) <- gets gameGoalAssist
+    promptHandler (recordAssistPrompt game goal assist) e
+    return True
+  }
+
+confirmGoalDataC :: Controller
+confirmGoalDataC = Controller
+  { drawController = \s -> do
+    let
+      (game, goal) = gameGoal s
+      gs           = s^.progMode.gameStateL
+      players      = s^.database.dbPlayers
+      msg          = unlines $
+        [ "          Game: " ++ padNum 2 game
+        , "          Goal: " ++ show goal
+        , "Goal scored by: " ++
+          playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
+        ] ++
+        map
+          (\pid -> "   Assisted by: " ++
+            playerSummary (fromJust $ nth pid players))
+          (gs^.assistsBy) ++
+        [ ""
+        , "Is the above information correct? (Y/N)"
+        ]
+    C.drawString msg
+    return C.CursorInvisible
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True  -> modify recordGoalAssists
+      Just False -> modify resetGoalData
+      Nothing    -> return ()
+    return True
+  }
+
+pMinPlayerC :: Controller
+pMinPlayerC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt pMinPlayerPrompt s
+  , handleController = \e -> do
+    promptHandler pMinPlayerPrompt e
+    return True
+  }
+
+getPMinsC :: Controller
+getPMinsC = Controller
+  { drawController = \s -> do
+    header s
+    C.drawString $ fromMaybe "" $ do
+      pid    <- s^.progMode.gameStateL.selectedPlayer
+      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
   }
 
@@ -149,10 +291,58 @@ header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
 
-overtimePrompt :: C.Event -> Action ()
-overtimePrompt (C.EventCharacter c) = modify $
-  progMode.gameStateL.overtimeFlag .~ case toUpper c of
-    'Y' -> Just True
-    'N' -> Just False
-    _   -> Nothing
-overtimePrompt _ = return ()
+getPlayerNumC :: Controller
+getPlayerNumC = Controller
+  { drawController   = drawPrompt playerNumPrompt
+  , handleController = \e -> do
+    promptHandler playerNumPrompt e
+    return True
+  }
+
+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
+  }
+
+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/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

@@ -30,12 +30,21 @@ module Mtlstats.Menu (
   gameTypeMenu
 ) 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 Lens.Micro ((^.), (.~), (?~))
+import Lens.Micro.Extras (view)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , getAppUserDataDirectory
+  , (</>)
+  )
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Config
 import Mtlstats.Types
 import Mtlstats.Types.Menu
 
@@ -60,7 +69,15 @@ 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' "Exit" $ do
+    db <- gets $ view database
+    liftIO $ do
+      dir <- getAppUserDataDirectory appName
+      let dbFile = dir </> dbFname
+      createDirectoryIfMissing True dir
+      encodeFile dbFile db
     return False
   ]
 

src/Mtlstats/Prompt.hs

@@ -19,6 +19,8 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Mtlstats.Prompt (
   -- * Prompt Functions
   drawPrompt,
@@ -30,20 +32,31 @@ module Mtlstats.Prompt (
   gameDayPrompt,
   otherTeamPrompt,
   homeScorePrompt,
-  awayScorePrompt
+  awayScorePrompt,
+  playerNumPrompt,
+  playerNamePrompt,
+  playerPosPrompt,
+  selectPlayerPrompt,
+  recordGoalPrompt,
+  recordAssistPrompt,
+  pMinPlayerPrompt,
+  assignPMinsPrompt
 ) where
 
 import Control.Monad (when)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
-import Lens.Micro ((^.), (.~), (?~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Lens.Micro.Extras (view)
 import Text.Read (readMaybe)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Config
+import Mtlstats.Format
 import Mtlstats.Types
+import Mtlstats.Util
 
 -- | Draws the prompt to the screen
 drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
@@ -63,8 +76,8 @@ promptHandler p (C.EventCharacter c) = let
    modify $ addChar c'
 promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
   modify removeChar
-promptHandler p (C.EventSpecialKey (C.KeyFunction k)) =
-  promptFunctionKey p k
+promptHandler p (C.EventSpecialKey k) =
+  promptSpecialKey p k
 promptHandler _ _ = return ()
 
 -- | Builds a string prompt
@@ -78,7 +91,7 @@ strPrompt pStr act = Prompt
   { promptDrawer     = drawSimplePrompt pStr
   , promptCharCheck  = const True
   , promptAction     = act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Builds a numeric prompt
@@ -92,7 +105,7 @@ numPrompt pStr act = Prompt
   { promptDrawer     = drawSimplePrompt pStr
   , promptCharCheck  = isDigit
   , promptAction     = \inStr -> forM_ (readMaybe inStr) act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Prompts for the game year
@@ -120,5 +133,119 @@ 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 .~)
+
+-- | 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 = Prompt
+  { promptDrawer = \s -> do
+    let sStr = s^.inputBuffer
+    C.drawString pStr
+    C.drawString sStr
+    (row, col) <- C.cursorPosition
+    C.drawString "\n\nPlayer select:\n"
+    let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
+    mapM_
+      (\(n, (_, p)) -> C.drawString $
+        "F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
+      sel
+    C.moveCursor row col
+  , promptCharCheck = const True
+  , promptAction = \sStr -> if null sStr
+    then callback Nothing
+    else do
+      players <- gets $ view $ database.dbPlayers
+      case playerSearchExact sStr players of
+        Just (n, _) -> callback $ Just n
+        Nothing -> do
+          mode <- gets $ view progMode
+          let
+            cps
+              = newCreatePlayerState
+              & cpsName .~ sStr
+              & cpsSuccessCallback .~ do
+                modify $ progMode .~ mode
+                pIndex <- pred . length <$> gets (view $ database.dbPlayers)
+                callback $ Just pIndex
+              & cpsFailureCallback .~ do
+                modify $ progMode .~ mode
+                callback Nothing
+          modify $ progMode .~ CreatePlayer cps
+  , promptSpecialKey = \case
+    C.KeyFunction n -> do
+      sStr    <- gets $ view inputBuffer
+      players <- gets $ view $ database.dbPlayers
+      modify $ inputBuffer .~ ""
+      let
+        fKey    = pred $ fromIntegral n
+        options = playerSearch sStr players
+        sel     = fst <$> nth fKey options
+      callback sel
+    _ -> return ()
+  }
+
+-- | 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
+
+pMinPlayerPrompt :: Prompt
+pMinPlayerPrompt = selectPlayerPrompt
+  "Assign penalty minutes to: " $
+  \case
+    Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
+    Just n  -> modify $ progMode.gameStateL.selectedPlayer ?~ n
+
+assignPMinsPrompt :: Prompt
+assignPMinsPrompt = numPrompt "Penalty minutes: " $
+  modify . assignPMins
+
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

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
-report width s = unlines $ fromMaybe [] $ do
+  -> [String]
+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,10 @@ module Mtlstats.Types (
   Controller (..),
   Action,
   ProgState (..),
-  GameState (..),
   ProgMode (..),
+  GameState (..),
   GameType (..),
+  CreatePlayerState (..),
   Database (..),
   Player (..),
   PlayerStats (..),
@@ -41,8 +42,10 @@ module Mtlstats.Types (
   database,
   progMode,
   inputBuffer,
+  scrollOffset,
   -- ** ProgMode Lenses
   gameStateL,
+  createPlayerStateL,
   -- ** GameState Lenses
   gameYear,
   gameMonth,
@@ -52,6 +55,20 @@ module Mtlstats.Types (
   homeScore,
   awayScore,
   overtimeFlag,
+  dataVerified,
+  pointsAccounted,
+  goalBy,
+  assistsBy,
+  gamePlayerStats,
+  confirmGoalDataFlag,
+  selectedPlayer,
+  pMinsRecorded,
+  -- ** CreatePlayerState Lenses
+  cpsNumber,
+  cpsName,
+  cpsPosition,
+  cpsSuccessCallback,
+  cpsFailureCallback,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -85,9 +102,12 @@ module Mtlstats.Types (
   gmsWins,
   gmsLosses,
   gmsOvertime,
+  gmsGoalsFor,
+  gmsGoalsAgainst,
   -- * Constructors
   newProgState,
   newGameState,
+  newCreatePlayerState,
   newDatabase,
   newPlayer,
   newPlayerStats,
@@ -103,12 +123,20 @@ module Mtlstats.Types (
   gameWon,
   gameLost,
   gameTied,
+  unaccountedPoints,
   -- ** GameStats Helpers
   gmsGames,
   gmsPoints,
   addGameStats,
   -- ** Player Helpers
-  pPoints
+  playerSearch,
+  playerSearchExact,
+  modifyPlayer,
+  playerSummary,
+  playerIsActive,
+  -- ** PlayerStats Helpers
+  psPoints,
+  addPlayerStats
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -124,6 +152,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
@@ -149,7 +180,22 @@ data ProgState = ProgState
   -- ^ The program's mode
   , _inputBuffer  :: String
   -- ^ Buffer for user input
-  } deriving (Eq, Show)
+  , _scrollOffset :: Int
+  -- ^ The scrolling offset for the display
+  }
+
+-- | The program mode
+data ProgMode
+  = MainMenu
+  | NewSeason
+  | NewGame GameState
+  | CreatePlayer CreatePlayerState
+
+instance Show ProgMode where
+  show MainMenu         = "MainMenu"
+  show NewSeason        = "NewSeason"
+  show (NewGame _)      = "NewGame"
+  show (CreatePlayer _) = "CreatePlayer"
 
 -- | The game state
 data GameState = GameState
@@ -169,21 +215,46 @@ data GameState = GameState
   -- ^ 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
+  , _selectedPlayer      :: Maybe Int
+  -- ^ Index number of the selected 'Player'
+  , _pMinsRecorded       :: Bool
+  -- ^ Set when the penalty mintes have been recorded
   } deriving (Eq, Show)
 
--- | The program mode
-data ProgMode
-  = MainMenu
-  | NewSeason
-  | NewGame GameState
-  deriving (Eq, Show)
-
 -- | The type of game
 data GameType
   = HomeGame
   | 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
+  }
+
 -- | Represents the database
 data Database = Database
   { _dbPlayers       :: [Player]
@@ -372,6 +443,10 @@ data GameStats = GameStats
   -- ^ Games lost
   , _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,17 +454,23 @@ 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
     , "losses"        .= l
     , "overtime"      .= ot
+    , "goals_for"     .= gf
+    , "goals_against" .= ga
     ]
-  toEncoding (GameStats w l ot) = pairs $
+  toEncoding (GameStats w l ot gf ga) = pairs $
     "wins"          .= w  <>
     "losses"        .= l  <>
-    "overtime" .= ot
+    "overtime"      .= ot <>
+    "goals_for"     .= gf <>
+    "goals_against" .= ga
 
 -- | Defines a user prompt
 data Prompt = Prompt
@@ -399,12 +480,13 @@ data Prompt = Prompt
   -- ^ Determines whether or not the character is valid
   , promptAction     :: String -> Action ()
   -- ^ Action to perform when the value is entered
-  , promptFunctionKey :: Integer -> Action ()
-  -- ^ Action to perform when a function key is pressed
+  , promptSpecialKey :: C.Key -> Action ()
+  -- ^ Action to perform when a special key is pressed
   }
 
 makeLenses ''ProgState
 makeLenses ''GameState
+makeLenses ''CreatePlayerState
 makeLenses ''Database
 makeLenses ''Player
 makeLenses ''PlayerStats
@@ -419,12 +501,20 @@ gameStateL = lens
     _          -> newGameState)
   (\_ gs -> NewGame gs)
 
+createPlayerStateL :: Lens' ProgMode CreatePlayerState
+createPlayerStateL = lens
+  (\case
+    CreatePlayer cps -> cps
+    _                -> newCreatePlayerState)
+  (\_ cps -> CreatePlayer cps)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
   { _database     = newDatabase
   , _progMode     = MainMenu
   , _inputBuffer  = ""
+  , _scrollOffset = 0
   }
 
 -- | Constructor for a 'GameState'
@@ -438,6 +528,24 @@ newGameState = GameState
   , _homeScore           = Nothing
   , _awayScore           = Nothing
   , _overtimeFlag        = Nothing
+  , _dataVerified        = False
+  , _pointsAccounted     = 0
+  , _goalBy              = Nothing
+  , _assistsBy           = []
+  , _gamePlayerStats     = M.empty
+  , _confirmGoalDataFlag = False
+  , _selectedPlayer      = Nothing
+  , _pMinsRecorded       = False
+  }
+
+-- | Constructor for a 'CreatePlayerState'
+newCreatePlayerState :: CreatePlayerState
+newCreatePlayerState = CreatePlayerState
+  { _cpsNumber          = Nothing
+  , _cpsName            = ""
+  , _cpsPosition        = ""
+  , _cpsSuccessCallback = return ()
+  , _cpsFailureCallback = return ()
   }
 
 -- | Constructor for a 'Database'
@@ -507,6 +615,8 @@ newGameStats = GameStats
   { _gmsWins         = 0
   , _gmsLosses       = 0
   , _gmsOvertime     = 0
+  , _gmsGoalsFor     = 0
+  , _gmsGoalsAgainst = 0
   }
 
 -- | Determines the team's score
@@ -545,15 +655,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
@@ -565,8 +686,74 @@ addGameStats s1 s2 = GameStats
   { _gmsWins         = s1^.gmsWins + s2^.gmsWins
   , _gmsLosses       = s1^.gmsLosses + s2^.gmsLosses
   , _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
+
+-- | 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
-pPoints s = s^.psGoals + s^.psAssists
+psPoints :: PlayerStats -> Int
+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

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

@@ -19,15 +19,29 @@ 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
 
 spec :: Spec
 spec = describe "Mtlstats.Actions" $ do
@@ -39,6 +53,16 @@ spec = describe "Mtlstats.Actions" $ do
   overtimeCheckSpec
   updateGameStatsSpec
   validateGameDateSpec
+  createPlayerSpec
+  addPlayerSpec
+  recordGoalAssistsSpec
+  awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
+  assignPMinsSpec
+  backHomeSpec
+  scrollUpSpec
+  scrollDownSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -48,7 +72,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 +85,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" $
@@ -193,6 +217,8 @@ updateGameStatsSpec = describe "updateGameStats" $ do
       & gmsWins         .~ 1
       & gmsLosses       .~ 1
       & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 1
 
     s t h a o = newProgState
       & progMode.gameStateL
@@ -204,71 +230,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)
         .  (gmsLosses       .~ hl)
         .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
       & dbAwayGameStats
         %~ (gmsWins         .~ aw)
         .  (gmsLosses       .~ al)
         .  (gmsOvertime     .~ ao)
+        .  (gmsGoalsFor     .~ af)
+        .  (gmsGoalsAgainst .~ aa)
 
   context "home win" $
     it "should record a home win" $ let
       s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 2 1 1 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)
-      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)
-      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)
-      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
-      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 +349,275 @@ 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"
+
+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]
+
+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)])
+      .  (selectedPlayer  .~ 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.selectedPlayer `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
@@ -351,3 +654,49 @@ 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

@@ -42,6 +42,7 @@ spec = describe "Mtlstats.Types" $ do
   gameStatsSpec
   databaseSpec
   gameStateLSpec
+  createPlayerStateLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -49,10 +50,17 @@ spec = describe "Mtlstats.Types" $ do
   gameWonSpec
   gameLostSpec
   gameTiedSpec
+  unaccountedPointsSpec
   gmsGamesSpec
   gmsPointsSpec
   addGameStatsSpec
-  pPointsSpec
+  playerSearchSpec
+  playerSearchExactSpec
+  modifyPlayerSpec
+  playerSummarySpec
+  playerIsActiveSpec
+  psPointsSpec
+  addPlayerStatsSpec
   Menu.spec
 
 playerSpec :: Spec
@@ -81,6 +89,34 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   ]
   where gs t = newGameState & gameType ?~ t
 
+createPlayerStateLSpec :: Spec
+createPlayerStateLSpec = describe "createPlayerStateL" $ do
+  context "getters" $ do
+    context "state missing" $ let
+      pm  = MainMenu
+      cps = pm^.createPlayerStateL
+      in it "should not have a number" $
+        cps^.cpsNumber `shouldBe` Nothing
+
+    context "existing state" $ let
+      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+      cps = pm^.createPlayerStateL
+      in it "should have a number of 1" $
+        cps^.cpsNumber `shouldBe` Just 1
+
+  context "setters" $ do
+    context "state missing" $ let
+      pm  = MainMenu
+      pm' = pm & createPlayerStateL.cpsNumber ?~ 1
+      in it "should set the player number to 1" $
+        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
+
+    context "existing state" $ let
+      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+      pm' = pm & createPlayerStateL.cpsNumber ?~ 2
+      in it "should set the player number to 2" $
+        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
+
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
   let
@@ -226,6 +262,8 @@ gameStats n = GameStats
   { _gmsWins         = n
   , _gmsLosses       = n + 1
   , _gmsOvertime     = n + 2
+  , _gmsGoalsFor     = n + 3
+  , _gmsGoalsAgainst = n + 4
   }
 
 gameStatsJSON :: Int -> Value
@@ -233,6 +271,8 @@ gameStatsJSON n = Object $ HM.fromList
   [ ( "wins",          toJSON n       )
   , ( "losses",        toJSON $ n + 1 )
   , ( "overtime",      toJSON $ n + 2 )
+  , ( "goals_for",     toJSON $ n + 3 )
+  , ( "goals_against", toJSON $ n + 4 )
   ]
 
 db :: Database
@@ -320,30 +360,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
       & homeScore    .~ h
       & awayScore    .~ a
+      & overtimeFlag .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gameLost gs `shouldBe` expected)
-  --  gameType,      homeScore, awayScore, expected
-  [ ( Just HomeGame, Just 1,    Just 1,    Just False )
-  , ( Just HomeGame, Just 1,    Just 2,    Just True  )
-  , ( Just HomeGame, Just 2,    Just 1,    Just False )
-  , ( Just AwayGame, Just 1,    Just 1,    Just False )
-  , ( Just AwayGame, Just 1,    Just 2,    Just False )
-  , ( Just AwayGame, Just 2,    Just 1,    Just True  )
-  , ( Nothing,       Just 1,    Just 2,    Nothing    )
-  , ( Just HomeGame, Nothing,   Just 1,    Nothing    )
-  , ( Just AwayGame, Nothing,   Just 1,    Nothing    )
-  , ( Just HomeGame, Just 1,    Nothing,   Nothing    )
-  , ( Just AwayGame, Just 1,    Nothing,   Nothing    )
-  , ( Nothing,       Nothing,   Nothing,   Nothing    )
+  --  gameType,      homeScore, awayScore, overtimeFlag, expected
+  [ ( Just HomeGame, Just 1,    Just 1,    Just False,   Just False )
+  , ( Just HomeGame, Just 1,    Just 2,    Just False,   Just True  )
+  , ( Just HomeGame, Just 1,    Just 2,    Just True,    Just False )
+  , ( Just HomeGame, Just 2,    Just 1,    Just False,   Just False )
+  , ( Just AwayGame, Just 1,    Just 1,    Just False,   Just False )
+  , ( Just AwayGame, Just 1,    Just 2,    Just False,   Just False )
+  , ( Just AwayGame, Just 2,    Just 1,    Just False,   Just True  )
+  , ( Just AwayGame, Just 2,    Just 1,    Just True,    Just False )
+  , ( Nothing,       Just 1,    Just 2,    Just False,   Nothing    )
+  , ( Just HomeGame, Nothing,   Just 1,    Just False,   Nothing    )
+  , ( Just AwayGame, Nothing,   Just 1,    Just False,   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 +410,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
       & gmsLosses   .~ l
+      & gmsOvertime .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gmsGames gs `shouldBe` expected)
-  --  wins, losses, expected
-  [ ( 0,    0,      0        )
-  , ( 1,    0,      1        )
-  , ( 0,    1,      1        )
-  , ( 1,    1,      2        )
-  , ( 2,    3,      5        )
+  --  wins, losses, overtime, expected
+  [ ( 0,    0,      0,        0        )
+  , ( 1,    0,      0,        1        )
+  , ( 0,    1,      0,        1        )
+  , ( 0,    0,      1,        1        )
+  , ( 1,    1,      1,        3        )
+  , ( 2,    3,      5,        10       )
   ]
 
 gmsPointsSpec :: Spec
 gmsPointsSpec = describe "gmsPoints" $ mapM_
   (\(w, l, ot, expected) -> let
-    gs = GameStats
-      { _gmsWins     = w
-      , _gmsLosses   = l
-      , _gmsOvertime = ot
-      }
+    gs
+      = newGameStats
+      & gmsWins     .~ w
+      & gmsLosses   .~ l
+      & gmsOvertime .~ ot
     in context (show gs) $
       it ("should be " ++ show expected) $
         gmsPoints gs `shouldBe` expected)
@@ -409,26 +487,109 @@ addGameStatsSpec = describe "addGameStats" $
 
     s1 = GameStats
       { _gmsWins         = 1
-      , _gmsLosses   = 3
-      , _gmsOvertime = 2
+      , _gmsLosses       = 2
+      , _gmsOvertime     = 3
+      , _gmsGoalsFor     = 4
+      , _gmsGoalsAgainst = 5
       }
 
     s2 = GameStats
-      { _gmsWins     = 4
-      , _gmsLosses   = 6
-      , _gmsOvertime = 5
+      { _gmsWins         = 6
+      , _gmsLosses       = 7
+      , _gmsOvertime     = 8
+      , _gmsGoalsFor     = 9
+      , _gmsGoalsAgainst = 10
       }
 
     expected = GameStats
-      { _gmsWins     = 5
+      { _gmsWins         = 7
       , _gmsLosses       = 9
-      , _gmsOvertime = 7
+      , _gmsOvertime     = 11
+      , _gmsGoalsFor     = 13
+      , _gmsGoalsAgainst = 15
       }
 
     in addGameStats s1 s2 `shouldBe` expected
 
-pPointsSpec :: Spec
-pPointsSpec = describe "pPoints" $ mapM_
+playerSearchSpec :: Spec
+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"
+
+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 +598,46 @@ 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
+
+joe :: Player
+joe = newPlayer 2 "Joe" "center"
+
+bob :: Player
+bob = newPlayer 3 "Bob" "defense"
+
+steve :: Player
+steve = newPlayer 5 "Steve" "forward"

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]