version 0.4.0

year-to-date statistics

ChangeLog.md

@@ -1,5 +1,16 @@
 # Changelog for mtlstats
 
+## 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

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.2.0
+version:             0.4.0
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"
@@ -22,6 +22,7 @@ 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

src/Mtlstats/Actions.hs

@@ -32,15 +32,24 @@ module Mtlstats.Actions
   , 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
@@ -82,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)
+      %~ (gmsWins         +~ hw)
+      .  (gmsLosses       +~ hl)
+      .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
     & database.dbAwayGameStats
-      %~ (gmsWins +~ aw)
-      .  (gmsLosses +~ al)
-      .  (gmsOvertime +~ aot)
+      %~ (gmsWins         +~ aw)
+      .  (gmsLosses       +~ al)
+      .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
 
 -- | Validates the game date
 validateGameDate :: ProgState -> ProgState
@@ -136,7 +156,22 @@ addPlayer s = fromMaybe s $ do
     pos    = cps^.cpsPosition
     player = newPlayer num name pos
   Just $ s & database.dbPlayers
-    %~ (player:)
+    %~ (++[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
@@ -145,10 +180,70 @@ awardGoal
   -> ProgState
   -> ProgState
 awardGoal n ps = ps
-  &  database.dbPlayers
-  %~ map
-     (\(i, p) -> if i == n
-       then p
-         & pYtd.psGoals      %~ succ
-         & pLifetime.psGoals %~ succ
-       else p) . zip [0..]
+  & 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

@@ -36,3 +36,7 @@ appName = "mtlstats"
 -- | The database filename
 dbFname :: String
 dbFname = "database.json"
+
+-- | The maximum number of assists
+maxAssists :: Int
+maxAssists = 2

src/Mtlstats/Control.hs

@@ -24,8 +24,8 @@ module Mtlstats.Control (dispatch) where
 import Control.Monad (join, when)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (toUpper)
-import Data.Maybe (fromJust)
-import Lens.Micro ((^.), (.~))
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Lens.Micro ((^.), (.~), (%~))
 import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
@@ -36,6 +36,7 @@ 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
@@ -53,7 +54,9 @@ dispatch s = case s^.progMode of
     | null $ gs^.awayScore            -> awayScoreC
     | null $ gs^.overtimeFlag         -> overtimeFlagC
     | not $ gs^.dataVerified          -> verifyDataC
-    | fromJust (unaccountedPoints gs) -> recordGoalC
+    | fromJust (unaccountedPoints gs) -> goalInput gs
+    | isJust $ gs^.selectedPlayer     -> getPMinsC
+    | not $ gs^.pMinsRecorded         -> pMinPlayerC
     | otherwise                       -> reportC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
@@ -182,32 +185,105 @@ verifyDataC = Controller
     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 = s^.database.dbGames
-    goal = succ $ s^.progMode.gameStateL.pointsAccounted
+    (game, goal) = gameGoal s
     in drawPrompt (recordGoalPrompt game goal) s
   , handleController = \e -> do
-    game <- gets $ view $ database.dbGames
-    goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
+    (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
-    (_, cols) <- C.windowSize
-    C.drawString $ report (fromInteger $ pred cols) s
+    (rows, cols) <- C.windowSize
+    C.drawString $ unlines $ slice
+      (s^.scrollOffset)
+      (fromInteger $ pred rows)
+      (report (fromInteger $ pred cols) s)
     return C.CursorInvisible
   , handleController = \e -> do
-    when
-      (case e of
-        C.EventCharacter _  -> True
-        C.EventSpecialKey _ -> True
-        _                   -> False) $
-      modify $ progMode .~ MainMenu
+    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
   }
 
@@ -258,3 +334,15 @@ confirmCreatePlayerC = Controller
       Nothing -> return ()
     return True
   }
+
+gameGoal :: ProgState -> (Int, Int)
+gameGoal s =
+  ( s^.database.dbGames
+  , succ $ s^.progMode.gameStateL.pointsAccounted
+  )
+
+gameGoalAssist :: ProgState -> (Int, Int, Int)
+gameGoalAssist s = let
+  (game, goal) = gameGoal s
+  assist       = succ $ length $ s^.progMode.gameStateL.assistsBy
+  in (game, goal, assist)

src/Mtlstats/Prompt.hs

@@ -38,6 +38,9 @@ module Mtlstats.Prompt (
   playerPosPrompt,
   selectPlayerPrompt,
   recordGoalPrompt,
+  recordAssistPrompt,
+  pMinPlayerPrompt,
+  assignPMinsPrompt
 ) where
 
 import Control.Monad (when)
@@ -167,23 +170,26 @@ selectPlayerPrompt pStr callback = Prompt
       sel
     C.moveCursor row col
   , promptCharCheck = const True
-  , promptAction = \sStr -> 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
-              callback (Just 0)
-            & cpsFailureCallback .~ do
-              modify $ progMode .~ mode
-              callback Nothing
-        modify $ progMode .~ CreatePlayer cps
+  , 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
@@ -205,13 +211,41 @@ recordGoalPrompt
   -- ^ The goal number
   -> Prompt
 recordGoalPrompt game goal = selectPlayerPrompt
-  ("*** GAME " ++ padNum 2 game ++ " ***\n" ++
-   "Who scored goal number " ++ show goal ++ "? ") $
+  (  "*** 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 -> return ()
-    Just n  -> modify
-      $ awardGoal n
-      . (progMode.gameStateL.pointsAccounted %~ succ)
+    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, gameDate) 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,8 +36,16 @@ 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
@@ -63,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"
@@ -72,12 +84,25 @@ 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
@@ -85,10 +110,55 @@ gameDate gs = fromMaybe "" $ do
   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

@@ -42,6 +42,7 @@ module Mtlstats.Types (
   database,
   progMode,
   inputBuffer,
+  scrollOffset,
   -- ** ProgMode Lenses
   gameStateL,
   createPlayerStateL,
@@ -56,6 +57,12 @@ module Mtlstats.Types (
   overtimeFlag,
   dataVerified,
   pointsAccounted,
+  goalBy,
+  assistsBy,
+  gamePlayerStats,
+  confirmGoalDataFlag,
+  selectedPlayer,
+  pMinsRecorded,
   -- ** CreatePlayerState Lenses
   cpsNumber,
   cpsName,
@@ -95,6 +102,8 @@ module Mtlstats.Types (
   gmsWins,
   gmsLosses,
   gmsOvertime,
+  gmsGoalsFor,
+  gmsGoalsAgainst,
   -- * Constructors
   newProgState,
   newGameState,
@@ -120,9 +129,14 @@ module Mtlstats.Types (
   gmsPoints,
   addGameStats,
   -- ** Player Helpers
-  pPoints,
   playerSearch,
-  playerSearchExact
+  playerSearchExact,
+  modifyPlayer,
+  playerSummary,
+  playerIsActive,
+  -- ** PlayerStats Helpers
+  psPoints,
+  addPlayerStats
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -139,6 +153,7 @@ 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)
@@ -159,12 +174,14 @@ 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
+  , _scrollOffset :: Int
+  -- ^ The scrolling offset for the display
   }
 
 -- | The program mode
@@ -182,25 +199,40 @@ instance Show ProgMode where
 
 -- | The game state
 data GameState = GameState
-  { _gameYear        :: Maybe Int
+  { _gameYear            :: Maybe Int
   -- ^ The year the game took place
-  , _gameMonth       :: Maybe Int
+  , _gameMonth           :: Maybe Int
   -- ^ The month the game took place
-  , _gameDay         :: Maybe Int
+  , _gameDay             :: Maybe Int
   -- ^ The day of the month the game took place
-  , _gameType        :: Maybe GameType
+  , _gameType            :: Maybe GameType
   -- ^ The type of game (home/away)
-  , _otherTeam       :: String
+  , _otherTeam           :: String
   -- ^ The name of the other team
-  , _homeScore       :: Maybe Int
+  , _homeScore           :: Maybe Int
   -- ^ The home team's score
-  , _awayScore       :: Maybe Int
+  , _awayScore           :: Maybe Int
   -- ^ The away team's score
-  , _overtimeFlag    :: Maybe Bool
+  , _overtimeFlag        :: Maybe Bool
   -- ^ Indicates whether or not the game went into overtime
-  , _dataVerified    :: Bool
+  , _dataVerified        :: Bool
   -- ^ Set to 'True' when the user confirms the entered data
-  , _pointsAccounted :: Int
+  , _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 type of game
@@ -405,12 +437,16 @@ instance ToJSON GoalieStats where
 
 -- | 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
@@ -418,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
-    [ "wins"     .= w
-    , "losses"   .= l
-    , "overtime" .= ot
+  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 $
-    "wins"     .= w  <>
-    "losses"   .= l  <>
-    "overtime" .= ot
+  toEncoding (GameStats w l ot gf ga) = pairs $
+    "wins"          .= w  <>
+    "losses"        .= l  <>
+    "overtime"      .= ot <>
+    "goals_for"     .= gf <>
+    "goals_against" .= ga
 
 -- | Defines a user prompt
 data Prompt = Prompt
@@ -469,24 +511,31 @@ createPlayerStateL = lens
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
-  { _database    = newDatabase
-  , _progMode    = MainMenu
-  , _inputBuffer = ""
+  { _database     = newDatabase
+  , _progMode     = MainMenu
+  , _inputBuffer  = ""
+  , _scrollOffset = 0
   }
 
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameYear        = Nothing
-  , _gameMonth       = Nothing
-  , _gameDay         = Nothing
-  , _gameType        = Nothing
-  , _otherTeam       = ""
-  , _homeScore       = Nothing
-  , _awayScore       = Nothing
-  , _overtimeFlag    = Nothing
-  , _dataVerified    = False
-  , _pointsAccounted = 0
+  { _gameYear            = Nothing
+  , _gameMonth           = Nothing
+  , _gameDay             = Nothing
+  , _gameType            = Nothing
+  , _otherTeam           = ""
+  , _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'
@@ -563,9 +612,11 @@ newGoalieStats = GoalieStats
 -- | Constructor for a 'GameStats' value
 newGameStats :: GameStats
 newGameStats = GameStats
-  { _gmsWins     = 0
-  , _gmsLosses   = 0
-  , _gmsOvertime = 0
+  { _gmsWins         = 0
+  , _gmsLosses       = 0
+  , _gmsOvertime     = 0
+  , _gmsGoalsFor     = 0
+  , _gmsGoalsAgainst = 0
   }
 
 -- | Determines the team's score
@@ -632,15 +683,13 @@ 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
-  , _gmsLosses   = s1^.gmsLosses + s2^.gmsLosses
-  , _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
+  { _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
   }
 
--- | Calculates a player's points
-pPoints :: PlayerStats -> Int
-pPoints s = s^.psGoals + s^.psAssists
-
 -- | Searches through a list of players
 playerSearch
   :: String
@@ -667,3 +716,44 @@ playerSearchExact sStr =
   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
+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

@@ -19,11 +19,59 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Util (nth) where
+module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
 
-nth :: Int -> [a] -> Maybe a
+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
@@ -41,7 +55,14 @@ spec = describe "Mtlstats.Actions" $ do
   validateGameDateSpec
   createPlayerSpec
   addPlayerSpec
+  recordGoalAssistsSpec
   awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
+  assignPMinsSpec
+  backHomeSpec
+  scrollUpSpec
+  scrollDownSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -193,9 +214,11 @@ updateGameStatsSpec = describe "updateGameStats" $ do
   let
 
     baseStats = newGameStats
-      & gmsWins     .~ 1
-      & gmsLosses   .~ 1
-      & gmsOvertime .~ 1
+      & gmsWins         .~ 1
+      & gmsLosses       .~ 1
+      & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 1
 
     s t h a o = newProgState
       & progMode.gameStateL
@@ -207,75 +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)
+        %~ (gmsWins         .~ hw)
+        .  (gmsLosses       .~ hl)
+        .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
       & dbAwayGameStats
-        %~ (gmsWins     .~ aw)
-        .  (gmsLosses   .~ al)
-        .  (gmsOvertime .~ ao)
+        %~ (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 overtime" $ let
       s'  = s (Just HomeGame) (Just 1) (Just 2) (Just True)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 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 overtime" $ let
       s'  = s (Just AwayGame) (Just 2) (Just 1) (Just True)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 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)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing home score" $
     it "should not change anything" $ let
       s'  = s (Just HomeGame) Nothing (Just 1) (Just True)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing away score" $
     it "should not change anything" $ let
       s'  = s (Just HomeGame) (Just 1) Nothing (Just True)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
   context "missing overtime flag" $
     it "should not change anything" $ let
       s'  = s (Just HomeGame) (Just 1) (Just 2) Nothing
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 1 1 1 1 1
+      in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
 
 validateGameDateSpec :: Spec
 validateGameDateSpec = describe "validateGameDate" $ do
@@ -334,7 +361,7 @@ addPlayerSpec = describe "addPlayer" $ do
     p1 = newPlayer 1 "Joe" "centre"
     p2 = newPlayer 2 "Bob" "defense"
     db = newDatabase
-      & dbPlayers .~ [p2]
+      & dbPlayers .~ [p1]
     s pm = newProgState
       & progMode .~ pm
       & database .~ db
@@ -342,15 +369,76 @@ addPlayerSpec = describe "addPlayer" $ do
   context "data available" $
     it "should create the player" $ let
       s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
-        & cpsNumber   ?~ 1
-        & cpsName     .~ "Joe"
-        & cpsPosition .~ "centre"
+        & 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` [p2]
+      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
@@ -366,31 +454,34 @@ awardGoalSpec = describe "awardGoal" $ do
     db
       = newDatabase
       & dbPlayers .~ [joe, bob]
+    joeStats
+      = newPlayerStats
+      & psGoals .~ 1
     ps
       = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
       & database .~ db
 
-  context "Joe" $ do
-    let
-      ps'    = awardGoal 0 ps
-      player = head $ ps'^.database.dbPlayers
+  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 Joe's year-to-date goals" $
-      player^.pYtd.psGoals `shouldBe` 2
+        it ("should increment " ++ pName ++ "'s year-to-date goals") $
+          player^.pYtd.psGoals `shouldBe` ytd
 
-    it "should increment Joe's lifetime goals" $
-      player^.pLifetime.psGoals `shouldBe` 3
+        it ("should increment " ++ pName ++ "'s lifetime goals") $
+          player^.pLifetime.psGoals `shouldBe` lt
 
-  context "Bob" $ do
-    let
-      ps' = awardGoal 1 ps
-      player = last $ ps'^.database.dbPlayers
-
-    it "should increment Bob's year-to-data goals" $
-      player^.pYtd.psGoals `shouldBe` 4
-
-    it "should increment Bob's lifetime goals" $
-      player^.pLifetime.psGoals `shouldBe` 5
+        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
@@ -402,6 +493,131 @@ awardGoalSpec = describe "awardGoal" $ do
     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
@@ -438,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/ReportSpec.hs

@@ -28,8 +28,9 @@ import Mtlstats.Report
 import Mtlstats.Types
 
 spec :: Spec
-spec = describe "Mtlstats.Report"
+spec = describe "Mtlstats.Report" $ do
   gameDateSpec
+  playerNameColWidthSpec
 
 gameDateSpec :: Spec
 gameDateSpec = describe "gameDate" $ do
@@ -45,3 +46,20 @@ gameDateSpec = describe "gameDate" $ do
   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/TypesSpec.hs

@@ -54,9 +54,13 @@ spec = describe "Mtlstats.Types" $ do
   gmsGamesSpec
   gmsPointsSpec
   addGameStatsSpec
-  pPointsSpec
   playerSearchSpec
   playerSearchExactSpec
+  modifyPlayerSpec
+  playerSummarySpec
+  playerIsActiveSpec
+  psPointsSpec
+  addPlayerStatsSpec
   Menu.spec
 
 playerSpec :: Spec
@@ -255,16 +259,20 @@ goalieStatsJSON n = Object $ HM.fromList
 
 gameStats :: Int -> GameStats
 gameStats n = GameStats
-  { _gmsWins     = n
-  , _gmsLosses   = n + 1
-  , _gmsOvertime = n + 2
+  { _gmsWins         = n
+  , _gmsLosses       = n + 1
+  , _gmsOvertime     = n + 2
+  , _gmsGoalsFor     = n + 3
+  , _gmsGoalsAgainst = n + 4
   }
 
 gameStatsJSON :: Int -> Value
 gameStatsJSON n = Object $ HM.fromList
-  [ ( "wins",     toJSON n       )
-  , ( "losses",   toJSON $ n + 1 )
-  , ( "overtime", toJSON $ n + 2 )
+  [ ( "wins",          toJSON n       )
+  , ( "losses",        toJSON $ n + 1 )
+  , ( "overtime",      toJSON $ n + 2 )
+  , ( "goals_for",     toJSON $ n + 3 )
+  , ( "goals_against", toJSON $ n + 4 )
   ]
 
 db :: Database
@@ -456,11 +464,11 @@ gmsGamesSpec = describe "gmsGames" $ mapM_
 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)
@@ -478,43 +486,31 @@ addGameStatsSpec = describe "addGameStats" $
   it "should add the values" $ let
 
     s1 = GameStats
-      { _gmsWins     = 1
-      , _gmsLosses   = 3
-      , _gmsOvertime = 2
+      { _gmsWins         = 1
+      , _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
-      , _gmsLosses   = 9
-      , _gmsOvertime = 7
+      { _gmsWins         = 7
+      , _gmsLosses       = 9
+      , _gmsOvertime     = 11
+      , _gmsGoalsFor     = 13
+      , _gmsGoalsAgainst = 15
       }
 
     in addGameStats s1 s2 `shouldBe` expected
 
-pPointsSpec :: Spec
-pPointsSpec = describe "pPoints" $ mapM_
-  (\(goals, assists, points) -> let
-    desc = "goals: " ++ show goals ++
-      ", assists: " ++ show assists
-    stats = newPlayerStats &
-      psGoals   .~ goals &
-      psAssists .~ assists
-    in context desc $
-      it ("should be " ++ show points) $
-        pPoints stats `shouldBe` points)
-  --  goals, assists, points
-  [ ( 0,     0,       0      )
-  , ( 1,     0,       1      )
-  , ( 0,     1,       1      )
-  , ( 2,     3,       5      )
-  ]
-
 playerSearchSpec :: Spec
 playerSearchSpec = describe "playerSearch" $ mapM_
   (\(sStr, expected) -> context sStr $
@@ -542,6 +538,101 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
   , ( "",      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
+    stats = newPlayerStats &
+      psGoals   .~ goals &
+      psAssists .~ assists
+    in context desc $
+      it ("should be " ++ show 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"
 

test/UtilSpec.hs

@@ -21,13 +21,17 @@ 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"
+spec = describe "Mtlstats.Util" $ do
   nthSpec
+  modifyNthSpec
+  updateMapSpec
+  sliceSpec
 
 nthSpec :: Spec
 nthSpec = describe "nth" $ mapM_
@@ -42,3 +46,49 @@ nthSpec = describe "nth" $ mapM_
   , ( 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]