From 8e74764cab57ab1d7c086d821877aee4a298e5b0 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 00:51:50 -0500 Subject: [PATCH 01/12] implemented promptController and promptControllerWith --- src/Mtlstats/Prompt.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 97aab82..9617f1a 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -25,6 +25,8 @@ module Mtlstats.Prompt ( -- * Prompt Functions drawPrompt, promptHandler, + promptControllerWith, + promptController, strPrompt, numPrompt, selectPrompt, @@ -90,6 +92,31 @@ promptHandler p (C.EventSpecialKey k) = promptSpecialKey p k promptHandler _ _ = return () +-- | Builds a controller out of a prompt with a header +promptControllerWith + :: (ProgState -> C.Update ()) + -- ^ The header + -> Prompt + -- ^ The prompt to use + -> Controller + -- ^ The resulting controller +promptControllerWith header prompt = Controller + { drawController = \s -> do + header s + drawPrompt prompt s + , handleController = \e -> do + promptHandler prompt e + return True + } + +-- | Builds a controller out of a prompt +promptController + :: Prompt + -- ^ The prompt to use + -> Controller + -- ^ The resulting controller +promptController = promptControllerWith (const $ return ()) + -- | Builds a string prompt strPrompt :: String From b0cf9a83a1b61530272337612b06bc5920672c4d Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 00:57:46 -0500 Subject: [PATCH 02/12] added gameGoalieAssigned field to GameState --- src/Mtlstats/Types.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 1bd6708..27e0e3c 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -74,6 +74,7 @@ module Mtlstats.Types ( goalieMinsPlayed, goalsAllowed, goaliesRecorded, + gameGoalieAssigned, -- ** CreatePlayerState Lenses cpsNumber, cpsName, @@ -274,6 +275,9 @@ data GameState = GameState -- the game , _goaliesRecorded :: Bool -- ^ Set when the user confirms that all goalie info has been entered + , _gameGoalieAssigned :: Bool + -- ^ Set to 'True' when the goalie has been selected who will be + -- given the win/loss/tie } deriving (Eq, Show) -- | The type of game @@ -645,6 +649,7 @@ newGameState = GameState , _goalieMinsPlayed = Nothing , _goalsAllowed = Nothing , _goaliesRecorded = False + , _gameGoalieAssigned = False } -- | Constructor for a 'CreatePlayerState' From 3f38160abdaa1702ff37804012f6b151b9e9ace8 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 01:24:33 -0500 Subject: [PATCH 03/12] don't mark goalies recorded unless at least one has been entered --- src/Mtlstats/Actions.hs | 6 ++++++ src/Mtlstats/Prompt.hs | 2 +- test/ActionsSpec.hs | 18 ++++++++++++++++++ 3 files changed, 25 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 0e8ca34..03a2e4c 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -37,6 +37,7 @@ module Mtlstats.Actions , addGoalie , resetCreatePlayerState , resetCreateGoalieState + , finishGameGoalieEntry , recordGoalAssists , awardGoal , awardAssist @@ -200,6 +201,11 @@ resetCreateGoalieState = progMode.createGoalieStateL %~ (cgsNumber .~ Nothing) . (cgsName .~ "") +-- | Attempts to finish game goalie entry +finishGameGoalieEntry :: ProgState -> ProgState +finishGameGoalieEntry s = s & progMode.gameStateL.goaliesRecorded + .~ not (null $ s^.progMode.gameStateL.gameGoalieStats) + -- | Awards the goal and assists to the players recordGoalAssists :: ProgState -> ProgState recordGoalAssists ps = fromMaybe ps $ do diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 9617f1a..9a05683 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -338,7 +338,7 @@ goalieNamePrompt = strPrompt "Goalie name: " $ selectGameGoaliePrompt :: Prompt selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $ \case - Nothing -> modify $ progMode.gameStateL.goaliesRecorded .~ True + Nothing -> modify finishGameGoalieEntry Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n -- | Prompts for the number of minutes the goalie has played diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 5c1cffd..c07fc64 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -62,6 +62,7 @@ spec = describe "Mtlstats.Actions" $ do addGoalieSpec resetCreatePlayerStateSpec resetCreateGoalieStateSpec + finishGameGoalieEntrySpec recordGoalAssistsSpec awardGoalSpec awardAssistSpec @@ -439,6 +440,23 @@ 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.goaliesRecorded `shouldBe` False + + context "goalie data" $ + it "should set goaliesRecorded" $ let + s = progState $ M.fromList [(1, newGoalieStats)] + in s^.progMode.gameStateL.goaliesRecorded `shouldBe` True + recordGoalAssistsSpec :: Spec recordGoalAssistsSpec = describe "recordGoalAssists" $ do let From 43f3d9eb081863a7a7408a8ae915641bc9f63658 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 01:48:47 -0500 Subject: [PATCH 04/12] renamed GameState fields to prevent name collisions --- src/Mtlstats/Actions.hs | 16 +++--- src/Mtlstats/Control.hs | 8 +-- src/Mtlstats/Control/GoalieInput.hs | 6 +-- src/Mtlstats/Prompt.hs | 12 ++--- src/Mtlstats/Types.hs | 76 ++++++++++++++--------------- test/ActionsSpec.hs | 20 ++++---- 6 files changed, 69 insertions(+), 69 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 03a2e4c..1352a79 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -203,7 +203,7 @@ resetCreateGoalieState = progMode.createGoalieStateL -- | Attempts to finish game goalie entry finishGameGoalieEntry :: ProgState -> ProgState -finishGameGoalieEntry s = s & progMode.gameStateL.goaliesRecorded +finishGameGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded .~ not (null $ s^.progMode.gameStateL.gameGoalieStats) -- | Awards the goal and assists to the players @@ -271,7 +271,7 @@ assignPMins -> ProgState -> ProgState assignPMins mins s = fromMaybe s $ do - n <- s^.progMode.gameStateL.selectedPlayer + n <- s^.progMode.gameStateL.gameSelectedPlayer Just $ s & database.dbPlayers %~ modifyNth n (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins)) @@ -279,7 +279,7 @@ assignPMins mins s = fromMaybe s $ do %~ ( gamePlayerStats %~ updateMap n newPlayerStats (psPMin +~ mins) ) - . (selectedPlayer .~ Nothing) + . (gameSelectedPlayer .~ Nothing) -- | Records the goalie's game stats recordGoalieStats :: ProgState -> ProgState @@ -287,8 +287,8 @@ recordGoalieStats s = fromMaybe s $ do let gs = s^.progMode.gameStateL gid <- gs^.gameSelectedGoalie goalie <- nth gid $ s^.database.dbGoalies - mins <- gs^.goalieMinsPlayed - goals <- gs^.goalsAllowed + mins <- gs^.gameGoalieMinsPlayed + goals <- gs^.gameGoalsAllowed let gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats @@ -304,9 +304,9 @@ recordGoalieStats s = fromMaybe s $ do Just $ s & progMode.gameStateL %~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats) - . (gameSelectedGoalie .~ Nothing) - . (goalieMinsPlayed .~ Nothing) - . (goalsAllowed .~ Nothing) + . (gameSelectedGoalie .~ Nothing) + . (gameGoalieMinsPlayed .~ Nothing) + . (gameGoalsAllowed .~ Nothing) & database.dbGoalies %~ modifyNth gid (\goalie -> goalie & gYtd %~ bumpStats diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 40e42f5..959c971 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -58,9 +58,9 @@ dispatch s = case s^.progMode of | null $ gs^.overtimeFlag -> overtimeFlagC | not $ gs^.dataVerified -> verifyDataC | fromJust (unaccountedPoints gs) -> goalInput gs - | isJust $ gs^.selectedPlayer -> getPMinsC - | not $ gs^.pMinsRecorded -> pMinPlayerC - | not $ gs^.goaliesRecorded -> goalieInput gs + | isJust $ gs^.gameSelectedPlayer -> getPMinsC + | not $ gs^.gamePMinsRecorded -> pMinPlayerC + | not $ gs^.gameGoaliesRecorded -> goalieInput gs | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC @@ -267,7 +267,7 @@ getPMinsC = Controller { drawController = \s -> do header s C.drawString $ fromMaybe "" $ do - pid <- s^.progMode.gameStateL.selectedPlayer + pid <- s^.progMode.gameStateL.gameSelectedPlayer player <- nth pid $ s^.database.dbPlayers Just $ playerSummary player ++ "\n" drawPrompt assignPMinsPrompt s diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs index 3b5fed3..2ec0c09 100644 --- a/src/Mtlstats/Control/GoalieInput.hs +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -33,9 +33,9 @@ import Mtlstats.Util -- | The dispatcher for handling goalie input goalieInput :: GameState -> Controller goalieInput gs - | null $ gs^.gameSelectedGoalie = selectGoalieC - | null $ gs^.goalieMinsPlayed = minsPlayedC - | otherwise = goalsAllowedC + | null $ gs^.gameSelectedGoalie = selectGoalieC + | null $ gs^.gameGoalieMinsPlayed = minsPlayedC + | otherwise = goalsAllowedC selectGoalieC :: Controller selectGoalieC = Controller diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 9a05683..7f530ae 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -316,8 +316,8 @@ pMinPlayerPrompt :: Prompt pMinPlayerPrompt = selectPlayerPrompt "Assign penalty minutes to: " $ \case - Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True - Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n + Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True + Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n -- | Prompts for the number of penalty mintues to assign to the player assignPMinsPrompt :: Prompt @@ -344,15 +344,15 @@ selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $ -- | Prompts for the number of minutes the goalie has played goalieMinsPlayedPrompt :: Prompt goalieMinsPlayedPrompt = numPrompt "Minutes played: " $ - modify . (progMode.gameStateL.goalieMinsPlayed ?~) + modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~) -- | Prompts for the number of goals the goalie allowed goalsAllowedPrompt :: Prompt goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do - modify (progMode.gameStateL.goalsAllowed ?~ n) - mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.goalieMinsPlayed) + modify (progMode.gameStateL.gameGoalsAllowed ?~ n) + mins <- fromMaybe 0 <$> gets (^.progMode.gameStateL.gameGoalieMinsPlayed) when (mins >= gameLength) $ - modify $ progMode.gameStateL.goaliesRecorded .~ True + modify $ progMode.gameStateL.gameGoaliesRecorded .~ True modify recordGoalieStats playerToEditPrompt :: Prompt diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 27e0e3c..fb80cb6 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -67,13 +67,13 @@ module Mtlstats.Types ( assistsBy, gamePlayerStats, confirmGoalDataFlag, - selectedPlayer, - pMinsRecorded, + gameSelectedPlayer, + gamePMinsRecorded, gameGoalieStats, gameSelectedGoalie, - goalieMinsPlayed, - goalsAllowed, - goaliesRecorded, + gameGoalieMinsPlayed, + gameGoalsAllowed, + gameGoaliesRecorded, gameGoalieAssigned, -- ** CreatePlayerState Lenses cpsNumber, @@ -252,30 +252,30 @@ data GameState = GameState , _goalBy :: Maybe Int -- ^ The index number of the player who scored the most recently -- entered goal - , _assistsBy :: [Int] + , _assistsBy :: [Int] -- ^ The index numbers of the players who have assisted the most -- recently entered goal - , _gamePlayerStats :: M.Map Int PlayerStats + , _gamePlayerStats :: M.Map Int PlayerStats -- ^ The player stats accumulated over the game - , _confirmGoalDataFlag :: Bool + , _confirmGoalDataFlag :: Bool -- ^ Set when the user confirms the goal data - , _selectedPlayer :: Maybe Int + , _gameSelectedPlayer :: Maybe Int -- ^ Index number of the selected 'Player' - , _pMinsRecorded :: Bool + , _gamePMinsRecorded :: Bool -- ^ Set when the penalty mintes have been recorded - , _gameGoalieStats :: M.Map Int GoalieStats + , _gameGoalieStats :: M.Map Int GoalieStats -- ^ The goalie stats accumulated over the game - , _gameSelectedGoalie :: Maybe Int + , _gameSelectedGoalie :: Maybe Int -- ^ Index number of the selected 'Goalie' - , _goalieMinsPlayed :: Maybe Int + , _gameGoalieMinsPlayed :: Maybe Int -- ^ The number of minutes the currently selected goalie played in -- the game - , _goalsAllowed :: Maybe Int + , _gameGoalsAllowed :: Maybe Int -- ^ The number of goals the currently selected goalie allowed in -- the game - , _goaliesRecorded :: Bool + , _gameGoaliesRecorded :: Bool -- ^ Set when the user confirms that all goalie info has been entered - , _gameGoalieAssigned :: Bool + , _gameGoalieAssigned :: Bool -- ^ Set to 'True' when the goalie has been selected who will be -- given the win/loss/tie } deriving (Eq, Show) @@ -628,28 +628,28 @@ 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 - , _pointsAccounted = 0 - , _goalBy = Nothing - , _assistsBy = [] - , _gamePlayerStats = M.empty - , _confirmGoalDataFlag = False - , _selectedPlayer = Nothing - , _pMinsRecorded = False - , _gameGoalieStats = M.empty - , _gameSelectedGoalie = Nothing - , _goalieMinsPlayed = Nothing - , _goalsAllowed = Nothing - , _goaliesRecorded = False - , _gameGoalieAssigned = False + { _gameYear = Nothing + , _gameMonth = Nothing + , _gameDay = Nothing + , _gameType = Nothing + , _otherTeam = "" + , _homeScore = Nothing + , _awayScore = Nothing + , _overtimeFlag = Nothing + , _dataVerified = False + , _pointsAccounted = 0 + , _goalBy = Nothing + , _assistsBy = [] + , _gamePlayerStats = M.empty + , _confirmGoalDataFlag = False + , _gameSelectedPlayer = Nothing + , _gamePMinsRecorded = False + , _gameGoalieStats = M.empty + , _gameSelectedGoalie = Nothing + , _gameGoalieMinsPlayed = Nothing + , _gameGoalsAllowed = Nothing + , _gameGoaliesRecorded = False + , _gameGoalieAssigned = False } -- | Constructor for a 'CreatePlayerState' diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index c07fc64..6cb437a 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -450,12 +450,12 @@ finishGameGoalieEntrySpec = describe "finishGameGoalieEntry" $ do context "no goalie data" $ it "should not set goaliesRecorded" $ let s = progState M.empty - in s^.progMode.gameStateL.goaliesRecorded `shouldBe` False + 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.goaliesRecorded `shouldBe` True + in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True recordGoalAssistsSpec :: Spec recordGoalAssistsSpec = describe "recordGoalAssists" $ do @@ -655,7 +655,7 @@ assignPMinsSpec = describe "assignPMins" $ let & database.dbPlayers .~ [bob, joe] & progMode.gameStateL %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)]) - . (selectedPlayer .~ pid) + . (gameSelectedPlayer .~ pid) in mapM_ (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) -> @@ -687,7 +687,7 @@ assignPMinsSpec = describe "assignPMins" $ let ] it "should set selectedPlayer to Nothing" $ - ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing) + ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing) -- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game [ ( Just 0, 6, 5, 4, 6, 5, 0 ) @@ -712,10 +712,10 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let & gLifetime .~ goalieStats 40 41 42 gameState n mins goals = newGameState - & gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)] - & gameSelectedGoalie .~ n - & goalieMinsPlayed .~ mins - & goalsAllowed .~ goals + & gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)] + & gameSelectedGoalie .~ n + & gameGoalieMinsPlayed .~ mins + & gameGoalsAllowed .~ goals progState n mins goals = newProgState & database.dbGoalies .~ [joe, bob] @@ -768,12 +768,12 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let context "minutes played" $ let expected = if reset then Nothing else mins in it ("should be " ++ show expected) $ - (s^.progMode.gameStateL.goalieMinsPlayed) `shouldBe` 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.goalsAllowed) `shouldBe` expected) + (s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected) [ ( "updating Joe" , Just 0 From 2f767209bb5aea63f528b5041319401e4302282b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 02:38:48 -0500 Subject: [PATCH 05/12] 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 From 76c0a85a50f3defc2361b64c7d219bfe324d8463 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 02:41:50 -0500 Subject: [PATCH 06/12] don't show game report until a game goalie has been assigned --- src/Mtlstats/Control.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 959c971..412568c 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -60,7 +60,7 @@ dispatch s = case s^.progMode of | fromJust (unaccountedPoints gs) -> goalInput gs | isJust $ gs^.gameSelectedPlayer -> getPMinsC | not $ gs^.gamePMinsRecorded -> pMinPlayerC - | not $ gs^.gameGoaliesRecorded -> goalieInput gs + | not $ gs^.gameGoalieAssigned -> goalieInput gs | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC From 2a9ff93642cdd75cb7e9891eb67bfe5d04e109b6 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 02:47:11 -0500 Subject: [PATCH 07/12] use proptController and promptControllerWith in goalie input controller --- src/Mtlstats/Control/GoalieInput.hs | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs index 684cbbc..3d9cbf2 100644 --- a/src/Mtlstats/Control/GoalieInput.hs +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -39,35 +39,16 @@ goalieInput gs | otherwise = goalsAllowedC selectGoalieC :: Controller -selectGoalieC = Controller - { drawController = drawPrompt selectGameGoaliePrompt - , handleController = \e -> do - promptHandler selectGameGoaliePrompt e - return True - } +selectGoalieC = promptController selectGameGoaliePrompt minsPlayedC :: Controller -minsPlayedC = Controller - { drawController = \s -> do - C.drawString $ header s - drawPrompt goalieMinsPlayedPrompt s - , handleController = \e -> do - promptHandler goalieMinsPlayedPrompt e - return True - } +minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt goalsAllowedC :: Controller -goalsAllowedC = Controller - { drawController = \s -> do - C.drawString $ header s - drawPrompt goalsAllowedPrompt s - , handleController = \e -> do - promptHandler goalsAllowedPrompt e - return True - } +goalsAllowedC = promptControllerWith header goalsAllowedPrompt -header :: ProgState -> String -header s = unlines +header :: ProgState -> C.Update () +header s = C.drawString $ unlines [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***" , fromMaybe "" $ do n <- s^.progMode.gameStateL.gameSelectedGoalie From 7fd837863bb651599e6e94e1b1e938748b84266b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 02:50:10 -0500 Subject: [PATCH 08/12] call selectGameGoalieC when goalie info entered for game --- src/Mtlstats/Control/GoalieInput.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs index 3d9cbf2..722a38a 100644 --- a/src/Mtlstats/Control/GoalieInput.hs +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -34,6 +34,7 @@ import Mtlstats.Util -- | The dispatcher for handling goalie input goalieInput :: GameState -> Controller goalieInput gs + | gs^.gameGoaliesRecorded = selectGameGoalieC | null $ gs^.gameSelectedGoalie = selectGoalieC | null $ gs^.gameGoalieMinsPlayed = minsPlayedC | otherwise = goalsAllowedC @@ -47,6 +48,9 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt goalsAllowedC :: Controller goalsAllowedC = promptControllerWith header goalsAllowedPrompt +selectGameGoalieC :: Controller +selectGameGoalieC = undefined + header :: ProgState -> C.Update () header s = C.drawString $ unlines [ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***" From d708bed77ddb906d59787c3edf3633c069e87858 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 03:00:02 -0500 Subject: [PATCH 09/12] simplified goalsAllowedPrompt --- src/Mtlstats/Actions/GoalieInput.hs | 6 ++++++ src/Mtlstats/Prompt/GoalieInput.hs | 3 --- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Mtlstats/Actions/GoalieInput.hs b/src/Mtlstats/Actions/GoalieInput.hs index acae846..c8280a9 100644 --- a/src/Mtlstats/Actions/GoalieInput.hs +++ b/src/Mtlstats/Actions/GoalieInput.hs @@ -28,6 +28,7 @@ import qualified Data.Map as M import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (&), (.~), (%~), (+~)) +import Mtlstats.Config import Mtlstats.Types import Mtlstats.Util @@ -56,6 +57,10 @@ recordGoalieStats s = fromMaybe s $ do & gsMinsPlayed +~ mins & gsGoalsAllowed +~ goals + tryFinish = if mins >= gameLength + then finishGoalieEntry + else id + Just $ s & progMode.gameStateL %~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats) @@ -66,3 +71,4 @@ recordGoalieStats s = fromMaybe s $ do %~ modifyNth gid (\goalie -> goalie & gYtd %~ bumpStats & gLifetime %~ bumpStats) + & tryFinish diff --git a/src/Mtlstats/Prompt/GoalieInput.hs b/src/Mtlstats/Prompt/GoalieInput.hs index bda49d2..c811c43 100644 --- a/src/Mtlstats/Prompt/GoalieInput.hs +++ b/src/Mtlstats/Prompt/GoalieInput.hs @@ -53,7 +53,4 @@ goalieMinsPlayedPrompt = numPrompt "Minutes played: " $ 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 From 4910200c96a20c50de479440dec11c7dcfa30001 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 04:12:20 -0500 Subject: [PATCH 10/12] implemented selectGameGoalieC --- src/Mtlstats/Actions/GoalieInput.hs | 9 ++++++++ src/Mtlstats/Control.hs | 2 +- src/Mtlstats/Control/GoalieInput.hs | 21 +++++++++++-------- src/Mtlstats/Menu.hs | 32 ++++++++++++++++++++++++++++- 4 files changed, 54 insertions(+), 10 deletions(-) diff --git a/src/Mtlstats/Actions/GoalieInput.hs b/src/Mtlstats/Actions/GoalieInput.hs index c8280a9..bef227f 100644 --- a/src/Mtlstats/Actions/GoalieInput.hs +++ b/src/Mtlstats/Actions/GoalieInput.hs @@ -22,6 +22,7 @@ along with this program. If not, see . module Mtlstats.Actions.GoalieInput ( finishGoalieEntry , recordGoalieStats + , setGameGoalie ) where import qualified Data.Map as M @@ -72,3 +73,11 @@ recordGoalieStats s = fromMaybe s $ do & gYtd %~ bumpStats & gLifetime %~ bumpStats) & tryFinish + +-- | Records the win, loss, or tie to a specific 'Goalie' +setGameGoalie + :: Int + -- ^ The goalie's index + -> ProgState + -> ProgState +setGameGoalie = undefined diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 412568c..1e45218 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -60,7 +60,7 @@ dispatch s = case s^.progMode of | fromJust (unaccountedPoints gs) -> goalInput gs | isJust $ gs^.gameSelectedPlayer -> getPMinsC | not $ gs^.gamePMinsRecorded -> pMinPlayerC - | not $ gs^.gameGoalieAssigned -> goalieInput gs + | not $ gs^.gameGoalieAssigned -> goalieInput s | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC diff --git a/src/Mtlstats/Control/GoalieInput.hs b/src/Mtlstats/Control/GoalieInput.hs index 722a38a..2718c15 100644 --- a/src/Mtlstats/Control/GoalieInput.hs +++ b/src/Mtlstats/Control/GoalieInput.hs @@ -26,18 +26,23 @@ import Lens.Micro ((^.)) import qualified UI.NCurses as C import Mtlstats.Format +import Mtlstats.Menu import Mtlstats.Prompt import Mtlstats.Prompt.GoalieInput import Mtlstats.Types import Mtlstats.Util -- | The dispatcher for handling goalie input -goalieInput :: GameState -> Controller -goalieInput gs - | gs^.gameGoaliesRecorded = selectGameGoalieC - | null $ gs^.gameSelectedGoalie = selectGoalieC - | null $ gs^.gameGoalieMinsPlayed = minsPlayedC - | otherwise = goalsAllowedC +goalieInput :: ProgState -> Controller +goalieInput s = let + gs = s^.progMode.gameStateL + in if gs^.gameGoaliesRecorded + then selectGameGoalieC s + else if null $ gs^.gameSelectedGoalie + then selectGoalieC + else if null $ gs^.gameGoalieMinsPlayed + then minsPlayedC + else goalsAllowedC selectGoalieC :: Controller selectGoalieC = promptController selectGameGoaliePrompt @@ -48,8 +53,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt goalsAllowedC :: Controller goalsAllowedC = promptControllerWith header goalsAllowedPrompt -selectGameGoalieC :: Controller -selectGameGoalieC = undefined +selectGameGoalieC :: ProgState -> Controller +selectGameGoalieC = menuController . gameGoalieMenu header :: ProgState -> C.Update () header s = C.drawString $ unlines diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index b365078..0bce690 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -21,6 +21,7 @@ along with this program. If not, see . module Mtlstats.Menu ( -- * Menu Functions + menuController, drawMenu, menuHandler, -- * Menus @@ -28,13 +29,16 @@ module Mtlstats.Menu ( newSeasonMenu, gameMonthMenu, gameTypeMenu, - editPlayerMenu + editPlayerMenu, + gameGoalieMenu ) where import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (gets, modify) import Data.Aeson (encodeFile) import Data.Char (toUpper) +import qualified Data.Map as M +import Data.Maybe (mapMaybe) import Lens.Micro ((^.), (.~), (?~)) import Lens.Micro.Extras (view) import System.EasyFile @@ -45,9 +49,20 @@ import System.EasyFile import qualified UI.NCurses as C import Mtlstats.Actions +import qualified Mtlstats.Actions.GoalieInput as GI import Mtlstats.Config import Mtlstats.Types import Mtlstats.Types.Menu +import Mtlstats.Util + +-- | Generates a simple 'Controller' for a Menu +menuController :: Menu () -> Controller +menuController menu = Controller + { drawController = const $ drawMenu menu + , handleController = \e -> do + menuHandler menu e + return True + } -- | The draw function for a 'Menu' drawMenu :: Menu a -> C.Update C.CursorMode @@ -142,3 +157,18 @@ editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map , ( '9', "Lifetime penalty mins", Just EPLtPMin ) , ( '0', "Finished editing", Nothing ) ] + +-- | Game goalie selection menu +gameGoalieMenu :: ProgState -> Menu () +gameGoalieMenu s = let + title = "Which goalie should get credit for the game?" + gids = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats + goalies = mapMaybe + (\n -> do + goalie <- nth n $ s^.database.dbGoalies + Just (n, goalie)) + gids + in Menu title () $ map + (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $ + modify $ GI.setGameGoalie gid) $ + zip ['1'..] goalies From c6c461f5845fc56426f1682707a2144c94eb605a Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 05:44:08 -0500 Subject: [PATCH 11/12] implemented win/loss/tie tallying --- src/Mtlstats/Actions/GoalieInput.hs | 24 ++++++- test/Actions/GoalieInputSpec.hs | 106 +++++++++++++++++++++++++++- 2 files changed, 128 insertions(+), 2 deletions(-) diff --git a/src/Mtlstats/Actions/GoalieInput.hs b/src/Mtlstats/Actions/GoalieInput.hs index bef227f..4a9594e 100644 --- a/src/Mtlstats/Actions/GoalieInput.hs +++ b/src/Mtlstats/Actions/GoalieInput.hs @@ -80,4 +80,26 @@ setGameGoalie -- ^ The goalie's index -> ProgState -> ProgState -setGameGoalie = undefined +setGameGoalie gid s = fromMaybe s $ do + let gs = s^.progMode.gameStateL + won <- gameWon gs + lost <- gameLost gs + tied <- gs^.overtimeFlag + let + w = if won then 1 else 0 + l = if lost then 1 else 0 + t = if tied then 1 else 0 + + updateStats gs = gs + & gsWins +~ w + & gsLosses +~ l + & gsTies +~ t + + updateGoalie g = g + & gYtd %~ updateStats + & gLifetime %~ updateStats + + Just $ s + & database.dbGoalies %~ modifyNth gid updateGoalie + & progMode.gameStateL.gameGoalieStats + %~ updateMap gid newGoalieStats updateStats diff --git a/test/Actions/GoalieInputSpec.hs b/test/Actions/GoalieInputSpec.hs index c9a6585..dc2c9a8 100644 --- a/test/Actions/GoalieInputSpec.hs +++ b/test/Actions/GoalieInputSpec.hs @@ -23,7 +23,7 @@ module Actions.GoalieInputSpec (spec) where import qualified Data.Map as M import Data.Maybe (fromJust) -import Lens.Micro ((^.), (&), (.~)) +import Lens.Micro ((^.), (&), (.~), (?~)) import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Actions.GoalieInput @@ -36,6 +36,7 @@ spec :: Spec spec = describe "Mtlstats.Actions.GoalieInput" $ do finishGoalieEntrySpec recordGoalieStatsSpec + setGameGoalieSpec finishGoalieEntrySpec :: Spec finishGoalieEntrySpec = describe "finishGoalieEntry" $ do @@ -182,3 +183,106 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let , False ) ] + +setGameGoalieSpec :: Spec +setGameGoalieSpec = describe "setGameGoalie" $ let + + goalieStats w l t = newGoalieStats + & gsWins .~ w + & gsLosses .~ l + & gsTies .~ t + + bob = newGoalie 2 "Bob" + & gYtd .~ goalieStats 10 11 12 + & gLifetime .~ goalieStats 20 21 22 + + joe = newGoalie 3 "Joe" + & gYtd .~ goalieStats 30 31 32 + & gLifetime .~ goalieStats 40 41 42 + + gameState h a ot = newGameState + & gameType ?~ HomeGame + & homeScore ?~ h + & awayScore ?~ a + & overtimeFlag ?~ ot + + winningGame = gameState 1 0 False + losingGame = gameState 0 1 False + tiedGame = gameState 0 1 True + + in mapM_ + (\(label, gameState, gid, bobData, joeData) -> context label $ let + + progState = newProgState + & database.dbGoalies .~ [bob, joe] + & progMode.gameStateL .~ gameState + & setGameGoalie gid + + in mapM_ + (\( label + , gid + , ( gWins + , gLosses + , gTies + , ytdWins + , ytdLosses + , ytdTies + , ltWins + , ltLosses + , ltTies + ) + ) -> context label $ do + let + goalie = (progState^.database.dbGoalies) !! gid + gameStats = progState^.progMode.gameStateL.gameGoalieStats + game = M.findWithDefault newGoalieStats gid gameStats + ytd = goalie^.gYtd + lifetime = goalie^.gLifetime + + mapM_ + (\(label, expected, actual) -> context label $ + expected `TS.compareTest` actual) + [ ( "game stats", game, goalieStats gWins gLosses gTies ) + , ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies ) + , ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies ) + ]) + [ ( "checking Bob", 0, bobData ) + , ( "checking Joe", 1, joeData ) + ]) + [ ( "Bob wins" + , winningGame + , 0 + , ( 1, 0, 0, 11, 11, 12, 21, 21, 22 ) + , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 ) + ) + , ( "Bob loses" + , losingGame + , 0 + , ( 0, 1, 0, 10, 12, 12, 20, 22, 22 ) + , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 ) + ) + , ( "Bob ties" + , tiedGame + , 0 + , ( 0, 0, 1, 10, 11, 13, 20, 21, 23 ) + , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 ) + ) + , ( "Joe wins" + , winningGame + , 1 + , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) + , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 ) + ) + , ( "Joe loses" + , losingGame + , 1 + , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) + , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 ) + ) + , ( "Joe ties" + , tiedGame + , 1 + , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) + , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 ) + ) + ] From 405ca1c5c7beed32c1d616bfa896d3d676c50104 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Mon, 4 Nov 2019 05:58:39 -0500 Subject: [PATCH 12/12] don't hang on goalie selection --- src/Mtlstats/Actions/GoalieInput.hs | 9 ++++++--- test/Actions/GoalieInputSpec.hs | 5 ++++- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Mtlstats/Actions/GoalieInput.hs b/src/Mtlstats/Actions/GoalieInput.hs index 4a9594e..17f92ec 100644 --- a/src/Mtlstats/Actions/GoalieInput.hs +++ b/src/Mtlstats/Actions/GoalieInput.hs @@ -99,7 +99,10 @@ setGameGoalie gid s = fromMaybe s $ do & gYtd %~ updateStats & gLifetime %~ updateStats + updateGameState gs = gs + & gameGoalieStats %~ updateMap gid newGoalieStats updateStats + & gameGoalieAssigned .~ True + Just $ s - & database.dbGoalies %~ modifyNth gid updateGoalie - & progMode.gameStateL.gameGoalieStats - %~ updateMap gid newGoalieStats updateStats + & database.dbGoalies %~ modifyNth gid updateGoalie + & progMode.gameStateL %~ updateGameState diff --git a/test/Actions/GoalieInputSpec.hs b/test/Actions/GoalieInputSpec.hs index dc2c9a8..4d9a0ae 100644 --- a/test/Actions/GoalieInputSpec.hs +++ b/test/Actions/GoalieInputSpec.hs @@ -245,7 +245,10 @@ setGameGoalieSpec = describe "setGameGoalie" $ let [ ( "game stats", game, goalieStats gWins gLosses gTies ) , ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies ) , ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies ) - ]) + ] + + it "should set the gameGoalieAssigned flag" $ + progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True) [ ( "checking Bob", 0, bobData ) , ( "checking Joe", 1, joeData ) ])