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)