Merge pull request #19 from mtlstats/gfga
Calculate goals for/goals against
This commit is contained in:
Jonathan Lamothe
GitHub
commit
c9b822df3c
|
|
@ -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)
|
||||
%~ (gmsWins +~ hw)
|
||||
. (gmsLosses +~ hl)
|
||||
. (gmsOvertime +~ hot)
|
||||
. (gmsGoalsFor +~ hgf)
|
||||
. (gmsGoalsAgainst +~ hga)
|
||||
& database.dbAwayGameStats
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
. (gmsGoalsFor +~ agf)
|
||||
. (gmsGoalsAgainst +~ aga)
|
||||
|
||||
-- | Validates the game date
|
||||
validateGameDate :: ProgState -> ProgState
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -95,6 +95,8 @@ module Mtlstats.Types (
|
|||
gmsWins,
|
||||
gmsLosses,
|
||||
gmsOvertime,
|
||||
gmsGoalsFor,
|
||||
gmsGoalsAgainst,
|
||||
-- * Constructors
|
||||
newProgState,
|
||||
newGameState,
|
||||
|
|
@ -405,12 +407,16 @@ instance ToJSON GoalieStats where
|
|||
|
||||
-- | Game statistics
|
||||
data GameStats = GameStats
|
||||
{ _gmsWins :: Int
|
||||
{ _gmsWins :: Int
|
||||
-- ^ Games won
|
||||
, _gmsLosses :: Int
|
||||
, _gmsLosses :: Int
|
||||
-- ^ Games lost
|
||||
, _gmsOvertime :: Int
|
||||
, _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
|
||||
[ "wins" .= w
|
||||
, "losses" .= l
|
||||
, "overtime" .= ot
|
||||
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 $
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
"overtime" .= ot
|
||||
toEncoding (GameStats w l ot gf ga) = pairs $
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
"overtime" .= ot <>
|
||||
"goals_for" .= gf <>
|
||||
"goals_against" .= ga
|
||||
|
||||
-- | Defines a user prompt
|
||||
data Prompt = Prompt
|
||||
|
|
@ -563,9 +575,11 @@ newGoalieStats = GoalieStats
|
|||
-- | Constructor for a 'GameStats' value
|
||||
newGameStats :: GameStats
|
||||
newGameStats = GameStats
|
||||
{ _gmsWins = 0
|
||||
, _gmsLosses = 0
|
||||
, _gmsOvertime = 0
|
||||
{ _gmsWins = 0
|
||||
, _gmsLosses = 0
|
||||
, _gmsOvertime = 0
|
||||
, _gmsGoalsFor = 0
|
||||
, _gmsGoalsAgainst = 0
|
||||
}
|
||||
|
||||
-- | Determines the team's score
|
||||
|
|
@ -632,9 +646,11 @@ gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
|
|||
-- | Adds two 'GameStats' values together
|
||||
addGameStats :: GameStats -> GameStats -> GameStats
|
||||
addGameStats s1 s2 = GameStats
|
||||
{ _gmsWins = s1^.gmsWins + s2^.gmsWins
|
||||
, _gmsLosses = s1^.gmsLosses + s2^.gmsLosses
|
||||
, _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
|
||||
{ _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
|
||||
|
|
|
|||
|
|
@ -193,9 +193,11 @@ updateGameStatsSpec = describe "updateGameStats" $ do
|
|||
let
|
||||
|
||||
baseStats = newGameStats
|
||||
& gmsWins .~ 1
|
||||
& gmsLosses .~ 1
|
||||
& gmsOvertime .~ 1
|
||||
& 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)
|
||||
%~ (gmsWins .~ hw)
|
||||
. (gmsLosses .~ hl)
|
||||
. (gmsOvertime .~ ho)
|
||||
. (gmsGoalsFor .~ hf)
|
||||
. (gmsGoalsAgainst .~ ha)
|
||||
& dbAwayGameStats
|
||||
%~ (gmsWins .~ aw)
|
||||
. (gmsLosses .~ al)
|
||||
. (gmsOvertime .~ ao)
|
||||
%~ (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
|
||||
|
|
|
|||
|
|
@ -255,16 +255,20 @@ goalieStatsJSON n = Object $ HM.fromList
|
|||
|
||||
gameStats :: Int -> GameStats
|
||||
gameStats n = GameStats
|
||||
{ _gmsWins = n
|
||||
, _gmsLosses = n + 1
|
||||
, _gmsOvertime = n + 2
|
||||
{ _gmsWins = n
|
||||
, _gmsLosses = n + 1
|
||||
, _gmsOvertime = n + 2
|
||||
, _gmsGoalsFor = n + 3
|
||||
, _gmsGoalsAgainst = n + 4
|
||||
}
|
||||
|
||||
gameStatsJSON :: Int -> Value
|
||||
gameStatsJSON n = Object $ HM.fromList
|
||||
[ ( "wins", toJSON n )
|
||||
, ( "losses", toJSON $ n + 1 )
|
||||
, ( "overtime", toJSON $ n + 2 )
|
||||
[ ( "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)
|
||||
|
|
@ -478,21 +482,27 @@ addGameStatsSpec = describe "addGameStats" $
|
|||
it "should add the values" $ let
|
||||
|
||||
s1 = GameStats
|
||||
{ _gmsWins = 1
|
||||
, _gmsLosses = 3
|
||||
, _gmsOvertime = 2
|
||||
{ _gmsWins = 1
|
||||
, _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
|
||||
, _gmsLosses = 9
|
||||
, _gmsOvertime = 7
|
||||
{ _gmsWins = 7
|
||||
, _gmsLosses = 9
|
||||
, _gmsOvertime = 11
|
||||
, _gmsGoalsFor = 13
|
||||
, _gmsGoalsAgainst = 15
|
||||
}
|
||||
|
||||
in addGameStats s1 s2 `shouldBe` expected
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user