fix ProgMode comparison failure

also updated copyright notice

.gitignore

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

ChangeLog.md

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

Vagrantfile

@@ -0,0 +1,10 @@
+# -*- mode: ruby -*-
+# vi: set ft=ruby :
+
+Vagrant.configure("2") do |config|
+  config.vm.box = "ubuntu/xenial64"
+  config.vm.provision "shell", path: "vagrant/provision.sh"
+  config.vm.provider :virtualbox do |v|
+    v.customize ["modifyvm", :id, "--memory", 4096]
+  end
+end

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.13.0
+version:             0.16.1
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"

src/Mtlstats.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,23 +19,15 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE ScopedTypeVariables #-}
-
 module Mtlstats (initState, mainLoop) where
 
-import Control.Exception (IOException, catch)
 import Control.Monad (void)
 import Control.Monad.Extra (whenM)
-import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.State (get, gets)
-import Data.Aeson (decodeFileStrict)
-import Data.Maybe (fromJust, fromMaybe)
-import Lens.Micro ((&), (.~))
-import System.EasyFile (getAppUserDataDirectory, (</>))
+import Data.Maybe (fromJust)
 import qualified UI.NCurses as C
 
-import Mtlstats.Config
 import Mtlstats.Control
 import Mtlstats.Types
 
@@ -44,15 +36,7 @@ initState :: C.Curses ProgState
 initState = do
   C.setEcho False
   void $ C.setCursorMode C.CursorInvisible
-  db <- liftIO $ do
-    dir <- getAppUserDataDirectory appName
-    let dbFile = dir </> dbFname
-    fromMaybe newDatabase <$> catch
-      (decodeFileStrict dbFile)
-      (\(_ :: IOException) -> return Nothing)
-  return
-    $ newProgState
-    & database .~ db
+  return newProgState
 
 -- | Main program loop
 mainLoop :: Action ()

src/Mtlstats/Actions.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
 
 module Mtlstats.Actions
   ( startNewSeason
@@ -43,12 +43,14 @@ module Mtlstats.Actions
   , backHome
   , scrollUp
   , scrollDown
+  , loadDatabase
   , saveDatabase
   ) where
 
+import Control.Exception (IOException, catch)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.State (gets, modify)
-import Data.Aeson (encodeFile)
+import Data.Aeson (decodeFileStrict, encodeFile)
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.), (&), (.~), (%~))
 import System.EasyFile
@@ -216,12 +218,27 @@ scrollUp = scrollOffset %~ max 0 . pred
 scrollDown :: ProgState -> ProgState
 scrollDown = scrollOffset %~ succ
 
+-- | Loads the database
+loadDatabase :: Action ()
+loadDatabase = do
+  dbFile <- dbSetup
+  liftIO
+    (catch
+      (decodeFileStrict dbFile)
+      (\(_ :: IOException) -> return Nothing))
+    >>= mapM_ (modify . (database .~))
+
 -- | Saves the database
-saveDatabase :: String -> Action ()
-saveDatabase fn = do
-  db <- gets (^.database)
+saveDatabase :: Action ()
+saveDatabase = do
+  db     <- gets (^.database)
+  dbFile <- dbSetup
+  liftIO $ encodeFile dbFile db
+
+dbSetup :: Action String
+dbSetup = do
+  fn <- gets (^.dbName)
   liftIO $ do
     dir <- getAppUserDataDirectory appName
-    let dbFile = dir </> fn
     createDirectoryIfMissing True dir
-    encodeFile dbFile db
+    return $ dir </> fn ++ ".json"

src/Mtlstats/Actions/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Actions/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -43,9 +43,7 @@ import Mtlstats.Util
 overtimeCheck :: ProgState -> ProgState
 overtimeCheck s
   | fromMaybe False $ gameTied $ s^.progMode.gameStateL =
-    s & progMode.gameStateL
-    %~ (homeScore .~ Nothing)
-    .  (awayScore .~ Nothing)
+    s & progMode.gameStateL.overtimeFlag ?~ True
   | fromMaybe False $ gameWon $ s^.progMode.gameStateL =
     s & progMode.gameStateL.overtimeFlag ?~ False
   | otherwise  = s
@@ -124,12 +122,13 @@ awardGoal n ps = ps
     (\m -> let
       stats = M.findWithDefault newPlayerStats n m
       in M.insert n (stats & psGoals %~ succ) m)
-  & database.dbPlayers %~ map
-    (\(i, p) -> if i == n
+  & database.dbPlayers %~ zipWith
+    (\i p -> if i == n
       then p
         & pYtd.psGoals      %~ succ
         & pLifetime.psGoals %~ succ
-      else p) . zip [0..]
+      else p)
+    [0..]
 
 -- | Awards an assist to a player
 awardAssist
@@ -142,12 +141,13 @@ awardAssist n ps = ps
     (\m -> let
       stats = M.findWithDefault newPlayerStats n m
       in M.insert n (stats & psAssists %~ succ) m)
-  & database.dbPlayers %~ map
-    (\(i, p) -> if i == n
+  & database.dbPlayers %~ zipWith
+    (\i p -> if i == n
       then p
         & pYtd.psAssists      %~ succ
         & pLifetime.psAssists %~ succ
-      else p) . zip [0..]
+      else p)
+    [0..]
 
 -- | Resets the entered data for the current goal
 resetGoalData :: ProgState -> ProgState

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -87,18 +87,22 @@ setGameGoalie
   -> ProgState
 setGameGoalie gid s = fromMaybe s $ do
   let gs = s^.progMode.gameStateL
-  won  <- gameWon gs
-  lost <- gameLost gs
-  tied <- gs^.overtimeFlag
+  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
+    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)
+      = (gsWins     +~ w)
+      . (gsLosses   +~ l)
+      . (gsTies     +~ t)
+      . (gsShutouts +~ so)
 
     updateGoalie
       = (gYtd      %~ updateStats)

src/Mtlstats/Config.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -33,10 +33,6 @@ maxFunKeys = 9
 appName :: String
 appName = "mtlstats"
 
--- | The database filename
-dbFname :: String
-dbFname = "database.json"
-
 -- | The maximum number of assists
 maxAssists :: Int
 maxAssists = 2
@@ -44,3 +40,11 @@ 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) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -39,7 +39,7 @@ import Mtlstats.Types
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
   TitleScreen         -> titleScreenC
-  MainMenu            -> mainMenuC
+  MainMenu            -> mainMenuC s
   NewSeason flag      -> newSeasonC flag
   NewGame gs          -> newGameC gs
   EditMenu            -> editMenuC
@@ -49,11 +49,13 @@ dispatch s = case s^.progMode of
   EditGoalie egs      -> editGoalieC egs
   (EditStandings esm) -> editStandingsC esm
 
-mainMenuC :: Controller
-mainMenuC = Controller
-  { drawController   = const $ drawMenu mainMenu
-  , handleController = menuHandler mainMenu
-  }
+mainMenuC :: ProgState -> Controller
+mainMenuC s = if null $ s^.dbName
+  then promptController getDBPrompt
+  else Controller
+    { drawController   = const $ drawMenu mainMenu
+    , handleController = menuHandler mainMenu
+    }
 
 newSeasonC :: Bool -> Controller
 newSeasonC False = promptController newSeasonPrompt

src/Mtlstats/Control/CreateGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Control/CreatePlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Control/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -23,10 +23,13 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.EditGoalie (editGoalieC) where
 
+import Control.Monad.Trans.State (gets, modify)
 import Data.Maybe (fromMaybe)
-import Lens.Micro ((^.))
+import Lens.Micro ((^.), (.~), (%~))
 import UI.NCurses as C
 
+import Mtlstats.Actions
+import Mtlstats.Handlers
 import Mtlstats.Helpers.Goalie
 import Mtlstats.Menu
 import Mtlstats.Menu.EditGoalie
@@ -52,6 +55,7 @@ editC cb =
     EGName          -> nameC
     EGYtd           -> ytdMenuC
     EGLifetime      -> lifetimeMenuC
+    EGDelete        -> deleteC
     EGYtdGames b    -> ytdGamesC b
     EGYtdMins b     -> ytdMinsC b
     EGYtdGoals b    -> ytdGoalsC b
@@ -83,6 +87,38 @@ ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
 lifetimeMenuC :: Action () -> Controller
 lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
 
+deleteC :: Action () -> Controller
+deleteC _ = Controller
+
+  { drawController = \s -> do
+
+    C.drawString $ let
+
+      hdr = fromMaybe [] $ do
+        gid    <- s^.progMode.editGoalieStateL.egsSelectedGoalie
+        goalie <- nth gid $ s^.database.dbGoalies
+        Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
+
+      in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
+
+    return C.CursorInvisible
+
+  , handleController = \e -> do
+
+    case ynHandler e of
+
+      Just True -> do
+        gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
+          (\gid -> modify $ database.dbGoalies %~ dropNth gid)
+        modify edit
+
+      Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
+      Nothing    -> return ()
+
+    return True
+
+  }
+
 ytdGamesC :: Bool -> Action () -> Controller
 ytdGamesC = curry $ promptController .
   uncurry editGoalieYtdGamesPrompt

src/Mtlstats/Control/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,10 +21,13 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.EditPlayer (editPlayerC) where
 
+import Control.Monad.Trans.State (gets, modify)
 import Data.Maybe (fromMaybe)
-import Lens.Micro ((^.))
+import Lens.Micro ((^.), (.~), (%~))
 import qualified UI.NCurses as C
 
+import Mtlstats.Actions
+import Mtlstats.Handlers
 import Mtlstats.Helpers.Player
 import Mtlstats.Menu
 import Mtlstats.Menu.EditPlayer
@@ -45,6 +48,7 @@ editPlayerC eps
       EPPosition     -> positionC
       EPYtd          -> ytdC
       EPLifetime     -> lifetimeC
+      EPDelete       -> deleteC
       EPYtdGoals   b -> ytdGoalsC   b
       EPYtdAssists b -> ytdAssistsC b
       EPYtdPMin      -> ytdPMinC
@@ -74,6 +78,38 @@ ytdC _ = menuControllerWith header editPlayerYtdMenu
 lifetimeC :: Action () -> Controller
 lifetimeC _ = menuControllerWith header editPlayerLtMenu
 
+deleteC :: Action () -> Controller
+deleteC _ = Controller
+
+  { drawController = \s -> do
+
+    C.drawString $ let
+
+      hdr = fromMaybe [] $ do
+        pid    <- s^.progMode.editPlayerStateL.epsSelectedPlayer
+        player <- nth pid $ s^.database.dbPlayers
+        Just $ "Player: " ++ playerDetails player ++ "\n\n"
+
+      in hdr ++ "Are you sure you want to delete this player? (Y/N)"
+
+    return C.CursorInvisible
+
+  , handleController = \e -> do
+
+    case ynHandler e of
+
+      Just True -> do
+        gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
+          (\pid -> modify $ database.dbPlayers %~ dropNth pid)
+        modify edit
+
+      Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
+      Nothing    -> return ()
+
+    return True
+
+  }
+
 ytdGoalsC :: Bool -> Action () -> Controller
 ytdGoalsC batchMode callback = promptController $
   editPlayerYtdGoalsPrompt batchMode callback

src/Mtlstats/Control/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Control/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -21,13 +21,15 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control.NewGame (newGameC) where
 
-import Control.Monad.Trans.State (gets, modify)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.State (get, gets, modify)
 import Data.Maybe (fromJust, fromMaybe, isJust)
 import Lens.Micro ((^.), (.~))
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Actions.NewGame
+import Mtlstats.Config
 import Mtlstats.Control.NewGame.GoalieInput
 import Mtlstats.Format
 import Mtlstats.Handlers
@@ -60,7 +62,7 @@ gameYearC :: Controller
 gameYearC = promptControllerWith header gameYearPrompt
 
 gameMonthC :: Controller
-gameMonthC = menuControllerWith header gameMonthMenu
+gameMonthC = promptControllerWith monthHeader gameMonthPrompt
 
 gameDayC :: Controller
 gameDayC = promptControllerWith header gameDayPrompt
@@ -204,16 +206,19 @@ reportC = Controller
     C.drawString $ unlines $ slice
       (s^.scrollOffset)
       (fromInteger $ pred rows)
-      (report (fromInteger $ pred cols) s)
+      (displayReport (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 ()
+
+      C.EventCharacter '\n' -> do
+        get >>= liftIO . writeFile reportFilename . exportReport reportCols
+        modify backHome
+
+      _ -> return ()
     return True
   }
 
@@ -221,6 +226,31 @@ header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
 
+monthHeader :: ProgState -> C.Update ()
+monthHeader s = do
+  (_, cols) <- C.windowSize
+  header s
+
+  let
+    table = labelTable $ zip (map show ([1..] :: [Int]))
+      [ "JANUARY"
+      , "FEBRUARY"
+      , "MARCH"
+      , "APRIL"
+      , "MAY"
+      , "JUNE"
+      , "JULY"
+      , "AUGUST"
+      , "SEPTEMBER"
+      , "OCTOBER"
+      , "NOVEMBER"
+      , "DECEMBER"
+      ]
+
+  C.drawString $ unlines $
+    map (centre $ fromIntegral $ pred cols) $
+      ["MONTH:", ""] ++ table ++ [""]
+
 gameGoal :: ProgState -> (Int, Int)
 gameGoal s =
   ( s^.database.dbGames

src/Mtlstats/Control/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Control/TitleScreen.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -41,7 +41,7 @@ titleScreenC = Controller
          ]
       ++ titleText
       ++ [ ""
-         , "Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe"
+         , "Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe"
          , "<rheal.lamothe@gmail.com>"
          , ""
          , "Press any key to continue..."

src/Mtlstats/Format.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -129,9 +129,14 @@ month _  = ""
 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 ++ ": " ++ val)
-    xs
+    ( \(label, val)
+      -> right labelWidth label
+      ++ ": "
+      ++ left valWidth val
+    ) xs
 
 -- | Creates a variable column table of numbers with two axes
 numTable

src/Mtlstats/Handlers.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Helpers/Goalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Helpers/Player.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Helpers/Position.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -29,7 +29,6 @@ module Mtlstats.Menu (
   -- * Menus
   mainMenu,
   newSeasonMenu,
-  gameMonthMenu,
   gameTypeMenu,
   gameGoalieMenu,
   editMenu
@@ -45,7 +44,6 @@ import qualified UI.NCurses as C
 import Mtlstats.Actions
 import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
 import Mtlstats.Actions.EditStandings
-import Mtlstats.Config
 import Mtlstats.Format
 import Mtlstats.Types
 import Mtlstats.Types.Menu
@@ -115,7 +113,7 @@ mainMenu = Menu "MASTER MENU" True
   , MenuItem 'C' "EDIT MENU" $
     modify edit >> return True
   , MenuItem 'E' "EXIT" $
-    saveDatabase dbFname >> return False
+    saveDatabase >> return False
   ]
 
 -- | The new season menu
@@ -125,30 +123,10 @@ newSeasonMenu = Menu "SEASON TYPE" ()
     $ resetYtd
     . clearRookies
     . resetStandings
-    . startNewGame
+    . backHome
   , MenuItem 'P' "PLAYOFFS" $ modify
     $ resetStandings
-    . startNewGame
-  ]
-
--- | Requests the month in which the game took place
-gameMonthMenu :: Menu ()
-gameMonthMenu = Menu "MONTH:" () $ map
-  (\(ch, name, val) ->
-    MenuItem ch name $
-    modify $ progMode.gameStateL.gameMonth ?~ val)
-  [ ( 'A', "JANUARY",   1  )
-  , ( 'B', "FEBRUARY",  2  )
-  , ( 'C', "MARCH",     3  )
-  , ( 'D', "APRIL",     4  )
-  , ( 'E', "MAY",       5  )
-  , ( 'F', "JUNE",      6  )
-  , ( 'G', "JULY",      7  )
-  , ( 'H', "AUGUST",    8  )
-  , ( 'I', "SEPTEMBER", 9  )
-  , ( 'J', "OCTOBER",   10 )
-  , ( 'K', "NOVEMBER",  11 )
-  , ( 'L', "DECEMBER",  12 )
+    . backHome
   ]
 
 -- | The game type menu (home/away)
@@ -170,10 +148,11 @@ gameGoalieMenu s = let
       goalie <- nth n $ s^.database.dbGoalies
       Just (n, goalie))
     gids
-  in Menu title () $ map
-    (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
-      modify $ GI.setGameGoalie gid) $
-    zip ['1'..] goalies
+  in Menu title () $ zipWith
+    (\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
+      modify $ GI.setGameGoalie gid)
+    ['1'..]
+    goalies
 
 -- | The edit menu
 editMenu :: Menu ()

src/Mtlstats/Menu/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -44,6 +44,7 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
   , ( '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           )
   ]
 

src/Mtlstats/Menu/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -45,6 +45,7 @@ editPlayerMenu = Menu "EDIT PLAYER" () $ map
   , ( '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           )
   ]
 

src/Mtlstats/Menu/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Prompt.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -31,9 +31,12 @@ module Mtlstats.Prompt (
   ucStrPrompt,
   namePrompt,
   numPrompt,
+  numPromptRange,
   numPromptWithFallback,
+  dbNamePrompt,
   selectPrompt,
   -- * Individual prompts
+  getDBPrompt,
   newSeasonPrompt,
   playerNumPrompt,
   playerNamePrompt,
@@ -41,7 +44,9 @@ module Mtlstats.Prompt (
   goalieNumPrompt,
   goalieNamePrompt,
   selectPlayerPrompt,
+  selectActivePlayerPrompt,
   selectGoaliePrompt,
+  selectActiveGoaliePrompt,
   selectPositionPrompt,
   playerToEditPrompt
 ) where
@@ -150,6 +155,20 @@ numPrompt
   -> Prompt
 numPrompt pStr = numPromptWithFallback pStr $ return ()
 
+-- | Builds a numberic prompt with a range
+numPromptRange
+  :: 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
@@ -164,30 +183,34 @@ numPromptWithFallback pStr fallback act = Prompt
   , promptProcessChar = \ch str -> if isDigit ch
     then str ++ [ch]
     else str
-  , promptAction      = \inStr -> case readMaybe inStr of
-      Nothing -> fallback
-      Just n  -> act n
+  , promptAction      = maybe fallback act . readMaybe
   , promptSpecialKey  = const $ return ()
   }
 
+-- | Prompts for a database name
+dbNamePrompt
+  :: String
+  -- ^ 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 (++[toUpper ch])
+    else id
+  }
+
 -- | Prompts the user for a filename to save a backup of the database
 -- to
 newSeasonPrompt :: Prompt
-newSeasonPrompt = prompt
-  { promptProcessChar = \ch str -> if validChar ch
-    then str ++ [toUpper ch]
-    else str
-  }
-  where
-
-    prompt = strPrompt "Filename to save database: " $ \fn ->
-      if null fn
-      then modify backHome
-      else do
-        saveDatabase $ fn ++ ".json"
-        modify $ progMode .~ NewSeason True
-
-    validChar = (||) <$> isAlphaNum <*> (=='-')
+newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
+  if null fn
+  then modify backHome
+  else do
+    saveDatabase
+    modify
+      $ (dbName .~ fn)
+      . (progMode .~ NewSeason True)
 
 -- | Builds a selection prompt
 selectPrompt :: SelectParams a -> Prompt
@@ -226,6 +249,12 @@ selectPrompt params = Prompt
     _ -> return ()
   }
 
+-- | Prompts for the database to load
+getDBPrompt :: Prompt
+getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
+  modify $ dbName .~ fn
+  loadDatabase
+
 -- | Prompts for a new player's number
 playerNumPrompt :: Prompt
 playerNumPrompt = numPrompt "Player number: " $
@@ -251,18 +280,21 @@ goalieNamePrompt :: Prompt
 goalieNamePrompt = namePrompt "Goalie name: " $
   modify . (progMode.createGoalieStateL.cgsName .~)
 
--- | Selects a player (creating one if necessary)
-selectPlayerPrompt
-  :: String
+-- | 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
-selectPlayerPrompt pStr callback = selectPrompt SelectParams
+selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
   { spPrompt       = pStr
   , spSearchHeader = "Player select:"
-  , spSearch       = \sStr db -> playerSearch sStr (db^.dbPlayers)
+  , spSearch       = \sStr db -> sFunc sStr (db^.dbPlayers)
   , spSearchExact  = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
   , spElemDesc     = playerSummary
   , spProcessChar  = capitalizeName
@@ -280,18 +312,41 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
     modify $ progMode .~ CreatePlayer cps
   }
 
--- | Selects a goalie (creating one if necessary)
-selectGoaliePrompt
+-- | Selects a player (creating one if necessary)
+selectPlayerPrompt
   :: String
   -- ^ The prompt string
   -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the payer as
+  -- input)
+  -> Prompt
+selectPlayerPrompt = selectPlayerPromptWith playerSearch
+
+-- | Selects an active player (creating one if necessary)
+selectActivePlayerPrompt
+  :: String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the payer as
+  -- input)
+  -> Prompt
+selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch
+
+-- | Selects a goalie with a specified search criteria (creating the
+-- goalie if necessary)
+selectGoaliePromptWith
+  :: (String -> [Goalie] -> [(Int, Goalie)])
+  -- ^ The search criteria
+  -> String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
   -- ^ The callback to run (takes the index number of the goalie as
   -- input)
   -> Prompt
-selectGoaliePrompt pStr callback = selectPrompt SelectParams
+selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
   { spPrompt       = pStr
   , spSearchHeader = "Goalie select:"
-  , spSearch       = \sStr db -> goalieSearch sStr (db^.dbGoalies)
+  , spSearch       = \sStr db -> criteria sStr (db^.dbGoalies)
   , spSearchExact  = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
   , spElemDesc     = goalieSummary
   , spProcessChar  = capitalizeName
@@ -309,6 +364,26 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
     modify $ progMode .~ CreateGoalie cgs
   }
 
+-- | Selects a goalie (creating one if necessary)
+selectGoaliePrompt
+  :: String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the goalie as
+  -- input)
+  -> Prompt
+selectGoaliePrompt = selectGoaliePromptWith goalieSearch
+
+-- | Selects an active goalie (creating one if necessary)
+selectActiveGoaliePrompt
+  :: String
+  -- ^ The prompt string
+  -> (Maybe Int -> Action ())
+  -- ^ The callback to run (takes the index number of the goalie as
+  -- input)
+  -> Prompt
+selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch
+
 -- | Selects (or creates) a player position
 selectPositionPrompt
   :: String

src/Mtlstats/Prompt/EditGoalie.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Prompt/EditPlayer.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Prompt/EditStandings.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Prompt/NewGame.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -23,6 +23,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Prompt.NewGame
   ( gameYearPrompt
+  , gameMonthPrompt
   , gameDayPrompt
   , otherTeamPrompt
   , homeScorePrompt
@@ -48,6 +49,11 @@ 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: " $
@@ -76,7 +82,7 @@ recordGoalPrompt
   -> Int
   -- ^ The goal number
   -> Prompt
-recordGoalPrompt game goal = selectPlayerPrompt
+recordGoalPrompt game goal = selectActivePlayerPrompt
   (  "*** GAME " ++ padNum 2 game ++ " ***\n"
   ++ "Who scored goal number " ++ show goal ++ "? "
   ) $ modify . (progMode.gameStateL.goalBy .~)
@@ -90,7 +96,7 @@ recordAssistPrompt
   -> Int
   -- ^ The assist number
   -> Prompt
-recordAssistPrompt game goal assist = selectPlayerPrompt
+recordAssistPrompt game goal assist = selectActivePlayerPrompt
   (  "*** GAME " ++ padNum 2 game ++ " ***\n"
   ++ "Goal: " ++ show goal ++ "\n"
   ++ "Assist #" ++ show assist ++ ": "
@@ -104,7 +110,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
 
 -- | Prompts for the player to assign penalty minutes to
 pMinPlayerPrompt :: Prompt
-pMinPlayerPrompt = selectPlayerPrompt
+pMinPlayerPrompt = selectActivePlayerPrompt
   "Assign penalty minutes to: " $
   \case
     Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded  .~ True

src/Mtlstats/Prompt/NewGame/GoalieInput.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -36,7 +36,8 @@ import Mtlstats.Types
 
 -- | Prompts for a goalie who played in the game
 selectGameGoaliePrompt :: Prompt
-selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
+selectGameGoaliePrompt = selectActiveGoaliePrompt
+  "Which goalie played this game: " $
   \case
     Nothing -> modify finishGoalieEntry
     Just n  -> modify $ progMode.gameStateL.gameSelectedGoalie  ?~ n

src/Mtlstats/Report.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Report (report, gameDate) where
+module Mtlstats.Report (displayReport, exportReport, gameDate) where
 
 import Data.List (sortOn)
 import qualified Data.Map as M
@@ -34,21 +34,37 @@ import Mtlstats.Helpers.Player
 import Mtlstats.Types
 import Mtlstats.Util
 
--- | Generates the report
-report
+-- | Generates the report displayed on screen
+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
   ++ [""]
   ++ gameStatsReport width s
   ++ [""]
   ++ yearToDateStatsReport width s
-  ++ [""]
-  ++ lifetimeStatsReport width s
 
 standingsReport :: Int -> ProgState -> [String]
 standingsReport width s = fromMaybe [] $ do
@@ -241,8 +257,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let
     else repeat ""
 
   table = overlayLast olayText
-    $ map (\(ln, line) -> overlay ln $ centre width line)
-    $ zip lnOverlay
+    $ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
     $ complexTable ([right, left] ++ repeat right)
     $ tHeader : body ++ if showTotals
       then [separator, totals]
@@ -301,8 +316,7 @@ goalieReport width showTotals lineNumbers goalieData = let
     then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
     else repeat ""
 
-  in map (\(ln, line) -> overlay ln $ centre width line)
-    $ zip lnOverlay
+  in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
     $ overlayLast olayText
     $ complexTable ([right, left] ++ repeat right)
     $ header : body ++ if showTotals

src/Mtlstats/Types.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -50,6 +50,7 @@ module Mtlstats.Types (
   -- ** ProgState Lenses
   database,
   progMode,
+  dbName,
   inputBuffer,
   scrollOffset,
   -- ** ProgMode Lenses
@@ -175,6 +176,7 @@ module Mtlstats.Types (
   addGameStats,
   -- ** Player Helpers
   playerSearch,
+  activePlayerSearch,
   playerSearchExact,
   modifyPlayer,
   playerSummary,
@@ -184,6 +186,7 @@ module Mtlstats.Types (
   addPlayerStats,
   -- ** Goalie Helpers
   goalieSearch,
+  activeGoalieSearch,
   goalieSearchExact,
   goalieSummary,
   goalieIsActive,
@@ -208,9 +211,8 @@ import Data.Aeson
   , (.=)
   )
 import Data.Char (toUpper)
-import Data.List (isInfixOf)
+import Data.List (find, isInfixOf)
 import qualified Data.Map as M
-import Data.Maybe (listToMaybe)
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 import qualified UI.NCurses as C
@@ -234,6 +236,8 @@ data ProgState = ProgState
   -- ^ The data to be saved
   , _progMode     :: ProgMode
   -- ^ The program's mode
+  , _dbName       :: String
+  -- ^ The name of the database file
   , _inputBuffer  :: String
   -- ^ Buffer for user input
   , _scrollOffset :: Int
@@ -376,6 +380,7 @@ data EditPlayerMode
   | EPPosition
   | EPYtd
   | EPLifetime
+  | EPDelete
   | EPYtdGoals Bool
   | EPYtdAssists Bool
   | EPYtdPMin
@@ -401,6 +406,7 @@ data EditGoalieMode
   | EGName
   | EGYtd
   | EGLifetime
+  | EGDelete
   | EGYtdGames    Bool
   | EGYtdMins     Bool
   | EGYtdGoals    Bool
@@ -782,6 +788,7 @@ newProgState :: ProgState
 newProgState = ProgState
   { _database     = newDatabase
   , _progMode     = TitleScreen
+  , _dbName       = ""
   , _inputBuffer  = ""
   , _scrollOffset = 0
   }
@@ -998,6 +1005,23 @@ addGameStats s1 s2 = GameStats
   , _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
   }
 
+-- | Searches through a list of players with a specified criteria
+playerSearchWith
+  :: (Player -> Bool)
+  -- ^ The search criteria
+  -> String
+  -- ^ The search string
+  -> [Player]
+  -- ^ The list of players to search
+  -> [(Int, Player)]
+  -- ^ The matching players with their index numbers
+playerSearchWith criteria sStr =
+  filter match . zip [0..]
+  where
+    match (_, p)
+      =  map toUpper sStr `isInfixOf` map toUpper (p^.pName)
+      && criteria p
+
 -- | Searches through a list of players
 playerSearch
   :: String
@@ -1006,9 +1030,17 @@ playerSearch
   -- ^ The list of players to search
   -> [(Int, Player)]
   -- ^ The matching players with their index numbers
-playerSearch sStr =
-  filter match . zip [0..]
-  where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
+playerSearch = playerSearchWith $ const True
+
+-- | Searches through a list of players for an active player
+activePlayerSearch
+  :: String
+  -- ^ The search string
+  -> [Player]
+  -- ^ The list of players to search
+  -> [(Int, Player)]
+  -- ^ The matching players with their index numbers
+activePlayerSearch = playerSearchWith (^.pActive)
 
 -- | Searches for a player by exact match on name
 playerSearchExact
@@ -1019,7 +1051,7 @@ playerSearchExact
   -> Maybe (Int, Player)
   -- ^ The player's index and value
 playerSearchExact sStr =
-  listToMaybe . filter match . zip [0..]
+  find match . zip [0..]
   where match (_, p) = p^.pName == sStr
 
 -- | Modifies a player with a given name
@@ -1063,6 +1095,23 @@ addPlayerStats s1 s2 = newPlayerStats
   & psAssists .~ s1^.psAssists + s2^.psAssists
   & psPMin    .~ s1^.psPMin + s2^.psPMin
 
+-- | Searches a list of goalies with a search criteria
+goalieSearchWith
+  :: (Goalie -> Bool)
+  -- ^ The search criteria
+  -> String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> [(Int, Goalie)]
+  -- ^ The search results with their corresponding index numbers
+goalieSearchWith criteria sStr =
+  filter match . zip [0..]
+  where
+    match (_, g)
+      =  map toUpper sStr `isInfixOf` map toUpper (g^.gName)
+      && criteria g
+
 -- | Searches a list of goalies
 goalieSearch
   :: String
@@ -1071,9 +1120,17 @@ goalieSearch
   -- ^ The list to search
   -> [(Int, Goalie)]
   -- ^ The search results with their corresponding index numbers
-goalieSearch sStr =
-  filter match . zip [0..]
-  where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
+goalieSearch = goalieSearchWith $ const True
+
+-- | Searches a list of goalies for an active goalie
+activeGoalieSearch
+  :: String
+  -- ^ The search string
+  -> [Goalie]
+  -- ^ The list to search
+  -> [(Int, Goalie)]
+  -- ^ The search results with their corresponding index numbers
+activeGoalieSearch = goalieSearchWith (^.gActive)
 
 -- | Searches a list of goalies for an exact match
 goalieSearchExact

src/Mtlstats/Types/Menu.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

src/Mtlstats/Util.hs

@@ -1,7 +1,7 @@
 {- |
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -22,6 +22,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 module Mtlstats.Util
   ( nth
   , modifyNth
+  , dropNth
   , updateMap
   , slice
   , capitalizeName
@@ -52,8 +53,21 @@ modifyNth
   -> [a]
   -- ^ The list
   -> [a]
-modifyNth n f = map (\(i, x) -> if i == n then f x else x)
-  . zip [0..]
+modifyNth n f = zipWith
+  (\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

test/Actions/EditStandingsSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/Actions/NewGame/GoalieInputSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -22,18 +22,16 @@ 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 "Mtlstats.Actions.GoalieInput" $ do
+spec = describe "GoalieInput" $ do
   finishGoalieEntrySpec
   recordGoalieStatsSpec
   setGameGoalieSpec
@@ -79,236 +77,229 @@ finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
     bobStats   = (1, newGoalieStats)
 
 recordGoalieStatsSpec :: Spec
-recordGoalieStatsSpec = describe "recordGoalieStats" $ let
-  goalieStats games mins goals = newGoalieStats
-    & gsGames        .~ games
-    & gsMinsPlayed   .~ mins
-    & gsGoalsAllowed .~ goals
+recordGoalieStatsSpec = describe "recordGoalieStats" $ mapM_
+  ( \(label, input, expected) ->
+    context label $ do
+      let ps = recordGoalieStats input
+      ps `TS.compareTest` expected
+  )
 
-  joe = newGoalie 2 "Joe"
-    & gYtd      .~ goalieStats 10 11 12
-    & gLifetime .~ goalieStats 20 21 22
+  [ ( "No goalie"
+    , noGoalie
+    , noGoalie
+    )
 
-  bob = newGoalie 3 "Bob"
-    & gYtd      .~ goalieStats 30 31 32
-    & gLifetime .~ goalieStats 40 41 42
+  , ( "Missing goalie"
+    , missingGoalie
+    , missingGoalie
+    )
+  ]
 
-  gameState n mins goals = newGameState
-    & gameGoalieStats      .~ M.fromList [(1, goalieStats 1 2 3)]
-    & gameSelectedGoalie   .~ n
-    & gameGoalieMinsPlayed .~ mins
-    & gameGoalsAllowed     .~ goals
+  where
+    noGoalie = defProgState
 
-  progState n mins goals = newProgState
-    & database.dbGoalies  .~ [joe, bob]
-    & progMode.gameStateL .~ gameState n mins goals
+    missingGoalie = defProgState
+      & progMode.gameStateL.gameSelectedGoalie ?~ 99
 
-  in mapM_
-    (\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
-      s = recordGoalieStats $ progState setGid mins goals
-      in context setName $ do
+    defProgState = newProgState
+      & progMode.gameStateL
+        %~ ( gameType  ?~ HomeGame )
+        .  ( homeScore ?~ 2        )
+        .  ( awayScore ?~ 1        )
+      & database.dbGoalies .~ [jim, bob, steve]
 
-        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
+    jim   = mkGoalie 2 "Jim"   1
+    bob   = mkGoalie 3 "Bob"   2
+    steve = mkGoalie 5 "Steve" 3
 
-              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
-      )
-    ]
+    mkGoalie num name n = newGoalie num name
+      & gYtd
+        %~ ( gsGames        .~ n     )
+        .  ( gsMinsPlayed   .~ n + 1 )
+        .  ( gsGoalsAllowed .~ n + 2 )
+        .  ( gsShutouts     .~ n + 3 )
+        .  ( gsWins         .~ n + 4 )
+        .  ( gsLosses       .~ n + 5 )
+        .  ( gsTies         .~ n + 6 )
+      & gLifetime
+        %~ ( gsGames        .~ n + 7  )
+        .  ( gsMinsPlayed   .~ n + 8  )
+        .  ( gsGoalsAllowed .~ n + 9  )
+        .  ( gsShutouts     .~ n + 10 )
+        .  ( gsWins         .~ n + 11 )
+        .  ( gsLosses       .~ n + 12 )
+        .  ( gsTies         .~ n + 13 )
 
 setGameGoalieSpec :: Spec
-setGameGoalieSpec = describe "setGameGoalie" $ let
+setGameGoalieSpec = describe "setGameGoalie" $ mapM_
 
-  goalieStats w l t = newGoalieStats
-    & gsWins   .~ w
-    & gsLosses .~ l
-    & gsTies   .~ t
+  (\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
+    context label $ do
 
-  bob = newGoalie 2 "Bob"
-    & gYtd      .~ goalieStats 10 11 12
-    & gLifetime .~ goalieStats 20 21 22
+      let
+        ps'          = setGameGoalie goalieId ps
+        [joe', bob'] = ps'^.database.dbGoalies
+        gStats'      = ps'^.progMode.gameStateL.gameGoalieStats
 
-  joe = newGoalie 3 "Joe"
-    & gYtd      .~ goalieStats 30 31 32
-    & gLifetime .~ goalieStats 40 41 42
+      context "Joe" $ joe' `TS.compareTest` expectedJoe
+      context "Bob" $ bob' `TS.compareTest` expectedBob
+      context "game stats" $ gStats' `TS.compareTest` expectedGStats)
 
-  gameState h a ot = newGameState
-    & gameType        ?~ HomeGame
-    & homeScore       ?~ h
-    & awayScore       ?~ a
-    & overtimeFlag    ?~ ot
+  [ ( "Joe wins - no shutout"
+    , 0
+    , psWin
+    , joeWin
+    , bob
+    , gsJoeWin
+    )
 
-  winningGame = gameState 1 0 False
-  losingGame  = gameState 0 1 False
-  tiedGame    = gameState 0 1 True
+  , ( "Bob wins - no shutout"
+    , 1
+    , psWin
+    , joe
+    , bobWin
+    , gsBobWin
+    )
 
-  in mapM_
-    (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
+  , ( "Joe wins - shutout"
+    , 0
+    , psWinSO
+    , joeWinSO
+    , bob
+    , gsJoeWinSO
+    )
 
-      progState = newProgState
-        & database.dbGoalies  .~ [bob, joe]
-        & progMode.gameStateL .~ gs
-        & setGameGoalie setGid
+  , ( "Bob wins - shutout"
+    , 1
+    , psWinSO
+    , joe
+    , bobWinSO
+    , gsBobWinSO
+    )
 
-      in mapM_
-        (\( chkLabel
-          , chkGid
-          , ( gWins
-            , gLosses
-            , gTies
-            , ytdWins
-            , ytdLosses
-            , ytdTies
-            , ltWins
-            , ltLosses
-            , ltTies
-            )
-          ) -> context chkLabel $ do
-            let
-              goalie = (progState^.database.dbGoalies) !! chkGid
-              gameStats = progState^.progMode.gameStateL.gameGoalieStats
-              game      = M.findWithDefault newGoalieStats chkGid gameStats
-              ytd       = goalie^.gYtd
-              lifetime  = goalie^.gLifetime
+  , ( "Joe loses"
+    , 0
+    , psLose
+    , joeLose
+    , bob
+    , gsJoeLose
+    )
 
-            mapM_
-              (\(label', expected, actual) -> context label' $
-                expected `TS.compareTest` actual)
-              [ ( "game stats",     game,     goalieStats gWins   gLosses   gTies   )
-              , ( "YTD stats",      ytd,      goalieStats ytdWins ytdLosses ytdTies )
-              , ( "lifetime stats", lifetime, goalieStats ltWins  ltLosses  ltTies  )
-              ]
+  , ( "Bob loses"
+    , 1
+    , psLose
+    , joe
+    , bobLose
+    , gsBobLose
+    )
 
-            it "should set the gameGoalieAssigned flag" $
-              progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
-        [ ( "checking Bob", 0, bobData )
-        , ( "checking Joe", 1, joeData )
-        ])
-    [ ( "Bob wins"
-      , winningGame
-      , 0
-      , ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
-      )
-    , ( "Bob loses"
-      , losingGame
-      , 0
-      , ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
-      )
-    , ( "Bob ties"
-      , tiedGame
-      , 0
-      , ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
-      )
-    , ( "Joe wins"
-      , winningGame
-      , 1
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
-      , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
-      )
-    , ( "Joe loses"
-      , losingGame
-      , 1
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
-      , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
-      )
-    , ( "Joe ties"
-      , tiedGame
-      , 1
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
-      , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
-      )
-    ]
+  , ( "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

test/Actions/NewGameSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -48,61 +48,31 @@ spec = describe "NewGame" $ do
   GoalieInput.spec
 
 overtimeCheckSpec :: Spec
-overtimeCheckSpec = describe "overtimeCheck" $ do
+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)
 
-  context "tie game" $ do
-    let
-      s = newProgState
-        & progMode.gameStateL
-          %~ (gameType  ?~ HomeGame)
-          .  (homeScore ?~ 1)
-          .  (awayScore ?~ 1)
-        & overtimeCheck
+        ps' = overtimeCheck ps
+        in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
 
-    it "should clear the home score" $
-      s^.progMode.gameStateL.homeScore `shouldBe` Nothing
+  --  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  )
+  ]
 
-    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
+  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

test/ActionsSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/FormatSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -141,9 +141,9 @@ labelTableSpec = describe "labelTable" $
       ]
 
     expected =
-      [ "   foo: bar"
+      [ "   foo: bar "
       , "   baz: quux"
-      , "longer: x"
+      , "longer: x   "
       ]
 
     in labelTable input `shouldBe` expected

test/HandlersSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/Helpers/GoalieSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -54,7 +54,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let
       .  ( gsTies         .~ 15 )
 
   expected = unlines
-    [ "Number: 1"
+    [ "Number: 1   "
     , "  Name: Joe*"
     , ""
     , "              YTD Lifetime"

test/Helpers/PlayerSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -50,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
         }
 
     expected = unlines
-      [ "  Number: 1"
-      , "    Name: Joe*"
+      [ "  Number: 1     "
+      , "    Name: Joe*  "
       , "Position: centre"
       , ""
       , "             YTD Lifetime"

test/Helpers/PositionSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/HelpersSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/ReportSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/Spec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/Types/MenuSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify

test/TypesSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
 
 module TypesSpec
   ( Comparable (..)
@@ -33,11 +33,19 @@ module TypesSpec
 import Control.Monad (replicateM)
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
+import qualified Data.Map.Lazy as M
 import qualified Data.HashMap.Strict as HM
 import Data.Ratio ((%))
 import Lens.Micro (Lens', (&), (^.), (.~), (?~))
 import System.Random (randomIO, randomRIO)
-import Test.Hspec (Spec, context, describe, it, shouldBe)
+import Test.Hspec
+  ( Spec
+  , context
+  , describe
+  , expectationFailure
+  , it
+  , shouldBe
+  )
 
 import Mtlstats.Config
 import Mtlstats.Types
@@ -72,6 +80,7 @@ spec = describe "Mtlstats.Types" $ do
   gmsPointsSpec
   addGameStatsSpec
   playerSearchSpec
+  activePlayerSearchSpec
   playerSearchExactSpec
   modifyPlayerSpec
   playerSummarySpec
@@ -79,6 +88,7 @@ spec = describe "Mtlstats.Types" $ do
   psPointsSpec
   addPlayerStatsSpec
   goalieSearchSpec
+  activeGoalieSearchSpec
   goalieSearchExactSpec
   goalieSummarySpec
   goalieIsActiveSpec
@@ -646,6 +656,19 @@ playerSearchSpec = describe "playerSearch" $ mapM_
   , ( "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 $
@@ -777,6 +800,28 @@ goalieSearchSpec = describe "goalieSearch" $ do
     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
@@ -934,74 +979,223 @@ 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 ProgState where
+  compareTest act expect = do
+    compareLenses "database"     database     act expect
+    compareLenses "progMode"     progMode     act expect
+    compareLenses "dbName"       dbName       act expect
+    compareLenses "inputBuffer"  inputBuffer  act expect
+    compareLenses "scrollOffset" scrollOffset act expect
+
+instance Comparable ProgMode where
+  compareTest TitleScreen TitleScreen = return ()
+  compareTest MainMenu    MainMenu    = return ()
+
+  compareTest (NewSeason act) (NewSeason expect) =
+    context "NewSeason flag" $
+      act `compareTest` expect
+
+  compareTest (NewGame act) (NewGame expect) =
+    context "NewGame GameState" $
+      act `compareTest` expect
+
+  compareTest EditMenu EditMenu = return ()
+
+  compareTest (CreatePlayer act) (CreatePlayer expect) =
+    context "CreatePlayer CreatePlayerState" $
+      act `compareTest` expect
+
+  compareTest (CreateGoalie act) (CreateGoalie expect) =
+    context "CreateGoalie CreateGoalieState" $
+      act `compareTest` expect
+
+  compareTest (EditPlayer act) (EditPlayer expect) =
+    context "EditPlayer EditPlayerState" $
+      act `compareTest` expect
+
+  compareTest (EditGoalie act) (EditGoalie expect) =
+    context "EditGoalie EditGoalieState" $
+      act `compareTest` expect
+
+  compareTest (EditStandings act) (EditStandings expect) =
+    context "EditStandings EditStandingsMode" $
+      act `compareTest` expect
+
+  compareTest _ _ = it "should be the expected mode" $
+    expectationFailure "ProgMode mismatch"
 
 instance Comparable GameState where
-  compareTest actual expected =
-    it ("should be " ++ show expected) $
-      actual `shouldBe` expected
+  compareTest act expect = do
+    compareLenses "gameYear"             gameYear             act expect
+    compareLenses "gameMonth"            gameMonth            act expect
+    compareLenses "gameDay"              gameDay              act expect
+    compareLenses "gameType"             gameType             act expect
+    compareLenses "otherTeam"            otherTeam            act expect
+    compareLenses "homeScore"            homeScore            act expect
+    compareLenses "awayScore"            awayScore            act expect
+    compareLenses "overtimeFlag"         overtimeFlag         act expect
+    compareLenses "dataVerified"         dataVerified         act expect
+    compareLenses "pointsAccounted"      pointsAccounted      act expect
+    compareLenses "goalBy"               goalBy               act expect
+    compareLenses "assistsBy"            assistsBy            act expect
+    compareLenses "gamePlayerStats"      gamePlayerStats      act expect
+    compareLenses "confirmGoalDataGlag"  confirmGoalDataFlag  act expect
+    compareLenses "gameSelectedPlayer"   gameSelectedPlayer   act expect
+    compareLenses "gamePMinsRecorded"    gamePMinsRecorded    act expect
+    compareLenses "gameGoalieStats"      gameGoalieStats      act expect
+    compareLenses "gameSelectedGoalie"   gameSelectedGoalie   act expect
+    compareLenses "gameGoalieMinsPlayed" gameGoalieMinsPlayed act expect
+    compareLenses "gameGoalsAllowed"     gameGoalsAllowed     act expect
+    compareLenses "gameGoaliesRecorded"  gameGoaliesRecorded  act expect
+    compareLenses "gameGoalieAssigned"   gameGoalieAssigned   act expect
+
+instance Comparable Database where
+  compareTest act expect = do
+    compareLenses "dbPlayers"       dbPlayers       act expect
+    compareLenses "dbGoalies"       dbGoalies       act expect
+    compareLenses "dbGames"         dbGames         act expect
+    compareLenses "dbHomeGameStats" dbHomeGameStats act expect
+    compareLenses "dbAwayGameStats" dbAwayGameStats act expect
+
+instance Comparable Player where
+  compareTest act expect = do
+    compareLenses "pNumber"   pNumber   act expect
+    compareLenses "pName"     pName     act expect
+    compareLenses "pPosition" pPosition act expect
+    compareLenses "pRookie"   pRookie   act expect
+    compareLenses "pActive"   pActive   act expect
+    compareLenses "pYtd"      pYtd      act expect
+    compareLenses "pLifetime" pLifetime act expect
+
+instance Comparable [Player] where
+  compareTest = compareLists
+
+instance Comparable PlayerStats where
+  compareTest act expect = do
+    compareLenses "psGoals"   psGoals   act expect
+    compareLenses "psAssists" psAssists act expect
+    compareLenses "psPMin"    psPMin    act expect
+
+instance Comparable Goalie where
+  compareTest act expect = do
+    compareLenses "gNumber"   gNumber   act expect
+    compareLenses "gName"     gName     act expect
+    compareLenses "gRookie"   gRookie   act expect
+    compareLenses "gActive"   gActive   act expect
+    compareLenses "gYtd"      gYtd      act expect
+    compareLenses "gLifetime" gLifetime act expect
+
+instance Comparable [Goalie] where
+  compareTest = compareLists
+
+instance Comparable GoalieStats where
+  compareTest act expect = do
+    compareLenses "gsGames"        gsGames        act expect
+    compareLenses "gsMisPlayed"    gsMinsPlayed   act expect
+    compareLenses "gsGoalsAllowed" gsGoalsAllowed act expect
+    compareLenses "gsWins"         gsWins         act expect
+    compareLenses "gsLosses"       gsLosses       act expect
+    compareLenses "gsTies"         gsTies         act expect
+
+instance Comparable GameStats where
+  compareTest act expect = do
+    compareLenses "gmsWins"         gmsWins         act expect
+    compareLenses "gmsLosses"       gmsLosses       act expect
+    compareLenses "gmsOvertime"     gmsOvertime     act expect
+    compareLenses "gmsGoalsFor"     gmsGoalsFor     act expect
+    compareLenses "gmsGoalsAgainst" gmsGoalsAgainst act expect
+
+instance Comparable GameType where
+  compareTest = compareVals
 
 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
+  compareTest act expect = do
+    compareLenses "cpsNumber"   cpsNumber   act expect
+    compareLenses "cpsName"     cpsName     act expect
+    compareLenses "cpsPosition" cpsPosition act expect
 
 instance Comparable EditPlayerState where
-  compareTest actual expected = do
+  compareTest act expect = do
+    compareLenses "epsSelectedPlayer" epsSelectedPlayer act expect
+    compareLenses "epsMode"           epsMode           act expect
 
-    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 EditPlayerMode where
+  compareTest = compareVals
 
 instance Comparable EditGoalieState where
-  compareTest actual expected = do
+  compareTest act expect = do
+    compareLenses "egsSelectedGoalie" egsSelectedGoalie act expect
+    compareLenses "egsMode"           egsMode           act expect
 
-    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 EditGoalieMode where
+  compareTest = compareVals
 
 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
+  compareTest act expect = do
+    compareLenses "cgsNumber" cgsNumber act expect
+    compareLenses "cgsName"   cgsName   act expect
 
 instance Comparable EditStandingsMode where
-  compareTest actual expected =
-    it ("should be " ++ show expected) $
-      actual `shouldBe` expected
+  compareTest = compareVals
+
+instance  Comparable Int where
+  compareTest = compareVals
+
+instance Comparable Bool where
+  compareTest = compareVals
+
+instance Comparable String where
+  compareTest = compareVals
+
+instance Comparable [Int] where
+  compareTest = compareLists
+
+instance Comparable a => Comparable (Maybe a) where
+  compareTest Nothing  Nothing  = return ()
+  compareTest (Just a) (Just e) = a `compareTest` e
+  compareTest Nothing  (Just _) = error "Unexpectedly received a value"
+  compareTest (Just _) Nothing  = error "Received Nothing"
+
+instance (Ord k, Show k, Comparable v) => Comparable (M.Map k v) where
+  compareTest actM expectM = do
+    context "number of elements" $
+      length actM `compareVals` length expectM
+
+    context "check values" $
+      mapM_
+        ( \k -> context (show k) $
+          M.lookup k actM `compareTest` M.lookup k expectM
+        ) $ M.keys actM
+
+compareLists :: (Comparable a) => [a] -> [a] -> Spec
+compareLists acts expects = do
+    let
+      aLen = length acts
+      eLen = length expects
+
+    context "count elements" $
+      it ("should be " ++ show eLen) $
+        aLen `shouldBe` eLen
+
+    context "compare elements" $
+      mapM_
+        ( \(n, act, expect) ->
+          context ("element " ++ show n) $
+            expect `compareTest` act
+        ) $ zip3 ([0..] :: [Int]) acts expects
+
+compareVals :: (Eq a, Show a) => a -> a -> Spec
+compareVals expect act =
+  it ("should be " ++ show expect) $
+    act `shouldBe` expect
+
+compareLenses
+  :: Comparable b
+  => String
+  -> Lens' a b
+  -> a
+  -> a
+  -> Spec
+compareLenses label lens act expect =
+  describe label $
+    (act^.lens) `compareTest` (expect^.lens)

test/UtilSpec.hs

@@ -1,7 +1,7 @@
 {-
 
 mtlstats
-Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
+Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
 <rheal.lamothe@gmail.com>
 
 This program is free software: you can redistribute it and/or modify
@@ -30,6 +30,7 @@ spec :: Spec
 spec = describe "Mtlstats.Util" $ do
   nthSpec
   modifyNthSpec
+  dropNthSpec
   updateMapSpec
   sliceSpec
   capitalizeNameSpec
@@ -64,6 +65,20 @@ modifyNthSpec = describe "modifyNth" $ do
     it "should not modify the value" $
       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
   let

vagrant/as_user.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+
+echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc
+mkdir /vagrant/data
+ln -s /vagrant/data ~vagrant/.mtlstats
+
+cd /vagrant
+stack install

vagrant/provision.sh

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+apt-get update
+apt-get upgrade
+apt-get -y install libghc-ncurses-dev
+wget -qO- https://get.haskellstack.org/ | sh
+
+export HOME=/home/vagrant
+
+sudo -u vagrant /vagrant/vagrant/as_user.sh