commit
4e25db12f1
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 )
|
||||||
|
]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 )
|
|
||||||
]
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user