diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 5d14e80..48ea77f 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -36,6 +36,7 @@ module Mtlstats.Actions , awardGoal , awardAssist , resetGoalData + , assignPMins ) where import Control.Monad.Trans.State (modify) @@ -45,6 +46,7 @@ import Data.Time.Calendar (fromGregorianValid) import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~)) import Mtlstats.Types +import Mtlstats.Util -- | Starts a new season startNewSeason :: ProgState -> ProgState @@ -210,3 +212,20 @@ resetGoalData ps = ps & progMode.gameStateL %~ (goalBy .~ Nothing) . (assistsBy .~ []) . (confirmGoalDataFlag .~ False) + +-- | Adds penalty minutes to a player +assignPMins + :: Int + -- ^ The number of minutes to add + -> ProgState + -> ProgState +assignPMins mins s = fromMaybe s $ do + n <- s^.progMode.gameStateL.selectedPlayer + Just $ s + & database.dbPlayers %~ modifyNth n + (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins)) + & progMode.gameStateL + %~ ( gamePlayerStats %~ updateMap n newPlayerStats + (psPMin +~ mins) + ) + . (selectedPlayer .~ Nothing) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index bcb6cfb..66445db 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -24,7 +24,7 @@ module Mtlstats.Control (dispatch) where import Control.Monad (join, when) import Control.Monad.Trans.State (gets, modify) import Data.Char (toUpper) -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, fromMaybe, isJust) import Lens.Micro ((^.), (.~)) import Lens.Micro.Extras (view) import qualified UI.NCurses as C @@ -55,6 +55,8 @@ 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 | otherwise -> reportC CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC @@ -241,6 +243,30 @@ confirmGoalDataC = Controller return True } +pMinPlayerC :: Controller +pMinPlayerC = Controller + { drawController = \s -> do + header s + drawPrompt pMinPlayerPrompt s + , handleController = \e -> do + promptHandler pMinPlayerPrompt e + return True + } + +getPMinsC :: Controller +getPMinsC = Controller + { drawController = \s -> do + header s + C.drawString $ fromMaybe "" $ do + pid <- s^.progMode.gameStateL.selectedPlayer + player <- nth pid $ s^.database.dbPlayers + Just $ playerSummary player ++ "\n" + drawPrompt assignPMinsPrompt s + , handleController = \e -> do + promptHandler assignPMinsPrompt e + return True + } + reportC :: Controller reportC = Controller { drawController = \s -> do diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index dc17391..c9b6703 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -38,7 +38,9 @@ module Mtlstats.Prompt ( playerPosPrompt, selectPlayerPrompt, recordGoalPrompt, - recordAssistPrompt + recordAssistPrompt, + pMinPlayerPrompt, + assignPMinsPrompt ) where import Control.Monad (when) @@ -234,5 +236,16 @@ recordAssistPrompt game goal assist = selectPlayerPrompt when (nAssists >= maxAssists) $ modify $ progMode.gameStateL.confirmGoalDataFlag .~ True +pMinPlayerPrompt :: Prompt +pMinPlayerPrompt = selectPlayerPrompt + "Assign penalty minutes to: " $ + \case + Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True + Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n + +assignPMinsPrompt :: Prompt +assignPMinsPrompt = numPrompt "Penalty minutes: " $ + modify . assignPMins + 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 152c728..31ddf14 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -60,6 +60,8 @@ module Mtlstats.Types ( assistsBy, gamePlayerStats, confirmGoalDataFlag, + selectedPlayer, + pMinsRecorded, -- ** CreatePlayerState Lenses cpsNumber, cpsName, @@ -223,6 +225,10 @@ data GameState = GameState -- ^ The player stats accumulated over the game , _confirmGoalDataFlag :: Bool -- ^ Set when the user confirms the goal data + , _selectedPlayer :: Maybe Int + -- ^ Index number of the selected 'Player' + , _pMinsRecorded :: Bool + -- ^ Set when the penalty mintes have been recorded } deriving (Eq, Show) -- | The type of game @@ -523,6 +529,8 @@ newGameState = GameState , _assistsBy = [] , _gamePlayerStats = M.empty , _confirmGoalDataFlag = False + , _selectedPlayer = Nothing + , _pMinsRecorded = False } -- | Constructor for a 'CreatePlayerState' diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index 3d8880f..0100fc3 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -19,11 +19,48 @@ along with this program. If not, see . -} -module Mtlstats.Util (nth) where +module Mtlstats.Util (nth, modifyNth, updateMap) where -nth :: Int -> [a] -> Maybe a +import qualified Data.Map as M + +-- | Attempt to select the element from a list at a given index +nth + :: Int + -- ^ The index + -> [a] + -- ^ The list + -> Maybe a nth _ [] = Nothing nth n (x:xs) | n == 0 = Just x | n < 0 = Nothing | otherwise = nth (pred n) xs + +-- | Attempt to modify the index at a given index in a list +modifyNth + :: Int + -- ^ The index + -> (a -> a) + -- ^ The modification function + -> [a] + -- ^ The list + -> [a] +modifyNth n f = map (\(i, x) -> if i == n then f x else x) + . zip [0..] + +-- | Modify a value indexed by a given key in a map using a default +-- initial value if not present +updateMap + :: Ord k + => k + -- ^ The key + -> a + -- ^ The default initial value + -> (a -> a) + -- ^ The modification function + -> M.Map k a + -- ^ The map + -> M.Map k a +updateMap k def f m = let + x = M.findWithDefault def k m + in M.insert k (f x) m diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 472958a..a0afc71 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -23,12 +23,14 @@ module ActionsSpec (spec) where import Control.Monad (replicateM) import qualified Data.Map as M +import Data.Maybe (fromJust) import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import System.Random (randomRIO) import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe) import Mtlstats.Actions import Mtlstats.Types +import Mtlstats.Util spec :: Spec spec = describe "Mtlstats.Actions" $ do @@ -46,6 +48,7 @@ spec = describe "Mtlstats.Actions" $ do awardGoalSpec awardAssistSpec resetGoalDataSpec + assignPMinsSpec startNewSeasonSpec :: Spec startNewSeasonSpec = describe "startNewSeason" $ do @@ -545,6 +548,62 @@ resetGoalDataSpec = describe "resetGoalData" $ do it "should clear confirmGoalDataFlag" $ ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False +assignPMinsSpec :: Spec +assignPMinsSpec = describe "assignPMins" $ let + + bob = newPlayer 2 "Bob" "centre" + & pYtd.psPMin .~ 3 + & pLifetime.psPMin .~ 4 + + joe = newPlayer 3 "Joe" "defense" + & pYtd.psPMin .~ 5 + & pLifetime.psPMin .~ 6 + + ps pid = newProgState + & database.dbPlayers .~ [bob, joe] + & progMode.gameStateL + %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)]) + . (selectedPlayer .~ pid) + + in mapM_ + (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) -> + context ("selectedPlayer = " ++ show pid) $ do + let ps' = assignPMins 2 $ ps pid + + mapM_ + (\(name, pid', lt, ytd, game) -> context name $ do + let + player = fromJust $ nth pid' $ ps'^.database.dbPlayers + gStats = ps'^.progMode.gameStateL.gamePlayerStats + pStats = M.findWithDefault newPlayerStats pid' gStats + + context "lifetime penalty minutes" $ + it ("should be " ++ show lt) $ + player^.pLifetime.psPMin `shouldBe` lt + + context "year-to-date penalty minutes" $ + it ("should be " ++ show ytd) $ + player^.pYtd.psPMin `shouldBe` ytd + + context "game penalty minutes" $ + it ("should be " ++ show game) $ + pStats^.psPMin `shouldBe` game) + + -- name, index, lifetime, ytd, game + [ ( "Bob", 0, bobLt, bobYtd, bobGame ) + , ( "Joe", 1, joeLt, joeYtd, joeGame ) + ] + + it "should set selectedPlayer to Nothing" $ + ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing) + + -- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game + [ ( Just 0, 6, 5, 4, 6, 5, 0 ) + , ( Just 1, 4, 3, 2, 8, 7, 2 ) + , ( Just 2, 4, 3, 2, 6, 5, 0 ) + , ( Nothing, 4, 3, 2, 6, 5, 0 ) + ] + makePlayer :: IO Player makePlayer = Player <$> makeNum diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs index e5e1f37..6a60641 100644 --- a/test/UtilSpec.hs +++ b/test/UtilSpec.hs @@ -21,13 +21,16 @@ along with this program. If not, see . module UtilSpec (spec) where +import qualified Data.Map as M import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Util spec :: Spec -spec = describe "Mtlstats.Util" +spec = describe "Mtlstats.Util" $ do nthSpec + modifyNthSpec + updateMapSpec nthSpec :: Spec nthSpec = describe "nth" $ mapM_ @@ -42,3 +45,33 @@ nthSpec = describe "nth" $ mapM_ , ( 3, Nothing ) , ( -1, Nothing ) ] + +modifyNthSpec :: Spec +modifyNthSpec = describe "modifyNth" $ do + + context "in bounds" $ + it "should modify the value" $ + modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3] + + context "out of bounds" $ + it "should not modify the value" $ + modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3] + + context "negative index" $ + it "should not modify the value" $ + modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3] + +updateMapSpec :: Spec +updateMapSpec = describe "updateMap" $ do + let + input = M.fromList [(1, 2), (3, 5)] + + context "key found" $ let + expected = M.fromList [(1, 3), (3, 5)] + in it "should update the value" $ + updateMap 1 10 succ input `shouldBe` expected + + context "key not found" $ let + expected = M.fromList [(1, 2), (3, 5), (10, 11)] + in it "should create a new value and update the default" $ + updateMap 10 10 succ input `shouldBe` expected