fixed shutout bug

shutouts weren't being recorded

src/Mtlstats/Actions/NewGame/GoalieInput.hs

@@ -90,15 +90,19 @@ setGameGoalie gid s = fromMaybe s $ do
   won     <- gameWon gs
   lost    <- gameLost gs
   tied    <- gs^.overtimeFlag
+  shutout <- (==0) <$> otherScore gs
+
   let
     w  = if won then 1 else 0
     l  = if lost then 1 else 0
     t  = if tied then 1 else 0
+    so = if shutout then 1 else 0
 
     updateStats
       = (gsWins     +~ w)
       . (gsLosses   +~ l)
       . (gsTies     +~ t)
+      . (gsShutouts +~ so)
 
     updateGoalie
       = (gYtd      %~ updateStats)

test/Actions/NewGame/GoalieInputSpec.hs

@@ -33,7 +33,7 @@ import Mtlstats.Util
 import qualified TypesSpec as TS
 
 spec :: Spec
-spec = describe "Mtlstats.Actions.GoalieInput" $ do
+spec = describe "GoalieInput" $ do
   finishGoalieEntrySpec
   recordGoalieStatsSpec
   setGameGoalieSpec
@@ -208,107 +208,175 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
     ]
 
 setGameGoalieSpec :: Spec
-setGameGoalieSpec = describe "setGameGoalie" $ let
+setGameGoalieSpec = describe "setGameGoalie" $ mapM_
 
-  goalieStats w l t = newGoalieStats
+  (\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
-    & gsWins   .~ w
+    context label $ do
-    & gsLosses .~ l
-    & gsTies   .~ t
 
-  bob = newGoalie 2 "Bob"
-    & gYtd      .~ goalieStats 10 11 12
-    & gLifetime .~ goalieStats 20 21 22
-
-  joe = newGoalie 3 "Joe"
-    & gYtd      .~ goalieStats 30 31 32
-    & gLifetime .~ goalieStats 40 41 42
-
-  gameState h a ot = newGameState
-    & gameType        ?~ HomeGame
-    & homeScore       ?~ h
-    & awayScore       ?~ a
-    & overtimeFlag    ?~ ot
-
-  winningGame = gameState 1 0 False
-  losingGame  = gameState 0 1 False
-  tiedGame    = gameState 0 1 True
-
-  in mapM_
-    (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
-
-      progState = newProgState
-        & database.dbGoalies  .~ [bob, joe]
-        & progMode.gameStateL .~ gs
-        & setGameGoalie setGid
-
-      in mapM_
-        (\( chkLabel
-          , chkGid
-          , ( gWins
-            , gLosses
-            , gTies
-            , ytdWins
-            , ytdLosses
-            , ytdTies
-            , ltWins
-            , ltLosses
-            , ltTies
-            )
-          ) -> context chkLabel $ do
       let
-              goalie = (progState^.database.dbGoalies) !! chkGid
+        ps'          = setGameGoalie goalieId ps
-              gameStats = progState^.progMode.gameStateL.gameGoalieStats
+        [joe', bob'] = ps'^.database.dbGoalies
-              game      = M.findWithDefault newGoalieStats chkGid gameStats
+        gStats'      = ps'^.progMode.gameStateL.gameGoalieStats
-              ytd       = goalie^.gYtd
-              lifetime  = goalie^.gLifetime
 
-            mapM_
+      context "Joe" $ joe' `TS.compareTest` expectedJoe
-              (\(label', expected, actual) -> context label' $
+      context "Bob" $ bob' `TS.compareTest` expectedBob
-                expected `TS.compareTest` actual)
+      context "game stats" $ gStats' `TS.compareTest` expectedGStats)
-              [ ( "game stats",     game,     goalieStats gWins   gLosses   gTies   )
-              , ( "YTD stats",      ytd,      goalieStats ytdWins ytdLosses ytdTies )
-              , ( "lifetime stats", lifetime, goalieStats ltWins  ltLosses  ltTies  )
-              ]
 
-            it "should set the gameGoalieAssigned flag" $
+  [ ( "Joe wins - no shutout"
-              progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
-        [ ( "checking Bob", 0, bobData )
-        , ( "checking Joe", 1, joeData )
-        ])
-    [ ( "Bob wins"
-      , winningGame
     , 0
-      , ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
+    , psWin
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
+    , joeWin
+    , bob
+    , gsJoeWin
     )
-    , ( "Bob loses"
+
-      , losingGame
+  , ( "Bob wins - no shutout"
-      , 0
-      , ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
-      )
-    , ( "Bob ties"
-      , tiedGame
-      , 0
-      , ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
-      , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
-      )
-    , ( "Joe wins"
-      , winningGame
     , 1
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+    , psWin
-      , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
+    , joe
+    , bobWin
+    , gsBobWin
     )
+
+  , ( "Joe wins - shutout"
+    , 0
+    , psWinSO
+    , joeWinSO
+    , bob
+    , gsJoeWinSO
+    )
+
+  , ( "Bob wins - shutout"
+    , 1
+    , psWinSO
+    , joe
+    , bobWinSO
+    , gsBobWinSO
+    )
+
   , ( "Joe loses"
-      , losingGame
+    , 0
-      , 1
+    , psLose
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+    , joeLose
-      , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
+    , bob
+    , gsJoeLose
     )
-    , ( "Joe ties"
+
-      , tiedGame
+  , ( "Bob loses"
     , 1
-      , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
+    , psLose
-      , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
+    , joe
+    , bobLose
+    , gsBobLose
+    )
+
+  , ( "Joe overtime"
+    , 0
+    , psOT
+    , joeOT
+    , bob
+    , gsJoeOT
+    )
+
+  , ( "Bob overtime"
+    , 1
+    , psOT
+    , joe
+    , bobOT
+    , gsBobOT
     )
   ]
+
+  where
+
+    joe
+      = newGoalie 2 "Joe"
+      & gYtd
+        %~ (gsShutouts .~ 11)
+        .  (gsWins     .~ 12)
+        .  (gsLosses   .~ 13)
+        .  (gsTies     .~ 14)
+      & gLifetime
+        %~ (gsShutouts .~ 21)
+        .  (gsWins     .~ 22)
+        .  (gsLosses   .~ 23)
+        .  (gsTies     .~ 24)
+
+    bob
+      = newGoalie 3 "Bob"
+      & gYtd
+        %~ (gsShutouts .~ 31)
+        .  (gsWins     .~ 32)
+        .  (gsLosses   .~ 33)
+        .  (gsTies     .~ 34)
+      & gLifetime
+        %~ (gsShutouts .~ 41)
+        .  (gsWins     .~ 42)
+        .  (gsLosses   .~ 43)
+        .  (gsTies     .~ 44)
+
+    joeWin   = win joe
+    bobWin   = win bob
+    joeWinSO = winSO joe
+    bobWinSO = winSO bob
+    joeLose  = lose joe
+    bobLose  = lose bob
+    joeOT    = tie joe
+    bobOT    = tie bob
+
+    psWin = mkProgState
+      $ (homeScore ?~ 2)
+      . (awayScore ?~ 1)
+
+    psWinSO = mkProgState
+      $ (homeScore ?~ 1)
+      . (awayScore ?~ 0)
+
+    psLose = mkProgState
+      $ (homeScore ?~ 0)
+      . (awayScore ?~ 1)
+
+    psOT = mkProgState
+      $ (homeScore    ?~ 0)
+      . (awayScore    ?~ 1)
+      . (overtimeFlag ?~ True)
+
+    mkProgState f
+      = newProgState
+      & database.dbGoalies  .~ [joe, bob]
+      & progMode.gameStateL
+        %~ f
+        .  (gameType     ?~ HomeGame)
+        .  (overtimeFlag ?~ False)
+
+    gsJoeWin   = mkGameStats 0 incWin
+    gsBobWin   = mkGameStats 1 incWin
+    gsJoeWinSO = mkGameStats 0 $ incWin . incSO
+    gsBobWinSO = mkGameStats 1 $ incWin . incSO
+    gsJoeLose  = mkGameStats 0 incLoss
+    gsBobLose  = mkGameStats 1 incLoss
+    gsJoeOT    = mkGameStats 0 incOT
+    gsBobOT    = mkGameStats 1 incOT
+
+    mkGameStats n f = M.fromList [(n, f newGoalieStats)]
+
+    win
+      = (gYtd      %~ incWin)
+      . (gLifetime %~ incWin)
+
+    winSO
+      = (gYtd      %~ (incWin . incSO))
+      . (gLifetime %~ (incWin . incSO))
+
+    lose
+      = (gYtd      %~ incLoss)
+      . (gLifetime %~ incLoss)
+
+    tie
+      = (gYtd      %~ incOT)
+      . (gLifetime %~ incOT)
+
+    incWin  = gsWins     %~ succ
+    incSO   = gsShutouts %~ succ
+    incLoss = gsLosses   %~ succ
+    incOT   = gsTies     %~ succ

test/TypesSpec.hs

@@ -19,7 +19,7 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 -}
 
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
 
 module TypesSpec
   ( Comparable (..)
@@ -33,6 +33,7 @@ module TypesSpec
 import Control.Monad (replicateM)
 import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
 import Data.Aeson.Types (Value (Object))
+import qualified Data.Map.Lazy as M
 import qualified Data.HashMap.Strict as HM
 import Data.Ratio ((%))
 import Lens.Micro (Lens', (&), (^.), (.~), (?~))
@@ -1005,3 +1006,48 @@ instance Comparable EditStandingsMode where
   compareTest actual expected =
     it ("should be " ++ show expected) $
       actual `shouldBe` expected
+
+instance Comparable Goalie where
+  compareTest actual expected = do
+
+    describe "gNumber" $
+      it ("should be " ++ show (expected^.gNumber)) $
+        actual^.gNumber `shouldBe` expected^.gNumber
+
+    describe "gName" $
+      it ("should be " ++ show (expected^.gName)) $
+        actual^.gName `shouldBe` expected^.gName
+
+    describe "gRookie" $
+      it ("should be " ++ show (expected^.gRookie)) $
+        actual^.gRookie `shouldBe` expected^.gRookie
+
+    describe "gActive" $
+      it ("should be " ++ show (expected^.gActive)) $
+        actual^.gActive `shouldBe` expected^.gActive
+
+    describe "gYtd" $
+      (actual^.gYtd) `compareTest` (expected^.gYtd)
+
+    describe "gLifetime" $
+      (actual^.gLifetime) `compareTest` (expected^.gLifetime)
+
+instance Comparable (M.Map Int GoalieStats) where
+  compareTest actual expected = do
+
+    let
+      aList = M.toList actual
+      eList = M.toList expected
+
+    it "should have the correct number of elements" $
+      length aList `shouldBe` length eList
+
+    mapM_
+      (\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
+
+        context "key" $
+          it ("should be " ++ show ke) $
+            ka `shouldBe` ke
+
+        context "value" $ va `compareTest` ve)
+      (zip3 ([0..] :: [Int]) aList eList)