Merge pull request 'switch from ncurses to brick' (#1) from brick into dev

Reviewed-on: #1

.gitignore

@@ -1,3 +1,6 @@
 .stack-work/
 mtlstats.cabal
+.vagrant
+data
+*.log
 *~

.travis.yml

@@ -1,40 +0,0 @@
-# This is the simple Travis configuration, which is intended for use
-# on applications which do not require cross-platform and
-# multiple-GHC-version support. For more information and other
-# options, see:
-#
-# https://docs.haskellstack.org/en/stable/travis_ci/
-#
-# Copy these contents into the root directory of your Github project in a file
-# named .travis.yml
-
-# Choose a build environment
-dist: xenial
-
-# Do not choose a language; we provide our own build tools.
-language: generic
-
-# Caching so the next build will be fast too.
-cache:
-  directories:
-  - $HOME/.stack
-
-# Ensure necessary system libraries are present
-addons:
-  apt:
-    packages:
-      - libgmp-dev
-
-before_install:
-# Download and unpack the stack executable
-- mkdir -p ~/.local/bin
-- export PATH=$HOME/.local/bin:$PATH
-- travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-
-install:
-# Build dependencies
-- stack --no-terminal --install-ghc test --only-dependencies
-
-script:
-# Build the package, its tests, and its docs and run the tests
-- stack --no-terminal test --haddock --no-haddock-deps

ChangeLog.md

@@ -1,18 +1,96 @@
 # Changelog for mtlstats
 
-## v0.4.0
+## current
+- updated code to use brick instead of ncurses
 
+## 0.16.1
+- Don't automatically start a new game on new season
+
+## 0.16.0
+- enter months by number
+
+## 0.15.2
+- allow ties
+
+## 0.15.1
+- only search for active players/goalies on game data input
+
+## 0.15.0
+- Ask for database to load on start-up
+- Add page break to report file
+- Implemented player/goalie deletion
+
+## 0.14.0
+- Fixed a bug that was causing shutouts to not be recorded
+- Output report to a text file (report.txt)
+
+## 0.13.0
+- Added autocomplete to player position prompt
+- Don't prompt for lifetime stats on rookie player/goalie creation
+- Ask whether a player/goalie is active on creation
+- Don't ask which goalie to assign the game to when there's only one
+
+## 0.12.0
+- Edit lifetime stats on new player/goalie creation
+- Sort goalies by minutes played
+- Subsort players by lifetime points
+- Changed wording on edit menus
+
+## 0.11.0
+- Added active flag to players/goalies
+- Clear rookie flag on new (regular) season
+- Save a copy of the database on new season
+- Implemented game standings editing
+- Added title screen
+- Changed sytling of menus
+
+## 0.10.0
+- Don't show player number zero in reports
+- Fixed player/goalie name capitalisation on edit
+- Return to correct edit menus after editing player stats
+- Enabled batch editing of player/goalie YTD/lifetime stats
+- Bugfix: allow user to edit goalie shutouts
+- Added line numbers to lifetime player/goalie reports
+- Implemented rookie flag
+
+## 0.9.0
+- Bugfix: Display lifetime stats in report, not YTD
+- Force expected capitalization on player/goalie names
+- Don't show lifetime totals in report
+- Sort players in YTD and lifetime reports by points
+- Moved player/goalie creation/editing to edit submenu
+
+## 0.8.0
+- Bugfix: removed quotation marks from goalie names in report
+- Allow lower case player names
+- Don't show players without points in game report
+- Removed unnecessary goalie statistics from game report
+- Fixed goalie average calculation
+
+## 0.7.0
+- Shortened views to fit within 25 lines
+- Implemented goalie reports
+
+## 0.6.0
+- Generate lifetime statistics report
+- Implemented goalie editing
+- Reset game standings on new season
+
+## 0.5.0
+- Fixed player creation bug
+- Prompt for goalie informaiton on game data entry
+- Implemented player editing
+
+## v0.4.0
 - Record penalty minutes
 - Calculate total game statistics
 - Generate year-to-date statistics report
 
 ## v0.3.0
-
 - Record goals and assists
 - Track goals for and goals against
 
 ## v0.2.0
-
 - Overtime losses don't count in the loss column
 - Confirm game data with user before updating stats
 - Implemented player creation

app/Main.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,10 +21,11 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Main where
 
-import Control.Monad.Trans.State (evalStateT)
+import Brick.Main (defaultMain)
-import UI.NCurses (runCurses)
+import Control.Monad (void)
 
 import Mtlstats
+import Mtlstats.Types
 
 main :: IO ()
-main = runCurses $ initState >>= evalStateT mainLoop
+main = void $ defaultMain app newProgState

package.yaml

@@ -1,37 +1,43 @@
 name:                mtlstats
-version:             0.4.0
+version:             0.16.1
-github:              "mtlstats/mtlstats"
+license:             GPL-3.0-or-later
-license:             GPL-3
 author:              "Jonathan Lamothe"
 maintainer:          "jlamothe1980@gmail.com"
-copyright:           "Rhéal Lamothe"
+copyright:           "1984, 1985, 2019-2021, 2023 Rhéal Lamothe"
 
 extra-source-files:
 - README.md
 - ChangeLog.md
 
 # Metadata used when publishing your package
-# synopsis:            Short description of your package
+synopsis:            Hockey statistics tracker
-# category:            Web
+category:            Statistics
 
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
+description:         Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
 
 dependencies:
 - base >= 4.7 && < 5
-- aeson >= 1.4.4.0 && < 1.5
+- aeson >= 2.0.3.0 && < 2.1
+- bytestring >= 0.11.4.0 && < 0.12
+- brick >= 1.4 && < 1.5
 - containers >= 0.6.0.1 && < 0.7
 - easy-file >= 0.2.2 && < 0.3
-- extra >= 1.6.17 && < 1.7
+- extra >= 1.7.13 && < 1.8
+- microlens >= 0.4.12.0 && < 0.5
+- microlens-mtl >= 0.2.0.3 && < 0.3
 - microlens-th >= 0.4.2.3 && < 0.5
-- ncurses >= 0.2.16 && < 0.3
+- mtl >= 2.2.2 && < 2.3
-- random >= 1.1 && < 1.2
+- random >= 1.2.1.1 && < 1.3
-- time >= 1.8.0.2 && < 1.9
+- text-zipper >= 0.12 && < 0.13
-- transformers >= 0.5.6.2 && < 0.6
+- time >= 1.11.1.1 && < 1.12
-- bytestring
+- vty >= 5.37 && < 5.38
-- microlens
+
+ghc-options:
+  - -Wall
+  - -Werror
 
 library:
   source-dirs: src
@@ -57,5 +63,5 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - mtlstats
-    - hspec >= 2.7.1 && < 2.8
+    - hspec >= 2.9.7 && < 2.10
     - unordered-containers

src/Mtlstats.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,56 +19,45 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE ScopedTypeVariables #-}
+module Mtlstats (app) where
 
-module Mtlstats (initState, mainLoop) where
+import Brick.AttrMap (AttrMap, forceAttrMap)
+import Brick.Main (App (..), halt, showFirstCursor)
+import Brick.Types (BrickEvent (VtyEvent), Widget)
+import Brick.Util (on)
+import Brick.Widgets.Core (fill)
+import Control.Monad.State.Class (gets)
+import Graphics.Vty.Attributes.Color (blue, white)
+import Graphics.Vty.Input.Events
+  ( Event (EvKey)
+  , Modifier (MCtrl)
+  , Key (KChar)
+  )
 
-import Control.Exception (IOException, catch)
-import Control.Monad (void)
-import Control.Monad.Extra (whenM)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State (get, gets)
-import Data.Aeson (decodeFileStrict)
-import Data.Maybe (fromJust, fromMaybe)
-import Lens.Micro ((&), (.~))
-import System.EasyFile (getAppUserDataDirectory, (</>))
-import qualified UI.NCurses as C
-
-import Mtlstats.Config
 import Mtlstats.Control
 import Mtlstats.Types
 
--- | Initializes the progran
+-- | The main application
-initState :: C.Curses ProgState
+app :: App ProgState () ()
-initState = do
+app = App
-  C.setEcho False
+  { appDraw         = draw
-  void $ C.setCursorMode C.CursorInvisible
+  , appChooseCursor = showFirstCursor
-  db <- liftIO $ do
+  , appHandleEvent  = handler
-    dir <- getAppUserDataDirectory appName
+  , appStartEvent   = return ()
-    let dbFile = dir </> dbFname
+  , appAttrMap      = const myAttrMap
-    fromMaybe newDatabase <$> catch
+  }
-      (decodeFileStrict dbFile)
-      (\(_ :: IOException) -> return Nothing)
-  return
-    $ newProgState
-    & database .~ db
 
--- | Main program loop
+draw :: ProgState -> [Widget ()]
-mainLoop :: Action ()
+draw s =
-mainLoop = do
+  [ drawController (dispatch s) s
+  , fill ' '
+  ]
+
+handler :: Handler ()
+handler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt
+handler e = do
   c <- gets dispatch
-  get >>= lift . draw . drawController c
+  handleController c e
-  w <- lift C.defaultWindow
-  whenM (lift (fromJust <$> C.getEvent w Nothing) >>= handleController c)
-    mainLoop
 
-draw :: C.Update C.CursorMode -> C.Curses ()
+myAttrMap :: AttrMap
-draw u = do
+myAttrMap = forceAttrMap (white `on` blue)
-  void $ C.setCursorMode C.CursorInvisible
-  w  <- C.defaultWindow
-  cm <- C.updateWindow w $ do
-    C.clear
-    u
-  C.render
-  void $ C.setCursorMode cm

src/Mtlstats/Actions.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,41 +19,56 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Mtlstats.Actions
   ( startNewSeason
   , resetYtd
+  , clearRookies
+  , resetStandings
   , startNewGame
-  , addChar
-  , removeChar
-  , overtimeCheck
-  , updateGameStats
-  , validateGameDate
   , createPlayer
+  , createGoalie
+  , edit
+  , editPlayer
+  , editSelectedPlayer
+  , editGoalie
+  , editSelectedGoalie
   , addPlayer
-  , recordGoalAssists
+  , addGoalie
-  , awardGoal
+  , resetCreatePlayerState
-  , awardAssist
+  , resetCreateGoalieState
-  , resetGoalData
-  , assignPMins
   , backHome
-  , scrollUp
+  , clearEditor
-  , scrollDown
+  , loadDatabase
+  , saveDatabase
   ) where
 
-import Control.Monad.Trans.State (modify)
+import Brick.Main (viewportScroll)
-import qualified Data.Map as M
+import Brick.Widgets.Edit (Editor, applyEdit)
+import Control.Exception (IOException, catch)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Class (modify)
+import Data.Aeson (decodeFileStrict, encodeFile)
 import Data.Maybe (fromMaybe)
-import Data.Time.Calendar (fromGregorianValid)
+import Data.Text.Zipper (gotoBOF, killToEOF)
-import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
+import Lens.Micro ((^.), (&), (.~), (%~))
+import Lens.Micro.Mtl ((.=), use)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , getAppUserDataDirectory
+  , (</>)
+  )
 
+import Mtlstats.Config
 import Mtlstats.Types
 import Mtlstats.Util
 
 -- | Starts a new season
 startNewSeason :: ProgState -> ProgState
-startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
+startNewSeason
+  = (progMode .~ NewSeason False)
+  . (database.dbGames .~ 0)
 
 -- | Resets all players year-to-date stats
 resetYtd :: ProgState -> ProgState
@@ -61,189 +76,156 @@ resetYtd
   = (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
   . (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
 
+-- | Clears the rookie flag from all players/goalies
+clearRookies :: ProgState -> ProgState
+clearRookies = database
+  %~ (dbPlayers %~ map (pRookie .~ False))
+  .  (dbGoalies %~ map (gRookie .~ False))
+
+-- | Resets game standings
+resetStandings :: ProgState -> ProgState
+resetStandings = database
+  %~ ( dbHomeGameStats .~ newGameStats)
+  .  ( dbAwayGameStats .~ newGameStats)
+
 -- | Starts a new game
 startNewGame :: ProgState -> ProgState
 startNewGame
   = (progMode .~ NewGame newGameState)
   . (database . dbGames %~ succ)
 
--- | Adds a character to the input buffer
-addChar :: Char -> ProgState -> ProgState
-addChar c = inputBuffer %~ (++[c])
-
--- | Removes a character from the input buffer (if possible)
-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
-  let gs = s^.progMode.gameStateL
-  gType  <- gs^.gameType
-  won    <- gameWon gs
-  lost   <- gameLost gs
-  ot     <- gs^.overtimeFlag
-  tScore <- teamScore gs
-  oScore <- otherScore gs
-  let
-    hw  = if gType == HomeGame && won then 1 else 0
-    hl  = if gType == HomeGame && lost then 1 else 0
-    hot = if gType == HomeGame && ot then 1 else 0
-    hgf = if gType == HomeGame then tScore else 0
-    hga = if gType == HomeGame then oScore else 0
-    aw  = if gType == AwayGame && won then 1 else 0
-    al  = if gType == AwayGame && lost then 1 else 0
-    aot = if gType == AwayGame && ot then 1 else 0
-    agf = if gType == AwayGame then tScore else 0
-    aga = if gType == AwayGame then oScore else 0
-  Just $ s
-    & database.dbHomeGameStats
-      %~ (gmsWins         +~ hw)
-      .  (gmsLosses       +~ hl)
-      .  (gmsOvertime     +~ hot)
-      .  (gmsGoalsFor     +~ hgf)
-      .  (gmsGoalsAgainst +~ hga)
-    & database.dbAwayGameStats
-      %~ (gmsWins         +~ aw)
-      .  (gmsLosses       +~ al)
-      .  (gmsOvertime     +~ aot)
-      .  (gmsGoalsFor     +~ agf)
-      .  (gmsGoalsAgainst +~ aga)
-
--- | Validates the game date
-validateGameDate :: ProgState -> ProgState
-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
-
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
 createPlayer = let
-  cb = modify $ progMode .~ MainMenu
+  callback = modify edit
-  cps
+  cps = newCreatePlayerState
-    = newCreatePlayerState
+    & cpsSuccessCallback .~ callback
-    & cpsSuccessCallback .~ cb
+    & cpsFailureCallback .~ callback
-    & cpsFailureCallback .~ cb
   in progMode .~ CreatePlayer cps
 
+-- | Starts goalie creation mode
+createGoalie :: ProgState -> ProgState
+createGoalie = let
+  callback = modify edit
+  cgs = newCreateGoalieState
+    & cgsSuccessCallback .~ callback
+    & cgsFailureCallback .~ callback
+  in progMode .~ CreateGoalie cgs
+
+-- | Launches the edit menu
+edit :: ProgState -> ProgState
+edit = progMode .~ EditMenu
+
+-- | Starts the player editing process
+editPlayer :: ProgState -> ProgState
+editPlayer = progMode .~ EditPlayer newEditPlayerState
+
+-- | Edits the selected 'Player'
+editSelectedPlayer
+  :: (Player -> Player)
+  -- ^ The modification to be made to the 'Player'
+  -> ProgState
+  -> ProgState
+editSelectedPlayer f s = fromMaybe s $ do
+  n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
+  let
+    players  = s^.database.dbPlayers
+    players' = modifyNth n f players
+  Just $ s & database.dbPlayers .~ players'
+
+-- | Starts the 'Goalie' editing process
+editGoalie :: ProgState -> ProgState
+editGoalie = progMode .~ EditGoalie newEditGoalieState
+
+-- | Edits the selected 'Goalie'
+editSelectedGoalie
+  :: (Goalie -> Goalie)
+  -- ^ The modification to be made to the 'Goalie'
+  -> ProgState
+  -> ProgState
+editSelectedGoalie f s = fromMaybe s $ do
+  n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+  let
+    goalies  = s^.database.dbGoalies
+    goalies' = modifyNth n f goalies
+  Just $ s & database.dbGoalies .~ goalies'
+
 -- | Adds the entered player to the roster
 addPlayer :: ProgState -> ProgState
 addPlayer s = fromMaybe s $ do
   let cps = s^.progMode.createPlayerStateL
   num   <- cps^.cpsNumber
+  rFlag <- cps^.cpsRookieFlag
+  aFlag <- cps^.cpsActiveFlag
   let
     name   = cps^.cpsName
     pos    = cps^.cpsPosition
     player = newPlayer num name pos
+      & pRookie .~ rFlag
+      & pActive .~ aFlag
   Just $ s & database.dbPlayers
     %~ (++[player])
 
--- | Awards the goal and assists to the players
+-- | Adds the entered goalie to the roster
-recordGoalAssists :: ProgState -> ProgState
+addGoalie :: ProgState -> ProgState
-recordGoalAssists ps = fromMaybe ps $ do
+addGoalie s = fromMaybe s $ do
-  let gs = ps^.progMode.gameStateL
+  let cgs = s^.progMode.createGoalieStateL
-  goalId <- gs^.goalBy
+  num   <- cgs^.cgsNumber
-  let assistIds = gs^.assistsBy
+  rFlag <- cgs^.cgsRookieFlag
-  Just $ ps
+  aFlag <- cgs^.cgsActiveFlag
-    & awardGoal goalId
+  let
-    & (\s -> foldr awardAssist s assistIds)
+    name   = cgs^.cgsName
-    & progMode.gameStateL
+    goalie = newGoalie num name
-      %~ (goalBy              .~ Nothing)
+      & gRookie .~ rFlag
-      .  (assistsBy           .~ [])
+      & gActive .~ aFlag
-      .  (pointsAccounted     %~ succ)
+  Just $ s & database.dbGoalies
-      .  (confirmGoalDataFlag .~ False)
+    %~ (++[goalie])
 
--- | Awards a goal to a player
+-- | Resets the 'CreatePlayerState' value
-awardGoal
+resetCreatePlayerState :: ProgState -> ProgState
-  :: Int
+resetCreatePlayerState = progMode.createPlayerStateL
-  -- ^ The player's index number
+  %~ (cpsNumber   .~ Nothing)
-  -> ProgState
+  .  (cpsName     .~ "")
-  -> ProgState
+  .  (cpsPosition .~ "")
-awardGoal n ps = ps
-  & progMode.gameStateL.gamePlayerStats %~
-    (\m -> let
-      stats = M.findWithDefault newPlayerStats n m
-      in M.insert n (stats & psGoals %~ succ) m)
-  & database.dbPlayers %~ map
-    (\(i, p) -> if i == n
-      then p
-        & pYtd.psGoals      %~ succ
-        & pLifetime.psGoals %~ succ
-      else p) . zip [0..]
 
--- | Awards an assist to a player
+-- | Resets the 'CreateGoalieState' value
-awardAssist
+resetCreateGoalieState :: ProgState -> ProgState
-  :: Int
+resetCreateGoalieState = progMode.createGoalieStateL
-  -- ^ The player's index number
+  %~ (cgsNumber .~ Nothing)
-  -> ProgState
+  .  (cgsName   .~ "")
-  -> 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  .~ "")
+  . (editorW  %~ clearEditor)
-  . (scrollOffset .~ 0)
+  . (scroller .~ viewportScroll ())
 
--- | Scrolls the display up
+-- | Clears an editor
-scrollUp :: ProgState -> ProgState
+clearEditor :: Editor String () -> Editor String ()
-scrollUp = scrollOffset %~ max 0 . pred
+clearEditor = applyEdit $ killToEOF . gotoBOF
 
--- | Scrolls the display down
+-- | Loads the database
-scrollDown :: ProgState -> ProgState
+loadDatabase :: Action ()
-scrollDown = scrollOffset %~ succ
+loadDatabase = do
+  dbFile <- dbSetup
+  liftIO
+    (catch
+      (decodeFileStrict dbFile)
+      (\(_ :: IOException) -> return Nothing))
+    >>= mapM_ (database .=)
+
+-- | Saves the database
+saveDatabase :: Action ()
+saveDatabase = do
+  db     <- use database
+  dbFile <- dbSetup
+  liftIO $ encodeFile dbFile db
+
+dbSetup :: Action String
+dbSetup = do
+  fn <- use dbName
+  liftIO $ do
+    dir <- getAppUserDataDirectory appName
+    createDirectoryIfMissing True dir
+    return $ dir </> fn ++ ".json"

src/Mtlstats/Actions/EditStandings.hs

@@ -0,0 +1,70 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Actions.EditStandings
+  ( editStandings
+  , editHomeStandings
+  , editAwayStandings
+  , editWins
+  , editLosses
+  , editOvertime
+  , editGoalsFor
+  , editGoalsAgainst
+  ) where
+
+import Lens.Micro ((.~))
+
+import Mtlstats.Types
+
+-- | Enters edit standings mode
+editStandings :: ProgState -> ProgState
+editStandings = progMode .~ EditStandings ESMMenu
+
+-- | Edits the home standings
+editHomeStandings :: ProgState -> ProgState
+editHomeStandings = progMode .~ EditStandings (ESMHome ESMSubMenu)
+
+-- | Edits the road standings
+editAwayStandings :: ProgState -> ProgState
+editAwayStandings = progMode .~ EditStandings (ESMAway ESMSubMenu)
+
+-- | Changes to edit wins mode
+editWins :: ProgState -> ProgState
+editWins = doEdit ESMEditWins
+
+-- | Changes to edit losses mode
+editLosses :: ProgState -> ProgState
+editLosses = doEdit ESMEditLosses
+
+-- | Changes to edit overtime mode
+editOvertime :: ProgState -> ProgState
+editOvertime = doEdit ESMEditOvertime
+
+-- | Changes to edit goals for mode
+editGoalsFor :: ProgState -> ProgState
+editGoalsFor = doEdit ESMEditGoalsFor
+
+-- | Changes to edit goals against mode
+editGoalsAgainst :: ProgState -> ProgState
+editGoalsAgainst = doEdit ESMEditGoalsAgainst
+
+doEdit :: ESMSubMode -> ProgState -> ProgState
+doEdit = (progMode.editStandingsModeL.esmSubModeL .~)

src/Mtlstats/Actions/NewGame.hs

@@ -0,0 +1,191 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Actions.NewGame
+  ( overtimeCheck
+  , updateGameStats
+  , validateGameDate
+  , recordGoalAssists
+  , awardGoal
+  , awardAssist
+  , resetGoalData
+  , assignPMins
+  , awardShutouts
+  ) where
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Time.Calendar (fromGregorianValid)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
+
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Determines whether or not to perform a check for overtime
+overtimeCheck :: ProgState -> ProgState
+overtimeCheck s
+  | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
+    s & progMode.gameStateL.overtimeFlag ?~ True
+  | 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
+  let gs = s^.progMode.gameStateL
+  gType  <- gs^.gameType
+  won    <- gameWon gs
+  lost   <- gameLost gs
+  ot     <- gs^.overtimeFlag
+  tScore <- teamScore gs
+  oScore <- otherScore gs
+  let
+    hw  = if gType == HomeGame && won then 1 else 0
+    hl  = if gType == HomeGame && lost then 1 else 0
+    hot = if gType == HomeGame && ot then 1 else 0
+    hgf = if gType == HomeGame then tScore else 0
+    hga = if gType == HomeGame then oScore else 0
+    aw  = if gType == AwayGame && won then 1 else 0
+    al  = if gType == AwayGame && lost then 1 else 0
+    aot = if gType == AwayGame && ot then 1 else 0
+    agf = if gType == AwayGame then tScore else 0
+    aga = if gType == AwayGame then oScore else 0
+  Just $ s
+    & database.dbHomeGameStats
+      %~ (gmsWins         +~ hw)
+      .  (gmsLosses       +~ hl)
+      .  (gmsOvertime     +~ hot)
+      .  (gmsGoalsFor     +~ hgf)
+      .  (gmsGoalsAgainst +~ hga)
+    & database.dbAwayGameStats
+      %~ (gmsWins         +~ aw)
+      .  (gmsLosses       +~ al)
+      .  (gmsOvertime     +~ aot)
+      .  (gmsGoalsFor     +~ agf)
+      .  (gmsGoalsAgainst +~ aga)
+
+-- | Validates the game date
+validateGameDate :: ProgState -> ProgState
+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
+
+-- | Awards the goal and assists to the players
+recordGoalAssists :: ProgState -> ProgState
+recordGoalAssists ps = fromMaybe ps $ do
+  let gs = ps^.progMode.gameStateL
+  goalId <- gs^.goalBy
+  let assistIds = gs^.assistsBy
+  Just $ ps
+    & awardGoal goalId
+    & (\s -> foldr awardAssist s assistIds)
+    & progMode.gameStateL
+      %~ (goalBy              .~ Nothing)
+      .  (assistsBy           .~ [])
+      .  (pointsAccounted     %~ succ)
+      .  (confirmGoalDataFlag .~ False)
+
+-- | Awards a goal to a player
+awardGoal
+  :: Int
+  -- ^ The player's index number
+  -> ProgState
+  -> ProgState
+awardGoal n ps = ps
+  & progMode.gameStateL.gamePlayerStats %~
+    (\m -> let
+      stats = M.findWithDefault newPlayerStats n m
+      in M.insert n (stats & psGoals %~ succ) m)
+  & database.dbPlayers %~ zipWith
+    (\i p -> if i == n
+      then p
+        & pYtd.psGoals      %~ succ
+        & pLifetime.psGoals %~ succ
+      else p)
+    [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 %~ zipWith
+    (\i p -> if i == n
+      then p
+        & pYtd.psAssists      %~ succ
+        & pLifetime.psAssists %~ succ
+      else p)
+    [0..]
+
+-- | Resets the entered data for the current goal
+resetGoalData :: ProgState -> ProgState
+resetGoalData ps = ps & progMode.gameStateL
+  %~ (goalBy              .~ Nothing)
+  .  (assistsBy           .~ [])
+  .  (confirmGoalDataFlag .~ False)
+
+-- | Adds penalty minutes to a player
+assignPMins
+  :: Int
+  -- ^ The number of minutes to add
+  -> ProgState
+  -> ProgState
+assignPMins mins s = fromMaybe s $ do
+  n <- s^.progMode.gameStateL.gameSelectedPlayer
+  Just $ s
+    & database.dbPlayers %~ modifyNth n
+      (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
+    & progMode.gameStateL
+      %~ ( gamePlayerStats %~ updateMap n newPlayerStats
+           (psPMin +~ mins)
+         )
+      .  (gameSelectedPlayer .~ Nothing)
+
+-- | Awards a shutout to any 'Goalie' who played and didn't allow any
+-- goals
+awardShutouts :: ProgState -> ProgState
+awardShutouts s = foldl
+  (\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0
+    then s'
+      & database.dbGoalies %~ modifyNth gid
+        ( ( gYtd.gsShutouts      %~ succ )
+        . ( gLifetime.gsShutouts %~ succ )
+        )
+      & progMode.gameStateL.gameGoalieStats %~ M.adjust
+        (gsShutouts %~ succ)
+        gid
+    else s')
+  s
+  (M.toList $ s^.progMode.gameStateL.gameGoalieStats)

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -0,0 +1,117 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Actions.NewGame.GoalieInput
+  ( finishGoalieEntry
+  , recordGoalieStats
+  , setGameGoalie
+  ) where
+
+import Control.Monad (void)
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.), (&), (.~), (%~), (+~))
+
+import Mtlstats.Config
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Attempts to finish game goalie entry
+finishGoalieEntry :: ProgState -> ProgState
+finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
+  []         -> s
+  [(gid, _)] -> setGameGoalie gid s'
+  _          -> s'
+  where
+    s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
+
+-- | Records the goalie's game stats
+recordGoalieStats :: ProgState -> ProgState
+recordGoalieStats s = fromMaybe s $ do
+  let gs = s^.progMode.gameStateL
+  gid   <- gs^.gameSelectedGoalie
+  mins  <- gs^.gameGoalieMinsPlayed
+  goals <- gs^.gameGoalsAllowed
+  void $ nth gid $ s^.database.dbGoalies
+
+  let
+    gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
+    bumpVal   = if gameStats^.gsGames == 0
+      then 1
+      else 0
+
+    bumpStats
+      = (gsGames        +~ bumpVal)
+      . (gsMinsPlayed   +~ mins)
+      . (gsGoalsAllowed +~ goals)
+
+    tryFinish = if mins >= gameLength
+      then finishGoalieEntry
+      else id
+
+  Just $ s
+    & progMode.gameStateL
+      %~ (gameGoalieStats    %~ updateMap gid newGoalieStats bumpStats)
+      .  (gameSelectedGoalie   .~ Nothing)
+      .  (gameGoalieMinsPlayed .~ Nothing)
+      .  (gameGoalsAllowed     .~ Nothing)
+    & database.dbGoalies
+      %~ modifyNth gid (\goalie -> goalie
+         & gYtd      %~ bumpStats
+         & gLifetime %~ bumpStats)
+    & tryFinish
+
+-- | Records the win, loss, or tie to a specific 'Goalie'
+setGameGoalie
+  :: Int
+  -- ^ The goalie's index
+  -> ProgState
+  -> ProgState
+setGameGoalie gid s = fromMaybe s $ do
+  let gs = s^.progMode.gameStateL
+  won     <- gameWon gs
+  lost    <- gameLost gs
+  tied    <- gs^.overtimeFlag
+  shutout <- (==0) <$> otherScore gs
+
+  let
+    w  = if won then 1 else 0
+    l  = if lost then 1 else 0
+    t  = if tied then 1 else 0
+    so = if shutout then 1 else 0
+
+    updateStats
+      = (gsWins     +~ w)
+      . (gsLosses   +~ l)
+      . (gsTies     +~ t)
+      . (gsShutouts +~ so)
+
+    updateGoalie
+      = (gYtd      %~ updateStats)
+      . (gLifetime %~ updateStats)
+
+    updateGameState
+      = (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
+      . (gameGoalieAssigned .~ True)
+
+  Just $ s
+    & database.dbGoalies  %~ modifyNth gid updateGoalie
+    & progMode.gameStateL %~ updateGameState

src/Mtlstats/Config.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -33,10 +33,18 @@ maxFunKeys = 9
 appName :: String
 appName = "mtlstats"
 
--- | The database filename
-dbFname :: String
-dbFname = "database.json"
-
 -- | The maximum number of assists
 maxAssists :: Int
 maxAssists = 2
+
+-- | The length of a typical game (in minutes)
+gameLength :: Int
+gameLength = 60
+
+-- | Report output filename
+reportFilename :: FilePath
+reportFilename = "report.txt"
+
+-- | Number of columns in report file
+reportCols :: Int
+reportCols = 79

src/Mtlstats/Control.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,328 +21,45 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (join, when)
+import Lens.Micro ((^.))
-import Control.Monad.Trans.State (gets, modify)
-import Data.Char (toUpper)
-import Data.Maybe (fromJust, fromMaybe, isJust)
-import Lens.Micro ((^.), (.~), (%~))
-import Lens.Micro.Extras (view)
-import qualified UI.NCurses as C
 
-import Mtlstats.Actions
+import Mtlstats.Control.CreateGoalie
-import Mtlstats.Format
+import Mtlstats.Control.CreatePlayer
-import Mtlstats.Handlers
+import Mtlstats.Control.EditGoalie
+import Mtlstats.Control.EditPlayer
+import Mtlstats.Control.EditStandings
+import Mtlstats.Control.NewGame
+import Mtlstats.Control.TitleScreen
 import Mtlstats.Menu
 import Mtlstats.Prompt
-import Mtlstats.Report
 import Mtlstats.Types
-import Mtlstats.Util
 
 -- | Reads the program state and returs the apropriate controller to
 -- run
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-  MainMenu  -> mainMenuC
+  TitleScreen         -> titleScreenC
-  NewSeason -> newSeasonC
+  MainMenu            -> mainMenuC s
-  NewGame gs
+  NewSeason flag      -> newSeasonC flag
-    | null $ gs^.gameYear             -> gameYearC
+  NewGame gs          -> newGameC gs
-    | null $ gs^.gameMonth            -> gameMonthC
+  EditMenu            -> editMenuC
-    | null $ gs^.gameDay              -> gameDayC
+  CreatePlayer cps    -> createPlayerC cps
-    | null $ gs^.gameType             -> gameTypeC
+  CreateGoalie cgs    -> createGoalieC cgs
-    | null $ gs^.otherTeam            -> otherTeamC
+  EditPlayer eps      -> editPlayerC eps
-    | null $ gs^.homeScore            -> homeScoreC
+  EditGoalie egs      -> editGoalieC egs
-    | null $ gs^.awayScore            -> awayScoreC
+  (EditStandings esm) -> editStandingsC esm
-    | null $ gs^.overtimeFlag         -> overtimeFlagC
-    | not $ gs^.dataVerified          -> verifyDataC
-    | fromJust (unaccountedPoints gs) -> goalInput gs
-    | isJust $ gs^.selectedPlayer     -> getPMinsC
-    | not $ gs^.pMinsRecorded         -> pMinPlayerC
-    | otherwise                       -> reportC
-  CreatePlayer cps
-    | null $ cps^.cpsNumber   -> getPlayerNumC
-    | null $ cps^.cpsName     -> getPlayerNameC
-    | null $ cps^.cpsPosition -> getPlayerPosC
-    | otherwise               -> confirmCreatePlayerC
 
-mainMenuC :: Controller
+mainMenuC :: ProgState -> Controller
-mainMenuC = Controller
+mainMenuC s = if null $ s^.dbName
+  then promptController getDBPrompt
+  else Controller
     { drawController   = const $ drawMenu mainMenu
     , handleController = menuHandler mainMenu
     }
 
-newSeasonC :: Controller
+newSeasonC :: Bool -> Controller
-newSeasonC = Controller
+newSeasonC False = promptController newSeasonPrompt
-  { drawController   = const $ drawMenu newSeasonMenu
+newSeasonC True  = menuController newSeasonMenu
-  , handleController = \e -> do
-    menuHandler newSeasonMenu e
-    return True
-  }
 
-gameYearC :: Controller
+editMenuC :: Controller
-gameYearC = Controller
+editMenuC = menuController editMenu
-  { drawController = \s -> do
-    header s
-    drawPrompt gameYearPrompt s
-  , handleController = \e -> do
-    promptHandler gameYearPrompt e
-    return True
-  }
-
-gameMonthC :: Controller
-gameMonthC = Controller
-  { drawController = \s -> do
-    header s
-    drawMenu gameMonthMenu
-  , handleController = \e -> do
-    menuHandler gameMonthMenu e
-    return True
-  }
-
-gameDayC :: Controller
-gameDayC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt gameDayPrompt s
-  , handleController = \e -> do
-    promptHandler gameDayPrompt e
-    modify validateGameDate
-    return True
-  }
-
-gameTypeC :: Controller
-gameTypeC = Controller
-  { drawController = \s -> do
-    header s
-    drawMenu gameTypeMenu
-  , handleController = \e -> do
-    menuHandler gameTypeMenu e
-    return True
-  }
-
-otherTeamC :: Controller
-otherTeamC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt otherTeamPrompt s
-  , handleController = \e -> do
-    promptHandler otherTeamPrompt e
-    return True
-  }
-
-homeScoreC :: Controller
-homeScoreC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt homeScorePrompt s
-  , handleController = \e -> do
-    promptHandler homeScorePrompt e
-    return True
-  }
-
-awayScoreC :: Controller
-awayScoreC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt awayScorePrompt s
-  , handleController = \e -> do
-    promptHandler awayScorePrompt e
-    modify overtimeCheck
-    return True
-  }
-
-overtimeFlagC :: Controller
-overtimeFlagC = Controller
-  { drawController = \s -> do
-    header s
-    C.drawString "Did the game go into overtime?  (Y/N)"
-    return C.CursorInvisible
-  , handleController = \e -> do
-    modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
-    return True
-  }
-
-verifyDataC :: Controller
-verifyDataC = Controller
-  { drawController = \s -> do
-    let gs = s^.progMode.gameStateL
-    header s
-    C.drawString "\n"
-    C.drawString $ "      Date: " ++ gameDate gs ++ "\n"
-    C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
-    C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
-    C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
-    C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
-    C.drawString $ "  Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
-    C.drawString "Is the above information correct?  (Y/N)"
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case ynHandler e of
-      Just True  -> do
-        modify $ progMode.gameStateL.dataVerified .~ True
-        modify updateGameStats
-      Just False -> modify $ progMode.gameStateL .~ newGameState
-      Nothing    -> return ()
-    return True
-  }
-
-goalInput :: GameState -> Controller
-goalInput gs
-  | null (gs^.goalBy            ) = recordGoalC
-  | not (gs^.confirmGoalDataFlag) = recordAssistC
-  | otherwise                     = confirmGoalDataC
-
-recordGoalC :: Controller
-recordGoalC = Controller
-  { drawController = \s -> let
-    (game, goal) = gameGoal s
-    in drawPrompt (recordGoalPrompt game goal) s
-  , handleController = \e -> do
-    (game, goal) <- gets gameGoal
-    promptHandler (recordGoalPrompt game goal) e
-    return True
-  }
-
-recordAssistC :: Controller
-recordAssistC = Controller
-  { drawController = \s -> let
-    (game, goal, assist) = gameGoalAssist s
-    in drawPrompt (recordAssistPrompt game goal assist) s
-  , handleController = \e -> do
-    (game, goal, assist) <- gets gameGoalAssist
-    promptHandler (recordAssistPrompt game goal assist) e
-    return True
-  }
-
-confirmGoalDataC :: Controller
-confirmGoalDataC = Controller
-  { drawController = \s -> do
-    let
-      (game, goal) = gameGoal s
-      gs           = s^.progMode.gameStateL
-      players      = s^.database.dbPlayers
-      msg          = unlines $
-        [ "          Game: " ++ padNum 2 game
-        , "          Goal: " ++ show goal
-        , "Goal scored by: " ++
-          playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
-        ] ++
-        map
-          (\pid -> "   Assisted by: " ++
-            playerSummary (fromJust $ nth pid players))
-          (gs^.assistsBy) ++
-        [ ""
-        , "Is the above information correct? (Y/N)"
-        ]
-    C.drawString msg
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case ynHandler e of
-      Just True  -> modify recordGoalAssists
-      Just False -> modify resetGoalData
-      Nothing    -> return ()
-    return True
-  }
-
-pMinPlayerC :: Controller
-pMinPlayerC = Controller
-  { drawController = \s -> do
-    header s
-    drawPrompt pMinPlayerPrompt s
-  , handleController = \e -> do
-    promptHandler pMinPlayerPrompt e
-    return True
-  }
-
-getPMinsC :: Controller
-getPMinsC = Controller
-  { drawController = \s -> do
-    header s
-    C.drawString $ fromMaybe "" $ do
-      pid    <- s^.progMode.gameStateL.selectedPlayer
-      player <- nth pid $ s^.database.dbPlayers
-      Just $ playerSummary player ++ "\n"
-    drawPrompt assignPMinsPrompt s
-  , handleController = \e -> do
-    promptHandler assignPMinsPrompt e
-    return True
-  }
-
-reportC :: Controller
-reportC = Controller
-  { drawController = \s -> do
-    (rows, cols) <- C.windowSize
-    C.drawString $ unlines $ slice
-      (s^.scrollOffset)
-      (fromInteger $ pred rows)
-      (report (fromInteger $ pred cols) s)
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case e of
-      C.EventSpecialKey C.KeyUpArrow   -> modify scrollUp
-      C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
-      C.EventSpecialKey C.KeyHome      -> modify $ scrollOffset .~ 0
-      C.EventSpecialKey _              -> modify backHome
-      C.EventCharacter _               -> modify backHome
-      _                                -> return ()
-    return True
-  }
-
-header :: ProgState -> C.Update ()
-header s = C.drawString $
-  "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
-
-getPlayerNumC :: Controller
-getPlayerNumC = Controller
-  { drawController   = drawPrompt playerNumPrompt
-  , handleController = \e -> do
-    promptHandler playerNumPrompt e
-    return True
-  }
-
-getPlayerNameC :: Controller
-getPlayerNameC = Controller
-  { drawController   = drawPrompt playerNamePrompt
-  , handleController = \e -> do
-    promptHandler playerNamePrompt e
-    return True
-  }
-
-getPlayerPosC :: Controller
-getPlayerPosC = Controller
-  { drawController   = drawPrompt playerPosPrompt
-  , handleController = \e -> do
-    promptHandler playerPosPrompt e
-    return True
-  }
-
-confirmCreatePlayerC :: Controller
-confirmCreatePlayerC = Controller
-  { drawController = \s -> do
-    let cps = s^.progMode.createPlayerStateL
-    C.drawString $ "  Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
-    C.drawString $ "    Player name: " ++ cps^.cpsName ++ "\n"
-    C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
-    C.drawString "Create player: are you sure?  (Y/N)"
-    return C.CursorInvisible
-  , handleController = \e -> do
-    case ynHandler e of
-      Just True -> do
-        modify addPlayer
-        join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
-      Just False ->
-        join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
-      Nothing -> return ()
-    return True
-  }
-
-gameGoal :: ProgState -> (Int, Int)
-gameGoal s =
-  ( s^.database.dbGames
-  , succ $ s^.progMode.gameStateL.pointsAccounted
-  )
-
-gameGoalAssist :: ProgState -> (Int, Int, Int)
-gameGoalAssist s = let
-  (game, goal) = gameGoal s
-  assist       = succ $ length $ s^.progMode.gameStateL.assistsBy
-  in (game, goal, assist)

src/Mtlstats/Control/CreateGoalie.hs

@@ -0,0 +1,102 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.CreateGoalie (createGoalieC) where
+
+import Brick.Widgets.Core (str)
+import Control.Monad.State.Class (gets, modify)
+import Lens.Micro ((^.), (.~), (?~), (%~), to)
+import Lens.Micro.Mtl ((.=))
+
+import Mtlstats.Actions
+import Mtlstats.Format
+import Mtlstats.Handlers
+import Mtlstats.Prompt
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Handles goalie creation
+createGoalieC :: CreateGoalieState -> Controller
+createGoalieC cgs
+  | null $ cgs^.cgsNumber     = getGoalieNumC
+  | null $ cgs^.cgsName       = getGoalieNameC
+  | null $ cgs^.cgsRookieFlag = getRookieFlagC
+  | null $ cgs^.cgsActiveFlag = getActiveFlagC
+  | otherwise                 = confirmCreateGoalieC
+
+getGoalieNumC :: Controller
+getGoalieNumC = promptController goalieNumPrompt
+
+getGoalieNameC :: Controller
+getGoalieNameC = promptController goalieNamePrompt
+
+getRookieFlagC :: Controller
+getRookieFlagC = Controller
+  { drawController = const $
+    str "Is this goalie a rookie? (Y/N)"
+  , handleController = \e ->
+    modify $ case ynHandler e of
+      Just True -> progMode.createGoalieStateL
+        %~ (cgsRookieFlag ?~ True)
+        .  (cgsActiveFlag ?~ True)
+      rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
+  }
+
+getActiveFlagC :: Controller
+getActiveFlagC = Controller
+  { drawController = const $ str "Is this goalie active? (Y/N)"
+  , handleController = \e ->
+    progMode.createGoalieStateL.cgsActiveFlag .= ynHandler e
+  }
+
+confirmCreateGoalieC :: Controller
+confirmCreateGoalieC = Controller
+  { drawController = \s -> let
+    cgs = s^.progMode.createGoalieStateL
+    in linesToWidget
+      $  labelTable
+         [ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber     )
+         , ( "Goalie name",   cgs^.cgsName                        )
+         , ( "Rookie",        maybe "?" show $ cgs^.cgsRookieFlag )
+         , ( "Active",        maybe "?" show $ cgs^.cgsActiveFlag )
+         ]
+      ++ [ ""
+         , "Create goalie: are you sure?  (Y/N)"
+         ]
+  , handleController = \e -> do
+    cgs <- gets (^.progMode.createGoalieStateL)
+    let
+      success = cgs^.cgsSuccessCallback
+      failure = cgs^.cgsFailureCallback
+    case ynHandler e of
+      Just True -> do
+        gid <- gets (^.database.dbGoalies.to length)
+        let rookie = cgs^.cgsRookieFlag == Just True
+        modify addGoalie
+        if rookie
+          then success
+          else modify $ progMode.editGoalieStateL
+            %~ (egsSelectedGoalie ?~ gid)
+            .  (egsMode           .~ EGLtGames True)
+            .  (egsCallback       .~ success)
+      Just False -> failure
+      Nothing    -> return ()
+  }

src/Mtlstats/Control/CreatePlayer.hs

@@ -0,0 +1,105 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.CreatePlayer (createPlayerC) where
+
+import Brick.Widgets.Core (str)
+import Control.Monad.State.Class (gets, modify)
+import Lens.Micro ((^.), (.~), (?~), (%~), to)
+import Lens.Micro.Mtl ((.=), use)
+
+import Mtlstats.Actions
+import Mtlstats.Format
+import Mtlstats.Handlers
+import Mtlstats.Prompt
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Handles player creation
+createPlayerC :: CreatePlayerState -> Controller
+createPlayerC cps
+  | null $ cps^.cpsNumber     = getPlayerNumC
+  | null $ cps^.cpsName       = getPlayerNameC
+  | null $ cps^.cpsPosition   = getPlayerPosC
+  | null $ cps^.cpsRookieFlag = getRookieFlagC
+  | null $ cps^.cpsActiveFlag = getActiveFlagC
+  | otherwise                 = confirmCreatePlayerC
+
+getPlayerNumC :: Controller
+getPlayerNumC = promptController playerNumPrompt
+
+getPlayerNameC :: Controller
+getPlayerNameC = promptController playerNamePrompt
+
+getPlayerPosC :: Controller
+getPlayerPosC = promptController playerPosPrompt
+
+getRookieFlagC :: Controller
+getRookieFlagC = Controller
+  { drawController = const $ str "Is this player a rookie? (Y/N)"
+  , handleController = \e ->
+    modify $ case ynHandler e of
+      Just True -> progMode.createPlayerStateL
+        %~ (cpsRookieFlag ?~ True)
+        .  (cpsActiveFlag ?~ True)
+      rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
+  }
+
+getActiveFlagC :: Controller
+getActiveFlagC = Controller
+  { drawController = const $ str "Is the player active? (Y/N)"
+  , handleController = \e ->
+    progMode.createPlayerStateL.cpsActiveFlag .= ynHandler e
+  }
+
+confirmCreatePlayerC :: Controller
+confirmCreatePlayerC = Controller
+  { drawController = \s -> let cps = s^.progMode.createPlayerStateL
+    in linesToWidget
+      $  labelTable
+         [ ( "Player number",   maybe "?" show $ cps^.cpsNumber     )
+         , ( "Player name",     cps^.cpsName                        )
+         , ( "Player position", cps^.cpsPosition                    )
+         , ( "Rookie",          maybe "?" show $ cps^.cpsRookieFlag )
+         , ( "Active",          maybe "?" show $ cps^.cpsActiveFlag )
+         ]
+      ++ [ ""
+         , "Create player: are you sure?  (Y/N)"
+         ]
+  , handleController = \e -> do
+    cps <- use $ progMode.createPlayerStateL
+    let
+      success = cps^.cpsSuccessCallback
+      failure = cps^.cpsFailureCallback
+    case ynHandler e of
+      Just True -> do
+        pid <- gets (^.database.dbPlayers.to length)
+        let rookie = cps^.cpsRookieFlag == Just True
+        modify addPlayer
+        if rookie
+          then success
+          else modify $ progMode.editPlayerStateL
+            %~ (epsSelectedPlayer ?~ pid)
+            .  (epsMode           .~ EPLtGoals True)
+            .  (epsCallback       .~ success)
+      Just False -> failure
+      Nothing -> return ()
+  }

src/Mtlstats/Control/EditGoalie.hs

@@ -0,0 +1,171 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Control.EditGoalie (editGoalieC) where
+
+import Brick.Types (Widget)
+import Brick.Widgets.Core (str, vBox)
+import Control.Monad.State.Class (modify)
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import Lens.Micro.Mtl ((.=), (%=), use)
+
+import Mtlstats.Actions
+import Mtlstats.Handlers
+import Mtlstats.Helpers.Goalie
+import Mtlstats.Menu
+import Mtlstats.Menu.EditGoalie
+import Mtlstats.Prompt
+import Mtlstats.Prompt.EditGoalie
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Controller/dispatcher for editing a 'Goalie'
+editGoalieC :: EditGoalieState -> Controller
+editGoalieC egs
+  | null $ egs^.egsSelectedGoalie = selectC
+  | otherwise = editC (egs^.egsCallback) (egs^.egsMode)
+
+selectC :: Controller
+selectC = promptController goalieToEditPrompt
+
+editC :: Action () -> EditGoalieMode -> Controller
+editC cb =
+  ( \case
+    EGMenu          -> menuC
+    EGNumber        -> numberC
+    EGName          -> nameC
+    EGYtd           -> ytdMenuC
+    EGLifetime      -> lifetimeMenuC
+    EGDelete        -> deleteC
+    EGYtdGames b    -> ytdGamesC b
+    EGYtdMins b     -> ytdMinsC b
+    EGYtdGoals b    -> ytdGoalsC b
+    EGYtdShutouts b -> ytdShutoutsC b
+    EGYtdWins b     -> ytdWinsC b
+    EGYtdLosses b   -> ytdLossesC b
+    EGYtdTies       -> ytdTiesC
+    EGLtGames b     -> ltGamesC b
+    EGLtMins b      -> ltMinsC b
+    EGLtGoals b     -> ltGoalsC b
+    EGLtShutouts b  -> ltShutoutsC b
+    EGLtWins b      -> ltWinsC b
+    EGLtLosses b    -> ltLossesC b
+    EGLtTies        -> ltTiesC
+  ) <*> return cb
+
+menuC :: Action () -> Controller
+menuC _ = menuControllerWith header editGoalieMenu
+
+numberC :: Action () -> Controller
+numberC = promptController . editGoalieNumberPrompt
+
+nameC :: Action () -> Controller
+nameC = promptController . editGoalieNamePrompt
+
+ytdMenuC :: Action () -> Controller
+ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
+
+lifetimeMenuC :: Action () -> Controller
+lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
+
+deleteC :: Action () -> Controller
+deleteC _ = Controller
+
+  { drawController = \s -> let
+    hdr = fromMaybe "" $ do
+      gid    <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+      goalie <- nth gid $ s^.database.dbGoalies
+      Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
+    in str $ hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
+  , handleController = \e -> case ynHandler e of
+    Just True -> do
+      use (progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
+        (\gid -> database.dbGoalies %= dropNth gid)
+      modify edit
+    Just False -> progMode.editGoalieStateL.egsMode .= EGMenu
+    Nothing    -> return ()
+  }
+
+ytdGamesC :: Bool -> Action () -> Controller
+ytdGamesC = curry $ promptController .
+  uncurry editGoalieYtdGamesPrompt
+
+ytdMinsC :: Bool -> Action () -> Controller
+ytdMinsC = curry $ promptController .
+  uncurry editGoalieYtdMinsPrompt
+
+ytdGoalsC :: Bool -> Action () -> Controller
+ytdGoalsC = curry $ promptController .
+  uncurry editGoalieYtdGoalsPrompt
+
+ytdShutoutsC :: Bool -> Action () -> Controller
+ytdShutoutsC = curry $ promptController .
+  uncurry editGoalieYtdShutoutsPrompt
+
+ytdWinsC :: Bool -> Action () -> Controller
+ytdWinsC = curry $ promptController .
+  uncurry editGoalieYtdWinsPrompt
+
+ytdLossesC :: Bool -> Action () -> Controller
+ytdLossesC = curry $ promptController .
+  uncurry editGoalieYtdLossesPrompt
+
+ytdTiesC :: Action () -> Controller
+ytdTiesC = promptController . editGoalieYtdTiesPrompt
+
+ltGamesC :: Bool -> Action () -> Controller
+ltGamesC = curry $ promptController .
+  uncurry editGoalieLtGamesPrompt
+
+ltMinsC :: Bool -> Action () -> Controller
+ltMinsC = curry $ promptController .
+  uncurry editGoalieLtMinsPrompt
+
+ltGoalsC :: Bool -> Action() -> Controller
+ltGoalsC = curry $ promptController .
+  uncurry editGoalieLtGoalsPrompt
+
+ltShutoutsC :: Bool -> Action () -> Controller
+ltShutoutsC = curry $ promptController .
+  uncurry editGoalieLtShutoutsPrompt
+
+ltWinsC :: Bool -> Action () -> Controller
+ltWinsC = curry $ promptController .
+  uncurry editGoalieLtWinsPrompt
+
+ltLossesC :: Bool -> Action () -> Controller
+ltLossesC = curry $ promptController .
+  uncurry editGoalieLtLossesPrompt
+
+ltTiesC :: Action () -> Controller
+ltTiesC = promptController . editGoalieLtTiesPrompt
+
+header :: ProgState -> Widget () -> Widget ()
+header s w = vBox
+  [ str $ fromMaybe "" $ do
+    gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+    g   <- nth gid $ s^.database.dbGoalies
+    Just $ goalieDetails g
+  , w
+  ]

src/Mtlstats/Control/EditPlayer.hs

@@ -0,0 +1,130 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.EditPlayer (editPlayerC) where
+
+import Brick.Types (Widget)
+import Brick.Widgets.Core (emptyWidget, str, vBox)
+import Control.Monad.State.Class (modify)
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+import Lens.Micro.Mtl ((.=), (%=), use)
+
+import Mtlstats.Actions
+import Mtlstats.Handlers
+import Mtlstats.Helpers.Player
+import Mtlstats.Menu
+import Mtlstats.Menu.EditPlayer
+import Mtlstats.Prompt
+import Mtlstats.Prompt.EditPlayer
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Dispatcher/controller for the player edit mode
+editPlayerC :: EditPlayerState -> Controller
+editPlayerC eps
+  | null $ eps^.epsSelectedPlayer = selectPlayerC
+  | otherwise =
+    ( case eps^.epsMode of
+      EPMenu         -> menuC
+      EPNumber       -> numberC
+      EPName         -> nameC
+      EPPosition     -> positionC
+      EPYtd          -> ytdC
+      EPLifetime     -> lifetimeC
+      EPDelete       -> deleteC
+      EPYtdGoals   b -> ytdGoalsC   b
+      EPYtdAssists b -> ytdAssistsC b
+      EPYtdPMin      -> ytdPMinC
+      EPLtGoals    b -> ltGoalsC    b
+      EPLtAssists  b -> ltAssistsC  b
+      EPLtPMin       -> ltPMinC
+    ) $ eps^.epsCallback
+
+selectPlayerC :: Controller
+selectPlayerC = promptController playerToEditPrompt
+
+menuC :: Action () -> Controller
+menuC _ = menuControllerWith header editPlayerMenu
+
+numberC :: Action () -> Controller
+numberC = promptController . editPlayerNumPrompt
+
+nameC :: Action () -> Controller
+nameC = promptController . editPlayerNamePrompt
+
+positionC :: Action () -> Controller
+positionC = promptController . editPlayerPosPrompt
+
+ytdC :: Action () -> Controller
+ytdC _ = menuControllerWith header editPlayerYtdMenu
+
+lifetimeC :: Action () -> Controller
+lifetimeC _ = menuControllerWith header editPlayerLtMenu
+
+deleteC :: Action () -> Controller
+deleteC _ = Controller
+
+  { drawController = \s -> let
+    hdr = fromMaybe [] $ do
+      pid    <- s^.progMode.editPlayerStateL.epsSelectedPlayer
+      player <- nth pid $ s^.database.dbPlayers
+      Just $ "Player: " ++ playerDetails player ++ "\n"
+    in str $ hdr ++ "Are you sure you want to delete this player? (Y/N)"
+  , handleController = \e -> case ynHandler e of
+    Just True -> do
+      use (progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
+        (\pid -> database.dbPlayers %= dropNth pid)
+      modify edit
+    Just False -> progMode.editPlayerStateL.epsMode .= EPMenu
+    Nothing    -> return ()
+  }
+
+ytdGoalsC :: Bool -> Action () -> Controller
+ytdGoalsC batchMode callback = promptController $
+  editPlayerYtdGoalsPrompt batchMode callback
+
+ytdAssistsC :: Bool -> Action () -> Controller
+ytdAssistsC batchMode callback = promptController $
+  editPlayerYtdAssistsPrompt batchMode callback
+
+ytdPMinC :: Action () -> Controller
+ytdPMinC = promptController . editPlayerYtdPMinPrompt
+
+ltGoalsC :: Bool -> Action () -> Controller
+ltGoalsC batchMode callback = promptController $
+  editPlayerLtGoalsPrompt batchMode callback
+
+ltAssistsC :: Bool -> Action () -> Controller
+ltAssistsC batchMode callback = promptController $
+  editPlayerLtAssistsPrompt batchMode callback
+
+ltPMinC :: Action () -> Controller
+ltPMinC = promptController . editPlayerLtPMinPrompt
+
+header :: ProgState -> Widget () -> Widget ()
+header s w = vBox
+  [ fromMaybe emptyWidget $ do
+    pid    <- s^.progMode.editPlayerStateL.epsSelectedPlayer
+    player <- nth pid $ s^.database.dbPlayers
+    Just $ str $ playerDetails player
+  , w
+  ]

src/Mtlstats/Control/EditStandings.hs

@@ -0,0 +1,91 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Control.EditStandings (editStandingsC) where
+
+import Brick.Types (Widget)
+import Brick.Widgets.Core (vBox)
+import Lens.Micro ((^.))
+
+import Mtlstats.Format
+import Mtlstats.Menu
+import Mtlstats.Menu.EditStandings
+import Mtlstats.Prompt
+import Mtlstats.Prompt.EditStandings
+import Mtlstats.Types
+import Mtlstats.Types.Menu
+import Mtlstats.Util
+
+-- | Controller for the edit standings menu
+editStandingsC :: EditStandingsMode -> Controller
+editStandingsC = \case
+  ESMMenu   -> menuControllerWith header editStandingsMenu
+  ESMHome m -> editHomeStandingsC m
+  ESMAway m -> editAwayStandingsC m
+
+editHomeStandingsC :: ESMSubMode -> Controller
+editHomeStandingsC = \case
+  ESMSubMenu          -> menuC editHomeStandingsMenu
+  ESMEditWins         -> promptC editHomeWinsPrompt
+  ESMEditLosses       -> promptC editHomeLossesPrompt
+  ESMEditOvertime     -> promptC editHomeOvertimePrompt
+  ESMEditGoalsFor     -> promptC editHomeGoalsForPrompt
+  ESMEditGoalsAgainst -> promptC editHomeGoalsAgainstPrompt
+
+editAwayStandingsC :: ESMSubMode -> Controller
+editAwayStandingsC = \case
+  ESMSubMenu          -> menuC editAwayStandingsMenu
+  ESMEditWins         -> promptC editAwayWinsPrompt
+  ESMEditLosses       -> promptC editAwayLossesPrompt
+  ESMEditOvertime     -> promptC editAwayOvertimePrompt
+  ESMEditGoalsFor     -> promptC editAwayGoalsForPrompt
+  ESMEditGoalsAgainst -> promptC editAwayGoalsAgainstPrompt
+
+menuC :: Menu () -> Controller
+menuC = menuControllerWith header
+
+promptC :: Prompt -> Controller
+promptC = promptControllerWith header
+
+header :: ProgState -> Widget () -> Widget ()
+header s w = let
+  db    = s^.database
+  home  = db^.dbHomeGameStats
+  away  = db^.dbAwayGameStats
+  table  = numTable ["   W", "   L", "  OT", "  GF", "  GA"]
+      [ ( "HOME", valsFor home )
+      , ( "ROAD", valsFor away )
+      ]
+  in vBox
+    [ linesToWidget $ table ++ [""]
+    , w
+    ]
+
+valsFor :: GameStats -> [Int]
+valsFor gs =
+  [ gs^.gmsWins
+  , gs^.gmsLosses
+  , gs^.gmsOvertime
+  , gs^.gmsGoalsFor
+  , gs^.gmsGoalsAgainst
+  ]

src/Mtlstats/Control/NewGame.hs

@@ -0,0 +1,258 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.NewGame (newGameC) where
+
+import Brick.Main (vScrollBy, vScrollToBeginning)
+import Brick.Types
+  ( BrickEvent (VtyEvent)
+  , ViewportType (Vertical)
+  , Widget
+  )
+import Brick.Widgets.Center (hCenter)
+import Brick.Widgets.Core (str, vBox, viewport)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Class (get, gets, modify)
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Graphics.Vty.Input.Events
+  ( Event (EvKey)
+  , Key (KDown, KHome, KEnter, KUp)
+  )
+import Lens.Micro ((^.), (.~))
+import Lens.Micro.Mtl ((.=), use)
+
+import Mtlstats.Actions
+import Mtlstats.Actions.NewGame
+import Mtlstats.Config
+import Mtlstats.Control.NewGame.GoalieInput
+import Mtlstats.Format
+import Mtlstats.Handlers
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Prompt.NewGame
+import Mtlstats.Report
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Dispatcher for a new game
+newGameC :: GameState -> Controller
+newGameC gs
+  | null $ gs^.gameYear             = gameYearC
+  | null $ gs^.gameMonth            = gameMonthC
+  | null $ gs^.gameDay              = gameDayC
+  | null $ gs^.gameType             = gameTypeC
+  | null $ gs^.otherTeam            = otherTeamC
+  | null $ gs^.homeScore            = homeScoreC
+  | null $ gs^.awayScore            = awayScoreC
+  | null $ gs^.overtimeFlag         = overtimeFlagC
+  | not $ gs^.dataVerified          = verifyDataC
+  | fromJust (unaccountedPoints gs) = goalInput gs
+  | isJust $ gs^.gameSelectedPlayer = getPMinsC
+  | not $ gs^.gamePMinsRecorded     = pMinPlayerC
+  | not $ gs^.gameGoalieAssigned    = goalieInputC gs
+  | otherwise                       = reportC
+
+gameYearC :: Controller
+gameYearC = promptControllerWith header gameYearPrompt
+
+gameMonthC :: Controller
+gameMonthC = promptControllerWith monthHeader gameMonthPrompt
+
+gameDayC :: Controller
+gameDayC = promptControllerWith header gameDayPrompt
+
+gameTypeC :: Controller
+gameTypeC = menuControllerWith header gameTypeMenu
+
+otherTeamC :: Controller
+otherTeamC = promptControllerWith header otherTeamPrompt
+
+homeScoreC :: Controller
+homeScoreC = promptControllerWith header homeScorePrompt
+
+awayScoreC :: Controller
+awayScoreC = promptControllerWith header awayScorePrompt
+
+overtimeFlagC :: Controller
+overtimeFlagC = Controller
+  { drawController = \s -> header s $
+    str "Did the game go into overtime?  (Y/N)"
+  , handleController = \e ->
+    progMode.gameStateL.overtimeFlag .= ynHandler e
+  }
+
+verifyDataC :: Controller
+verifyDataC = Controller
+  { drawController = \s -> let
+    gs = s^.progMode.gameStateL
+    in header s $ linesToWidget $
+    [""] ++
+    labelTable
+      [ ( "Date",       gameDate gs                        )
+      , ( "Game type",  show $ fromJust $ gs^.gameType     )
+      , ( "Other team", gs^.otherTeam                      )
+      , ( "Home score", show $ fromJust $ gs^.homeScore    )
+      , ( "Away score", show $ fromJust $ gs^.awayScore    )
+      , ( "Overtime",   show $ fromJust $ gs^.overtimeFlag )
+      ] ++
+    [ ""
+    , "Is the above information correct?  (Y/N)"
+    ]
+  , handleController = \e ->
+    case ynHandler e of
+      Just True  -> modify
+        $ (progMode.gameStateL.dataVerified .~ True)
+        . updateGameStats
+        . awardShutouts
+      Just False -> modify $ progMode.gameStateL .~ newGameState
+      Nothing    -> return ()
+  }
+
+goalInput :: GameState -> Controller
+goalInput gs
+  | null (gs^.goalBy            ) = recordGoalC
+  | not (gs^.confirmGoalDataFlag) = recordAssistC
+  | otherwise                     = confirmGoalDataC
+
+recordGoalC :: Controller
+recordGoalC = Controller
+  { drawController = \s -> let
+    (game, goal) = gameGoal s
+    in drawPrompt (recordGoalPrompt game goal) s
+  , handleController = \e -> do
+    (game, goal) <- gets gameGoal
+    promptHandler (recordGoalPrompt game goal) e
+  }
+
+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
+  }
+
+confirmGoalDataC :: Controller
+confirmGoalDataC = Controller
+  { drawController = \s -> let
+    (game, goal) = gameGoal s
+    gs           = s^.progMode.gameStateL
+    players      = s^.database.dbPlayers
+    msg          =
+      [ "          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)"
+      ]
+    in linesToWidget msg
+  , handleController = \e -> do
+    case ynHandler e of
+      Just True  -> modify recordGoalAssists
+      Just False -> modify resetGoalData
+      Nothing    -> return ()
+  }
+
+pMinPlayerC :: Controller
+pMinPlayerC = Controller
+  { drawController = \s -> header s $
+    drawPrompt pMinPlayerPrompt s
+  , handleController = promptHandler pMinPlayerPrompt
+  }
+
+getPMinsC :: Controller
+getPMinsC = Controller
+  { drawController = \s ->  header s $ vBox
+    [ str $ fromMaybe "" $ do
+      pid    <- s^.progMode.gameStateL.gameSelectedPlayer
+      player <- nth pid $ s^.database.dbPlayers
+      Just $ playerSummary player
+    , drawPrompt assignPMinsPrompt s
+    ]
+  , handleController = promptHandler assignPMinsPrompt
+  }
+
+reportC :: Controller
+reportC = Controller
+  { drawController = viewport () Vertical . hCenter . linesToWidget .
+    displayReport reportCols
+  , handleController = \e -> do
+    scr <- use scroller
+    case e of
+      VtyEvent (EvKey k []) -> case k of
+        KUp    -> vScrollBy scr (-1)
+        KDown  -> vScrollBy scr 1
+        KHome  -> vScrollToBeginning scr
+        KEnter -> do
+          get >>= liftIO . writeFile reportFilename . exportReport reportCols
+          modify backHome
+        _ -> return ()
+      _ -> return ()
+  }
+
+header :: ProgState -> Widget () -> Widget ()
+header s w = vBox
+  [ str $ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
+  , w
+  ]
+
+monthHeader :: ProgState -> Widget () -> Widget ()
+monthHeader s w = let 
+  table = labelTable $ zip (map show ([1..] :: [Int]))
+    [ "JANUARY"
+    , "FEBRUARY"
+    , "MARCH"
+    , "APRIL"
+    , "MAY"
+    , "JUNE"
+    , "JULY"
+    , "AUGUST"
+    , "SEPTEMBER"
+    , "OCTOBER"
+    , "NOVEMBER"
+    , "DECEMBER"
+    ]
+  in header s $ vBox
+    [ linesToWidgetC $
+      ["MONTH:", ""] ++ table ++ [""]
+    , w
+    ]
+
+gameGoal :: ProgState -> (Int, Int)
+gameGoal s =
+  ( s^.database.dbGames
+  , succ $ s^.progMode.gameStateL.pointsAccounted
+  )
+
+gameGoalAssist :: ProgState -> (Int, Int, Int)
+gameGoalAssist s = let
+  (game, goal) = gameGoal s
+  assist       = succ $ length $ s^.progMode.gameStateL.assistsBy
+  in (game, goal, assist)

src/Mtlstats/Control/NewGame/GoalieInput.hs

@@ -0,0 +1,63 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
+
+import Brick.Types (Widget)
+import Brick.Widgets.Core (str, vBox)
+import Data.Maybe (fromMaybe)
+import Lens.Micro ((^.))
+
+import Mtlstats.Format
+import Mtlstats.Menu
+import Mtlstats.Prompt
+import Mtlstats.Prompt.NewGame.GoalieInput
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | The dispatcher for handling goalie input
+goalieInputC :: GameState -> Controller
+goalieInputC gs
+  | gs^.gameGoaliesRecorded         = selectGameGoalieC
+  | null $ gs^.gameSelectedGoalie   = selectGoalieC
+  | null $ gs^.gameGoalieMinsPlayed = minsPlayedC
+  | otherwise                       = goalsAllowedC
+
+selectGoalieC :: Controller
+selectGoalieC = promptController selectGameGoaliePrompt
+
+minsPlayedC :: Controller
+minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
+
+goalsAllowedC :: Controller
+goalsAllowedC = promptControllerWith header goalsAllowedPrompt
+
+selectGameGoalieC :: Controller
+selectGameGoalieC = menuStateController gameGoalieMenu
+
+header :: ProgState -> Widget () -> Widget ()
+header s w = vBox $ map str
+  [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
+  , fromMaybe "" $ do
+    n <- s^.progMode.gameStateL.gameSelectedGoalie
+    g <- nth n $ s^.database.dbGoalies
+    Just $ goalieSummary g
+  ] ++ [w]

src/Mtlstats/Control/TitleScreen.hs

@@ -0,0 +1,139 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Control.TitleScreen (titleScreenC) where
+
+import Brick.Types (BrickEvent (VtyEvent))
+import Control.Monad.State.Class (modify)
+import Data.Char (chr)
+import Graphics.Vty.Input.Events (Event (EvKey))
+
+import Mtlstats.Actions
+import Mtlstats.Types
+import Mtlstats.Util
+
+titleScreenC :: Controller
+titleScreenC = Controller
+  { drawController = const $ linesToWidgetC
+    $  [ ""
+       , "MONTREAL CANADIENS STATISTICS"
+       ]
+    ++ titleText
+    ++ [ ""
+       , "Copyright (C) 1984, 1985, 2019-2021, 2023 Rhéal Lamothe"
+       , "<rheal.lamothe@gmail.com>"
+       , ""
+       , "Press any key to continue..."
+       ]
+  , handleController = \case
+    VtyEvent (EvKey _ _) -> modify backHome
+    _                    -> return ()
+  }
+
+titleText :: [String]
+titleText = box $ map (map blockify) $ foldl joinBlocks (repeat "")
+  [chM, chT, chL, chS, chT, chA, chT, chS]
+
+box :: [String] -> [String]
+box strs
+  =  [[tl] ++ replicate width horiz ++ [tr]]
+  ++ map (\s -> [vert] ++ s ++ [vert]) strs
+  ++ [[bl] ++ replicate width horiz ++ [br]]
+  where
+    width = length $ head strs
+    tl    = chr 0x2554
+    tr    = chr 0x2557
+    bl    = chr 0x255a
+    br    = chr 0x255d
+    horiz = chr 0x2550
+    vert  = chr 0x2551
+
+blockify :: Char -> Char
+blockify = \case
+  '#' -> chr 0x2588
+  '>' -> chr 0x2590
+  '<' -> chr 0x258c
+  ch  -> ch
+
+joinBlocks :: [String] -> [String] -> [String]
+joinBlocks = zipWith (++)
+
+chM :: [String]
+chM =
+  [ "##<   >##"
+  , ">##   ##<"
+  , ">##< >##<"
+  , ">### ###<"
+  , ">#######<"
+  , ">#<###>#<"
+  , ">#<>#<>#<"
+  , "##<   >##"
+  ]
+
+chT :: [String]
+chT =
+  [ ">########<"
+  , ">## ## ##<"
+  , ">#< ## >#<"
+  , "    ##    "
+  , "    ##    "
+  , "    ##    "
+  , "    ##    "
+  , "   >##<   "
+  ]
+
+chL :: [String]
+chL =
+  [ "###    "
+  , ">#<    "
+  , ">#<    "
+  , ">#<    "
+  , ">#<    "
+  , ">#<  ##"
+  , ">#< >##"
+  , "#######"
+  ]
+
+chS :: [String]
+chS =
+  [ " #####< "
+  , ">#<  ## "
+  , "##      "
+  , " #####< "
+  , "     >#<"
+  , "      ##"
+  , ">#<  >#<"
+  , " ###### "
+  ]
+
+chA :: [String]
+chA =
+  [ "  >##<  "
+  , "   ##   "
+  , "  >##<  "
+  , "  ####  "
+  , " >#<>#< "
+  , " ###### "
+  , ">#<  >#<"
+  , "###  ###"
+  ]

src/Mtlstats/Format.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,15 +19,28 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Mtlstats.Format
   ( padNum
   , left
   , right
   , centre
+  , padRight
   , overlay
   , month
+  , labelTable
+  , numTable
+  , tableWith
+  , complexTable
+  , overlayLast
+  , showFloating
   ) where
 
+import Data.List (transpose)
+
+import Mtlstats.Types
+
 -- | Pad an 'Int' with leading zeroes to fit a certain character width
 padNum
   :: Int
@@ -75,6 +88,16 @@ centre n str = let
   pad  = replicate pLen ' '
   in take n $ pad ++ str ++ repeat ' '
 
+-- | Pads text on the right with spaces to fit a minimum width
+padRight
+  :: Int
+  -- ^ The width to pad to
+  -> String
+  -- ^ The text to pad
+  -> String
+padRight width str =
+  overlay str $ replicate width ' '
+
 -- | Overlays one string on top of another
 overlay
   :: String
@@ -101,3 +124,89 @@ month 10 = "OCT"
 month 11 = "NOV"
 month 12 = "DEC"
 month _  = ""
+
+-- | Creates a two-column table with labels
+labelTable :: [(String, String)] -> [String]
+labelTable xs = let
+  labelWidth = maximum $ map (length . fst) xs
+  valWidth   = maximum $ map (length . snd) xs
+
+  in map
+    ( \(label, val)
+      -> right labelWidth label
+      ++ ": "
+      ++ left valWidth val
+    ) xs
+
+-- | Creates a variable column table of numbers with two axes
+numTable
+  :: [String]
+  -- ^ The top column labels
+  -> [(String, [Int])]
+  -- ^ The rows with their labels
+  -> [String]
+numTable headers rows = tableWith right $ header : body
+  where
+    header = "" : headers
+    body   = map
+      (\(label, row) ->
+        label : map show row)
+      rows
+
+-- | Creates a table from a two-dimensional list with a specified
+-- padding function
+tableWith
+  :: (Int -> String -> String)
+  -- ^ The padding function
+  -> [[String]]
+  -- ^ The cells
+  -> [String]
+tableWith pFunc tData = complexTable
+  (repeat pFunc)
+  (map (map CellText) tData)
+
+-- | Creates a complex table
+complexTable
+  :: [Int -> String -> String]
+  -- ^ The padding function for each column
+  -> [[TableCell]]
+  -- ^ The table cells (an array of rows)
+  -> [String]
+complexTable pFuncs tData = let
+  widths = map
+    (map $ \case
+      CellText str -> length str
+      CellFill _   -> 0)
+    tData
+  colWidths = map maximum $ transpose widths
+
+  bFunc = \case
+    [] -> ""
+    [(f, len, CellText str)]       -> f len str
+    [(_, len, CellFill ch)]        -> replicate len ch
+    (f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
+    (_, len, CellFill ch) : cells  -> replicate (succ len) ch ++ bFunc cells
+
+  in map
+    (bFunc . zip3 pFuncs colWidths)
+    tData
+
+-- | Places an overlay on the last line of an report
+overlayLast
+  :: String
+  -- ^ The text to overlay
+  -> [String]
+  -- ^ The report to modify
+  -> [String]
+  -- ^ The resulting report
+overlayLast _ []       = []
+overlayLast str [l]    = [overlay str l]
+overlayLast str (l:ls) = l : overlayLast str ls
+
+-- | Converts a non-integer into a string
+showFloating :: RealFrac n => n -> String
+showFloating n = let
+  i        = round $ n * 100
+  whole    = i `div` 100
+  fraction = i `mod` 100
+  in show whole ++ "." ++ padNum 2 fraction

src/Mtlstats/Handlers.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,12 +21,13 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Handlers (ynHandler) where
 
+import Brick.Types (BrickEvent (VtyEvent))
 import Data.Char (toUpper)
-import qualified UI.NCurses as C
+import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar))
 
 -- | Handler for a yes/no prompt
-ynHandler :: C.Event -> Maybe Bool
+ynHandler :: BrickEvent () () -> Maybe Bool
-ynHandler (C.EventCharacter c) = case toUpper c of
+ynHandler (VtyEvent (EvKey (KChar c) [])) = case toUpper c of
   'Y' -> Just True
   'N' -> Just False
   _   -> Nothing

src/Mtlstats/Helpers/Goalie.hs

@@ -0,0 +1,62 @@
+{- |
+
+mtlstats
+Copyright (C) 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.Helpers.Goalie (goalieDetails, goalieName) where
+
+import Lens.Micro ((^.))
+
+import Mtlstats.Format
+import Mtlstats.Types
+
+-- | Provides a detailed 'String' describing a 'Goalie'
+goalieDetails :: Goalie -> String
+goalieDetails g = let
+  header = unlines $ labelTable
+    [ ( "Number", show $ g^.gNumber )
+    , ( "Name",   goalieName g      )
+    ]
+
+  body = unlines $ numTable ["YTD", "Lifetime"] $ map
+    (\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
+    [ ( "Games played",  gsGames        )
+    , ( "Mins played",   gsMinsPlayed   )
+    , ( "Goals allowed", gsGoalsAllowed )
+    , ( "Shutouts",      gsShutouts     )
+    , ( "Wins",          gsWins         )
+    , ( "Losses",        gsLosses       )
+    , ( "Ties",          gsTies         )
+    ]
+
+  in header ++ "\n" ++ body
+
+-- | Returns the goalie name, modified if they are a rookie
+goalieName :: Goalie -> String
+goalieName g = let
+
+  prefix = if g^.gActive
+    then ""
+    else "*"
+
+  suffix = if g^.gRookie
+    then "*"
+    else ""
+
+  in prefix ++ g^.gName ++ suffix

src/Mtlstats/Helpers/Player.hs

@@ -0,0 +1,60 @@
+{- |
+
+mtlstats
+Copyright (C) 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.Helpers.Player (playerDetails, playerName) where
+
+import Lens.Micro ((^.))
+
+import Mtlstats.Format
+import Mtlstats.Types
+
+-- | Provides a detailed string describing a 'Player'
+playerDetails :: Player -> String
+playerDetails p = unlines $ top ++ [""] ++ table
+  where
+    top = labelTable
+      [ ( "Number",   show $ p^.pNumber )
+      , ( "Name",     playerName p      )
+      , ( "Position", p^.pPosition      )
+      ]
+
+    table = numTable ["YTD", "Lifetime"] $ map
+      (\(label, lens) ->
+        (label, [p^.pYtd.lens, p^.pLifetime.lens]))
+      [ ( "Goals",        psGoals   )
+      , ( "Assists",      psAssists )
+      , ( "Penalty mins", psPMin    )
+      ]
+
+-- | Presents a modified version of the player's name indicating
+-- whether or not they're a rookie
+playerName :: Player -> String
+playerName p = let
+
+  prefix = if p^.pActive
+    then ""
+    else "*"
+
+  suffix = if p^.pRookie
+    then "*"
+    else ""
+
+  in prefix ++ p^.pName ++ suffix

src/Mtlstats/Helpers/Position.hs

@@ -0,0 +1,89 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Helpers.Position
+  ( posSearch
+  , posSearchExact
+  , posCallback
+  , getPositions
+  ) where
+
+import Data.Char (toUpper)
+import Data.List (isInfixOf)
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import Lens.Micro ((^.), to)
+import Lens.Micro.Mtl (use)
+
+import Mtlstats.Types
+import Mtlstats.Util
+
+-- | Searches the 'Database' for all the positions used
+posSearch
+  :: String
+  -- ^ The search string
+  -> Database
+  -- ^ The database
+  -> [(Int, String)]
+  -- ^ A list of result indices and their values
+posSearch sStr db = filter sFunc $ zip [0..] ps
+  where
+    sFunc (_, pos) = map toUpper sStr `isInfixOf` map toUpper pos
+    ps = getPositions db
+
+-- | Searches the 'Database' for an exact position
+posSearchExact
+  :: String
+  -- ^ The search string
+  -> Database
+  -- ^ The database
+  -> Maybe Int
+  -- ^ The index of the result (or 'Nothing' if not found)
+posSearchExact sStr db = case filter sFunc $ zip [0..] ps of
+  []      -> Nothing
+  (n,_):_ -> Just n
+  where
+    sFunc (_, pos) = sStr == pos
+    ps = getPositions db
+
+-- | Builds a callback function for when a 'Player' position is
+-- selected
+posCallback
+  :: (String -> Action ())
+  -- ^ The raw callback function
+  -> Maybe Int
+  -- ^ The index number of the position selected or 'Nothing' if blank
+  -> Action ()
+  -- ^ The action to perform
+posCallback callback = \case
+  Nothing -> callback ""
+  Just n  -> do
+    ps <- use (database.to getPositions)
+    let pos = fromMaybe "" $ nth n ps
+    callback pos
+
+-- | Extracts a list of positions from a 'Database'
+getPositions :: Database -> [String]
+getPositions = do
+  raw <- map (^.pPosition) . (^.dbPlayers)
+  return $ S.toList $ S.fromList raw

src/Mtlstats/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,101 +21,144 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Menu (
   -- * Menu Functions
+  menuController,
+  menuControllerWith,
+  menuStateController,
   drawMenu,
   menuHandler,
   -- * Menus
   mainMenu,
   newSeasonMenu,
-  gameMonthMenu,
+  gameTypeMenu,
-  gameTypeMenu
+  gameGoalieMenu,
+  editMenu
 ) where
 
-import Control.Monad.IO.Class (liftIO)
+import Brick.Main (halt)
-import Control.Monad.Trans.State (gets, modify)
+import Brick.Types (BrickEvent (VtyEvent), Widget)
-import Data.Aeson (encodeFile)
+import Control.Monad.State.Class (gets, modify)
 import Data.Char (toUpper)
-import Lens.Micro ((^.), (.~), (?~))
+import qualified Data.Map as M
-import Lens.Micro.Extras (view)
+import Data.Maybe (mapMaybe)
-import System.EasyFile
+import Graphics.Vty.Input.Events (Event (EvKey), Key (KChar))
-  ( createDirectoryIfMissing
+import Lens.Micro ((^.), (?~))
-  , getAppUserDataDirectory
-  , (</>)
-  )
-import qualified UI.NCurses as C
 
 import Mtlstats.Actions
-import Mtlstats.Config
+import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
+import Mtlstats.Actions.EditStandings
 import Mtlstats.Types
 import Mtlstats.Types.Menu
+import Mtlstats.Util
+
+-- | Generates a simple 'Controller' for a Menu
+menuController :: Menu () -> Controller
+menuController = menuControllerWith $ const id
+
+-- | Generate a simple 'Controller' for a 'Menu' with a header
+menuControllerWith
+  :: (ProgState -> Widget () -> Widget())
+  -- ^ Function to attach the header
+  -> Menu ()
+  -- ^ The menu
+  -> Controller
+  -- ^ The resulting controller
+menuControllerWith header menu = Controller
+  { drawController = \s -> header s $ drawMenu menu
+  , handleController = menuHandler menu
+  }
+
+-- | Generate and create a controller for a menu based on the current
+-- 'ProgState'
+menuStateController
+  :: (ProgState -> Menu ())
+  -- ^ The function to generate the menu
+  -> Controller
+  -- ^ The resulting controller
+menuStateController menuFunc = Controller
+  { drawController = drawMenu . menuFunc
+  , handleController = \e -> do
+    menu <- gets menuFunc
+    menuHandler menu e
+  }
 
 -- | The draw function for a 'Menu'
-drawMenu :: Menu a -> C.Update C.CursorMode
+drawMenu :: Menu a -> Widget ()
-drawMenu m = do
+drawMenu m = let
-  C.drawString $ show m
+  menuLines = lines $ show m
-  return C.CursorInvisible
+  in linesToWidgetC menuLines
 
 -- | The event handler for a 'Menu'
-menuHandler :: Menu a -> C.Event -> Action a
+menuHandler :: Menu a -> Handler a
-menuHandler m (C.EventCharacter c) =
+menuHandler m (VtyEvent (EvKey (KChar c) [])) =
   case filter (\i -> i^.miKey == toUpper c) $ m^.menuItems of
     i:_ -> i^.miAction
     []  -> return $ m^.menuDefault
 menuHandler m _ = return $ m^.menuDefault
 
 -- | The main menu
-mainMenu :: Menu Bool
+mainMenu :: Menu ()
-mainMenu = Menu "*** MAIN MENU ***" True
+mainMenu = Menu "MASTER MENU" ()
-  [ MenuItem '1' "New Season" $
+  [ MenuItem 'A' "NEW SEASON" $
-    modify startNewSeason >> return True
+    modify startNewSeason
-  , MenuItem '2' "New Game" $
+  , MenuItem 'B' "NEW GAME" $
-    modify startNewGame >> return True
+    modify startNewGame
-  , MenuItem '3' "Create Player" $
+  , MenuItem 'C' "EDIT MENU" $
-    modify createPlayer >> return True
+    modify edit
-  , MenuItem '4' "Exit" $ do
+  , MenuItem 'E' "EXIT" $
-    db <- gets $ view database
+    saveDatabase >> halt
-    liftIO $ do
-      dir <- getAppUserDataDirectory appName
-      let dbFile = dir </> dbFname
-      createDirectoryIfMissing True dir
-      encodeFile dbFile db
-    return False
   ]
 
 -- | The new season menu
 newSeasonMenu :: Menu ()
-newSeasonMenu = Menu "*** SEASON TYPE ***" ()
+newSeasonMenu = Menu "SEASON TYPE" ()
-  [ MenuItem '1' "Regular Season" $ do
+  [ MenuItem 'R' "REGULAR SEASON" $ modify
-    modify resetYtd
+    $ resetYtd
-    modify startNewGame
+    . clearRookies
-  , MenuItem '2' "Playoffs" $
+    . resetStandings
-    modify startNewGame
+    . backHome
-  ]
+  , MenuItem 'P' "PLAYOFFS" $ modify
-
+    $ resetStandings
--- | Requests the month in which the game took place
+    . backHome
-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" $
+  [ MenuItem 'H' "HOME GAME" $
     modify $ progMode.gameStateL.gameType ?~ HomeGame
-  , MenuItem '2' "Away Game" $
+  , MenuItem 'A' "AWAY GAME" $
     modify $ progMode.gameStateL.gameType ?~ AwayGame
   ]
+
+-- | Game goalie selection menu
+gameGoalieMenu :: ProgState -> Menu ()
+gameGoalieMenu s = let
+  title   = "Which goalie should get credit for the game?"
+  gids    = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats
+  goalies = mapMaybe
+    (\n -> do
+      goalie <- nth n $ s^.database.dbGoalies
+      Just (n, goalie))
+    gids
+  in Menu title () $ zipWith
+    (\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
+      modify $ GI.setGameGoalie gid)
+    ['1'..]
+    goalies
+
+-- | The edit menu
+editMenu :: Menu ()
+editMenu = Menu "EDIT MENU" ()
+  [ MenuItem 'A' "CREATE PLAYER" $
+    modify createPlayer
+  , MenuItem 'B' "CREATE GOALIE" $
+    modify createGoalie
+  , MenuItem 'C' "EDIT PLAYER" $
+    modify editPlayer
+  , MenuItem 'D' "EDIT GOALIE" $
+    modify editGoalie
+  , MenuItem 'E' "EDIT STANDINGS" $
+    modify editStandings
+  , MenuItem 'R' "RETURN TO MAIN MENU" $
+    modify backHome
+  ]

src/Mtlstats/Menu/EditGoalie.hs

@@ -0,0 +1,90 @@
+{- |
+
+mtlstats
+Copyright (C) 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.Menu.EditGoalie
+  ( editGoalieMenu
+  , editGoalieYtdMenu
+  , editGoalieLtMenu
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((.~), (%~))
+
+import Mtlstats.Actions
+import Mtlstats.Types
+import Mtlstats.Types.Menu
+
+-- | The 'Goalie' edit menu
+editGoalieMenu :: Menu ()
+editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
+  (\(ch, label, action) -> MenuItem ch label $ modify action)
+
+  --  key, label,                 value
+  [ ( 'A', "NUMBER",              set EGNumber   )
+  , ( 'B', "NAME",                set EGName     )
+  , ( 'C', "ROOKIE FLAG",         toggleRookie   )
+  , ( 'D', "ACTIVE FLAG",         toggleActive   )
+  , ( 'E', "YTD STATS",           set EGYtd      )
+  , ( 'F', "LIFETIME STATS",      set EGLifetime )
+  , ( 'G', "DELETE RECORD",       set EGDelete   )
+  , ( 'R', "RETURN TO EDIT MENU", edit           )
+  ]
+
+  where
+    set mode     = progMode.editGoalieStateL.egsMode .~ mode
+    toggleRookie = editSelectedGoalie (gRookie %~ not)
+    toggleActive = editSelectedGoalie (gActive %~ not)
+
+-- | The 'Goalie' YTD edit menu
+editGoalieYtdMenu :: Menu ()
+editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
+  --  key, label,                 value
+  [ ( 'A', "ALL YTD STATS",       EGYtdGames    True  )
+  , ( 'B', "YTD GAMES",           EGYtdGames    False )
+  , ( 'C', "YTD MINUTES",         EGYtdMins     False )
+  , ( 'D', "YTD GOALS",           EGYtdGoals    False )
+  , ( 'E', "YTD SHUTOUTS",        EGYtdShutouts False )
+  , ( 'F', "YTD WINS",            EGYtdWins     False )
+  , ( 'G', "YTD LOSSES",          EGYtdLosses   False )
+  , ( 'H', "YTD TIES",            EGYtdTies           )
+  , ( 'R', "RETURN TO EDIT MENU", EGMenu              )
+  ]
+
+-- | The 'Goalie' lifetime edit menu
+editGoalieLtMenu :: Menu ()
+editGoalieLtMenu = editMenu
+  "EDIT GOALTENDER LIFETIME"
+  --  key, label,                 value
+  [ ( 'A', "ALL LIFETIME STATS",  EGLtGames    True  )
+  , ( 'B', "LIFETIME GAMES",      EGLtGames    False )
+  , ( 'C', "LIFETIME MINUTES",    EGLtMins     False )
+  , ( 'D', "LIFETIME GOALS",      EGLtGoals    False )
+  , ( 'E', "LIFETIME SHUTOUTS",   EGLtShutouts False )
+  , ( 'F', "LIFETIME WINS",       EGLtWins     False )
+  , ( 'G', "LIFETIME LOSSES",     EGLtLosses   False )
+  , ( 'H', "LIFETIME TIES",       EGLtTies           )
+  , ( 'R', "RETURN TO EDIT MENU", EGMenu             )
+  ]
+
+editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
+editMenu title = Menu title () . map
+  (\(key, label, val) -> MenuItem key label $
+    modify $ progMode.editGoalieStateL.egsMode .~ val)

src/Mtlstats/Menu/EditPlayer.hs

@@ -0,0 +1,84 @@
+{- |
+
+mtlstats
+Copyright (C) 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.Menu.EditPlayer
+  ( editPlayerMenu
+  , editPlayerYtdMenu
+  , editPlayerLtMenu
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((.~), (%~))
+
+import Mtlstats.Actions
+import Mtlstats.Types
+import Mtlstats.Types.Menu
+
+-- | The 'Player' edit menu
+editPlayerMenu :: Menu ()
+editPlayerMenu = Menu "EDIT PLAYER" () $ map
+  (\(ch, label, action) -> MenuItem ch label $ modify action)
+
+  --  key, label,                 value
+  [ ( 'A', "NUMBER",              set EPNumber   )
+  , ( 'B', "NAME",                set EPName     )
+  , ( 'C', "POSITION",            set EPPosition )
+  , ( 'D', "ROOKIE FLAG",         toggleRookie   )
+  , ( 'E', "ACTIVE FLAG",         toggleActive   )
+  , ( 'F', "YTD STATS",           set EPYtd      )
+  , ( 'G', "LIFETIME STATS",      set EPLifetime )
+  , ( 'H', "DELETE RECORD",       set EPDelete   )
+  , ( 'R', "RETURN TO EDIT MENU", edit           )
+  ]
+
+  where
+    set mode     = progMode.editPlayerStateL.epsMode .~ mode
+    toggleRookie = editSelectedPlayer $ pRookie %~ not
+    toggleActive = editSelectedPlayer $ pActive %~ not
+
+-- | The 'Player' YTD stats edit menu
+editPlayerYtdMenu :: Menu ()
+editPlayerYtdMenu = editMenu
+  "EDIT PLAYER YEAR-TO-DATE"
+  --  key, label,                        value
+  [ ( 'A', "ALL YTD STATS",              EPYtdGoals   True  )
+  , ( 'B', "YTD GOALS",                  EPYtdGoals   False )
+  , ( 'C', "YTD ASSISTS",                EPYtdAssists False )
+  , ( 'D', "YTD PENALTY MINS",           EPYtdPMin          )
+  , ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu             )
+  ]
+
+-- | The 'Player' lifetime stats edit menu
+editPlayerLtMenu :: Menu ()
+editPlayerLtMenu = editMenu
+  "EDIT PLAYER LIFETIME"
+  --  key, label,                        value
+  [ ( 'A', "ALL LIFETIME STATS",         EPLtGoals   True  )
+  , ( 'B', "LIFETIME GOALS",             EPLtGoals   False )
+  , ( 'C', "LIFETIME ASSITS",            EPLtAssists False )
+  , ( 'D', "LIFETIME PENALTY MINS",      EPLtPMin          )
+  , ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu            )
+  ]
+
+editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
+editMenu title = Menu title () . map
+  (\(key, label, val) -> MenuItem key label $
+    modify $ progMode.editPlayerStateL.epsMode .~ val)

src/Mtlstats/Menu/EditStandings.hs

@@ -0,0 +1,64 @@
+{- |
+
+mtlstats
+Copyright (C) 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.Menu.EditStandings
+  ( editStandingsMenu
+  , editHomeStandingsMenu
+  , editAwayStandingsMenu
+  ) where
+
+import Control.Monad.State.Class (modify)
+
+import Mtlstats.Actions
+import Mtlstats.Actions.EditStandings
+import Mtlstats.Types.Menu
+
+editStandingsMenu :: Menu ()
+editStandingsMenu = Menu "EDIT STANDINGS" ()
+  [ MenuItem 'A' "EDIT HOME STANDINGS" $
+    modify editHomeStandings
+  , MenuItem 'B' "EDIT ROAD STANDINGS" $
+    modify editAwayStandings
+  , MenuItem 'R' "RETURN TO MAIN MENU" $
+    modify backHome
+  ]
+
+editHomeStandingsMenu :: Menu ()
+editHomeStandingsMenu = subMenu "HOME"
+
+editAwayStandingsMenu :: Menu ()
+editAwayStandingsMenu = subMenu "ROAD"
+
+subMenu :: String -> Menu ()
+subMenu str = Menu (str ++ " STANDINGS") ()
+  [ MenuItem 'W' "EDIT WINS" $
+    modify editWins
+  , MenuItem 'L' "EDIT LOSSES" $
+    modify editLosses
+  , MenuItem 'O' "EDIT OVERTIME GAMES" $
+    modify editOvertime
+  , MenuItem 'F' "EDIT GOALS FOR" $
+    modify editGoalsFor
+  , MenuItem 'A' "EDIT GOALS AGAINST" $
+    modify editGoalsAgainst
+  , MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $
+    modify editStandings
+  ]

src/Mtlstats/Prompt.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,67 +19,92 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
-
 module Mtlstats.Prompt (
   -- * Prompt Functions
-  drawPrompt,
   promptHandler,
+  promptControllerWith,
+  promptController,
   strPrompt,
+  ucStrPrompt,
+  namePrompt,
   numPrompt,
+  numPromptRange,
+  numPromptWithFallback,
+  dbNamePrompt,
+  selectPrompt,
   -- * Individual prompts
-  gameYearPrompt,
+  getDBPrompt,
-  gameDayPrompt,
+  newSeasonPrompt,
-  otherTeamPrompt,
-  homeScorePrompt,
-  awayScorePrompt,
   playerNumPrompt,
   playerNamePrompt,
   playerPosPrompt,
+  goalieNumPrompt,
+  goalieNamePrompt,
   selectPlayerPrompt,
-  recordGoalPrompt,
+  selectActivePlayerPrompt,
-  recordAssistPrompt,
+  selectGoaliePrompt,
-  pMinPlayerPrompt,
+  selectActiveGoaliePrompt,
-  assignPMinsPrompt
+  selectPositionPrompt,
+  playerToEditPrompt
 ) where
 
+import Brick.Types (BrickEvent (VtyEvent), Widget)
+import Brick.Widgets.Core (hBox, str, vBox)
+import Brick.Widgets.Edit (editContentsL, renderEditor)
 import Control.Monad (when)
-import Control.Monad.Trans.State (gets, modify)
+import Control.Monad.Extra (whenJust)
-import Data.Char (isDigit, toUpper)
+import Control.Monad.State.Class (gets, modify)
-import Data.Foldable (forM_)
+import Data.Char (isAlphaNum, isDigit, toUpper)
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Data.Text.Zipper (deletePrevChar, insertChar)
-import Lens.Micro.Extras (view)
+import Graphics.Vty.Input.Events
+  ( Event (EvKey)
+  , Key (KBS, KChar, KEnter, KFun)
+  )
+import Lens.Micro ((^.), (&), (.~), (?~), (%~), to)
+import Lens.Micro.Mtl ((%=), use)
 import Text.Read (readMaybe)
-import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Config
-import Mtlstats.Format
+import Mtlstats.Helpers.Position
 import Mtlstats.Types
 import Mtlstats.Util
 
--- | Draws the prompt to the screen
-drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
-drawPrompt p s = do
-  promptDrawer p s
-  return C.CursorVisible
-
 -- | Event handler for a prompt
-promptHandler :: Prompt -> C.Event -> Action ()
+promptHandler :: Prompt -> Handler ()
-promptHandler p (C.EventCharacter '\n') = do
+promptHandler p (VtyEvent (EvKey KEnter [])) = do
-  val <- gets $ view inputBuffer
+  val <- use $ editorW.to userText
-  modify $ inputBuffer .~ ""
+  editorW %= clearEditor
   promptAction p val
-promptHandler p (C.EventCharacter c) = let
+promptHandler p (VtyEvent (EvKey (KChar c) [])) =
-  c' = toUpper c
+  editorW %= promptProcessChar p c
-  in when (promptCharCheck p c') $
+promptHandler _ (VtyEvent (EvKey KBS [])) =
-   modify $ addChar c'
+  editorW.editContentsL %= deletePrevChar
-promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
+promptHandler p (VtyEvent (EvKey k m)) =
-  modify removeChar
+  promptSpecialKey p k m
-promptHandler p (C.EventSpecialKey k) =
-  promptSpecialKey p k
 promptHandler _ _ = return ()
 
+-- | Builds a controller out of a prompt with a header
+promptControllerWith
+  :: (ProgState -> Widget () -> Widget ())
+  -- ^ The header
+  -> Prompt
+  -- ^ The prompt to use
+  -> Controller
+  -- ^ The resulting controller
+promptControllerWith header prompt = Controller
+  { drawController   = \s -> header s $ drawPrompt prompt s
+  , handleController = promptHandler prompt
+  }
+
+-- | Builds a controller out of a prompt
+promptController
+  :: Prompt
+  -- ^ The prompt to use
+  -> Controller
+  -- ^ The resulting controller
+promptController = promptControllerWith $ const id
+
 -- | Builds a string prompt
 strPrompt
   :: String
@@ -88,12 +113,33 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer     = drawSimplePrompt pStr
+  { drawPrompt        = drawSimplePrompt pStr
-  , promptCharCheck  = const True
+  , promptProcessChar = \ch -> editContentsL %~ insertChar ch
   , promptAction      = act
-  , promptSpecialKey = const $ return ()
+  , promptSpecialKey  = \_ _ -> return ()
   }
 
+-- | Creates an upper case string prompt
+ucStrPrompt
+  :: String
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+ucStrPrompt pStr act = (strPrompt pStr act)
+  { promptProcessChar = \ch -> editContentsL %~ insertChar ch }
+
+-- | Creates a prompt which forces capitalization of input to
+-- accomodate a player or goalie name
+namePrompt
+  :: String
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+namePrompt pStr act = (strPrompt pStr act)
+  { promptProcessChar = capitalizeName }
+
 -- | Builds a numeric prompt
 numPrompt
   :: String
@@ -101,37 +147,112 @@ numPrompt
   -> (Int -> Action ())
   -- ^ The callback function for the result
   -> Prompt
-numPrompt pStr act = Prompt
+numPrompt pStr = numPromptWithFallback pStr $ return ()
-  { promptDrawer     = drawSimplePrompt pStr
+
-  , promptCharCheck  = isDigit
+-- | Builds a numberic prompt with a range
-  , promptAction     = \inStr -> forM_ (readMaybe inStr) act
+numPromptRange
-  , promptSpecialKey = const $ return ()
+  :: Int
+  -- ^ The minimum value
+  -> Int
+  -- ^ The maximum value
+  -> String
+  -- ^ The prompt string
+  -> (Int -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
+  when (n >= nMin && n <= nMax) $ callback n
+
+-- | Builds a numeric prompt with a fallback action
+numPromptWithFallback
+  :: String
+  -- ^ The prompt string
+  -> Action ()
+  -- ^ The action to call on invalid (or blank) input
+  -> (Int -> Action ())
+  -- ^ The callback function for the result
+  -> Prompt
+numPromptWithFallback pStr fallback act = Prompt
+  { drawPrompt        = drawSimplePrompt pStr
+  , promptProcessChar = \ch existing -> if isDigit ch
+    then existing & editContentsL %~ insertChar ch
+    else existing
+  , promptAction      = maybe fallback act . readMaybe
+  , promptSpecialKey  = \_ _ -> return ()
   }
 
--- | Prompts for the game year
+-- | Prompts for a database name
-gameYearPrompt :: Prompt
+dbNamePrompt
-gameYearPrompt = numPrompt "Game year: " $
+  :: String
-  modify . (progMode.gameStateL.gameYear ?~)
+  -- ^ The prompt string
+  -> (String -> Action ())
+  -- ^ The callback to pass the result to
+  -> Prompt
+dbNamePrompt pStr act = (strPrompt pStr act)
+  { promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
+    then editContentsL %~ insertChar (toUpper ch)
+    else id
+  }
 
--- | Prompts for the day of the month the game took place
+-- | Prompts the user for a filename to save a backup of the database
-gameDayPrompt :: Prompt
+-- to
-gameDayPrompt = numPrompt "Day of month: " $
+newSeasonPrompt :: Prompt
-  modify . (progMode.gameStateL.gameDay ?~)
+newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
+  if null fn
+  then modify backHome
+  else do
+    saveDatabase
+    modify
+      $ (dbName .~ fn)
+      . (progMode .~ NewSeason True)
 
--- | Prompts for the other team name
+-- | Builds a selection prompt
-otherTeamPrompt :: Prompt
+selectPrompt :: SelectParams a -> Prompt
-otherTeamPrompt = strPrompt "Other team: " $
+selectPrompt params = Prompt
-  modify . (progMode.gameStateL.otherTeam .~)
+  { drawPrompt = \s -> let
+    sStr       = s^.editorW.to userText
+    pStr       = spPrompt params
+    results    = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
+    fmtRes     = map
+      (\(n, (_, x)) -> let
+        desc = spElemDesc params x
+        in str $ "F" ++ show n ++ ") " ++ desc)
+      results
+    in vBox $
+      [ hBox
+        [ str pStr
+        , renderEditor linesToWidget True (s^.editorW)
+        ]
+      , str " "
+      , str $ spSearchHeader params
+      ] ++ fmtRes
+  , promptProcessChar = spProcessChar params
+  , promptAction = \sStr -> if null sStr
+    then spCallback params Nothing
+    else do
+      db <- gets (^.database)
+      case spSearchExact params sStr db of
+        Nothing -> spNotFound params sStr
+        Just n  -> spCallback params $ Just n
+  , promptSpecialKey = \key _ -> case key of
+    KFun rawK -> do
+      sStr <- use $ editorW . to userText
+      db   <- use database
+      let
+        n       = pred rawK
+        results = spSearch params sStr db
+      when (n < maxFunKeys) $
+        whenJust (nth n results) $ \(sel, _) -> do
+          editorW %= clearEditor
+          spCallback params $ Just sel
+    _ -> return ()
+  }
 
--- | Prompts for the home score
+-- | Prompts for the database to load
-homeScorePrompt :: Prompt
+getDBPrompt :: Prompt
-homeScorePrompt = numPrompt "Home score: " $
+getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
-  modify . (progMode.gameStateL.homeScore ?~)
+  modify $ dbName .~ fn
-
+  loadDatabase
--- | Prompts for the away score
-awayScorePrompt :: Prompt
-awayScorePrompt = numPrompt "Away score: " $
-  modify . (progMode.gameStateL.awayScore ?~)
 
 -- | Prompts for a new player's number
 playerNumPrompt :: Prompt
@@ -140,14 +261,56 @@ playerNumPrompt = numPrompt "Player number: " $
 
 -- | Prompts for a new player's name
 playerNamePrompt :: Prompt
-playerNamePrompt = strPrompt "Player name: " $
+playerNamePrompt = namePrompt "Player name: " $
   modify . (progMode.createPlayerStateL.cpsName .~)
 
 -- | Prompts for a new player's position
 playerPosPrompt :: Prompt
-playerPosPrompt = strPrompt "Player position: " $
+playerPosPrompt = selectPositionPrompt "Player position: " $
   modify . (progMode.createPlayerStateL.cpsPosition .~)
 
+-- | Prompts tor the goalie's number
+goalieNumPrompt :: Prompt
+goalieNumPrompt = numPrompt "Goalie number: " $
+  modify . (progMode.createGoalieStateL.cgsNumber ?~)
+
+-- | Prompts for the goalie's name
+goalieNamePrompt :: Prompt
+goalieNamePrompt = namePrompt "Goalie name: " $
+  modify . (progMode.createGoalieStateL.cgsName .~)
+
+-- | Selects a player using a specified search function (creating the
+-- player if necessary)
+selectPlayerPromptWith
+  :: (String -> [Player] -> [(Int, Player)])
+  -- ^ The search function
+  -> String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the payer as
+  -- input)
+  -> Prompt
+selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
+  { spPrompt       = pStr
+  , spSearchHeader = "Player select:"
+  , spSearch       = \sStr db -> sFunc sStr (db^.dbPlayers)
+  , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
+  , spElemDesc     = playerSummary
+  , spProcessChar  = capitalizeName
+  , spCallback     = callback
+  , spNotFound     = \sStr -> do
+    mode <- gets (^.progMode)
+    let
+      cps = newCreatePlayerState
+        & cpsName .~ sStr
+        & cpsSuccessCallback .~ do
+          modify $ progMode .~ mode
+          index <- pred . length <$> gets (^.database.dbPlayers)
+          callback $ Just index
+        & cpsFailureCallback .~ modify (progMode .~ mode)
+    modify $ progMode .~ CreatePlayer cps
+  }
+
 -- | Selects a player (creating one if necessary)
 selectPlayerPrompt
   :: String
@@ -156,96 +319,94 @@ selectPlayerPrompt
   -- ^ The callback to run (takes the index number of the payer as
   -- input)
   -> Prompt
-selectPlayerPrompt pStr callback = Prompt
+selectPlayerPrompt = selectPlayerPromptWith playerSearch
-  { promptDrawer = \s -> do
+
-    let sStr = s^.inputBuffer
+-- | Selects an active player (creating one if necessary)
-    C.drawString pStr
+selectActivePlayerPrompt
-    C.drawString sStr
+  :: String
-    (row, col) <- C.cursorPosition
+  -- ^ The prompt string
-    C.drawString "\n\nPlayer select:\n"
+  -> (Maybe Int -> Action ())
-    let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
+  -- ^ The callback to run (takes the index number of the payer as
-    mapM_
+  -- input)
-      (\(n, (_, p)) -> C.drawString $
+  -> Prompt
-        "F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
+selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch
-      sel
+
-    C.moveCursor row col
+-- | Selects a goalie with a specified search criteria (creating the
-  , promptCharCheck = const True
+-- goalie if necessary)
-  , promptAction = \sStr -> if null sStr
+selectGoaliePromptWith
-    then callback Nothing
+  :: (String -> [Goalie] -> [(Int, Goalie)])
-    else do
+  -- ^ The search criteria
-      players <- gets $ view $ database.dbPlayers
+  -> String
-      case playerSearchExact sStr players of
+  -- ^ The prompt string
-        Just (n, _) -> callback $ Just n
+  -> (Maybe Int -> Action ())
-        Nothing -> do
+  -- ^ The callback to run (takes the index number of the goalie as
-          mode <- gets $ view progMode
+  -- input)
+  -> Prompt
+selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
+  { spPrompt       = pStr
+  , spSearchHeader = "Goalie select:"
+  , spSearch       = \sStr db -> criteria sStr (db^.dbGoalies)
+  , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
+  , spElemDesc     = goalieSummary
+  , spProcessChar  = capitalizeName
+  , spCallback     = callback
+  , spNotFound     = \sStr -> do
+    mode <- gets (^.progMode)
     let
-            cps
+      cgs = newCreateGoalieState
-              = newCreatePlayerState
+        & cgsName .~ sStr
-              & cpsName .~ sStr
+        & cgsSuccessCallback .~ do
-              & cpsSuccessCallback .~ do
           modify $ progMode .~ mode
-                pIndex <- pred . length <$> gets (view $ database.dbPlayers)
+          index <- pred . length <$> gets (^.database.dbGoalies)
-                callback $ Just pIndex
+          callback $ Just index
-              & cpsFailureCallback .~ do
+        & cgsFailureCallback .~ modify (progMode .~ mode)
-                modify $ progMode .~ mode
+    modify $ progMode .~ CreateGoalie cgs
-                callback Nothing
-          modify $ progMode .~ CreatePlayer cps
-  , promptSpecialKey = \case
-    C.KeyFunction n -> do
-      sStr    <- gets $ view inputBuffer
-      players <- gets $ view $ database.dbPlayers
-      modify $ inputBuffer .~ ""
-      let
-        fKey    = pred $ fromIntegral n
-        options = playerSearch sStr players
-        sel     = fst <$> nth fKey options
-      callback sel
-    _ -> return ()
   }
 
--- | Prompts for the player who scored the goal
+-- | Selects a goalie (creating one if necessary)
-recordGoalPrompt
+selectGoaliePrompt
-  :: Int
+  :: String
-  -- ^ The game number
+  -- ^ The prompt string
-  -> Int
+  -> (Maybe Int -> Action ())
-  -- ^ The goal number
+  -- ^ The callback to run (takes the index number of the goalie as
+  -- input)
   -> Prompt
-recordGoalPrompt game goal = selectPlayerPrompt
+selectGoaliePrompt = selectGoaliePromptWith goalieSearch
-  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
-  ++ "Who scored goal number " ++ show goal ++ "? "
-  ) $ modify . (progMode.gameStateL.goalBy .~)
 
--- | Prompts for a player who assisted the goal
+-- | Selects an active goalie (creating one if necessary)
-recordAssistPrompt
+selectActiveGoaliePrompt
-  :: Int
+  :: String
-  -- ^ The game number
+  -- ^ The prompt string
-  -> Int
+  -> (Maybe Int -> Action ())
-  -- ^ The goal nuber
+  -- ^ The callback to run (takes the index number of the goalie as
-  -> Int
+  -- input)
-  -- ^ The assist number
   -> Prompt
-recordAssistPrompt game goal assist = selectPlayerPrompt
+selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch
-  (  "*** 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
+-- | Selects (or creates) a player position
-pMinPlayerPrompt = selectPlayerPrompt
+selectPositionPrompt
-  "Assign penalty minutes to: " $
+  :: String
-  \case
+  -- ^ The 'Prompt' string
-    Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
+  -> (String -> Action ())
-    Just n  -> modify $ progMode.gameStateL.selectedPlayer ?~ n
+  -- ^ The action to perform when a value is entered
+  -> Prompt
+selectPositionPrompt pStr callback = selectPrompt SelectParams
+  { spPrompt = pStr
+  , spSearchHeader = "Positions:"
+  , spSearch = posSearch
+  , spSearchExact = posSearchExact
+  , spElemDesc = id
+  , spProcessChar = \c -> editContentsL %~ insertChar (toUpper c)
+  , spCallback = posCallback callback
+  , spNotFound = callback
+  }
 
-assignPMinsPrompt :: Prompt
+playerToEditPrompt :: Prompt
-assignPMinsPrompt = numPrompt "Penalty minutes: " $
+playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
-  modify . assignPMins
+  modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
 
-drawSimplePrompt :: String -> ProgState -> C.Update ()
+drawSimplePrompt :: String -> Renderer
-drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
+drawSimplePrompt pStr s = hBox
+  [ str pStr
+  , renderEditor linesToWidget True (s^.editorW)
+  ]

src/Mtlstats/Prompt/EditGoalie.hs

@@ -0,0 +1,287 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Prompt.EditGoalie
+  ( goalieToEditPrompt
+  , editGoalieNumberPrompt
+  , editGoalieNamePrompt
+  , editGoalieYtdGamesPrompt
+  , editGoalieYtdMinsPrompt
+  , editGoalieYtdGoalsPrompt
+  , editGoalieYtdShutoutsPrompt
+  , editGoalieYtdWinsPrompt
+  , editGoalieYtdLossesPrompt
+  , editGoalieYtdTiesPrompt
+  , editGoalieLtGamesPrompt
+  , editGoalieLtMinsPrompt
+  , editGoalieLtGoalsPrompt
+  , editGoalieLtShutoutsPrompt
+  , editGoalieLtWinsPrompt
+  , editGoalieLtLossesPrompt
+  , editGoalieLtTiesPrompt
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((.~))
+
+import Mtlstats.Actions
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompt to select a 'Goalie' for editing
+goalieToEditPrompt :: Prompt
+goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
+  modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
+
+-- | Prompt to edit a goalie's number
+editGoalieNumberPrompt
+  :: Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
+  (gNumber .~)
+
+-- | Prompt to edit a goalie's name
+editGoalieNamePrompt
+  :: Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieNamePrompt cb = namePrompt "Goalie name: " $ \name -> do
+  if null name
+    then goto EGMenu
+    else doEdit EGMenu $ gName .~ name
+  cb
+
+-- | Prompt to edit a goalie's YTD games played
+editGoalieYtdGamesPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdGamesPrompt batchMode cb =
+  editNum "Year-to-date games played: " mode
+  (gYtd.gsGames .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdMins True, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD minutes played
+editGoalieYtdMinsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdMinsPrompt batchMode cb =
+  editNum "Year-to-date minutes played: " mode
+  (gYtd.gsMinsPlayed .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdGoals True, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD goales allowed
+editGoalieYtdGoalsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdGoalsPrompt batchMode cb =
+  editNum "Year-to-date goals allowed: " mode
+  (gYtd.gsGoalsAllowed .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdShutouts True, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD shutouts
+editGoalieYtdShutoutsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdShutoutsPrompt batchMode cb =
+  editNum "Year-to-date shutouts: " mode
+  (gYtd.gsShutouts .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdWins True, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD wins
+editGoalieYtdWinsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdWinsPrompt batchMode cb =
+  editNum "Year-to-date wins: " mode
+  (gYtd.gsWins .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdLosses True, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD losses
+editGoalieYtdLossesPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdLossesPrompt batchMode cb =
+  editNum "Year-to-date losses: " mode
+  (gYtd.gsLosses .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGYtdTies, return ())
+      else (EGYtd, cb)
+
+-- | Prompt to edit a goalie's YTD ties
+editGoalieYtdTiesPrompt
+  :: Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
+  (gYtd.gsTies .~)
+
+-- | Prompt to edit a goalie's lifetime games played
+editGoalieLtGamesPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtGamesPrompt batchMode cb =
+  editNum "Lifetime games played: " mode
+  (gLifetime.gsGames .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtMins True, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime minutes played
+editGoalieLtMinsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtMinsPrompt batchMode cb =
+  editNum "Lifetime minutes played: " mode
+  (gLifetime.gsMinsPlayed .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtGoals True, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime goals allowed
+editGoalieLtGoalsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtGoalsPrompt batchMode cb =
+  editNum "Lifetime goals allowed: " mode
+  (gLifetime.gsGoalsAllowed .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtShutouts True, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime shutouts
+editGoalieLtShutoutsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtShutoutsPrompt batchMode cb =
+  editNum "Lifetime shutouts: " mode
+  (gLifetime.gsShutouts .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtWins True, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime wins
+editGoalieLtWinsPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtWinsPrompt batchMode cb =
+  editNum "Lifetime wins: " mode
+  (gLifetime.gsWins .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtLosses True, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime losses
+editGoalieLtLossesPrompt
+  :: Bool
+  -- ^ Indicates whether or not we're in batch mode
+  -> Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtLossesPrompt batchMode cb =
+  editNum "Lifetime losses: " mode
+  (gLifetime.gsLosses .~) cb'
+  where
+    (mode, cb') = if batchMode
+      then (EGLtTies, return ())
+      else (EGLifetime, cb)
+
+-- | Prompt to edit a goalie's lifetime ties
+editGoalieLtTiesPrompt
+  :: Action ()
+  -- ^ Action to perform on completion
+  -> Prompt
+editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
+  (gLifetime.gsTies .~)
+
+editNum
+  :: String
+  -> EditGoalieMode
+  -> (Int -> Goalie -> Goalie)
+  -> Action ()
+  -> Prompt
+editNum pStr mode f cb = numPromptWithFallback pStr
+  (goto mode >> cb)
+  (\num -> do
+    doEdit mode $ f num
+    cb)
+
+doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
+doEdit mode f = do
+  modify $ editSelectedGoalie f
+  goto mode
+
+goto :: EditGoalieMode -> Action ()
+goto = modify . (progMode.editGoalieStateL.egsMode .~)

src/Mtlstats/Prompt/EditPlayer.hs

@@ -0,0 +1,161 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Prompt.EditPlayer
+  ( editPlayerNumPrompt
+  , editPlayerNamePrompt
+  , editPlayerPosPrompt
+  , editPlayerYtdGoalsPrompt
+  , editPlayerYtdAssistsPrompt
+  , editPlayerYtdPMinPrompt
+  , editPlayerLtGoalsPrompt
+  , editPlayerLtAssistsPrompt
+  , editPlayerLtPMinPrompt
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((.~))
+
+import Mtlstats.Actions
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompt to edit a player's number
+editPlayerNumPrompt
+  :: Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerNumPrompt = editNum "Player number: " EPMenu
+  (pNumber .~)
+
+-- | Prompt to edit a player's name
+editPlayerNamePrompt
+  :: Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
+  if null name
+    then goto EPMenu
+    else doEdit EPMenu $ pName .~ name
+  callback
+
+-- | Prompt to edit a player's position
+editPlayerPosPrompt
+  :: Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
+  if null pos
+    then goto EPMenu
+    else doEdit EPMenu $ pPosition .~ pos
+  callback
+
+-- | Prompt to edit a player's year-to-date goals
+editPlayerYtdGoalsPrompt
+  :: Bool
+  -- ^ Indicates wheter or not we're editing in batch mode
+  -> Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
+  (pYtd.psGoals .~) callback'
+  where
+    (mode, callback') = if batchMode
+      then (EPYtdAssists True, return ())
+      else (EPYtd, callback)
+
+-- | Prompt to edit a player's year-to-date assists
+editPlayerYtdAssistsPrompt
+  :: Bool
+  -- ^ Indicates wheter or not we're editing in batch mode
+  -> Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
+  (pYtd.psAssists .~) callback'
+  where
+    (mode, callback') = if batchMode
+      then (EPYtdPMin, return ())
+      else (EPYtd, callback)
+
+-- | Prompt to edit a player's year-to-date penalty minutes
+editPlayerYtdPMinPrompt
+  :: Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
+  (pYtd.psPMin .~)
+
+-- | Prompt to edit a player's lifetime goals
+editPlayerLtGoalsPrompt
+  :: Bool
+  -- ^ Indicates wheter or not we're editing in batch mode
+  -> Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
+  (pLifetime.psGoals .~) callback'
+  where
+    (mode, callback') = if batchMode
+      then (EPLtAssists True, return ())
+      else (EPLifetime, callback)
+
+-- | Prompt to edit a player's lifetime assists
+editPlayerLtAssistsPrompt
+  :: Bool
+  -- ^ Indicates wheter or not we're editing in batch mode
+  -> Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
+  (pLifetime.psAssists .~) callback'
+  where
+    (mode, callback') = if batchMode
+      then (EPLtPMin, return ())
+      else (EPLifetime, callback)
+
+-- | Prompt to edit a player's lifetime penalty minutes
+editPlayerLtPMinPrompt
+  :: Action ()
+  -- ^ The action to be performed upon completion
+  -> Prompt
+editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
+  (pLifetime.psPMin .~)
+
+editNum
+  :: String
+  -> EditPlayerMode
+  -> (Int -> Player -> Player)
+  -> Action ()
+  -> Prompt
+editNum pStr mode f callback = numPromptWithFallback pStr
+  (goto mode >> callback)
+  (\num -> do
+    doEdit mode $ f num
+    callback)
+
+doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
+doEdit mode f = do
+  modify $ editSelectedPlayer f
+  goto mode
+
+goto :: EditPlayerMode -> Action ()
+goto = modify . (progMode.editPlayerStateL.epsMode .~)

src/Mtlstats/Prompt/EditStandings.hs

@@ -0,0 +1,89 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Prompt.EditStandings
+  ( editHomeWinsPrompt
+  , editHomeLossesPrompt
+  , editHomeOvertimePrompt
+  , editHomeGoalsForPrompt
+  , editHomeGoalsAgainstPrompt
+  , editAwayWinsPrompt
+  , editAwayLossesPrompt
+  , editAwayOvertimePrompt
+  , editAwayGoalsForPrompt
+  , editAwayGoalsAgainstPrompt
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((.~), (%~))
+
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+editHomeWinsPrompt :: Prompt
+editHomeWinsPrompt =
+  mkPrompt "Home wins: " (dbHomeGameStats.gmsWins .~)
+
+editHomeLossesPrompt :: Prompt
+editHomeLossesPrompt =
+  mkPrompt "Home losses: " (dbHomeGameStats.gmsLosses .~)
+
+editHomeOvertimePrompt :: Prompt
+editHomeOvertimePrompt =
+  mkPrompt "Home overtime games: " (dbHomeGameStats.gmsOvertime .~)
+
+editHomeGoalsForPrompt :: Prompt
+editHomeGoalsForPrompt =
+  mkPrompt "Home goals for: " (dbHomeGameStats.gmsGoalsFor .~)
+
+editHomeGoalsAgainstPrompt :: Prompt
+editHomeGoalsAgainstPrompt =
+  mkPrompt "Home goals against: " (dbHomeGameStats.gmsGoalsAgainst .~)
+
+editAwayWinsPrompt :: Prompt
+editAwayWinsPrompt =
+  mkPrompt "Road wins: " (dbAwayGameStats.gmsWins .~)
+
+editAwayLossesPrompt :: Prompt
+editAwayLossesPrompt =
+  mkPrompt "Road losses: " (dbAwayGameStats.gmsLosses .~)
+
+editAwayOvertimePrompt :: Prompt
+editAwayOvertimePrompt =
+  mkPrompt "Road overtime games: " (dbAwayGameStats.gmsOvertime .~)
+
+editAwayGoalsForPrompt :: Prompt
+editAwayGoalsForPrompt =
+  mkPrompt "Road goals for: " (dbAwayGameStats.gmsGoalsFor .~)
+
+editAwayGoalsAgainstPrompt :: Prompt
+editAwayGoalsAgainstPrompt =
+  mkPrompt "Road goals against: " (dbAwayGameStats.gmsGoalsAgainst .~)
+
+mkPrompt :: String -> (Int -> Database -> Database) -> Prompt
+mkPrompt pStr f = numPromptWithFallback pStr
+  (modify subMenu)
+  (\n -> modify
+    $ (database %~ f n)
+    . subMenu)
+
+subMenu :: ProgState -> ProgState
+subMenu = progMode.editStandingsModeL.esmSubModeL .~ ESMSubMenu

src/Mtlstats/Prompt/NewGame.hs

@@ -0,0 +1,122 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Prompt.NewGame
+  ( gameYearPrompt
+  , gameMonthPrompt
+  , gameDayPrompt
+  , otherTeamPrompt
+  , homeScorePrompt
+  , awayScorePrompt
+  , recordGoalPrompt
+  , recordAssistPrompt
+  , pMinPlayerPrompt
+  , assignPMinsPrompt
+  ) where
+
+import Control.Monad (when)
+import Control.Monad.State.Class (gets, modify)
+import Lens.Micro ((^.), (.~), (?~), (%~))
+
+import Mtlstats.Actions.NewGame
+import Mtlstats.Config
+import Mtlstats.Format
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompts for the game year
+gameYearPrompt :: Prompt
+gameYearPrompt = numPrompt "Game year: " $
+  modify . (progMode.gameStateL.gameYear ?~)
+
+-- | Prompts for the game month
+gameMonthPrompt :: Prompt
+gameMonthPrompt = numPromptRange 1 12 "Game month: " $
+  modify . (progMode.gameStateL.gameMonth ?~)
+
+-- | 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 = ucStrPrompt "Other team: " $
+  modify . (progMode.gameStateL.otherTeam .~)
+
+-- | Prompts for the home score
+homeScorePrompt :: Prompt
+homeScorePrompt = numPrompt "Home score: " $
+  modify . (progMode.gameStateL.homeScore ?~)
+
+-- | Prompts for the away score
+awayScorePrompt :: Prompt
+awayScorePrompt = numPrompt "Away score: " $ \score -> modify
+  $ overtimeCheck
+  . (progMode.gameStateL.awayScore ?~ score)
+
+-- | Prompts for the player who scored the goal
+recordGoalPrompt
+  :: Int
+  -- ^ The game number
+  -> Int
+  -- ^ The goal number
+  -> Prompt
+recordGoalPrompt game goal = selectActivePlayerPrompt
+  (  "*** 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 = selectActivePlayerPrompt
+  (  "*** 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 (^.progMode.gameStateL.assistsBy)
+      when (nAssists >= maxAssists) $
+        modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
+
+-- | Prompts for the player to assign penalty minutes to
+pMinPlayerPrompt :: Prompt
+pMinPlayerPrompt = selectActivePlayerPrompt
+  "Assign penalty minutes to: " $
+  \case
+    Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded  .~ True
+    Just n  -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
+
+-- | Prompts for the number of penalty mintues to assign to the player
+assignPMinsPrompt :: Prompt
+assignPMinsPrompt = numPrompt "Penalty minutes: " $
+  modify . assignPMins

src/Mtlstats/Prompt/NewGame/GoalieInput.hs

@@ -0,0 +1,54 @@
+{- |
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Mtlstats.Prompt.NewGame.GoalieInput
+  ( selectGameGoaliePrompt
+  , goalieMinsPlayedPrompt
+  , goalsAllowedPrompt
+  ) where
+
+import Control.Monad.State.Class (modify)
+import Lens.Micro ((?~))
+
+import Mtlstats.Actions.NewGame.GoalieInput
+import Mtlstats.Prompt
+import Mtlstats.Types
+
+-- | Prompts for a goalie who played in the game
+selectGameGoaliePrompt :: Prompt
+selectGameGoaliePrompt = selectActiveGoaliePrompt
+  "Which goalie played this game: " $
+  \case
+    Nothing -> modify finishGoalieEntry
+    Just n  -> modify $ progMode.gameStateL.gameSelectedGoalie  ?~ n
+
+-- | Prompts for the number of minutes the goalie has played
+goalieMinsPlayedPrompt :: Prompt
+goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
+  modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~)
+
+-- | Prompts for the number of goals the goalie allowed
+goalsAllowedPrompt :: Prompt
+goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
+  modify (progMode.gameStateL.gameGoalsAllowed ?~ n)
+  modify recordGoalieStats

src/Mtlstats/Report.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,24 +19,46 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Report (report, gameDate, playerNameColWidth) where
+module Mtlstats.Report (displayReport, exportReport, gameDate) where
 
+import Data.List (sortOn)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Ord (Down (Down))
 import Lens.Micro ((^.))
 
 import Mtlstats.Config
 import Mtlstats.Format
+import Mtlstats.Helpers.Goalie
+import Mtlstats.Helpers.Player
 import Mtlstats.Types
 import Mtlstats.Util
 
--- | Generates the report
+-- | Generates the report displayed on screen
-report
+displayReport
   :: Int
   -- ^ The number of columns for the report
   -> ProgState
   -- ^ The program state
   -> [String]
+displayReport width s
+  =  report width s
+  ++ [""]
+  ++ lifetimeStatsReport width s
+
+-- | Generates the report to be exported to file
+exportReport
+  :: Int
+  -- ^ The number of columns in the report
+  -> ProgState
+  -- ^ The program state
+  -> String
+exportReport width s
+  =  unlines (report width s)
+  ++ "\f"
+  ++ unlines (lifetimeStatsReport width s)
+
+report :: Int -> ProgState -> [String]
 report width s
   =  standingsReport width s
   ++ [""]
@@ -58,7 +80,8 @@ standingsReport width s = fromMaybe [] $ do
     tStats = addGameStats hStats aStats
   hScore <- gs^.homeScore
   aScore <- gs^.awayScore
-  Just
+  let
+    rHeader =
       [ overlay
         ("GAME NUMBER " ++ padNum 2 gNum)
         (centre width
@@ -67,98 +90,269 @@ standingsReport width s = fromMaybe [] $ do
       , date
       , centre width "STANDINGS"
       , ""
-    , centre width
-      $  left 11 myTeam
-      ++ right 2 "G"
-      ++ right 4 "W"
-      ++ right 4 "L"
-      ++ right 4 "OT"
-      ++ right 4 "GF"
-      ++ right 4 "GA"
-      ++ right 4 "P"
-    , centre width
-      $  left 11 "HOME"
-      ++ showStats hStats
-    , centre width
-      $ left 11 "ROAD"
-      ++ showStats aStats
-    , centre width
-      $  replicate 11 ' '
-      ++ replicate (2 + 4 * 6) '-'
-    , centre width
-      $  left 11 "TOTALS"
-      ++ showStats tStats
       ]
 
+    tHeader =
+      [ CellText myTeam
+      , CellText " G"
+      , CellText "   W"
+      , CellText "   L"
+      , CellText "  OT"
+      , CellText "  GF"
+      , CellText "  GA"
+      , CellText "   P"
+      ]
+
+    rowCells stats =
+      [ CellText $ show $ gmsGames stats
+      , CellText $ show $ stats^.gmsWins
+      , CellText $ show $ stats^.gmsLosses
+      , CellText $ show $ stats^.gmsOvertime
+      , CellText $ show $ stats^.gmsGoalsFor
+      , CellText $ show $ stats^.gmsGoalsAgainst
+      , CellText $ show $ gmsPoints stats
+      ]
+
+    body =
+      [ CellText "HOME" : rowCells hStats
+      , CellText "ROAD" : rowCells aStats
+      ]
+
+    separator = CellText "" : replicate 7 (CellFill '-')
+    totals = CellText "TOTALS" : rowCells tStats
+
+    table = map (centre width) $
+      complexTable
+      (left : repeat right)
+      (tHeader : body ++ [separator, totals])
+
+  Just $ rHeader ++ table
+
 gameStatsReport :: Int -> ProgState -> [String]
-gameStatsReport width s = playerReport width "GAME" $
+gameStatsReport width s = let
-  fromMaybe [] $ mapM
+  gs = s^.progMode.gameStateL
+  db = s^.database
+
+  playerStats = sortPlayers $ mapMaybe
     (\(pid, stats) -> do
-      p <- nth pid $ s^.database.dbPlayers
+      p <- nth pid $ db^.dbPlayers
       Just (p, stats))
-    (M.toList $ s^.progMode.gameStateL.gamePlayerStats)
+    (M.toList $ gs^.gamePlayerStats)
+
+  goalieStats = mapMaybe
+    (\(gid, stats) -> do
+      g <- nth gid $ db^.dbGoalies
+      Just (g, stats))
+    (M.toList $ gs^.gameGoalieStats)
+
+  criteria (_, ps) = psPoints ps > 0
+
+  in filteredPlayerReport width "GAME" criteria True False playerStats
+  ++ [""]
+  ++ gameGoalieReport width goalieStats
 
 yearToDateStatsReport :: Int -> ProgState -> [String]
-yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
+yearToDateStatsReport width s = let
-  map (\p -> (p, p^.pYtd)) $
+  db = s^.database
-  filter playerIsActive $ s^.database.dbPlayers
+
+  playerStats = sortPlayers
+    $ map (\p -> (p, p^.pYtd))
+    $ filter playerIsActive
+    $ db^.dbPlayers
+
+  goalieStats = map (\g -> (g, g^.gYtd))
+    $ filter goalieIsActive
+    $ db^.dbGoalies
+
+  in playerReport width "YEAR TO DATE" True False playerStats
+  ++ [""]
+  ++ goalieReport width True False goalieStats
+
+lifetimeStatsReport :: Int -> ProgState -> [String]
+lifetimeStatsReport width s = let
+  db = s^.database
+
+  playerStats = sortPlayers
+    $ map (\p -> (p, p^.pLifetime))
+    $ db^.dbPlayers
+
+  goalieStats = map (\g -> (g, g^.gLifetime))
+    $ db^.dbGoalies
+
+  in playerReport width "LIFETIME" False True playerStats
+  ++ [""]
+  ++ goalieReport width False True goalieStats
 
 gameDate :: GameState -> String
 gameDate gs = fromMaybe "" $ do
-  year  <- show <$> gs^.gameYear
+  y <- show <$> gs^.gameYear
-  month <- month <$> gs^.gameMonth
+  m <- month <$> gs^.gameMonth
-  day   <- padNum 2 <$> gs^.gameDay
+  d <- padNum 2 <$> gs^.gameDay
-  Just $ month ++ " " ++ day ++ " " ++ year
+  Just $ m ++ " " ++ d ++ " " ++ y
 
-playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
+playerReport
-playerReport width label ps = let
+  :: Int
-  nameWidth = playerNameColWidth $ map fst ps
+  -> String
-  tStats    = foldr (addPlayerStats . snd) newPlayerStats ps
+  -> Bool
-  in
+  -> Bool
+  -> [(Player, PlayerStats)]
+  -> [String]
+playerReport width label =
+  filteredPlayerReport width label (const True)
+
+filteredPlayerReport
+  :: Int
+  -> String
+  -> ((Player, PlayerStats) -> Bool)
+  -> Bool
+  -> Bool
+  -> [(Player, PlayerStats)]
+  -> [String]
+filteredPlayerReport width label criteria showTotals lineNumbers ps = let
+  tStats    = foldl addPlayerStats newPlayerStats $ map snd ps
+  criteria' = (&&) <$> criteria <*> \(p, _) -> p^.pNumber /= 0
+  fps       = filter criteria' ps
+
+  rHeader =
     [ 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
+  tHeader =
-playerNameColWidth = foldr
+    [ CellText "NO."
-  (\player current -> max current $ succ $ length $ player^.pName)
+    , CellText "Player"
-  10
+    , CellText "   G"
+    , CellText "   A"
+    , CellText "   P"
+    , CellText "  PM"
+    ]
 
-showStats :: GameStats -> String
+  statsCells stats =
-showStats gs
+    [ CellText $ show $ stats^.psGoals
-  =  right 2 (show $ gmsGames gs)
+    , CellText $ show $ stats^.psAssists
-  ++ right 4 (show $ gs^.gmsWins)
+    , CellText $ show $ psPoints stats
-  ++ right 4 (show $ gs^.gmsLosses)
+    , CellText $ show $ stats^.psPMin
-  ++ right 4 (show $ gs^.gmsOvertime)
+    ]
-  ++ right 4 (show $ gs^.gmsGoalsFor)
+
-  ++ right 4 (show $ gs^.gmsGoalsAgainst)
+  body = map
-  ++ right 4 (show $ gmsPoints gs)
+    (\(p, stats) ->
+      [ CellText $ show (p^.pNumber) ++ " "
+      , CellText $ playerName p
+      ] ++ statsCells stats)
+    fps
+
+  separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
+
+  totals =
+    [ CellText ""
+    , CellText ""
+    ] ++ statsCells tStats
+
+  olayText = if showTotals
+    then label ++ " TOTALS"
+    else ""
+
+  lnOverlay = if lineNumbers
+    then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
+    else repeat ""
+
+  table = overlayLast olayText
+    $ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
+    $ complexTable ([right, left] ++ repeat right)
+    $ tHeader : body ++ if showTotals
+      then [separator, totals]
+      else []
+
+  in rHeader ++ table
+
+goalieReport
+  :: Int
+  -> Bool
+  -> Bool
+  -> [(Goalie, GoalieStats)]
+  -> [String]
+goalieReport width showTotals lineNumbers goalieData = let
+  olayText = if showTotals
+    then "GOALTENDING TOTALS"
+    else ""
+
+  goalieData' = sortGoalies goalieData
+
+  tData = foldl addGoalieStats newGoalieStats
+    $ map snd goalieData'
+
+  header =
+    [ CellText "NO."
+    , CellText $ padRight (length olayText) "GOALTENDER"
+    , CellText "GP"
+    , CellText " MIN"
+    , CellText "  GA"
+    , CellText "  SO"
+    , CellText "AVE"
+    ]
+
+  rowCells stats =
+    [ CellText $ show $ stats^.gsGames
+    , CellText $ show $ stats^.gsMinsPlayed
+    , CellText $ show $ stats^.gsGoalsAllowed
+    , CellText $ show $ stats^.gsShutouts
+    , CellText $ showFloating $ gsAverage stats
+    ]
+
+  body = map
+    (\(goalie, stats) ->
+      [ CellText $ show (goalie^.gNumber) ++ " "
+      , CellText $ goalieName goalie
+      ] ++ rowCells stats)
+    goalieData'
+
+  separator
+    =  replicate 2 (CellText "")
+    ++ replicate 5 (CellFill '-')
+
+  summary = replicate 2 (CellText  "") ++ rowCells tData
+
+  lnOverlay = if lineNumbers
+    then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
+    else repeat ""
+
+  in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
+    $ overlayLast olayText
+    $ complexTable ([right, left] ++ repeat right)
+    $ header : body ++ if showTotals
+      then [separator, summary]
+      else []
+
+gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
+gameGoalieReport width goalieData = let
+  goalieData' = sortGoalies goalieData
+
+  header =
+    [ CellText "NO."
+    , CellText "GOALTENDER"
+    , CellText "   MIN"
+    , CellText "    GA"
+    , CellText "   AVE"
+    ]
+
+  body = map
+    (\(goalie, stats) ->
+      [ CellText $ show (goalie^.gNumber) ++ " "
+      , CellText $ goalieName goalie
+      , CellText $ show $ stats^.gsMinsPlayed
+      , CellText $ show $ stats^.gsGoalsAllowed
+      , CellText $ showFloating $ gsAverage stats
+      ])
+    goalieData'
+
+  in map (centre width)
+    $ complexTable ([right, left] ++ repeat right)
+    $ header : body
+
+sortPlayers :: [(Player, PlayerStats)] -> [(Player, PlayerStats)]
+sortPlayers = sortOn $ Down . \(p, ps) ->
+  (psPoints ps, psPoints $ p^.pLifetime)
+
+sortGoalies :: [(Goalie, GoalieStats)] -> [(Goalie, GoalieStats)]
+sortGoalies = sortOn $ Down . \(g, gs) ->
+  (gs^.gsMinsPlayed, g^.gLifetime.gsMinsPlayed)

src/Mtlstats/Types/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -38,8 +38,8 @@ module Mtlstats.Types.Menu (
 
 import Lens.Micro ((^.))
 import Lens.Micro.TH (makeLenses)
-import qualified UI.NCurses as C
 
+import Mtlstats.Format
 import Mtlstats.Types
 
 -- | Defines a menu
@@ -66,8 +66,15 @@ makeLenses ''Menu
 makeLenses ''MenuItem
 
 instance Show (Menu a) where
-  show m = m ^. menuTitle ++ "\n" ++ items
+  show m = unlines
-    where items = unlines $ map show $ m ^. menuItems
+    $  [ m^.menuTitle
+       , ""
+       ]
+    ++ body
+    where
+      body  = map (left width) items
+      width = maximum $ map length items
+      items = map show $ m^.menuItems
 
 instance Show (MenuItem a) where
-  show i = [i ^. miKey] ++ ") " ++ i ^. miDescription
+  show i = [i ^. miKey] ++ ": " ++ i ^. miDescription

src/Mtlstats/Util.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,9 +19,26 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
+module Mtlstats.Util
+  ( nth
+  , modifyNth
+  , dropNth
+  , updateMap
+  , slice
+  , capitalizeName
+  , linesToWidget
+  , linesToWidgetC
+  , userText
+  ) where
 
+import Brick.Types (Widget)
+import Brick.Widgets.Center (hCenter)
+import Brick.Widgets.Core (str, vBox)
+import Brick.Widgets.Edit (Editor, editContentsL, getEditContents)
+import Data.Char (isSpace, toUpper)
 import qualified Data.Map as M
+import Data.Text.Zipper (insertChar)
+import Lens.Micro ((^.), (&), (%~), to)
 
 -- | Attempt to select the element from a list at a given index
 nth
@@ -45,8 +62,21 @@ modifyNth
   -> [a]
   -- ^ The list
   -> [a]
-modifyNth n f = map (\(i, x) -> if i == n then f x else x)
+modifyNth n f = zipWith
-  . zip [0..]
+  (\i x -> if i == n then f x else x)
+  [0..]
+
+-- | Attempt to drop the nth element from a list
+dropNth
+  :: Int
+  -- ^ The index of the element to drop
+  -> [a]
+  -- ^ The list to be modified
+  -> [a]
+  -- ^ The modified list
+dropNth n = foldr
+  (\(i, x) acc -> if i == n then acc else x : acc)
+  [] . zip [0..]
 
 -- | Modify a value indexed by a given key in a map using a default
 -- initial value if not present
@@ -75,3 +105,45 @@ slice
   -- ^ The list to take a subset of
   -> [a]
 slice offset len = take len . drop offset
+
+-- | Name capitalization function for a player
+capitalizeName
+  :: Char
+  -- ^ The character being input
+  -> Editor String ()
+  -- ^ The current string
+  -> Editor String ()
+  -- ^ The resulting string
+capitalizeName ch e = e & editContentsL %~ insertChar ch'
+  where
+    s   = e^.to userText
+    ch' = if lockFlag s
+      then toUpper ch
+      else ch
+    lockFlag "" = True
+    lockFlag (c:cs)
+      | c == ','  = lockFlag' cs
+      | otherwise = lockFlag cs
+    lockFlag' "" = True
+    lockFlag' (c:cs)
+      | isSpace c = lockFlag' cs
+      | otherwise = False
+
+-- | Converts a list of lines to a widget
+linesToWidget :: [String] -> Widget ()
+linesToWidget = vBox . map (str . keepBlank)
+
+-- | Converts a list of lines to a widget with each line horizontally
+-- centered
+linesToWidgetC :: [String] -> Widget ()
+linesToWidgetC = vBox . map (hCenter . str . keepBlank)
+
+-- | Fetches the text from an editor widget
+userText :: Editor String () -> String
+userText w = case getEditContents w of
+  (x:_) -> x
+  []    -> ""
+
+keepBlank :: String -> String
+keepBlank "" = " "
+keepBlank s = s

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-14.0
+resolver: lts-20.22
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

stack.yaml.lock

@@ -7,13 +7,13 @@ packages:
 - completed:
     hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
     pantry-tree:
-      size: 674
       sha256: 093bdc85ed518c81724f5b6b81c24ab4ebdd231551861f4feaa43361136f70b7
+      size: 674
   original:
     hackage: ncurses-0.2.16@sha256:8ad9fe6562a80d28166d76adbac1eb4d40c6511fe4e9272ed6e1166dc2f1cdf1,3575
 snapshots:
 - completed:
-    size: 523443
+    sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/0.yaml
+    size: 650255
-    sha256: 283773e7120f5446d961eab35ea95c9af9c24187cc178537bd29273200a05171
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml
-  original: lts-14.0
+  original: lts-20.22

test/Actions/EditStandingsSpec.hs

@@ -0,0 +1,83 @@
+{-
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+module Actions.EditStandingsSpec (spec) where
+
+import Lens.Micro ((^.), (&), (.~))
+import Test.Hspec
+  ( Spec
+  , context
+  , describe
+  , it
+  , shouldBe
+  , shouldSatisfy
+  )
+
+import Mtlstats.Actions.EditStandings
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "EditStandings" $ do
+  mapM_
+    (\(label, f, expected) -> describe label $ do
+      let
+        ps  = newProgState
+        ps' = f ps
+
+      it "should set progMode to EditStandings" $
+        ps'^.progMode `shouldSatisfy` \case
+          (EditStandings _) -> True
+          _                 -> False
+
+      it ("should set editStandingsMode to " ++ show expected) $
+        ps'^.progMode.editStandingsModeL `shouldBe` expected)
+
+    --  label,               function,          expected mode
+    [ ( "editStandings",     editStandings,     ESMMenu            )
+    , ( "editHomeStandings", editHomeStandings, ESMHome ESMSubMenu )
+    , ( "editAwayStandings", editAwayStandings, ESMAway ESMSubMenu )
+    ]
+
+  mapM_
+    (\(label, f, expected) -> describe label $ do
+      mapM_
+        (\prefix -> context ("mode: " ++ show (prefix ESMSubMenu)) $ let
+          ps  = newProgState & progMode.editStandingsModeL .~ prefix ESMSubMenu
+          ps' = f ps
+          in it ("should set the mode to " ++ show expected) $
+            ps'^.progMode.editStandingsModeL `shouldBe` prefix expected)
+        [ESMHome, ESMAway]
+
+      context "mode: ESMMenu" $ let
+        ps  = newProgState & progMode.editStandingsModeL .~ ESMMenu
+        ps' = f ps
+        in it "should not change the mode" $
+          ps'^.progMode.editStandingsModeL `shouldBe` ESMMenu)
+
+    --  label,              function,         expected
+    [ ( "editWins",         editWins,         ESMEditWins         )
+    , ( "editLosses",       editLosses,       ESMEditLosses       )
+    , ( "editOvertime",     editOvertime,     ESMEditOvertime     )
+    , ( "editGoalsFor",     editGoalsFor,     ESMEditGoalsFor     )
+    , ( "editGoalsAgainst", editGoalsAgainst, ESMEditGoalsAgainst )
+    ]

test/Actions/NewGame/GoalieInputSpec.hs

@@ -0,0 +1,386 @@
+{-
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Actions.NewGame.GoalieInputSpec (spec) where
+
+import qualified Data.Map as M
+import Data.Maybe (fromJust)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Actions.NewGame.GoalieInput
+import Mtlstats.Types
+import Mtlstats.Util
+
+import qualified TypesSpec as TS
+
+spec :: Spec
+spec = describe "GoalieInput" $ do
+  finishGoalieEntrySpec
+  recordGoalieStatsSpec
+  setGameGoalieSpec
+
+finishGoalieEntrySpec :: Spec
+finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
+  (\(label, stats, grFlag, gaFlag) -> context label $ do
+    let
+      ps = newProgState
+        & progMode.gameStateL
+          %~ (gameGoalieStats .~ stats)
+          .  (gameType        ?~ HomeGame)
+          .  (homeScore       ?~ 1)
+          .  (awayScore       ?~ 0)
+          .  (overtimeFlag    ?~ False)
+        & database.dbGoalies .~ goalies
+
+      ps' = finishGoalieEntry ps
+      gs  = ps'^.progMode.gameStateL
+
+    describe "gameGoaliesRecorded" $
+      it ("should be " ++ show grFlag) $
+        gs^.gameGoaliesRecorded `shouldBe` grFlag
+
+    describe "gameGoalieAssigned" $
+      it ("should be " ++ show gaFlag) $
+        gs^.gameGoalieAssigned `shouldBe` gaFlag)
+
+  --  label,         initial stats, goalies recorded, goalie assigned
+  [ ( "no goalies",  noGoalies,     False,            False           )
+  , ( "one goalie",  oneGoalie,     True,             True            )
+  , ( "two goalies", twoGoalies,    True,             False           )
+  ]
+
+  where
+    goalies    = [joe, bob]
+    joe        = newGoalie 2 "Joe"
+    bob        = newGoalie 3 "Bob"
+    noGoalies  = M.empty
+    oneGoalie  = M.fromList [joeStats]
+    twoGoalies = M.fromList [joeStats, bobStats]
+    joeStats   = (0, newGoalieStats)
+    bobStats   = (1, newGoalieStats)
+
+recordGoalieStatsSpec :: Spec
+recordGoalieStatsSpec = describe "recordGoalieStats" $ let
+  goalieStats games mins goals = newGoalieStats
+    & gsGames        .~ games
+    & gsMinsPlayed   .~ mins
+    & gsGoalsAllowed .~ goals
+
+  joe = newGoalie 2 "Joe"
+    & gYtd      .~ goalieStats 10 11 12
+    & gLifetime .~ goalieStats 20 21 22
+
+  bob = newGoalie 3 "Bob"
+    & gYtd      .~ goalieStats 30 31 32
+    & gLifetime .~ goalieStats 40 41 42
+
+  gameState n mins goals = newGameState
+    & gameGoalieStats      .~ M.fromList [(1, goalieStats 1 2 3)]
+    & gameSelectedGoalie   .~ n
+    & gameGoalieMinsPlayed .~ mins
+    & gameGoalsAllowed     .~ goals
+
+  progState n mins goals = newProgState
+    & database.dbGoalies  .~ [joe, bob]
+    & progMode.gameStateL .~ gameState n mins goals
+
+  in mapM_
+    (\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
+      s = recordGoalieStats $ progState setGid mins goals
+      in context setName $ do
+
+        mapM_
+          (\( chkName
+            , chkGid
+            , ( gGames
+              , gMins
+              , gGoals
+              , ytdGames
+              , ytdMins
+              , ytdGoals
+              , ltGames
+              , ltMins
+              , ltGoals
+              )
+            ) -> context chkName $ do
+              let
+                gs     = s^.progMode.gameStateL.gameGoalieStats
+                game   = M.findWithDefault newGoalieStats chkGid gs
+                goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
+                ytd    = goalie^.gYtd
+                lt     = goalie^.gLifetime
+
+              context "game" $
+                game `TS.compareTest` goalieStats gGames gMins gGoals
+
+              context "year-to-date" $
+                ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
+
+              context "lifetime" $
+                lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
+
+          [ ( "checking Joe", 0, joeData )
+          , ( "checking Bob", 1, bobData )
+          ]
+
+        context "selected goalie" $ let
+          expected = if reset then Nothing else setGid
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
+
+        context "minutes played" $ let
+          expected = if reset then Nothing else mins
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
+
+        context "goals allowed" $ let
+          expected = if reset then Nothing else goals
+          in it ("should be " ++ show expected) $
+            (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
+
+    [ ( "updating Joe"
+      , Just 0
+      , Just 1
+      , Just 2
+      , (1, 1, 2, 11, 12, 14, 21, 22, 24)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , True
+      )
+    , ( "updating Bob"
+      , Just 1
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 3, 5, 30, 32, 34, 40, 42, 44)
+      , True
+      )
+    , ( "goalie out of bounds"
+      , Just 2
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing goalie"
+      , Nothing
+      , Just 1
+      , Just 2
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing minutes"
+      , Just 0
+      , Nothing
+      , Just 1
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    , ( "missing goals"
+      , Just 0
+      , Just 1
+      , Nothing
+      , (0, 0, 0, 10, 11, 12, 20, 21, 22)
+      , (1, 2, 3, 30, 31, 32, 40, 41, 42)
+      , False
+      )
+    ]
+
+setGameGoalieSpec :: Spec
+setGameGoalieSpec = describe "setGameGoalie" $ mapM_
+
+  (\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
+    context label $ do
+
+      let
+        ps'          = setGameGoalie goalieId ps
+        (joe', bob') = getFirstTwo $ ps'^.database.dbGoalies
+        gStats'      = ps'^.progMode.gameStateL.gameGoalieStats
+
+      context "Joe" $ joe' `TS.compareTest` expectedJoe
+      context "Bob" $ bob' `TS.compareTest` expectedBob
+      context "game stats" $ gStats' `TS.compareTest` expectedGStats)
+
+  [ ( "Joe wins - no shutout"
+    , 0
+    , psWin
+    , joeWin
+    , bob
+    , gsJoeWin
+    )
+
+  , ( "Bob wins - no shutout"
+    , 1
+    , psWin
+    , joe
+    , bobWin
+    , gsBobWin
+    )
+
+  , ( "Joe wins - shutout"
+    , 0
+    , psWinSO
+    , joeWinSO
+    , bob
+    , gsJoeWinSO
+    )
+
+  , ( "Bob wins - shutout"
+    , 1
+    , psWinSO
+    , joe
+    , bobWinSO
+    , gsBobWinSO
+    )
+
+  , ( "Joe loses"
+    , 0
+    , psLose
+    , joeLose
+    , bob
+    , gsJoeLose
+    )
+
+  , ( "Bob loses"
+    , 1
+    , psLose
+    , joe
+    , bobLose
+    , gsBobLose
+    )
+
+  , ( "Joe overtime"
+    , 0
+    , psOT
+    , joeOT
+    , bob
+    , gsJoeOT
+    )
+
+  , ( "Bob overtime"
+    , 1
+    , psOT
+    , joe
+    , bobOT
+    , gsBobOT
+    )
+  ]
+
+  where
+
+    joe
+      = newGoalie 2 "Joe"
+      & gYtd
+        %~ (gsShutouts .~ 11)
+        .  (gsWins     .~ 12)
+        .  (gsLosses   .~ 13)
+        .  (gsTies     .~ 14)
+      & gLifetime
+        %~ (gsShutouts .~ 21)
+        .  (gsWins     .~ 22)
+        .  (gsLosses   .~ 23)
+        .  (gsTies     .~ 24)
+
+    bob
+      = newGoalie 3 "Bob"
+      & gYtd
+        %~ (gsShutouts .~ 31)
+        .  (gsWins     .~ 32)
+        .  (gsLosses   .~ 33)
+        .  (gsTies     .~ 34)
+      & gLifetime
+        %~ (gsShutouts .~ 41)
+        .  (gsWins     .~ 42)
+        .  (gsLosses   .~ 43)
+        .  (gsTies     .~ 44)
+
+    joeWin   = win joe
+    bobWin   = win bob
+    joeWinSO = winSO joe
+    bobWinSO = winSO bob
+    joeLose  = lose joe
+    bobLose  = lose bob
+    joeOT    = tie joe
+    bobOT    = tie bob
+
+    psWin = mkProgState
+      $ (homeScore ?~ 2)
+      . (awayScore ?~ 1)
+
+    psWinSO = mkProgState
+      $ (homeScore ?~ 1)
+      . (awayScore ?~ 0)
+
+    psLose = mkProgState
+      $ (homeScore ?~ 0)
+      . (awayScore ?~ 1)
+
+    psOT = mkProgState
+      $ (homeScore    ?~ 0)
+      . (awayScore    ?~ 1)
+      . (overtimeFlag ?~ True)
+
+    mkProgState f
+      = newProgState
+      & database.dbGoalies  .~ [joe, bob]
+      & progMode.gameStateL
+        %~ f
+        .  (gameType     ?~ HomeGame)
+        .  (overtimeFlag ?~ False)
+
+    gsJoeWin   = mkGameStats 0 incWin
+    gsBobWin   = mkGameStats 1 incWin
+    gsJoeWinSO = mkGameStats 0 $ incWin . incSO
+    gsBobWinSO = mkGameStats 1 $ incWin . incSO
+    gsJoeLose  = mkGameStats 0 incLoss
+    gsBobLose  = mkGameStats 1 incLoss
+    gsJoeOT    = mkGameStats 0 incOT
+    gsBobOT    = mkGameStats 1 incOT
+
+    mkGameStats n f = M.fromList [(n, f newGoalieStats)]
+
+    win
+      = (gYtd      %~ incWin)
+      . (gLifetime %~ incWin)
+
+    winSO
+      = (gYtd      %~ (incWin . incSO))
+      . (gLifetime %~ (incWin . incSO))
+
+    lose
+      = (gYtd      %~ incLoss)
+      . (gLifetime %~ incLoss)
+
+    tie
+      = (gYtd      %~ incOT)
+      . (gLifetime %~ incOT)
+
+    incWin  = gsWins     %~ succ
+    incSO   = gsShutouts %~ succ
+    incLoss = gsLosses   %~ succ
+    incOT   = gsTies     %~ succ
+
+getFirstTwo :: [a] -> (a, a)
+getFirstTwo (x:y:_) = (x, y)
+getFirstTwo _       = error "insufficient members of list"

test/Actions/NewGameSpec.hs

@@ -0,0 +1,496 @@
+{-
+
+mtlstats
+Copyright (C) Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Actions.NewGameSpec (spec) where
+
+import Control.Monad (replicateM)
+import qualified Data.Map as M
+import Data.Maybe (fromJust)
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
+import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
+
+import Mtlstats.Actions.NewGame
+import Mtlstats.Types
+import Mtlstats.Util
+
+import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
+import qualified TypesSpec as TS
+
+spec :: Spec
+spec = describe "NewGame" $ do
+  overtimeCheckSpec
+  updateGameStatsSpec
+  validateGameDateSpec
+  recordGoalAssistsSpec
+  awardGoalSpec
+  awardAssistSpec
+  resetGoalDataSpec
+  assignPMinsSpec
+  awardShutoutsSpec
+  GoalieInput.spec
+
+overtimeCheckSpec :: Spec
+overtimeCheckSpec = describe "overtimeCheck" $ mapM_
+  (\(label, expectation, gt, home, away, otf) ->
+    context label $
+      it expectation $ let
+        ps = newProgState & progMode.gameStateL
+          %~ (gameType  ?~ gt)
+          .  (homeScore ?~ home)
+          .  (awayScore ?~ away)
+
+        ps' = overtimeCheck ps
+        in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
+
+  --  label,       expectation, type,     home, away, ot flag
+  [ ( "home win",  clearFlag,   HomeGame, 2,    1,    Just False )
+  , ( "home loss", leaveFlag,   HomeGame, 1,    2,    Nothing    )
+  , ( "home tie",  setFlag,     HomeGame, 1,    1,    Just True  )
+  , ( "away win",  clearFlag,   AwayGame, 1,    2,    Just False )
+  , ( "away loss", leaveFlag,   AwayGame, 2,    1,    Nothing    )
+  , ( "away tie",  setFlag,     AwayGame, 1,    1,    Just True  )
+  ]
+
+  where
+    clearFlag = "should set the overtimeFlag to True"
+    setFlag   = "should set the overtimeFlag to False"
+    leaveFlag = "should leave the overtimeFlag as Nothing"
+
+updateGameStatsSpec :: Spec
+updateGameStatsSpec = describe "updateGameStats" $ do
+  let
+
+    baseStats = newGameStats
+      & gmsWins         .~ 1
+      & gmsLosses       .~ 1
+      & gmsOvertime     .~ 1
+      & gmsGoalsFor     .~ 1
+      & gmsGoalsAgainst .~ 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 hf ha aw al ao af aa = newDatabase
+      & dbHomeGameStats
+        %~ (gmsWins         .~ hw)
+        .  (gmsLosses       .~ hl)
+        .  (gmsOvertime     .~ ho)
+        .  (gmsGoalsFor     .~ hf)
+        .  (gmsGoalsAgainst .~ ha)
+      & dbAwayGameStats
+        %~ (gmsWins         .~ aw)
+        .  (gmsLosses       .~ al)
+        .  (gmsOvertime     .~ ao)
+        .  (gmsGoalsFor     .~ af)
+        .  (gmsGoalsAgainst .~ aa)
+
+  context "home win" $
+    it "should record a home win" $ let
+      s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 2 1 1 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 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 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 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 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 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 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 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 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 1 1 1 1
+
+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
+
+recordGoalAssistsSpec :: Spec
+recordGoalAssistsSpec = describe "recordGoalAssists" $ do
+  let
+    joe   = newPlayer 1 "Joe"   "centre"
+    bob   = newPlayer 2 "Bob"   "defense"
+    steve = newPlayer 3 "Steve" "forward"
+    dave  = newPlayer 4 "Dave"  "somewhere"
+    frank = newPlayer 5 "Frank" "elsewhere"
+    ps
+      = newProgState
+      & database.dbPlayers .~ [joe, bob, steve, dave, frank]
+      & progMode.gameStateL
+        %~ (goalBy              ?~ 0)
+        .  (assistsBy           .~ [1, 2])
+        .  (confirmGoalDataFlag .~ True)
+      & recordGoalAssists
+
+  mapM_
+    (\(name, n, goals, assists) -> context name $ do
+      let
+        player = (ps^.database.dbPlayers) !! n
+        stats  = M.findWithDefault newPlayerStats n $
+          ps^.progMode.gameStateL.gamePlayerStats
+
+      it ("should set the year-to-date goals to " ++ show goals) $
+        player^.pYtd.psGoals `shouldBe` goals
+
+      it ("should set the lifetime goals to " ++ show goals) $
+        player^.pLifetime.psGoals `shouldBe` goals
+
+      it ("should set the game goals to " ++ show goals) $
+        stats^.psAssists `shouldBe` assists
+
+      it ("should set the year-to-date assists to " ++ show assists) $
+        player^.pYtd.psAssists `shouldBe` assists
+
+      it ("should set the lifetime assists to " ++ show assists) $
+        player^.pLifetime.psAssists `shouldBe` assists
+
+      it ("should set the game assists to " ++ show assists) $
+        stats^.psAssists `shouldBe` assists)
+
+    --  name,    index, goals, assists
+    [ ( "Joe",   0,     1,     0       )
+    , ( "Bob",   1,     0,     1       )
+    , ( "Steve", 2,     0,     1       )
+    , ( "Dave",  3,     0,     0       )
+    ]
+
+  it "should clear the goalBy value" $
+    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
+
+  it "should clear the assistsBy list" $
+    ps^.progMode.gameStateL.assistsBy `shouldBe` []
+
+  it "should increment the pointsAccounted counter" $
+    ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
+
+  it "should clear the confirmGoalDataFlag" $
+    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
+
+awardGoalSpec :: Spec
+awardGoalSpec = describe "awardGoal" $ do
+  let
+    joe
+      = newPlayer 2 "Joe" "centre"
+      & pYtd.psGoals      .~ 1
+      & pLifetime.psGoals .~ 2
+    bob
+      = newPlayer 3 "Bob" "defense"
+      & pYtd.psGoals      .~ 3
+      & pLifetime.psGoals .~ 4
+    db
+      = newDatabase
+      & dbPlayers .~ [joe, bob]
+    joeStats
+      = newPlayerStats
+      & psGoals .~ 1
+    ps
+      = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
+      & database .~ db
+
+  mapM_
+    (\(name, pid, ytd, lt, game) ->
+      context name $ do
+        let
+          ps'    = awardGoal pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ name ++ "'s year-to-date goals") $
+          player^.pYtd.psGoals `shouldBe` ytd
+
+        it ("should increment " ++ name ++ "'s lifetime goals") $
+          player^.pLifetime.psGoals `shouldBe` lt
+
+        it ("should increment " ++ name ++ "'s game goals") $
+          gStats^.psGoals `shouldBe` game)
+    --  player name, player id, ytd goals, lifetime goals, game goals
+    [ ( "Joe",       0,         2,         3,              2          )
+    , ( "Bob",       1,         4,         5,              1          )
+    ]
+
+  context "invalid index" $ let
+    ps' = awardGoal 2 ps
+    in it "should not change the database" $
+      ps'^.database `shouldBe` db
+
+  context "negative index" $ let
+    ps' = awardGoal (-1) ps
+    in it "should not change the database" $
+      ps'^.database `shouldBe` db
+
+awardAssistSpec :: Spec
+awardAssistSpec = describe "awardAssist" $ do
+  let
+    joe
+      = newPlayer 1 "Joe" "centre"
+      & pYtd.psAssists      .~ 1
+      & pLifetime.psAssists .~ 2
+    bob
+      = newPlayer 2 "Bob" "defense"
+      & pYtd.psAssists      .~ 3
+      & pLifetime.psAssists .~ 4
+    joeStats
+      = newPlayerStats
+      & psAssists .~ 1
+    ps
+      = newProgState
+      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
+      & database.dbPlayers .~ [joe, bob]
+
+  mapM_
+    (\(name, pid, ytd, lt, game) ->
+      context name $ do
+        let
+          ps' = awardAssist pid ps
+          player = (ps'^.database.dbPlayers) !! pid
+          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
+
+        it ("should increment " ++ name ++ "'s year-to-date assists") $
+          player^.pYtd.psAssists `shouldBe` ytd
+
+        it ("should increment " ++ name ++ "'s lifetime assists") $
+          player^.pLifetime.psAssists `shouldBe` lt
+
+        it ("should increment " ++ name ++ "'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 TS.makePlayer
+  let
+    gs
+      = newGameState
+      & goalBy              ?~ 1
+      & assistsBy           .~ [2, 3]
+      & confirmGoalDataFlag .~ True
+    ps
+      = newProgState
+      & database.dbPlayers  .~ players
+      & progMode.gameStateL .~ gs
+      & resetGoalData
+
+  it "should clear the goalBy value" $
+    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
+
+  it "should clear the assists by list" $
+    ps^.progMode.gameStateL.assistsBy `shouldBe` []
+
+  it "should clear confirmGoalDataFlag" $
+    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
+
+assignPMinsSpec :: Spec
+assignPMinsSpec = describe "assignPMins" $ let
+
+  bob = newPlayer 2 "Bob" "centre"
+    & pYtd.psPMin      .~ 3
+    & pLifetime.psPMin .~ 4
+
+  joe = newPlayer 3 "Joe" "defense"
+    & pYtd.psPMin      .~ 5
+    & pLifetime.psPMin .~ 6
+
+  ps pid = newProgState
+    & database.dbPlayers .~ [bob, joe]
+    & progMode.gameStateL
+      %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
+      .  (gameSelectedPlayer .~ pid)
+
+  in mapM_
+    (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
+      context ("selectedPlayer = " ++ show pid) $ do
+        let ps' = assignPMins 2 $ ps pid
+
+        mapM_
+          (\(name, pid', lt, ytd, game) -> context name $ do
+            let
+              player = fromJust $ nth pid' $ ps'^.database.dbPlayers
+              gStats = ps'^.progMode.gameStateL.gamePlayerStats
+              pStats = M.findWithDefault newPlayerStats pid' gStats
+
+            context "lifetime penalty minutes" $
+              it ("should be " ++ show lt) $
+                player^.pLifetime.psPMin `shouldBe` lt
+
+            context "year-to-date penalty minutes" $
+              it ("should be " ++ show ytd) $
+                player^.pYtd.psPMin `shouldBe` ytd
+
+            context "game penalty minutes" $
+              it ("should be " ++ show game) $
+                pStats^.psPMin `shouldBe` game)
+
+          --  name,  index, lifetime, ytd,    game
+          [ ( "Bob", 0,     bobLt,    bobYtd, bobGame )
+          , ( "Joe", 1,     joeLt,    joeYtd, joeGame )
+          ]
+
+        it "should set selectedPlayer to Nothing" $
+          ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
+
+    --  index,   bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
+    [ ( Just 0,  6,      5,       4,        6,      5,       0        )
+    , ( Just 1,  4,      3,       2,        8,      7,       2        )
+    , ( Just 2,  4,      3,       2,        6,      5,       0        )
+    , ( Nothing, 4,      3,       2,        6,      5,       0        )
+    ]
+
+awardShutoutsSpec :: Spec
+awardShutoutsSpec = describe "awardShutouts" $ let
+  joe = newGoalie 2 "Joe"
+    & gYtd.gsShutouts      .~ 1
+    & gLifetime.gsShutouts .~ 2
+
+  bob = newGoalie 3 "Bob"
+    & gYtd.gsShutouts      .~ 3
+    & gLifetime.gsShutouts .~ 4
+
+  steve = newGoalie 5 "Steve"
+    & gYtd.gsShutouts      .~ 5
+    & gLifetime.gsShutouts .~ 6
+
+  ps = newProgState
+    & database.dbGoalies .~ [joe, bob, steve]
+    & progMode.gameStateL.gameGoalieStats .~ M.fromList
+      [ ( 0, newGoalieStats & gsGoalsAllowed .~ 1 )
+      , ( 1, newGoalieStats                       )
+      ]
+    & awardShutouts
+
+  in mapM_
+    (\(name, gid, expectedGame, expectedYtd, expectedLt) -> context name $ let
+      game = M.findWithDefault newGoalieStats gid $
+        ps^.progMode.gameStateL.gameGoalieStats
+      goalie = (ps^.database.dbGoalies) !! gid
+      in mapM_
+        (\(label, actual, expected) -> context label $
+          it ("should be " ++ show actual) $
+            actual `shouldBe` expected)
+        --  label,      actual,                       expected
+        [ ( "Game",     game^.gsShutouts,             expectedGame )
+        , ( "YTD",      goalie^.gYtd.gsShutouts,      expectedYtd  )
+        , ( "lifetime", goalie^.gLifetime.gsShutouts, expectedLt   )
+        ])
+    --  goalie,  goalie ID, Game, YTD, lifetime
+    [ ( "Joe",   0,         0,    1,   2        )
+    , ( "Bob",   1,         1,    4,   5        )
+    , ( "Steve", 2,         0,    5,   6        )
+    ]

test/ActionsSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -24,16 +24,12 @@ 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 ((^.), (&), (.~), (?~), (%~), to)
-import Data.Maybe (fromJust)
-import Lens.Micro ((^.), (&), (.~), (?~), (%~))
-import System.Random (randomRIO)
 import Test.Hspec
   ( Spec
   , context
   , describe
   , it
-  , runIO
   , shouldBe
   , shouldNotBe
   , shouldSatisfy
@@ -43,26 +39,32 @@ import Mtlstats.Actions
 import Mtlstats.Types
 import Mtlstats.Util
 
+import qualified Actions.NewGameSpec as NewGame
+import qualified Actions.EditStandingsSpec as EditStandings
+import SpecHelpers
+import qualified TypesSpec as TS
+
 spec :: Spec
 spec = describe "Mtlstats.Actions" $ do
   startNewSeasonSpec
   startNewGameSpec
   resetYtdSpec
-  addCharSpec
+  clearRookiesSpec
-  removeCharSpec
+  resetStandingsSpec
-  overtimeCheckSpec
-  updateGameStatsSpec
-  validateGameDateSpec
   createPlayerSpec
+  createGoalieSpec
+  editSpec
+  editPlayerSpec
+  editSelectedPlayerSpec
+  editGoalieSpec
+  editSelectedGoalieSpec
   addPlayerSpec
-  recordGoalAssistsSpec
+  addGoalieSpec
-  awardGoalSpec
+  resetCreatePlayerStateSpec
-  awardAssistSpec
+  resetCreateGoalieStateSpec
-  resetGoalDataSpec
-  assignPMinsSpec
   backHomeSpec
-  scrollUpSpec
+  NewGame.spec
-  scrollDownSpec
+  EditStandings.spec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -90,8 +92,8 @@ startNewGameSpec = describe "startNewGame" $ do
 resetYtdSpec :: Spec
 resetYtdSpec = describe "resetYtd" $
   it "should reset the year-to-date stats for all players" $ do
-    ps <- replicateM 2 makePlayer
+    ps <- replicateM 2 TS.makePlayer
-    gs <- replicateM 2 makeGoalie
+    gs <- replicateM 2 TS.makeGoalie
     let
       s = newProgState
         & database . dbPlayers .~ ps
@@ -117,237 +119,90 @@ resetYtdSpec = describe "resetYtd" $
         ytd ^. gsGames        `shouldBe`    0
         ytd ^. gsMinsPlayed   `shouldBe`    0
         ytd ^. gsGoalsAllowed `shouldBe`    0
-        ytd ^. gsGoalsAgainst `shouldBe`    0
         ytd ^. gsWins         `shouldBe`    0
         ytd ^. gsLosses       `shouldBe`    0
         ytd ^. gsTies         `shouldBe`    0
         lt ^. gsGames         `shouldNotBe` 0
         lt ^. gsMinsPlayed    `shouldNotBe` 0
         lt ^. gsGoalsAllowed  `shouldNotBe` 0
-        lt ^. gsGoalsAgainst  `shouldNotBe` 0
         lt ^. gsWins          `shouldNotBe` 0
         lt ^. gsLosses        `shouldNotBe` 0
         lt ^. gsTies          `shouldNotBe` 0) $
       s ^. database . dbGoalies
 
-addCharSpec :: Spec
+clearRookiesSpec :: Spec
-addCharSpec = describe "addChar" $
+clearRookiesSpec = describe "clearRookies" $ do
-  it "should add the character to the input buffer" $ let
-    s = newProgState
-      & inputBuffer .~ "foo"
-      & addChar 'd'
-  in s ^. inputBuffer `shouldBe` "food"
-
-removeCharSpec :: Spec
-removeCharSpec = describe "removeChar" $ do
-
-  context "empty" $
-    it "should remove the character from the input buffer" $ let
-      s = removeChar newProgState
-      in s ^. inputBuffer `shouldBe` ""
-
-  context "not empty" $
-    it "should remove the character from the input buffer" $ let
-      s = newProgState
-        & inputBuffer .~ "foo"
-        & 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
+    players =
-      & gmsWins         .~ 1
+      [ newPlayer 1 "Joe" "centre" & pRookie .~ True
-      & gmsLosses       .~ 1
+      , newPlayer 2 "Bob" "centre" & pRookie .~ False
-      & gmsOvertime     .~ 1
+      ]
-      & gmsGoalsFor     .~ 1
-      & gmsGoalsAgainst .~ 1
 
-    s t h a o = newProgState
+    goalies =
-      & progMode.gameStateL
+      [ newGoalie 3 "Bill" & gRookie .~ True
-        %~ (gameType     .~ t)
+      , newGoalie 4 "Doug" & gRookie .~ False
-        .  (homeScore    .~ h)
+      ]
-        .  (awayScore    .~ a)
+
-        .  (overtimeFlag .~ o)
+    ps = newProgState
       & database
-        %~ (dbHomeGameStats .~ baseStats)
+        %~ (dbPlayers .~ players)
-        .  (dbAwayGameStats .~ baseStats)
+        .  (dbGoalies .~ goalies)
 
-    db hw hl ho hf ha aw al ao af aa = newDatabase
+    ps' = clearRookies ps
-      & dbHomeGameStats
-        %~ (gmsWins         .~ hw)
-        .  (gmsLosses       .~ hl)
-        .  (gmsOvertime     .~ ho)
-        .  (gmsGoalsFor     .~ hf)
-        .  (gmsGoalsAgainst .~ ha)
-      & dbAwayGameStats
-        %~ (gmsWins         .~ aw)
-        .  (gmsLosses       .~ al)
-        .  (gmsOvertime     .~ ao)
-        .  (gmsGoalsFor     .~ af)
-        .  (gmsGoalsAgainst .~ aa)
 
-  context "home win" $
+  context "Players" $ mapM_
-    it "should record a home win" $ let
+    (\p -> let
-      s'  = s (Just HomeGame) (Just 2) (Just 1) (Just False)
+      name  = p^.pName
-      db' = updateGameStats s' ^. database
+      rFlag = p^.pRookie
-      in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
+      in context name $
+        it "should not be a rookie" $
+          rFlag `shouldBe` False)
+    (ps'^.database.dbPlayers)
 
-  context "home loss" $
+  context "Goalies" $ mapM_
-    it "should record a home loss" $ let
+    (\g -> let
-      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just False)
+      name  = g^.gName
-      db' = updateGameStats s' ^. database
+      rFlag = g^.gRookie
-      in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
+      in context name $
+        it "should not be a rookie" $
+          rFlag `shouldBe` False)
+    (ps'^.database.dbGoalies)
 
-  context "home overtime loss" $
+resetStandingsSpec :: Spec
-    it "should record a home overtime" $ let
+resetStandingsSpec = describe "resetStandings" $ do
-      s'  = s (Just HomeGame) (Just 1) (Just 2) (Just True)
-      db' = updateGameStats s' ^. database
-      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 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 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 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 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 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 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 1 1 1 1
-
-validateGameDateSpec :: Spec
-validateGameDateSpec = describe "validateGameDate" $ do
-
-  context "valid date" $
-    it "should leave the date unchanged" $ do
   let
-        s = newProgState
+    home = GameStats
-          & progMode.gameStateL
+      { _gmsWins         = 1
-            %~ (gameYear  ?~ 2019)
+      , _gmsLosses       = 2
-            .  (gameMonth ?~ 6)
+      , _gmsOvertime     = 3
-            .  (gameDay   ?~ 25)
+      , _gmsGoalsFor     = 4
-          & validateGameDate
+      , _gmsGoalsAgainst = 5
-      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+      }
-      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
-      s^.progMode.gameStateL.gameDay   `shouldBe` Just 25
 
-  context "invalid date" $
+    away = GameStats
-    it "should clear the date" $ do
+      { _gmsWins         = 6
-      let
+      , _gmsLosses       = 7
-        s = newProgState
+      , _gmsOvertime     = 8
-          & progMode.gameStateL
+      , _gmsGoalsFor     = 9
-            %~ (gameYear  ?~ 2019)
+      , _gmsGoalsAgainst = 10
-            .  (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" $
+    db = newDatabase
-    it "should not change anything" $ do
+      & dbHomeGameStats .~ home
-      let
+      & dbAwayGameStats .~ away
 
-        gs = newGameState
+    ps = newProgState
-          & gameYear  ?~ 2019
+      & database .~ db
-          & gameMonth ?~ 6
+      & resetStandings
 
-        s = newProgState
+  context "home standings" $
-          & progMode.gameStateL .~ gs
+    it "should be reset" $
-          & validateGameDate
+      ps^.database.dbHomeGameStats `shouldBe` newGameStats
 
-      s^.progMode.gameStateL.gameYear  `shouldBe` Just 2019
+  context "away standings" $
-      s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
+    it "should be reset" $
-      s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
+      ps^.database.dbAwayGameStats `shouldBe` newGameStats
 
 createPlayerSpec :: Spec
 createPlayerSpec = describe "createPlayer" $
@@ -355,313 +210,196 @@ createPlayerSpec = describe "createPlayer" $
     s = createPlayer newProgState
     in show (s^.progMode) `shouldBe` "CreatePlayer"
 
-addPlayerSpec :: Spec
+createGoalieSpec :: Spec
-addPlayerSpec = describe "addPlayer" $ do
+createGoalieSpec = describe "createGoalie" $
-  let
+  it "should change the mode appropriately" $ let
-    p1 = newPlayer 1 "Joe" "centre"
+    s = createGoalie newProgState
-    p2 = newPlayer 2 "Bob" "defense"
+    in show (s^.progMode) `shouldBe` "CreateGoalie"
-    db = newDatabase
-      & dbPlayers .~ [p1]
-    s pm = newProgState
-      & progMode .~ pm
-      & database .~ db
 
-  context "data available" $
+editSpec :: Spec
-    it "should create the player" $ let
+editSpec = describe "edit" $
-      s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
+  it "should change the mode to EditMenu" $ let
-        & cpsNumber   ?~ 2
+    ps = edit newProgState
+    in show (ps^.progMode) `shouldBe` "EditMenu"
+
+editPlayerSpec :: Spec
+editPlayerSpec = describe "editPlayer" $
+  it "should change the mode appropriately" $ let
+    s = editPlayer newProgState
+    in show (s^.progMode) `shouldBe` "EditPlayer"
+
+editSelectedPlayerSpec :: Spec
+editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
+  (\(label, pState, expected) -> context label $
+    it "should edit the players appropriately" $ let
+      pState'  = editSelectedPlayer (pName .~ "foo") pState
+      players' = pState'^.database.dbPlayers
+      in players' `shouldBe` expected)
+
+  --  label,           initial state,         expected
+  [ ( "wrong mode",    baseState,             players  )
+  , ( "not selected",  changePlayer Nothing,  players  )
+  , ( "player 0",      changePlayer $ Just 0, changed0 )
+  , ( "player 1",      changePlayer $ Just 1, changed1 )
+  , ( "out of bounds", changePlayer $ Just 2, players  )
+  ]
+
+  where
+    baseState      = newProgState & database.dbPlayers .~ players
+    changePlayer n = baseState
+      & (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
+    players        = [ player 0,  player 1  ]
+    changed0       = [ player' 0, player 1  ]
+    changed1       = [ player 0,  player' 1 ]
+    player n       = newPlayer n ("Player " ++ show n) "pos"
+    player' n      = newPlayer n "foo" "pos"
+
+editGoalieSpec :: Spec
+editGoalieSpec = describe "editGoalie" $
+  it "should change the mode appropriately" $ let
+    s = editGoalie newProgState
+    in show (s^.progMode) `shouldBe` "EditGoalie"
+
+editSelectedGoalieSpec :: Spec
+editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
+  (\(label, pState, expected) -> context label $
+    it "should edit the goalies appropriately" $ let
+      pState'  = editSelectedGoalie (gName .~ "foo") pState
+      goalies' = pState'^.database.dbGoalies
+      in goalies' `shouldBe` expected)
+
+  --  label,           initial state,         expected
+  [ ( "wrong mode",    baseState,             goalies  )
+  , ( "not selected",  changeGoalie Nothing,  goalies  )
+  , ( "goalie 0",      changeGoalie $ Just 0, changed0 )
+  , ( "goalie 1",      changeGoalie $ Just 1, changed1 )
+  , ( "out of bounds", changeGoalie $ Just 2, goalies  )
+  ]
+
+  where
+    baseState      = newProgState & database.dbGoalies .~ goalies
+    changeGoalie n = baseState
+      & (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
+    goalies        = [ goalie 0,  goalie 1  ]
+    changed0       = [ goalie' 0, goalie 1  ]
+    changed1       = [ goalie 0,  goalie' 1 ]
+    goalie n       = newGoalie n ("Player " ++ show n)
+    goalie' n      = newGoalie n "foo"
+
+addPlayerSpec :: Spec
+addPlayerSpec = describe "addPlayer" $ mapM_
+  (\(label, expectation, pm, players) -> context label $
+    it expectation $ let
+      ps = newProgState
+        & progMode           .~ pm
+        & database.dbPlayers .~ [joe]
+      ps' = addPlayer ps
+      in ps'^.database.dbPlayers `shouldBe` players)
+
+  --  label,                 expectation, progMode,  players
+  [ ( "wrong mode",          failure,     MainMenu,  [joe]          )
+  , ( "missing number",      failure,     noNum,     [joe]          )
+  , ( "missing rookie flag", failure,     noRookie,  [joe]          )
+  , ( "missing active flag", failure,     noActive,  [joe]          )
+  , ( "rookie",              success,     mkRookie,  [joe, rookie]  )
+  , ( "retired",             success,     mkRetired, [joe, retired] )
+  , ( "normal player",       success,     mkNormal,  [joe, normal]  )
+  ]
+
+  where
+    failure   = "should not create the player"
+    success   = "should create the player"
+    noNum     = mkpm Nothing  (Just False) (Just True)
+    noRookie  = mkpm (Just 3) Nothing      (Just True)
+    noActive  = mkpm (Just 3) (Just False) Nothing
+    mkRookie  = mkpm (Just 3) (Just True)  (Just True)
+    mkRetired = mkpm (Just 3) (Just False) (Just False)
+    mkNormal  = mkpm (Just 3) (Just False) (Just True)
+    joe       = newPlayer 2 "Joe" "centre"
+    rookie    = player True  True
+    retired   = player False False
+    normal    = player False True
+
+    player r a = newPlayer 3 "Bob" "defense"
+      & pRookie .~ r
+      & pActive .~ a
+
+    mkpm n r a = CreatePlayer $ newCreatePlayerState
+      & cpsNumber     .~ n
       & cpsName       .~ "Bob"
       & cpsPosition   .~ "defense"
-      in s'^.database.dbPlayers `shouldBe` [p1, p2]
+      & cpsRookieFlag .~ r
+      & cpsActiveFlag .~ a
 
-  context "data unavailable" $
+addGoalieSpec :: Spec
-    it "should not create the player" $ let
+addGoalieSpec = describe "addGoalie" $ mapM_
-      s' = addPlayer $ s MainMenu
+  (\(label, expectation, pm, goalies) -> context label $
-      in s'^.database.dbPlayers `shouldBe` [p1]
+    it expectation $ let
+      ps = newProgState
+        & progMode           .~ pm
+        & database.dbGoalies .~ [joe]
+      ps' = addGoalie ps
+      in ps'^.database.dbGoalies `shouldBe` goalies)
 
-recordGoalAssistsSpec :: Spec
+  --  label,            expectation, progMode,  expected goalies
-recordGoalAssistsSpec = describe "recordGoalAssists" $ do
+  [ ( "wrong mode",     failure,     MainMenu,  [joe]            )
-  let
+  , ( "no number",      failure,     noNum,     [joe]            )
-    joe   = newPlayer 1 "Joe"   "centre"
+  , ( "no rookie flag", failure,     noRookie,  [joe]            )
-    bob   = newPlayer 2 "Bob"   "defense"
+  , ( "no active flag", failure,     noActive,  [joe]            )
-    steve = newPlayer 3 "Steve" "forward"
+  , ( "rookie",         success,     mkRookie,  [joe, rookie]    )
-    dave  = newPlayer 4 "Dave"  "somewhere"
+  , ( "retired",        success,     mkRetired, [joe, retired]   )
-    frank = newPlayer 5 "Frank" "elsewhere"
+  , ( "normal goalie",  success,     mkNormal,  [joe, normal]    )
-    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" $
+  where
-    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
+    failure   = "should not create the goalie"
+    success   = "should create the goalie"
+    noNum     = cgs Nothing  (Just False) (Just True)
+    noRookie  = cgs (Just 3) Nothing      (Just True)
+    noActive  = cgs (Just 3) (Just False) Nothing
+    mkRookie  = cgs (Just 3) (Just True)  (Just True)
+    mkRetired = cgs (Just 3) (Just False) (Just False)
+    mkNormal  = cgs (Just 3) (Just False) (Just True)
+    joe       = newGoalie 2 "Joe"
+    rookie    = goalie True  True
+    retired   = goalie False False
+    normal    = goalie False True
 
-  it "should clear the assistsBy list" $
+    goalie r a = newGoalie 3 "Bob"
-    ps^.progMode.gameStateL.assistsBy `shouldBe` []
+      & gRookie .~ r
+      & gActive .~ a
 
-  it "should increment the pointsAccounted counter" $
+    cgs n r a = CreateGoalie $ newCreateGoalieState
-    ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
+      & cgsNumber     .~ n
+      & cgsName       .~ "Bob"
+      & cgsRookieFlag .~ r
+      & cgsActiveFlag .~ a
 
-  it "should clear the confirmGoalDataFlag" $
+resetCreatePlayerStateSpec :: Spec
-    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
+resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
+  cps = newCreatePlayerState
+    & cpsNumber   ?~ 1
+    & cpsName     .~ "Joe"
+    & cpsPosition .~ "centre"
+  ps  = resetCreatePlayerState $
+    newProgState & progMode.createPlayerStateL .~ cps
+  in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
 
-awardGoalSpec :: Spec
+resetCreateGoalieStateSpec :: Spec
-awardGoalSpec = describe "awardGoal" $ do
+resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
-  let
+  cgs = newCreateGoalieState
-    joe
+    & cgsNumber ?~ 1
-      = newPlayer 2 "Joe" "centre"
+    & cgsName   .~ "Joe"
-      & pYtd.psGoals      .~ 1
+  ps = resetCreateGoalieState $
-      & pLifetime.psGoals .~ 2
+    newProgState & progMode.createGoalieStateL .~ cgs
-    bob
+  in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
-      = newPlayer 3 "Bob" "defense"
-      & pYtd.psGoals      .~ 3
-      & pLifetime.psGoals .~ 4
-    db
-      = newDatabase
-      & dbPlayers .~ [joe, bob]
-    joeStats
-      = newPlayerStats
-      & psGoals .~ 1
-    ps
-      = newProgState
-      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
-      & database .~ db
-
-  mapM_
-    (\(pName, pid, ytd, lt, game) ->
-      context pName $ do
-        let
-          ps'    = awardGoal pid ps
-          player = (ps'^.database.dbPlayers) !! pid
-          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
-
-        it ("should increment " ++ pName ++ "'s year-to-date goals") $
-          player^.pYtd.psGoals `shouldBe` ytd
-
-        it ("should increment " ++ pName ++ "'s lifetime goals") $
-          player^.pLifetime.psGoals `shouldBe` lt
-
-        it ("should increment " ++ pName ++ "'s game goals") $
-          gStats^.psGoals `shouldBe` game)
-    --  player name, player id, ytd goals, lifetime goals, game goals
-    [ ( "Joe",       0,         2,         3,              2          )
-    , ( "Bob",       1,         4,         5,              1          )
-    ]
-
-  context "invalid index" $ let
-    ps' = awardGoal 2 ps
-    in it "should not change the database" $
-      ps'^.database `shouldBe` db
-
-  context "negative index" $ let
-    ps' = awardGoal (-1) ps
-    in it "should not change the database" $
-      ps'^.database `shouldBe` db
-
-awardAssistSpec :: Spec
-awardAssistSpec = describe "awardAssist" $ do
-  let
-    joe
-      = newPlayer 1 "Joe" "centre"
-      & pYtd.psAssists      .~ 1
-      & pLifetime.psAssists .~ 2
-    bob
-      = newPlayer 2 "Bob" "defense"
-      & pYtd.psAssists      .~ 3
-      & pLifetime.psAssists .~ 4
-    joeStats
-      = newPlayerStats
-      & psAssists .~ 1
-    ps
-      = newProgState
-      & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
-      & database.dbPlayers .~ [joe, bob]
-
-  mapM_
-    (\(pName, pid, ytd, lt, game) ->
-      context pName $ do
-        let
-          ps' = awardAssist pid ps
-          player = (ps'^.database.dbPlayers) !! pid
-          gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
-
-        it ("should increment " ++ pName ++ "'s year-to-date assists") $
-          player^.pYtd.psAssists `shouldBe` ytd
-
-        it ("should increment " ++ pName ++ "'s lifetime assists") $
-          player^.pLifetime.psAssists `shouldBe` lt
-
-        it ("should increment " ++ pName ++ "'s game assists") $
-          gStats^.psAssists `shouldBe` game)
-    --  player name, player id, ytd assists, lifetime assists, game assists
-    [ ( "Joe",       0,         2,           3,                2            )
-    , ( "Bob",       1,         4,           5,                1            )
-    ]
-
-  context "invalid index" $ let
-    ps' = awardAssist (-1) ps
-    in it "should not change anything" $
-      ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
-
-resetGoalDataSpec :: Spec
-resetGoalDataSpec = describe "resetGoalData" $ do
-  players <- runIO $ replicateM 5 makePlayer
-  let
-    gs
-      = newGameState
-      & goalBy              ?~ 1
-      & assistsBy           .~ [2, 3]
-      & confirmGoalDataFlag .~ True
-    ps
-      = newProgState
-      & database.dbPlayers  .~ players
-      & progMode.gameStateL .~ gs
-      & resetGoalData
-
-  it "should clear the goalBy value" $
-    ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
-
-  it "should clear the assists by list" $
-    ps^.progMode.gameStateL.assistsBy `shouldBe` []
-
-  it "should clear confirmGoalDataFlag" $
-    ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
-
-assignPMinsSpec :: Spec
-assignPMinsSpec = describe "assignPMins" $ let
-
-  bob = newPlayer 2 "Bob" "centre"
-    & pYtd.psPMin      .~ 3
-    & pLifetime.psPMin .~ 4
-
-  joe = newPlayer 3 "Joe" "defense"
-    & pYtd.psPMin      .~ 5
-    & pLifetime.psPMin .~ 6
-
-  ps pid = newProgState
-    & database.dbPlayers .~ [bob, joe]
-    & progMode.gameStateL
-      %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
-      .  (selectedPlayer  .~ pid)
-
-  in mapM_
-    (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
-      context ("selectedPlayer = " ++ show pid) $ do
-        let ps' = assignPMins 2 $ ps pid
-
-        mapM_
-          (\(name, pid', lt, ytd, game) -> context name $ do
-            let
-              player = fromJust $ nth pid' $ ps'^.database.dbPlayers
-              gStats = ps'^.progMode.gameStateL.gamePlayerStats
-              pStats = M.findWithDefault newPlayerStats pid' gStats
-
-            context "lifetime penalty minutes" $
-              it ("should be " ++ show lt) $
-                player^.pLifetime.psPMin `shouldBe` lt
-
-            context "year-to-date penalty minutes" $
-              it ("should be " ++ show ytd) $
-                player^.pYtd.psPMin `shouldBe` ytd
-
-            context "game penalty minutes" $
-              it ("should be " ++ show game) $
-                pStats^.psPMin `shouldBe` game)
-
-          --  name,  index, lifetime, ytd,    game
-          [ ( "Bob", 0,     bobLt,    bobYtd, bobGame )
-          , ( "Joe", 1,     joeLt,    joeYtd, joeGame )
-          ]
-
-        it "should set selectedPlayer to Nothing" $
-          ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing)
-
-    --  index,   bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
-    [ ( Just 0,  6,      5,       4,        6,      5,       0        )
-    , ( Just 1,  4,      3,       2,        8,      7,       2        )
-    , ( Just 2,  4,      3,       2,        6,      5,       0        )
-    , ( Nothing, 4,      3,       2,        6,      5,       0        )
-    ]
-
-makePlayer :: IO Player
-makePlayer = Player
-  <$> makeNum
-  <*> makeName
-  <*> makeName
-  <*> makePlayerStats
-  <*> makePlayerStats
-
-makeGoalie :: IO Goalie
-makeGoalie = Goalie
-  <$> makeNum
-  <*> makeName
-  <*> makeGoalieStats
-  <*> makeGoalieStats
-
-makePlayerStats :: IO PlayerStats
-makePlayerStats = PlayerStats
-  <$> makeNum
-  <*> makeNum
-  <*> makeNum
-
-makeGoalieStats :: IO GoalieStats
-makeGoalieStats = GoalieStats
-  <$> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-  <*> makeNum
-
-makeNum :: IO Int
-makeNum = randomRIO (1, 10)
-
-makeName :: IO String
-makeName = replicateM 10 $ randomRIO ('A', 'Z')
 
 backHomeSpec :: Spec
 backHomeSpec = describe "backHome" $ do
   let
     input = newProgState
       & progMode.gameStateL .~ newGameState
-      & inputBuffer         .~ "foo"
+      & editorW             .~ mkEditor "foo"
-      & scrollOffset        .~ 123
     result = backHome input
 
   it "should set the program mode back to MainMenu" $
@@ -670,33 +408,4 @@ backHomeSpec = describe "backHome" $ do
       _        -> False
 
   it "should clear the input buffer" $
-    result^.inputBuffer `shouldBe` ""
+    result^.editorW.to userText `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/FormatSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,9 +21,11 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module FormatSpec (spec) where
 
+import Data.Ratio ((%))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Format
+import Mtlstats.Types
 
 spec :: Spec
 spec = describe "Mtlstats.Format" $ do
@@ -31,8 +33,15 @@ spec = describe "Mtlstats.Format" $ do
   leftSpec
   rightSpec
   centreSpec
+  padRightSpec
   overlaySpec
   monthSpec
+  labelTableSpec
+  numTableSpec
+  tableWithSpec
+  complexTableSpec
+  overlayLastSpec
+  showFloatingSpec
 
 padNumSpec :: Spec
 padNumSpec = describe "padNum" $ do
@@ -90,6 +99,16 @@ centreSpec = describe "centre" $ do
     it "should truncate the text" $
       centre 2 "foo" `shouldBe` "fo"
 
+padRightSpec :: Spec
+padRightSpec = describe "padRight" $ mapM_
+  (\(label, width, str, expected) -> context label $
+    it ("should be " ++ show expected) $
+      padRight width str `shouldBe` expected)
+  --  label,          width, input string, expected
+  [ ( "text shorter", 5,     "foo",        "foo  "  )
+  , ( "text longer",  3,     "foobar",     "foobar" )
+  ]
+
 overlaySpec :: Spec
 overlaySpec = describe "overlay" $ do
 
@@ -111,3 +130,120 @@ monthSpec = describe "month" $ do
   context "invalid" $
     it "should return an empty string" $
       month 0 `shouldBe` ""
+
+labelTableSpec :: Spec
+labelTableSpec = describe "labelTable" $
+  it "should format the table" $ let
+    input =
+      [ ( "foo",    "bar"  )
+      , ( "baz",    "quux" )
+      , ( "longer", "x"    )
+      ]
+
+    expected =
+      [ "   foo: bar "
+      , "   baz: quux"
+      , "longer: x   "
+      ]
+
+    in labelTable input `shouldBe` expected
+
+numTableSpec :: Spec
+numTableSpec = describe "numTable" $
+  it "should format the table" $ let
+    headers = ["foo", "bar", "baz"]
+
+    rows =
+      [ ( "quux",  [ 1, 2,  3   ] )
+      , ( "xyzzy", [ 9, 99, 999 ] )
+      ]
+
+    expected =
+      [ "      foo bar baz"
+      , " quux   1   2   3"
+      , "xyzzy   9  99 999"
+      ]
+
+    in numTable headers rows `shouldBe` expected
+
+tableWithSpec :: Spec
+tableWithSpec = describe "tableWith" $ let
+  vals =
+    [ [ "foo",  "bar",   "baz" ]
+    , [ "quux", "xyzzy", "x"   ]
+    ]
+
+  in mapM_
+    (\(label, func, expected) -> context label $
+      it "should format the table" $
+        tableWith func vals `shouldBe` expected)
+    [ ( "align left"
+      , left
+      , [ "foo  bar   baz"
+        , "quux xyzzy x  "
+        ]
+      )
+    , ( "align right"
+      , right
+      , [ " foo   bar baz"
+        , "quux xyzzy   x"
+        ]
+      )
+    ]
+
+complexTableSpec :: Spec
+complexTableSpec = describe "complexTable" $ mapM_
+  (\(label, pFuncs, cells, expected) -> context label $
+    it "should format correctly" $
+      complexTable pFuncs cells `shouldBe` expected)
+  [ ( "no fill"
+    , [left, right]
+    , [ [ CellText "foo",  CellText "bar"  ]
+      , [ CellText "baaz", CellText "quux" ]
+      ]
+    , [ "foo   bar"
+      , "baaz quux"
+      ]
+    )
+  , ( "with fill"
+    , [left, left, left]
+    , [ [ CellText "foo",  CellText "bar", CellText "baz" ]
+      , [ CellText "quux", CellFill '-',   CellFill '@'   ]
+      ]
+    , [ "foo  bar baz"
+      , "quux ----@@@"
+      ]
+    )
+  ]
+
+overlayLastSpec :: Spec
+overlayLastSpec = describe "overlayLast" $ let
+  text = "foo"
+
+  sample =
+    [ "line 1"
+    , "line 2"
+    ]
+
+  edited =
+    [ "line 1"
+    , "fooe 2"
+    ]
+
+  in mapM_
+    (\(label, input, expected) -> context label $
+      it ("should be " ++ show expected) $
+        overlayLast text input `shouldBe` expected)
+
+    --  label,            input,  expected
+    [ ( "empty list",     [],     []       )
+    , ( "non-empty list", sample, edited   )
+    ]
+
+showFloatingSpec :: Spec
+showFloatingSpec = describe "showFloating" $ let
+  input = 3 % 2 :: Rational
+  expected = "1.50"
+
+  in it ("should be " ++ expected) $
+    showFloating input `shouldBe` expected

test/HandlersSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -22,7 +22,9 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module HandlersSpec (spec) where
 
 import Test.Hspec (Spec, context, describe, it, shouldBe)
-import qualified UI.NCurses as C
+
+import Brick.Types (BrickEvent (VtyEvent))
+import Graphics.Vty.Input.Events (Event (EvKey, EvResize), Key (KChar))
 
 import Mtlstats.Handlers
 
@@ -37,10 +39,18 @@ ynHandlerSpec = describe "ynHandler" $ mapM_
       it ("should be " ++ show expected) $
         ynHandler event `shouldBe` expected)
   --  description,   event,                expected
-  [ ( "Y pressed",   C.EventCharacter 'Y', Just True  )
+  [ ( "Y pressed",   capitalY,   Just True  )
-  , ( "y pressed",   C.EventCharacter 'y', Just True  )
+  , ( "y pressed",   lowerY,     Just True  )
-  , ( "N pressed",   C.EventCharacter 'N', Just False )
+  , ( "N pressed",   capitalN,   Just False )
-  , ( "n pressed",   C.EventCharacter 'n', Just False )
+  , ( "n pressed",   lowerN,     Just False )
-  , ( "x pressed",   C.EventCharacter 'x', Nothing    )
+  , ( "x pressed",   lowerX,     Nothing    )
-  , ( "other event", C.EventResized,       Nothing    )
+  , ( "other event", otherEvent, Nothing    )
   ]
+  where
+    capitalY   = chE 'Y'
+    lowerY     = chE 'y'
+    capitalN   = chE 'N'
+    lowerN     = chE 'n'
+    lowerX     = chE 'x'
+    otherEvent = VtyEvent $ EvResize 0 0
+    chE c      = VtyEvent $ EvKey (KChar c) []

test/Helpers/GoalieSpec.hs

@@ -0,0 +1,91 @@
+{-
+
+mtlstats
+Copyright (C) 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 Helpers.GoalieSpec (spec) where
+
+import Lens.Micro ((&), (.~), (%~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Helpers.Goalie
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Goalie" $ do
+  goalieDetailsSpec
+  goalieNameSpec
+
+goalieDetailsSpec :: Spec
+goalieDetailsSpec = describe "goalieDetails" $ let
+  input = newGoalie 1 "Joe"
+    & gRookie .~ True
+    & gYtd
+      %~ ( gsGames        .~ 2  )
+      .  ( gsMinsPlayed   .~ 3  )
+      .  ( gsGoalsAllowed .~ 4  )
+      .  ( gsShutouts     .~ 5  )
+      .  ( gsWins         .~ 6  )
+      .  ( gsLosses       .~ 7  )
+      .  ( gsTies         .~ 8  )
+    & gLifetime
+      %~ ( gsGames        .~ 9  )
+      .  ( gsMinsPlayed   .~ 10 )
+      .  ( gsGoalsAllowed .~ 11 )
+      .  ( gsShutouts     .~ 12 )
+      .  ( gsWins         .~ 13 )
+      .  ( gsLosses       .~ 14 )
+      .  ( gsTies         .~ 15 )
+
+  expected = unlines
+    [ "Number: 1   "
+    , "  Name: Joe*"
+    , ""
+    , "              YTD Lifetime"
+    , " Games played   2        9"
+    , "  Mins played   3       10"
+    , "Goals allowed   4       11"
+    , "     Shutouts   5       12"
+    , "         Wins   6       13"
+    , "       Losses   7       14"
+    , "         Ties   8       15"
+    ]
+
+  in it "should format the output correctly" $
+    goalieDetails input `shouldBe` expected
+
+goalieNameSpec :: Spec
+goalieNameSpec = describe "goalieName" $ mapM_
+  (\(label, g, expected) -> context label $
+    it ("should be " ++ expected) $
+      goalieName g `shouldBe` expected)
+
+  --  label,        goalie,  expected
+  [ ( "rookie",     rookie,  "foo*"   )
+  , ( "non-rookie", active,  "foo"    )
+  , ( "retired",    retired, "*foo"   )
+  ]
+
+  where
+    rookie     = goalie True True
+    active     = goalie False True
+    retired    = goalie False False
+    goalie r a = newGoalie 1 "foo"
+      & gRookie .~ r
+      & gActive .~ a

test/Helpers/PlayerSpec.hs

@@ -0,0 +1,83 @@
+{-
+
+mtlstats
+Copyright (C) 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 Helpers.PlayerSpec (spec) where
+
+import Lens.Micro ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Helpers.Player
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Player" $ do
+  playerDetailsSpec
+  playerNameSpec
+
+playerDetailsSpec :: Spec
+playerDetailsSpec = describe "playerDetails" $
+  it "should give a detailed description" $ let
+
+    p = newPlayer 1 "Joe" "centre"
+      & pRookie .~ True
+      & pYtd .~ PlayerStats
+        { _psGoals   = 2
+        , _psAssists = 3
+        , _psPMin    = 4
+        }
+      & pLifetime .~ PlayerStats
+        { _psGoals   = 5
+        , _psAssists = 6
+        , _psPMin    = 7
+        }
+
+    expected = unlines
+      [ "  Number: 1     "
+      , "    Name: Joe*  "
+      , "Position: centre"
+      , ""
+      , "             YTD Lifetime"
+      , "       Goals   2        5"
+      , "     Assists   3        6"
+      , "Penalty mins   4        7"
+      ]
+
+    in playerDetails p `shouldBe` expected
+
+playerNameSpec :: Spec
+playerNameSpec = describe "playerName" $ mapM_
+  (\(label, p, expected) -> context label $
+    it ("should be " ++ expected) $
+      playerName p `shouldBe` expected)
+
+  --  label,        player,    expected
+  [ ( "rookie",     rookie,    "foo*"   )
+  , ( "non-rookie", nonRookie, "foo"    )
+  , ( "retired",    retired,   "*foo"  )
+  ]
+
+  where
+    rookie    = player True True
+    nonRookie = player False True
+    retired   = player False False
+    player r a = newPlayer 1 "foo" "centre"
+      & pRookie .~ r
+      & pActive .~ a

test/Helpers/PositionSpec.hs

@@ -0,0 +1,79 @@
+{-
+
+mtlstats
+Copyright (C) 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 Helpers.PositionSpec (spec) where
+
+import Lens.Micro ((&), (.~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Helpers.Position
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Position" $ do
+  posSearchSpec
+  posSearchExactSpec
+  getPositionsSpec
+
+posSearchSpec :: Spec
+posSearchSpec = describe "posSearch" $ mapM_
+  (\(sStr, expected) -> context ("search string: " ++ show sStr) $
+    it ("should be " ++ show expected) $
+      posSearch sStr db `shouldBe` expected)
+  [ ( "fOo"
+    , [ ( 2, "foo" )
+      ]
+    )
+  , ( "A"
+    , [ ( 0, "bar" )
+      , ( 1, "baz" )
+      ]
+    )
+  ]
+
+posSearchExactSpec :: Spec
+posSearchExactSpec = describe "posSearchExact" $ mapM_
+  (\(input, expected) -> context ("input: " ++ show input) $
+    it ("should be " ++ show expected) $
+      posSearchExact input db `shouldBe` expected)
+
+  --  input,  expected
+  [ ( "foo",  Just 2   )
+  , ( "FOO",  Nothing  )
+  , ( "bar",  Just 0   )
+  , ( "baz",  Just 1   )
+  , ( "a",    Nothing  )
+  , ( "quux", Nothing  )
+  ]
+
+getPositionsSpec :: Spec
+getPositionsSpec = describe "getPositions" $ let
+  expected = ["bar", "baz", "foo"]
+  in it ("should be " ++ show expected) $
+    getPositions db `shouldBe` expected
+
+db :: Database
+db = newDatabase & dbPlayers .~
+  [ newPlayer 2 "Joe"  "foo"
+  , newPlayer 3 "Bob"  "bar"
+  , newPlayer 5 "Bill" "foo"
+  , newPlayer 8 "Ed"   "baz"
+  ]

test/HelpersSpec.hs

@@ -0,0 +1,34 @@
+{-
+
+mtlstats
+Copyright (C) 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 HelpersSpec (spec) where
+
+import Test.Hspec (Spec, describe)
+
+import qualified Helpers.GoalieSpec as Goalie
+import qualified Helpers.PlayerSpec as Player
+import qualified Helpers.PositionSpec as Position
+
+spec :: Spec
+spec = describe "Helper" $ do
+  Player.spec
+  Goalie.spec
+  Position.spec

test/ReportSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,16 +21,15 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module ReportSpec (spec) where
 
-import Lens.Micro ((&), (?~), (%~))
+import Lens.Micro ((&), (?~))
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Report
 import Mtlstats.Types
 
 spec :: Spec
-spec = describe "Mtlstats.Report" $ do
+spec = describe "Mtlstats.Report"
   gameDateSpec
-  playerNameColWidthSpec
 
 gameDateSpec :: Spec
 gameDateSpec = describe "gameDate" $ do
@@ -46,20 +45,3 @@ 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/Spec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
 import qualified ActionsSpec as Actions
 import qualified FormatSpec as Format
 import qualified HandlersSpec as Handlers
+import qualified HelpersSpec as Helpers
 import qualified ReportSpec as Report
 import qualified TypesSpec as Types
 import qualified UtilSpec as Util
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
 main :: IO ()
 main = hspec $ do
   Types.spec
+  Helpers.spec
   Actions.spec
   Format.spec
   Handlers.spec

test/SpecHelpers.hs

@@ -0,0 +1,29 @@
+{-
+
+mtlstats
+Copyright (C) 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 SpecHelpers where
+
+import Brick.Widgets.Edit (Editor, editContentsL, editor)
+import Data.Text.Zipper (gotoEOL)
+import Lens.Micro ((&), (%~))
+
+mkEditor :: String -> Editor String ()
+mkEditor str = editor () (Just 1) str & editContentsL %~ gotoEOL

test/Types/MenuSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -37,11 +37,11 @@ showSpec :: Spec
 showSpec = describe "show" $
   it "should display correctly" $ let
     menu = Menu "Foo" ()
-      [ MenuItem '1' "Item 1" $ return ()
+      [ MenuItem '1' "foo" $ return ()
-      , MenuItem '2' "Item 2" $ return ()
+      , MenuItem '2' "bar baz" $ return ()
       ]
     expected =
-      "Foo\n\
+      "Foo\n\n\
-      \1) Item 1\n\
+      \1: foo    \n\
-      \2) Item 2\n"
+      \2: bar baz\n"
     in show menu `shouldBe` expected

test/TypesSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,15 +19,25 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
 
-module TypesSpec (spec) where
+module TypesSpec
+  ( Comparable (..)
+  , spec
+  , makePlayer
+  , makeGoalie
+  , makePlayerStats
+  , makeGoalieStats
+  ) where
 
+import Control.Monad (replicateM)
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
-import Data.ByteString.Lazy (ByteString)
+import qualified Data.Map.Lazy as M
-import qualified Data.HashMap.Strict as HM
+import Data.Ratio ((%))
+import qualified GHC.Exts as HM
 import Lens.Micro (Lens', (&), (^.), (.~), (?~))
+import System.Random (randomIO, randomRIO)
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Config
@@ -35,6 +45,9 @@ import Mtlstats.Types
 
 import qualified Types.MenuSpec as Menu
 
+class Comparable a where
+  compareTest :: a -> a -> Spec
+
 spec :: Spec
 spec = describe "Mtlstats.Types" $ do
   playerSpec
@@ -43,6 +56,11 @@ spec = describe "Mtlstats.Types" $ do
   databaseSpec
   gameStateLSpec
   createPlayerStateLSpec
+  createGoalieStateLSpec
+  editPlayerStateLSpec
+  editGoalieStateLSpec
+  editStandingsModeLSpec
+  esmSubModeLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -55,12 +73,20 @@ spec = describe "Mtlstats.Types" $ do
   gmsPointsSpec
   addGameStatsSpec
   playerSearchSpec
+  activePlayerSearchSpec
   playerSearchExactSpec
   modifyPlayerSpec
   playerSummarySpec
   playerIsActiveSpec
   psPointsSpec
   addPlayerStatsSpec
+  goalieSearchSpec
+  activeGoalieSearchSpec
+  goalieSearchExactSpec
+  goalieSummarySpec
+  goalieIsActiveSpec
+  addGoalieStatsSpec
+  gsAverageSpec
   Menu.spec
 
 playerSpec :: Spec
@@ -79,43 +105,137 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
 gameStateLSpec :: Spec
 gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   -- getters
-  [ ( MainMenu,              newGameState )
+  [ ( "missing state", MainMenu,              newGameState )
-  , ( NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "home game",     NewGame $ gs HomeGame, gs HomeGame  )
+  , ( "away game",     NewGame $ gs AwayGame, gs AwayGame  )
   ]
   -- setters
-  [ ( MainMenu,              gs HomeGame  )
+  [ ( "set home",     MainMenu,              gs HomeGame  )
-  , ( NewGame $ gs HomeGame, gs AwayGame  )
+  , ( "home to away", NewGame $ gs HomeGame, gs AwayGame  )
-  , ( NewGame $ gs HomeGame, newGameState )
+  , ( "away to home", NewGame $ gs AwayGame, gs HomeGame  )
+  , ( "clear home",   NewGame $ gs HomeGame, newGameState )
+  , ( "clear away",   NewGame $ gs AwayGame, newGameState )
   ]
   where gs t = newGameState & gameType ?~ t
 
 createPlayerStateLSpec :: Spec
-createPlayerStateLSpec = describe "createPlayerStateL" $ do
+createPlayerStateLSpec = describe "createPlayerStateL" $
-  context "getters" $ do
+  lensSpec createPlayerStateL
-    context "state missing" $ let
+  -- getters
-      pm  = MainMenu
+  [ ( "missing state", MainMenu,          newCreatePlayerState )
-      cps = pm^.createPlayerStateL
+  , ( "with state",    CreatePlayer cps1, cps1                 )
-      in it "should not have a number" $
+  ]
-        cps^.cpsNumber `shouldBe` Nothing
+  -- setters
+  [ ( "missing state", MainMenu,          cps1                 )
+  , ( "change state",  CreatePlayer cps1, cps2                 )
+  , ( "clear state",   CreatePlayer cps1, newCreatePlayerState )
+  ]
+  where
+    cps1 = newCreatePlayerState
+      & cpsNumber    ?~ 1
+      & cpsName      .~ "Joe"
+      & cpsPosition  .~ "centre"
+    cps2 = newCreatePlayerState
+      & cpsNumber   ?~ 2
+      & cpsName     .~ "Bob"
+      & cpsPosition .~ "defense"
 
-    context "existing state" $ let
+createGoalieStateLSpec :: Spec
-      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+createGoalieStateLSpec = describe "createGoalieStateL" $
-      cps = pm^.createPlayerStateL
+  lensSpec createGoalieStateL
-      in it "should have a number of 1" $
+  -- getters
-        cps^.cpsNumber `shouldBe` Just 1
+  [ ( "missing state", MainMenu,          newCreateGoalieState )
+  , ( "with state",    CreateGoalie cgs1, cgs1                 )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,          cgs1                 )
+  , ( "change state", CreateGoalie cgs1, cgs2                 )
+  , ( "clear state",  CreateGoalie cgs1, newCreateGoalieState )
+  ]
+  where
+    cgs1 = newCreateGoalieState
+      & cgsNumber    ?~ 1
+      & cgsName      .~ "Joe"
+    cgs2 = newCreateGoalieState
+      & cgsNumber ?~ 2
+      & cgsName   .~ "Bob"
 
-  context "setters" $ do
+editPlayerStateLSpec :: Spec
-    context "state missing" $ let
+editPlayerStateLSpec = describe "editPlayerStateL" $
-      pm  = MainMenu
+  lensSpec editPlayerStateL
-      pm' = pm & createPlayerStateL.cpsNumber ?~ 1
+  -- getters
-      in it "should set the player number to 1" $
+  [ ( "missing state", MainMenu,        newEditPlayerState )
-        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
+  , ( "withState",     EditPlayer eps1, eps1               )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,        eps1               )
+  , ( "change state", EditPlayer eps1, eps2               )
+  , ( "clear state",  EditPlayer eps1, newEditPlayerState )
+  ]
+  where
+    eps1 = newEditPlayerState
+      & epsSelectedPlayer ?~ 1
+    eps2 = newEditPlayerState
+      & epsSelectedPlayer ?~ 2
 
-    context "existing state" $ let
+editGoalieStateLSpec :: Spec
-      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+editGoalieStateLSpec = describe "editGoalieStateL" $
-      pm' = pm & createPlayerStateL.cpsNumber ?~ 2
+  lensSpec editGoalieStateL
-      in it "should set the player number to 2" $
+  -- getters
-        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
+  [ ( "missing state", MainMenu,        newEditGoalieState )
+  , ( "with state",    EditGoalie egs1, egs1               )
+  ]
+  -- setters
+  [ ( "set state",    MainMenu,        egs1               )
+  , ( "change state", EditGoalie egs1, egs2               )
+  , ( "clear state",  EditGoalie egs1, newEditGoalieState )
+  ]
+  where
+    egs1 = newEditGoalieState
+      & egsSelectedGoalie ?~ 1
+    egs2 = newEditGoalieState
+      & egsSelectedGoalie ?~ 2
+
+editStandingsModeLSpec :: Spec
+editStandingsModeLSpec = describe "editStandingsModeL" $
+  lensSpec editStandingsModeL
+  -- getters
+  [ ( "missing mode", MainMenu,           menu )
+  , ( "with mode",    EditStandings home, home )
+  ]
+  -- setters
+  [ ( "set mode",    MainMenu,           home )
+  , ( "change mode", EditStandings home, away )
+  ]
+  where
+    menu = ESMMenu
+    home = ESMHome ESMSubMenu
+    away = ESMAway ESMSubMenu
+
+esmSubModeLSpec :: Spec
+esmSubModeLSpec = describe "esmSubModeL" $ do
+
+  context "getters" $ mapM_
+    (\(label, mode, expected) -> context label $
+      it ("should be " ++ show expected) $
+        mode^.esmSubModeL `shouldBe` expected)
+
+    --  label,        mode,                expected
+    [ ( "no state",   ESMMenu,             ESMSubMenu  )
+    , ( "with state", ESMHome ESMEditWins, ESMEditWins )
+    ]
+
+  context "setters" $ mapM_
+    (\(label, mode, expected) -> context label $
+      it ("should be " ++ show expected) $ let
+        mode' = mode & esmSubModeL .~ ESMEditWins
+        in mode' `shouldBe` expected)
+
+    --  label,       mode,               expected
+    [ ( "no state",  ESMMenu,            ESMMenu             )
+    , ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
+    , ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
+    ]
 
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
@@ -177,27 +297,27 @@ jsonSpec x j = do
       decode (encode x) `shouldBe` Just x
 
 lensSpec
-  :: (Eq a, Show s, Show a)
+  :: Comparable a
   => Lens' s a
-  -> [(s, a)]
+  -> [(String, s, a)]
-  -> [(s, a)]
+  -> [(String, s, a)]
   -> Spec
-lensSpec l gs ss = do
+lensSpec lens getters setters = do
 
   context "getters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $
-      it ("should be " ++ show x) $
+      compareTest (s^.lens) x)
-        s ^. l `shouldBe` x)
+    getters
-    gs
 
   context "setters" $ mapM_
-    (\(s, x) -> context (show s) $
+    (\(label, s, x) -> context label $ let
-      it ("should set to " ++ show x) $
+      s' = s & lens .~ x
-        (s & l .~ x) ^. l `shouldBe` x)
+      in compareTest (s'^.lens) x)
-    ss
+    setters
 
 player :: Player
 player = newPlayer 1 "Joe" "centre"
+  & pRookie   .~ False
   & pYtd      .~ playerStats 1
   & pLifetime .~ playerStats 2
 
@@ -206,6 +326,8 @@ playerJSON = Object $ HM.fromList
   [ ( "number",   toJSON (1 :: Int)           )
   , ( "name",     toJSON ("Joe" :: String)    )
   , ( "position", toJSON ("centre" :: String) )
+  , ( "rookie",   toJSON False                )
+  , ( "active",   toJSON True                 )
   , ( "ytd",      playerStatsJSON 1           )
   , ( "lifetime", playerStatsJSON 2           )
   ]
@@ -225,6 +347,7 @@ playerStatsJSON n = Object $ HM.fromList
 
 goalie :: Goalie
 goalie = newGoalie 1 "Joe"
+  & gRookie   .~ False
   & gYtd      .~ goalieStats 1
   & gLifetime .~ goalieStats 2
 
@@ -232,6 +355,8 @@ goalieJSON :: Value
 goalieJSON = Object $ HM.fromList
   [ ( "number",   toJSON (1 :: Int)         )
   , ( "name",     toJSON ("Joe" :: String ) )
+  , ( "rookie",   toJSON False              )
+  , ( "active",   toJSON True               )
   , ( "ytd",      goalieStatsJSON 1         )
   , ( "lifetime", goalieStatsJSON 2         )
   ]
@@ -241,7 +366,7 @@ goalieStats n = newGoalieStats
   & gsGames        .~ n
   & gsMinsPlayed   .~ n + 1
   & gsGoalsAllowed .~ n + 2
-  & gsGoalsAgainst .~ n + 3
+  & gsShutouts     .~ n + 3
   & gsWins         .~ n + 4
   & gsLosses       .~ n + 5
   & gsTies         .~ n + 6
@@ -251,7 +376,7 @@ goalieStatsJSON n = Object $ HM.fromList
   [ ( "games",         toJSON n       )
   , ( "mins_played",   toJSON $ n + 1 )
   , ( "goals_allowed", toJSON $ n + 2 )
-  , ( "goals_against", toJSON $ n + 3 )
+  , ( "shutouts",      toJSON $ n + 3 )
   , ( "wins",          toJSON $ n + 4 )
   , ( "losses",        toJSON $ n + 5 )
   , ( "ties",          toJSON $ n + 6 )
@@ -518,12 +643,25 @@ playerSearchSpec = describe "playerSearch" $ mapM_
       ps = [joe, bob, steve]
       in playerSearch sStr ps `shouldBe` expected)
   --  search, result
-  [ ( "Joe",  [(0, joe)]             )
+  [ ( "joe",  [(0, joe)]             )
   , ( "o",    [(0, joe), (1, bob)]   )
   , ( "e",    [(0, joe), (2, steve)] )
   , ( "x",    []                     )
   ]
 
+activePlayerSearchSpec :: Spec
+activePlayerSearchSpec = describe "activePlayerSearch" $ mapM_
+  (\(sStr, expected) -> context sStr $
+    it ("should return " ++ show expected) $ let
+      ps = [joe, bob, steve & pActive .~ False]
+      in activePlayerSearch sStr ps `shouldBe` expected)
+  --  search, result
+  [ ( "joe",  [(0, joe)]           )
+  , ( "o",    [(0, joe), (1, bob)] )
+  , ( "e",    [(0, joe)]           )
+  , ( "x",    []                   )
+  ]
+
 playerSearchExactSpec :: Spec
 playerSearchExactSpec = describe "playerSearchExact" $ mapM_
   (\(sStr, expected) -> context sStr $
@@ -540,10 +678,10 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
 
 modifyPlayerSpec :: Spec
 modifyPlayerSpec = describe "modifyPlayer" $ mapM_
-  (\(pName, j, b, s) -> let
+  (\(name, j, b, s) -> let
     modifier = pLifetime.psGoals .~ 1
-    players = modifyPlayer modifier pName [joe, bob, steve]
+    players = modifyPlayer modifier name [joe, bob, steve]
-    in context ("modify " ++ pName) $ do
+    in context ("modify " ++ name) $ do
 
       context "Joe's lifetime goals" $
         it ("should be " ++ show j) $
@@ -571,21 +709,21 @@ playerSummarySpec = describe "playerSummary" $
 playerIsActiveSpec :: Spec
 playerIsActiveSpec = describe "playerIsActive" $ do
   let
-    pState = newPlayerStats
+    pStats = newPlayerStats
       & psGoals   .~ 10
       & psAssists .~ 11
       & psPMin    .~ 12
-    player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
+    p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
 
   mapM_
-    (\(label, player', expected) -> context label $
+    (\(label, p', expected) -> context label $
       it ("should be " ++ show expected) $
-        playerIsActive player' `shouldBe` expected)
+        playerIsActive p' `shouldBe` expected)
     --  label,                player,                  expected
-    [ ( "not active",         player,                       False    )
+    [ ( "not active",         p,                       False    )
-    , ( "has goal",           player & pYtd.psGoals   .~ 1, True     )
+    , ( "has goal",           p & pYtd.psGoals   .~ 1, True     )
-    , ( "has assist",         player & pYtd.psAssists .~ 1, True     )
+    , ( "has assist",         p & pYtd.psAssists .~ 1, True     )
-    , ( "has penalty minute", player & pYtd.psPMin    .~ 1, True     )
+    , ( "has penalty minute", p & pYtd.psPMin    .~ 1, True     )
     ]
 
 psPointsSpec :: Spec
@@ -633,6 +771,150 @@ addPlayerStatsSpec = describe "addPlayerStats" $ do
     it "should be 9" $
       s3^.psPMin `shouldBe` 9
 
+goalieSearchSpec :: Spec
+goalieSearchSpec = describe "goalieSearch" $ do
+  let
+    goalies =
+      [ newGoalie 2 "Joe"
+      , newGoalie 3 "Bob"
+      , newGoalie 5 "Steve"
+      ]
+    result n = (n, goalies!!n)
+
+  context "partial match" $
+    it "should return Joe and Steve" $
+      goalieSearch "e" goalies `shouldBe` [result 0, result 2]
+
+  context "no match" $
+    it "should return an empty list" $
+      goalieSearch "x" goalies `shouldBe` []
+
+  context "exact match" $
+    it "should return Bob" $
+      goalieSearch "bob" goalies `shouldBe` [result 1]
+
+activeGoalieSearchSpec :: Spec
+activeGoalieSearchSpec = describe "activeGoalieSearch" $ do
+  let
+    goalies =
+      [ newGoalie 2 "Joe"
+      , newGoalie 3 "Bob"
+      , newGoalie 5 "Steve" & gActive .~ False
+      ]
+    result n = (n, goalies!!n)
+
+  context "partial match" $
+    it "should return Joe" $
+      activeGoalieSearch "e" goalies `shouldBe` [result 0]
+
+  context "no match" $
+    it "should return an empty list" $
+      activeGoalieSearch "x" goalies `shouldBe` []
+
+  context "exact match" $
+    it "should return Bob" $
+      activeGoalieSearch "bob" goalies `shouldBe` [result 1]
+
+goalieSearchExactSpec :: Spec
+goalieSearchExactSpec = describe "goalieSearchExact" $ do
+  let
+    goalies =
+      [ newGoalie 2 "Joe"
+      , newGoalie 3 "Bob"
+      , newGoalie 5 "Steve"
+      ]
+    result n = (n, goalies!!n)
+
+  mapM_
+    (\(name, num) -> context name $
+      it ("should return " ++ name) $
+        goalieSearchExact name goalies `shouldBe` Just (result num))
+    --  name,    num
+    [ ( "Joe",   0   )
+    , ( "Bob",   1   )
+    , ( "Steve", 2   )
+    ]
+
+  context "Greg" $
+    it "should return Nothing" $
+      goalieSearchExact "Greg" goalies `shouldBe` Nothing
+
+goalieSummarySpec :: Spec
+goalieSummarySpec = describe "goalieSummary" $
+  it "should provide a summary string" $
+    goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
+
+goalieIsActiveSpec :: Spec
+goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
+  (\(label, input, expected) -> context label $
+    it ("should be " ++ show expected) $
+      goalieIsActive input `shouldBe` expected)
+
+  --  label,      input,    expected
+  [ ( "inactive", inactive, False    )
+  , ( "active",   active,   True     )
+  ]
+
+  where
+    inactive = newGoalie 1 "Joe"
+      & gLifetime.gsMinsPlayed .~ 1
+
+    active = inactive
+      & gYtd.gsMinsPlayed .~ 1
+
+addGoalieStatsSpec :: Spec
+addGoalieStatsSpec = describe "addGoalieStats" $ let
+  g1 = GoalieStats
+    { _gsGames        = 1
+    , _gsMinsPlayed   = 2
+    , _gsGoalsAllowed = 3
+    , _gsShutouts     = 4
+    , _gsWins         = 5
+    , _gsLosses       = 6
+    , _gsTies         = 7
+    }
+
+  g2 = GoalieStats
+    { _gsGames        = 8
+    , _gsMinsPlayed   = 9
+    , _gsGoalsAllowed = 10
+    , _gsShutouts     = 11
+    , _gsWins         = 12
+    , _gsLosses       = 13
+    , _gsTies         = 14
+    }
+
+  expected = GoalieStats
+    { _gsGames        = 9
+    , _gsMinsPlayed   = 11
+    , _gsGoalsAllowed = 13
+    , _gsShutouts     = 15
+    , _gsWins         = 17
+    , _gsLosses       = 19
+    , _gsTies         = 21
+    }
+
+  actual = g1 `addGoalieStats` g2
+
+  in it ("should be " ++ show expected) $
+    actual `shouldBe` expected
+
+gsAverageSpec :: Spec
+gsAverageSpec = describe "gsAverage" $ mapM_
+  (\(label, stats, expected) -> context label $
+    it ("should be " ++ show expected) $
+      gsAverage stats `shouldBe` expected)
+
+  --  label,          stats,           expected
+  [ ( "with minutes", gs,              3 % 2    )
+  , ( "no minutes",   newGoalieStats , 0        )
+  ]
+
+  where
+    gs = newGoalieStats
+      & gsMinsPlayed   .~ 2 * gameLength
+      & gsGoalsAllowed .~ 3
+
 joe :: Player
 joe = newPlayer 2 "Joe" "center"
 
@@ -641,3 +923,168 @@ bob = newPlayer 3 "Bob" "defense"
 
 steve :: Player
 steve = newPlayer 5 "Steve" "forward"
+
+-- | Creates a 'Player'
+makePlayer :: IO Player
+makePlayer = Player
+  <$> makeNum
+  <*> makeName
+  <*> makeName
+  <*> makeBool
+  <*> makeBool
+  <*> makePlayerStats
+  <*> makePlayerStats
+
+-- | Creates a 'Goalie'
+makeGoalie :: IO Goalie
+makeGoalie = Goalie
+  <$> makeNum
+  <*> makeName
+  <*> makeBool
+  <*> makeBool
+  <*> makeGoalieStats
+  <*> makeGoalieStats
+
+-- | Creates a 'PlayerStats' value
+makePlayerStats :: IO PlayerStats
+makePlayerStats = PlayerStats
+  <$> makeNum
+  <*> makeNum
+  <*> makeNum
+
+-- | Creates a 'GoalieStats' value
+makeGoalieStats :: IO GoalieStats
+makeGoalieStats = GoalieStats
+  <$> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+  <*> makeNum
+
+makeNum :: IO Int
+makeNum = randomRIO (1, 10)
+
+makeBool :: IO Bool
+makeBool = randomIO
+
+makeName :: IO String
+makeName = replicateM 10 $ randomRIO ('A', 'Z')
+
+instance Comparable GoalieStats where
+  compareTest actual expected = mapM_
+    (\(name, lens) -> describe name $
+      it ("should be " ++ show (expected^.lens)) $
+        actual^.lens `shouldBe` expected^.lens)
+    --  name,             lens
+    [ ( "gsGames",        gsGames        )
+    , ( "gsMinsPlayed",   gsMinsPlayed   )
+    , ( "gsGoalsAllowed", gsGoalsAllowed )
+    , ( "gsWins",         gsWins         )
+    , ( "gsLosses",       gsLosses       )
+    , ( "gsTies",         gsTies         )
+    ]
+
+instance Comparable GameState where
+  compareTest actual expected =
+    it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+
+instance Comparable CreatePlayerState where
+  compareTest actual expected = do
+
+    describe "cpsNumber" $
+      it ("should be " ++ show (expected^.cpsNumber)) $
+        actual^.cpsNumber `shouldBe` expected^.cpsNumber
+
+    describe "cpsName" $
+      it ("should be " ++ expected^.cpsName) $
+        actual^.cpsName `shouldBe` expected^.cpsName
+
+    describe "cpsPosition" $
+      it ("should be " ++ expected^.cpsPosition) $
+        actual^.cpsPosition `shouldBe` expected^.cpsPosition
+
+instance Comparable EditPlayerState where
+  compareTest actual expected = do
+
+    describe "epsSelectedPlayer" $
+      it ("should be " ++ show (expected^.epsSelectedPlayer)) $
+        actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
+
+    describe "epsMode" $
+      it ("should be " ++ show (expected^.epsMode)) $
+        actual^.epsMode `shouldBe` expected^.epsMode
+
+instance Comparable EditGoalieState where
+  compareTest actual expected = do
+
+    describe "egsSelectedGoalie" $
+      it ("should be " ++ show (expected^.egsSelectedGoalie)) $
+        actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
+
+    describe "egsMode" $
+      it ("should be " ++ show (expected^.egsMode)) $
+        actual^.egsMode `shouldBe` expected^.egsMode
+
+instance Comparable CreateGoalieState where
+  compareTest actual expected = do
+
+    describe "cgsNuber" $
+      it("should be " ++ show (expected^.cgsNumber)) $
+        actual^.cgsNumber `shouldBe` expected^.cgsNumber
+
+    describe "cgsName" $
+      it ("should be " ++ expected^.cgsName) $
+        actual^.cgsName `shouldBe` expected^.cgsName
+
+instance Comparable EditStandingsMode where
+  compareTest actual expected =
+    it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+
+instance Comparable Goalie where
+  compareTest actual expected = do
+
+    describe "gNumber" $
+      it ("should be " ++ show (expected^.gNumber)) $
+        actual^.gNumber `shouldBe` expected^.gNumber
+
+    describe "gName" $
+      it ("should be " ++ show (expected^.gName)) $
+        actual^.gName `shouldBe` expected^.gName
+
+    describe "gRookie" $
+      it ("should be " ++ show (expected^.gRookie)) $
+        actual^.gRookie `shouldBe` expected^.gRookie
+
+    describe "gActive" $
+      it ("should be " ++ show (expected^.gActive)) $
+        actual^.gActive `shouldBe` expected^.gActive
+
+    describe "gYtd" $
+      (actual^.gYtd) `compareTest` (expected^.gYtd)
+
+    describe "gLifetime" $
+      (actual^.gLifetime) `compareTest` (expected^.gLifetime)
+
+instance Comparable (M.Map Int GoalieStats) where
+  compareTest actual expected = do
+
+    let
+      aList = M.toList actual
+      eList = M.toList expected
+
+    it "should have the correct number of elements" $
+      length aList `shouldBe` length eList
+
+    mapM_
+      (\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
+
+        context "key" $
+          it ("should be " ++ show ke) $
+            ka `shouldBe` ke
+
+        context "value" $ va `compareTest` ve)
+      (zip3 ([0..] :: [Int]) aList eList)

test/UtilSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 2019 Rhéal Lamothe
+Copyright (C) Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -26,12 +26,16 @@ import Test.Hspec (Spec, context, describe, it, shouldBe)
 
 import Mtlstats.Util
 
+import SpecHelpers
+
 spec :: Spec
 spec = describe "Mtlstats.Util" $ do
   nthSpec
   modifyNthSpec
+  dropNthSpec
   updateMapSpec
   sliceSpec
+  capitalizeNameSpec
 
 nthSpec :: Spec
 nthSpec = describe "nth" $ mapM_
@@ -49,18 +53,33 @@ nthSpec = describe "nth" $ mapM_
 
 modifyNthSpec  :: Spec
 modifyNthSpec = describe "modifyNth" $ do
+  let list = [1, 2, 3] :: [Int]
 
   context "in bounds" $
     it "should modify the value" $
-      modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
+      modifyNth 1 succ list `shouldBe` [1, 3, 3]
 
   context "out of bounds" $
     it "should not modify the value" $
-      modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
+      modifyNth 3 succ list `shouldBe` [1, 2, 3]
 
   context "negative index" $
     it "should not modify the value" $
-      modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
+      modifyNth (-1) succ list `shouldBe` [1, 2, 3]
+
+dropNthSpec :: Spec
+dropNthSpec = describe "dropNth" $ mapM_
+
+  (\(label, n, expected) ->
+    context label $
+      it ("should be " ++ show expected) $
+      dropNth n list `shouldBe` expected)
+
+  [ ( "out of bounds", 1, ["foo", "baz"] )
+  , ( "in bounds",     3, list           )
+  ]
+
+  where list = ["foo", "bar", "baz"]
 
 updateMapSpec :: Spec
 updateMapSpec = describe "updateMap" $ do
@@ -68,7 +87,7 @@ updateMapSpec = describe "updateMap" $ do
     input = M.fromList [(1, 2), (3, 5)]
 
   context "key found" $ let
-    expected = M.fromList [(1, 3), (3, 5)]
+    expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
     in it "should update the value" $
       updateMap 1 10 succ input `shouldBe` expected
 
@@ -79,7 +98,7 @@ updateMapSpec = describe "updateMap" $ do
 
 sliceSpec :: Spec
 sliceSpec = describe "slice" $ do
-  let list = [2, 4, 6, 8]
+  let list = [2, 4, 6, 8] :: [Int]
 
   context "sublist" $
     it "should return the sublist" $
@@ -92,3 +111,23 @@ sliceSpec = describe "slice" $ do
   context "negative offset" $
     it "should return the correct number of elements from the beginning" $
       slice (-10) 2 list `shouldBe` [2, 4]
+
+capitalizeNameSpec :: Spec
+capitalizeNameSpec = describe "capitalizeName" $ mapM_
+  (\(label, ch, str, expected) -> context label $
+    it ("should be " ++ expected) $
+      userText (capitalizeName ch $ mkEditor str) `shouldBe` expected)
+  --  label,                        character, string,   expected
+  [ ( "initial lower",              'a',       "",       "A"       )
+  , ( "initial upper",              'A',       "",       "A"       )
+  , ( "initial non-alpha",          '0',       "",       "0"       )
+  , ( "pre-comma lower",            'a',       "A",      "AA"      )
+  , ( "pre-comma upper",            'A',       "A",      "AA"      )
+  , ( "pre-comma non-alpha",        '0',       "A",      "A0"      )
+  , ( "post-comma first lower",     'a',       "FOO, ",  "FOO, A"  )
+  , ( "post-comma first upper",     'A',       "FOO, ",  "FOO, A"  )
+  , ( "post-comma first non-alpha", '0',       "FOO, ",  "FOO, 0"  )
+  , ( "unrestricted upper",         'A',       "FOO, A", "FOO, AA" )
+  , ( "unrestricted lower",         'a',       "FOO, A", "FOO, Aa" )
+  , ( "unrestricted non-alpha",     '0',       "FOO, A", "FOO, A0" )
+  ]