diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs
index 951e236..f700373 100644
--- a/src/Mtlstats/Actions.hs
+++ b/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..]
diff --git a/src/Mtlstats/Config.hs b/src/Mtlstats/Config.hs
index e02aacc..392c17d 100644
--- a/src/Mtlstats/Config.hs
+++ b/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
diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs
index edb8c42..8b00523 100644
--- a/src/Mtlstats/Control.hs
+++ b/src/Mtlstats/Control.hs
@@ -21,11 +21,12 @@ along with this program. If not, see .
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
@@ -43,16 +44,17 @@ dispatch s = case s^.progMode of
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
- | otherwise -> reportC
+ | 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
@@ -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
- Just False -> modify $ progMode .~ MainMenu
- Nothing -> return ()
+ join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
+ Just False ->
+ join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
+ Nothing -> return ()
return True
}
diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs
index 3909b11..04bb138 100644
--- a/src/Mtlstats/Prompt.hs
+++ b/src/Mtlstats/Prompt.hs
@@ -19,6 +19,8 @@ along with this program. If not, see .
-}
+{-# 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)) =
- promptFunctionKey p k
+promptHandler p (C.EventSpecialKey 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
- , promptCharCheck = const True
- , promptAction = act
- , promptFunctionKey = const $ return ()
+ { promptDrawer = drawSimplePrompt pStr
+ , promptCharCheck = const True
+ , promptAction = act
+ , 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
- , 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
@@ -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
diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs
index be3701b..b5a2ecc 100644
--- a/src/Mtlstats/Types.hs
+++ b/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 ()
- -- ^ Action to perform when a function key is pressed
+ , promptSpecialKey :: C.Key -> Action ()
+ -- ^ 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
- , _gameMonth = Nothing
- , _gameDay = Nothing
- , _gameType = Nothing
- , _otherTeam = ""
- , _homeScore = Nothing
- , _awayScore = Nothing
- , _overtimeFlag = Nothing
- , _dataVerified = False
+ { _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 = ""
+ { _cpsNumber = Nothing
+ , _cpsName = ""
+ , _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
diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs
new file mode 100644
index 0000000..3d8880f
--- /dev/null
+++ b/src/Mtlstats/Util.hs
@@ -0,0 +1,29 @@
+{- |
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+
+
+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 .
+
+-}
+
+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
diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs
index 470492f..7735057 100644
--- a/test/ActionsSpec.hs
+++ b/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)
- 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
@@ -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
diff --git a/test/Spec.hs b/test/Spec.hs
index a3db0ba..4edf493 100644
--- a/test/Spec.hs
+++ b/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
diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs
index 68a15d2..5aad0a4 100644
--- a/test/TypesSpec.hs
+++ b/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" $
- lensSpec createPlayerStateL
- -- getters
- [ ( MainMenu, newCreatePlayerState )
- , ( CreatePlayer $ cps 1 , cps 1 )
- ]
- -- setters
- [ ( MainMenu, cps 1 )
- , ( CreatePlayer $ cps 1, cps 2 )
- ]
- where
- cps n = newCreatePlayerState
- & cpsNumber ?~ n
- & cpsName .~ "foo"
- & cpsPosition .~ "bar"
+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
@@ -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"
diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs
new file mode 100644
index 0000000..e5e1f37
--- /dev/null
+++ b/test/UtilSpec.hs
@@ -0,0 +1,44 @@
+{-
+
+mtlstats
+Copyright (C) 2019 Rhéal Lamothe
+
+
+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 .
+
+-}
+
+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 )
+ ]