Merge pull request #40 from mtlstats/goalie-stats

Goalie stats
This commit is contained in:
Jonathan Lamothe 2019-11-28 12:00:25 -05:00 committed by GitHub
commit 4e25db12f1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 547 additions and 230 deletions

View File

@ -28,6 +28,7 @@ module Mtlstats.Actions.NewGame
, awardAssist , awardAssist
, resetGoalData , resetGoalData
, assignPMins , assignPMins
, awardShutouts
) where ) where
import qualified Data.Map as M import qualified Data.Map as M
@ -171,3 +172,20 @@ assignPMins mins s = fromMaybe s $ do
(psPMin +~ mins) (psPMin +~ mins)
) )
. (gameSelectedPlayer .~ Nothing) . (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)

View File

@ -43,7 +43,7 @@ dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of dispatch s = case s^.progMode of
MainMenu -> mainMenuC MainMenu -> mainMenuC
NewSeason -> newSeasonC NewSeason -> newSeasonC
NewGame _ -> newGameC s NewGame gs -> newGameC gs
CreatePlayer cps CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC | null $ cps^.cpsName -> getPlayerNameC

View File

@ -39,95 +39,43 @@ import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
-- | Dispatcher for a new game -- | Dispatcher for a new game
newGameC :: ProgState -> Controller newGameC :: GameState -> Controller
newGameC s = let newGameC gs
gs = s^.progMode.gameStateL | null $ gs^.gameYear = gameYearC
in if null $ gs^.gameYear then gameYearC | null $ gs^.gameMonth = gameMonthC
else if null $ gs^.gameMonth then gameMonthC | null $ gs^.gameDay = gameDayC
else if null $ gs^.gameDay then gameDayC | null $ gs^.gameType = gameTypeC
else if null $ gs^.gameType then gameTypeC | null $ gs^.otherTeam = otherTeamC
else if null $ gs^.otherTeam then otherTeamC | null $ gs^.homeScore = homeScoreC
else if null $ gs^.homeScore then homeScoreC | null $ gs^.awayScore = awayScoreC
else if null $ gs^.awayScore then awayScoreC | null $ gs^.overtimeFlag = overtimeFlagC
else if null $ gs^.overtimeFlag then overtimeFlagC | not $ gs^.dataVerified = verifyDataC
else if not $ gs^.dataVerified then verifyDataC | fromJust (unaccountedPoints gs) = goalInput gs
else if fromJust (unaccountedPoints gs) then goalInput gs | isJust $ gs^.gameSelectedPlayer = getPMinsC
else if isJust $ gs^.gameSelectedPlayer then getPMinsC | not $ gs^.gamePMinsRecorded = pMinPlayerC
else if not $ gs^.gamePMinsRecorded then pMinPlayerC | not $ gs^.gameGoalieAssigned = goalieInputC gs
else if not $ gs^.gameGoalieAssigned then goalieInputC s | otherwise = reportC
else reportC
gameYearC :: Controller gameYearC :: Controller
gameYearC = Controller gameYearC = promptControllerWith header gameYearPrompt
{ drawController = \s -> do
header s
drawPrompt gameYearPrompt s
, handleController = \e -> do
promptHandler gameYearPrompt e
return True
}
gameMonthC :: Controller gameMonthC :: Controller
gameMonthC = Controller gameMonthC = menuControllerWith header gameMonthMenu
{ drawController = \s -> do
header s
drawMenu gameMonthMenu
, handleController = \e -> do
menuHandler gameMonthMenu e
return True
}
gameDayC :: Controller gameDayC :: Controller
gameDayC = Controller gameDayC = promptControllerWith header gameDayPrompt
{ drawController = \s -> do
header s
drawPrompt gameDayPrompt s
, handleController = \e -> do
promptHandler gameDayPrompt e
modify validateGameDate
return True
}
gameTypeC :: Controller gameTypeC :: Controller
gameTypeC = Controller gameTypeC = menuControllerWith header gameTypeMenu
{ drawController = \s -> do
header s
drawMenu gameTypeMenu
, handleController = \e -> do
menuHandler gameTypeMenu e
return True
}
otherTeamC :: Controller otherTeamC :: Controller
otherTeamC = Controller otherTeamC = promptControllerWith header otherTeamPrompt
{ drawController = \s -> do
header s
drawPrompt otherTeamPrompt s
, handleController = \e -> do
promptHandler otherTeamPrompt e
return True
}
homeScoreC :: Controller homeScoreC :: Controller
homeScoreC = Controller homeScoreC = promptControllerWith header homeScorePrompt
{ drawController = \s -> do
header s
drawPrompt homeScorePrompt s
, handleController = \e -> do
promptHandler homeScorePrompt e
return True
}
awayScoreC :: Controller awayScoreC :: Controller
awayScoreC = Controller awayScoreC = promptControllerWith header awayScorePrompt
{ drawController = \s -> do
header s
drawPrompt awayScorePrompt s
, handleController = \e -> do
promptHandler awayScorePrompt e
modify overtimeCheck
return True
}
overtimeFlagC :: Controller overtimeFlagC :: Controller
overtimeFlagC = Controller overtimeFlagC = Controller
@ -146,19 +94,22 @@ verifyDataC = Controller
let gs = s^.progMode.gameStateL let gs = s^.progMode.gameStateL
header s header s
C.drawString "\n" C.drawString "\n"
C.drawString $ " Date: " ++ gameDate gs ++ "\n" C.drawString $ unlines $ labelTable
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n" [ ( "Date", gameDate gs )
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n" , ( "Game type", show $ fromJust $ gs^.gameType )
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n" , ( "Other team", gs^.otherTeam )
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n" , ( "Home score", show $ fromJust $ gs^.homeScore )
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n" , ( "Away score", show $ fromJust $ gs^.awayScore )
C.drawString "Is the above information correct? (Y/N)" , ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
]
C.drawString "\nIs the above information correct? (Y/N)"
return C.CursorInvisible return C.CursorInvisible
, handleController = \e -> do , handleController = \e -> do
case ynHandler e of case ynHandler e of
Just True -> do Just True -> modify
modify $ progMode.gameStateL.dataVerified .~ True $ (progMode.gameStateL.dataVerified .~ True)
modify updateGameStats . updateGameStats
. awardShutouts
Just False -> modify $ progMode.gameStateL .~ newGameState Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return () Nothing -> return ()
return True return True

View File

@ -33,16 +33,12 @@ import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
-- | The dispatcher for handling goalie input -- | The dispatcher for handling goalie input
goalieInputC :: ProgState -> Controller goalieInputC :: GameState -> Controller
goalieInputC s = let goalieInputC gs
gs = s^.progMode.gameStateL | gs^.gameGoaliesRecorded = selectGameGoalieC
in if gs^.gameGoaliesRecorded | null $ gs^.gameSelectedGoalie = selectGoalieC
then selectGameGoalieC s | null $ gs^.gameGoalieMinsPlayed = minsPlayedC
else if null $ gs^.gameSelectedGoalie | otherwise = goalsAllowedC
then selectGoalieC
else if null $ gs^.gameGoalieMinsPlayed
then minsPlayedC
else goalsAllowedC
selectGoalieC :: Controller selectGoalieC :: Controller
selectGoalieC = promptController selectGameGoaliePrompt selectGoalieC = promptController selectGameGoaliePrompt
@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
goalsAllowedC :: Controller goalsAllowedC :: Controller
goalsAllowedC = promptControllerWith header goalsAllowedPrompt goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: ProgState -> Controller selectGameGoalieC :: Controller
selectGameGoalieC = menuController . gameGoalieMenu selectGameGoalieC = menuStateController gameGoalieMenu
header :: ProgState -> C.Update () header :: ProgState -> C.Update ()
header s = C.drawString $ unlines header s = C.drawString $ unlines

View File

@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Format module Mtlstats.Format
( padNum ( padNum
, left , left
@ -29,10 +31,15 @@ module Mtlstats.Format
, labelTable , labelTable
, numTable , numTable
, tableWith , tableWith
, complexTable
, overlayLast
, showFloating
) where ) where
import Data.List (transpose) import Data.List (transpose)
import Mtlstats.Types
-- | Pad an 'Int' with leading zeroes to fit a certain character width -- | Pad an 'Int' with leading zeroes to fit a certain character width
padNum padNum
:: Int :: Int
@ -138,12 +145,52 @@ tableWith
-> [[String]] -> [[String]]
-- ^ The cells -- ^ The cells
-> [String] -> [String]
tableWith func tdata = let tableWith pFunc tData = complexTable
widths = map (map length) tdata (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 colWidths = map maximum $ transpose widths
fitted = map
(\row -> map bFunc = \case
(\(str, len) -> func len str) $ [] -> ""
zip row colWidths) [(f, len, CellText str)] -> f len str
tdata [(_, len, CellFill ch)] -> replicate len ch
in map unwords fitted (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

View File

@ -23,6 +23,7 @@ module Mtlstats.Menu (
-- * Menu Functions -- * Menu Functions
menuController, menuController,
menuControllerWith, menuControllerWith,
menuStateController,
drawMenu, drawMenu,
menuHandler, menuHandler,
-- * Menus -- * Menus
@ -76,6 +77,21 @@ menuControllerWith header menu = Controller
return True 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' -- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode drawMenu :: Menu a -> C.Update C.CursorMode
drawMenu m = do drawMenu m = do

View File

@ -65,8 +65,9 @@ homeScorePrompt = numPrompt "Home score: " $
-- | Prompts for the away score -- | Prompts for the away score
awayScorePrompt :: Prompt awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $ awayScorePrompt = numPrompt "Away score: " $ \score -> modify
modify . (progMode.gameStateL.awayScore ?~) $ overtimeCheck
. (progMode.gameStateL.awayScore ?~ score)
-- | Prompts for the player who scored the goal -- | Prompts for the player who scored the goal
recordGoalPrompt recordGoalPrompt

View File

@ -19,10 +19,10 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Report (report, gameDate, playerNameColWidth) where module Mtlstats.Report (report, gameDate) where
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Mtlstats.Config import Mtlstats.Config
@ -60,54 +60,104 @@ standingsReport width s = fromMaybe [] $ do
tStats = addGameStats hStats aStats tStats = addGameStats hStats aStats
hScore <- gs^.homeScore hScore <- gs^.homeScore
aScore <- gs^.awayScore aScore <- gs^.awayScore
Just let
[ overlay rHeader =
("GAME NUMBER " ++ padNum 2 gNum) [ overlay
(centre width ("GAME NUMBER " ++ padNum 2 gNum)
$ aTeam ++ " " ++ show aScore ++ " AT " (centre width
++ hTeam ++ " " ++ show hScore) $ aTeam ++ " " ++ show aScore ++ " AT "
, date ++ hTeam ++ " " ++ show hScore)
, centre width "STANDINGS" , date
, "" , centre width "STANDINGS"
, centre width , ""
$ left 11 myTeam ]
++ right 2 "G"
++ right 4 "W" tHeader =
++ right 4 "L" [ CellText myTeam
++ right 4 "OT" , CellText " G"
++ right 4 "GF" , CellText " W"
++ right 4 "GA" , CellText " L"
++ right 4 "P" , CellText " OT"
, centre width , CellText " GF"
$ left 11 "HOME" , CellText " GA"
++ showStats hStats , CellText " P"
, centre width ]
$ left 11 "ROAD"
++ showStats aStats rowCells stats =
, centre width [ CellText $ show $ gmsGames stats
$ replicate 11 ' ' , CellText $ show $ stats^.gmsWins
++ replicate (2 + 4 * 6) '-' , CellText $ show $ stats^.gmsLosses
, centre width , CellText $ show $ stats^.gmsOvertime
$ left 11 "TOTALS" , CellText $ show $ stats^.gmsGoalsFor
++ showStats tStats , 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 :: Int -> ProgState -> [String]
gameStatsReport width s = playerReport width "GAME" $ gameStatsReport width s = let
fromMaybe [] $ mapM gs = s^.progMode.gameStateL
db = s^.database
playerStats = mapMaybe
(\(pid, stats) -> do (\(pid, stats) -> do
p <- nth pid $ s^.database.dbPlayers p <- nth pid $ db^.dbPlayers
Just (p, stats)) 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 :: Int -> ProgState -> [String]
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $ yearToDateStatsReport width s = let
map (\p -> (p, p^.pYtd)) $ db = s^.database
filter playerIsActive $ s^.database.dbPlayers
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 :: Int -> ProgState -> [String]
lifetimeStatsReport width s = playerReport width "LIFETIME" $ lifetimeStatsReport width s = let
map (\p -> (p, p^.pLifetime)) $ s^.database.dbPlayers 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 :: GameState -> String
gameDate gs = fromMaybe "" $ do gameDate gs = fromMaybe "" $ do
@ -118,53 +168,89 @@ gameDate gs = fromMaybe "" $ do
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String] playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
playerReport width label ps = let playerReport width label ps = let
nameWidth = playerNameColWidth $ map fst ps tStats = foldl addPlayerStats newPlayerStats $ map snd ps
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
in rHeader =
[ centre width (label ++ " STATISTICS") [ 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 tHeader =
playerNameColWidth = foldr [ CellText "NO."
(\player current -> max current $ succ $ length $ player^.pName) , CellText "Player"
10 , CellText " G"
, CellText " A"
, CellText " P"
, CellText " PM"
]
showStats :: GameStats -> String statsCells stats =
showStats gs [ CellText $ show $ stats^.psGoals
= right 2 (show $ gmsGames gs) , CellText $ show $ stats^.psAssists
++ right 4 (show $ gs^.gmsWins) , CellText $ show $ psPoints stats
++ right 4 (show $ gs^.gmsLosses) , CellText $ show $ stats^.psPMin
++ right 4 (show $ gs^.gmsOvertime) ]
++ right 4 (show $ gs^.gmsGoalsFor)
++ right 4 (show $ gs^.gmsGoalsAgainst) body = map
++ right 4 (show $ gmsPoints gs) (\(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]

View File

@ -43,6 +43,7 @@ module Mtlstats.Types (
GameStats (..), GameStats (..),
Prompt (..), Prompt (..),
SelectParams (..), SelectParams (..),
TableCell (..),
-- * Lenses -- * Lenses
-- ** ProgState Lenses -- ** ProgState Lenses
database, database,
@ -120,6 +121,7 @@ module Mtlstats.Types (
gsGames, gsGames,
gsMinsPlayed, gsMinsPlayed,
gsGoalsAllowed, gsGoalsAllowed,
gsShutouts,
gsWins, gsWins,
gsLosses, gsLosses,
gsTies, gsTies,
@ -168,7 +170,11 @@ module Mtlstats.Types (
-- ** Goalie Helpers -- ** Goalie Helpers
goalieSearch, goalieSearch,
goalieSearchExact, goalieSearchExact,
goalieSummary goalieSummary,
goalieIsActive,
-- ** GoalieStats Helpers
addGoalieStats,
gsAverage
) where ) where
import Control.Monad.Trans.State (StateT) import Control.Monad.Trans.State (StateT)
@ -182,6 +188,8 @@ import Data.Aeson
, toJSON , toJSON
, withObject , withObject
, (.:) , (.:)
, (.:?)
, (.!=)
, (.=) , (.=)
) )
import Data.List (isInfixOf) import Data.List (isInfixOf)
@ -513,6 +521,8 @@ data GoalieStats = GoalieStats
-- ^ The number of minutes played -- ^ The number of minutes played
, _gsGoalsAllowed :: Int , _gsGoalsAllowed :: Int
-- ^ The number of goals allowed -- ^ The number of goals allowed
, _gsShutouts :: Int
-- ^ The number of shutouts the goalie has accumulated
, _gsWins :: Int , _gsWins :: Int
-- ^ The number of wins -- ^ The number of wins
, _gsLosses :: Int , _gsLosses :: Int
@ -523,26 +533,29 @@ data GoalieStats = GoalieStats
instance FromJSON GoalieStats where instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .: "games" <$> v .:? "games" .!= 0
<*> v .: "mins_played" <*> v .:? "mins_played" .!= 0
<*> v .: "goals_allowed" <*> v .:? "goals_allowed" .!= 0
<*> v .: "wins" <*> v .:? "shutouts" .!= 0
<*> v .: "losses" <*> v .:? "wins" .!= 0
<*> v .: "ties" <*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where 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 [ "games" .= g
, "mins_played" .= m , "mins_played" .= m
, "goals_allowed" .= a , "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w , "wins" .= w
, "losses" .= l , "losses" .= l
, "ties" .= t , "ties" .= t
] ]
toEncoding (GoalieStats g m a w l t) = pairs $ toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <> "games" .= g <>
"mins_played" .= m <> "mins_played" .= m <>
"goals_allowed" .= a <> "goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <> "wins" .= w <>
"losses" .= l <> "losses" .= l <>
"ties" .= t "ties" .= t
@ -614,6 +627,14 @@ data SelectParams a = SelectParams
-- ^ The function to call when the selection doesn't exist -- ^ 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 ''ProgState
makeLenses ''GameState makeLenses ''GameState
makeLenses ''CreatePlayerState makeLenses ''CreatePlayerState
@ -786,6 +807,7 @@ newGoalieStats = GoalieStats
{ _gsGames = 0 { _gsGames = 0
, _gsMinsPlayed = 0 , _gsMinsPlayed = 0
, _gsGoalsAllowed = 0 , _gsGoalsAllowed = 0
, _gsShutouts = 0
, _gsWins = 0 , _gsWins = 0
, _gsLosses = 0 , _gsLosses = 0
, _gsTies = 0 , _gsTies = 0
@ -966,3 +988,24 @@ goalieSearchExact sStr goalies = let
-- | Provides a description string for a 'Goalie' -- | Provides a description string for a 'Goalie'
goalieSummary :: Goalie -> String goalieSummary :: Goalie -> String
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")" 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)

View File

@ -44,6 +44,7 @@ spec = describe "NewGame" $ do
awardAssistSpec awardAssistSpec
resetGoalDataSpec resetGoalDataSpec
assignPMinsSpec assignPMinsSpec
awardShutoutsSpec
GoalieInput.spec GoalieInput.spec
overtimeCheckSpec :: Spec overtimeCheckSpec :: Spec
@ -481,3 +482,45 @@ assignPMinsSpec = describe "assignPMins" $ let
, ( Just 2, 4, 3, 2, 6, 5, 0 ) , ( Just 2, 4, 3, 2, 6, 5, 0 )
, ( Nothing, 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 )
]

View File

@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module FormatSpec (spec) where module FormatSpec (spec) where
import Data.Ratio ((%))
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Types
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Format" $ do spec = describe "Mtlstats.Format" $ do
@ -36,6 +38,9 @@ spec = describe "Mtlstats.Format" $ do
labelTableSpec labelTableSpec
numTableSpec numTableSpec
tableWithSpec tableWithSpec
complexTableSpec
overlayLastSpec
showFloatingSpec
padNumSpec :: Spec padNumSpec :: Spec
padNumSpec = describe "padNum" $ do 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

View File

@ -28,9 +28,8 @@ import Mtlstats.Report
import Mtlstats.Types import Mtlstats.Types
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Report" $ do spec = describe "Mtlstats.Report"
gameDateSpec gameDateSpec
playerNameColWidthSpec
gameDateSpec :: Spec gameDateSpec :: Spec
gameDateSpec = describe "gameDate" $ do gameDateSpec = describe "gameDate" $ do
@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
context "invalid date" $ context "invalid date" $
it "should return an empty string" $ it "should return an empty string" $
gameDate newGameState `shouldBe` "" 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 )
]

View File

@ -34,6 +34,7 @@ import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON) import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object)) import Data.Aeson.Types (Value (Object))
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~)) import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomRIO) import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
@ -78,6 +79,9 @@ spec = describe "Mtlstats.Types" $ do
goalieSearchSpec goalieSearchSpec
goalieSearchExactSpec goalieSearchExactSpec
goalieSummarySpec goalieSummarySpec
goalieIsActiveSpec
addGoalieStatsSpec
gsAverageSpec
Menu.spec Menu.spec
playerSpec :: Spec playerSpec :: Spec
@ -310,18 +314,20 @@ goalieStats n = newGoalieStats
& gsGames .~ n & gsGames .~ n
& gsMinsPlayed .~ n + 1 & gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2 & gsGoalsAllowed .~ n + 2
& gsWins .~ n + 3 & gsShutouts .~ n + 3
& gsLosses .~ n + 4 & gsWins .~ n + 4
& gsTies .~ n + 5 & gsLosses .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n ) [ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 ) , ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 ) , ( "goals_allowed", toJSON $ n + 2 )
, ( "wins", toJSON $ n + 3 ) , ( "shutouts", toJSON $ n + 3 )
, ( "losses", toJSON $ n + 4 ) , ( "wins", toJSON $ n + 4 )
, ( "ties", toJSON $ n + 5 ) , ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
] ]
gameStats :: Int -> GameStats gameStats :: Int -> GameStats
@ -751,6 +757,72 @@ goalieSummarySpec = describe "goalieSummary" $
it "should provide a summary string" $ it "should provide a summary string" $
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)" 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 :: Player
joe = newPlayer 2 "Joe" "center" joe = newPlayer 2 "Joe" "center"
@ -793,7 +865,7 @@ makeGoalieStats = GoalieStats
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum
makeNum :: IO Int makeNum :: IO Int
makeNum = randomRIO (1, 10) makeNum = randomRIO (1, 10)