version 0.3.0

Show game statistics in report

ChangeLog.md

@@ -1,5 +1,10 @@
 # Changelog for mtlstats
 
+## 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.3.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,10 +32,14 @@ module Mtlstats.Actions
   , validateGameDate
   , createPlayer
   , addPlayer
+  , recordGoalAssists
   , awardGoal
+  , awardAssist
+  , resetGoalData
   ) 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, (^.), (&), (.~), (?~), (%~), (+~))
@@ -82,26 +86,37 @@ overtimeCheck s
 -- | Adjusts the game stats based on the results of the current game
 updateGameStats :: ProgState -> ProgState
 updateGameStats s = fromMaybe s $ do
-  gType <- s^.progMode.gameStateL.gameType
+  let gs = s^.progMode.gameStateL
-  won   <- gameWon $ s^.progMode.gameStateL
+  gType  <- gs^.gameType
-  lost  <- gameLost $ s^.progMode.gameStateL
+  won    <- gameWon gs
-  ot    <- s^.progMode.gameStateL.overtimeFlag
+  lost   <- gameLost gs
+  ot     <- gs^.overtimeFlag
+  tScore <- teamScore gs
+  oScore <- otherScore gs
   let
     hw  = if gType == HomeGame && won then 1 else 0
     hl  = if gType == HomeGame && lost then 1 else 0
     hot = if gType == HomeGame && ot then 1 else 0
+    hgf = if gType == HomeGame then tScore else 0
+    hga = if gType == HomeGame then oScore else 0
     aw  = if gType == AwayGame && won then 1 else 0
     al  = if gType == AwayGame && lost then 1 else 0
     aot = if gType == AwayGame && ot then 1 else 0
+    agf = if gType == AwayGame then tScore else 0
+    aga = if gType == AwayGame then oScore else 0
   Just $ s
     & database.dbHomeGameStats
-      %~ (gmsWins +~ hw)
+      %~ (gmsWins         +~ hw)
-      .  (gmsLosses +~ hl)
+      .  (gmsLosses       +~ hl)
-      .  (gmsOvertime +~ hot)
+      .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
     & database.dbAwayGameStats
-      %~ (gmsWins +~ aw)
+      %~ (gmsWins         +~ aw)
-      .  (gmsLosses +~ al)
+      .  (gmsLosses       +~ al)
-      .  (gmsOvertime +~ aot)
+      .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
 
 -- | Validates the game date
 validateGameDate :: ProgState -> ProgState
@@ -136,7 +151,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 +175,38 @@ awardGoal
   -> ProgState
   -> ProgState
 awardGoal n ps = ps
-  &  database.dbPlayers
+  & progMode.gameStateL.gamePlayerStats %~
-  %~ map
+    (\m -> let
-     (\(i, p) -> if i == n
+      stats = M.findWithDefault newPlayerStats n m
-       then p
+      in M.insert n (stats & psGoals %~ succ) m)
-         & pYtd.psGoals      %~ succ
+  & database.dbPlayers %~ map
-         & pLifetime.psGoals %~ succ
+    (\(i, p) -> if i == n
-       else p) . zip [0..]
+      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)

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

@@ -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,7 @@ 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
     | otherwise                       -> reportC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
@@ -182,19 +183,64 @@ 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
+    (game, goal) = gameGoal s
-    goal = succ $ s^.progMode.gameStateL.pointsAccounted
     in drawPrompt (recordGoalPrompt game goal) s
   , handleController = \e -> do
-    game <- gets $ view $ database.dbGames
+    (game, goal) <- gets gameGoal
-    goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
     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
+  }
+
 reportC :: Controller
 reportC = Controller
   { drawController = \s -> do
@@ -258,3 +304,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,7 @@ module Mtlstats.Prompt (
   playerPosPrompt,
   selectPlayerPrompt,
   recordGoalPrompt,
+  recordAssistPrompt
 ) where
 
 import Control.Monad (when)
@@ -167,23 +168,26 @@ selectPlayerPrompt pStr callback = Prompt
       sel
     C.moveCursor row col
   , promptCharCheck = const True
-  , promptAction = \sStr -> do
+  , promptAction = \sStr -> if null sStr
-    players <- gets $ view $ database.dbPlayers
+    then callback Nothing
-    case playerSearchExact sStr players of
+    else do
-      Just (n, _) -> callback $ Just n
+      players <- gets $ view $ database.dbPlayers
-      Nothing -> do
+      case playerSearchExact sStr players of
-        mode <- gets $ view progMode
+        Just (n, _) -> callback $ Just n
-        let
+        Nothing -> do
-          cps
+          mode <- gets $ view progMode
-            = newCreatePlayerState
+          let
-            & cpsName .~ sStr
+            cps
-            & cpsSuccessCallback .~ do
+              = newCreatePlayerState
-              modify $ progMode .~ mode
+              & cpsName .~ sStr
-              callback (Just 0)
+              & cpsSuccessCallback .~ do
-            & cpsFailureCallback .~ do
+                modify $ progMode .~ mode
-              modify $ progMode .~ mode
+                pIndex <- pred . length <$> gets (view $ database.dbPlayers)
-              callback Nothing
+                callback $ Just pIndex
-        modify $ progMode .~ CreatePlayer cps
+              & cpsFailureCallback .~ do
+                modify $ progMode .~ mode
+                callback Nothing
+          modify $ progMode .~ CreatePlayer cps
   , promptSpecialKey = \case
     C.KeyFunction n -> do
       sStr    <- gets $ view inputBuffer
@@ -205,13 +209,30 @@ recordGoalPrompt
   -- ^ The goal number
   -> Prompt
 recordGoalPrompt game goal = selectPlayerPrompt
-  ("*** GAME " ++ padNum 2 game ++ " ***\n" ++
+  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
-   "Who scored goal number " ++ show goal ++ "? ") $
+  ++ "Who scored goal number " ++ show goal ++ "? "
-  \case
+  ) $ modify . (progMode.gameStateL.goalBy .~)
-    Nothing -> return ()
+
-    Just n  -> modify
+-- | Prompts for a player who assisted the goal
-      $ awardGoal n
+recordAssistPrompt
-      . (progMode.gameStateL.pointsAccounted %~ succ)
+  :: 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
 
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Report.hs

@@ -21,12 +21,14 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Report (report, gameDate) 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
@@ -37,18 +39,24 @@ report
   -> String
 report width s = unlines $ fromMaybe [] $ do
   let
-    db     = s^.database
+    db      = s^.database
-    gs     = s^.progMode.gameStateL
+    gs      = s^.progMode.gameStateL
-    gNum   = db^.dbGames
+    gNum    = db^.dbGames
-    date   = gameDate gs
+    date    = gameDate gs
-    hTeam  = homeTeam gs
+    hTeam   = homeTeam gs
-    aTeam  = awayTeam gs
+    aTeam   = awayTeam gs
-    hStats = db^.dbHomeGameStats
+    hStats  = db^.dbHomeGameStats
-    aStats = db^.dbAwayGameStats
+    aStats  = db^.dbAwayGameStats
-    tStats = addGameStats hStats aStats
+    tStats  = addGameStats hStats aStats
+    players = db^.dbPlayers
   hScore <- gs^.homeScore
   aScore <- gs^.awayScore
-  Just
+  pStats <- mapM
+    (\(n, stats) -> do
+      player <- nth n players
+      Just (player, stats))
+    (M.toList $ gs^.gamePlayerStats)
+  Just $
     [ overlay
       ("GAME NUMBER " ++ padNum 2 gNum)
       (centre width
@@ -63,6 +71,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,11 +82,30 @@ 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
-    ]
+    , ""
+    , centre width "GAME STATISTICS"
+    , ""
+    , centre width
+      $  "NO. "
+      ++ left 20 "PLAYER"
+      ++ right 3 "G"
+      ++ right 6 "A"
+      ++ right 6 "P"
+      ++ right 6 "PM"
+    ] ++ map
+      (\(p, stats) -> centre width
+        $  right 2 (show $ p^.pNumber)
+        ++ "  "
+        ++ left 20 (p^.pName)
+        ++ right 3 (show $ stats^.psGoals)
+        ++ right 6 (show $ stats^.psAssists)
+        ++ right 6 (show $ pPoints stats)
+        ++ right 6 (show $ stats^.psPMin))
+      pStats
 
 gameDate :: GameState -> String
 gameDate gs = fromMaybe "" $ do
@@ -91,4 +120,6 @@ showStats 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

@@ -56,6 +56,10 @@ module Mtlstats.Types (
   overtimeFlag,
   dataVerified,
   pointsAccounted,
+  goalBy,
+  assistsBy,
+  gamePlayerStats,
+  confirmGoalDataFlag,
   -- ** CreatePlayerState Lenses
   cpsNumber,
   cpsName,
@@ -95,6 +99,8 @@ module Mtlstats.Types (
   gmsWins,
   gmsLosses,
   gmsOvertime,
+  gmsGoalsFor,
+  gmsGoalsAgainst,
   -- * Constructors
   newProgState,
   newGameState,
@@ -122,7 +128,9 @@ module Mtlstats.Types (
   -- ** Player Helpers
   pPoints,
   playerSearch,
-  playerSearchExact
+  playerSearchExact,
+  modifyPlayer,
+  playerSummary
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -139,6 +147,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)
@@ -182,25 +191,36 @@ 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
   } deriving (Eq, Show)
 
 -- | The type of game
@@ -405,12 +425,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 +442,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
+    [ "wins"          .= w
-    , "losses"   .= l
+    , "losses"        .= l
-    , "overtime" .= ot
+    , "overtime"      .= ot
+    , "goals_for"     .= gf
+    , "goals_against" .= ga
     ]
-  toEncoding (GameStats w l ot) = pairs $
+  toEncoding (GameStats w l ot gf ga) = pairs $
-    "wins"     .= w  <>
+    "wins"          .= w  <>
-    "losses"   .= l  <>
+    "losses"        .= l  <>
-    "overtime" .= ot
+    "overtime"      .= ot <>
+    "goals_for"     .= gf <>
+    "goals_against" .= ga
 
 -- | Defines a user prompt
 data Prompt = Prompt
@@ -477,16 +507,20 @@ newProgState = ProgState
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameYear        = Nothing
+  { _gameYear            = Nothing
-  , _gameMonth       = Nothing
+  , _gameMonth           = Nothing
-  , _gameDay         = Nothing
+  , _gameDay             = Nothing
-  , _gameType        = Nothing
+  , _gameType            = Nothing
-  , _otherTeam       = ""
+  , _otherTeam           = ""
-  , _homeScore       = Nothing
+  , _homeScore           = Nothing
-  , _awayScore       = Nothing
+  , _awayScore           = Nothing
-  , _overtimeFlag    = Nothing
+  , _overtimeFlag        = Nothing
-  , _dataVerified    = False
+  , _dataVerified        = False
-  , _pointsAccounted = 0
+  , _pointsAccounted     = 0
+  , _goalBy              = Nothing
+  , _assistsBy           = []
+  , _gamePlayerStats     = M.empty
+  , _confirmGoalDataFlag = False
   }
 
 -- | Constructor for a 'CreatePlayerState'
@@ -563,9 +597,11 @@ newGoalieStats = GoalieStats
 -- | Constructor for a 'GameStats' value
 newGameStats :: GameStats
 newGameStats = GameStats
-  { _gmsWins     = 0
+  { _gmsWins         = 0
-  , _gmsLosses   = 0
+  , _gmsLosses       = 0
-  , _gmsOvertime = 0
+  , _gmsOvertime     = 0
+  , _gmsGoalsFor     = 0
+  , _gmsGoalsAgainst = 0
   }
 
 -- | Determines the team's score
@@ -632,9 +668,11 @@ gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
 -- | Adds two 'GameStats' values together
 addGameStats :: GameStats -> GameStats -> GameStats
 addGameStats s1 s2 = GameStats
-  { _gmsWins     = s1^.gmsWins + s2^.gmsWins
+  { _gmsWins         = s1^.gmsWins + s2^.gmsWins
-  , _gmsLosses   = s1^.gmsLosses + s2^.gmsLosses
+  , _gmsLosses       = s1^.gmsLosses + s2^.gmsLosses
-  , _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
+  , _gmsOvertime     = s1^.gmsOvertime + s2^.gmsOvertime
+  , _gmsGoalsFor     = s1^.gmsGoalsFor + s2^.gmsGoalsFor
+  , _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
   }
 
 -- | Calculates a player's points
@@ -667,3 +705,23 @@ 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

test/ActionsSpec.hs

@@ -22,9 +22,10 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
+import qualified Data.Map as M
 import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import System.Random (randomRIO)
-import Test.Hspec (Spec, context, describe, it, shouldBe, shouldNotBe)
+import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
 
 import Mtlstats.Actions
 import Mtlstats.Types
@@ -41,7 +42,10 @@ spec = describe "Mtlstats.Actions" $ do
   validateGameDateSpec
   createPlayerSpec
   addPlayerSpec
+  recordGoalAssistsSpec
   awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -193,9 +197,11 @@ updateGameStatsSpec = describe "updateGameStats" $ do
   let
 
     baseStats = newGameStats
-      & gmsWins     .~ 1
+      & gmsWins         .~ 1
-      & gmsLosses   .~ 1
+      & gmsLosses       .~ 1
-      & gmsOvertime .~ 1
+      & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 1
 
     s t h a o = newProgState
       & progMode.gameStateL
@@ -207,75 +213,79 @@ updateGameStatsSpec = describe "updateGameStats" $ do
         %~ (dbHomeGameStats .~ baseStats)
         .  (dbAwayGameStats .~ baseStats)
 
-    db hw hl ho aw al ao = newDatabase
+    db hw hl ho hf ha aw al ao af aa = newDatabase
       & dbHomeGameStats
-        %~ (gmsWins     .~ hw)
+        %~ (gmsWins         .~ hw)
-        .  (gmsLosses   .~ hl)
+        .  (gmsLosses       .~ hl)
-        .  (gmsOvertime .~ ho)
+        .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
       & dbAwayGameStats
-        %~ (gmsWins     .~ aw)
+        %~ (gmsWins         .~ aw)
-        .  (gmsLosses   .~ al)
+        .  (gmsLosses       .~ al)
-        .  (gmsOvertime .~ ao)
+        .  (gmsOvertime     .~ ao)
+        .  (gmsGoalsFor     .~ af)
+        .  (gmsGoalsAgainst .~ aa)
 
   context "home win" $
     it "should record a home win" $ let
       s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 2 1 1 1 1 1
+      in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
 
   context "home loss" $
     it "should record a home loss" $ let
       s'  = s (Just HomeGame) (Just 1) (Just 2) (Just False)
       db' = updateGameStats s' ^. database
-      in db' `shouldBe` db 1 2 1 1 1 1
+      in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
 
   context "home overtime loss" $
     it "should record a home 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 +344,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 +352,76 @@ addPlayerSpec = describe "addPlayer" $ do
   context "data available" $
     it "should create the player" $ let
       s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
-        & cpsNumber   ?~ 1
+        & cpsNumber   ?~ 2
-        & cpsName     .~ "Joe"
+        & cpsName     .~ "Bob"
-        & cpsPosition .~ "centre"
+        & 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 +437,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
+  mapM_
-    let
+    (\(pName, pid, ytd, lt, game) ->
-      ps'    = awardGoal 0 ps
+      context pName $ do
-      player = head $ ps'^.database.dbPlayers
+        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" $
+        it ("should increment " ++ pName ++ "'s year-to-date goals") $
-      player^.pYtd.psGoals `shouldBe` 2
+          player^.pYtd.psGoals `shouldBe` ytd
 
-    it "should increment Joe's lifetime goals" $
+        it ("should increment " ++ pName ++ "'s lifetime goals") $
-      player^.pLifetime.psGoals `shouldBe` 3
+          player^.pLifetime.psGoals `shouldBe` lt
 
-  context "Bob" $ do
+        it ("should increment " ++ pName ++ "'s game goals") $
-    let
+          gStats^.psGoals `shouldBe` game)
-      ps' = awardGoal 1 ps
+    --  player name, player id, ytd goals, lifetime goals, game goals
-      player = last $ ps'^.database.dbPlayers
+    [ ( "Joe",       0,         2,         3,              2          )
-
+    , ( "Bob",       1,         4,         5,              1          )
-    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
 
   context "invalid index" $ let
     ps' = awardGoal 2 ps
@@ -402,6 +476,75 @@ 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
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum

test/TypesSpec.hs

@@ -57,6 +57,8 @@ spec = describe "Mtlstats.Types" $ do
   pPointsSpec
   playerSearchSpec
   playerSearchExactSpec
+  modifyPlayerSpec
+  playerSummarySpec
   Menu.spec
 
 playerSpec :: Spec
@@ -255,16 +257,20 @@ goalieStatsJSON n = Object $ HM.fromList
 
 gameStats :: Int -> GameStats
 gameStats n = GameStats
-  { _gmsWins     = n
+  { _gmsWins         = n
-  , _gmsLosses   = n + 1
+  , _gmsLosses       = n + 1
-  , _gmsOvertime = n + 2
+  , _gmsOvertime     = n + 2
+  , _gmsGoalsFor     = n + 3
+  , _gmsGoalsAgainst = n + 4
   }
 
 gameStatsJSON :: Int -> Value
 gameStatsJSON n = Object $ HM.fromList
-  [ ( "wins",     toJSON n       )
+  [ ( "wins",          toJSON n       )
-  , ( "losses",   toJSON $ n + 1 )
+  , ( "losses",        toJSON $ n + 1 )
-  , ( "overtime", toJSON $ n + 2 )
+  , ( "overtime",      toJSON $ n + 2 )
+  , ( "goals_for",     toJSON $ n + 3 )
+  , ( "goals_against", toJSON $ n + 4 )
   ]
 
 db :: Database
@@ -456,11 +462,11 @@ gmsGamesSpec = describe "gmsGames" $ mapM_
 gmsPointsSpec :: Spec
 gmsPointsSpec = describe "gmsPoints" $ mapM_
   (\(w, l, ot, expected) -> let
-    gs = GameStats
+    gs
-      { _gmsWins     = w
+      = newGameStats
-      , _gmsLosses   = l
+      & gmsWins     .~ w
-      , _gmsOvertime = ot
+      & gmsLosses   .~ l
-      }
+      & gmsOvertime .~ ot
     in context (show gs) $
       it ("should be " ++ show expected) $
         gmsPoints gs `shouldBe` expected)
@@ -478,21 +484,27 @@ addGameStatsSpec = describe "addGameStats" $
   it "should add the values" $ let
 
     s1 = GameStats
-      { _gmsWins     = 1
+      { _gmsWins         = 1
-      , _gmsLosses   = 3
+      , _gmsLosses       = 2
-      , _gmsOvertime = 2
+      , _gmsOvertime     = 3
+      , _gmsGoalsFor     = 4
+      , _gmsGoalsAgainst = 5
       }
 
     s2 = GameStats
-      { _gmsWins     = 4
+      { _gmsWins         = 6
-      , _gmsLosses   = 6
+      , _gmsLosses       = 7
-      , _gmsOvertime = 5
+      , _gmsOvertime     = 8
+      , _gmsGoalsFor     = 9
+      , _gmsGoalsAgainst = 10
       }
 
     expected = GameStats
-      { _gmsWins     = 5
+      { _gmsWins         = 7
-      , _gmsLosses   = 9
+      , _gmsLosses       = 9
-      , _gmsOvertime = 7
+      , _gmsOvertime     = 11
+      , _gmsGoalsFor     = 13
+      , _gmsGoalsAgainst = 15
       }
 
     in addGameStats s1 s2 `shouldBe` expected
@@ -542,6 +554,36 @@ 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"
+
 joe :: Player
 joe = newPlayer 2 "Joe" "center"