diff --git a/package.yaml b/package.yaml index 7e50ebb..37e73b9 100644 --- a/package.yaml +++ b/package.yaml @@ -22,6 +22,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 - aeson >= 1.4.4.0 && < 1.5 +- containers >= 0.6.0.1 && < 0.7 - easy-file >= 0.2.2 && < 0.3 - extra >= 1.6.17 && < 1.7 - microlens-th >= 0.4.2.3 && < 0.5 diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 23acce7..5d14e80 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -39,6 +39,7 @@ module Mtlstats.Actions ) where import Control.Monad.Trans.State (modify) +import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Time.Calendar (fromGregorianValid) import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~)) @@ -174,13 +175,16 @@ awardGoal -> ProgState -> ProgState awardGoal n ps = ps - & database.dbPlayers - %~ map - (\(i, p) -> if i == n - then p - & pYtd.psGoals %~ succ - & pLifetime.psGoals %~ succ - else p) . zip [0..] + & progMode.gameStateL.gamePlayerStats %~ + (\m -> let + stats = M.findWithDefault newPlayerStats n m + in M.insert n (stats & psGoals %~ succ) m) + & database.dbPlayers %~ map + (\(i, p) -> if i == n + then p + & pYtd.psGoals %~ succ + & pLifetime.psGoals %~ succ + else p) . zip [0..] -- | Awards an assist to a player awardAssist @@ -189,13 +193,16 @@ awardAssist -> 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..] + & progMode.gameStateL.gamePlayerStats %~ + (\m -> let + stats = M.findWithDefault newPlayerStats n m + in M.insert n (stats & psAssists %~ succ) m) + & database.dbPlayers %~ map + (\(i, p) -> if i == n + then p + & pYtd.psAssists %~ succ + & pLifetime.psAssists %~ succ + else p) . zip [0..] -- | Resets the entered data for the current goal resetGoalData :: ProgState -> ProgState diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index f814334..2f8504e 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -21,12 +21,14 @@ along with this program. If not, see . module Mtlstats.Report (report, gameDate) where +import qualified Data.Map as M import Data.Maybe (fromMaybe) import Lens.Micro ((^.)) import Mtlstats.Config import Mtlstats.Format import Mtlstats.Types +import Mtlstats.Util -- | Generates the report report @@ -37,18 +39,24 @@ report -> String report width s = unlines $ fromMaybe [] $ do let - db = s^.database - gs = s^.progMode.gameStateL - gNum = db^.dbGames - date = gameDate gs - hTeam = homeTeam gs - aTeam = awayTeam gs - hStats = db^.dbHomeGameStats - aStats = db^.dbAwayGameStats - tStats = addGameStats hStats aStats + db = s^.database + gs = s^.progMode.gameStateL + gNum = db^.dbGames + date = gameDate gs + hTeam = homeTeam gs + aTeam = awayTeam gs + hStats = db^.dbHomeGameStats + aStats = db^.dbAwayGameStats + tStats = addGameStats hStats aStats + players = db^.dbPlayers hScore <- gs^.homeScore aScore <- gs^.awayScore - Just + pStats <- mapM + (\(n, stats) -> do + player <- nth n players + Just (player, stats)) + (M.toList $ gs^.gamePlayerStats) + Just $ [ overlay ("GAME NUMBER " ++ padNum 2 gNum) (centre width @@ -78,7 +86,26 @@ report width s = unlines $ fromMaybe [] $ do , centre width $ left 11 "TOTALS" ++ showStats tStats - ] + , "" + , centre width "GAME STATISTICS" + , "" + , centre width + $ "NO. " + ++ left 20 "PLAYER" + ++ right 3 "G" + ++ right 6 "A" + ++ right 6 "P" + ++ right 6 "PM" + ] ++ map + (\(p, stats) -> centre width + $ right 2 (show $ p^.pNumber) + ++ " " + ++ left 20 (p^.pName) + ++ right 3 (show $ stats^.psGoals) + ++ right 6 (show $ stats^.psAssists) + ++ right 6 (show $ pPoints stats) + ++ right 6 (show $ stats^.psPMin)) + pStats gameDate :: GameState -> String gameDate gs = fromMaybe "" $ do diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index d438946..ba821b6 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -58,6 +58,7 @@ module Mtlstats.Types ( pointsAccounted, goalBy, assistsBy, + gamePlayerStats, confirmGoalDataFlag, -- ** CreatePlayerState Lenses cpsNumber, @@ -146,6 +147,7 @@ import Data.Aeson , (.=) ) import Data.List (isInfixOf) +import qualified Data.Map as M import Data.Maybe (listToMaybe) import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro.TH (makeLenses) @@ -215,7 +217,10 @@ data GameState = GameState , _assistsBy :: [Int] -- ^ The index numbers of the players who have assisted the most -- recently entered goal + , _gamePlayerStats :: M.Map Int PlayerStats + -- ^ The player stats accumulated over the game , _confirmGoalDataFlag :: Bool + -- ^ Set when the user confirms the goal data } deriving (Eq, Show) -- | The type of game @@ -514,6 +519,7 @@ newGameState = GameState , _pointsAccounted = 0 , _goalBy = Nothing , _assistsBy = [] + , _gamePlayerStats = M.empty , _confirmGoalDataFlag = False } diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 2818774..472958a 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -22,6 +22,7 @@ along with this program. If not, see . module ActionsSpec (spec) where import Control.Monad (replicateM) +import qualified Data.Map as M import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import System.Random (randomRIO) import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe) @@ -368,9 +369,10 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do bob = newPlayer 2 "Bob" "defense" steve = newPlayer 3 "Steve" "forward" dave = newPlayer 4 "Dave" "somewhere" + frank = newPlayer 5 "Frank" "elsewhere" ps = newProgState - & database.dbPlayers .~ [joe, bob, steve, dave] + & database.dbPlayers .~ [joe, bob, steve, dave, frank] & progMode.gameStateL %~ (goalBy ?~ 0) . (assistsBy .~ [1, 2]) @@ -378,26 +380,35 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do & recordGoalAssists mapM_ - (\(name, n, ytdg, ltg, ytda, lta) -> context name $ do - let player = (ps^.database.dbPlayers) !! n + (\(name, n, goals, assists) -> context name $ do + let + player = (ps^.database.dbPlayers) !! n + stats = M.findWithDefault newPlayerStats n $ + ps^.progMode.gameStateL.gamePlayerStats - it ("should set the year-to-date goals to " ++ show ytdg) $ - player^.pYtd.psGoals `shouldBe` ytdg + it ("should set the year-to-date goals to " ++ show goals) $ + player^.pYtd.psGoals `shouldBe` goals - it ("should set the lifetime goals to " ++ show ltg) $ - player^.pLifetime.psGoals `shouldBe` ltg + it ("should set the lifetime goals to " ++ show goals) $ + player^.pLifetime.psGoals `shouldBe` goals - it ("should set the year-to-date assists to " ++ show ytda) $ - player^.pYtd.psAssists `shouldBe` ytda + it ("should set the game goals to " ++ show goals) $ + stats^.psAssists `shouldBe` assists - it ("should set the lifetime assists to " ++ show lta) $ - player^.pLifetime.psAssists `shouldBe` lta) + it ("should set the year-to-date assists to " ++ show assists) $ + player^.pYtd.psAssists `shouldBe` assists - -- 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 set the lifetime assists to " ++ show assists) $ + player^.pLifetime.psAssists `shouldBe` assists + + it ("should set the game assists to " ++ show assists) $ + stats^.psAssists `shouldBe` assists) + + -- name, index, goals, assists + [ ( "Joe", 0, 1, 0 ) + , ( "Bob", 1, 0, 1 ) + , ( "Steve", 2, 0, 1 ) + , ( "Dave", 3, 0, 0 ) ] it "should clear the goalBy value" $ @@ -426,31 +437,34 @@ awardGoalSpec = describe "awardGoal" $ do db = newDatabase & dbPlayers .~ [joe, bob] + joeStats + = newPlayerStats + & psGoals .~ 1 ps = newProgState + & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats & database .~ db - context "Joe" $ do - let - ps' = awardGoal 0 ps - player = head $ ps'^.database.dbPlayers + mapM_ + (\(pName, pid, ytd, lt, game) -> + context pName $ do + let + ps' = awardGoal pid ps + player = (ps'^.database.dbPlayers) !! pid + gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid - it "should increment Joe's year-to-date goals" $ - player^.pYtd.psGoals `shouldBe` 2 + it ("should increment " ++ pName ++ "'s year-to-date goals") $ + player^.pYtd.psGoals `shouldBe` ytd - it "should increment Joe's lifetime goals" $ - player^.pLifetime.psGoals `shouldBe` 3 + it ("should increment " ++ pName ++ "'s lifetime goals") $ + player^.pLifetime.psGoals `shouldBe` lt - context "Bob" $ do - let - ps' = awardGoal 1 ps - player = last $ ps'^.database.dbPlayers - - it "should increment Bob's year-to-data goals" $ - player^.pYtd.psGoals `shouldBe` 4 - - it "should increment Bob's lifetime goals" $ - player^.pLifetime.psGoals `shouldBe` 5 + it ("should increment " ++ pName ++ "'s game goals") $ + gStats^.psGoals `shouldBe` game) + -- player name, player id, ytd goals, lifetime goals, game goals + [ ( "Joe", 0, 2, 3, 2 ) + , ( "Bob", 1, 4, 5, 1 ) + ] context "invalid index" $ let ps' = awardGoal 2 ps @@ -473,45 +487,34 @@ awardAssistSpec = describe "awardAssist" $ do = newPlayer 2 "Bob" "defense" & pYtd.psAssists .~ 3 & pLifetime.psAssists .~ 4 + joeStats + = newPlayerStats + & psAssists .~ 1 ps = newProgState + & progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats & database.dbPlayers .~ [joe, bob] - context "Joe" $ do - let - ps' = awardAssist 0 ps - joe' = head $ ps'^.database.dbPlayers - bob' = last $ ps'^.database.dbPlayers + mapM_ + (\(pName, pid, ytd, lt, game) -> + context pName $ do + let + ps' = awardAssist pid ps + player = (ps'^.database.dbPlayers) !! pid + gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid - it "should increment Joe's year-to-date assists" $ - joe'^.pYtd.psAssists `shouldBe` 2 + it ("should increment " ++ pName ++ "'s year-to-date assists") $ + player^.pYtd.psAssists `shouldBe` ytd - it "should increment Joe's lifetime assists" $ - joe'^.pLifetime.psAssists `shouldBe` 3 + it ("should increment " ++ pName ++ "'s lifetime assists") $ + player^.pLifetime.psAssists `shouldBe` lt - 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 + it ("should increment " ++ pName ++ "'s game assists") $ + gStats^.psAssists `shouldBe` game) + -- player name, player id, ytd assists, lifetime assists, game assists + [ ( "Joe", 0, 2, 3, 2 ) + , ( "Bob", 1, 4, 5, 1 ) + ] context "invalid index" $ let ps' = awardAssist (-1) ps