diff --git a/src/Mtlstats/Actions/NewGame.hs b/src/Mtlstats/Actions/NewGame.hs index f8a8648..4ccec27 100644 --- a/src/Mtlstats/Actions/NewGame.hs +++ b/src/Mtlstats/Actions/NewGame.hs @@ -28,6 +28,7 @@ module Mtlstats.Actions.NewGame , awardAssist , resetGoalData , assignPMins + , awardShutouts ) where import qualified Data.Map as M @@ -171,3 +172,20 @@ assignPMins mins s = fromMaybe s $ do (psPMin +~ mins) ) . (gameSelectedPlayer .~ Nothing) + +-- | Awards a shutout to any 'Goalie' who played and didn't allow any +-- goals +awardShutouts :: ProgState -> ProgState +awardShutouts s = foldl + (\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0 + then s' + & database.dbGoalies %~ modifyNth gid + ( ( gYtd.gsShutouts %~ succ ) + . ( gLifetime.gsShutouts %~ succ ) + ) + & progMode.gameStateL.gameGoalieStats %~ M.adjust + (gsShutouts %~ succ) + gid + else s') + s + (M.toList $ s^.progMode.gameStateL.gameGoalieStats) diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index e57b4b4..b8521d7 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -43,7 +43,7 @@ dispatch :: ProgState -> Controller dispatch s = case s^.progMode of MainMenu -> mainMenuC NewSeason -> newSeasonC - NewGame _ -> newGameC s + NewGame gs -> newGameC gs CreatePlayer cps | null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsName -> getPlayerNameC diff --git a/src/Mtlstats/Control/NewGame.hs b/src/Mtlstats/Control/NewGame.hs index 6c26bca..f534f2b 100644 --- a/src/Mtlstats/Control/NewGame.hs +++ b/src/Mtlstats/Control/NewGame.hs @@ -39,95 +39,43 @@ import Mtlstats.Types import Mtlstats.Util -- | Dispatcher for a new game -newGameC :: ProgState -> Controller -newGameC s = let - gs = s^.progMode.gameStateL - in if null $ gs^.gameYear then gameYearC - else if null $ gs^.gameMonth then gameMonthC - else if null $ gs^.gameDay then gameDayC - else if null $ gs^.gameType then gameTypeC - else if null $ gs^.otherTeam then otherTeamC - else if null $ gs^.homeScore then homeScoreC - else if null $ gs^.awayScore then awayScoreC - else if null $ gs^.overtimeFlag then overtimeFlagC - else if not $ gs^.dataVerified then verifyDataC - else if fromJust (unaccountedPoints gs) then goalInput gs - else if isJust $ gs^.gameSelectedPlayer then getPMinsC - else if not $ gs^.gamePMinsRecorded then pMinPlayerC - else if not $ gs^.gameGoalieAssigned then goalieInputC s - else reportC +newGameC :: GameState -> Controller +newGameC gs + | null $ gs^.gameYear = gameYearC + | null $ gs^.gameMonth = gameMonthC + | null $ gs^.gameDay = gameDayC + | null $ gs^.gameType = gameTypeC + | null $ gs^.otherTeam = otherTeamC + | null $ gs^.homeScore = homeScoreC + | null $ gs^.awayScore = awayScoreC + | null $ gs^.overtimeFlag = overtimeFlagC + | not $ gs^.dataVerified = verifyDataC + | fromJust (unaccountedPoints gs) = goalInput gs + | isJust $ gs^.gameSelectedPlayer = getPMinsC + | not $ gs^.gamePMinsRecorded = pMinPlayerC + | not $ gs^.gameGoalieAssigned = goalieInputC gs + | otherwise = reportC gameYearC :: Controller -gameYearC = Controller - { drawController = \s -> do - header s - drawPrompt gameYearPrompt s - , handleController = \e -> do - promptHandler gameYearPrompt e - return True - } +gameYearC = promptControllerWith header gameYearPrompt gameMonthC :: Controller -gameMonthC = Controller - { drawController = \s -> do - header s - drawMenu gameMonthMenu - , handleController = \e -> do - menuHandler gameMonthMenu e - return True - } +gameMonthC = menuControllerWith header gameMonthMenu gameDayC :: Controller -gameDayC = Controller - { drawController = \s -> do - header s - drawPrompt gameDayPrompt s - , handleController = \e -> do - promptHandler gameDayPrompt e - modify validateGameDate - return True - } +gameDayC = promptControllerWith header gameDayPrompt gameTypeC :: Controller -gameTypeC = Controller - { drawController = \s -> do - header s - drawMenu gameTypeMenu - , handleController = \e -> do - menuHandler gameTypeMenu e - return True - } +gameTypeC = menuControllerWith header gameTypeMenu otherTeamC :: Controller -otherTeamC = Controller - { drawController = \s -> do - header s - drawPrompt otherTeamPrompt s - , handleController = \e -> do - promptHandler otherTeamPrompt e - return True - } +otherTeamC = promptControllerWith header otherTeamPrompt homeScoreC :: Controller -homeScoreC = Controller - { drawController = \s -> do - header s - drawPrompt homeScorePrompt s - , handleController = \e -> do - promptHandler homeScorePrompt e - return True - } +homeScoreC = promptControllerWith header homeScorePrompt awayScoreC :: Controller -awayScoreC = Controller - { drawController = \s -> do - header s - drawPrompt awayScorePrompt s - , handleController = \e -> do - promptHandler awayScorePrompt e - modify overtimeCheck - return True - } +awayScoreC = promptControllerWith header awayScorePrompt overtimeFlagC :: Controller overtimeFlagC = Controller @@ -146,19 +94,22 @@ verifyDataC = Controller let gs = s^.progMode.gameStateL header s C.drawString "\n" - C.drawString $ " Date: " ++ gameDate gs ++ "\n" - C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n" - C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n" - C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n" - C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n" - C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n" - C.drawString "Is the above information correct? (Y/N)" + C.drawString $ unlines $ labelTable + [ ( "Date", gameDate gs ) + , ( "Game type", show $ fromJust $ gs^.gameType ) + , ( "Other team", gs^.otherTeam ) + , ( "Home score", show $ fromJust $ gs^.homeScore ) + , ( "Away score", show $ fromJust $ gs^.awayScore ) + , ( "Overtime", show $ fromJust $ gs^.overtimeFlag ) + ] + C.drawString "\nIs the above information correct? (Y/N)" return C.CursorInvisible , handleController = \e -> do case ynHandler e of - Just True -> do - modify $ progMode.gameStateL.dataVerified .~ True - modify updateGameStats + Just True -> modify + $ (progMode.gameStateL.dataVerified .~ True) + . updateGameStats + . awardShutouts Just False -> modify $ progMode.gameStateL .~ newGameState Nothing -> return () return True diff --git a/src/Mtlstats/Control/NewGame/GoalieInput.hs b/src/Mtlstats/Control/NewGame/GoalieInput.hs index 9cf5d6a..17eb278 100644 --- a/src/Mtlstats/Control/NewGame/GoalieInput.hs +++ b/src/Mtlstats/Control/NewGame/GoalieInput.hs @@ -33,16 +33,12 @@ import Mtlstats.Types import Mtlstats.Util -- | The dispatcher for handling goalie input -goalieInputC :: ProgState -> Controller -goalieInputC s = let - gs = s^.progMode.gameStateL - in if gs^.gameGoaliesRecorded - then selectGameGoalieC s - else if null $ gs^.gameSelectedGoalie - then selectGoalieC - else if null $ gs^.gameGoalieMinsPlayed - then minsPlayedC - else goalsAllowedC +goalieInputC :: GameState -> Controller +goalieInputC gs + | gs^.gameGoaliesRecorded = selectGameGoalieC + | null $ gs^.gameSelectedGoalie = selectGoalieC + | null $ gs^.gameGoalieMinsPlayed = minsPlayedC + | otherwise = goalsAllowedC selectGoalieC :: Controller selectGoalieC = promptController selectGameGoaliePrompt @@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt goalsAllowedC :: Controller goalsAllowedC = promptControllerWith header goalsAllowedPrompt -selectGameGoalieC :: ProgState -> Controller -selectGameGoalieC = menuController . gameGoalieMenu +selectGameGoalieC :: Controller +selectGameGoalieC = menuStateController gameGoalieMenu header :: ProgState -> C.Update () header s = C.drawString $ unlines diff --git a/src/Mtlstats/Format.hs b/src/Mtlstats/Format.hs index 5dfbcd1..e7279fd 100644 --- a/src/Mtlstats/Format.hs +++ b/src/Mtlstats/Format.hs @@ -19,6 +19,8 @@ along with this program. If not, see . -} +{-# LANGUAGE LambdaCase #-} + module Mtlstats.Format ( padNum , left @@ -29,10 +31,15 @@ module Mtlstats.Format , labelTable , numTable , tableWith + , complexTable + , overlayLast + , showFloating ) where import Data.List (transpose) +import Mtlstats.Types + -- | Pad an 'Int' with leading zeroes to fit a certain character width padNum :: Int @@ -138,12 +145,52 @@ tableWith -> [[String]] -- ^ The cells -> [String] -tableWith func tdata = let - widths = map (map length) tdata +tableWith pFunc tData = complexTable + (repeat pFunc) + (map (map CellText) tData) + +-- | Creates a complex table +complexTable + :: [Int -> String -> String] + -- ^ The padding function for each column + -> [[TableCell]] + -- ^ The table cells (an array of rows) + -> [String] +complexTable pFuncs tData = let + widths = map + (map $ \case + CellText str -> length str + CellFill _ -> 0) + tData colWidths = map maximum $ transpose widths - fitted = map - (\row -> map - (\(str, len) -> func len str) $ - zip row colWidths) - tdata - in map unwords fitted + + bFunc = \case + [] -> "" + [(f, len, CellText str)] -> f len str + [(_, len, CellFill ch)] -> replicate len ch + (f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells + (_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells + + in map + (bFunc . zip3 pFuncs colWidths) + tData + +-- | Places an overlay on the last line of an report +overlayLast + :: String + -- ^ The text to overlay + -> [String] + -- ^ The report to modify + -> [String] + -- ^ The resulting report +overlayLast _ [] = [] +overlayLast str [l] = [overlay str l] +overlayLast str (l:ls) = l : overlayLast str ls + +-- | Converts a non-integer into a string +showFloating :: RealFrac n => n -> String +showFloating n = let + i = round $ n * 100 + whole = i `div` 100 + fraction = i `mod` 100 + in show whole ++ "." ++ padNum 2 fraction diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index db404ae..77c6f63 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -23,6 +23,7 @@ module Mtlstats.Menu ( -- * Menu Functions menuController, menuControllerWith, + menuStateController, drawMenu, menuHandler, -- * Menus @@ -76,6 +77,21 @@ menuControllerWith header menu = Controller return True } +-- | Generate and create a controller for a menu based on the current +-- 'ProgState' +menuStateController + :: (ProgState -> Menu ()) + -- ^ The function to generate the menu + -> Controller + -- ^ The resulting controller +menuStateController menuFunc = Controller + { drawController = drawMenu . menuFunc + , handleController = \e -> do + menu <- gets menuFunc + menuHandler menu e + return True + } + -- | The draw function for a 'Menu' drawMenu :: Menu a -> C.Update C.CursorMode drawMenu m = do diff --git a/src/Mtlstats/Prompt/NewGame.hs b/src/Mtlstats/Prompt/NewGame.hs index 3812b97..a6cdfc7 100644 --- a/src/Mtlstats/Prompt/NewGame.hs +++ b/src/Mtlstats/Prompt/NewGame.hs @@ -65,8 +65,9 @@ homeScorePrompt = numPrompt "Home score: " $ -- | Prompts for the away score awayScorePrompt :: Prompt -awayScorePrompt = numPrompt "Away score: " $ - modify . (progMode.gameStateL.awayScore ?~) +awayScorePrompt = numPrompt "Away score: " $ \score -> modify + $ overtimeCheck + . (progMode.gameStateL.awayScore ?~ score) -- | Prompts for the player who scored the goal recordGoalPrompt diff --git a/src/Mtlstats/Report.hs b/src/Mtlstats/Report.hs index cb7ee4f..913e2c8 100644 --- a/src/Mtlstats/Report.hs +++ b/src/Mtlstats/Report.hs @@ -19,10 +19,10 @@ along with this program. If not, see . -} -module Mtlstats.Report (report, gameDate, playerNameColWidth) where +module Mtlstats.Report (report, gameDate) where import qualified Data.Map as M -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import Lens.Micro ((^.)) import Mtlstats.Config @@ -60,54 +60,104 @@ standingsReport width s = fromMaybe [] $ do tStats = addGameStats hStats aStats hScore <- gs^.homeScore aScore <- gs^.awayScore - Just - [ overlay - ("GAME NUMBER " ++ padNum 2 gNum) - (centre width - $ aTeam ++ " " ++ show aScore ++ " AT " - ++ hTeam ++ " " ++ show hScore) - , date - , centre width "STANDINGS" - , "" - , centre width - $ left 11 myTeam - ++ right 2 "G" - ++ right 4 "W" - ++ right 4 "L" - ++ right 4 "OT" - ++ right 4 "GF" - ++ right 4 "GA" - ++ right 4 "P" - , centre width - $ left 11 "HOME" - ++ showStats hStats - , centre width - $ left 11 "ROAD" - ++ showStats aStats - , centre width - $ replicate 11 ' ' - ++ replicate (2 + 4 * 6) '-' - , centre width - $ left 11 "TOTALS" - ++ showStats tStats - ] + let + rHeader = + [ overlay + ("GAME NUMBER " ++ padNum 2 gNum) + (centre width + $ aTeam ++ " " ++ show aScore ++ " AT " + ++ hTeam ++ " " ++ show hScore) + , date + , centre width "STANDINGS" + , "" + ] + + tHeader = + [ CellText myTeam + , CellText " G" + , CellText " W" + , CellText " L" + , CellText " OT" + , CellText " GF" + , CellText " GA" + , CellText " P" + ] + + rowCells stats = + [ CellText $ show $ gmsGames stats + , CellText $ show $ stats^.gmsWins + , CellText $ show $ stats^.gmsLosses + , CellText $ show $ stats^.gmsOvertime + , CellText $ show $ stats^.gmsGoalsFor + , CellText $ show $ stats^.gmsGoalsAgainst + , CellText $ show $ gmsPoints stats + ] + + body = + [ CellText "HOME" : rowCells hStats + , CellText "ROAD" : rowCells aStats + ] + + separator = CellText "" : replicate 7 (CellFill '-') + totals = CellText "TOTALS" : rowCells tStats + + table = map (centre width) $ + complexTable + (left : repeat right) + (tHeader : body ++ [separator, totals]) + + Just $ rHeader ++ table gameStatsReport :: Int -> ProgState -> [String] -gameStatsReport width s = playerReport width "GAME" $ - fromMaybe [] $ mapM +gameStatsReport width s = let + gs = s^.progMode.gameStateL + db = s^.database + + playerStats = mapMaybe (\(pid, stats) -> do - p <- nth pid $ s^.database.dbPlayers + p <- nth pid $ db^.dbPlayers Just (p, stats)) - (M.toList $ s^.progMode.gameStateL.gamePlayerStats) + (M.toList $ gs^.gamePlayerStats) + + goalieStats = mapMaybe + (\(gid, stats) -> do + g <- nth gid $ db^.dbGoalies + Just (g, stats)) + (M.toList $ gs^.gameGoalieStats) + + in playerReport width "GAME" playerStats + ++ [""] + ++ goalieReport width goalieStats yearToDateStatsReport :: Int -> ProgState -> [String] -yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $ - map (\p -> (p, p^.pYtd)) $ - filter playerIsActive $ s^.database.dbPlayers +yearToDateStatsReport width s = let + db = s^.database + + playerStats = map (\p -> (p, p^.pYtd)) + $ filter playerIsActive + $ db^.dbPlayers + + goalieStats = map (\g -> (g, g^.gYtd)) + $ filter goalieIsActive + $ db^.dbGoalies + + in playerReport width "YEAR TO DATE" playerStats + ++ [""] + ++ goalieReport width goalieStats lifetimeStatsReport :: Int -> ProgState -> [String] -lifetimeStatsReport width s = playerReport width "LIFETIME" $ - map (\p -> (p, p^.pLifetime)) $ s^.database.dbPlayers +lifetimeStatsReport width s = let + db = s^.database + + playerStats = map (\p -> (p, p^.pYtd)) + $ db^.dbPlayers + + goalieStats = map (\g -> (g, g^.gYtd)) + $ db^.dbGoalies + + in playerReport width "LIFETIME" playerStats + ++ [""] + ++ goalieReport width goalieStats gameDate :: GameState -> String gameDate gs = fromMaybe "" $ do @@ -118,53 +168,89 @@ gameDate gs = fromMaybe "" $ do playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String] playerReport width label ps = let - nameWidth = playerNameColWidth $ map fst ps - tStats = foldr (addPlayerStats . snd) newPlayerStats ps - in + tStats = foldl addPlayerStats newPlayerStats $ map snd ps + + rHeader = [ centre width (label ++ " STATISTICS") , "" - , centre width - $ "NO. " - ++ left nameWidth "PLAYER" - ++ right 3 "G" - ++ right 6 "A" - ++ right 6 "P" - ++ right 6 "PM" - ] ++ map - (\(p, stats) -> centre width - $ right 2 (show $ p^.pNumber) - ++ " " - ++ left nameWidth (p^.pName) - ++ right 3 (show $ stats^.psGoals) - ++ right 6 (show $ stats^.psAssists) - ++ right 6 (show $ psPoints stats) - ++ right 6 (show $ stats^.psPMin)) - ps ++ - [ centre width - $ replicate (4 + nameWidth) ' ' - ++ replicate (3 + 3 * 6) '-' - , overlay - (label ++ " TOTALS") - ( centre width - $ replicate (4 + nameWidth) ' ' - ++ right 3 (show $ tStats^.psGoals) - ++ right 6 (show $ tStats^.psAssists) - ++ right 6 (show $ psPoints tStats) - ++ right 6 (show $ tStats^.psPMin) - ) ] -playerNameColWidth :: [Player] -> Int -playerNameColWidth = foldr - (\player current -> max current $ succ $ length $ player^.pName) - 10 + tHeader = + [ CellText "NO." + , CellText "Player" + , CellText " G" + , CellText " A" + , CellText " P" + , CellText " PM" + ] -showStats :: GameStats -> String -showStats gs - = right 2 (show $ gmsGames 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) + statsCells stats = + [ CellText $ show $ stats^.psGoals + , CellText $ show $ stats^.psAssists + , CellText $ show $ psPoints stats + , CellText $ show $ stats^.psPMin + ] + + body = map + (\(p, stats) -> + [ CellText $ show (p^.pNumber) ++ " " + , CellText $ p^.pName + ] ++ statsCells stats) + ps + + separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-') + + totals = + [ CellText "" + , CellText "" + ] ++ statsCells tStats + + table = overlayLast (label ++ " TOTALS") + $ map (centre width) + $ complexTable ([right, left] ++ repeat right) + $ tHeader : body ++ [separator, totals] + + in rHeader ++ table + +goalieReport :: Int -> [(Goalie, GoalieStats)] -> [String] +goalieReport width goalieData = let + olayText = "GOALTENDING TOTALS" + + tData = foldl addGoalieStats newGoalieStats + $ map snd goalieData + + header = + [ CellText "NO." + , CellText $ left (length olayText) "GOALTENDER" + , CellText "GP" + , CellText " MIN" + , CellText " GA" + , CellText " SO" + , CellText "AVE" + ] + + rowCells stats = + [ CellText $ show $ stats^.gsGames + , CellText $ show $ stats^.gsMinsPlayed + , CellText $ show $ stats^.gsGoalsAllowed + , CellText $ show $ stats^.gsShutouts + , CellText $ showFloating $ gsAverage stats + ] + + body = map + (\(goalie, stats) -> + [ CellText $ show (goalie^.gNumber) ++ " " + , CellText $ show $ goalie^.gName + ] ++ rowCells stats) + goalieData + + separator + = replicate 2 (CellText "") + ++ replicate 5 (CellFill '-') + + summary = replicate 2 (CellText "") ++ rowCells tData + + in map (centre width) + $ overlayLast olayText + $ complexTable ([right, left] ++ repeat right) + $ header : body ++ [separator, summary] diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index 827e779..6403c90 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -43,6 +43,7 @@ module Mtlstats.Types ( GameStats (..), Prompt (..), SelectParams (..), + TableCell (..), -- * Lenses -- ** ProgState Lenses database, @@ -120,6 +121,7 @@ module Mtlstats.Types ( gsGames, gsMinsPlayed, gsGoalsAllowed, + gsShutouts, gsWins, gsLosses, gsTies, @@ -168,7 +170,11 @@ module Mtlstats.Types ( -- ** Goalie Helpers goalieSearch, goalieSearchExact, - goalieSummary + goalieSummary, + goalieIsActive, + -- ** GoalieStats Helpers + addGoalieStats, + gsAverage ) where import Control.Monad.Trans.State (StateT) @@ -182,6 +188,8 @@ import Data.Aeson , toJSON , withObject , (.:) + , (.:?) + , (.!=) , (.=) ) import Data.List (isInfixOf) @@ -513,6 +521,8 @@ data GoalieStats = GoalieStats -- ^ The number of minutes played , _gsGoalsAllowed :: Int -- ^ The number of goals allowed + , _gsShutouts :: Int + -- ^ The number of shutouts the goalie has accumulated , _gsWins :: Int -- ^ The number of wins , _gsLosses :: Int @@ -523,26 +533,29 @@ data GoalieStats = GoalieStats instance FromJSON GoalieStats where parseJSON = withObject "GoalieStats" $ \v -> GoalieStats - <$> v .: "games" - <*> v .: "mins_played" - <*> v .: "goals_allowed" - <*> v .: "wins" - <*> v .: "losses" - <*> v .: "ties" + <$> v .:? "games" .!= 0 + <*> v .:? "mins_played" .!= 0 + <*> v .:? "goals_allowed" .!= 0 + <*> v .:? "shutouts" .!= 0 + <*> v .:? "wins" .!= 0 + <*> v .:? "losses" .!= 0 + <*> v .:? "ties" .!= 0 instance ToJSON GoalieStats where - toJSON (GoalieStats g m a w l t) = object + toJSON (GoalieStats g m a s w l t) = object [ "games" .= g , "mins_played" .= m , "goals_allowed" .= a + , "shutouts" .= s , "wins" .= w , "losses" .= l , "ties" .= t ] - toEncoding (GoalieStats g m a w l t) = pairs $ + toEncoding (GoalieStats g m a s w l t) = pairs $ "games" .= g <> "mins_played" .= m <> "goals_allowed" .= a <> + "shutouts" .= s <> "wins" .= w <> "losses" .= l <> "ties" .= t @@ -614,6 +627,14 @@ data SelectParams a = SelectParams -- ^ The function to call when the selection doesn't exist } +-- | Describes a table cell +data TableCell + = CellText String + -- ^ A cell with text + | CellFill Char + -- ^ A cell filled with the given character + deriving (Eq, Show) + makeLenses ''ProgState makeLenses ''GameState makeLenses ''CreatePlayerState @@ -786,6 +807,7 @@ newGoalieStats = GoalieStats { _gsGames = 0 , _gsMinsPlayed = 0 , _gsGoalsAllowed = 0 + , _gsShutouts = 0 , _gsWins = 0 , _gsLosses = 0 , _gsTies = 0 @@ -966,3 +988,24 @@ goalieSearchExact sStr goalies = let -- | Provides a description string for a 'Goalie' goalieSummary :: Goalie -> String goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")" + +-- | Determines whether or not a goalie has been active in the current +-- season +goalieIsActive :: Goalie -> Bool +goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0 + +-- | Adds two sets of 'GoalieStats' +addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats +addGoalieStats g1 g2 = GoalieStats + { _gsGames = g1^.gsGames + g2^.gsGames + , _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed + , _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed + , _gsShutouts = g1^.gsShutouts + g2^.gsShutouts + , _gsWins = g1^.gsWins + g2^.gsWins + , _gsLosses = g1^.gsLosses + g2^.gsLosses + , _gsTies = g1^.gsTies + g2^.gsTies + } + +-- | Determines a goalie's average goals allowed per game. +gsAverage :: GoalieStats -> Rational +gsAverage gs = fromIntegral (gs^.gsGoalsAllowed) / fromIntegral (gs^.gsGames) diff --git a/test/Actions/NewGameSpec.hs b/test/Actions/NewGameSpec.hs index eb1acb5..8bdb95d 100644 --- a/test/Actions/NewGameSpec.hs +++ b/test/Actions/NewGameSpec.hs @@ -44,6 +44,7 @@ spec = describe "NewGame" $ do awardAssistSpec resetGoalDataSpec assignPMinsSpec + awardShutoutsSpec GoalieInput.spec overtimeCheckSpec :: Spec @@ -481,3 +482,45 @@ assignPMinsSpec = describe "assignPMins" $ let , ( Just 2, 4, 3, 2, 6, 5, 0 ) , ( Nothing, 4, 3, 2, 6, 5, 0 ) ] + +awardShutoutsSpec :: Spec +awardShutoutsSpec = describe "awardShutouts" $ let + joe = newGoalie 2 "Joe" + & gYtd.gsShutouts .~ 1 + & gLifetime.gsShutouts .~ 2 + + bob = newGoalie 3 "Bob" + & gYtd.gsShutouts .~ 3 + & gLifetime.gsShutouts .~ 4 + + steve = newGoalie 5 "Steve" + & gYtd.gsShutouts .~ 5 + & gLifetime.gsShutouts .~ 6 + + ps = newProgState + & database.dbGoalies .~ [joe, bob, steve] + & progMode.gameStateL.gameGoalieStats .~ M.fromList + [ ( 0, newGoalieStats & gsGoalsAllowed .~ 1 ) + , ( 1, newGoalieStats ) + ] + & awardShutouts + + in mapM_ + (\(name, gid, expectedGame, expectedYtd, expectedLt) -> context name $ let + game = M.findWithDefault newGoalieStats gid $ + ps^.progMode.gameStateL.gameGoalieStats + goalie = (ps^.database.dbGoalies) !! gid + in mapM_ + (\(label, actual, expected) -> context label $ + it ("should be " ++ show actual) $ + actual `shouldBe` expected) + -- label, actual, expected + [ ( "Game", game^.gsShutouts, expectedGame ) + , ( "YTD", goalie^.gYtd.gsShutouts, expectedYtd ) + , ( "lifetime", goalie^.gLifetime.gsShutouts, expectedLt ) + ]) + -- goalie, goalie ID, Game, YTD, lifetime + [ ( "Joe", 0, 0, 1, 2 ) + , ( "Bob", 1, 1, 4, 5 ) + , ( "Steve", 2, 0, 5, 6 ) + ] diff --git a/test/FormatSpec.hs b/test/FormatSpec.hs index 6c80913..a7f7949 100644 --- a/test/FormatSpec.hs +++ b/test/FormatSpec.hs @@ -21,9 +21,11 @@ along with this program. If not, see . module FormatSpec (spec) where +import Data.Ratio ((%)) import Test.Hspec (Spec, context, describe, it, shouldBe) import Mtlstats.Format +import Mtlstats.Types spec :: Spec spec = describe "Mtlstats.Format" $ do @@ -36,6 +38,9 @@ spec = describe "Mtlstats.Format" $ do labelTableSpec numTableSpec tableWithSpec + complexTableSpec + overlayLastSpec + showFloatingSpec padNumSpec :: Spec padNumSpec = describe "padNum" $ do @@ -174,3 +179,60 @@ tableWithSpec = describe "tableWith" $ let ] ) ] + +complexTableSpec :: Spec +complexTableSpec = describe "complexTable" $ mapM_ + (\(label, pFuncs, cells, expected) -> context label $ + it "should format correctly" $ + complexTable pFuncs cells `shouldBe` expected) + [ ( "no fill" + , [left, right] + , [ [ CellText "foo", CellText "bar" ] + , [ CellText "baaz", CellText "quux" ] + ] + , [ "foo bar" + , "baaz quux" + ] + ) + , ( "with fill" + , [left, left, left] + , [ [ CellText "foo", CellText "bar", CellText "baz" ] + , [ CellText "quux", CellFill '-', CellFill '@' ] + ] + , [ "foo bar baz" + , "quux ----@@@" + ] + ) + ] + +overlayLastSpec :: Spec +overlayLastSpec = describe "overlayLast" $ let + text = "foo" + + sample = + [ "line 1" + , "line 2" + ] + + edited = + [ "line 1" + , "fooe 2" + ] + + in mapM_ + (\(label, input, expected) -> context label $ + it ("should be " ++ show expected) $ + overlayLast text input `shouldBe` expected) + + -- label, input, expected + [ ( "empty list", [], [] ) + , ( "non-empty list", sample, edited ) + ] + +showFloatingSpec :: Spec +showFloatingSpec = describe "showFloating" $ let + input = 3 % 2 :: Rational + expected = "1.50" + + in it ("should be " ++ expected) $ + showFloating input `shouldBe` expected diff --git a/test/ReportSpec.hs b/test/ReportSpec.hs index 310817a..d3998b3 100644 --- a/test/ReportSpec.hs +++ b/test/ReportSpec.hs @@ -28,9 +28,8 @@ import Mtlstats.Report import Mtlstats.Types spec :: Spec -spec = describe "Mtlstats.Report" $ do +spec = describe "Mtlstats.Report" gameDateSpec - playerNameColWidthSpec gameDateSpec :: Spec gameDateSpec = describe "gameDate" $ do @@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do context "invalid date" $ it "should return an empty string" $ gameDate newGameState `shouldBe` "" - -playerNameColWidthSpec :: Spec -playerNameColWidthSpec = describe "playerNameColWidth" $ do - let - short1 = newPlayer 1 "short" "foo" - short2 = newPlayer 2 "shorty" "bar" - long = newPlayer 3 "123456789012345" "baz" - - mapM_ - (\(label, players, expected) -> context label $ - it ("should be " ++ show expected) $ - playerNameColWidth players `shouldBe` expected) - -- label, players, expected - [ ( "empty list", [], 10 ) - , ( "short names", [short1, short2], 10 ) - , ( "long name", [short1, long], 16 ) - ] diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs index 60dbcd6..294d17d 100644 --- a/test/TypesSpec.hs +++ b/test/TypesSpec.hs @@ -34,6 +34,7 @@ import Control.Monad (replicateM) import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON) import Data.Aeson.Types (Value (Object)) import qualified Data.HashMap.Strict as HM +import Data.Ratio ((%)) import Lens.Micro (Lens', (&), (^.), (.~), (?~)) import System.Random (randomRIO) import Test.Hspec (Spec, context, describe, it, shouldBe) @@ -78,6 +79,9 @@ spec = describe "Mtlstats.Types" $ do goalieSearchSpec goalieSearchExactSpec goalieSummarySpec + goalieIsActiveSpec + addGoalieStatsSpec + gsAverageSpec Menu.spec playerSpec :: Spec @@ -310,18 +314,20 @@ goalieStats n = newGoalieStats & gsGames .~ n & gsMinsPlayed .~ n + 1 & gsGoalsAllowed .~ n + 2 - & gsWins .~ n + 3 - & gsLosses .~ n + 4 - & gsTies .~ n + 5 + & gsShutouts .~ n + 3 + & gsWins .~ n + 4 + & gsLosses .~ n + 5 + & gsTies .~ n + 6 goalieStatsJSON :: Int -> Value goalieStatsJSON n = Object $ HM.fromList [ ( "games", toJSON n ) , ( "mins_played", toJSON $ n + 1 ) , ( "goals_allowed", toJSON $ n + 2 ) - , ( "wins", toJSON $ n + 3 ) - , ( "losses", toJSON $ n + 4 ) - , ( "ties", toJSON $ n + 5 ) + , ( "shutouts", toJSON $ n + 3 ) + , ( "wins", toJSON $ n + 4 ) + , ( "losses", toJSON $ n + 5 ) + , ( "ties", toJSON $ n + 6 ) ] gameStats :: Int -> GameStats @@ -751,6 +757,72 @@ goalieSummarySpec = describe "goalieSummary" $ it "should provide a summary string" $ goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)" +goalieIsActiveSpec :: Spec +goalieIsActiveSpec = describe "goalieIsActive" $ mapM_ + (\(label, input, expected) -> context label $ + it ("should be " ++ show expected) $ + goalieIsActive input `shouldBe` expected) + + -- label, input, expected + [ ( "inactive", inactive, False ) + , ( "active", active, True ) + ] + + where + inactive = newGoalie 1 "Joe" + & gLifetime.gsMinsPlayed .~ 1 + + active = inactive + & gYtd.gsMinsPlayed .~ 1 + +addGoalieStatsSpec :: Spec +addGoalieStatsSpec = describe "addGoalieStats" $ let + g1 = GoalieStats + { _gsGames = 1 + , _gsMinsPlayed = 2 + , _gsGoalsAllowed = 3 + , _gsShutouts = 4 + , _gsWins = 5 + , _gsLosses = 6 + , _gsTies = 7 + } + + g2 = GoalieStats + { _gsGames = 8 + , _gsMinsPlayed = 9 + , _gsGoalsAllowed = 10 + , _gsShutouts = 11 + , _gsWins = 12 + , _gsLosses = 13 + , _gsTies = 14 + } + + expected = GoalieStats + { _gsGames = 9 + , _gsMinsPlayed = 11 + , _gsGoalsAllowed = 13 + , _gsShutouts = 15 + , _gsWins = 17 + , _gsLosses = 19 + , _gsTies = 21 + } + + actual = g1 `addGoalieStats` g2 + + in it ("should be " ++ show expected) $ + actual `shouldBe` expected + +gsAverageSpec :: Spec +gsAverageSpec = describe "gsAverage" $ let + gs = newGoalieStats + & gsGames .~ 2 + & gsGoalsAllowed .~ 3 + + expected = 3 % 2 + + in it ("should be " ++ show expected) $ + gsAverage gs `shouldBe` expected + joe :: Player joe = newPlayer 2 "Joe" "center" @@ -793,7 +865,7 @@ makeGoalieStats = GoalieStats <*> makeNum <*> makeNum <*> makeNum - + <*> makeNum makeNum :: IO Int makeNum = randomRIO (1, 10)