version 0.2.0

load/save database

ChangeLog.md

@@ -1,3 +1,9 @@
 # Changelog for mtlstats
 
-## Unreleased changes
+## v0.2.0
+
+- Overtime losses don't count in the loss column
+- Confirm game data with user before updating stats
+- Implemented player creation
+- Goal points are now assigned to players
+- Loading/saving of database

package.yaml

@@ -1,5 +1,5 @@
 name:                mtlstats
-version:             0.1.0
+version:             0.2.0
 github:              "mtlstats/mtlstats"
 license:             GPL-3
 author:              "Jonathan Lamothe"
@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/jlam
 dependencies:
 - base >= 4.7 && < 5
 - aeson >= 1.4.4.0 && < 1.5
+- easy-file >= 0.2.2 && < 0.3
 - extra >= 1.6.17 && < 1.7
 - microlens-th >= 0.4.2.3 && < 0.5
 - ncurses >= 0.2.16 && < 0.3

src/Mtlstats.hs

@@ -19,15 +19,23 @@ 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.Maybe (fromJust)
+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
 
@@ -36,7 +44,15 @@ initState :: C.Curses ProgState
 initState = do
   C.setEcho False
   void $ C.setCursorMode C.CursorInvisible
-  return newProgState
+  db <- liftIO $ do
+    dir <- getAppUserDataDirectory appName
+    let dbFile = dir </> dbFname
+    fromMaybe newDatabase <$> catch
+      (decodeFileStrict dbFile)
+      (\(_ :: IOException) -> return Nothing)
+  return
+    $ newProgState
+    & database .~ db
 
 -- | Main program loop
 mainLoop :: Action ()

src/Mtlstats/Actions.hs

@@ -30,8 +30,12 @@ module Mtlstats.Actions
   , overtimeCheck
   , updateGameStats
   , validateGameDate
+  , createPlayer
+  , addPlayer
+  , awardGoal
   ) where
 
+import Control.Monad.Trans.State (modify)
 import Data.Maybe (fromMaybe)
 import Data.Time.Calendar (fromGregorianValid)
 import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
@@ -111,3 +115,40 @@ validateGameDate s = fromMaybe s $ do
       .  (gameMonth .~ Nothing)
       .  (gameDay   .~ Nothing)
     else s
+
+-- | Starts player creation mode
+createPlayer :: ProgState -> ProgState
+createPlayer = let
+  cb = modify $ progMode .~ MainMenu
+  cps
+    = newCreatePlayerState
+    & cpsSuccessCallback .~ cb
+    & cpsFailureCallback .~ cb
+  in progMode .~ CreatePlayer cps
+
+-- | Adds the entered player to the roster
+addPlayer :: ProgState -> ProgState
+addPlayer s = fromMaybe s $ do
+  let cps = s^.progMode.createPlayerStateL
+  num <- cps^.cpsNumber
+  let
+    name   = cps^.cpsName
+    pos    = cps^.cpsPosition
+    player = newPlayer num name pos
+  Just $ s & database.dbPlayers
+    %~ (player:)
+
+-- | Awards a goal to a player
+awardGoal
+  :: Int
+  -- ^ The player's index number
+  -> ProgState
+  -> ProgState
+awardGoal n ps = ps
+  &  database.dbPlayers
+  %~ map
+     (\(i, p) -> if i == n
+       then p
+         & pYtd.psGoals      %~ succ
+         & pLifetime.psGoals %~ succ
+       else p) . zip [0..]

src/Mtlstats/Config.hs

@@ -24,3 +24,15 @@ module Mtlstats.Config where
 -- | The name of the team whose stats we're tracking
 myTeam :: String
 myTeam = "MONTREAL"
+
+-- | The maximum number of function keys
+maxFunKeys :: Int
+maxFunKeys = 9
+
+-- | The application name
+appName :: String
+appName = "mtlstats"
+
+-- | The database filename
+dbFname :: String
+dbFname = "database.json"

src/Mtlstats/Control.hs

@@ -21,14 +21,17 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (when)
-import Control.Monad.Trans.State (modify)
+import Control.Monad (join, when)
+import Control.Monad.Trans.State (gets, modify)
 import Data.Char (toUpper)
+import Data.Maybe (fromJust)
 import Lens.Micro ((^.), (.~))
+import Lens.Micro.Extras (view)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
 import Mtlstats.Format
+import Mtlstats.Handlers
 import Mtlstats.Menu
 import Mtlstats.Prompt
 import Mtlstats.Report
@@ -38,121 +41,220 @@ import Mtlstats.Types
 -- run
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-
-  MainMenu -> Controller
-    { drawController   = const $ drawMenu mainMenu
-    , handleController = menuHandler mainMenu
-    }
-
-  NewSeason -> Controller
-    { drawController   = const $ drawMenu newSeasonMenu
-    , handleController = \e -> do
-      menuHandler newSeasonMenu e
-      return True
-    }
-
+  MainMenu  -> mainMenuC
+  NewSeason -> newSeasonC
   NewGame 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) -> recordGoalC
+    | otherwise                       -> reportC
+  CreatePlayer cps
+    | null $ cps^.cpsNumber   -> getPlayerNumC
+    | null $ cps^.cpsName     -> getPlayerNameC
+    | null $ cps^.cpsPosition -> getPlayerPosC
+    | otherwise               -> confirmCreatePlayerC
 
-    | null $ gs^.gameYear -> Controller
-      { drawController = \s -> do
-        header s
-        drawPrompt gameYearPrompt s
-      , handleController = \e -> do
-        promptHandler gameYearPrompt e
-        return True
-      }
+mainMenuC :: Controller
+mainMenuC = Controller
+  { drawController   = const $ drawMenu mainMenu
+  , handleController = menuHandler mainMenu
+  }
 
-    | null $ gs^.gameMonth -> Controller
-      { drawController = \s -> do
-        header s
-        drawMenu gameMonthMenu
-      , handleController = \e -> do
-        menuHandler gameMonthMenu e
-        return True
-      }
+newSeasonC :: Controller
+newSeasonC = Controller
+  { drawController   = const $ drawMenu newSeasonMenu
+  , handleController = \e -> do
+    menuHandler newSeasonMenu e
+    return True
+  }
 
-    | null $ gs^.gameDay -> Controller
-      { drawController = \s -> do
-        header s
-        drawPrompt gameDayPrompt s
-      , handleController = \e -> do
-        promptHandler gameDayPrompt e
-        modify validateGameDate
-        return True
-      }
+gameYearC :: Controller
+gameYearC = Controller
+  { drawController = \s -> do
+    header s
+    drawPrompt gameYearPrompt s
+  , handleController = \e -> do
+    promptHandler gameYearPrompt e
+    return True
+  }
 
-    | null $ gs^.gameType -> Controller
-      { drawController = \s -> do
-        header s
-        drawMenu gameTypeMenu
-      , handleController = \e -> do
-        menuHandler gameTypeMenu e
-        return True
-      }
+gameMonthC :: Controller
+gameMonthC = Controller
+  { drawController = \s -> do
+    header s
+    drawMenu gameMonthMenu
+  , handleController = \e -> do
+    menuHandler gameMonthMenu e
+    return True
+  }
 
-    | null $ gs^.otherTeam -> Controller
-      { drawController = \s -> do
-        header s
-        drawPrompt otherTeamPrompt s
-      , handleController = \e -> do
-        promptHandler otherTeamPrompt 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
+  }
 
-    | null $ gs^.homeScore -> Controller
-      { drawController = \s -> do
-        header s
-        drawPrompt homeScorePrompt s
-      , handleController = \e -> do
-        promptHandler homeScorePrompt e
-        return True
-      }
+gameTypeC :: Controller
+gameTypeC = Controller
+  { drawController = \s -> do
+    header s
+    drawMenu gameTypeMenu
+  , handleController = \e -> do
+    menuHandler gameTypeMenu e
+    return True
+  }
 
-    | null $ gs^.awayScore -> Controller
-      { drawController = \s -> do
-        header s
-        drawPrompt awayScorePrompt s
-      , handleController = \e -> do
-        promptHandler awayScorePrompt e
-        modify overtimeCheck
+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
-        return True
-      }
+      Just False -> modify $ progMode.gameStateL .~ newGameState
+      Nothing    -> return ()
+    return True
+  }
 
-    | null $ gs^.overtimeFlag -> Controller
-      { drawController = \s -> do
-        header s
-        C.drawString "Did the game go into overtime?  (Y/N)"
-        return C.CursorInvisible
-      , handleController = \e -> do
-        overtimePrompt e
-        modify updateGameStats
-        return True
-      }
+recordGoalC :: Controller
+recordGoalC = Controller
+  { drawController = \s -> let
+    game = s^.database.dbGames
+    goal = succ $ s^.progMode.gameStateL.pointsAccounted
+    in drawPrompt (recordGoalPrompt game goal) s
+  , handleController = \e -> do
+    game <- gets $ view $ database.dbGames
+    goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
+    promptHandler (recordGoalPrompt game goal) e
+    return True
+  }
 
-    | otherwise -> Controller
-      { drawController = \s -> do
-        (_, cols) <- C.windowSize
-        C.drawString $ report (fromInteger $ pred cols) s
-        return C.CursorInvisible
-      , handleController = \e -> do
-        when
-          (case e of
-            C.EventCharacter _  -> True
-            C.EventSpecialKey _ -> True
-            _                   -> False) $
-          modify $ progMode .~ MainMenu
-        return True
-      }
+reportC :: Controller
+reportC = Controller
+  { drawController = \s -> do
+    (_, cols) <- C.windowSize
+    C.drawString $ report (fromInteger $ pred cols) s
+    return C.CursorInvisible
+  , handleController = \e -> do
+    when
+      (case e of
+        C.EventCharacter _  -> True
+        C.EventSpecialKey _ -> True
+        _                   -> False) $
+      modify $ progMode .~ MainMenu
+    return True
+  }
 
 header :: ProgState -> C.Update ()
 header s = C.drawString $
   "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
 
-overtimePrompt :: C.Event -> Action ()
-overtimePrompt (C.EventCharacter c) = modify $
-  progMode.gameStateL.overtimeFlag .~ case toUpper c of
-    'Y' -> Just True
-    'N' -> Just False
-    _   -> Nothing
-overtimePrompt _ = return ()
+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
+  }

src/Mtlstats/Handlers.hs

@@ -0,0 +1,33 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Handlers (ynHandler) where
+
+import Data.Char (toUpper)
+import qualified UI.NCurses as C
+
+-- | Handler for a yes/no prompt
+ynHandler :: C.Event -> Maybe Bool
+ynHandler (C.EventCharacter c) = case toUpper c of
+  'Y' -> Just True
+  'N' -> Just False
+  _   -> Nothing
+ynHandler _ = Nothing

src/Mtlstats/Menu.hs

@@ -30,12 +30,21 @@ module Mtlstats.Menu (
   gameTypeMenu
 ) where
 
-import Control.Monad.Trans.State (modify)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.State (gets, modify)
+import Data.Aeson (encodeFile)
 import Data.Char (toUpper)
 import Lens.Micro ((^.), (.~), (?~))
+import Lens.Micro.Extras (view)
+import System.EasyFile
+  ( createDirectoryIfMissing
+  , getAppUserDataDirectory
+  , (</>)
+  )
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Config
 import Mtlstats.Types
 import Mtlstats.Types.Menu
 
@@ -60,7 +69,15 @@ mainMenu = Menu "*** MAIN MENU ***" True
     modify startNewSeason >> return True
   , MenuItem '2' "New Game" $
     modify startNewGame >> return True
-  , MenuItem '3' "Exit" $
+  , MenuItem '3' "Create Player" $
+    modify createPlayer >> return True
+  , MenuItem '4' "Exit" $ do
+    db <- gets $ view database
+    liftIO $ do
+      dir <- getAppUserDataDirectory appName
+      let dbFile = dir </> dbFname
+      createDirectoryIfMissing True dir
+      encodeFile dbFile db
     return False
   ]
 

src/Mtlstats/Prompt.hs

@@ -19,6 +19,8 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Mtlstats.Prompt (
   -- * Prompt Functions
   drawPrompt,
@@ -30,20 +32,28 @@ module Mtlstats.Prompt (
   gameDayPrompt,
   otherTeamPrompt,
   homeScorePrompt,
-  awayScorePrompt
+  awayScorePrompt,
+  playerNumPrompt,
+  playerNamePrompt,
+  playerPosPrompt,
+  selectPlayerPrompt,
+  recordGoalPrompt,
 ) where
 
 import Control.Monad (when)
 import Control.Monad.Trans.State (gets, modify)
 import Data.Char (isDigit, toUpper)
 import Data.Foldable (forM_)
-import Lens.Micro ((^.), (.~), (?~))
+import Lens.Micro ((^.), (&), (.~), (?~), (%~))
 import Lens.Micro.Extras (view)
 import Text.Read (readMaybe)
 import qualified UI.NCurses as C
 
 import Mtlstats.Actions
+import Mtlstats.Config
+import Mtlstats.Format
 import Mtlstats.Types
+import Mtlstats.Util
 
 -- | Draws the prompt to the screen
 drawPrompt :: Prompt -> ProgState -> C.Update C.CursorMode
@@ -63,8 +73,8 @@ promptHandler p (C.EventCharacter c) = let
    modify $ addChar c'
 promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
   modify removeChar
-promptHandler p (C.EventSpecialKey (C.KeyFunction k)) =
-  promptFunctionKey p k
+promptHandler p (C.EventSpecialKey k) =
+  promptSpecialKey p k
 promptHandler _ _ = return ()
 
 -- | Builds a string prompt
@@ -75,10 +85,10 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
-  , promptCharCheck   = const True
-  , promptAction      = act
-  , promptFunctionKey = const $ return ()
+  { promptDrawer     = drawSimplePrompt pStr
+  , promptCharCheck  = const True
+  , promptAction     = act
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Builds a numeric prompt
@@ -89,10 +99,10 @@ numPrompt
   -- ^ The callback function for the result
   -> Prompt
 numPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
-  , promptCharCheck   = isDigit
-  , promptAction      = \inStr -> forM_ (readMaybe inStr) act
-  , promptFunctionKey = const $ return ()
+  { promptDrawer     = drawSimplePrompt pStr
+  , promptCharCheck  = isDigit
+  , promptAction     = \inStr -> forM_ (readMaybe inStr) act
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Prompts for the game year
@@ -120,5 +130,88 @@ awayScorePrompt :: Prompt
 awayScorePrompt = numPrompt "Away score: " $
   modify . (progMode.gameStateL.awayScore ?~)
 
+-- | Prompts for a new player's number
+playerNumPrompt :: Prompt
+playerNumPrompt = numPrompt "Player number: " $
+  modify . (progMode.createPlayerStateL.cpsNumber ?~)
+
+-- | Prompts for a new player's name
+playerNamePrompt :: Prompt
+playerNamePrompt = strPrompt "Player name: " $
+  modify . (progMode.createPlayerStateL.cpsName .~)
+
+-- | Prompts for a new player's position
+playerPosPrompt :: Prompt
+playerPosPrompt = strPrompt "Player position: " $
+  modify . (progMode.createPlayerStateL.cpsPosition .~)
+
+-- | 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 pStr callback = Prompt
+  { promptDrawer = \s -> do
+    let sStr = s^.inputBuffer
+    C.drawString pStr
+    C.drawString sStr
+    (row, col) <- C.cursorPosition
+    C.drawString "\n\nPlayer select:\n"
+    let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
+    mapM_
+      (\(n, (_, p)) -> C.drawString $
+        "F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
+      sel
+    C.moveCursor row col
+  , promptCharCheck = const True
+  , promptAction = \sStr -> do
+    players <- gets $ view $ database.dbPlayers
+    case playerSearchExact sStr players of
+      Just (n, _) -> callback $ Just n
+      Nothing -> do
+        mode <- gets $ view progMode
+        let
+          cps
+            = newCreatePlayerState
+            & cpsName .~ sStr
+            & cpsSuccessCallback .~ do
+              modify $ progMode .~ mode
+              callback (Just 0)
+            & cpsFailureCallback .~ do
+              modify $ progMode .~ mode
+              callback Nothing
+        modify $ progMode .~ CreatePlayer cps
+  , 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
+recordGoalPrompt
+  :: Int
+  -- ^ The game number
+  -> Int
+  -- ^ The goal number
+  -> Prompt
+recordGoalPrompt game goal = selectPlayerPrompt
+  ("*** GAME " ++ padNum 2 game ++ " ***\n" ++
+   "Who scored goal number " ++ show goal ++ "? ") $
+  \case
+    Nothing -> return ()
+    Just n  -> modify
+      $ awardGoal n
+      . (progMode.gameStateL.pointsAccounted %~ succ)
+
 drawSimplePrompt :: String -> ProgState -> C.Update ()
 drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Report.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-module Mtlstats.Report (report) where
+module Mtlstats.Report (report, gameDate) where
 
 import Data.Maybe (fromMaybe)
 import Lens.Micro ((^.))
@@ -40,6 +40,7 @@ report width s = unlines $ fromMaybe [] $ do
     db     = s^.database
     gs     = s^.progMode.gameStateL
     gNum   = db^.dbGames
+    date   = gameDate gs
     hTeam  = homeTeam gs
     aTeam  = awayTeam gs
     hStats = db^.dbHomeGameStats
@@ -47,10 +48,6 @@ report width s = unlines $ fromMaybe [] $ do
     tStats = addGameStats hStats aStats
   hScore <- gs^.homeScore
   aScore <- gs^.awayScore
-  month  <- month <$> gs^.gameMonth
-  day    <- padNum 2 <$> gs^.gameDay
-  year   <- show <$> gs^.gameYear
-  let date = month ++ " " ++ day ++ " " ++ year
   Just
     [ overlay
       ("GAME NUMBER " ++ padNum 2 gNum)
@@ -81,6 +78,13 @@ report width s = unlines $ fromMaybe [] $ do
       ++ showStats tStats
     ]
 
+gameDate :: GameState -> String
+gameDate gs = fromMaybe "" $ do
+  year  <- show <$> gs^.gameYear
+  month <- month <$> gs^.gameMonth
+  day   <- padNum 2 <$> gs^.gameDay
+  Just $ month ++ " " ++ day ++ " " ++ year
+
 showStats :: GameStats -> String
 showStats gs
   =  right 2 (show $ gmsGames gs)

src/Mtlstats/Types.hs

@@ -26,9 +26,10 @@ module Mtlstats.Types (
   Controller (..),
   Action,
   ProgState (..),
-  GameState (..),
   ProgMode (..),
+  GameState (..),
   GameType (..),
+  CreatePlayerState (..),
   Database (..),
   Player (..),
   PlayerStats (..),
@@ -43,6 +44,7 @@ module Mtlstats.Types (
   inputBuffer,
   -- ** ProgMode Lenses
   gameStateL,
+  createPlayerStateL,
   -- ** GameState Lenses
   gameYear,
   gameMonth,
@@ -52,6 +54,14 @@ module Mtlstats.Types (
   homeScore,
   awayScore,
   overtimeFlag,
+  dataVerified,
+  pointsAccounted,
+  -- ** CreatePlayerState Lenses
+  cpsNumber,
+  cpsName,
+  cpsPosition,
+  cpsSuccessCallback,
+  cpsFailureCallback,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -88,6 +98,7 @@ module Mtlstats.Types (
   -- * Constructors
   newProgState,
   newGameState,
+  newCreatePlayerState,
   newDatabase,
   newPlayer,
   newPlayerStats,
@@ -103,12 +114,15 @@ module Mtlstats.Types (
   gameWon,
   gameLost,
   gameTied,
+  unaccountedPoints,
   -- ** GameStats Helpers
   gmsGames,
   gmsPoints,
   addGameStats,
   -- ** Player Helpers
-  pPoints
+  pPoints,
+  playerSearch,
+  playerSearchExact
 ) where
 
 import Control.Monad.Trans.State (StateT)
@@ -124,6 +138,8 @@ import Data.Aeson
   , (.:)
   , (.=)
   )
+import Data.List (isInfixOf)
+import Data.Maybe (listToMaybe)
 import Lens.Micro (Lens', lens, (&), (^.), (.~))
 import Lens.Micro.TH (makeLenses)
 import qualified UI.NCurses as C
@@ -149,34 +165,43 @@ data ProgState = ProgState
   -- ^ The program's mode
   , _inputBuffer :: String
   -- ^ Buffer for user input
-  } deriving (Eq, Show)
-
--- | The game state
-data GameState = GameState
-  { _gameYear     :: Maybe Int
-  -- ^ The year the game took place
-  , _gameMonth    :: Maybe Int
-  -- ^ The month the game took place
-  , _gameDay      :: Maybe Int
-  -- ^ The day of the month the game took place
-  , _gameType     :: Maybe GameType
-  -- ^ The type of game (home/away)
-  , _otherTeam    :: String
-  -- ^ The name of the other team
-  , _homeScore    :: Maybe Int
-  -- ^ The home team's score
-  , _awayScore    :: Maybe Int
-  -- ^ The away team's score
-  , _overtimeFlag :: Maybe Bool
-  -- ^ Indicates whether or not the game went into overtime
-  } deriving (Eq, Show)
+  }
 
 -- | The program mode
 data ProgMode
   = MainMenu
   | NewSeason
   | NewGame GameState
-  deriving (Eq, Show)
+  | CreatePlayer CreatePlayerState
+
+instance Show ProgMode where
+  show MainMenu         = "MainMenu"
+  show NewSeason        = "NewSeason"
+  show (NewGame _)      = "NewGame"
+  show (CreatePlayer _) = "CreatePlayer"
+
+-- | The game state
+data GameState = GameState
+  { _gameYear        :: Maybe Int
+  -- ^ The year the game took place
+  , _gameMonth       :: Maybe Int
+  -- ^ The month the game took place
+  , _gameDay         :: Maybe Int
+  -- ^ The day of the month the game took place
+  , _gameType        :: Maybe GameType
+  -- ^ The type of game (home/away)
+  , _otherTeam       :: String
+  -- ^ The name of the other team
+  , _homeScore       :: Maybe Int
+  -- ^ The home team's score
+  , _awayScore       :: Maybe Int
+  -- ^ The away team's score
+  , _overtimeFlag    :: Maybe Bool
+  -- ^ Indicates whether or not the game went into overtime
+  , _dataVerified    :: Bool
+  -- ^ Set to 'True' when the user confirms the entered data
+  , _pointsAccounted :: Int
+  } deriving (Eq, Show)
 
 -- | The type of game
 data GameType
@@ -184,6 +209,20 @@ data GameType
   | AwayGame
   deriving (Eq, Show)
 
+-- | Player creation status
+data CreatePlayerState = CreatePlayerState
+  { _cpsNumber          :: Maybe Int
+  -- ^ The player's number
+  , _cpsName            :: String
+  -- ^ The player's name
+  , _cpsPosition        :: String
+  -- ^ The player's position
+  , _cpsSuccessCallback :: Action ()
+  -- ^ The function to call on success
+  , _cpsFailureCallback :: Action ()
+  -- ^ The function to call on failure
+  }
+
 -- | Represents the database
 data Database = Database
   { _dbPlayers       :: [Player]
@@ -393,18 +432,19 @@ instance ToJSON GameStats where
 
 -- | Defines a user prompt
 data Prompt = Prompt
-  { promptDrawer      :: ProgState -> C.Update ()
+  { promptDrawer     :: ProgState -> C.Update ()
   -- ^ Draws the prompt to thr screen
-  , promptCharCheck   :: Char -> Bool
+  , promptCharCheck  :: Char -> Bool
   -- ^ Determines whether or not the character is valid
-  , promptAction      :: String -> Action ()
+  , promptAction     :: String -> Action ()
   -- ^ Action to perform when the value is entered
-  , promptFunctionKey :: Integer -> Action ()
-  -- ^ Action to perform when a function key is pressed
+  , promptSpecialKey :: C.Key -> Action ()
+  -- ^ Action to perform when a special key is pressed
   }
 
 makeLenses ''ProgState
 makeLenses ''GameState
+makeLenses ''CreatePlayerState
 makeLenses ''Database
 makeLenses ''Player
 makeLenses ''PlayerStats
@@ -419,6 +459,13 @@ gameStateL = lens
     _          -> newGameState)
   (\_ gs -> NewGame gs)
 
+createPlayerStateL :: Lens' ProgMode CreatePlayerState
+createPlayerStateL = lens
+  (\case
+    CreatePlayer cps -> cps
+    _                -> newCreatePlayerState)
+  (\_ cps -> CreatePlayer cps)
+
 -- | Constructor for a 'ProgState'
 newProgState :: ProgState
 newProgState = ProgState
@@ -430,14 +477,26 @@ newProgState = ProgState
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameYear     = Nothing
-  , _gameMonth    = Nothing
-  , _gameDay      = Nothing
-  , _gameType     = Nothing
-  , _otherTeam    = ""
-  , _homeScore    = Nothing
-  , _awayScore    = Nothing
-  , _overtimeFlag = Nothing
+  { _gameYear        = Nothing
+  , _gameMonth       = Nothing
+  , _gameDay         = Nothing
+  , _gameType        = Nothing
+  , _otherTeam       = ""
+  , _homeScore       = Nothing
+  , _awayScore       = Nothing
+  , _overtimeFlag    = Nothing
+  , _dataVerified    = False
+  , _pointsAccounted = 0
+  }
+
+-- | Constructor for a 'CreatePlayerState'
+newCreatePlayerState :: CreatePlayerState
+newCreatePlayerState = CreatePlayerState
+  { _cpsNumber          = Nothing
+  , _cpsName            = ""
+  , _cpsPosition        = ""
+  , _cpsSuccessCallback = return ()
+  , _cpsFailureCallback = return ()
   }
 
 -- | Constructor for a 'Database'
@@ -545,15 +604,26 @@ gameWon gs = (>) <$> teamScore gs <*> otherScore gs
 
 -- | Checks if the game was lost
 gameLost :: GameState -> Maybe Bool
-gameLost gs = (<) <$> teamScore gs <*> otherScore gs
+gameLost gs = do
+  ot    <- gs^.overtimeFlag
+  team  <- teamScore gs
+  other <- otherScore gs
+  Just $ not ot && other > team
 
 -- | Checks if the game has tied
 gameTied :: GameState -> Maybe Bool
 gameTied gs = (==) <$> gs^.homeScore <*> gs^.awayScore
 
+-- | Checks for unaccounted points
+unaccountedPoints :: GameState -> Maybe Bool
+unaccountedPoints gs = do
+  scored <- teamScore gs
+  let accounted = gs^.pointsAccounted
+  Just $ scored > accounted
+
 -- | Calculates the number of games played
 gmsGames :: GameStats -> Int
-gmsGames gs = gs^.gmsWins + gs^.gmsLosses
+gmsGames gs = gs^.gmsWins + gs^.gmsLosses + gs^.gmsOvertime
 
 -- | Calculates the number of points
 gmsPoints :: GameStats -> Int
@@ -570,3 +640,30 @@ addGameStats s1 s2 = GameStats
 -- | Calculates a player's points
 pPoints :: PlayerStats -> Int
 pPoints s = s^.psGoals + s^.psAssists
+
+-- | Searches through a list of players
+playerSearch
+  :: String
+  -- ^ The search string
+  -> [Player]
+  -- ^ The list of players to search
+  -> [(Int, Player)]
+  -- ^ The matching players with their index numbers
+playerSearch sStr =
+  filter (match sStr) .
+  zip [0..]
+  where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
+
+-- | Searches for a player by exact match on name
+playerSearchExact
+  :: String
+  -- ^ The player's name
+  -> [Player]
+  -- ^ The list of players to search
+  -> Maybe (Int, Player)
+  -- ^ The player's index and value
+playerSearchExact sStr =
+  listToMaybe .
+  filter (match sStr) .
+  zip [0..]
+  where match sStr (_, p) = p^.pName == sStr

src/Mtlstats/Util.hs

@@ -0,0 +1,29 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module Mtlstats.Util (nth) where
+
+nth :: Int -> [a] -> Maybe a
+nth _ [] = Nothing
+nth n (x:xs)
+  | n == 0    = Just x
+  | n < 0     = Nothing
+  | otherwise = nth (pred n) xs

test/ActionsSpec.hs

@@ -39,6 +39,9 @@ spec = describe "Mtlstats.Actions" $ do
   overtimeCheckSpec
   updateGameStatsSpec
   validateGameDateSpec
+  createPlayerSpec
+  addPlayerSpec
+  awardGoalSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -48,7 +51,7 @@ startNewSeasonSpec = describe "startNewSeason" $ do
       & startNewSeason
 
   it "should set the progState to NewSeason" $
-    s ^. progMode `shouldBe` NewSeason
+    show (s^.progMode) `shouldBe` "NewSeason"
 
   it "should set the number of games to 0" $
     s ^. database . dbGames `shouldBe` 0
@@ -61,7 +64,7 @@ startNewGameSpec = describe "startNewGame" $ do
     s ^. database . dbGames `shouldBe` 1
 
   it "should set the mode to NewGame" $
-    s ^. progMode `shouldBe` NewGame newGameState
+    show (s^.progMode) `shouldBe` "NewGame"
 
 resetYtdSpec :: Spec
 resetYtdSpec = describe "resetYtd" $
@@ -227,10 +230,10 @@ updateGameStatsSpec = describe "updateGameStats" $ do
       in db' `shouldBe` db 1 2 1 1 1 1
 
   context "home overtime loss" $
-    it "should record a home loss and overtime" $ let
+    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 2 2 1 1 1
+      in db' `shouldBe` db 1 1 2 1 1 1
 
   context "away win" $
     it "should record an away win" $ let
@@ -245,30 +248,34 @@ updateGameStatsSpec = describe "updateGameStats" $ do
       in db' `shouldBe` db 1 1 1 1 2 1
 
   context "away overtime loss" $
-    it "should record an away loss and overtime" $ let
+    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 2 2
+      in db' `shouldBe` db 1 1 1 1 1 2
 
   context "missing game type" $
     it "should not change anything" $ let
-      s' = s Nothing (Just 1) (Just 2) (Just True)
-      in updateGameStats s' `shouldBe` s'
+      s'  = s Nothing (Just 1) (Just 2) (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 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)
-      in updateGameStats s' `shouldBe` s'
+      s'  = s (Just HomeGame) Nothing (Just 1) (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 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)
-      in updateGameStats s' `shouldBe` s'
+      s'  = s (Just HomeGame) (Just 1) Nothing (Just True)
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 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
-      in updateGameStats s' `shouldBe` s'
+      s'  = s (Just HomeGame) (Just 1) (Just 2) Nothing
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1
 
 validateGameDateSpec :: Spec
 validateGameDateSpec = describe "validateGameDate" $ do
@@ -315,6 +322,86 @@ validateGameDateSpec = describe "validateGameDate" $ do
       s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
       s^.progMode.gameStateL.gameDay   `shouldBe` Nothing
 
+createPlayerSpec :: Spec
+createPlayerSpec = describe "createPlayer" $
+  it "should change the mode appropriately" $ let
+    s = createPlayer newProgState
+    in show (s^.progMode) `shouldBe` "CreatePlayer"
+
+addPlayerSpec :: Spec
+addPlayerSpec = describe "addPlayer" $ do
+  let
+    p1 = newPlayer 1 "Joe" "centre"
+    p2 = newPlayer 2 "Bob" "defense"
+    db = newDatabase
+      & dbPlayers .~ [p2]
+    s pm = newProgState
+      & progMode .~ pm
+      & database .~ db
+
+  context "data available" $
+    it "should create the player" $ let
+      s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
+        & cpsNumber   ?~ 1
+        & cpsName     .~ "Joe"
+        & cpsPosition .~ "centre"
+      in s'^.database.dbPlayers `shouldBe` [p1, p2]
+
+  context "data unavailable" $
+    it "should not create the player" $ let
+      s' = addPlayer $ s MainMenu
+      in s'^.database.dbPlayers `shouldBe` [p2]
+
+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]
+    ps
+      = newProgState
+      & database .~ db
+
+  context "Joe" $ do
+    let
+      ps'    = awardGoal 0 ps
+      player = head $ ps'^.database.dbPlayers
+
+    it "should increment Joe's year-to-date goals" $
+      player^.pYtd.psGoals `shouldBe` 2
+
+    it "should increment Joe's lifetime goals" $
+      player^.pLifetime.psGoals `shouldBe` 3
+
+  context "Bob" $ do
+    let
+      ps' = awardGoal 1 ps
+      player = last $ ps'^.database.dbPlayers
+
+    it "should increment Bob's year-to-data goals" $
+      player^.pYtd.psGoals `shouldBe` 4
+
+    it "should increment Bob's lifetime goals" $
+      player^.pLifetime.psGoals `shouldBe` 5
+
+  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
+
 makePlayer :: IO Player
 makePlayer = Player
   <$> makeNum

test/HandlersSpec.hs

@@ -0,0 +1,46 @@
+{-
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module HandlersSpec (spec) where
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+import qualified UI.NCurses as C
+
+import Mtlstats.Handlers
+
+spec :: Spec
+spec = describe "Mtlstats.Handlers"
+  ynHandlerSpec
+
+ynHandlerSpec :: Spec
+ynHandlerSpec = describe "ynHandler" $ mapM_
+  (\(desc, event, expected) ->
+    context desc $
+      it ("should be " ++ show expected) $
+        ynHandler event `shouldBe` expected)
+  --  description,   event,                expected
+  [ ( "Y pressed",   C.EventCharacter 'Y', Just True  )
+  , ( "y pressed",   C.EventCharacter 'y', Just True  )
+  , ( "N pressed",   C.EventCharacter 'N', Just False )
+  , ( "n pressed",   C.EventCharacter 'n', Just False )
+  , ( "x pressed",   C.EventCharacter 'x', Nothing    )
+  , ( "other event", C.EventResized,       Nothing    )
+  ]

test/ReportSpec.hs

@@ -0,0 +1,47 @@
+{-
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module ReportSpec (spec) where
+
+import Lens.Micro ((&), (?~), (%~))
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Report
+import Mtlstats.Types
+
+spec :: Spec
+spec = describe "Mtlstats.Report"
+  gameDateSpec
+
+gameDateSpec :: Spec
+gameDateSpec = describe "gameDate" $ do
+
+  context "valid gameDate" $
+    it "should format the date" $ let
+      gs = newGameState
+        & gameYear  ?~ 1980
+        & gameMonth ?~ 6
+        & gameDay   ?~ 25
+      in gameDate gs `shouldBe` "JUN 25 1980"
+
+  context "invalid date" $
+    it "should return an empty string" $
+      gameDate newGameState `shouldBe` ""

test/Spec.hs

@@ -23,10 +23,16 @@ import Test.Hspec (hspec)
 
 import qualified ActionsSpec as Actions
 import qualified FormatSpec as Format
+import qualified HandlersSpec as Handlers
+import qualified ReportSpec as Report
 import qualified TypesSpec as Types
+import qualified UtilSpec as Util
 
 main :: IO ()
 main = hspec $ do
   Types.spec
   Actions.spec
   Format.spec
+  Handlers.spec
+  Report.spec
+  Util.spec

test/TypesSpec.hs

@@ -42,6 +42,7 @@ spec = describe "Mtlstats.Types" $ do
   gameStatsSpec
   databaseSpec
   gameStateLSpec
+  createPlayerStateLSpec
   teamScoreSpec
   otherScoreSpec
   homeTeamSpec
@@ -49,10 +50,13 @@ spec = describe "Mtlstats.Types" $ do
   gameWonSpec
   gameLostSpec
   gameTiedSpec
+  unaccountedPointsSpec
   gmsGamesSpec
   gmsPointsSpec
   addGameStatsSpec
   pPointsSpec
+  playerSearchSpec
+  playerSearchExactSpec
   Menu.spec
 
 playerSpec :: Spec
@@ -81,6 +85,34 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   ]
   where gs t = newGameState & gameType ?~ t
 
+createPlayerStateLSpec :: Spec
+createPlayerStateLSpec = describe "createPlayerStateL" $ do
+  context "getters" $ do
+    context "state missing" $ let
+      pm  = MainMenu
+      cps = pm^.createPlayerStateL
+      in it "should not have a number" $
+        cps^.cpsNumber `shouldBe` Nothing
+
+    context "existing state" $ let
+      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+      cps = pm^.createPlayerStateL
+      in it "should have a number of 1" $
+        cps^.cpsNumber `shouldBe` Just 1
+
+  context "setters" $ do
+    context "state missing" $ let
+      pm  = MainMenu
+      pm' = pm & createPlayerStateL.cpsNumber ?~ 1
+      in it "should set the player number to 1" $
+        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
+
+    context "existing state" $ let
+      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
+      pm' = pm & createPlayerStateL.cpsNumber ?~ 2
+      in it "should set the player number to 2" $
+        pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
+
 teamScoreSpec :: Spec
 teamScoreSpec = describe "teamScore" $ do
   let
@@ -320,30 +352,36 @@ gameWonSpec = describe "gameWon" $ mapM_
 
 gameLostSpec :: Spec
 gameLostSpec = describe "gameLost" $ mapM_
-  (\(t, h, a, expected) -> let
+  (\(t, h, a, ot, expected) -> let
     desc = "game type: " ++ show t ++
       ", home score: " ++ show h ++
-      ", away score: " ++ show a
+      ", away score: " ++ show a ++
+      ", overtimr flag: " ++ show ot
     gs = newGameState
-      & gameType  .~ t
-      & homeScore .~ h
-      & awayScore .~ a
+      & gameType     .~ t
+      & homeScore    .~ h
+      & awayScore    .~ a
+      & overtimeFlag .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gameLost gs `shouldBe` expected)
-  --  gameType,      homeScore, awayScore, expected
-  [ ( Just HomeGame, Just 1,    Just 1,    Just False )
-  , ( Just HomeGame, Just 1,    Just 2,    Just True  )
-  , ( Just HomeGame, Just 2,    Just 1,    Just False )
-  , ( Just AwayGame, Just 1,    Just 1,    Just False )
-  , ( Just AwayGame, Just 1,    Just 2,    Just False )
-  , ( Just AwayGame, Just 2,    Just 1,    Just True  )
-  , ( Nothing,       Just 1,    Just 2,    Nothing    )
-  , ( Just HomeGame, Nothing,   Just 1,    Nothing    )
-  , ( Just AwayGame, Nothing,   Just 1,    Nothing    )
-  , ( Just HomeGame, Just 1,    Nothing,   Nothing    )
-  , ( Just AwayGame, Just 1,    Nothing,   Nothing    )
-  , ( Nothing,       Nothing,   Nothing,   Nothing    )
+  --  gameType,      homeScore, awayScore, overtimeFlag, expected
+  [ ( Just HomeGame, Just 1,    Just 1,    Just False,   Just False )
+  , ( Just HomeGame, Just 1,    Just 2,    Just False,   Just True  )
+  , ( Just HomeGame, Just 1,    Just 2,    Just True,    Just False )
+  , ( Just HomeGame, Just 2,    Just 1,    Just False,   Just False )
+  , ( Just AwayGame, Just 1,    Just 1,    Just False,   Just False )
+  , ( Just AwayGame, Just 1,    Just 2,    Just False,   Just False )
+  , ( Just AwayGame, Just 2,    Just 1,    Just False,   Just True  )
+  , ( Just AwayGame, Just 2,    Just 1,    Just True,    Just False )
+  , ( Nothing,       Just 1,    Just 2,    Just False,   Nothing    )
+  , ( Just HomeGame, Nothing,   Just 1,    Just False,   Nothing    )
+  , ( Just AwayGame, Nothing,   Just 1,    Just False,   Nothing    )
+  , ( Just HomeGame, Just 1,    Nothing,   Just False,   Nothing    )
+  , ( Just AwayGame, Just 1,    Nothing,   Just False,   Nothing    )
+  , ( Just HomeGame, Just 1,    Just 2,    Nothing,      Nothing    )
+  , ( Just AwayGame, Just 1,    Just 2,    Nothing,      Nothing    )
+  , ( Nothing,       Nothing,   Nothing,   Just False,   Nothing    )
   ]
 
 gameTiedSpec :: Spec
@@ -364,23 +402,55 @@ gameTiedSpec = describe "gameTied" $ mapM_
   , ( Just 1,  Just 2,  Just False )
   ]
 
+unaccountedPointsSpec :: Spec
+unaccountedPointsSpec = describe "unaccounted points" $ do
+  context "no data" $
+    it "should return Nothing" $
+      unaccountedPoints newGameState `shouldBe` Nothing
+
+  context "unaccounted points" $
+    it "should return True" $ let
+      gs = newGameState
+        & gameType  ?~ HomeGame
+        & homeScore ?~ 1
+      in unaccountedPoints gs `shouldBe` Just True
+
+  context "all points accounted" $
+    it "should return False" $ let
+      gs = newGameState
+        & gameType        ?~ HomeGame
+        & homeScore       ?~ 1
+        & pointsAccounted .~ 1
+      in unaccountedPoints gs `shouldBe` Just False
+
+  context "more points accounted" $
+    it "should return True" $ let
+      gs = newGameState
+        & gameType        ?~ HomeGame
+        & homeScore       ?~ 1
+        & pointsAccounted .~ 2
+      in unaccountedPoints gs `shouldBe` Just False
+
 gmsGamesSpec :: Spec
 gmsGamesSpec = describe "gmsGames" $ mapM_
-  (\(w, l, expected) -> let
+  (\(w, l, ot, expected) -> let
     desc = "wins: " ++ show w ++
-      ", losses: " ++ show l
+      ", losses: " ++ show l ++
+      ", overtime: " ++ show ot
     gs = newGameStats
-      & gmsWins   .~ w
-      & gmsLosses .~ l
+      & gmsWins     .~ w
+      & gmsLosses   .~ l
+      & gmsOvertime .~ ot
     in context desc $
       it ("should be " ++ show expected) $
         gmsGames gs `shouldBe` expected)
-  --  wins, losses, expected
-  [ ( 0,    0,      0        )
-  , ( 1,    0,      1        )
-  , ( 0,    1,      1        )
-  , ( 1,    1,      2        )
-  , ( 2,    3,      5        )
+  --  wins, losses, overtime, expected
+  [ ( 0,    0,      0,        0        )
+  , ( 1,    0,      0,        1        )
+  , ( 0,    1,      0,        1        )
+  , ( 0,    0,      1,        1        )
+  , ( 1,    1,      1,        3        )
+  , ( 2,    3,      5,        10       )
   ]
 
 gmsPointsSpec :: Spec
@@ -444,3 +514,39 @@ pPointsSpec = describe "pPoints" $ mapM_
   , ( 0,     1,       1      )
   , ( 2,     3,       5      )
   ]
+
+playerSearchSpec :: Spec
+playerSearchSpec = describe "playerSearch" $ mapM_
+  (\(sStr, expected) -> context sStr $
+    it ("should return " ++ show expected) $ let
+      ps = [joe, bob, steve]
+      in playerSearch sStr ps `shouldBe` expected)
+  --  search, result
+  [ ( "Joe",  [(0, joe)]             )
+  , ( "o",    [(0, joe), (1, bob)]   )
+  , ( "e",    [(0, joe), (2, steve)] )
+  , ( "x",    []                     )
+  ]
+
+playerSearchExactSpec :: Spec
+playerSearchExactSpec = describe "playerSearchExact" $ mapM_
+  (\(sStr, expected) -> context sStr $
+    it ("should be " ++ show expected) $ let
+      ps = [joe, bob, steve]
+      in playerSearchExact sStr ps `shouldBe` expected)
+  --  search,  result
+  [ ( "Joe",   Just (0, joe)   )
+  , ( "Bob",   Just (1, bob)   )
+  , ( "Steve", Just (2, steve) )
+  , ( "Sam",   Nothing         )
+  , ( "",      Nothing         )
+  ]
+
+joe :: Player
+joe = newPlayer 2 "Joe" "center"
+
+bob :: Player
+bob = newPlayer 3 "Bob" "defense"
+
+steve :: Player
+steve = newPlayer 5 "Steve" "forward"

test/UtilSpec.hs

@@ -0,0 +1,44 @@
+{-
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+<rheal.lamothe@gmail.com>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+-}
+
+module UtilSpec (spec) where
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Mtlstats.Util
+
+spec :: Spec
+spec = describe "Mtlstats.Util"
+  nthSpec
+
+nthSpec :: Spec
+nthSpec = describe "nth" $ mapM_
+  (\(n, expected) -> context (show n) $
+    it ("should be " ++ show expected) $ let
+      xs = ["foo", "bar", "baz"]
+      in nth n xs `shouldBe` expected)
+  --  index, expected
+  [ ( 0,     Just "foo" )
+  , ( 1,     Just "bar" )
+  , ( 2,     Just "baz" )
+  , ( 3,     Nothing    )
+  , ( -1,    Nothing    )
+  ]