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
, 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..]

View File

@ -36,3 +36,7 @@ appName = "mtlstats"
-- | The database filename
dbFname :: String
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^.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)

View File

@ -38,6 +38,7 @@ module Mtlstats.Prompt (
playerPosPrompt,
selectPlayerPrompt,
recordGoalPrompt,
recordAssistPrompt
) where
import Control.Monad (when)
@ -167,7 +168,9 @@ selectPlayerPrompt pStr callback = Prompt
sel
C.moveCursor row col
, promptCharCheck = const True
, promptAction = \sStr -> do
, 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
@ -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

View File

@ -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)

View File

@ -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

View File

@ -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"