diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index f700373..4cf62d4 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -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 diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index 518c1b0..f814334 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -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) diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index b5a2ecc..25f2fc5 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -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 diff --git a/test/ActionsSpec.hs b/test/ActionsSpec.hs index 7735057..1566af6 100644 --- a/test/ActionsSpec.hs +++ b/test/ActionsSpec.hs @@ -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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 5aad0a4..e617f45 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -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