fingerprint/mtlstats
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
parent 5332dc0d7f a9918c559b
commit c9b822df3c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 115 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/Mtlstats/Actions.hs
View File

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

6
src/Mtlstats/Report.hs
View File

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

50
src/Mtlstats/Types.hs
View File

@ -95,6 +95,8 @@ module Mtlstats.Types (
gmsWins, gmsWins,
gmsLosses, gmsLosses,
gmsOvertime, gmsOvertime,
gmsGoalsFor,
gmsGoalsAgainst,
-- * Constructors -- * Constructors
newProgState, newProgState,
newGameState, newGameState,
@ -405,12 +407,16 @@ instance ToJSON GoalieStats where
-- | Game statistics -- | Game statistics
data GameStats = GameStats data GameStats = GameStats
{ _gmsWins :: Int { _gmsWins :: Int
-- ^ Games won -- ^ Games won
, _gmsLosses :: Int , _gmsLosses :: Int
-- ^ Games lost -- ^ Games lost
, _gmsOvertime :: Int , _gmsOvertime :: Int
-- ^ Games lost in overtime -- ^ Games lost in overtime
, _gmsGoalsFor :: Int
-- ^ Goals for the team
, _gmsGoalsAgainst :: Int
-- ^ Goals against the team
} deriving (Eq, Show) } deriving (Eq, Show)
instance FromJSON GameStats where instance FromJSON GameStats where
@ -418,17 +424,23 @@ instance FromJSON GameStats where
<$> v .: "wins" <$> v .: "wins"
<*> v .: "losses" <*> v .: "losses"
<*> v .: "overtime" <*> v .: "overtime"
<*> v .: "goals_for"
<*> v .: "goals_against"
instance ToJSON GameStats where instance ToJSON GameStats where
toJSON (GameStats w l ot) = object toJSON (GameStats w l ot gf ga) = object
[ "wins" .= w [ "wins" .= w
, "losses" .= l , "losses" .= l
, "overtime" .= ot , "overtime" .= ot
, "goals_for" .= gf
, "goals_against" .= ga
] ]
toEncoding (GameStats w l ot) = pairs $ toEncoding (GameStats w l ot gf ga) = pairs $
"wins" .= w <> "wins" .= w <>
"losses" .= l <> "losses" .= l <>
"overtime" .= ot "overtime" .= ot <>
"goals_for" .= gf <>
"goals_against" .= ga
-- | Defines a user prompt -- | Defines a user prompt
data Prompt = Prompt data Prompt = Prompt
@ -563,9 +575,11 @@ newGoalieStats = GoalieStats
-- | Constructor for a 'GameStats' value -- | Constructor for a 'GameStats' value
newGameStats :: GameStats newGameStats :: GameStats
newGameStats = GameStats newGameStats = GameStats
{ _gmsWins = 0 { _gmsWins = 0
, _gmsLosses = 0 , _gmsLosses = 0
, _gmsOvertime = 0 , _gmsOvertime = 0
, _gmsGoalsFor = 0
, _gmsGoalsAgainst = 0
} }
-- | Determines the team's score -- | Determines the team's score
@ -632,9 +646,11 @@ gmsPoints gs = 2 * gs^.gmsWins + gs^. gmsOvertime
-- | Adds two 'GameStats' values together -- | Adds two 'GameStats' values together
addGameStats :: GameStats -> GameStats -> GameStats addGameStats :: GameStats -> GameStats -> GameStats
addGameStats s1 s2 = GameStats addGameStats s1 s2 = GameStats
{ _gmsWins = s1^.gmsWins + s2^.gmsWins { _gmsWins = s1^.gmsWins + s2^.gmsWins
, _gmsLosses = s1^.gmsLosses + s2^.gmsLosses , _gmsLosses = s1^.gmsLosses + s2^.gmsLosses
, _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime , _gmsOvertime = s1^.gmsOvertime + s2^.gmsOvertime
, _gmsGoalsFor = s1^.gmsGoalsFor + s2^.gmsGoalsFor
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
} }
-- | Calculates a player's points -- | Calculates a player's points

46
test/ActionsSpec.hs
View File

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

50
test/TypesSpec.hs
View File

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