Merge pull request #19 from mtlstats/gfga

Calculate goals for/goals against
This commit is contained in:
Jonathan Lamothe 2019-09-21 00:43:35 -04:00 committed by GitHub
commit c9b822df3c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 115 additions and 68 deletions

View File

@ -82,26 +82,37 @@ overtimeCheck s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
gType <- s^.progMode.gameStateL.gameType
won <- gameWon $ s^.progMode.gameStateL
lost <- gameLost $ s^.progMode.gameStateL
ot <- s^.progMode.gameStateL.overtimeFlag
let gs = s^.progMode.gameStateL
gType <- gs^.gameType
won <- gameWon gs
lost <- gameLost gs
ot <- gs^.overtimeFlag
tScore <- teamScore gs
oScore <- otherScore gs
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
hgf = if gType == HomeGame then tScore else 0
hga = if gType == HomeGame then oScore else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
agf = if gType == AwayGame then tScore else 0
aga = if gType == AwayGame then oScore else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
. (gmsGoalsFor +~ hgf)
. (gmsGoalsAgainst +~ hga)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
. (gmsGoalsFor +~ agf)
. (gmsGoalsAgainst +~ aga)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState

View File

@ -63,6 +63,8 @@ report width s = unlines $ fromMaybe [] $ do
++ right 4 "W"
++ right 4 "L"
++ right 4 "OT"
++ right 4 "GF"
++ right 4 "GA"
++ right 4 "P"
, centre width
$ left 11 "HOME"
@ -72,7 +74,7 @@ report width s = unlines $ fromMaybe [] $ do
++ showStats aStats
, centre width
$ replicate 11 ' '
++ replicate (2 + 4 * 4) '-'
++ replicate (2 + 4 * 6) '-'
, centre width
$ left 11 "TOTALS"
++ showStats tStats
@ -91,4 +93,6 @@ showStats gs
++ right 4 (show $ gs^.gmsWins)
++ right 4 (show $ gs^.gmsLosses)
++ right 4 (show $ gs^.gmsOvertime)
++ right 4 (show $ gs^.gmsGoalsFor)
++ right 4 (show $ gs^.gmsGoalsAgainst)
++ right 4 (show $ gmsPoints gs)

View File

@ -95,6 +95,8 @@ module Mtlstats.Types (
gmsWins,
gmsLosses,
gmsOvertime,
gmsGoalsFor,
gmsGoalsAgainst,
-- * Constructors
newProgState,
newGameState,
@ -411,6 +413,10 @@ data GameStats = GameStats
-- ^ Games lost
, _gmsOvertime :: Int
-- ^ Games lost in overtime
, _gmsGoalsFor :: Int
-- ^ Goals for the team
, _gmsGoalsAgainst :: Int
-- ^ Goals against the team
} deriving (Eq, Show)
instance FromJSON GameStats where
@ -418,17 +424,23 @@ instance FromJSON GameStats where
<$> v .: "wins"
<*> v .: "losses"
<*> v .: "overtime"
<*> v .: "goals_for"
<*> v .: "goals_against"
instance ToJSON GameStats where
toJSON (GameStats w l ot) = object
toJSON (GameStats w l ot gf ga) = object
[ "wins" .= w
, "losses" .= l
, "overtime" .= ot
, "goals_for" .= gf
, "goals_against" .= ga
]
toEncoding (GameStats w l ot) = pairs $
toEncoding (GameStats w l ot gf ga) = pairs $
"wins" .= w <>
"losses" .= l <>
"overtime" .= ot
"overtime" .= ot <>
"goals_for" .= gf <>
"goals_against" .= ga
-- | Defines a user prompt
data Prompt = Prompt
@ -566,6 +578,8 @@ newGameStats = GameStats
{ _gmsWins = 0
, _gmsLosses = 0
, _gmsOvertime = 0
, _gmsGoalsFor = 0
, _gmsGoalsAgainst = 0
}
-- | Determines the team's score
@ -635,6 +649,8 @@ addGameStats s1 s2 = GameStats
{ _gmsWins = s1^.gmsWins + s2^.gmsWins
, _gmsLosses = s1^.gmsLosses + s2^.gmsLosses
, _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
, _gmsGoalsFor = s1^.gmsGoalsFor + s2^.gmsGoalsFor
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
}
-- | Calculates a player's points

View File

@ -196,6 +196,8 @@ updateGameStatsSpec = describe "updateGameStats" $ do
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
& gmsGoalsFor .~ 1
& gmsGoalsAgainst .~ 1
s t h a o = newProgState
& progMode.gameStateL
@ -207,75 +209,79 @@ updateGameStatsSpec = describe "updateGameStats" $ do
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho aw al ao = newDatabase
db hw hl ho hf ha aw al ao af aa = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
. (gmsGoalsFor .~ hf)
. (gmsGoalsAgainst .~ ha)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
. (gmsGoalsFor .~ af)
. (gmsGoalsAgainst .~ aa)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 1 1 1
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 1 1 1
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
context "home overtime loss" $
it "should record a home overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 2 1 1 1
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 2 1 1
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 2 1
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
context "away overtime loss" $
it "should record an away overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 2
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do

View File

@ -258,6 +258,8 @@ gameStats n = GameStats
{ _gmsWins = n
, _gmsLosses = n + 1
, _gmsOvertime = n + 2
, _gmsGoalsFor = n + 3
, _gmsGoalsAgainst = n + 4
}
gameStatsJSON :: Int -> Value
@ -265,6 +267,8 @@ gameStatsJSON n = Object $ HM.fromList
[ ( "wins", toJSON n )
, ( "losses", toJSON $ n + 1 )
, ( "overtime", toJSON $ n + 2 )
, ( "goals_for", toJSON $ n + 3 )
, ( "goals_against", toJSON $ n + 4 )
]
db :: Database
@ -456,11 +460,11 @@ gmsGamesSpec = describe "gmsGames" $ mapM_
gmsPointsSpec :: Spec
gmsPointsSpec = describe "gmsPoints" $ mapM_
(\(w, l, ot, expected) -> let
gs = GameStats
{ _gmsWins = w
, _gmsLosses = l
, _gmsOvertime = ot
}
gs
= newGameStats
& gmsWins .~ w
& gmsLosses .~ l
& gmsOvertime .~ ot
in context (show gs) $
it ("should be " ++ show expected) $
gmsPoints gs `shouldBe` expected)
@ -479,20 +483,26 @@ addGameStatsSpec = describe "addGameStats" $
s1 = GameStats
{ _gmsWins = 1
, _gmsLosses = 3
, _gmsOvertime = 2
, _gmsLosses = 2
, _gmsOvertime = 3
, _gmsGoalsFor = 4
, _gmsGoalsAgainst = 5
}
s2 = GameStats
{ _gmsWins = 4
, _gmsLosses = 6
, _gmsOvertime = 5
{ _gmsWins = 6
, _gmsLosses = 7
, _gmsOvertime = 8
, _gmsGoalsFor = 9
, _gmsGoalsAgainst = 10
}
expected = GameStats
{ _gmsWins = 5
{ _gmsWins = 7
, _gmsLosses = 9
, _gmsOvertime = 7
, _gmsOvertime = 11
, _gmsGoalsFor = 13
, _gmsGoalsAgainst = 15
}
in addGameStats s1 s2 `shouldBe` expected