diff --git a/ChangeLog.md b/ChangeLog.md index 2518430..344232d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,8 @@ # Changelog for mtlstats +## current +- Fixed a bug that was causing shutouts to not be recorded + ## 0.13.0 - Added autocomplete to player position prompt - Don't prompt for lifetime stats on rookie player/goalie creation diff --git a/src/Mtlstats/Actions/NewGame.hs b/src/Mtlstats/Actions/NewGame.hs index bc6d666..ddc20eb 100644 --- a/src/Mtlstats/Actions/NewGame.hs +++ b/src/Mtlstats/Actions/NewGame.hs @@ -124,12 +124,13 @@ awardGoal n ps = ps (\m -> let stats = M.findWithDefault newPlayerStats n m in M.insert n (stats & psGoals %~ succ) m) - & database.dbPlayers %~ map - (\(i, p) -> if i == n + & database.dbPlayers %~ zipWith + (\i p -> if i == n then p & pYtd.psGoals %~ succ & pLifetime.psGoals %~ succ - else p) . zip [0..] + else p) + [0..] -- | Awards an assist to a player awardAssist @@ -142,12 +143,13 @@ awardAssist n ps = ps (\m -> let stats = M.findWithDefault newPlayerStats n m in M.insert n (stats & psAssists %~ succ) m) - & database.dbPlayers %~ map - (\(i, p) -> if i == n + & database.dbPlayers %~ zipWith + (\i p -> if i == n then p & pYtd.psAssists %~ succ & pLifetime.psAssists %~ succ - else p) . zip [0..] + else p) + [0..] -- | Resets the entered data for the current goal resetGoalData :: ProgState -> ProgState diff --git a/src/Mtlstats/Actions/NewGame/GoalieInput.hs b/src/Mtlstats/Actions/NewGame/GoalieInput.hs index d4fb34c..ca9df98 100644 --- a/src/Mtlstats/Actions/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Actions/NewGame/GoalieInput.hs @@ -87,18 +87,22 @@ setGameGoalie -> ProgState setGameGoalie gid s = fromMaybe s $ do let gs = s^.progMode.gameStateL - won <- gameWon gs - lost <- gameLost gs - tied <- gs^.overtimeFlag + 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 + 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) + = (gsWins +~ w) + . (gsLosses +~ l) + . (gsTies +~ t) + . (gsShutouts +~ so) updateGoalie = (gYtd %~ updateStats) diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 4e4db16..7b298d6 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -170,10 +170,11 @@ gameGoalieMenu s = let goalie <- nth n $ s^.database.dbGoalies Just (n, goalie)) gids - in Menu title () $ map - (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $ - modify $ GI.setGameGoalie gid) $ - zip ['1'..] goalies + in Menu title () $ zipWith + (\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $ + modify $ GI.setGameGoalie gid) + ['1'..] + goalies -- | The edit menu editMenu :: Menu () diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 8f6d12d..e250178 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -164,9 +164,7 @@ numPromptWithFallback pStr fallback act = Prompt , promptProcessChar = \ch str -> if isDigit ch then str ++ [ch] else str - , promptAction = \inStr -> case readMaybe inStr of - Nothing -> fallback - Just n -> act n + , promptAction = maybe fallback act . readMaybe , promptSpecialKey = const $ return () } diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index f9b5ad4..7385adc 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -241,8 +241,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let else repeat "" table = overlayLast olayText - $ map (\(ln, line) -> overlay ln $ centre width line) - $ zip lnOverlay + $ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay $ complexTable ([right, left] ++ repeat right) $ tHeader : body ++ if showTotals then [separator, totals] @@ -301,8 +300,7 @@ goalieReport width showTotals lineNumbers goalieData = let then "" : [right 2 $ show x | x <- [(1 :: Int)..]] else repeat "" - in map (\(ln, line) -> overlay ln $ centre width line) - $ zip lnOverlay + in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay $ overlayLast olayText $ complexTable ([right, left] ++ repeat right) $ header : body ++ if showTotals diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 7b2cd69..f3e37a5 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -208,9 +208,8 @@ import Data.Aeson , (.=) ) import Data.Char (toUpper) -import Data.List (isInfixOf) +import Data.List (find, isInfixOf) import qualified Data.Map as M -import Data.Maybe (listToMaybe) import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro.TH (makeLenses) import qualified UI.NCurses as C @@ -1019,7 +1018,7 @@ playerSearchExact -> Maybe (Int, Player) -- ^ The player's index and value playerSearchExact sStr = - listToMaybe . filter match . zip [0..] + find match . zip [0..] where match (_, p) = p^.pName == sStr -- | Modifies a player with a given name diff --git a/src/Mtlstats/Util.hs b/src/Mtlstats/Util.hs index 153f719..951859c 100644 --- a/src/Mtlstats/Util.hs +++ b/src/Mtlstats/Util.hs @@ -52,8 +52,9 @@ modifyNth -> [a] -- ^ The list -> [a] -modifyNth n f = map (\(i, x) -> if i == n then f x else x) - . zip [0..] +modifyNth n f = zipWith + (\i x -> if i == n then f x else x) + [0..] -- | Modify a value indexed by a given key in a map using a default -- initial value if not present diff --git a/test/Actions/NewGame/GoalieInputSpec.hs b/test/Actions/NewGame/GoalieInputSpec.hs index eb8d83d..c688a88 100644 --- a/test/Actions/NewGame/GoalieInputSpec.hs +++ b/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 - & gsWins .~ w - & gsLosses .~ l - & gsTies .~ t + (\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) -> + context label $ do - bob = newGoalie 2 "Bob" - & gYtd .~ goalieStats 10 11 12 - & gLifetime .~ goalieStats 20 21 22 + let + ps' = setGameGoalie goalieId ps + [joe', bob'] = ps'^.database.dbGoalies + gStats' = ps'^.progMode.gameStateL.gameGoalieStats - joe = newGoalie 3 "Joe" - & gYtd .~ goalieStats 30 31 32 - & gLifetime .~ goalieStats 40 41 42 + context "Joe" $ joe' `TS.compareTest` expectedJoe + context "Bob" $ bob' `TS.compareTest` expectedBob + context "game stats" $ gStats' `TS.compareTest` expectedGStats) - gameState h a ot = newGameState - & gameType ?~ HomeGame - & homeScore ?~ h - & awayScore ?~ a - & overtimeFlag ?~ ot + [ ( "Joe wins - no shutout" + , 0 + , psWin + , joeWin + , bob + , gsJoeWin + ) - winningGame = gameState 1 0 False - losingGame = gameState 0 1 False - tiedGame = gameState 0 1 True + , ( "Bob wins - no shutout" + , 1 + , psWin + , joe + , bobWin + , gsBobWin + ) - in mapM_ - (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let + , ( "Joe wins - shutout" + , 0 + , psWinSO + , joeWinSO + , bob + , gsJoeWinSO + ) - progState = newProgState - & database.dbGoalies .~ [bob, joe] - & progMode.gameStateL .~ gs - & setGameGoalie setGid + , ( "Bob wins - shutout" + , 1 + , psWinSO + , joe + , bobWinSO + , gsBobWinSO + ) - in mapM_ - (\( chkLabel - , chkGid - , ( gWins - , gLosses - , gTies - , ytdWins - , ytdLosses - , ytdTies - , ltWins - , ltLosses - , ltTies - ) - ) -> context chkLabel $ do - let - goalie = (progState^.database.dbGoalies) !! chkGid - gameStats = progState^.progMode.gameStateL.gameGoalieStats - game = M.findWithDefault newGoalieStats chkGid gameStats - ytd = goalie^.gYtd - lifetime = goalie^.gLifetime + , ( "Joe loses" + , 0 + , psLose + , joeLose + , bob + , gsJoeLose + ) - mapM_ - (\(label', expected, actual) -> context label' $ - expected `TS.compareTest` actual) - [ ( "game stats", game, goalieStats gWins gLosses gTies ) - , ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies ) - , ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies ) - ] + , ( "Bob loses" + , 1 + , psLose + , joe + , bobLose + , gsBobLose + ) - it "should set the gameGoalieAssigned flag" $ - 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 ) - , ( 0, 0, 0, 30, 31, 32, 40, 41, 42 ) - ) - , ( "Bob loses" - , losingGame - , 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 ) - , ( 1, 0, 0, 31, 31, 32, 41, 41, 42 ) - ) - , ( "Joe loses" - , losingGame - , 1 - , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) - , ( 0, 1, 0, 30, 32, 32, 40, 42, 42 ) - ) - , ( "Joe ties" - , tiedGame - , 1 - , ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) - , ( 0, 0, 1, 30, 31, 33, 40, 41, 43 ) - ) - ] + , ( "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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index c678f76..d88de00 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -{-# 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)