Merge pull request #10 from mtlstats/game-stats

Generate game stats report

package.yaml

@@ -26,7 +26,7 @@ dependencies:
 - microlens-th >= 0.4.2.3 && < 0.5
 - ncurses >= 0.2.16 && < 0.3
 - random >= 1.1 && < 1.2
-- raw-strings-qq >= 1.1 && < 1.2
+- time >= 1.8.0.2 && < 1.9
 - transformers >= 0.5.6.2 && < 0.6
 - bytestring
 - microlens
@@ -56,3 +56,4 @@ tests:
     dependencies:
     - mtlstats
     - hspec >= 2.7.1 && < 2.8
+    - unordered-containers

src/Mtlstats/Actions.hs

@@ -27,9 +27,14 @@ module Mtlstats.Actions
   , startNewGame
   , addChar
   , removeChar
+  , overtimeCheck
+  , updateGameStats
+  , validateGameDate
   ) where
 
-import Lens.Micro (over, (&), (.~), (?~), (%~))
+import Data.Maybe (fromMaybe)
+import Data.Time.Calendar (fromGregorianValid)
+import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
 
 import Mtlstats.Types
 
@@ -58,3 +63,51 @@ removeChar :: ProgState -> ProgState
 removeChar = inputBuffer %~ \case
   ""  -> ""
   str -> init str
+
+-- | Determines whether or not to perform a check for overtime
+overtimeCheck :: ProgState -> ProgState
+overtimeCheck s
+  | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
+    s & progMode.gameStateL
+    %~ (homeScore .~ Nothing)
+    .  (awayScore .~ Nothing)
+  | fromMaybe False $ gameWon $ s^.progMode.gameStateL =
+    s & progMode.gameStateL.overtimeFlag ?~ False
+  | otherwise  = s
+
+-- | Adjusts the game stats based on the results of the current game
+updateGameStats :: ProgState -> ProgState
+updateGameStats s = fromMaybe s $ do
+  gType <- s^.progMode.gameStateL.gameType
+  won   <- gameWon $ s^.progMode.gameStateL
+  lost  <- gameLost $ s^.progMode.gameStateL
+  ot    <- s^.progMode.gameStateL.overtimeFlag
+  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
+    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
+  Just $ s
+    & database.dbHomeGameStats
+      %~ (gmsWins +~ hw)
+      .  (gmsLosses +~ hl)
+      .  (gmsOvertime +~ hot)
+    & database.dbAwayGameStats
+      %~ (gmsWins +~ aw)
+      .  (gmsLosses +~ al)
+      .  (gmsOvertime +~ aot)
+
+-- | Validates the game date
+validateGameDate :: ProgState -> ProgState
+validateGameDate s = fromMaybe s $ do
+  y <- toInteger <$> s^.progMode.gameStateL.gameYear
+  m <- s^.progMode.gameStateL.gameMonth
+  d <- s^.progMode.gameStateL.gameDay
+  Just $ if null $ fromGregorianValid y m d
+    then s & progMode.gameStateL
+      %~ (gameYear  .~ Nothing)
+      .  (gameMonth .~ Nothing)
+      .  (gameDay   .~ Nothing)
+    else s

src/Mtlstats/Config.hs

@@ -0,0 +1,26 @@
+{- |
+
+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.Config where
+
+-- | The name of the team whose stats we're tracking
+myTeam :: String
+myTeam = "MONTREAL"

src/Mtlstats/Events.hs

@@ -23,7 +23,9 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Events (handleEvent) where
 
+import Control.Monad (when)
 import Control.Monad.Trans.State (gets, modify)
+import Data.Char (toUpper)
 import Lens.Micro ((^.), (.~))
 import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
@@ -42,6 +44,16 @@ handleEvent e = gets (view progMode) >>= \case
   MainMenu  -> menuHandler mainMenu e
   NewSeason -> menuHandler newSeasonMenu e >> return True
   NewGame gs
+    | null $ gs^.gameYear -> do
+      promptHandler gameYearPrompt e
+      return True
+    | null $ gs^.gameMonth -> do
+      menuHandler gameMonthMenu e
+      return True
+    | null $ gs^.gameDay -> do
+      promptHandler gameDayPrompt e
+      modify validateGameDate
+      return True
     | null $ gs^.gameType -> do
       menuHandler gameTypeMenu e
       return True
@@ -53,5 +65,25 @@ handleEvent e = gets (view progMode) >>= \case
       return True
     | null $ gs^.awayScore -> do
       promptHandler awayScorePrompt e
+      modify overtimeCheck
+      modify updateGameStats
       return True
-    | otherwise -> undefined
+    | null $ gs^.overtimeFlag -> do
+      overtimePrompt e
+        >>= modify . (progMode.gameStateL.overtimeFlag .~)
+      modify updateGameStats
+      return True
+    | otherwise -> do
+      when
+        (case e of
+          C.EventCharacter _  -> True
+          C.EventSpecialKey _ -> True
+          _                   -> False) $
+        modify $ progMode .~ MainMenu
+      return True
+
+overtimePrompt :: C.Event -> Action (Maybe Bool)
+overtimePrompt (C.EventCharacter c) = case toUpper c of
+  'Y' -> return (Just True)
+  'N' -> return (Just False)
+  _   -> return Nothing

src/Mtlstats/Format.hs

@@ -0,0 +1,103 @@
+{- |
+
+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.Format
+  ( padNum
+  , left
+  , right
+  , centre
+  , overlay
+  , month
+  ) where
+
+-- | Pad an 'Int' with leading zeroes to fit a certain character width
+padNum
+  :: Int
+  -- ^ The width in characters
+  -> Int
+  -- ^ The value to format
+  -> String
+padNum size n
+  | n < 0 = '-' : padNum (pred size) (-n)
+  | otherwise = let
+    str  = show n
+    sLen = length str
+    pLen = size - sLen
+    pad  = replicate pLen '0'
+    in pad ++ str
+
+-- | Aligns text to the left within a field (clipping if necessary)
+left
+  :: Int
+  -- ^ The width of the field
+  -> String
+  -- ^ The text to align
+  -> String
+left n str = take n $ str ++ repeat ' '
+
+-- | Aligns text to the right within a field (clipping if necessary)
+right
+  :: Int
+  -- ^ The width of the field
+  -> String
+  -- ^ The text to align
+  -> String
+right n str = reverse $ left n $ reverse str
+
+-- | Aligns text to the centre within a field (clipping if necessary)
+centre
+  :: Int
+  -- ^ The width of the field
+  -> String
+  -- ^ The text to align
+  -> String
+centre n str = let
+  sLen = length str
+  pLen = (n - sLen) `div` 2
+  pad  = replicate pLen ' '
+  in take n $ pad ++ str ++ repeat ' '
+
+-- | Overlays one string on top of another
+overlay
+  :: String
+  -- ^ The string on the top
+  -> String
+  -- ^ The string on the bottom
+  -> String
+overlay (x:xs) (_:ys) = x : overlay xs ys
+overlay xs []         = xs
+overlay [] ys         = ys
+
+-- | Converts a number to a three character month (e.g. @"JAN"@)
+month :: Int -> String
+month 1  = "JAN"
+month 2  = "FEB"
+month 3  = "MAR"
+month 4  = "APR"
+month 5  = "MAY"
+month 6  = "JUN"
+month 7  = "JUL"
+month 8  = "AUG"
+month 9  = "SEP"
+month 10 = "OCT"
+month 11 = "NOV"
+month 12 = "DEC"
+month _  = ""

src/Mtlstats/Menu.hs

@@ -26,10 +26,12 @@ module Mtlstats.Menu (
   -- * Menus
   mainMenu,
   newSeasonMenu,
+  gameMonthMenu,
   gameTypeMenu
 ) where
 
 import Control.Monad.Trans.State (modify)
+import Data.Char (toUpper)
 import Lens.Micro ((^.), (.~), (?~))
 import qualified UI.NCurses as C
 
@@ -46,7 +48,7 @@ drawMenu m = do
 -- | The event handler for a 'Menu'
 menuHandler :: Menu a -> C.Event -> Action a
 menuHandler m (C.EventCharacter c) =
-  case filter (\i -> i ^. miKey == c) $ m ^. menuItems of
+  case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
     i:_ -> i^.miAction
     []  -> return $ m^.menuDefault
 menuHandler m _ = return $ m^.menuDefault
@@ -71,11 +73,31 @@ newSeasonMenu = Menu "*** SEASON TYPE ***" ()
     modify startNewGame
   ]
 
+-- | Requests the month in which the game took place
+gameMonthMenu :: Menu ()
+gameMonthMenu = Menu "Month:" () $ map
+  (\(ch, name, val) ->
+    MenuItem ch name $
+    modify $ progMode.gameStateL.gameMonth ?~ val)
+  [ ( 'A', "January",   1  )
+  , ( 'B', "February",  2  )
+  , ( 'C', "March",     3  )
+  , ( 'D', "April",     4  )
+  , ( 'E', "May",       5  )
+  , ( 'F', "June",      6  )
+  , ( 'G', "July",      7  )
+  , ( 'H', "August",    8  )
+  , ( 'I', "September", 9  )
+  , ( 'J', "October",   10 )
+  , ( 'K', "November",  11 )
+  , ( 'L', "December",  12 )
+  ]
+
 -- | The game type menu (home/away)
 gameTypeMenu :: Menu ()
-gameTypeMenu = Menu "*** GAME TYPE ***" ()
+gameTypeMenu = Menu "Game type:" ()
   [ MenuItem '1' "Home Game" $
-    modify $ progMode . gameTypeL ?~ HomeGame
+    modify $ progMode.gameStateL.gameType ?~ HomeGame
   , MenuItem '2' "Away Game" $
-    modify $ progMode . gameTypeL ?~ AwayGame
+    modify $ progMode.gameStateL.gameType ?~ AwayGame
   ]

src/Mtlstats/Prompt.hs

@@ -26,6 +26,8 @@ module Mtlstats.Prompt (
   strPrompt,
   numPrompt,
   -- * Individual prompts
+  gameYearPrompt,
+  gameDayPrompt,
   otherTeamPrompt,
   homeScorePrompt,
   awayScorePrompt
@@ -93,17 +95,30 @@ numPrompt pStr act = Prompt
   , promptFunctionKey = const $ return ()
   }
 
+-- | Prompts for the game year
+gameYearPrompt :: Prompt
+gameYearPrompt = numPrompt "Game year: " $
+  modify . (progMode.gameStateL.gameYear ?~)
+
+-- | Prompts for the day of the month the game took place
+gameDayPrompt :: Prompt
+gameDayPrompt = numPrompt "Day of month: " $
+  modify . (progMode.gameStateL.gameDay ?~)
+
+-- | Prompts for the other team name
 otherTeamPrompt :: Prompt
 otherTeamPrompt = strPrompt "Other team: " $
-  modify . (progMode . otherTeamL .~)
+  modify . (progMode.gameStateL.otherTeam .~)
 
+-- | Prompts for the home score
 homeScorePrompt :: Prompt
 homeScorePrompt = numPrompt "Home score: " $
-  modify . (progMode . homeScoreL ?~)
+  modify . (progMode.gameStateL.homeScore ?~)
 
+-- | Prompts for the away score
 awayScorePrompt :: Prompt
 awayScorePrompt = numPrompt "Away score: " $
-  modify . (progMode . awayScoreL ?~)
+  modify . (progMode.gameStateL.awayScore ?~)
 
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Report.hs

@@ -0,0 +1,90 @@
+{- |
+
+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.Report (report) where
+
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+
+import Mtlstats.Config
+import Mtlstats.Format
+import Mtlstats.Types
+
+-- | Generates the report
+report
+  :: Int
+  -- ^ The number of columns for the report
+  -> ProgState
+  -- ^ The program state
+  -> String
+report width s = unlines $ fromMaybe [] $ do
+  let
+    db     = s^.database
+    gs     = s^.progMode.gameStateL
+    gNum   = db^.dbGames
+    hTeam  = homeTeam gs
+    aTeam  = awayTeam gs
+    hStats = db^.dbHomeGameStats
+    aStats = db^.dbAwayGameStats
+    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)
+      (centre width
+        $  aTeam ++ " " ++ show aScore ++ "  AT  "
+        ++ hTeam ++ " " ++ show hScore)
+    , date
+    , centre width "STANDINGS"
+    , ""
+    , centre width
+      $  left 11 myTeam
+      ++ right 2 "G"
+      ++ right 4 "W"
+      ++ right 4 "L"
+      ++ right 4 "OT"
+      ++ right 4 "P"
+    , centre width
+      $  left 11 "HOME"
+      ++ showStats hStats
+    , centre width
+      $ left 11 "ROAD"
+      ++ showStats aStats
+    , centre width
+      $  replicate 11 ' '
+      ++ replicate (2 + 4 * 4) '-'
+    , centre width
+      $  left 11 "TOTALS"
+      ++ showStats tStats
+    ]
+
+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 $ gmsPoints gs)

src/Mtlstats/Types.hs

@@ -33,26 +33,30 @@ module Mtlstats.Types (
   PlayerStats (..),
   Goalie (..),
   GoalieStats (..),
+  GameStats (..),
   Prompt (..),
   -- * Lenses
   -- ** ProgState Lenses
   database,
   progMode,
   inputBuffer,
+  -- ** ProgMode Lenses
+  gameStateL,
   -- ** GameState Lenses
+  gameYear,
+  gameMonth,
+  gameDay,
   gameType,
   otherTeam,
   homeScore,
   awayScore,
-  -- ** ProgMode Lenses
+  overtimeFlag,
-  gameTypeL,
-  otherTeamL,
-  homeScoreL,
-  awayScoreL,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
   dbGames,
+  dbHomeGameStats,
+  dbAwayGameStats,
   -- ** Player Lenses
   pNumber,
   pName,
@@ -76,6 +80,10 @@ module Mtlstats.Types (
   gsWins,
   gsLosses,
   gsTies,
+  -- ** GameStats Lenses
+  gmsWins,
+  gmsLosses,
+  gmsOvertime,
   -- * Constructors
   newProgState,
   newGameState,
@@ -84,9 +92,20 @@ module Mtlstats.Types (
   newPlayerStats,
   newGoalie,
   newGoalieStats,
+  newGameStats,
   -- * Helper Functions
-  -- ** ProgState Helpers
+  -- ** GameState Helpers
   teamScore,
+  otherScore,
+  homeTeam,
+  awayTeam,
+  gameWon,
+  gameLost,
+  gameTied,
+  -- ** GameStats Helpers
+  gmsGames,
+  gmsPoints,
+  addGameStats,
   -- ** Player Helpers
   pPoints
 ) where
@@ -108,6 +127,8 @@ import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 import UI.NCurses (Curses, Update)
 
+import Mtlstats.Config
+
 -- | Action which maintains program state
 type Action a = StateT ProgState Curses a
 
@@ -123,7 +144,13 @@ data ProgState = ProgState
 
 -- | The game state
 data GameState = GameState
-  { _gameType  :: Maybe GameType
+  { _gameYear     :: Maybe Int
+  -- ^ The year the game took place
+  , _gameMonth    :: Maybe Int
+  -- ^ The month the game took place
+  , _gameDay      :: Maybe Int
+  -- ^ The day of the month the game took place
+  , _gameType     :: Maybe GameType
   -- ^ The type of game (home/away)
   , _otherTeam    :: String
   -- ^ The name of the other team
@@ -131,6 +158,8 @@ data GameState = GameState
   -- ^ The home team's score
   , _awayScore    :: Maybe Int
   -- ^ The away team's score
+  , _overtimeFlag :: Maybe Bool
+  -- ^ Indicates whether or not the game went into overtime
   } deriving (Eq, Show)
 
 -- | The program mode
@@ -154,6 +183,10 @@ data Database = Database
   -- ^ The list of goalies
   , _dbGames         :: Int
   -- ^ The number of games recorded
+  , _dbHomeGameStats :: GameStats
+  -- ^ Statistics for home games
+  , _dbAwayGameStats :: GameStats
+  -- ^ Statistics for away games
   } deriving (Eq, Show)
 
 instance FromJSON Database where
@@ -161,17 +194,23 @@ instance FromJSON Database where
     <$> v .: "players"
     <*> v .: "goalies"
     <*> v .: "games"
+    <*> v .: "home_game_stats"
+    <*> v .: "away_game_stats"
 
 instance ToJSON Database where
-  toJSON (Database players goalies games) = object
+  toJSON (Database players goalies games hgs ags) = object
     [ "players"         .= players
     , "goalies"         .= goalies
     , "games"           .= games
+    , "home_game_stats" .= hgs
+    , "away_game_stats" .= ags
     ]
-  toEncoding (Database players goalies games) = pairs $
+  toEncoding (Database players goalies games hgs ags) = pairs $
     "players"         .= players <>
     "goalies"         .= goalies <>
-    "games"   .= games
+    "games"           .= games   <>
+    "home_game_stats" .= hgs     <>
+    "away_game_stats" .= ags
 
 -- | Represents a (non-goalie) player
 data Player = Player
@@ -316,6 +355,33 @@ instance ToJSON GoalieStats where
       "losses"        .= l  <>
       "ties"          .= t
 
+-- | Game statistics
+data GameStats = GameStats
+  { _gmsWins     :: Int
+  -- ^ Games won
+  , _gmsLosses   :: Int
+  -- ^ Games lost
+  , _gmsOvertime :: Int
+  -- ^ Games lost in overtime
+  } deriving (Eq, Show)
+
+instance FromJSON GameStats where
+  parseJSON = withObject "GameStats" $ \v -> GameStats
+    <$> v .: "wins"
+    <*> v .: "losses"
+    <*> v .: "overtime"
+
+instance ToJSON GameStats where
+  toJSON (GameStats w l ot) = object
+    [ "wins"     .= w
+    , "losses"   .= l
+    , "overtime" .= ot
+    ]
+  toEncoding (GameStats w l ot) = pairs $
+    "wins"     .= w  <>
+    "losses"   .= l  <>
+    "overtime" .= ot
+
 -- | Defines a user prompt
 data Prompt = Prompt
   { promptDrawer      :: ProgState -> Update ()
@@ -335,42 +401,14 @@ makeLenses ''Player
 makeLenses ''PlayerStats
 makeLenses ''Goalie
 makeLenses ''GoalieStats
+makeLenses ''GameStats
 
-gameTypeL :: Lens' ProgMode (Maybe GameType)
+gameStateL :: Lens' ProgMode GameState
-gameTypeL = lens
+gameStateL = lens
   (\case
-    NewGame gs -> gs ^. gameType
+    NewGame gs -> gs
-    _          -> Nothing)
+    _          -> newGameState)
-  (\m gt -> case m of
+  (\_ gs -> NewGame gs)
-    NewGame gs -> NewGame $ gs & gameType .~ gt
-    _          -> NewGame $ newGameState & gameType .~ gt)
-
-otherTeamL :: Lens' ProgMode String
-otherTeamL = lens
-  (\case
-    NewGame gs -> gs ^. otherTeam
-    _          -> "")
-  (\m ot -> case m of
-    NewGame gs -> NewGame $ gs & otherTeam .~ ot
-    _          -> NewGame $ newGameState & otherTeam .~ ot)
-
-homeScoreL :: Lens' ProgMode (Maybe Int)
-homeScoreL = lens
-  (\case
-    NewGame gs -> gs ^. homeScore
-    _          -> Nothing)
-  (\m hs -> case m of
-    NewGame gs -> NewGame $ gs & homeScore .~ hs
-    _          -> NewGame $ newGameState & homeScore .~ hs)
-
-awayScoreL :: Lens' ProgMode (Maybe Int)
-awayScoreL = lens
-  (\case
-    NewGame gs -> gs ^. awayScore
-    _          -> Nothing)
-  (\m as -> case m of
-    NewGame gs -> NewGame $ gs & awayScore .~ as
-    _          -> NewGame $ newGameState & awayScore .~ as)
 
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
@@ -383,10 +421,14 @@ newProgState = ProgState
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameType  = Nothing
+  { _gameYear     = Nothing
+  , _gameMonth    = Nothing
+  , _gameDay      = Nothing
+  , _gameType     = Nothing
   , _otherTeam    = ""
   , _homeScore    = Nothing
   , _awayScore    = Nothing
+  , _overtimeFlag = Nothing
   }
 
 -- | Constructor for a 'Database'
@@ -395,6 +437,8 @@ newDatabase = Database
   { _dbPlayers       = []
   , _dbGoalies       = []
   , _dbGames         = 0
+  , _dbHomeGameStats = newGameStats
+  , _dbAwayGameStats = newGameStats
   }
 
 -- | Constructor for a 'Player'
@@ -448,13 +492,72 @@ newGoalieStats = GoalieStats
   , _gsTies         = 0
   }
 
--- | Determines the team's points
+-- | Constructor for a 'GameStats' value
-teamScore :: ProgState -> Maybe Int
+newGameStats :: GameStats
-teamScore s = case s ^. progMode . gameTypeL of
+newGameStats = GameStats
-  Just HomeGame -> s ^. progMode . homeScoreL
+  { _gmsWins     = 0
-  Just AwayGame -> s ^. progMode . awayScoreL
+  , _gmsLosses   = 0
+  , _gmsOvertime = 0
+  }
+
+-- | Determines the team's score
+teamScore :: GameState -> Maybe Int
+teamScore s = case s ^. gameType of
+  Just HomeGame -> s ^. homeScore
+  Just AwayGame -> s ^. awayScore
   Nothing       -> Nothing
 
+-- | Determines the other team's score
+otherScore :: GameState -> Maybe Int
+otherScore s = case s ^. gameType of
+  Just HomeGame -> s ^. awayScore
+  Just AwayGame -> s ^. homeScore
+  Nothing       -> Nothing
+
+-- | Returns the name of the home team (or an empty string if
+-- unavailable)
+homeTeam :: GameState -> String
+homeTeam gs = case gs^.gameType of
+  Just HomeGame -> myTeam
+  Just AwayGame -> gs^.otherTeam
+  Nothing       -> ""
+
+-- | Returns the name of the visiting team (or an empty string if
+-- unavailable)
+awayTeam :: GameState -> String
+awayTeam gs = case gs^.gameType of
+  Just HomeGame -> gs^.otherTeam
+  Just AwayGame -> myTeam
+  Nothing       -> ""
+
+-- | Checks if the game was won
+gameWon :: GameState -> Maybe Bool
+gameWon gs = (>) <$> teamScore gs <*> otherScore gs
+
+-- | Checks if the game was lost
+gameLost :: GameState -> Maybe Bool
+gameLost gs = (<) <$> teamScore gs <*> otherScore gs
+
+-- | Checks if the game has tied
+gameTied :: GameState -> Maybe Bool
+gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
+
+-- | Calculates the number of games played
+gmsGames :: GameStats -> Int
+gmsGames gs = gs^.gmsWins + gs^.gmsLosses
+
+-- | Calculates the number of points
+gmsPoints :: GameStats -> Int
+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
+  }
+
 -- | Calculates a player's points
 pPoints :: PlayerStats -> Int
 pPoints s = s^.psGoals + s^.psAssists

src/Mtlstats/UI.hs

@@ -25,8 +25,10 @@ import Control.Monad (void)
 import Lens.Micro ((^.))
 import qualified UI.NCurses as C
 
+import Mtlstats.Format
 import Mtlstats.Menu
 import Mtlstats.Prompt
+import Mtlstats.Report
 import Mtlstats.Types
 
 -- | Drawing function
@@ -40,10 +42,28 @@ draw s = do
       MainMenu  -> drawMenu mainMenu
       NewSeason -> drawMenu newSeasonMenu
       NewGame gs
-        | null $ gs ^. gameType  -> drawMenu gameTypeMenu
+        | null $ gs^.gameYear     -> header s >> drawPrompt gameYearPrompt s
-        | null $ gs ^. otherTeam -> drawPrompt otherTeamPrompt s
+        | null $ gs^.gameMonth    -> header s >> drawMenu gameMonthMenu
-        | null $ gs ^. homeScore -> drawPrompt homeScorePrompt s
+        | null $ gs^.gameDay      -> header s >> drawPrompt gameDayPrompt s
-        | null $ gs ^. awayScore -> drawPrompt awayScorePrompt s
+        | null $ gs^.gameType     -> header s >> drawMenu gameTypeMenu
-        | otherwise              -> undefined
+        | null $ gs^.otherTeam    -> header s >> drawPrompt otherTeamPrompt s
+        | null $ gs^.homeScore    -> header s >> drawPrompt homeScorePrompt s
+        | null $ gs^.awayScore    -> header s >> drawPrompt awayScorePrompt s
+        | null $ gs^.overtimeFlag -> header s >> overtimePrompt
+        | otherwise               -> showReport s
   C.render
   void $ C.setCursorMode cm
+
+header :: ProgState -> C.Update ()
+header s = C.drawString $
+  "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
+
+overtimePrompt :: C.Update C.CursorMode
+overtimePrompt = do
+  C.drawString "Did the game go into overtime?  (Y/N)"
+  return C.CursorInvisible
+
+showReport :: ProgState -> C.Update C.CursorMode
+showReport s = do
+  C.drawString $ report 72 s
+  return C.CursorInvisible

test/ActionsSpec.hs

@@ -22,7 +22,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module ActionsSpec (spec) where
 
 import Control.Monad (replicateM)
-import Lens.Micro ((&), (.~), (?~), (^.))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import System.Random (randomRIO)
 import Test.Hspec (Spec, context, describe, it, shouldBe, shouldNotBe)
 
@@ -36,6 +36,9 @@ spec = describe "Mtlstats.Actions" $ do
   resetYtdSpec
   addCharSpec
   removeCharSpec
+  overtimeCheckSpec
+  updateGameStatsSpec
+  validateGameDateSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -126,6 +129,192 @@ removeCharSpec = describe "removeChar" $ do
         & removeChar
       in s ^. inputBuffer `shouldBe` "fo"
 
+overtimeCheckSpec = describe "overtimeCheck" $ do
+
+  context "tie game" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 1)
+          .  (awayScore ?~ 1)
+        & overtimeCheck
+
+    it "should clear the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Nothing
+
+    it "should clear the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Nothing
+
+    it "should leave the overtimeFlag blank" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
+
+  context "game won" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 2)
+          .  (awayScore ?~ 1)
+        & overtimeCheck
+
+    it "should not change the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Just 2
+
+    it "should not change the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Just 1
+
+    it "should set the overtimeCheck flag to False" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
+
+  context "game lost" $ do
+    let
+      s = newProgState
+        & progMode.gameStateL
+          %~ (gameType  ?~ HomeGame)
+          .  (homeScore ?~ 1)
+          .  (awayScore ?~ 2)
+        & overtimeCheck
+
+    it "should not change the home score" $
+      s^.progMode.gameStateL.homeScore `shouldBe` Just 1
+
+    it "should not change the away score" $
+      s^.progMode.gameStateL.awayScore `shouldBe` Just 2
+
+    it "should leave the overtimeCheck flag blank" $
+      s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
+
+updateGameStatsSpec :: Spec
+updateGameStatsSpec = describe "updateGameStats" $ do
+  let
+
+    baseStats = newGameStats
+      & gmsWins     .~ 1
+      & gmsLosses   .~ 1
+      & gmsOvertime .~ 1
+
+    s t h a o = newProgState
+      & progMode.gameStateL
+        %~ (gameType     .~ t)
+        .  (homeScore    .~ h)
+        .  (awayScore    .~ a)
+        .  (overtimeFlag .~ o)
+      & database
+        %~ (dbHomeGameStats .~ baseStats)
+        .  (dbAwayGameStats .~ baseStats)
+
+    db hw hl ho aw al ao = newDatabase
+      & dbHomeGameStats
+        %~ (gmsWins     .~ hw)
+        .  (gmsLosses   .~ hl)
+        .  (gmsOvertime .~ ho)
+      & dbAwayGameStats
+        %~ (gmsWins     .~ aw)
+        .  (gmsLosses   .~ al)
+        .  (gmsOvertime .~ ao)
+
+  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
+
+  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
+
+  context "home overtime loss" $
+    it "should record a home loss and 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
+
+  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
+
+  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
+
+  context "away overtime loss" $
+    it "should record an away loss and 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
+
+  context "missing game type" $
+    it "should not change anything" $ let
+      s' = s Nothing (Just 1) (Just 2) (Just True)
+      in updateGameStats s' `shouldBe` s'
+
+  context "missing home score" $
+    it "should not change anything" $ let
+      s' = s (Just HomeGame) Nothing (Just 1) (Just True)
+      in updateGameStats s' `shouldBe` s'
+
+  context "missing away score" $
+    it "should not change anything" $ let
+      s' = s (Just HomeGame) (Just 1) Nothing (Just True)
+      in updateGameStats s' `shouldBe` s'
+
+  context "missing overtime flag" $
+    it "should not change anything" $ let
+      s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
+      in updateGameStats s' `shouldBe` s'
+
+validateGameDateSpec :: Spec
+validateGameDateSpec = describe "validateGameDate" $ do
+
+  context "valid date" $
+    it "should leave the date unchanged" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 6)
+            .  (gameDay   ?~ 25)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Just 25
+
+  context "invalid date" $
+    it "should clear the date" $ do
+      let
+        s = newProgState
+          & progMode.gameStateL
+            %~ (gameYear  ?~ 2019)
+            .  (gameMonth ?~ 2)
+            .  (gameDay   ?~ 30)
+          & validateGameDate
+      s^.progMode.gameStateL.gameYear  `shouldBe` Nothing
+      s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
+  context "missing day" $
+    it "should not change anything" $ do
+      let
+
+        gs = newGameState
+          & gameYear  ?~ 2019
+          & gameMonth ?~ 6
+
+        s = newProgState
+          & progMode.gameStateL .~ gs
+          & validateGameDate
+
+      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum

test/FormatSpec.hs

@@ -0,0 +1,113 @@
+{-
+
+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 FormatSpec (spec) where
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Format
+
+spec :: Spec
+spec = describe "Mtlstats.Format" $ do
+  padNumSpec
+  leftSpec
+  rightSpec
+  centreSpec
+  overlaySpec
+  monthSpec
+
+padNumSpec :: Spec
+padNumSpec = describe "padNum" $ do
+
+  context "zero, four digits" $
+    it "should be 0000" $
+      padNum 4 0 `shouldBe` "0000"
+
+  context "123, four digits" $
+    it "should be 0123" $
+      padNum 4 123 `shouldBe` "0123"
+
+  context "12345, four digits" $
+    it "should be 12345" $
+      padNum 4 12345 `shouldBe` "12345"
+
+  context "-12, four digits" $
+    it "should be -012" $
+      padNum 4 (-12) `shouldBe` "-012"
+
+  context "-1234, four digits" $
+    it "should be -1234" $
+      padNum 4 (-1234) `shouldBe` "-1234"
+
+leftSpec :: Spec
+leftSpec = describe "left" $ do
+
+  context "fit" $
+    it "should pad the text" $
+      left 5 "foo" `shouldBe` "foo  "
+
+  context "overflow" $
+    it "should truncate the text" $
+      left 2 "foo" `shouldBe` "fo"
+
+rightSpec :: Spec
+rightSpec = describe "right" $ do
+
+  context "fit" $
+    it "should pad the text" $
+      right 5 "foo" `shouldBe` "  foo"
+
+  context "overflow" $
+    it "should truncate the text" $
+      right 2 "foo" `shouldBe` "oo"
+
+centreSpec :: Spec
+centreSpec = describe "centre" $ do
+
+  context "fit" $
+    it "should pad the text" $
+      centre 5 "foo" `shouldBe` " foo "
+
+  context "overflow" $
+    it "should truncate the text" $
+      centre 2 "foo" `shouldBe` "fo"
+
+overlaySpec :: Spec
+overlaySpec = describe "overlay" $ do
+
+  context "first string shorter" $
+    it "should overlay" $
+      overlay "foo" "abc123" `shouldBe` "foo123"
+
+  context "first string longer" $
+    it "should overlay" $
+      overlay "abc123" "foo" `shouldBe` "abc123"
+
+monthSpec :: Spec
+monthSpec = describe "month" $ do
+
+  context "January" $
+    it "should return \"JAN\"" $
+      month 1 `shouldBe` "JAN"
+
+  context "invalid" $
+    it "should return an empty string" $
+      month 0 `shouldBe` ""

test/Spec.hs

@@ -22,9 +22,11 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 import Test.Hspec (hspec)
 
 import qualified ActionsSpec as Actions
+import qualified FormatSpec as Format
 import qualified TypesSpec as Types
 
 main :: IO ()
 main = hspec $ do
   Types.spec
   Actions.spec
+  Format.spec

test/TypesSpec.hs

@@ -19,15 +19,18 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings, RankNTypes #-}
 
 module TypesSpec (spec) where
 
-import Data.Aeson (decode, encode)
+import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
+import Data.Aeson.Types (Value (Object))
 import Data.ByteString.Lazy (ByteString)
-import Lens.Micro ((&), (^.), (.~), (?~))
+import qualified Data.HashMap.Strict as HM
+import Lens.Micro (Lens', (&), (^.), (.~), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
-import Text.RawString.QQ (r)
+
+import Mtlstats.Config
 import Mtlstats.Types
 
 import qualified Types.MenuSpec as Menu
@@ -35,26 +38,394 @@ import qualified Types.MenuSpec as Menu
 spec :: Spec
 spec = describe "Mtlstats.Types" $ do
   playerSpec
-  pPointsSpec
   goalieSpec
+  gameStatsSpec
   databaseSpec
-  gameTypeLSpec
+  gameStateLSpec
-  otherTeamLSpec
-  homeScoreLSpec
-  awayScoreLSpec
   teamScoreSpec
+  otherScoreSpec
+  homeTeamSpec
+  awayTeamSpec
+  gameWonSpec
+  gameLostSpec
+  gameTiedSpec
+  gmsGamesSpec
+  gmsPointsSpec
+  addGameStatsSpec
+  pPointsSpec
   Menu.spec
 
 playerSpec :: Spec
-playerSpec = describe "Player" $ do
+playerSpec = describe "Player" $ jsonSpec player playerJSON
+
+goalieSpec :: Spec
+goalieSpec = describe "Goalie" $ jsonSpec goalie goalieJSON
+
+gameStatsSpec :: Spec
+gameStatsSpec = describe "GameStats" $
+  jsonSpec (gameStats 1) (gameStatsJSON 1)
+
+databaseSpec :: Spec
+databaseSpec = describe "Database" $ jsonSpec db dbJSON
+
+gameStateLSpec :: Spec
+gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
+  -- getters
+  [ ( MainMenu,              newGameState )
+  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  ]
+  -- setters
+  [ ( MainMenu,              gs HomeGame  )
+  , ( NewGame $ gs HomeGame, gs AwayGame  )
+  , ( NewGame $ gs HomeGame, newGameState )
+  ]
+  where gs t = newGameState & gameType ?~ t
+
+teamScoreSpec :: Spec
+teamScoreSpec = describe "teamScore" $ do
+  let
+    s t = newGameState
+      & gameType  ?~ t
+      & homeScore ?~ 1
+      & awayScore ?~ 2
+
+  context "unknown game type" $
+    it "should return Nothing" $
+      teamScore newGameState `shouldBe` Nothing
+
+  context "HomeGame" $
+    it "should return 1" $
+      teamScore (s HomeGame) `shouldBe` Just 1
+
+  context "AwayGame" $
+    it "should return 2" $
+      teamScore (s AwayGame) `shouldBe` Just 2
+
+otherScoreSpec :: Spec
+otherScoreSpec = describe "otherScore" $ do
+  let
+    s t = newGameState
+      & gameType  ?~ t
+      & homeScore ?~ 1
+      & awayScore ?~ 2
+
+  context "unknown game type" $
+    it "should return Nothing" $
+      otherScore newGameState `shouldBe` Nothing
+
+  context "HomeGame" $
+    it "should return 2" $
+      otherScore (s HomeGame) `shouldBe` Just 2
+
+  context "AwayGame" $
+    it "should return 1" $
+      otherScore (s AwayGame) `shouldBe` Just 1
+
+jsonSpec
+  :: (Eq a, Show a, FromJSON a, ToJSON a)
+  => a
+  -> Value
+  -> Spec
+jsonSpec x j = do
 
   describe "decode" $
     it "should decode" $
-      decode playerJSON `shouldBe` Just player
+      decode (encode j) `shouldBe` Just x
 
-  describe "encode" $
+  describe "toJSON" $
     it "should encode" $
-      decode (encode player) `shouldBe` Just player
+      decode (encode $ toJSON x) `shouldBe` Just x
+
+  describe "toEncoding" $
+    it "should encode" $
+      decode (encode x) `shouldBe` Just x
+
+lensSpec
+  :: (Eq a, Show s, Show a)
+  => Lens' s a
+  -> [(s, a)]
+  -> [(s, a)]
+  -> Spec
+lensSpec l gs ss = do
+
+  context "getters" $ mapM_
+    (\(s, x) -> context (show s) $
+      it ("should be " ++ show x) $
+        s ^. l `shouldBe` x)
+    gs
+
+  context "setters" $ mapM_
+    (\(s, x) -> context (show s) $
+      it ("should set to " ++ show x) $
+        (s & l .~ x) ^. l `shouldBe` x)
+    ss
+
+player :: Player
+player = newPlayer 1 "Joe" "centre"
+  & pYtd      .~ playerStats 1
+  & pLifetime .~ playerStats 2
+
+playerJSON :: Value
+playerJSON = Object $ HM.fromList
+  [ ( "number",   toJSON (1 :: Int)           )
+  , ( "name",     toJSON ("Joe" :: String)    )
+  , ( "position", toJSON ("centre" :: String) )
+  , ( "ytd",      playerStatsJSON 1           )
+  , ( "lifetime", playerStatsJSON 2           )
+  ]
+
+playerStats :: Int -> PlayerStats
+playerStats n = newPlayerStats
+  & psGoals   .~ n
+  & psAssists .~ n + 1
+  & psPMin    .~ n + 2
+
+playerStatsJSON :: Int -> Value
+playerStatsJSON n = Object $ HM.fromList
+  [ ( "goals",        toJSON n       )
+  , ( "assists",      toJSON $ n + 1 )
+  , ( "penalty_mins", toJSON $ n + 2 )
+  ]
+
+goalie :: Goalie
+goalie = newGoalie 1 "Joe"
+  & gYtd      .~ goalieStats 1
+  & gLifetime .~ goalieStats 2
+
+goalieJSON :: Value
+goalieJSON = Object $ HM.fromList
+  [ ( "number",   toJSON (1 :: Int)         )
+  , ( "name",     toJSON ("Joe" :: String ) )
+  , ( "ytd",      goalieStatsJSON 1         )
+  , ( "lifetime", goalieStatsJSON 2         )
+  ]
+
+goalieStats :: Int -> GoalieStats
+goalieStats n = newGoalieStats
+  & gsGames        .~ n
+  & gsMinsPlayed   .~ n + 1
+  & gsGoalsAllowed .~ n + 2
+  & gsGoalsAgainst .~ n + 3
+  & gsWins         .~ n + 4
+  & gsLosses       .~ n + 5
+  & gsTies         .~ n + 6
+
+goalieStatsJSON :: Int -> Value
+goalieStatsJSON n = Object $ HM.fromList
+  [ ( "games",         toJSON n       )
+  , ( "mins_played",   toJSON $ n + 1 )
+  , ( "goals_allowed", toJSON $ n + 2 )
+  , ( "goals_against", toJSON $ n + 3 )
+  , ( "wins",          toJSON $ n + 4 )
+  , ( "losses",        toJSON $ n + 5 )
+  , ( "ties",          toJSON $ n + 6 )
+  ]
+
+gameStats :: Int -> GameStats
+gameStats n = GameStats
+  { _gmsWins     = n
+  , _gmsLosses   = n + 1
+  , _gmsOvertime = n + 2
+  }
+
+gameStatsJSON :: Int -> Value
+gameStatsJSON n = Object $ HM.fromList
+  [ ( "wins",     toJSON n       )
+  , ( "losses",   toJSON $ n + 1 )
+  , ( "overtime", toJSON $ n + 2 )
+  ]
+
+db :: Database
+db = newDatabase
+  & dbPlayers       .~ [player]
+  & dbGoalies       .~ [goalie]
+  & dbGames         .~ 1
+  & dbHomeGameStats .~ gameStats 1
+  & dbAwayGameStats .~ gameStats 2
+
+dbJSON :: Value
+dbJSON = Object $ HM.fromList
+  [ ( "players",         toJSON [playerJSON] )
+  , ( "goalies",         toJSON [goalieJSON] )
+  , ( "games",           toJSON (1 :: Int)   )
+  , ( "home_game_stats", gameStatsJSON 1     )
+  , ( "away_game_stats", gameStatsJSON 2     )
+  ]
+
+homeTeamSpec :: Spec
+homeTeamSpec = describe "homeTeam" $ do
+  let
+    gs gt = newGameState
+      & gameType  .~ gt
+      & otherTeam .~ "foo"
+
+  context "unknown game type" $
+    it "should return an empty string" $
+      homeTeam (gs Nothing) `shouldBe` ""
+
+  context "home game" $
+    it ("should return " ++ show myTeam) $
+      homeTeam (gs $ Just HomeGame) `shouldBe` myTeam
+
+  context "away game" $
+    it "should return \"foo\"" $
+      homeTeam (gs $ Just AwayGame) `shouldBe` "foo"
+
+awayTeamSpec :: Spec
+awayTeamSpec = describe "awayTeam" $ do
+  let
+    gs gt = newGameState
+      & gameType  .~ gt
+      & otherTeam .~ "foo"
+
+  context "unknown game type" $
+    it "should return an empty string" $
+      awayTeam (gs Nothing) `shouldBe` ""
+
+  context "home game" $
+    it "should return \"foo\"" $
+      awayTeam (gs $ Just HomeGame) `shouldBe` "foo"
+
+  context "away game" $
+    it ("should return " ++ show myTeam) $
+      awayTeam (gs $ Just AwayGame) `shouldBe` myTeam
+
+gameWonSpec :: Spec
+gameWonSpec = describe "gameWon" $ mapM_
+  (\(t, h, a, expected) -> let
+    desc = "game type: " ++ show t ++
+      ", home score: " ++ show h ++
+      ", away score: " ++ show a
+    gs = newGameState
+      & gameType  .~ t
+      & homeScore .~ h
+      & awayScore .~ a
+    in context desc $
+      it ("should be " ++ show expected) $
+        gameWon gs `shouldBe` expected)
+  --  gameType,      homeScore, awayScore, expected
+  [ ( Just HomeGame, Just 1,    Just 1,    Just False )
+  , ( Just HomeGame, Just 1,    Just 2,    Just False )
+  , ( Just HomeGame, Just 2,    Just 1,    Just True  )
+  , ( Just AwayGame, Just 1,    Just 1,    Just False )
+  , ( Just AwayGame, Just 1,    Just 2,    Just True  )
+  , ( Just AwayGame, Just 2,    Just 1,    Just False )
+  , ( 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    )
+  ]
+
+gameLostSpec :: Spec
+gameLostSpec = describe "gameLost" $ mapM_
+  (\(t, h, a, expected) -> let
+    desc = "game type: " ++ show t ++
+      ", home score: " ++ show h ++
+      ", away score: " ++ show a
+    gs = newGameState
+      & gameType  .~ t
+      & homeScore .~ h
+      & awayScore .~ a
+    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    )
+  ]
+
+gameTiedSpec :: Spec
+gameTiedSpec = describe "gameTied" $ mapM_
+  (\(home, away, expected) -> let
+    desc = "home score: " ++ show home ++
+      ", away score: " ++ show away
+    gs = newGameState
+      & homeScore .~ home
+      & awayScore .~ away
+    in context desc $
+      it ("should be " ++ show expected) $
+        gameTied gs `shouldBe` expected)
+  [ ( Nothing, Nothing, Nothing    )
+  , ( Nothing, Just 1,  Nothing    )
+  , ( Just 1,  Nothing, Nothing    )
+  , ( Just 1,  Just 1,  Just True  )
+  , ( Just 1,  Just 2,  Just False )
+  ]
+
+gmsGamesSpec :: Spec
+gmsGamesSpec = describe "gmsGames" $ mapM_
+  (\(w, l, expected) -> let
+    desc = "wins: " ++ show w ++
+      ", losses: " ++ show l
+    gs = newGameStats
+      & gmsWins   .~ w
+      & gmsLosses .~ l
+    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        )
+  ]
+
+gmsPointsSpec :: Spec
+gmsPointsSpec = describe "gmsPoints" $ mapM_
+  (\(w, l, ot, expected) -> let
+    gs = GameStats
+      { _gmsWins     = w
+      , _gmsLosses   = l
+      , _gmsOvertime = ot
+      }
+    in context (show gs) $
+      it ("should be " ++ show expected) $
+        gmsPoints gs `shouldBe` expected)
+  --  wins, losses, overtime, expected
+  [ ( 0,    0,      0,        0        )
+  , ( 1,    0,      0,        2        )
+  , ( 0,    1,      0,        0        )
+  , ( 0,    1,      1,        1        )
+  , ( 1,    1,      1,        3        )
+  , ( 2,    4,      3,        7        )
+  ]
+
+addGameStatsSpec :: Spec
+addGameStatsSpec = describe "addGameStats" $
+  it "should add the values" $ let
+
+    s1 = GameStats
+      { _gmsWins     = 1
+      , _gmsLosses   = 3
+      , _gmsOvertime = 2
+      }
+
+    s2 = GameStats
+      { _gmsWins     = 4
+      , _gmsLosses   = 6
+      , _gmsOvertime = 5
+      }
+
+    expected = GameStats
+      { _gmsWins     = 5
+      , _gmsLosses   = 9
+      , _gmsOvertime = 7
+      }
+
+    in addGameStats s1 s2 `shouldBe` expected
 
 pPointsSpec :: Spec
 pPointsSpec = describe "pPoints" $ mapM_
@@ -73,244 +444,3 @@ pPointsSpec = describe "pPoints" $ mapM_
   , ( 0,     1,       1      )
   , ( 2,     3,       5      )
   ]
-
-goalieSpec :: Spec
-goalieSpec = describe "Goalie" $ do
-
-  describe "decode" $
-    it "should decode" $
-      decode goalieJSON `shouldBe` Just goalie
-
-  describe "encode" $
-    it "should encode" $
-      decode (encode goalie) `shouldBe` Just goalie
-
-databaseSpec :: Spec
-databaseSpec = describe "Database" $ do
-
-  describe "decode" $
-    it "should decode" $
-      decode dbJSON `shouldBe` Just db
-
-  describe "encode" $
-    it "should encode" $
-      decode (encode db) `shouldBe` Just db
-
-gameTypeLSpec :: Spec
-gameTypeLSpec = describe "gameTypeL" $ do
-
-  context "getter" $ do
-
-    context "unexpected mode" $
-      it "should return Nothing" $
-        MainMenu ^. gameTypeL `shouldBe` Nothing
-
-    mapM_
-      (\t -> context (show t) $
-        it ("should return " ++ show t) $ let
-          gs = newGameState & gameType ?~ t
-          m  = NewGame gs
-          in m ^. gameTypeL `shouldBe` Just t)
-      [HomeGame, AwayGame]
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      mapM_
-        (\t -> context (show t) $
-          it ("should set to " ++ show t) $ let
-            m = MainMenu & gameTypeL ?~ t
-            in m ^. gameTypeL `shouldBe` Just t)
-        [HomeGame, AwayGame]
-
-    context "expected mode" $
-      mapM_
-        (\t -> context (show t) $
-          it ("should set to " ++ show t) $ let
-            m = NewGame newGameState & gameTypeL ?~ t
-            in m ^. gameTypeL `shouldBe` Just t)
-        [HomeGame, AwayGame]
-
-otherTeamLSpec :: Spec
-otherTeamLSpec = describe "otherTeamL" $ do
-
-  context "getter" $ do
-
-    context "unexpected mode" $
-      it "should return an empty string" $
-        MainMenu ^. otherTeamL `shouldBe` ""
-
-    context "expected mode" $
-      it "should return \"foo\"" $ let
-        m = NewGame $ newGameState & otherTeam .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      it "should set the value" $ let
-        m = MainMenu & otherTeamL .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
-
-    context "expected mode" $
-      it "should set the value" $ let
-        m = NewGame newGameState & otherTeamL .~ "foo"
-        in m ^. otherTeamL `shouldBe` "foo"
-
-homeScoreLSpec :: Spec
-homeScoreLSpec = describe "homeScoreL" $ do
-
-  context "getter" $ do
-
-    context "unexpected mode" $
-      it "should return Nothing" $
-        MainMenu ^. homeScoreL `shouldBe` Nothing
-
-    context "expected mode" $
-      it "should return 0" $ let
-        gs = newGameState & homeScore ?~ 0
-        m  = NewGame gs
-        in m ^. homeScoreL `shouldBe` Just 0
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      it "should set home score" $ let
-        m = MainMenu & homeScoreL ?~ 0
-        in m ^. homeScoreL `shouldBe` Just 0
-
-    context "expected mode" $
-      it "should set home score" $ let
-        m = NewGame newGameState & homeScoreL ?~ 0
-        in m ^. homeScoreL `shouldBe` Just 0
-
-awayScoreLSpec :: Spec
-awayScoreLSpec = describe "awayScoreL" $ do
-
-  context "getter" $ do
-
-    context "unexpected mode" $
-      it "should return Nothing" $
-        MainMenu ^. awayScoreL `shouldBe` Nothing
-
-    context "expected mode" $
-      it "should return 0" $ let
-        gs = newGameState & awayScore ?~ 0
-        m  = NewGame gs
-        in m ^. awayScoreL `shouldBe` Just 0
-
-  context "setter" $ do
-
-    context "unexpected mode" $
-      it "should set the away score" $ let
-        m = MainMenu & awayScoreL ?~ 0
-        in m ^. awayScoreL `shouldBe` Just 0
-
-    context "expected mode" $
-      it "should set the away score" $ let
-        m = NewGame newGameState & awayScoreL ?~ 0
-        in m ^. awayScoreL `shouldBe` Just 0
-
-teamScoreSpec :: Spec
-teamScoreSpec = describe "teamScore" $ do
-  let
-    m t = NewGame $ newGameState
-      & gameType  ?~ t
-      & homeScore ?~ 1
-      & awayScore ?~ 2
-    s t = newProgState
-      & progMode .~ m t
-
-  context "unexpected state" $
-    it "should return Nothing" $
-      teamScore newProgState `shouldBe` Nothing
-
-  context "HomeGame" $
-    it "should return 1" $
-      teamScore (s HomeGame) `shouldBe` Just 1
-
-  context "AwayGame" $
-    it "should return 2" $
-      teamScore (s AwayGame) `shouldBe` Just 2
-
-player :: Player
-player = newPlayer 1 "Joe" "centre"
-  & pYtd . psGoals        .~ 2
-  & pYtd . psAssists      .~ 3
-  & pYtd . psPMin         .~ 4
-  & pLifetime . psGoals   .~ 5
-  & pLifetime . psAssists .~ 6
-  & pLifetime . psPMin    .~ 7
-
-goalie :: Goalie
-goalie = newGoalie 1 "Joe"
-  & gYtd . gsGames             .~ 2
-  & gYtd . gsMinsPlayed        .~ 3
-  & gYtd . gsGoalsAllowed      .~ 4
-  & gYtd . gsGoalsAgainst      .~ 5
-  & gYtd . gsWins              .~ 6
-  & gYtd . gsLosses            .~ 7
-  & gYtd . gsTies              .~ 8
-  & gLifetime . gsGames        .~ 9
-  & gLifetime . gsMinsPlayed   .~ 10
-  & gLifetime . gsGoalsAllowed .~ 11
-  & gLifetime . gsGoalsAgainst .~ 12
-  & gLifetime . gsWins         .~ 13
-  & gLifetime . gsLosses       .~ 14
-  & gLifetime . gsTies         .~ 15
-
-db :: Database
-db = newDatabase
-  & dbPlayers .~ [player]
-  & dbGoalies .~ [goalie]
-  & dbGames   .~ 1
-
-playerJSON :: ByteString
-playerJSON = [r|
-  { "number": 1
-  , "name": "Joe"
-  , "position": "centre"
-  , "ytd":
-    { "goals": 2
-    , "assists": 3
-    , "penalty_mins": 4
-    }
-  , "lifetime":
-    { "goals": 5
-    , "assists": 6
-    , "penalty_mins": 7
-    }
-  }|]
-
-goalieJSON :: ByteString
-goalieJSON = [r|
-  { "number": 1
-  , "name": "Joe"
-  , "ytd":
-    { "games": 2
-    , "mins_played": 3
-    , "goals_allowed": 4
-    , "goals_against": 5
-    , "wins": 6
-    , "losses": 7
-    , "ties": 8
-    }
-  , "lifetime":
-    { "games": 9
-    , "mins_played": 10
-    , "goals_allowed": 11
-    , "goals_against": 12
-    , "wins": 13
-    , "losses": 14
-    , "ties": 15
-    }
-  }|]
-
-dbJSON :: ByteString
-dbJSON = [r|
-  { "players":
-    [ |] <> playerJSON <> [r| ]
-  , "goalies":
-    [ |] <> goalieJSON <> [r| ]
-  , "games": 1
-  }|]