Merge pull request #23 from mtlstats/game-stats
Show game statistics in report
This commit is contained in:
commit
54a631557e
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user