Merge pull request #19 from mtlstats/gfga

Calculate goals for/goals against

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
+  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
     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

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)

src/Mtlstats/Types.hs

@@ -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

test/ActionsSpec.hs

@@ -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

test/TypesSpec.hs

@@ -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
+    gs
-      { _gmsWins     = w
+      = newGameStats
-      , _gmsLosses   = l
+      & gmsWins     .~ w
-      , _gmsOvertime = ot
+      & 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
+      , _gmsLosses       = 2
-      , _gmsOvertime = 2
+      , _gmsOvertime     = 3
+      , _gmsGoalsFor     = 4
+      , _gmsGoalsAgainst = 5
       }
 
     s2 = GameStats
-      { _gmsWins     = 4
+      { _gmsWins         = 6
-      , _gmsLosses   = 6
+      , _gmsLosses       = 7
-      , _gmsOvertime = 5
+      , _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