Merge pull request #23 from mtlstats/game-stats

Show game statistics in report
This commit is contained in:
Jonathan Lamothe 2019-10-03 03:15:22 -04:00 committed by GitHub
commit 54a631557e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 135 additions and 91 deletions

View File

@ -22,6 +22,7 @@ description: Please see the README on GitHub at <https://github.com/jlam
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- aeson >= 1.4.4.0 && < 1.5 - aeson >= 1.4.4.0 && < 1.5
- containers >= 0.6.0.1 && < 0.7
- easy-file >= 0.2.2 && < 0.3 - easy-file >= 0.2.2 && < 0.3
- extra >= 1.6.17 && < 1.7 - extra >= 1.6.17 && < 1.7
- microlens-th >= 0.4.2.3 && < 0.5 - microlens-th >= 0.4.2.3 && < 0.5

View File

@ -39,6 +39,7 @@ module Mtlstats.Actions
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.Trans.State (modify)
import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid) import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~)) import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
@ -174,13 +175,16 @@ awardGoal
-> ProgState -> ProgState
-> ProgState -> ProgState
awardGoal n ps = ps awardGoal n ps = ps
& database.dbPlayers & progMode.gameStateL.gamePlayerStats %~
%~ map (\m -> let
(\(i, p) -> if i == n stats = M.findWithDefault newPlayerStats n m
then p in M.insert n (stats & psGoals %~ succ) m)
& pYtd.psGoals %~ succ & database.dbPlayers %~ map
& pLifetime.psGoals %~ succ (\(i, p) -> if i == n
else p) . zip [0..] then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
-- | Awards an assist to a player -- | Awards an assist to a player
awardAssist awardAssist
@ -189,13 +193,16 @@ awardAssist
-> ProgState -> ProgState
-> ProgState -> ProgState
awardAssist n ps = ps awardAssist n ps = ps
& database.dbPlayers & progMode.gameStateL.gamePlayerStats %~
%~ map (\m -> let
(\(i, p) -> if i == n stats = M.findWithDefault newPlayerStats n m
then p in M.insert n (stats & psAssists %~ succ) m)
& pYtd.psAssists %~ succ & database.dbPlayers %~ map
& pLifetime.psAssists %~ succ (\(i, p) -> if i == n
else p) . zip [0..] then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
-- | Resets the entered data for the current goal -- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState resetGoalData :: ProgState -> ProgState

View File

@ -21,12 +21,14 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Report (report, gameDate) where module Mtlstats.Report (report, gameDate) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
-- | Generates the report -- | Generates the report
report report
@ -37,18 +39,24 @@ report
-> String -> String
report width s = unlines $ fromMaybe [] $ do report width s = unlines $ fromMaybe [] $ do
let let
db = s^.database db = s^.database
gs = s^.progMode.gameStateL gs = s^.progMode.gameStateL
gNum = db^.dbGames gNum = db^.dbGames
date = gameDate gs date = gameDate gs
hTeam = homeTeam gs hTeam = homeTeam gs
aTeam = awayTeam gs aTeam = awayTeam gs
hStats = db^.dbHomeGameStats hStats = db^.dbHomeGameStats
aStats = db^.dbAwayGameStats aStats = db^.dbAwayGameStats
tStats = addGameStats hStats aStats tStats = addGameStats hStats aStats
players = db^.dbPlayers
hScore <- gs^.homeScore hScore <- gs^.homeScore
aScore <- gs^.awayScore aScore <- gs^.awayScore
Just pStats <- mapM
(\(n, stats) -> do
player <- nth n players
Just (player, stats))
(M.toList $ gs^.gamePlayerStats)
Just $
[ overlay [ overlay
("GAME NUMBER " ++ padNum 2 gNum) ("GAME NUMBER " ++ padNum 2 gNum)
(centre width (centre width
@ -78,7 +86,26 @@ report width s = unlines $ fromMaybe [] $ do
, centre width , centre width
$ left 11 "TOTALS" $ left 11 "TOTALS"
++ showStats tStats ++ 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 :: GameState -> String
gameDate gs = fromMaybe "" $ do gameDate gs = fromMaybe "" $ do

View File

@ -58,6 +58,7 @@ module Mtlstats.Types (
pointsAccounted, pointsAccounted,
goalBy, goalBy,
assistsBy, assistsBy,
gamePlayerStats,
confirmGoalDataFlag, confirmGoalDataFlag,
-- ** CreatePlayerState Lenses -- ** CreatePlayerState Lenses
cpsNumber, cpsNumber,
@ -146,6 +147,7 @@ import Data.Aeson
, (.=) , (.=)
) )
import Data.List (isInfixOf) import Data.List (isInfixOf)
import qualified Data.Map as M
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro (Lens', lens, (&), (^.), (.~))
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
@ -215,7 +217,10 @@ data GameState = GameState
, _assistsBy :: [Int] , _assistsBy :: [Int]
-- ^ The index numbers of the players who have assisted the most -- ^ The index numbers of the players who have assisted the most
-- recently entered goal -- recently entered goal
, _gamePlayerStats :: M.Map Int PlayerStats
-- ^ The player stats accumulated over the game
, _confirmGoalDataFlag :: Bool , _confirmGoalDataFlag :: Bool
-- ^ Set when the user confirms the goal data
} deriving (Eq, Show) } deriving (Eq, Show)
-- | The type of game -- | The type of game
@ -514,6 +519,7 @@ newGameState = GameState
, _pointsAccounted = 0 , _pointsAccounted = 0
, _goalBy = Nothing , _goalBy = Nothing
, _assistsBy = [] , _assistsBy = []
, _gamePlayerStats = M.empty
, _confirmGoalDataFlag = False , _confirmGoalDataFlag = False
} }

View File

@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where module ActionsSpec (spec) where
import Control.Monad (replicateM) import Control.Monad (replicateM)
import qualified Data.Map as M
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO) import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe) import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
@ -368,9 +369,10 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do
bob = newPlayer 2 "Bob" "defense" bob = newPlayer 2 "Bob" "defense"
steve = newPlayer 3 "Steve" "forward" steve = newPlayer 3 "Steve" "forward"
dave = newPlayer 4 "Dave" "somewhere" dave = newPlayer 4 "Dave" "somewhere"
frank = newPlayer 5 "Frank" "elsewhere"
ps ps
= newProgState = newProgState
& database.dbPlayers .~ [joe, bob, steve, dave] & database.dbPlayers .~ [joe, bob, steve, dave, frank]
& progMode.gameStateL & progMode.gameStateL
%~ (goalBy ?~ 0) %~ (goalBy ?~ 0)
. (assistsBy .~ [1, 2]) . (assistsBy .~ [1, 2])
@ -378,26 +380,35 @@ recordGoalAssistsSpec = describe "recordGoalAssists" $ do
& recordGoalAssists & recordGoalAssists
mapM_ mapM_
(\(name, n, ytdg, ltg, ytda, lta) -> context name $ do (\(name, n, goals, assists) -> context name $ do
let player = (ps^.database.dbPlayers) !! n 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) $ it ("should set the year-to-date goals to " ++ show goals) $
player^.pYtd.psGoals `shouldBe` ytdg player^.pYtd.psGoals `shouldBe` goals
it ("should set the lifetime goals to " ++ show ltg) $ it ("should set the lifetime goals to " ++ show goals) $
player^.pLifetime.psGoals `shouldBe` ltg player^.pLifetime.psGoals `shouldBe` goals
it ("should set the year-to-date assists to " ++ show ytda) $ it ("should set the game goals to " ++ show goals) $
player^.pYtd.psAssists `shouldBe` ytda stats^.psAssists `shouldBe` assists
it ("should set the lifetime assists to " ++ show lta) $ it ("should set the year-to-date assists to " ++ show assists) $
player^.pLifetime.psAssists `shouldBe` lta) player^.pYtd.psAssists `shouldBe` assists
-- name, index, ytd goals, lt goals, ytd assists, lt assists it ("should set the lifetime assists to " ++ show assists) $
[ ( "Joe", 0, 1, 1, 0, 0 ) player^.pLifetime.psAssists `shouldBe` assists
, ( "Bob", 1, 0, 0, 1, 1 )
, ( "Steve", 2, 0, 0, 1, 1 ) it ("should set the game assists to " ++ show assists) $
, ( "Dave", 3, 0, 0, 0, 0 ) 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" $ it "should clear the goalBy value" $
@ -426,31 +437,34 @@ awardGoalSpec = describe "awardGoal" $ do
db db
= newDatabase = newDatabase
& dbPlayers .~ [joe, bob] & dbPlayers .~ [joe, bob]
joeStats
= newPlayerStats
& psGoals .~ 1
ps ps
= newProgState = newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database .~ db & database .~ db
context "Joe" $ do mapM_
let (\(pName, pid, ytd, lt, game) ->
ps' = awardGoal 0 ps context pName $ do
player = head $ ps'^.database.dbPlayers 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" $ it ("should increment " ++ pName ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` 2 player^.pYtd.psGoals `shouldBe` ytd
it "should increment Joe's lifetime goals" $ it ("should increment " ++ pName ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` 3 player^.pLifetime.psGoals `shouldBe` lt
context "Bob" $ do it ("should increment " ++ pName ++ "'s game goals") $
let gStats^.psGoals `shouldBe` game)
ps' = awardGoal 1 ps -- player name, player id, ytd goals, lifetime goals, game goals
player = last $ ps'^.database.dbPlayers [ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
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
context "invalid index" $ let context "invalid index" $ let
ps' = awardGoal 2 ps ps' = awardGoal 2 ps
@ -473,45 +487,34 @@ awardAssistSpec = describe "awardAssist" $ do
= newPlayer 2 "Bob" "defense" = newPlayer 2 "Bob" "defense"
& pYtd.psAssists .~ 3 & pYtd.psAssists .~ 3
& pLifetime.psAssists .~ 4 & pLifetime.psAssists .~ 4
joeStats
= newPlayerStats
& psAssists .~ 1
ps ps
= newProgState = newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database.dbPlayers .~ [joe, bob] & database.dbPlayers .~ [joe, bob]
context "Joe" $ do mapM_
let (\(pName, pid, ytd, lt, game) ->
ps' = awardAssist 0 ps context pName $ do
joe' = head $ ps'^.database.dbPlayers let
bob' = last $ ps'^.database.dbPlayers 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" $ it ("should increment " ++ pName ++ "'s year-to-date assists") $
joe'^.pYtd.psAssists `shouldBe` 2 player^.pYtd.psAssists `shouldBe` ytd
it "should increment Joe's lifetime assists" $ it ("should increment " ++ pName ++ "'s lifetime assists") $
joe'^.pLifetime.psAssists `shouldBe` 3 player^.pLifetime.psAssists `shouldBe` lt
it "should leave Bob's year-to-date assists alone" $ it ("should increment " ++ pName ++ "'s game assists") $
bob'^.pYtd.psAssists `shouldBe` 3 gStats^.psAssists `shouldBe` game)
-- player name, player id, ytd assists, lifetime assists, game assists
it "should leave Bob's lifetime assists alone" $ [ ( "Joe", 0, 2, 3, 2 )
bob^.pLifetime.psAssists `shouldBe` 4 , ( "Bob", 1, 4, 5, 1 )
]
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 context "invalid index" $ let
ps' = awardAssist (-1) ps ps' = awardAssist (-1) ps