diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs
index b1dbde2..48ea77f 100644
--- a/src/Mtlstats/Actions.hs
+++ b/src/Mtlstats/Actions.hs
@@ -46,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
@@ -218,4 +219,13 @@ assignPMins
-- ^ The number of minutes to add
-> ProgState
-> ProgState
-assignPMins = undefined
+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/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