Merge pull request #17 from mtlstats/goal-points

Goal points

src/Mtlstats/Actions.hs

@@ -32,8 +32,10 @@ module Mtlstats.Actions
   , validateGameDate
   , createPlayer
   , addPlayer
+  , awardGoal
   ) where
 
+import Control.Monad.Trans.State (modify)
 import Data.Maybe (fromMaybe)
 import Data.Time.Calendar (fromGregorianValid)
 import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
@@ -116,7 +118,13 @@ validateGameDate s = fromMaybe s $ do
 
 -- | Starts player creation mode
 createPlayer :: ProgState -> ProgState
-createPlayer = progMode .~ CreatePlayer newCreatePlayerState
+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
@@ -129,3 +137,18 @@ addPlayer s = fromMaybe s $ do
     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,7 @@ 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

src/Mtlstats/Control.hs

@@ -21,11 +21,12 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Mtlstats.Control (dispatch) where
 
-import Control.Monad (when)
+import Control.Monad (join, when)
-import Control.Monad.Trans.State (modify)
+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
@@ -43,16 +44,17 @@ dispatch s = case s^.progMode of
   MainMenu  -> mainMenuC
   NewSeason -> newSeasonC
   NewGame gs
-    | null $ gs^.gameYear     -> gameYearC
+    | null $ gs^.gameYear             -> gameYearC
-    | null $ gs^.gameMonth    -> gameMonthC
+    | null $ gs^.gameMonth            -> gameMonthC
-    | null $ gs^.gameDay      -> gameDayC
+    | null $ gs^.gameDay              -> gameDayC
-    | null $ gs^.gameType     -> gameTypeC
+    | null $ gs^.gameType             -> gameTypeC
-    | null $ gs^.otherTeam    -> otherTeamC
+    | null $ gs^.otherTeam            -> otherTeamC
-    | null $ gs^.homeScore    -> homeScoreC
+    | null $ gs^.homeScore            -> homeScoreC
-    | null $ gs^.awayScore    -> awayScoreC
+    | null $ gs^.awayScore            -> awayScoreC
-    | null $ gs^.overtimeFlag -> overtimeFlagC
+    | null $ gs^.overtimeFlag         -> overtimeFlagC
-    | not $ gs^.dataVerified  -> verifyDataC
+    | not $ gs^.dataVerified          -> verifyDataC
-    | otherwise               -> reportC
+    | fromJust (unaccountedPoints gs) -> recordGoalC
+    | otherwise                       -> reportC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
     | null $ cps^.cpsName     -> getPlayerNameC
@@ -180,6 +182,19 @@ verifyDataC = Controller
     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
+  }
+
 reportC :: Controller
 reportC = Controller
   { drawController = \s -> do
@@ -235,10 +250,11 @@ confirmCreatePlayerC = Controller
     return C.CursorInvisible
   , handleController = \e -> do
     case ynHandler e of
-      Just True  -> do
+      Just True -> do
         modify addPlayer
-        modify $ progMode .~ MainMenu
+        join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
-      Just False -> modify $ progMode .~ MainMenu
+      Just False ->
-      Nothing    -> return ()
+        join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
+      Nothing -> return ()
     return True
   }

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,
@@ -33,20 +35,25 @@ module Mtlstats.Prompt (
   awayScorePrompt,
   playerNumPrompt,
   playerNamePrompt,
-  playerPosPrompt
+  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
@@ -66,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)) =
+promptHandler p (C.EventSpecialKey k) =
-  promptFunctionKey p k
+  promptSpecialKey p k
 promptHandler _ _ = return ()
 
 -- | Builds a string prompt
@@ -78,10 +85,10 @@ strPrompt
   -- ^ The callback function for the result
   -> Prompt
 strPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
+  { promptDrawer     = drawSimplePrompt pStr
-  , promptCharCheck   = const True
+  , promptCharCheck  = const True
-  , promptAction      = act
+  , promptAction     = act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Builds a numeric prompt
@@ -92,10 +99,10 @@ numPrompt
   -- ^ The callback function for the result
   -> Prompt
 numPrompt pStr act = Prompt
-  { promptDrawer      = drawSimplePrompt pStr
+  { promptDrawer     = drawSimplePrompt pStr
-  , promptCharCheck   = isDigit
+  , promptCharCheck  = isDigit
-  , promptAction      = \inStr -> forM_ (readMaybe inStr) act
+  , promptAction     = \inStr -> forM_ (readMaybe inStr) act
-  , promptFunctionKey = const $ return ()
+  , promptSpecialKey = const $ return ()
   }
 
 -- | Prompts for the game year
@@ -138,5 +145,73 @@ 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/Types.hs

@@ -55,10 +55,13 @@ module Mtlstats.Types (
   awayScore,
   overtimeFlag,
   dataVerified,
+  pointsAccounted,
   -- ** CreatePlayerState Lenses
   cpsNumber,
   cpsName,
   cpsPosition,
+  cpsSuccessCallback,
+  cpsFailureCallback,
   -- ** Database Lenses
   dbPlayers,
   dbGoalies,
@@ -111,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)
@@ -132,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
@@ -157,7 +165,7 @@ data ProgState = ProgState
   -- ^ The program's mode
   , _inputBuffer :: String
   -- ^ Buffer for user input
-  } deriving (Eq, Show)
+  }
 
 -- | The program mode
 data ProgMode
@@ -165,28 +173,34 @@ data ProgMode
   | NewSeason
   | NewGame GameState
   | CreatePlayer CreatePlayerState
-  deriving (Eq, Show)
+
+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
+  { _gameYear        :: Maybe Int
   -- ^ The year the game took place
-  , _gameMonth    :: Maybe Int
+  , _gameMonth       :: Maybe Int
   -- ^ The month the game took place
-  , _gameDay      :: Maybe Int
+  , _gameDay         :: Maybe Int
   -- ^ The day of the month the game took place
-  , _gameType     :: Maybe GameType
+  , _gameType        :: Maybe GameType
   -- ^ The type of game (home/away)
-  , _otherTeam    :: String
+  , _otherTeam       :: String
   -- ^ The name of the other team
-  , _homeScore    :: Maybe Int
+  , _homeScore       :: Maybe Int
   -- ^ The home team's score
-  , _awayScore    :: Maybe Int
+  , _awayScore       :: Maybe Int
   -- ^ The away team's score
-  , _overtimeFlag :: Maybe Bool
+  , _overtimeFlag    :: Maybe Bool
   -- ^ Indicates whether or not the game went into overtime
-  , _dataVerified :: Bool
+  , _dataVerified    :: Bool
   -- ^ Set to 'True' when the user confirms the entered data
+  , _pointsAccounted :: Int
   } deriving (Eq, Show)
 
 -- | The type of game
@@ -197,13 +211,17 @@ data GameType
 
 -- | Player creation status
 data CreatePlayerState = CreatePlayerState
-  { _cpsNumber    :: Maybe Int
+  { _cpsNumber          :: Maybe Int
   -- ^ The player's number
-  , _cpsName      :: String
+  , _cpsName            :: String
   -- ^ The player's name
-  , _cpsPosition  :: String
+  , _cpsPosition        :: String
   -- ^ The player's position
-  } deriving (Eq, Show)
+  , _cpsSuccessCallback :: Action ()
+  -- ^ The function to call on success
+  , _cpsFailureCallback :: Action ()
+  -- ^ The function to call on failure
+  }
 
 -- | Represents the database
 data Database = Database
@@ -414,14 +432,14 @@ 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 ()
+  , promptSpecialKey :: C.Key -> Action ()
-  -- ^ Action to perform when a function key is pressed
+  -- ^ Action to perform when a special key is pressed
   }
 
 makeLenses ''ProgState
@@ -459,23 +477,26 @@ newProgState = ProgState
 -- | Constructor for a 'GameState'
 newGameState :: GameState
 newGameState = GameState
-  { _gameYear     = Nothing
+  { _gameYear        = Nothing
-  , _gameMonth    = Nothing
+  , _gameMonth       = Nothing
-  , _gameDay      = Nothing
+  , _gameDay         = Nothing
-  , _gameType     = Nothing
+  , _gameType        = Nothing
-  , _otherTeam    = ""
+  , _otherTeam       = ""
-  , _homeScore    = Nothing
+  , _homeScore       = Nothing
-  , _awayScore    = Nothing
+  , _awayScore       = Nothing
-  , _overtimeFlag = Nothing
+  , _overtimeFlag    = Nothing
-  , _dataVerified = False
+  , _dataVerified    = False
+  , _pointsAccounted = 0
   }
 
 -- | Constructor for a 'CreatePlayerState'
 newCreatePlayerState :: CreatePlayerState
 newCreatePlayerState = CreatePlayerState
-  { _cpsNumber    = Nothing
+  { _cpsNumber          = Nothing
-  , _cpsName      = ""
+  , _cpsName            = ""
-  , _cpsPosition  = ""
+  , _cpsPosition        = ""
+  , _cpsSuccessCallback = return ()
+  , _cpsFailureCallback = return ()
   }
 
 -- | Constructor for a 'Database'
@@ -593,6 +614,13 @@ gameLost gs = do
 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 + gs^.gmsOvertime
@@ -612,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

@@ -41,6 +41,7 @@ spec = describe "Mtlstats.Actions" $ do
   validateGameDateSpec
   createPlayerSpec
   addPlayerSpec
+  awardGoalSpec
 
 startNewSeasonSpec :: Spec
 startNewSeasonSpec = describe "startNewSeason" $ do
@@ -50,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
@@ -63,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" $
@@ -254,23 +255,27 @@ updateGameStatsSpec = describe "updateGameStats" $ do
 
   context "missing game type" $
     it "should not change anything" $ let
-      s' = s Nothing (Just 1) (Just 2) (Just True)
+      s'  = s Nothing (Just 1) (Just 2) (Just True)
-      in updateGameStats s' `shouldBe` s'
+      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)
+      s'  = s (Just HomeGame) Nothing (Just 1) (Just True)
-      in updateGameStats s' `shouldBe` s'
+      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)
+      s'  = s (Just HomeGame) (Just 1) Nothing (Just True)
-      in updateGameStats s' `shouldBe` s'
+      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
+      s'  = s (Just HomeGame) (Just 1) (Just 2) Nothing
-      in updateGameStats s' `shouldBe` s'
+      db' = updateGameStats s' ^. database
+      in db' `shouldBe` db 1 1 1 1 1 1
 
 validateGameDateSpec :: Spec
 validateGameDateSpec = describe "validateGameDate" $ do
@@ -321,7 +326,7 @@ createPlayerSpec :: Spec
 createPlayerSpec = describe "createPlayer" $
   it "should change the mode appropriately" $ let
     s = createPlayer newProgState
-    in s^.progMode `shouldBe` CreatePlayer newCreatePlayerState
+    in show (s^.progMode) `shouldBe` "CreatePlayer"
 
 addPlayerSpec :: Spec
 addPlayerSpec = describe "addPlayer" $ do
@@ -347,6 +352,56 @@ addPlayerSpec = describe "addPlayer" $ do
       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/Spec.hs

@@ -26,6 +26,7 @@ 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
@@ -34,3 +35,4 @@ main = hspec $ do
   Format.spec
   Handlers.spec
   Report.spec
+  Util.spec

test/TypesSpec.hs

@@ -50,10 +50,13 @@ spec = describe "Mtlstats.Types" $ do
   gameWonSpec
   gameLostSpec
   gameTiedSpec
+  unaccountedPointsSpec
   gmsGamesSpec
   gmsPointsSpec
   addGameStatsSpec
   pPointsSpec
+  playerSearchSpec
+  playerSearchExactSpec
   Menu.spec
 
 playerSpec :: Spec
@@ -83,21 +86,32 @@ gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
   where gs t = newGameState & gameType ?~ t
 
 createPlayerStateLSpec :: Spec
-createPlayerStateLSpec = describe "createPlayerStateL" $
+createPlayerStateLSpec = describe "createPlayerStateL" $ do
-  lensSpec createPlayerStateL
+  context "getters" $ do
-  -- getters
+    context "state missing" $ let
-  [ ( MainMenu,              newCreatePlayerState )
+      pm  = MainMenu
-  , ( CreatePlayer $ cps 1 , cps 1                )
+      cps = pm^.createPlayerStateL
-  ]
+      in it "should not have a number" $
-  -- setters
+        cps^.cpsNumber `shouldBe` Nothing
-  [ ( MainMenu,             cps 1 )
+
-  , ( CreatePlayer $ cps 1, cps 2 )
+    context "existing state" $ let
-  ]
+      pm  = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
-  where
+      cps = pm^.createPlayerStateL
-    cps n = newCreatePlayerState
+      in it "should have a number of 1" $
-      & cpsNumber   ?~ n
+        cps^.cpsNumber `shouldBe` Just 1
-      & cpsName     .~ "foo"
+
-      & cpsPosition .~ "bar"
+  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
@@ -388,6 +402,35 @@ 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, ot, expected) -> let
@@ -471,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    )
+  ]