From fc58b0a72b68643b7dfdd9d060d375fcc5c340e3 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 25 Sep 2019 01:30:28 -0400 Subject: [PATCH 1/8] added maxAssists config value --- src/Mtlstats/Config.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Mtlstats/Config.hs b/src/Mtlstats/Config.hs index 22bc105..9a5137f 100644 --- a/src/Mtlstats/Config.hs +++ b/src/Mtlstats/Config.hs @@ -36,3 +36,7 @@ appName = "mtlstats" -- | The database filename dbFname :: String dbFname = "database.json" + +-- | The maximum number of assists +maxAssists :: Int +maxAssists = 2 From 625d9c616ab76d8fe5d63790bb6993544abab2f3 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 25 Sep 2019 02:41:35 -0400 Subject: [PATCH 2/8] added goalBy and assistsBy to GameState --- src/Mtlstats/Types.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 25f2fc5..d31399a 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -56,6 +56,8 @@ module Mtlstats.Types ( overtimeFlag, dataVerified, pointsAccounted, + goalBy, + assistsBy, -- ** CreatePlayerState Lenses cpsNumber, cpsName, @@ -203,6 +205,11 @@ data GameState = GameState , _dataVerified :: Bool -- ^ Set to 'True' when the user confirms the entered data , _pointsAccounted :: Int + -- ^ The number of game points accounted for + , _goalBy :: String + -- ^ The player who scored the most recently entered goal + , _assistsBy :: [String] + -- ^ The players who have assisted the most recently entered goal } deriving (Eq, Show) -- | The type of game @@ -499,6 +506,8 @@ newGameState = GameState , _overtimeFlag = Nothing , _dataVerified = False , _pointsAccounted = 0 + , _goalBy = "" + , _assistsBy = [] } -- | Constructor for a 'CreatePlayerState' From 8c8a2d52a69cb838f216cef84cb2accc64dd9846 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 25 Sep 2019 02:28:48 -0400 Subject: [PATCH 3/8] implemented modifyPlayer --- src/Mtlstats/Types.hs | 18 +++++++++++++++++- test/TypesSpec.hs | 26 ++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index d31399a..c385b64 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -126,7 +126,8 @@ module Mtlstats.Types ( -- ** Player Helpers pPoints, playerSearch, - playerSearchExact + playerSearchExact, + modifyPlayer ) where import Control.Monad.Trans.State (StateT) @@ -692,3 +693,18 @@ playerSearchExact sStr = filter (match sStr) . zip [0..] where match sStr (_, p) = p^.pName == sStr + +-- | Modifies a player with a given name +modifyPlayer + :: (Player -> Player) + -- ^ The modification function + -> String + -- ^ The player's name + -> [Player] + -- ^ The list of players to modify + -> [Player] + -- ^ The modified list +modifyPlayer f n = map + (\p -> if p^.pName == n + then f p + else p) diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index e617f45..13999c5 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -57,6 +57,7 @@ spec = describe "Mtlstats.Types" $ do pPointsSpec playerSearchSpec playerSearchExactSpec + modifyPlayerSpec Menu.spec playerSpec :: Spec @@ -552,6 +553,31 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_ , ( "", Nothing ) ] +modifyPlayerSpec :: Spec +modifyPlayerSpec = describe "modifyPlayer" $ mapM_ + (\(pName, j, b, s) -> let + modifier = pLifetime.psGoals .~ 1 + players = modifyPlayer modifier pName [joe, bob, steve] + in context ("modify " ++ pName) $ do + + context "Joe's lifetime goals" $ + it ("should be " ++ show j) $ + head players ^. pLifetime.psGoals `shouldBe` j + + context "Bob's lifetime goals" $ + it ("should be " ++ show b) $ + (players !! 1) ^. pLifetime.psGoals `shouldBe` b + + context "Steve's lifetime goals" $ + it ("should be " ++ show s) $ + last players ^. pLifetime.psGoals `shouldBe` s) + -- player name, Joe's goals, Bob's goals, Steve's goals + [ ( "Joe", 1, 0, 0 ) + , ( "Bob", 0, 1, 0 ) + , ( "Steve", 0, 0, 1 ) + , ( "Sam", 0, 0, 0 ) + ] + joe :: Player joe = newPlayer 2 "Joe" "center" From ffdb8e1e8cea5caa9852272f759f41e95abfa87e Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 25 Sep 2019 02:44:42 -0400 Subject: [PATCH 4/8] framework for recording assists --- src/Mtlstats/Control.hs | 10 +++++++++- src/Mtlstats/Prompt.hs | 13 +++++++------ 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 8b00523..3c4834d 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -53,7 +53,7 @@ dispatch s = case s^.progMode of | null $ gs^.awayScore -> awayScoreC | null $ gs^.overtimeFlag -> overtimeFlagC | not $ gs^.dataVerified -> verifyDataC - | fromJust (unaccountedPoints gs) -> recordGoalC + | fromJust (unaccountedPoints gs) -> goalInput gs | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC @@ -182,6 +182,11 @@ verifyDataC = Controller return True } +goalInput :: GameState -> Controller +goalInput gs + | null (gs^.goalBy) = recordGoalC + | otherwise = recordAssistC + recordGoalC :: Controller recordGoalC = Controller { drawController = \s -> let @@ -195,6 +200,9 @@ recordGoalC = Controller return True } +recordAssistC :: Controller +recordAssistC = undefined + reportC :: Controller reportC = Controller { drawController = \s -> do diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 04bb138..ee101d2 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -205,13 +205,14 @@ recordGoalPrompt -- ^ The goal number -> Prompt recordGoalPrompt game goal = selectPlayerPrompt - ("*** GAME " ++ padNum 2 game ++ " ***\n" ++ - "Who scored goal number " ++ show goal ++ "? ") $ - \case + ( "*** GAME " ++ padNum 2 game ++ " ***\n" ++ + "Who scored goal number " ++ show goal ++ "? " + ) $ \case Nothing -> return () - Just n -> modify - $ awardGoal n - . (progMode.gameStateL.pointsAccounted %~ succ) + Just n -> nth n <$> gets (view $ database.dbPlayers) + >>= maybe + (return ()) + (\p -> modify $ progMode.gameStateL.goalBy .~ p^.pName) drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer From 75803edfe77c1626efcf7284692db589500ee2bc Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 26 Sep 2019 01:23:34 -0400 Subject: [PATCH 5/8] implemented assist prompt --- src/Mtlstats/Actions.hs | 5 +++++ src/Mtlstats/Control.hs | 28 +++++++++++++++++++++++----- src/Mtlstats/Prompt.hs | 29 +++++++++++++++++++++++++++-- 3 files changed, 55 insertions(+), 7 deletions(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 4cf62d4..1d58d1b 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -32,6 +32,7 @@ module Mtlstats.Actions , validateGameDate , createPlayer , addPlayer + , recordGoalAssists , awardGoal ) where @@ -149,6 +150,10 @@ addPlayer s = fromMaybe s $ do Just $ s & database.dbPlayers %~ (player:) +-- | Awards the goal and assists to the players +recordGoalAssists :: ProgState -> ProgState +recordGoalAssists = undefined + -- | Awards a goal to a player awardGoal :: Int diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 3c4834d..8678ef2 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -190,18 +190,24 @@ goalInput gs recordGoalC :: Controller recordGoalC = Controller { drawController = \s -> let - game = s^.database.dbGames - goal = succ $ s^.progMode.gameStateL.pointsAccounted + (game, goal) = gameGoal s in drawPrompt (recordGoalPrompt game goal) s , handleController = \e -> do - game <- gets $ view $ database.dbGames - goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted) + (game, goal) <- gets gameGoal promptHandler (recordGoalPrompt game goal) e return True } recordAssistC :: Controller -recordAssistC = undefined +recordAssistC = Controller + { drawController = \s -> let + (game, goal, assist) = gameGoalAssist s + in drawPrompt (recordAssistPrompt game goal assist) s + , handleController = \e -> do + (game, goal, assist) <- gets gameGoalAssist + promptHandler (recordAssistPrompt game goal assist) e + return True + } reportC :: Controller reportC = Controller @@ -266,3 +272,15 @@ confirmCreatePlayerC = Controller Nothing -> return () return True } + +gameGoal :: ProgState -> (Int, Int) +gameGoal s = + ( s^.database.dbGames + , succ $ s^.progMode.gameStateL.pointsAccounted + ) + +gameGoalAssist :: ProgState -> (Int, Int, Int) +gameGoalAssist s = let + (game, goal) = gameGoal s + assist = succ $ length $ s^.progMode.gameStateL.assistsBy + in (game, goal, assist) diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index ee101d2..9d36ab9 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -38,6 +38,7 @@ module Mtlstats.Prompt ( playerPosPrompt, selectPlayerPrompt, recordGoalPrompt, + recordAssistPrompt ) where import Control.Monad (when) @@ -205,8 +206,8 @@ recordGoalPrompt -- ^ The goal number -> Prompt recordGoalPrompt game goal = selectPlayerPrompt - ( "*** GAME " ++ padNum 2 game ++ " ***\n" ++ - "Who scored goal number " ++ show goal ++ "? " + ( "*** GAME " ++ padNum 2 game ++ " ***\n" + ++ "Who scored goal number " ++ show goal ++ "? " ) $ \case Nothing -> return () Just n -> nth n <$> gets (view $ database.dbPlayers) @@ -214,5 +215,29 @@ recordGoalPrompt game goal = selectPlayerPrompt (return ()) (\p -> modify $ progMode.gameStateL.goalBy .~ p^.pName) +-- | Prompts for a player who assisted the goal +recordAssistPrompt + :: Int + -- ^ The game number + -> Int + -- ^ The goal nuber + -> Int + -- ^ The assist number + -> Prompt +recordAssistPrompt game goal assist = selectPlayerPrompt + ( "*** GAME " ++ padNum 2 game ++ " ***\n" + ++ "Goal: " ++ show goal ++ "\n" + ++ "Assist #" ++ show assist ++ ": " + ) $ \case + Nothing -> modify recordGoalAssists + Just n -> nth n <$> gets (view $ database.dbPlayers) + >>= maybe + (return ()) + (\p -> do + modify $ progMode.gameStateL.assistsBy %~ (++[p^.pName]) + nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy) + when (nAssists >= maxAssists) $ + modify recordGoalAssists) + drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer From c7c267b2a1490d3611959bcbc1655dcc0f63d0eb Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 26 Sep 2019 01:36:10 -0400 Subject: [PATCH 6/8] pressing enter without input results in player search failure --- src/Mtlstats/Prompt.hs | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 9d36ab9..9d7f0d8 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -168,23 +168,25 @@ selectPlayerPrompt pStr callback = Prompt 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 + , promptAction = \sStr -> if null sStr + then callback Nothing + else 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 From 11fcbfcbdd95e201fffbd8b8f656682bb33fe080 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Thu, 26 Sep 2019 02:07:55 -0400 Subject: [PATCH 7/8] implemented awardAssist --- src/Mtlstats/Actions.hs | 16 ++++++++++++ test/ActionsSpec.hs | 57 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 73 insertions(+) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 1d58d1b..a186dbf 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -34,6 +34,7 @@ module Mtlstats.Actions , addPlayer , recordGoalAssists , awardGoal + , awardAssist ) where import Control.Monad.Trans.State (modify) @@ -168,3 +169,18 @@ awardGoal n ps = ps & pYtd.psGoals %~ succ & pLifetime.psGoals %~ succ else p) . zip [0..] + +-- | Awards an assist to a player +awardAssist + :: Int + -- ^ The player's index number + -> ProgState + -> ProgState +awardAssist n ps = ps + & database.dbPlayers + %~ map + (\(i, p) -> if i == n + then p + & pYtd.psAssists %~ succ + & pLifetime.psAssists %~ succ + else p) . zip [0..] diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 1566af6..88707ee 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -42,6 +42,7 @@ spec = describe "Mtlstats.Actions" $ do createPlayerSpec addPlayerSpec awardGoalSpec + awardAssistSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -408,6 +409,62 @@ awardGoalSpec = describe "awardGoal" $ do in it "should not change the database" $ ps'^.database `shouldBe` db +awardAssistSpec :: Spec +awardAssistSpec = describe "awardAssist" $ do + let + joe + = newPlayer 1 "Joe" "centre" + & pYtd.psAssists .~ 1 + & pLifetime.psAssists .~ 2 + bob + = newPlayer 2 "Bob" "defense" + & pYtd.psAssists .~ 3 + & pLifetime.psAssists .~ 4 + ps + = newProgState + & database.dbPlayers .~ [joe, bob] + + context "Joe" $ do + let + ps' = awardAssist 0 ps + joe' = head $ ps'^.database.dbPlayers + bob' = last $ ps'^.database.dbPlayers + + it "should increment Joe's year-to-date assists" $ + joe'^.pYtd.psAssists `shouldBe` 2 + + it "should increment Joe's lifetime assists" $ + joe'^.pLifetime.psAssists `shouldBe` 3 + + it "should leave Bob's year-to-date assists alone" $ + bob'^.pYtd.psAssists `shouldBe` 3 + + it "should leave Bob's lifetime assists alone" $ + bob^.pLifetime.psAssists `shouldBe` 4 + + context "Bob" $ do + let + ps' = awardAssist 1 ps + joe' = head $ ps'^.database.dbPlayers + bob' = last $ ps'^.database.dbPlayers + + it "should leave Joe's year-to-date assists alone" $ + joe'^.pYtd.psAssists `shouldBe` 1 + + it "should leave Joe's lifetime assists alone" $ + joe'^.pLifetime.psAssists `shouldBe` 2 + + it "should increment Bob's year-to-date assists" $ + bob'^.pYtd.psAssists `shouldBe` 4 + + it "should increment Bob's lifetime assists" $ + bob'^.pLifetime.psAssists `shouldBe` 5 + + context "invalid index" $ let + ps' = awardAssist (-1) ps + in it "should not change anything" $ + ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers + makePlayer :: IO Player makePlayer = Player <$> makeNum From 669c854f4ff9ac3f8d46dcfaba35ab3b2f84c6bc Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 27 Sep 2019 01:39:50 -0400 Subject: [PATCH 8/8] implemented awardGoalAssists --- src/Mtlstats/Actions.hs | 16 +++++++++++++- test/ActionsSpec.hs | 48 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 1 deletion(-) diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index a186dbf..b12d587 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -153,7 +153,21 @@ addPlayer s = fromMaybe s $ do -- | Awards the goal and assists to the players recordGoalAssists :: ProgState -> ProgState -recordGoalAssists = undefined +recordGoalAssists ps = fromMaybe ps $ do + let + gs = ps^.progMode.gameStateL + players = ps^.database.dbPlayers + (goalId, _) <- playerSearchExact (gs^.goalBy) players + assistIds <- mapM + (\name -> fst <$> playerSearchExact name players) + (gs^.assistsBy) + Just $ ps + & awardGoal goalId + & (\s -> foldr awardAssist s assistIds) + & progMode.gameStateL + %~ (goalBy .~ "") + . (assistsBy .~ []) + . (pointsAccounted %~ succ) -- | Awards a goal to a player awardGoal diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 88707ee..9cc64ad 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -41,6 +41,7 @@ spec = describe "Mtlstats.Actions" $ do validateGameDateSpec createPlayerSpec addPlayerSpec + recordGoalAssistsSpec awardGoalSpec awardAssistSpec @@ -359,6 +360,53 @@ addPlayerSpec = describe "addPlayer" $ do s' = addPlayer $ s MainMenu in s'^.database.dbPlayers `shouldBe` [p2] +recordGoalAssistsSpec :: Spec +recordGoalAssistsSpec = describe "recordGoalAssists" $ do + let + joe = newPlayer 1 "Joe" "centre" + bob = newPlayer 2 "Bob" "defense" + steve = newPlayer 3 "Steve" "forward" + dave = newPlayer 4 "Dave" "somewhere" + ps + = newProgState + & database.dbPlayers .~ [joe, bob, steve, dave] + & progMode.gameStateL + %~ (goalBy .~ "Joe") + . (assistsBy .~ ["Bob", "Steve"]) + & recordGoalAssists + + mapM_ + (\(name, n, ytdg, ltg, ytda, lta) -> context name $ do + let player = (ps^.database.dbPlayers) !! n + + it ("should set the year-to-date goals to " ++ show ytdg) $ + player^.pYtd.psGoals `shouldBe` ytdg + + it ("should set the lifetime goals to " ++ show ltg) $ + player^.pLifetime.psGoals `shouldBe` ltg + + it ("should set the year-to-date assists to " ++ show ytda) $ + player^.pYtd.psAssists `shouldBe` ytda + + it ("should set the lifetime assists to " ++ show lta) $ + player^.pLifetime.psAssists `shouldBe` lta) + + -- name, index, ytd goals, lt goals, ytd assists, lt assists + [ ( "Joe", 0, 1, 1, 0, 0 ) + , ( "Bob", 1, 0, 0, 1, 1 ) + , ( "Steve", 2, 0, 0, 1, 1 ) + , ( "Dave", 3, 0, 0, 0, 0 ) + ] + + it "should clear the goalBy value" $ + ps^.progMode.gameStateL.goalBy `shouldBe` "" + + it "should clear the assistsBy list" $ + ps^.progMode.gameStateL.assistsBy `shouldBe` [] + + it "should increment the pointsAccounted counter" $ + ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1 + awardGoalSpec :: Spec awardGoalSpec = describe "awardGoal" $ do let