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