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 ) + ]