diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 4cf62d4..b12d587 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -32,7 +32,9 @@ module Mtlstats.Actions , validateGameDate , createPlayer , addPlayer + , recordGoalAssists , awardGoal + , awardAssist ) where import Control.Monad.Trans.State (modify) @@ -149,6 +151,24 @@ addPlayer s = fromMaybe s $ do Just $ s & database.dbPlayers %~ (player:) +-- | Awards the goal and assists to the players +recordGoalAssists :: ProgState -> ProgState +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 :: Int @@ -163,3 +183,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/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 diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index 8b00523..8678ef2 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,19 +182,33 @@ verifyDataC = Controller return True } +goalInput :: GameState -> Controller +goalInput gs + | null (gs^.goalBy) = recordGoalC + | otherwise = recordAssistC + 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 = 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 { drawController = \s -> do @@ -258,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 04bb138..9d7f0d8 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) @@ -167,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 @@ -205,13 +208,38 @@ 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) + +-- | 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 diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 25f2fc5..c385b64 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, @@ -124,7 +126,8 @@ module Mtlstats.Types ( -- ** Player Helpers pPoints, playerSearch, - playerSearchExact + playerSearchExact, + modifyPlayer ) where import Control.Monad.Trans.State (StateT) @@ -203,6 +206,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 +507,8 @@ newGameState = GameState , _overtimeFlag = Nothing , _dataVerified = False , _pointsAccounted = 0 + , _goalBy = "" + , _assistsBy = [] } -- | Constructor for a 'CreatePlayerState' @@ -683,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/ActionsSpec.hs b/test/ActionsSpec.hs index 1566af6..9cc64ad 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -41,7 +41,9 @@ spec = describe "Mtlstats.Actions" $ do validateGameDateSpec createPlayerSpec addPlayerSpec + recordGoalAssistsSpec awardGoalSpec + awardAssistSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -358,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 @@ -408,6 +457,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 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"