From 2f767209bb5aea63f528b5041319401e4302282b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 02:38:48 -0500 Subject: [PATCH] broke goalie input functions for game off into separate modules --- src/Mtlstats/Actions.hs | 38 ------ src/Mtlstats/Actions/GoalieInput.hs | 68 ++++++++++ src/Mtlstats/Control/GoalieInput.hs | 1 + src/Mtlstats/Prompt.hs | 48 ++------ src/Mtlstats/Prompt/GoalieInput.hs | 59 +++++++++ test/Actions/GoalieInputSpec.hs | 184 ++++++++++++++++++++++++++++ test/ActionsSpec.hs | 150 +---------------------- 7 files changed, 326 insertions(+), 222 deletions(-) create mode 100644 src/Mtlstats/Actions/GoalieInput.hs create mode 100644 src/Mtlstats/Prompt/GoalieInput.hs create mode 100644 test/Actions/GoalieInputSpec.hs diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 1352a79..1c61941 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -37,13 +37,11 @@ module Mtlstats.Actions , addGoalie , resetCreatePlayerState , resetCreateGoalieState - , finishGameGoalieEntry , recordGoalAssists , awardGoal , awardAssist , resetGoalData , assignPMins - , recordGoalieStats , backHome , scrollUp , scrollDown @@ -201,11 +199,6 @@ resetCreateGoalieState = progMode.createGoalieStateL %~ (cgsNumber .~ Nothing) . (cgsName .~ "") --- | Attempts to finish game goalie entry -finishGameGoalieEntry :: ProgState -> ProgState -finishGameGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded - .~ not (null $ s^.progMode.gameStateL.gameGoalieStats) - -- | Awards the goal and assists to the players recordGoalAssists :: ProgState -> ProgState recordGoalAssists ps = fromMaybe ps $ do @@ -281,37 +274,6 @@ assignPMins mins s = fromMaybe s $ do ) . (gameSelectedPlayer .~ Nothing) --- | Records the goalie's game stats -recordGoalieStats :: ProgState -> ProgState -recordGoalieStats s = fromMaybe s $ do - let gs = s^.progMode.gameStateL - gid <- gs^.gameSelectedGoalie - goalie <- nth gid $ s^.database.dbGoalies - mins <- gs^.gameGoalieMinsPlayed - goals <- gs^.gameGoalsAllowed - - let - gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats - bumpVal = if gameStats^.gsGames == 0 - then 1 - else 0 - - bumpStats gs = gs - & gsGames +~ bumpVal - & gsMinsPlayed +~ mins - & gsGoalsAllowed +~ goals - - Just $ s - & progMode.gameStateL - %~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats) - . (gameSelectedGoalie .~ Nothing) - . (gameGoalieMinsPlayed .~ Nothing) - . (gameGoalsAllowed .~ Nothing) - & database.dbGoalies - %~ modifyNth gid (\goalie -> goalie - & gYtd %~ bumpStats - & gLifetime %~ bumpStats) - -- | Resets the program state back to the main menu backHome :: ProgState -> ProgState backHome diff --git a/src/Mtlstats/Actions/GoalieInput.hs b/src/Mtlstats/Actions/GoalieInput.hs new file mode 100644 index 0000000..acae846 --- /dev/null +++ b/src/Mtlstats/Actions/GoalieInput.hs @@ -0,0 +1,68 @@ +{- | + +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.Actions.GoalieInput + ( finishGoalieEntry + , recordGoalieStats + ) where + +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Lens.Micro ((^.), (&), (.~), (%~), (+~)) + +import Mtlstats.Types +import Mtlstats.Util + +-- | Attempts to finish game goalie entry +finishGoalieEntry :: ProgState -> ProgState +finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded + .~ not (null $ s^.progMode.gameStateL.gameGoalieStats) + +-- | Records the goalie's game stats +recordGoalieStats :: ProgState -> ProgState +recordGoalieStats s = fromMaybe s $ do + let gs = s^.progMode.gameStateL + gid <- gs^.gameSelectedGoalie + goalie <- nth gid $ s^.database.dbGoalies + mins <- gs^.gameGoalieMinsPlayed + goals <- gs^.gameGoalsAllowed + + let + gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats + bumpVal = if gameStats^.gsGames == 0 + then 1 + else 0 + + bumpStats gs = gs + & gsGames +~ bumpVal + & gsMinsPlayed +~ mins + & gsGoalsAllowed +~ goals + + Just $ s + & progMode.gameStateL + %~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats) + . (gameSelectedGoalie .~ Nothing) + . (gameGoalieMinsPlayed .~ Nothing) + . (gameGoalsAllowed .~ Nothing) + & database.dbGoalies + %~ modifyNth gid (\goalie -> goalie + & gYtd %~ bumpStats + & gLifetime %~ bumpStats) diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs index 2ec0c09..684cbbc 100644 --- a/src/Mtlstats/Control/GoalieInput.hs +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -27,6 +27,7 @@ import qualified UI.NCurses as C import Mtlstats.Format import Mtlstats.Prompt +import Mtlstats.Prompt.GoalieInput import Mtlstats.Types import Mtlstats.Util diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 7f530ae..22ddd44 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -39,17 +39,14 @@ module Mtlstats.Prompt ( playerNumPrompt, playerNamePrompt, playerPosPrompt, + goalieNumPrompt, + goalieNamePrompt, selectPlayerPrompt, selectGoaliePrompt, recordGoalPrompt, recordAssistPrompt, pMinPlayerPrompt, assignPMinsPrompt, - goalieNumPrompt, - goalieNamePrompt, - selectGameGoaliePrompt, - goalieMinsPlayedPrompt, - goalsAllowedPrompt, playerToEditPrompt ) where @@ -222,6 +219,16 @@ playerPosPrompt :: Prompt playerPosPrompt = strPrompt "Player position: " $ modify . (progMode.createPlayerStateL.cpsPosition .~) +-- | Prompts tor the goalie's number +goalieNumPrompt :: Prompt +goalieNumPrompt = numPrompt "Goalie number: " $ + modify . (progMode.createGoalieStateL.cgsNumber ?~) + +-- | Prompts for the goalie's name +goalieNamePrompt :: Prompt +goalieNamePrompt = strPrompt "Goalie name: " $ + modify . (progMode.createGoalieStateL.cgsName .~) + -- | Selects a player (creating one if necessary) selectPlayerPrompt :: String @@ -324,37 +331,6 @@ assignPMinsPrompt :: Prompt assignPMinsPrompt = numPrompt "Penalty minutes: " $ modify . assignPMins --- | Prompts tor the goalie's number -goalieNumPrompt :: Prompt -goalieNumPrompt = numPrompt "Goalie number: " $ - modify . (progMode.createGoalieStateL.cgsNumber ?~) - --- | Prompts for the goalie's name -goalieNamePrompt :: Prompt -goalieNamePrompt = strPrompt "Goalie name: " $ - modify . (progMode.createGoalieStateL.cgsName .~) - --- | Prompts for a goalie who played in the game -selectGameGoaliePrompt :: Prompt -selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $ - \case - Nothing -> modify finishGameGoalieEntry - Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n - --- | Prompts for the number of minutes the goalie has played -goalieMinsPlayedPrompt :: Prompt -goalieMinsPlayedPrompt = numPrompt "Minutes played: " $ - modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~) - --- | Prompts for the number of goals the goalie allowed -goalsAllowedPrompt :: Prompt -goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do - modify (progMode.gameStateL.gameGoalsAllowed ?~ n) - mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.gameGoalieMinsPlayed) - when (mins >= gameLength) $ - modify $ progMode.gameStateL.gameGoaliesRecorded .~ True - modify recordGoalieStats - playerToEditPrompt :: Prompt playerToEditPrompt = selectPlayerPrompt "Player to edit: " $ modify . (progMode.editPlayerStateL.epsSelectedPlayer .~) diff --git a/src/Mtlstats/Prompt/GoalieInput.hs b/src/Mtlstats/Prompt/GoalieInput.hs new file mode 100644 index 0000000..bda49d2 --- /dev/null +++ b/src/Mtlstats/Prompt/GoalieInput.hs @@ -0,0 +1,59 @@ +{- | + +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 . + +-} + +{-# LANGUAGE LambdaCase #-} + +module Mtlstats.Prompt.GoalieInput + ( selectGameGoaliePrompt + , goalieMinsPlayedPrompt + , goalsAllowedPrompt + ) where + +import Control.Monad (when) +import Control.Monad.Trans.State (gets, modify) +import Data.Maybe (fromMaybe) +import Lens.Micro ((^.), (.~), (?~)) + +import Mtlstats.Actions.GoalieInput +import Mtlstats.Config +import Mtlstats.Prompt +import Mtlstats.Types + +-- | Prompts for a goalie who played in the game +selectGameGoaliePrompt :: Prompt +selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $ + \case + Nothing -> modify finishGoalieEntry + Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n + +-- | Prompts for the number of minutes the goalie has played +goalieMinsPlayedPrompt :: Prompt +goalieMinsPlayedPrompt = numPrompt "Minutes played: " $ + modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~) + +-- | Prompts for the number of goals the goalie allowed +goalsAllowedPrompt :: Prompt +goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do + modify (progMode.gameStateL.gameGoalsAllowed ?~ n) + mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.gameGoalieMinsPlayed) + when (mins >= gameLength) $ + modify $ progMode.gameStateL.gameGoaliesRecorded .~ True + modify recordGoalieStats diff --git a/test/Actions/GoalieInputSpec.hs b/test/Actions/GoalieInputSpec.hs new file mode 100644 index 0000000..c9a6585 --- /dev/null +++ b/test/Actions/GoalieInputSpec.hs @@ -0,0 +1,184 @@ +{- + +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 Actions.GoalieInputSpec (spec) where + +import qualified Data.Map as M +import Data.Maybe (fromJust) +import Lens.Micro ((^.), (&), (.~)) +import Test.Hspec (Spec, context, describe, it, shouldBe) + +import Mtlstats.Actions.GoalieInput +import Mtlstats.Types +import Mtlstats.Util + +import qualified TypesSpec as TS + +spec :: Spec +spec = describe "Mtlstats.Actions.GoalieInput" $ do + finishGoalieEntrySpec + recordGoalieStatsSpec + +finishGoalieEntrySpec :: Spec +finishGoalieEntrySpec = describe "finishGoalieEntry" $ do + let + progState stats = newProgState + & progMode.gameStateL.gameGoalieStats .~ stats + & finishGoalieEntry + + context "no goalie data" $ + it "should not set goaliesRecorded" $ let + s = progState M.empty + in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False + + context "goalie data" $ + it "should set goaliesRecorded" $ let + s = progState $ M.fromList [(1, newGoalieStats)] + in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True + +recordGoalieStatsSpec :: Spec +recordGoalieStatsSpec = describe "recordGoalieStats" $ let + goalieStats games mins goals = newGoalieStats + & gsGames .~ games + & gsMinsPlayed .~ mins + & gsGoalsAllowed .~ goals + + joe = newGoalie 2 "Joe" + & gYtd .~ goalieStats 10 11 12 + & gLifetime .~ goalieStats 20 21 22 + + bob = newGoalie 3 "Bob" + & gYtd .~ goalieStats 30 31 32 + & gLifetime .~ goalieStats 40 41 42 + + gameState n mins goals = newGameState + & gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)] + & gameSelectedGoalie .~ n + & gameGoalieMinsPlayed .~ mins + & gameGoalsAllowed .~ goals + + progState n mins goals = newProgState + & database.dbGoalies .~ [joe, bob] + & progMode.gameStateL .~ gameState n mins goals + + in mapM_ + (\(name, gid, mins, goals, joeData, bobData, reset) -> let + s = recordGoalieStats $ progState gid mins goals + in context name $ do + + mapM_ + (\( name + , gid + , ( gGames + , gMins + , gGoals + , ytdGames + , ytdMins + , ytdGoals + , ltGames + , ltMins + , ltGoals + ) + ) -> context name $ do + let + gs = s^.progMode.gameStateL.gameGoalieStats + game = M.findWithDefault newGoalieStats gid gs + goalie = fromJust $ nth gid $ s^.database.dbGoalies + ytd = goalie^.gYtd + lt = goalie^.gLifetime + + context "game" $ + game `TS.compareTest` goalieStats gGames gMins gGoals + + context "year-to-date" $ + ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals + + context "lifetime" $ + lt `TS.compareTest` goalieStats ltGames ltMins ltGoals) + + [ ( "checking Joe", 0, joeData ) + , ( "checking Bob", 1, bobData ) + ] + + context "selected goalie" $ let + expected = if reset then Nothing else gid + in it ("should be " ++ show expected) $ + (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected + + context "minutes played" $ let + expected = if reset then Nothing else mins + in it ("should be " ++ show expected) $ + (s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected + + context "goals allowed" $ let + expected = if reset then Nothing else goals + in it ("should be " ++ show expected) $ + (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected) + + [ ( "updating Joe" + , Just 0 + , Just 1 + , Just 2 + , (1, 1, 2, 11, 12, 14, 21, 22, 24) + , (1, 2, 3, 30, 31, 32, 40, 41, 42) + , True + ) + , ( "updating Bob" + , Just 1 + , Just 1 + , Just 2 + , (0, 0, 0, 10, 11, 12, 20, 21, 22) + , (1, 3, 5, 30, 32, 34, 40, 42, 44) + , True + ) + , ( "goalie out of bounds" + , Just 2 + , Just 1 + , Just 2 + , (0, 0, 0, 10, 11, 12, 20, 21, 22) + , (1, 2, 3, 30, 31, 32, 40, 41, 42) + , False + ) + , ( "missing goalie" + , Nothing + , Just 1 + , Just 2 + , (0, 0, 0, 10, 11, 12, 20, 21, 22) + , (1, 2, 3, 30, 31, 32, 40, 41, 42) + , False + ) + , ( "missing minutes" + , Just 0 + , Nothing + , Just 1 + , (0, 0, 0, 10, 11, 12, 20, 21, 22) + , (1, 2, 3, 30, 31, 32, 40, 41, 42) + , False + ) + , ( "missing goals" + , Just 0 + , Just 1 + , Nothing + , (0, 0, 0, 10, 11, 12, 20, 21, 22) + , (1, 2, 3, 30, 31, 32, 40, 41, 42) + , False + ) + ] diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 6cb437a..38b20a6 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -43,6 +43,7 @@ import Mtlstats.Actions import Mtlstats.Types import Mtlstats.Util +import qualified Actions.GoalieInputSpec as GoalieInput import qualified TypesSpec as TS spec :: Spec @@ -62,16 +63,15 @@ spec = describe "Mtlstats.Actions" $ do addGoalieSpec resetCreatePlayerStateSpec resetCreateGoalieStateSpec - finishGameGoalieEntrySpec recordGoalAssistsSpec awardGoalSpec awardAssistSpec resetGoalDataSpec assignPMinsSpec - recordGoalieStatsSpec backHomeSpec scrollUpSpec scrollDownSpec + GoalieInput.spec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -440,23 +440,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let newProgState & progMode.createGoalieStateL .~ cgs in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState -finishGameGoalieEntrySpec :: Spec -finishGameGoalieEntrySpec = describe "finishGameGoalieEntry" $ do - let - progState stats = newProgState - & progMode.gameStateL.gameGoalieStats .~ stats - & finishGameGoalieEntry - - context "no goalie data" $ - it "should not set goaliesRecorded" $ let - s = progState M.empty - in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False - - context "goalie data" $ - it "should set goaliesRecorded" $ let - s = progState $ M.fromList [(1, newGoalieStats)] - in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True - recordGoalAssistsSpec :: Spec recordGoalAssistsSpec = describe "recordGoalAssists" $ do let @@ -696,135 +679,6 @@ assignPMinsSpec = describe "assignPMins" $ let , ( Nothing, 4, 3, 2, 6, 5, 0 ) ] -recordGoalieStatsSpec :: Spec -recordGoalieStatsSpec = describe "recordGoalieStats" $ let - goalieStats games mins goals = newGoalieStats - & gsGames .~ games - & gsMinsPlayed .~ mins - & gsGoalsAllowed .~ goals - - joe = newGoalie 2 "Joe" - & gYtd .~ goalieStats 10 11 12 - & gLifetime .~ goalieStats 20 21 22 - - bob = newGoalie 3 "Bob" - & gYtd .~ goalieStats 30 31 32 - & gLifetime .~ goalieStats 40 41 42 - - gameState n mins goals = newGameState - & gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)] - & gameSelectedGoalie .~ n - & gameGoalieMinsPlayed .~ mins - & gameGoalsAllowed .~ goals - - progState n mins goals = newProgState - & database.dbGoalies .~ [joe, bob] - & progMode.gameStateL .~ gameState n mins goals - - in mapM_ - (\(name, gid, mins, goals, joeData, bobData, reset) -> let - s = recordGoalieStats $ progState gid mins goals - in context name $ do - - mapM_ - (\( name - , gid - , ( gGames - , gMins - , gGoals - , ytdGames - , ytdMins - , ytdGoals - , ltGames - , ltMins - , ltGoals - ) - ) -> context name $ do - let - gs = s^.progMode.gameStateL.gameGoalieStats - game = M.findWithDefault newGoalieStats gid gs - goalie = fromJust $ nth gid $ s^.database.dbGoalies - ytd = goalie^.gYtd - lt = goalie^.gLifetime - - context "game" $ - game `TS.compareTest` goalieStats gGames gMins gGoals - - context "year-to-date" $ - ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals - - context "lifetime" $ - lt `TS.compareTest` goalieStats ltGames ltMins ltGoals) - - [ ( "checking Joe", 0, joeData ) - , ( "checking Bob", 1, bobData ) - ] - - context "selected goalie" $ let - expected = if reset then Nothing else gid - in it ("should be " ++ show expected) $ - (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected - - context "minutes played" $ let - expected = if reset then Nothing else mins - in it ("should be " ++ show expected) $ - (s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected - - context "goals allowed" $ let - expected = if reset then Nothing else goals - in it ("should be " ++ show expected) $ - (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected) - - [ ( "updating Joe" - , Just 0 - , Just 1 - , Just 2 - , (1, 1, 2, 11, 12, 14, 21, 22, 24) - , (1, 2, 3, 30, 31, 32, 40, 41, 42) - , True - ) - , ( "updating Bob" - , Just 1 - , Just 1 - , Just 2 - , (0, 0, 0, 10, 11, 12, 20, 21, 22) - , (1, 3, 5, 30, 32, 34, 40, 42, 44) - , True - ) - , ( "goalie out of bounds" - , Just 2 - , Just 1 - , Just 2 - , (0, 0, 0, 10, 11, 12, 20, 21, 22) - , (1, 2, 3, 30, 31, 32, 40, 41, 42) - , False - ) - , ( "missing goalie" - , Nothing - , Just 1 - , Just 2 - , (0, 0, 0, 10, 11, 12, 20, 21, 22) - , (1, 2, 3, 30, 31, 32, 40, 41, 42) - , False - ) - , ( "missing minutes" - , Just 0 - , Nothing - , Just 1 - , (0, 0, 0, 10, 11, 12, 20, 21, 22) - , (1, 2, 3, 30, 31, 32, 40, 41, 42) - , False - ) - , ( "missing goals" - , Just 0 - , Just 1 - , Nothing - , (0, 0, 0, 10, 11, 12, 20, 21, 22) - , (1, 2, 3, 30, 31, 32, 40, 41, 42) - , False - ) - ] - makePlayer :: IO Player makePlayer = Player <$> makeNum