Merge pull request #20 from mtlstats/assists

Assists

src/Mtlstats/Actions.hs

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

src/Mtlstats/Config.hs

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

src/Mtlstats/Control.hs

@@ -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
+    (game, goal) = gameGoal s
-    goal = succ $ s^.progMode.gameStateL.pointsAccounted
     in drawPrompt (recordGoalPrompt game goal) s
   , handleController = \e -> do
-    game <- gets $ view $ database.dbGames
+    (game, goal) <- gets gameGoal
-    goal <- succ <$> gets (view $ progMode.gameStateL.pointsAccounted)
     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)

src/Mtlstats/Prompt.hs

@@ -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" ++
+  (  "*** GAME " ++ padNum 2 game ++ " ***\n"
-   "Who scored goal number " ++ show goal ++ "? ") $
+  ++ "Who scored goal number " ++ show goal ++ "? "
-  \case
+  ) $ \case
     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 pStr s = C.drawString $ pStr ++ s^.inputBuffer

src/Mtlstats/Types.hs

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

test/ActionsSpec.hs

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

test/TypesSpec.hs

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