Jonathan Lamothe
GitHub
commit
4e25db12f1
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
|
||||
-}
|
||||
|
||||
{-# 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 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]
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
]
|
||||
|
|
|
|||
|
|
@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user