commit
767c9b9221
|
@ -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..]
|
||||
|
|
|
@ -36,3 +36,7 @@ appName = "mtlstats"
|
|||
-- | The database filename
|
||||
dbFname :: String
|
||||
dbFname = "database.json"
|
||||
|
||||
-- | The maximum number of assists
|
||||
maxAssists :: Int
|
||||
maxAssists = 2
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user