Merge pull request #20 from mtlstats/assists

Assists
This commit is contained in:
Jonathan Lamothe 2019-09-27 01:46:06 -04:00 committed by GitHub
commit 767c9b9221
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 278 additions and 29 deletions

View File

@ -32,7 +32,9 @@ module Mtlstats.Actions
, validateGameDate , validateGameDate
, createPlayer , createPlayer
, addPlayer , addPlayer
, recordGoalAssists
, awardGoal , awardGoal
, awardAssist
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.Trans.State (modify)
@ -149,6 +151,24 @@ addPlayer s = fromMaybe s $ do
Just $ s & database.dbPlayers Just $ s & database.dbPlayers
%~ (player:) %~ (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 -- | Awards a goal to a player
awardGoal awardGoal
:: Int :: Int
@ -163,3 +183,18 @@ awardGoal n ps = ps
& pYtd.psGoals %~ succ & pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ & pLifetime.psGoals %~ succ
else p) . zip [0..] 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..]

View File

@ -36,3 +36,7 @@ appName = "mtlstats"
-- | The database filename -- | The database filename
dbFname :: String dbFname :: String
dbFname = "database.json" dbFname = "database.json"
-- | The maximum number of assists
maxAssists :: Int
maxAssists = 2

View File

@ -53,7 +53,7 @@ dispatch s = case s^.progMode of
| null $ gs^.awayScore -> awayScoreC | null $ gs^.awayScore -> awayScoreC
| null $ gs^.overtimeFlag -> overtimeFlagC | null $ gs^.overtimeFlag -> overtimeFlagC
| not $ gs^.dataVerified -> verifyDataC | not $ gs^.dataVerified -> verifyDataC
| fromJust (unaccountedPoints gs) -> recordGoalC | fromJust (unaccountedPoints gs) -> goalInput gs
| otherwise -> reportC | otherwise -> reportC
CreatePlayer cps CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsNumber -> getPlayerNumC
@ -182,19 +182,33 @@ verifyDataC = Controller
return True return True
} }
goalInput :: GameState -> Controller
goalInput gs
| null (gs^.goalBy) = recordGoalC
| otherwise = recordAssistC
recordGoalC :: Controller recordGoalC :: Controller
recordGoalC = Controller recordGoalC = Controller
{ drawController = \s -> let { drawController = \s -> let
game = s^.database.dbGames (game, goal) = gameGoal s
goal = succ $ s^.progMode.gameStateL.pointsAccounted
in drawPrompt (recordGoalPrompt game goal) s in drawPrompt (recordGoalPrompt game goal) s
, handleController = \e -> do , handleController = \e -> do
game <- gets $ view $ database.dbGames (game, goal) <- gets gameGoal
goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
promptHandler (recordGoalPrompt game goal) e promptHandler (recordGoalPrompt game goal) e
return True 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
reportC = Controller reportC = Controller
{ drawController = \s -> do { drawController = \s -> do
@ -258,3 +272,15 @@ confirmCreatePlayerC = Controller
Nothing -> return () Nothing -> return ()
return True 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)

View File

@ -38,6 +38,7 @@ module Mtlstats.Prompt (
playerPosPrompt, playerPosPrompt,
selectPlayerPrompt, selectPlayerPrompt,
recordGoalPrompt, recordGoalPrompt,
recordAssistPrompt
) where ) where
import Control.Monad (when) import Control.Monad (when)
@ -167,23 +168,25 @@ selectPlayerPrompt pStr callback = Prompt
sel sel
C.moveCursor row col C.moveCursor row col
, promptCharCheck = const True , promptCharCheck = const True
, promptAction = \sStr -> do , promptAction = \sStr -> if null sStr
players <- gets $ view $ database.dbPlayers then callback Nothing
case playerSearchExact sStr players of else do
Just (n, _) -> callback $ Just n players <- gets $ view $ database.dbPlayers
Nothing -> do case playerSearchExact sStr players of
mode <- gets $ view progMode Just (n, _) -> callback $ Just n
let Nothing -> do
cps mode <- gets $ view progMode
= newCreatePlayerState let
& cpsName .~ sStr cps
& cpsSuccessCallback .~ do = newCreatePlayerState
modify $ progMode .~ mode & cpsName .~ sStr
callback (Just 0) & cpsSuccessCallback .~ do
& cpsFailureCallback .~ do modify $ progMode .~ mode
modify $ progMode .~ mode callback (Just 0)
callback Nothing & cpsFailureCallback .~ do
modify $ progMode .~ CreatePlayer cps modify $ progMode .~ mode
callback Nothing
modify $ progMode .~ CreatePlayer cps
, promptSpecialKey = \case , promptSpecialKey = \case
C.KeyFunction n -> do C.KeyFunction n -> do
sStr <- gets $ view inputBuffer sStr <- gets $ view inputBuffer
@ -205,13 +208,38 @@ recordGoalPrompt
-- ^ The goal number -- ^ The goal number
-> Prompt -> Prompt
recordGoalPrompt game goal = selectPlayerPrompt recordGoalPrompt game goal = selectPlayerPrompt
("*** GAME " ++ padNum 2 game ++ " ***\n" ++ ( "*** GAME " ++ padNum 2 game ++ " ***\n"
"Who scored goal number " ++ show goal ++ "? ") $ ++ "Who scored goal number " ++ show goal ++ "? "
\case ) $ \case
Nothing -> return () Nothing -> return ()
Just n -> modify Just n -> nth n <$> gets (view $ database.dbPlayers)
$ awardGoal n >>= maybe
. (progMode.gameStateL.pointsAccounted %~ succ) (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 :: String -> ProgState -> C.Update ()
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

View File

@ -56,6 +56,8 @@ module Mtlstats.Types (
overtimeFlag, overtimeFlag,
dataVerified, dataVerified,
pointsAccounted, pointsAccounted,
goalBy,
assistsBy,
-- ** CreatePlayerState Lenses -- ** CreatePlayerState Lenses
cpsNumber, cpsNumber,
cpsName, cpsName,
@ -124,7 +126,8 @@ module Mtlstats.Types (
-- ** Player Helpers -- ** Player Helpers
pPoints, pPoints,
playerSearch, playerSearch,
playerSearchExact playerSearchExact,
modifyPlayer
) where ) where
import Control.Monad.Trans.State (StateT) import Control.Monad.Trans.State (StateT)
@ -203,6 +206,11 @@ data GameState = GameState
, _dataVerified :: Bool , _dataVerified :: Bool
-- ^ Set to 'True' when the user confirms the entered data -- ^ Set to 'True' when the user confirms the entered data
, _pointsAccounted :: Int , _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) } deriving (Eq, Show)
-- | The type of game -- | The type of game
@ -499,6 +507,8 @@ newGameState = GameState
, _overtimeFlag = Nothing , _overtimeFlag = Nothing
, _dataVerified = False , _dataVerified = False
, _pointsAccounted = 0 , _pointsAccounted = 0
, _goalBy = ""
, _assistsBy = []
} }
-- | Constructor for a 'CreatePlayerState' -- | Constructor for a 'CreatePlayerState'
@ -683,3 +693,18 @@ playerSearchExact sStr =
filter (match sStr) . filter (match sStr) .
zip [0..] zip [0..]
where match sStr (_, p) = p^.pName == sStr 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)

View File

@ -41,7 +41,9 @@ spec = describe "Mtlstats.Actions" $ do
validateGameDateSpec validateGameDateSpec
createPlayerSpec createPlayerSpec
addPlayerSpec addPlayerSpec
recordGoalAssistsSpec
awardGoalSpec awardGoalSpec
awardAssistSpec
startNewSeasonSpec :: Spec startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do startNewSeasonSpec = describe "startNewSeason" $ do
@ -358,6 +360,53 @@ addPlayerSpec = describe "addPlayer" $ do
s' = addPlayer $ s MainMenu s' = addPlayer $ s MainMenu
in s'^.database.dbPlayers `shouldBe` [p2] 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 :: Spec
awardGoalSpec = describe "awardGoal" $ do awardGoalSpec = describe "awardGoal" $ do
let let
@ -408,6 +457,62 @@ awardGoalSpec = describe "awardGoal" $ do
in it "should not change the database" $ in it "should not change the database" $
ps'^.database `shouldBe` db 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 :: IO Player
makePlayer = Player makePlayer = Player
<$> makeNum <$> makeNum

View File

@ -57,6 +57,7 @@ spec = describe "Mtlstats.Types" $ do
pPointsSpec pPointsSpec
playerSearchSpec playerSearchSpec
playerSearchExactSpec playerSearchExactSpec
modifyPlayerSpec
Menu.spec Menu.spec
playerSpec :: Spec playerSpec :: Spec
@ -552,6 +553,31 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
, ( "", Nothing ) , ( "", 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 :: Player
joe = newPlayer 2 "Joe" "center" joe = newPlayer 2 "Joe" "center"