Compare commits
107 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
dd6f604cd7 | ||
|
|
1763f142f1 | ||
|
|
b442b6a360 | ||
|
|
119c28ef18 | ||
|
|
b69b3fce7a | ||
|
|
59026de077 | ||
|
|
52f1e34d49 | ||
|
|
2c561e9807 | ||
|
|
e2aeb5bfa4 | ||
|
|
5b40a5942b | ||
|
|
ee3cea5643 | ||
|
|
5209c4a296 | ||
|
|
e077c32956 | ||
|
|
8dcef502be | ||
|
|
3ee97406f1 | ||
|
|
2768934c7c | ||
|
|
6c8ec21ffe | ||
|
|
ba3f8a5a6c | ||
|
|
3a71dc1e62 | ||
|
|
d14f2ba527 | ||
|
|
acd45229e7 | ||
|
|
aff1d5c255 | ||
|
|
0448a4beee | ||
|
|
ddb9394ab7 | ||
|
|
071aa3bd8e | ||
|
|
ac95601609 | ||
|
|
9606436e9e | ||
|
|
30807b7e2e | ||
|
|
34b743a55b | ||
|
|
63bd9a6de4 | ||
|
|
1f3ff5912c | ||
|
|
7bb0981ed6 | ||
|
|
eb4107365c | ||
|
|
6238e39f69 | ||
|
|
1adf6de990 | ||
|
|
2840298467 | ||
|
|
89fe646d0e | ||
|
|
b35136944c | ||
|
|
4d41c454a1 | ||
|
|
18ba758c0c | ||
|
|
3aedd01b08 | ||
|
|
235dd4e611 | ||
|
|
adf09c2cc4 | ||
|
|
a44ecc5e24 | ||
|
|
9980a095ed | ||
|
|
1d6a4aa7f3 | ||
|
|
8988ad9146 | ||
|
|
59d48ec154 | ||
|
|
be990538bc | ||
|
|
55c8806186 | ||
|
|
0ecf899b56 | ||
|
|
2f06fd221d | ||
|
|
f1227da9ca | ||
|
|
38db3c8d8f | ||
|
|
2b9a21c28b | ||
|
|
84c487dba5 | ||
|
|
6345e3d5d8 | ||
|
|
0ca03b7f21 | ||
|
|
482f42dca7 | ||
|
|
996bad94f1 | ||
|
|
4ca0b54de2 | ||
|
|
3738088dde | ||
|
|
1ec9e93f16 | ||
|
|
9534218797 | ||
|
|
d7d3d1a4fd | ||
|
|
86c4fe316e | ||
|
|
d5ac42268f | ||
|
|
df26e9d265 | ||
|
|
cb5f2d7d15 | ||
|
|
152ea76bda | ||
|
|
36ab31a17c | ||
|
|
768cb47fac | ||
|
|
427ad12603 | ||
|
|
1ca2ffc378 | ||
|
|
9e6b71c464 | ||
|
|
2f4e963e41 | ||
|
|
05af939963 | ||
|
|
8af7974c8f | ||
|
|
f7cfd5d835 | ||
|
|
cc495fa589 | ||
|
|
9c5d166f31 | ||
|
|
a9e12d11a9 | ||
|
|
08be4154b3 | ||
|
|
4e25db12f1 | ||
|
|
50389b4f4c | ||
|
|
dcbb809ae1 | ||
|
|
be54198960 | ||
|
|
e3d5af5f88 | ||
|
|
de67628df0 | ||
|
|
4848e54d81 | ||
|
|
3b6f77ba21 | ||
|
|
e7606c8a5e | ||
|
|
3560aa7595 | ||
|
|
5979856578 | ||
|
|
4941e0e64f | ||
|
|
eedeaed8fc | ||
|
|
d0f237e707 | ||
|
|
8795cb46a9 | ||
|
|
f1f7077c8c | ||
|
|
a407a01339 | ||
|
|
3e1218f6ff | ||
|
|
7ff16b8ac2 | ||
|
|
d7879a92af | ||
|
|
9b9feefa4f | ||
|
|
26a90a5ed9 | ||
|
|
e8b850c23a | ||
|
|
0efac07a33 |
27
ChangeLog.md
27
ChangeLog.md
@@ -1,5 +1,32 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## 0.10.0
|
||||
- Don't show player number zero in reports
|
||||
- Fixed player/goalie name capitalisation on edit
|
||||
- Return to correct edit menus after editing player stats
|
||||
- Enabled batch editing of player/goalie YTD/lifetime stats
|
||||
- Bugfix: allow user to edit goalie shutouts
|
||||
- Added line numbers to lifetime player/goalie reports
|
||||
- Implemented rookie flag
|
||||
|
||||
## 0.9.0
|
||||
- Bugfix: Display lifetime stats in report, not YTD
|
||||
- Force expected capitalization on player/goalie names
|
||||
- Don't show lifetime totals in report
|
||||
- Sort players in YTD and lifetime reports by points
|
||||
- Moved player/goalie creation/editing to edit submenu
|
||||
|
||||
## 0.8.0
|
||||
- Bugfix: removed quotation marks from goalie names in report
|
||||
- Allow lower case player names
|
||||
- Don't show players without points in game report
|
||||
- Removed unnecessary goalie statistics from game report
|
||||
- Fixed goalie average calculation
|
||||
|
||||
## 0.7.0
|
||||
- Shortened views to fit within 25 lines
|
||||
- Implemented goalie reports
|
||||
|
||||
## 0.6.0
|
||||
- Generate lifetime statistics report
|
||||
- Implemented goalie editing
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
name: mtlstats
|
||||
version: 0.6.0
|
||||
version: 0.10.0
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
author: "Jonathan Lamothe"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -30,8 +30,11 @@ module Mtlstats.Actions
|
||||
, removeChar
|
||||
, createPlayer
|
||||
, createGoalie
|
||||
, edit
|
||||
, editPlayer
|
||||
, editSelectedPlayer
|
||||
, editGoalie
|
||||
, editSelectedGoalie
|
||||
, addPlayer
|
||||
, addGoalie
|
||||
, resetCreatePlayerState
|
||||
@@ -46,6 +49,7 @@ import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Starts a new season
|
||||
startNewSeason :: ProgState -> ProgState
|
||||
@@ -82,7 +86,7 @@ removeChar = inputBuffer %~ \case
|
||||
-- | Starts player creation mode
|
||||
createPlayer :: ProgState -> ProgState
|
||||
createPlayer = let
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
callback = modify edit
|
||||
cps = newCreatePlayerState
|
||||
& cpsSuccessCallback .~ callback
|
||||
& cpsFailureCallback .~ callback
|
||||
@@ -91,20 +95,50 @@ createPlayer = let
|
||||
-- | Starts goalie creation mode
|
||||
createGoalie :: ProgState -> ProgState
|
||||
createGoalie = let
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
callback = modify edit
|
||||
cgs = newCreateGoalieState
|
||||
& cgsSuccessCallback .~ callback
|
||||
& cgsFailureCallback .~ callback
|
||||
in progMode .~ CreateGoalie cgs
|
||||
|
||||
-- | Launches the edit menu
|
||||
edit :: ProgState -> ProgState
|
||||
edit = progMode .~ EditMenu
|
||||
|
||||
-- | Starts the player editing process
|
||||
editPlayer :: ProgState -> ProgState
|
||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||
|
||||
-- | Edits the selected 'Player'
|
||||
editSelectedPlayer
|
||||
:: (Player -> Player)
|
||||
-- ^ The modification to be made to the 'Player'
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editSelectedPlayer f s = fromMaybe s $ do
|
||||
n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
let
|
||||
players = s^.database.dbPlayers
|
||||
players' = modifyNth n f players
|
||||
Just $ s & database.dbPlayers .~ players'
|
||||
|
||||
-- | Starts the 'Goalie' editing process
|
||||
editGoalie :: ProgState -> ProgState
|
||||
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||
|
||||
-- | Edits the selected 'Goalie'
|
||||
editSelectedGoalie
|
||||
:: (Goalie -> Goalie)
|
||||
-- ^ The modification to be made to the 'Goalie'
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editSelectedGoalie f s = fromMaybe s $ do
|
||||
n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
let
|
||||
goalies = s^.database.dbGoalies
|
||||
goalies' = modifyNth n f goalies
|
||||
Just $ s & database.dbGoalies .~ goalies'
|
||||
|
||||
-- | Adds the entered player to the roster
|
||||
addPlayer :: ProgState -> ProgState
|
||||
addPlayer s = fromMaybe s $ do
|
||||
|
||||
@@ -1,164 +0,0 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.EditGoalie
|
||||
( editGoalieNumber
|
||||
, editGoalieName
|
||||
, editGoalieYtdGames
|
||||
, editGoalieYtdMins
|
||||
, editGoalieYtdGoals
|
||||
, editGoalieYtdWins
|
||||
, editGoalieYtdLosses
|
||||
, editGoalieYtdTies
|
||||
, editGoalieLtGames
|
||||
, editGoalieLtMins
|
||||
, editGoalieLtGoals
|
||||
, editGoalieLtWins
|
||||
, editGoalieLtLosses
|
||||
, editGoalieLtTies
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Edits a goalie's number
|
||||
editGoalieNumber
|
||||
:: Int
|
||||
-- ^ New goalie number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
|
||||
|
||||
-- | Edits a goalie's name
|
||||
editGoalieName
|
||||
:: String
|
||||
-- ^ The new name
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieName name = editGoalie (gName .~ name) EGMenu
|
||||
|
||||
-- | Edits a goalie's YTD games
|
||||
editGoalieYtdGames
|
||||
:: Int
|
||||
-- ^ The number of games played
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD minutes
|
||||
editGoalieYtdMins
|
||||
:: Int
|
||||
-- ^ The number of minutes played
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD goals allowed
|
||||
editGoalieYtdGoals
|
||||
:: Int
|
||||
-- ^ The number of goals
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD wins
|
||||
editGoalieYtdWins
|
||||
:: Int
|
||||
-- ^ The number of wins
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD losses
|
||||
editGoalieYtdLosses
|
||||
:: Int
|
||||
-- ^ The number of losses
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD ties
|
||||
editGoalieYtdTies
|
||||
:: Int
|
||||
-- ^ The number of ties
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
|
||||
|
||||
-- | Edits a goalie's lifetime games played
|
||||
editGoalieLtGames
|
||||
:: Int
|
||||
-- ^ The number of games
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime minutes played
|
||||
editGoalieLtMins
|
||||
:: Int
|
||||
-- ^ The number of minutes
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime goals allowed
|
||||
editGoalieLtGoals
|
||||
:: Int
|
||||
-- ^ The number of goals
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime wins
|
||||
editGoalieLtWins
|
||||
:: Int
|
||||
-- ^ The number of wins
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime losses
|
||||
editGoalieLtLosses
|
||||
:: Int
|
||||
-- ^ The number of losses
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime ties
|
||||
editGoalieLtTies
|
||||
:: Int
|
||||
-- ^ The number of ties
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
|
||||
|
||||
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
|
||||
editGoalie f mode s = fromMaybe s $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
void $ nth gid $ s^.database.dbGoalies
|
||||
Just $ s
|
||||
& database.dbGoalies %~ modifyNth gid f
|
||||
& progMode.editGoalieStateL.egsMode .~ mode
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -41,9 +41,10 @@ import Mtlstats.Types
|
||||
-- run
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
NewGame _ -> newGameC s
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
NewGame gs -> newGameC gs
|
||||
EditMenu -> editMenuC
|
||||
CreatePlayer cps
|
||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||
| null $ cps^.cpsName -> getPlayerNameC
|
||||
@@ -70,6 +71,9 @@ newSeasonC = Controller
|
||||
return True
|
||||
}
|
||||
|
||||
editMenuC :: Controller
|
||||
editMenuC = menuController editMenu
|
||||
|
||||
getPlayerNumC :: Controller
|
||||
getPlayerNumC = Controller
|
||||
{ drawController = drawPrompt playerNumPrompt
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -27,6 +27,7 @@ import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import UI.NCurses as C
|
||||
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditGoalie
|
||||
import Mtlstats.Prompt
|
||||
@@ -45,23 +46,25 @@ selectC = promptController goalieToEditPrompt
|
||||
|
||||
editC :: EditGoalieMode -> Controller
|
||||
editC = \case
|
||||
EGMenu -> menuC
|
||||
EGNumber -> numberC
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGYtdGames -> ytdGamesC
|
||||
EGYtdMins -> ytdMinsC
|
||||
EGYtdGoals -> ytdGoalsC
|
||||
EGYtdWins -> ytdWinsC
|
||||
EGYtdLosses -> ytdLossesC
|
||||
EGYtdTies -> ytdTiesC
|
||||
EGLtGames -> ltGamesC
|
||||
EGLtMins -> ltMinsC
|
||||
EGLtGoals -> ltGoalsC
|
||||
EGLtWins -> ltWinsC
|
||||
EGLtLosses -> ltLossesC
|
||||
EGLtTies -> ltTiesC
|
||||
EGMenu -> menuC
|
||||
EGNumber -> numberC
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGYtdGames b -> ytdGamesC b
|
||||
EGYtdMins b -> ytdMinsC b
|
||||
EGYtdGoals b -> ytdGoalsC b
|
||||
EGYtdShutouts b -> ytdShutoutsC b
|
||||
EGYtdWins b -> ytdWinsC b
|
||||
EGYtdLosses b -> ytdLossesC b
|
||||
EGYtdTies -> ytdTiesC
|
||||
EGLtGames b -> ltGamesC b
|
||||
EGLtMins b -> ltMinsC b
|
||||
EGLtGoals b -> ltGoalsC b
|
||||
EGLtShutouts b -> ltShutoutsC b
|
||||
EGLtWins b -> ltWinsC b
|
||||
EGLtLosses b -> ltLossesC b
|
||||
EGLtTies -> ltTiesC
|
||||
|
||||
menuC :: Controller
|
||||
menuC = menuControllerWith header editGoalieMenu
|
||||
@@ -78,38 +81,44 @@ ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
||||
lifetimeMenuC :: Controller
|
||||
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
||||
|
||||
ytdGamesC :: Controller
|
||||
ytdGamesC = promptController editGoalieYtdGamesPrompt
|
||||
ytdGamesC :: Bool -> Controller
|
||||
ytdGamesC = promptController . editGoalieYtdGamesPrompt
|
||||
|
||||
ytdMinsC :: Controller
|
||||
ytdMinsC = promptController editGoalieYtdMinsPrompt
|
||||
ytdMinsC :: Bool -> Controller
|
||||
ytdMinsC = promptController . editGoalieYtdMinsPrompt
|
||||
|
||||
ytdGoalsC :: Controller
|
||||
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
|
||||
ytdGoalsC :: Bool -> Controller
|
||||
ytdGoalsC = promptController . editGoalieYtdGoalsPrompt
|
||||
|
||||
ytdWinsC :: Controller
|
||||
ytdWinsC = promptController editGoalieYtdWinsPrompt
|
||||
ytdShutoutsC :: Bool -> Controller
|
||||
ytdShutoutsC = promptController . editGoalieYtdShutoutsPrompt
|
||||
|
||||
ytdLossesC :: Controller
|
||||
ytdLossesC = promptController editGoalieYtdLossesPrompt
|
||||
ytdWinsC :: Bool -> Controller
|
||||
ytdWinsC = promptController . editGoalieYtdWinsPrompt
|
||||
|
||||
ytdLossesC :: Bool -> Controller
|
||||
ytdLossesC = promptController . editGoalieYtdLossesPrompt
|
||||
|
||||
ytdTiesC :: Controller
|
||||
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
||||
|
||||
ltGamesC :: Controller
|
||||
ltGamesC = promptController editGoalieLtGamesPrompt
|
||||
ltGamesC :: Bool -> Controller
|
||||
ltGamesC = promptController . editGoalieLtGamesPrompt
|
||||
|
||||
ltMinsC :: Controller
|
||||
ltMinsC = promptController editGoalieLtMinsPrompt
|
||||
ltMinsC :: Bool -> Controller
|
||||
ltMinsC = promptController . editGoalieLtMinsPrompt
|
||||
|
||||
ltGoalsC :: Controller
|
||||
ltGoalsC = promptController editGoalieLtGoalsPrompt
|
||||
ltGoalsC :: Bool -> Controller
|
||||
ltGoalsC = promptController . editGoalieLtGoalsPrompt
|
||||
|
||||
ltWinsC :: Controller
|
||||
ltWinsC = promptController editGoalieLtWinsPrompt
|
||||
ltShutoutsC :: Bool -> Controller
|
||||
ltShutoutsC = promptController . editGoalieLtShutoutsPrompt
|
||||
|
||||
ltLossesC :: Controller
|
||||
ltLossesC = promptController editGoalieLtLossesPrompt
|
||||
ltWinsC :: Bool -> Controller
|
||||
ltWinsC = promptController . editGoalieLtWinsPrompt
|
||||
|
||||
ltLossesC :: Bool -> Controller
|
||||
ltLossesC = promptController . editGoalieLtLossesPrompt
|
||||
|
||||
ltTiesC :: Controller
|
||||
ltTiesC = promptController editGoalieLtTiesPrompt
|
||||
@@ -118,20 +127,4 @@ header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
g <- nth gid $ s^.database.dbGoalies
|
||||
Just $ unlines
|
||||
[ " Goalie number: " ++ show (g^.gNumber)
|
||||
, " Goalie name: " ++ g^.gName
|
||||
, " YTD games played: " ++ show (g^.gYtd.gsGames)
|
||||
, " YTD mins played: " ++ show (g^.gYtd.gsMinsPlayed)
|
||||
, " YTD goals allowed: " ++ show (g^.gYtd.gsGoalsAllowed)
|
||||
, " YTD wins: " ++ show (g^.gYtd.gsWins)
|
||||
, " YTD losses: " ++ show (g^.gYtd.gsLosses)
|
||||
, " YTD ties: " ++ show (g^.gYtd.gsTies)
|
||||
, " Lifetime games played: " ++ show (g^.gLifetime.gsGames)
|
||||
, " Lifetime mins played: " ++ show (g^.gLifetime.gsMinsPlayed)
|
||||
, "Lifetime goals allowed: " ++ show (g^.gLifetime.gsGoalsAllowed)
|
||||
, " Lifetime wins: " ++ show (g^.gLifetime.gsWins)
|
||||
, " Lifetime losses: " ++ show (g^.gLifetime.gsLosses)
|
||||
, " Lifetime ties: " ++ show (g^.gLifetime.gsTies)
|
||||
, ""
|
||||
]
|
||||
Just $ goalieDetails g ++ "\n"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -25,7 +25,9 @@ import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditPlayer
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.EditPlayer
|
||||
import Mtlstats.Types
|
||||
@@ -36,108 +38,60 @@ editPlayerC :: EditPlayerState -> Controller
|
||||
editPlayerC eps
|
||||
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
||||
| otherwise = case eps^.epsMode of
|
||||
EPMenu -> menuC
|
||||
EPNumber -> numberC
|
||||
EPName -> nameC
|
||||
EPPosition -> positionC
|
||||
EPYtdGoals -> ytdGoalsC
|
||||
EPYtdAssists -> ytdAssistsC
|
||||
EPYtdPMin -> ytdPMinC
|
||||
EPLtGoals -> ltGoalsC
|
||||
EPLtAssists -> ltAssistsC
|
||||
EPLtPMin -> ltPMinC
|
||||
EPMenu -> menuC
|
||||
EPNumber -> numberC
|
||||
EPName -> nameC
|
||||
EPPosition -> positionC
|
||||
EPYtd -> ytdC
|
||||
EPLifetime -> lifetimeC
|
||||
EPYtdGoals b -> ytdGoalsC b
|
||||
EPYtdAssists b -> ytdAssistsC b
|
||||
EPYtdPMin -> ytdPMinC
|
||||
EPLtGoals b -> ltGoalsC b
|
||||
EPLtAssists b -> ltAssistsC b
|
||||
EPLtPMin -> ltPMinC
|
||||
|
||||
selectPlayerC :: Controller
|
||||
selectPlayerC = Controller
|
||||
{ drawController = drawPrompt playerToEditPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler playerToEditPrompt e
|
||||
return True
|
||||
}
|
||||
selectPlayerC = promptController playerToEditPrompt
|
||||
|
||||
menuC :: Controller
|
||||
menuC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
header = fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails p ++ "\n"
|
||||
C.drawString header
|
||||
drawMenu editPlayerMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler editPlayerMenu e
|
||||
return True
|
||||
}
|
||||
menuC = menuControllerWith header editPlayerMenu
|
||||
|
||||
numberC :: Controller
|
||||
numberC = Controller
|
||||
{ drawController = drawPrompt editPlayerNumPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNumPrompt e
|
||||
return True
|
||||
}
|
||||
numberC = promptController editPlayerNumPrompt
|
||||
|
||||
nameC :: Controller
|
||||
nameC = Controller
|
||||
{ drawController = drawPrompt editPlayerNamePrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNamePrompt e
|
||||
return True
|
||||
}
|
||||
nameC = promptController editPlayerNamePrompt
|
||||
|
||||
positionC :: Controller
|
||||
positionC = Controller
|
||||
{ drawController = drawPrompt editPlayerPosPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerPosPrompt e
|
||||
return True
|
||||
}
|
||||
positionC = promptController editPlayerPosPrompt
|
||||
|
||||
ytdGoalsC :: Controller
|
||||
ytdGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
ytdC :: Controller
|
||||
ytdC = menuControllerWith header editPlayerYtdMenu
|
||||
|
||||
ytdAssistsC :: Controller
|
||||
ytdAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
lifetimeC :: Controller
|
||||
lifetimeC = menuControllerWith header editPlayerLtMenu
|
||||
|
||||
ytdGoalsC :: Bool -> Controller
|
||||
ytdGoalsC = promptController . editPlayerYtdGoalsPrompt
|
||||
|
||||
ytdAssistsC :: Bool -> Controller
|
||||
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt
|
||||
|
||||
ytdPMinC :: Controller
|
||||
ytdPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdPMinPrompt e
|
||||
return True
|
||||
}
|
||||
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
||||
|
||||
ltGoalsC :: Controller
|
||||
ltGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
ltGoalsC :: Bool -> Controller
|
||||
ltGoalsC = promptController . editPlayerLtGoalsPrompt
|
||||
|
||||
ltAssistsC :: Controller
|
||||
ltAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
ltAssistsC :: Bool -> Controller
|
||||
ltAssistsC = promptController . editPlayerLtAssistsPrompt
|
||||
|
||||
ltPMinC :: Controller
|
||||
ltPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtPMinPrompt e
|
||||
return True
|
||||
}
|
||||
ltPMinC = promptController editPlayerLtPMinPrompt
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails player ++ "\n"
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,15 +19,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Format
|
||||
( padNum
|
||||
, left
|
||||
, right
|
||||
, centre
|
||||
, padRight
|
||||
, overlay
|
||||
, month
|
||||
, 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
|
||||
@@ -75,6 +88,16 @@ centre n str = let
|
||||
pad = replicate pLen ' '
|
||||
in take n $ pad ++ str ++ repeat ' '
|
||||
|
||||
-- | Pads text on the right with spaces to fit a minimum width
|
||||
padRight
|
||||
:: Int
|
||||
-- ^ The width to pad to
|
||||
-> String
|
||||
-- ^ The text to pad
|
||||
-> String
|
||||
padRight width str =
|
||||
overlay str $ replicate width ' '
|
||||
|
||||
-- | Overlays one string on top of another
|
||||
overlay
|
||||
:: String
|
||||
@@ -101,3 +124,84 @@ month 10 = "OCT"
|
||||
month 11 = "NOV"
|
||||
month 12 = "DEC"
|
||||
month _ = ""
|
||||
|
||||
-- | Creates a two-column table with labels
|
||||
labelTable :: [(String, String)] -> [String]
|
||||
labelTable xs = let
|
||||
labelWidth = maximum $ map (length . fst) xs
|
||||
in map
|
||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
||||
xs
|
||||
|
||||
-- | Creates a variable column table of numbers with two axes
|
||||
numTable
|
||||
:: [String]
|
||||
-- ^ The top column labels
|
||||
-> [(String, [Int])]
|
||||
-- ^ The rows with their labels
|
||||
-> [String]
|
||||
numTable headers rows = tableWith right $ header : body
|
||||
where
|
||||
header = "" : headers
|
||||
body = map
|
||||
(\(label, row) ->
|
||||
label : map show row)
|
||||
rows
|
||||
|
||||
-- | Creates a table from a two-dimensional list with a specified
|
||||
-- padding function
|
||||
tableWith
|
||||
:: (Int -> String -> String)
|
||||
-- ^ The padding function
|
||||
-> [[String]]
|
||||
-- ^ The cells
|
||||
-> [String]
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
58
src/Mtlstats/Helpers/Goalie.hs
Normal file
58
src/Mtlstats/Helpers/Goalie.hs
Normal file
@@ -0,0 +1,58 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Goalie (goalieDetails, goalieName) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed 'String' describing a 'Goalie'
|
||||
goalieDetails :: Goalie -> String
|
||||
goalieDetails g = let
|
||||
header = unlines $ labelTable
|
||||
[ ( "Number", show $ g^.gNumber )
|
||||
, ( "Name", goalieName g )
|
||||
]
|
||||
|
||||
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
|
||||
[ ( "Games played", gsGames )
|
||||
, ( "Mins played", gsMinsPlayed )
|
||||
, ( "Goals allowed", gsGoalsAllowed )
|
||||
, ( "Shutouts", gsShutouts )
|
||||
, ( "Wins", gsWins )
|
||||
, ( "Losses", gsLosses )
|
||||
, ( "Ties", gsTies )
|
||||
]
|
||||
|
||||
in header ++ "\n" ++ body
|
||||
|
||||
-- | Returns the goalie name, modified if they are a rookie
|
||||
goalieName :: Goalie -> String
|
||||
goalieName g = let
|
||||
|
||||
suffix = if g^.gRookie
|
||||
then "*"
|
||||
else ""
|
||||
|
||||
in g^.gName ++ suffix
|
||||
56
src/Mtlstats/Helpers/Player.hs
Normal file
56
src/Mtlstats/Helpers/Player.hs
Normal file
@@ -0,0 +1,56 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Player (playerDetails, playerName) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines $ top ++ [""] ++ table
|
||||
where
|
||||
top = labelTable
|
||||
[ ( "Number", show $ p^.pNumber )
|
||||
, ( "Name", playerName p )
|
||||
, ( "Position", p^.pPosition )
|
||||
]
|
||||
|
||||
table = numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) ->
|
||||
(label, [p^.pYtd.lens, p^.pLifetime.lens]))
|
||||
[ ( "Goals", psGoals )
|
||||
, ( "Assists", psAssists )
|
||||
, ( "Penalty mins", psPMin )
|
||||
]
|
||||
|
||||
-- | Presents a modified version of the player's name indicating
|
||||
-- whether or not they're a rookie
|
||||
playerName :: Player -> String
|
||||
playerName p = let
|
||||
|
||||
suffix = if p^.pRookie
|
||||
then "*"
|
||||
else ""
|
||||
|
||||
in p^.pName ++ suffix
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -23,6 +23,7 @@ module Mtlstats.Menu (
|
||||
-- * Menu Functions
|
||||
menuController,
|
||||
menuControllerWith,
|
||||
menuStateController,
|
||||
drawMenu,
|
||||
menuHandler,
|
||||
-- * Menus
|
||||
@@ -30,8 +31,8 @@ module Mtlstats.Menu (
|
||||
newSeasonMenu,
|
||||
gameMonthMenu,
|
||||
gameTypeMenu,
|
||||
editPlayerMenu,
|
||||
gameGoalieMenu
|
||||
gameGoalieMenu,
|
||||
editMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
@@ -40,7 +41,7 @@ import Data.Aeson (encodeFile)
|
||||
import Data.Char (toUpper)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Lens.Micro ((^.), (.~), (?~))
|
||||
import Lens.Micro ((^.), (?~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import System.EasyFile
|
||||
( createDirectoryIfMissing
|
||||
@@ -77,6 +78,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
|
||||
@@ -98,14 +114,8 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
||||
modify startNewSeason >> return True
|
||||
, MenuItem '2' "New Game" $
|
||||
modify startNewGame >> return True
|
||||
, MenuItem '3' "Create Player" $
|
||||
modify createPlayer >> return True
|
||||
, MenuItem '4' "Create Goalie" $
|
||||
modify createGoalie >> return True
|
||||
, MenuItem '5' "Edit Player" $
|
||||
modify editPlayer >> return True
|
||||
, MenuItem '6' "Edit Goalie" $
|
||||
modify editGoalie >> return True
|
||||
, MenuItem '3' "Edit" $
|
||||
modify edit >> return True
|
||||
, MenuItem 'X' "Exit" $ do
|
||||
db <- gets $ view database
|
||||
liftIO $ do
|
||||
@@ -157,24 +167,6 @@ gameTypeMenu = Menu "Game type:" ()
|
||||
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
||||
]
|
||||
|
||||
-- | The player edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
||||
Nothing -> modify $ progMode .~ MainMenu
|
||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
||||
[ ( '1', "Change number", Just EPNumber )
|
||||
, ( '2', "Change name", Just EPName )
|
||||
, ( '3', "Change position", Just EPPosition )
|
||||
, ( '4', "YTD goals", Just EPYtdGoals )
|
||||
, ( '5', "YTD assists", Just EPYtdAssists )
|
||||
, ( '6', "YTD penalty mins", Just EPYtdPMin )
|
||||
, ( '7', "Lifetime goals", Just EPLtGoals )
|
||||
, ( '8', "Lifetime assists", Just EPLtAssists )
|
||||
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
|
||||
, ( '0', "Finished editing", Nothing )
|
||||
]
|
||||
|
||||
-- | Game goalie selection menu
|
||||
gameGoalieMenu :: ProgState -> Menu ()
|
||||
gameGoalieMenu s = let
|
||||
@@ -189,3 +181,18 @@ gameGoalieMenu s = let
|
||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
||||
modify $ GI.setGameGoalie gid) $
|
||||
zip ['1'..] goalies
|
||||
|
||||
-- | The edit menu
|
||||
editMenu :: Menu ()
|
||||
editMenu = Menu "*** EDIT ***" ()
|
||||
[ MenuItem '1' "Create Player" $
|
||||
modify createPlayer
|
||||
, MenuItem '2' "Create Goalie" $
|
||||
modify createGoalie
|
||||
, MenuItem '3' "Edit Player" $
|
||||
modify editPlayer
|
||||
, MenuItem '4' "Edit Goalie" $
|
||||
modify editGoalie
|
||||
, MenuItem 'R' "Return to Main Menu" $
|
||||
modify backHome
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -26,38 +26,43 @@ module Mtlstats.Menu.EditGoalie
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Data.Maybe (maybe)
|
||||
import Lens.Micro ((.~))
|
||||
import Lens.Micro ((.~), (%~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Goalie' edit menu
|
||||
editGoalieMenu :: Menu ()
|
||||
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
|
||||
(\(key, label, val) -> MenuItem key label $ modify $ maybe
|
||||
(progMode .~ MainMenu)
|
||||
(progMode.editGoalieStateL.egsMode .~)
|
||||
val)
|
||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit number", Just EGNumber )
|
||||
, ( '2', "Edit name", Just EGName )
|
||||
, ( '3', "Edit YTD stats", Just EGYtd )
|
||||
, ( '4', "Edit Lifetime stats", Just EGLifetime )
|
||||
, ( 'R', "Return to Main Menu", Nothing )
|
||||
[ ( '1', "Edit number", set EGNumber )
|
||||
, ( '2', "Edit name", set EGName )
|
||||
, ( '3', "Toggle rookie flag", toggle )
|
||||
, ( '4', "Edit YTD stats", set EGYtd )
|
||||
, ( '5', "Edit Lifetime stats", set EGLifetime )
|
||||
, ( 'R', "Return to Edit Menu", edit )
|
||||
]
|
||||
|
||||
where
|
||||
set mode = progMode.editGoalieStateL.egsMode .~ mode
|
||||
toggle = editSelectedGoalie (gRookie %~ not)
|
||||
|
||||
-- | The 'Goalie' YTD edit menu
|
||||
editGoalieYtdMenu :: Menu ()
|
||||
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit YTD games", EGYtdGames )
|
||||
, ( '2', "Edit YTD minutes", EGYtdMins )
|
||||
, ( '3', "Edit YTD goals", EGYtdGoals )
|
||||
, ( '4', "Edit YTD wins", EGYtdWins )
|
||||
, ( '5', "Edit YTD losses", EGYtdLosses )
|
||||
, ( '6', "Edit YTD ties", EGYtdTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
[ ( '1', "Edit all YTD stats", EGYtdGames True )
|
||||
, ( '2', "Edit YTD games", EGYtdGames False )
|
||||
, ( '3', "Edit YTD minutes", EGYtdMins False )
|
||||
, ( '4', "Edit YTD goals", EGYtdGoals False )
|
||||
, ( '5', "Edit YTD shutouts", EGYtdShutouts False )
|
||||
, ( '6', "Edit YTD wins", EGYtdWins False )
|
||||
, ( '7', "Edit YTD losses", EGYtdLosses False )
|
||||
, ( '8', "Edit YTD ties", EGYtdTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
]
|
||||
|
||||
-- | The 'Goalie' lifetime edit menu
|
||||
@@ -65,13 +70,15 @@ editGoalieLtMenu :: Menu ()
|
||||
editGoalieLtMenu = editMenu
|
||||
"*** EDIT GOALTENDER LIFETIME ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit lifetime games", EGLtGames )
|
||||
, ( '2', "Edit lifetime minutes", EGLtMins )
|
||||
, ( '3', "Edit lifetime goals", EGLtGoals )
|
||||
, ( '4', "Edit lifetime wins", EGLtWins )
|
||||
, ( '5', "Edit lifetime losses", EGLtLosses )
|
||||
, ( '6', "Edit lifetime ties", EGLtTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
[ ( '1', "Edit all lifetime stats", EGLtGames True )
|
||||
, ( '2', "Edit lifetime games", EGLtGames False )
|
||||
, ( '3', "Edit lifetime minutes", EGLtMins False )
|
||||
, ( '4', "Edit lifetime goals", EGLtGoals False )
|
||||
, ( '5', "Edit lifetime shutouts", EGLtShutouts False )
|
||||
, ( '6', "Edit lifetime wins", EGLtWins False )
|
||||
, ( '7', "Edit lifetime losses", EGLtLosses False )
|
||||
, ( '8', "Edit lifetime ties", EGLtTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
]
|
||||
|
||||
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||
|
||||
81
src/Mtlstats/Menu/EditPlayer.hs
Normal file
81
src/Mtlstats/Menu/EditPlayer.hs
Normal file
@@ -0,0 +1,81 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Menu.EditPlayer
|
||||
( editPlayerMenu
|
||||
, editPlayerYtdMenu
|
||||
, editPlayerLtMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~), (%~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Player' edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit number", set EPNumber )
|
||||
, ( '2', "Edit name", set EPName )
|
||||
, ( '3', "Edit position", set EPPosition )
|
||||
, ( '4', "Toggle rookie flag", toggle )
|
||||
, ( '5', "Edit YTD stats", set EPYtd )
|
||||
, ( '6', "Edit lifetime stats", set EPLifetime )
|
||||
, ( 'R', "Return to Edit Menu", edit )
|
||||
]
|
||||
|
||||
where
|
||||
set mode = progMode.editPlayerStateL.epsMode .~ mode
|
||||
toggle = editSelectedPlayer $ pRookie %~ not
|
||||
|
||||
-- | The 'Player' YTD stats edit menu
|
||||
editPlayerYtdMenu :: Menu ()
|
||||
editPlayerYtdMenu = editMenu
|
||||
"*** EDIT PLAYER YEAR-TO-DATE ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit all YTD stats", EPYtdGoals True )
|
||||
, ( '2', "Edit YTD goals", EPYtdGoals False )
|
||||
, ( '3', "Edit YTD assists", EPYtdAssists False )
|
||||
, ( '4', "Edit YTD penalty mins", EPYtdPMin )
|
||||
, ( 'R', "Return to player edit menu", EPMenu )
|
||||
]
|
||||
|
||||
-- | The 'Player' lifetime stats edit menu
|
||||
editPlayerLtMenu :: Menu ()
|
||||
editPlayerLtMenu = editMenu
|
||||
"*** EDIT PLAYER LIFETIME ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit all lifetime stats", EPLtGoals True )
|
||||
, ( '2', "Edit lifetime goals", EPLtGoals False )
|
||||
, ( '3', "Edit lifetime assits", EPLtAssists False )
|
||||
, ( '4', "Edit lifetime penalty mins", EPLtPMin )
|
||||
, ( 'R', "Return to edit player menu", EPMenu )
|
||||
]
|
||||
|
||||
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
||||
editMenu title = Menu title () . map
|
||||
(\(key, label, val) -> MenuItem key label $
|
||||
modify $ progMode.editPlayerStateL.epsMode .~ val)
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -28,7 +28,10 @@ module Mtlstats.Prompt (
|
||||
promptControllerWith,
|
||||
promptController,
|
||||
strPrompt,
|
||||
ucStrPrompt,
|
||||
namePrompt,
|
||||
numPrompt,
|
||||
numPromptWithFallback,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
playerNumPrompt,
|
||||
@@ -45,8 +48,7 @@ import Control.Monad (when)
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (isDigit, toUpper)
|
||||
import Data.Foldable (forM_)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import Text.Read (readMaybe)
|
||||
import qualified UI.NCurses as C
|
||||
@@ -68,10 +70,8 @@ promptHandler p (C.EventCharacter '\n') = do
|
||||
val <- gets $ view inputBuffer
|
||||
modify $ inputBuffer .~ ""
|
||||
promptAction p val
|
||||
promptHandler p (C.EventCharacter c) = let
|
||||
c' = toUpper c
|
||||
in when (promptCharCheck p c') $
|
||||
modify $ addChar c'
|
||||
promptHandler p (C.EventCharacter c) =
|
||||
modify $ inputBuffer %~ promptProcessChar p c
|
||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
||||
modify removeChar
|
||||
promptHandler p (C.EventSpecialKey k) =
|
||||
@@ -111,12 +111,33 @@ strPrompt
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
strPrompt pStr act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptCharCheck = const True
|
||||
, promptAction = act
|
||||
, promptSpecialKey = const $ return ()
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptProcessChar = \ch -> (++ [ch])
|
||||
, promptAction = act
|
||||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Creates an upper case string prompt
|
||||
ucStrPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
ucStrPrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = \ch -> (++ [toUpper ch]) }
|
||||
|
||||
-- | Creates a prompt which forces capitalization of input to
|
||||
-- accomodate a player or goalie name
|
||||
namePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
namePrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = capitalizeName }
|
||||
|
||||
-- | Builds a numeric prompt
|
||||
numPrompt
|
||||
:: String
|
||||
@@ -124,11 +145,26 @@ numPrompt
|
||||
-> (Int -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
numPrompt pStr act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptCharCheck = isDigit
|
||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
||||
, promptSpecialKey = const $ return ()
|
||||
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||
|
||||
-- | Builds a numeric prompt with a fallback action
|
||||
numPromptWithFallback
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> Action ()
|
||||
-- ^ The action to call on invalid (or blank) input
|
||||
-> (Int -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
numPromptWithFallback pStr fallback act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptProcessChar = \ch str -> if isDigit ch
|
||||
then str ++ [ch]
|
||||
else str
|
||||
, promptAction = \inStr -> case readMaybe inStr of
|
||||
Nothing -> fallback
|
||||
Just n -> act n
|
||||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Builds a selection prompt
|
||||
@@ -146,7 +182,7 @@ selectPrompt params = Prompt
|
||||
in "F" ++ show n ++ ") " ++ desc)
|
||||
results
|
||||
C.moveCursor row col
|
||||
, promptCharCheck = const True
|
||||
, promptProcessChar = spProcessChar params
|
||||
, promptAction = \sStr -> if null sStr
|
||||
then spCallback params Nothing
|
||||
else do
|
||||
@@ -175,12 +211,12 @@ playerNumPrompt = numPrompt "Player number: " $
|
||||
|
||||
-- | Prompts for a new player's name
|
||||
playerNamePrompt :: Prompt
|
||||
playerNamePrompt = strPrompt "Player name: " $
|
||||
playerNamePrompt = namePrompt "Player name: " $
|
||||
modify . (progMode.createPlayerStateL.cpsName .~)
|
||||
|
||||
-- | Prompts for a new player's position
|
||||
playerPosPrompt :: Prompt
|
||||
playerPosPrompt = strPrompt "Player position: " $
|
||||
playerPosPrompt = ucStrPrompt "Player position: " $
|
||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||
|
||||
-- | Prompts tor the goalie's number
|
||||
@@ -190,7 +226,7 @@ goalieNumPrompt = numPrompt "Goalie number: " $
|
||||
|
||||
-- | Prompts for the goalie's name
|
||||
goalieNamePrompt :: Prompt
|
||||
goalieNamePrompt = strPrompt "Goalie name: " $
|
||||
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||
|
||||
-- | Selects a player (creating one if necessary)
|
||||
@@ -207,6 +243,7 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||
, spElemDesc = playerSummary
|
||||
, spProcessChar = capitalizeName
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
@@ -235,6 +272,7 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||
, spElemDesc = goalieSummary
|
||||
, spProcessChar = capitalizeName
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -26,12 +26,14 @@ module Mtlstats.Prompt.EditGoalie
|
||||
, editGoalieYtdGamesPrompt
|
||||
, editGoalieYtdMinsPrompt
|
||||
, editGoalieYtdGoalsPrompt
|
||||
, editGoalieYtdShutoutsPrompt
|
||||
, editGoalieYtdWinsPrompt
|
||||
, editGoalieYtdLossesPrompt
|
||||
, editGoalieYtdTiesPrompt
|
||||
, editGoalieLtGamesPrompt
|
||||
, editGoalieLtMinsPrompt
|
||||
, editGoalieLtGoalsPrompt
|
||||
, editGoalieLtShutoutsPrompt
|
||||
, editGoalieLtWinsPrompt
|
||||
, editGoalieLtLossesPrompt
|
||||
, editGoalieLtTiesPrompt
|
||||
@@ -40,7 +42,7 @@ module Mtlstats.Prompt.EditGoalie
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Actions.EditGoalie
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
@@ -51,70 +53,171 @@ goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
||||
|
||||
-- | Prompt to edit a goalie's number
|
||||
editGoalieNumberPrompt :: Prompt
|
||||
editGoalieNumberPrompt = numPrompt "Goalie number: " $
|
||||
modify . editGoalieNumber
|
||||
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
||||
(gNumber .~)
|
||||
|
||||
-- | Prompt to edit a goalie's name
|
||||
editGoalieNamePrompt :: Prompt
|
||||
editGoalieNamePrompt = strPrompt "Goalie name: " $
|
||||
modify . editGoalieName
|
||||
editGoalieNamePrompt = namePrompt "Goalie name: " $ \name ->
|
||||
if null name
|
||||
then goto EGMenu
|
||||
else doEdit EGMenu $ gName .~ name
|
||||
|
||||
-- | Prompt to edit a goalie's YTD games played
|
||||
editGoalieYtdGamesPrompt :: Prompt
|
||||
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
|
||||
modify . editGoalieYtdGames
|
||||
editGoalieYtdGamesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdGamesPrompt batchMode =
|
||||
editNum "Year-to-date games played: " mode
|
||||
(gYtd.gsGames .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdMins True else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD minutes played
|
||||
editGoalieYtdMinsPrompt :: Prompt
|
||||
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
|
||||
modify . editGoalieYtdMins
|
||||
editGoalieYtdMinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdMinsPrompt batchMode =
|
||||
editNum "Year-to-date minutes played: " mode
|
||||
(gYtd.gsMinsPlayed .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdGoals True else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD goales allowed
|
||||
editGoalieYtdGoalsPrompt :: Prompt
|
||||
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
|
||||
modify . editGoalieYtdGoals
|
||||
editGoalieYtdGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdGoalsPrompt batchMode =
|
||||
editNum "Year-to-date goals allowed: " mode
|
||||
(gYtd.gsGoalsAllowed .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdShutouts True else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD shutouts
|
||||
editGoalieYtdShutoutsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdShutoutsPrompt batchMode =
|
||||
editNum "Year-to-date shutouts: " mode
|
||||
(gYtd.gsShutouts .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdWins True else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD wins
|
||||
editGoalieYtdWinsPrompt :: Prompt
|
||||
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
|
||||
modify . editGoalieYtdWins
|
||||
editGoalieYtdWinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdWinsPrompt batchMode =
|
||||
editNum "Year-to-date wins: " mode
|
||||
(gYtd.gsWins .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdLosses True else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD losses
|
||||
editGoalieYtdLossesPrompt :: Prompt
|
||||
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
|
||||
modify . editGoalieYtdLosses
|
||||
editGoalieYtdLossesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieYtdLossesPrompt batchMode =
|
||||
editNum "Year-to-date losses: " mode
|
||||
(gYtd.gsLosses .~)
|
||||
where
|
||||
mode = if batchMode then EGYtdTies else EGYtd
|
||||
|
||||
-- | Prompt to edit a goalie's YTD ties
|
||||
editGoalieYtdTiesPrompt :: Prompt
|
||||
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
|
||||
modify . editGoalieYtdTies
|
||||
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
||||
(gYtd.gsTies .~)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime games played
|
||||
editGoalieLtGamesPrompt :: Prompt
|
||||
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
|
||||
modify . editGoalieLtGames
|
||||
editGoalieLtGamesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtGamesPrompt batchMode =
|
||||
editNum "Lifetime games played: " mode
|
||||
(gLifetime.gsGames .~)
|
||||
where
|
||||
mode = if batchMode then EGLtMins True else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime minutes played
|
||||
editGoalieLtMinsPrompt :: Prompt
|
||||
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
|
||||
modify . editGoalieLtMins
|
||||
editGoalieLtMinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtMinsPrompt batchMode =
|
||||
editNum "Lifetime minutes played: " mode
|
||||
(gLifetime.gsMinsPlayed .~)
|
||||
where
|
||||
mode = if batchMode then EGLtGoals True else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||
editGoalieLtGoalsPrompt :: Prompt
|
||||
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
|
||||
modify . editGoalieLtGoals
|
||||
editGoalieLtGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtGoalsPrompt batchMode =
|
||||
editNum "Lifetime goals allowed: " mode
|
||||
(gLifetime.gsGoalsAllowed .~)
|
||||
where
|
||||
mode = if batchMode then EGLtShutouts True else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime shutouts
|
||||
editGoalieLtShutoutsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtShutoutsPrompt batchMode =
|
||||
editNum "Lifetime shutouts: " mode
|
||||
(gLifetime.gsShutouts .~)
|
||||
where
|
||||
mode = if batchMode then EGLtWins True else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime wins
|
||||
editGoalieLtWinsPrompt :: Prompt
|
||||
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
|
||||
modify . editGoalieLtWins
|
||||
editGoalieLtWinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtWinsPrompt batchMode =
|
||||
editNum "Lifetime wins: " mode
|
||||
(gLifetime.gsWins .~)
|
||||
where
|
||||
mode = if batchMode then EGLtLosses True else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime losses
|
||||
editGoalieLtLossesPrompt :: Prompt
|
||||
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
|
||||
modify . editGoalieLtLosses
|
||||
editGoalieLtLossesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Prompt
|
||||
editGoalieLtLossesPrompt batchMode =
|
||||
editNum "Lifetime losses: " mode
|
||||
(gLifetime.gsLosses .~)
|
||||
where
|
||||
mode = if batchMode then EGLtTies else EGLifetime
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime ties
|
||||
editGoalieLtTiesPrompt :: Prompt
|
||||
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
|
||||
modify . editGoalieLtTies
|
||||
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
||||
(gLifetime.gsTies .~)
|
||||
|
||||
editNum
|
||||
:: String
|
||||
-> EditGoalieMode
|
||||
-> (Int -> Goalie -> Goalie)
|
||||
-> Prompt
|
||||
editNum pStr mode f = numPromptWithFallback pStr
|
||||
(goto mode)
|
||||
(doEdit mode . f)
|
||||
|
||||
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
||||
doEdit mode f = do
|
||||
modify $ editSelectedGoalie f
|
||||
goto mode
|
||||
|
||||
goto :: EditGoalieMode -> Action ()
|
||||
goto = modify . (progMode.editGoalieStateL.egsMode .~)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -31,62 +31,95 @@ module Mtlstats.Prompt.EditPlayer
|
||||
, editPlayerLtPMinPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad.Extra (whenJustM)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Prompt to edit a player's number
|
||||
editPlayerNumPrompt :: Prompt
|
||||
editPlayerNumPrompt = numPrompt "Player number: " $
|
||||
editPlayer . (pNumber .~)
|
||||
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
||||
(pNumber .~)
|
||||
|
||||
-- | Prompt to edit a player's name
|
||||
editPlayerNamePrompt :: Prompt
|
||||
editPlayerNamePrompt = strPrompt "Player name: " $
|
||||
editPlayer . (pName .~)
|
||||
editPlayerNamePrompt = namePrompt "Player name: " $ \name ->
|
||||
if null name
|
||||
then goto EPMenu
|
||||
else doEdit EPMenu $ pName .~ name
|
||||
|
||||
-- | Prompt to edit a player's position
|
||||
editPlayerPosPrompt :: Prompt
|
||||
editPlayerPosPrompt = strPrompt "Player position: " $
|
||||
editPlayer . (pPosition .~)
|
||||
editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos ->
|
||||
if null pos
|
||||
then goto EPMenu
|
||||
else doEdit EPMenu $ pPosition .~ pos
|
||||
|
||||
-- | Prompt to edit a player's year-to-date goals
|
||||
editPlayerYtdGoalsPrompt :: Prompt
|
||||
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
|
||||
editPlayer . (pYtd.psGoals .~)
|
||||
editPlayerYtdGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Prompt
|
||||
editPlayerYtdGoalsPrompt batchMode = editNum "Year-to-date goals: " mode
|
||||
(pYtd.psGoals .~)
|
||||
where
|
||||
mode = if batchMode then EPYtdAssists True else EPYtd
|
||||
|
||||
-- | Prompt to edit a player's year-to-date assists
|
||||
editPlayerYtdAssistsPrompt :: Prompt
|
||||
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
|
||||
editPlayer . (pYtd.psAssists .~)
|
||||
editPlayerYtdAssistsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Prompt
|
||||
editPlayerYtdAssistsPrompt batchMode = editNum "Year-to-date assists: " mode
|
||||
(pYtd.psAssists .~)
|
||||
where
|
||||
mode = if batchMode then EPYtdPMin else EPYtd
|
||||
|
||||
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||
editPlayerYtdPMinPrompt :: Prompt
|
||||
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
|
||||
editPlayer . (pYtd.psPMin .~)
|
||||
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
||||
(pYtd.psPMin .~)
|
||||
|
||||
-- | Prompt to edit a player's lifetime goals
|
||||
editPlayerLtGoalsPrompt :: Prompt
|
||||
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
|
||||
editPlayer . (pLifetime.psGoals .~)
|
||||
editPlayerLtGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Prompt
|
||||
editPlayerLtGoalsPrompt batchMode = editNum "Lifetime goals: " mode
|
||||
(pLifetime.psGoals .~)
|
||||
where
|
||||
mode = if batchMode then EPLtAssists True else EPLifetime
|
||||
|
||||
-- | Prompt to edit a player's lifetime assists
|
||||
editPlayerLtAssistsPrompt :: Prompt
|
||||
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
|
||||
editPlayer . (pLifetime.psAssists .~)
|
||||
editPlayerLtAssistsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Prompt
|
||||
editPlayerLtAssistsPrompt batchMode = editNum "Lifetime assists: " mode
|
||||
(pLifetime.psAssists .~)
|
||||
where
|
||||
mode = if batchMode then EPLtPMin else EPLifetime
|
||||
|
||||
-- | Prompt to edit a player's lifetime penalty minutes
|
||||
editPlayerLtPMinPrompt :: Prompt
|
||||
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
|
||||
editPlayer . (pLifetime.psPMin .~)
|
||||
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
||||
(pLifetime.psPMin .~)
|
||||
|
||||
editPlayer :: (Player -> Player) -> Action ()
|
||||
editPlayer f =
|
||||
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
|
||||
modify
|
||||
$ (database.dbPlayers %~ modifyNth pid f)
|
||||
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
|
||||
editNum
|
||||
:: String
|
||||
-> EditPlayerMode
|
||||
-> (Int -> Player -> Player)
|
||||
-> Prompt
|
||||
editNum pStr mode f = numPromptWithFallback pStr
|
||||
(goto mode)
|
||||
(doEdit mode . f)
|
||||
|
||||
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
||||
doEdit mode f = do
|
||||
modify $ editSelectedPlayer f
|
||||
goto mode
|
||||
|
||||
goto :: EditPlayerMode -> Action ()
|
||||
goto = modify . (progMode.editPlayerStateL.epsMode .~)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -55,7 +55,7 @@ gameDayPrompt = numPrompt "Day of month: " $
|
||||
|
||||
-- | Prompts for the other team name
|
||||
otherTeamPrompt :: Prompt
|
||||
otherTeamPrompt = strPrompt "Other team: " $
|
||||
otherTeamPrompt = ucStrPrompt "Other team: " $
|
||||
modify . (progMode.gameStateL.otherTeam .~)
|
||||
|
||||
-- | Prompts for the home score
|
||||
@@ -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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,14 +19,18 @@ 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 Data.List (sortOn)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Ord (Down (Down))
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
@@ -60,54 +64,108 @@ 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)
|
||||
|
||||
criteria (_, ps) = psPoints ps > 0
|
||||
|
||||
in filteredPlayerReport width "GAME" criteria True False playerStats
|
||||
++ [""]
|
||||
++ gameGoalieReport 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 = sortOn (Down . psPoints . snd)
|
||||
$ 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" True False playerStats
|
||||
++ [""]
|
||||
++ goalieReport width True False 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 = sortOn (Down . psPoints . snd)
|
||||
$ map (\p -> (p, p^.pLifetime))
|
||||
$ db^.dbPlayers
|
||||
|
||||
goalieStats = map (\g -> (g, g^.gLifetime))
|
||||
$ db^.dbGoalies
|
||||
|
||||
in playerReport width "LIFETIME" False True playerStats
|
||||
++ [""]
|
||||
++ goalieReport width False True goalieStats
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
@@ -116,55 +174,159 @@ gameDate gs = fromMaybe "" $ do
|
||||
d <- padNum 2 <$> gs^.gameDay
|
||||
Just $ m ++ " " ++ d ++ " " ++ y
|
||||
|
||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||
playerReport width label ps = let
|
||||
nameWidth = playerNameColWidth $ map fst ps
|
||||
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
|
||||
in
|
||||
playerReport
|
||||
:: Int
|
||||
-> String
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Player, PlayerStats)]
|
||||
-> [String]
|
||||
playerReport width label =
|
||||
filteredPlayerReport width label (const True)
|
||||
|
||||
filteredPlayerReport
|
||||
:: Int
|
||||
-> String
|
||||
-> ((Player, PlayerStats) -> Bool)
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Player, PlayerStats)]
|
||||
-> [String]
|
||||
filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
||||
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||
criteria' = (&&) <$> criteria <*> \(p, _) -> p^.pNumber /= 0
|
||||
fps = filter criteria' 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 $ playerName p
|
||||
] ++ statsCells stats)
|
||||
fps
|
||||
|
||||
separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
|
||||
|
||||
totals =
|
||||
[ CellText ""
|
||||
, CellText ""
|
||||
] ++ statsCells tStats
|
||||
|
||||
olayText = if showTotals
|
||||
then label ++ " TOTALS"
|
||||
else ""
|
||||
|
||||
lnOverlay = if lineNumbers
|
||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||
else repeat ""
|
||||
|
||||
table = overlayLast olayText
|
||||
$ map (\(ln, line) -> overlay ln $ centre width line)
|
||||
$ zip lnOverlay
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ tHeader : body ++ if showTotals
|
||||
then [separator, totals]
|
||||
else []
|
||||
|
||||
in rHeader ++ table
|
||||
|
||||
goalieReport
|
||||
:: Int
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Goalie, GoalieStats)]
|
||||
-> [String]
|
||||
goalieReport width showTotals lineNumbers goalieData = let
|
||||
olayText = if showTotals
|
||||
then "GOALTENDING TOTALS"
|
||||
else ""
|
||||
|
||||
tData = foldl addGoalieStats newGoalieStats
|
||||
$ map snd goalieData
|
||||
|
||||
header =
|
||||
[ CellText "NO."
|
||||
, CellText $ padRight (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 $ goalieName goalie
|
||||
] ++ rowCells stats)
|
||||
goalieData
|
||||
|
||||
separator
|
||||
= replicate 2 (CellText "")
|
||||
++ replicate 5 (CellFill '-')
|
||||
|
||||
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||
|
||||
lnOverlay = if lineNumbers
|
||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||
else repeat ""
|
||||
|
||||
in map (\(ln, line) -> overlay ln $ centre width line)
|
||||
$ zip lnOverlay
|
||||
$ overlayLast olayText
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body ++ if showTotals
|
||||
then [separator, summary]
|
||||
else []
|
||||
|
||||
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||
gameGoalieReport width goalieData = let
|
||||
header =
|
||||
[ CellText "NO."
|
||||
, CellText "GOALTENDER"
|
||||
, CellText " MIN"
|
||||
, CellText " GA"
|
||||
, CellText " AVE"
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(goalie, stats) ->
|
||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||
, CellText $ goalieName goalie
|
||||
, CellText $ show $ stats^.gsMinsPlayed
|
||||
, CellText $ show $ stats^.gsGoalsAllowed
|
||||
, CellText $ showFloating $ gsAverage stats
|
||||
])
|
||||
goalieData
|
||||
|
||||
in map (centre width)
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -43,6 +43,7 @@ module Mtlstats.Types (
|
||||
GameStats (..),
|
||||
Prompt (..),
|
||||
SelectParams (..),
|
||||
TableCell (..),
|
||||
-- * Lenses
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
@@ -105,6 +106,7 @@ module Mtlstats.Types (
|
||||
pNumber,
|
||||
pName,
|
||||
pPosition,
|
||||
pRookie,
|
||||
pYtd,
|
||||
pLifetime,
|
||||
-- ** PlayerStats Lenses
|
||||
@@ -114,12 +116,14 @@ module Mtlstats.Types (
|
||||
-- ** Goalie Lenses
|
||||
gNumber,
|
||||
gName,
|
||||
gRookie,
|
||||
gYtd,
|
||||
gLifetime,
|
||||
-- ** GoalieStats Lenses
|
||||
gsGames,
|
||||
gsMinsPlayed,
|
||||
gsGoalsAllowed,
|
||||
gsShutouts,
|
||||
gsWins,
|
||||
gsLosses,
|
||||
gsTies,
|
||||
@@ -161,7 +165,6 @@ module Mtlstats.Types (
|
||||
playerSearchExact,
|
||||
modifyPlayer,
|
||||
playerSummary,
|
||||
playerDetails,
|
||||
playerIsActive,
|
||||
-- ** PlayerStats Helpers
|
||||
psPoints,
|
||||
@@ -169,7 +172,11 @@ module Mtlstats.Types (
|
||||
-- ** Goalie Helpers
|
||||
goalieSearch,
|
||||
goalieSearchExact,
|
||||
goalieSummary
|
||||
goalieSummary,
|
||||
goalieIsActive,
|
||||
-- ** GoalieStats Helpers
|
||||
addGoalieStats,
|
||||
gsAverage
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (StateT)
|
||||
@@ -183,8 +190,11 @@ import Data.Aeson
|
||||
, toJSON
|
||||
, withObject
|
||||
, (.:)
|
||||
, (.:?)
|
||||
, (.!=)
|
||||
, (.=)
|
||||
)
|
||||
import Data.Char (toUpper)
|
||||
import Data.List (isInfixOf)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (listToMaybe)
|
||||
@@ -222,6 +232,7 @@ data ProgMode
|
||||
= MainMenu
|
||||
| NewSeason
|
||||
| NewGame GameState
|
||||
| EditMenu
|
||||
| CreatePlayer CreatePlayerState
|
||||
| CreateGoalie CreateGoalieState
|
||||
| EditPlayer EditPlayerState
|
||||
@@ -231,6 +242,7 @@ instance Show ProgMode where
|
||||
show MainMenu = "MainMenu"
|
||||
show NewSeason = "NewSeason"
|
||||
show (NewGame _) = "NewGame"
|
||||
show EditMenu = "EditMenu"
|
||||
show (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
show (EditPlayer _) = "EditPlayer"
|
||||
@@ -335,11 +347,13 @@ data EditPlayerMode
|
||||
| EPNumber
|
||||
| EPName
|
||||
| EPPosition
|
||||
| EPYtdGoals
|
||||
| EPYtdAssists
|
||||
| EPYtd
|
||||
| EPLifetime
|
||||
| EPYtdGoals Bool
|
||||
| EPYtdAssists Bool
|
||||
| EPYtdPMin
|
||||
| EPLtGoals
|
||||
| EPLtAssists
|
||||
| EPLtGoals Bool
|
||||
| EPLtAssists Bool
|
||||
| EPLtPMin
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -357,17 +371,19 @@ data EditGoalieMode
|
||||
| EGName
|
||||
| EGYtd
|
||||
| EGLifetime
|
||||
| EGYtdGames
|
||||
| EGYtdMins
|
||||
| EGYtdGoals
|
||||
| EGYtdWins
|
||||
| EGYtdLosses
|
||||
| EGYtdGames Bool
|
||||
| EGYtdMins Bool
|
||||
| EGYtdGoals Bool
|
||||
| EGYtdShutouts Bool
|
||||
| EGYtdWins Bool
|
||||
| EGYtdLosses Bool
|
||||
| EGYtdTies
|
||||
| EGLtGames
|
||||
| EGLtMins
|
||||
| EGLtGoals
|
||||
| EGLtWins
|
||||
| EGLtLosses
|
||||
| EGLtGames Bool
|
||||
| EGLtMins Bool
|
||||
| EGLtGoals Bool
|
||||
| EGLtShutouts Bool
|
||||
| EGLtWins Bool
|
||||
| EGLtLosses Bool
|
||||
| EGLtTies
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -385,13 +401,138 @@ data Database = Database
|
||||
-- ^ Statistics for away games
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a (non-goalie) player
|
||||
data Player = Player
|
||||
{ _pNumber :: Int
|
||||
-- ^ The player's number
|
||||
, _pName :: String
|
||||
-- ^ The player's name
|
||||
, _pPosition :: String
|
||||
-- ^ The player's position
|
||||
, _pRookie :: Bool
|
||||
-- ^ Indicates that the player is a rookie
|
||||
, _pYtd :: PlayerStats
|
||||
-- ^ The Player's year-to-date stats
|
||||
, _pLifetime :: PlayerStats
|
||||
-- ^ The player's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a (non-goalie) player's stats
|
||||
data PlayerStats = PlayerStats
|
||||
{ _psGoals :: Int
|
||||
-- ^ The number of goals
|
||||
, _psAssists :: Int
|
||||
-- ^ The number of assists
|
||||
, _psPMin :: Int
|
||||
-- ^ The number of penalty minutes
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a goalie
|
||||
data Goalie = Goalie
|
||||
{ _gNumber :: Int
|
||||
-- ^ The goalie's number
|
||||
, _gName :: String
|
||||
-- ^ The goalie's name
|
||||
, _gRookie :: Bool
|
||||
-- ^ Indicates that the goalie is a rookie
|
||||
, _gYtd :: GoalieStats
|
||||
-- ^ The goalie's year-to-date stats
|
||||
, _gLifetime :: GoalieStats
|
||||
-- ^ The goalie's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a goalie's stats
|
||||
data GoalieStats = GoalieStats
|
||||
{ _gsGames :: Int
|
||||
-- ^ The number of games played
|
||||
, _gsMinsPlayed :: Int
|
||||
-- ^ 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
|
||||
-- ^ The number of losses
|
||||
, _gsTies :: Int
|
||||
-- ^ The number of ties
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Game statistics
|
||||
data GameStats = GameStats
|
||||
{ _gmsWins :: Int
|
||||
-- ^ Games won
|
||||
, _gmsLosses :: Int
|
||||
-- ^ Games lost
|
||||
, _gmsOvertime :: Int
|
||||
-- ^ Games lost in overtime
|
||||
, _gmsGoalsFor :: Int
|
||||
-- ^ Goals for the team
|
||||
, _gmsGoalsAgainst :: Int
|
||||
-- ^ Goals against the team
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Defines a user prompt
|
||||
data Prompt = Prompt
|
||||
{ promptDrawer :: ProgState -> C.Update ()
|
||||
-- ^ Draws the prompt to the screen
|
||||
, promptProcessChar :: Char -> String -> String
|
||||
-- ^ Modifies the string based on the character entered
|
||||
, promptAction :: String -> Action ()
|
||||
-- ^ Action to perform when the value is entered
|
||||
, promptSpecialKey :: C.Key -> Action ()
|
||||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spProcessChar :: Char -> String -> String
|
||||
-- ^ Processes a character entered by the user
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ 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
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''EditPlayerState
|
||||
makeLenses ''EditGoalieState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
makeLenses ''Goalie
|
||||
makeLenses ''GoalieStats
|
||||
makeLenses ''GameStats
|
||||
|
||||
instance FromJSON Database where
|
||||
parseJSON = withObject "Database" $ \v -> Database
|
||||
<$> v .: "players"
|
||||
<*> v .: "goalies"
|
||||
<*> v .: "games"
|
||||
<*> v .: "home_game_stats"
|
||||
<*> v .: "away_game_stats"
|
||||
<$> v .:? "players" .!= []
|
||||
<*> v .:? "goalies" .!= []
|
||||
<*> v .:? "games" .!= 0
|
||||
<*> v .:? "home_game_stats" .!= newGameStats
|
||||
<*> v .:? "away_game_stats" .!= newGameStats
|
||||
|
||||
instance ToJSON Database where
|
||||
toJSON (Database players goalies games hgs ags) = object
|
||||
@@ -408,58 +549,37 @@ instance ToJSON Database where
|
||||
"home_game_stats" .= hgs <>
|
||||
"away_game_stats" .= ags
|
||||
|
||||
-- | Represents a (non-goalie) player
|
||||
data Player = Player
|
||||
{ _pNumber :: Int
|
||||
-- ^ The player's number
|
||||
, _pName :: String
|
||||
-- ^ The player's name
|
||||
, _pPosition :: String
|
||||
-- ^ The player's position
|
||||
, _pYtd :: PlayerStats
|
||||
-- ^ The Player's year-to-date stats
|
||||
, _pLifetime :: PlayerStats
|
||||
-- ^ The player's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON Player where
|
||||
parseJSON = withObject "Player" $ \v -> Player
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "position"
|
||||
<*> v .: "ytd"
|
||||
<*> v .: "lifetime"
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "position"
|
||||
<*> v .:? "rookie" .!= False
|
||||
<*> v .:? "ytd" .!= newPlayerStats
|
||||
<*> v .:? "lifetime" .!= newPlayerStats
|
||||
|
||||
instance ToJSON Player where
|
||||
toJSON (Player num name pos ytd lt) = object
|
||||
toJSON (Player num name pos rk ytd lt) = object
|
||||
[ "number" .= num
|
||||
, "name" .= name
|
||||
, "position" .= pos
|
||||
, "rookie" .= rk
|
||||
, "ytd" .= ytd
|
||||
, "lifetime" .= lt
|
||||
]
|
||||
toEncoding (Player num name pos ytd lt) = pairs $
|
||||
toEncoding (Player num name pos rk ytd lt) = pairs $
|
||||
"number" .= num <>
|
||||
"name" .= name <>
|
||||
"position" .= pos <>
|
||||
"rookie" .= rk <>
|
||||
"ytd" .= ytd <>
|
||||
"lifetime" .= lt
|
||||
|
||||
-- | Represents a (non-goalie) player's stats
|
||||
data PlayerStats = PlayerStats
|
||||
{ _psGoals :: Int
|
||||
-- ^ The number of goals
|
||||
, _psAssists :: Int
|
||||
-- ^ The number of assists
|
||||
, _psPMin :: Int
|
||||
-- ^ The number of penalty minutes
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON PlayerStats where
|
||||
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
||||
<$> v .: "goals"
|
||||
<*> v .: "assists"
|
||||
<*> v .: "penalty_mins"
|
||||
<$> v .:? "goals" .!= 0
|
||||
<*> v .:? "assists" .!= 0
|
||||
<*> v .:? "penalty_mins" .!= 0
|
||||
|
||||
instance ToJSON PlayerStats where
|
||||
toJSON (PlayerStats g a pm) = object
|
||||
@@ -472,94 +592,58 @@ instance ToJSON PlayerStats where
|
||||
"assists" .= a <>
|
||||
"penalty_mins" .= pm
|
||||
|
||||
-- | Represents a goalie
|
||||
data Goalie = Goalie
|
||||
{ _gNumber :: Int
|
||||
-- ^ The goalie's number
|
||||
, _gName :: String
|
||||
-- ^ The goalie's name
|
||||
, _gYtd :: GoalieStats
|
||||
-- ^ The goalie's year-to-date stats
|
||||
, _gLifetime :: GoalieStats
|
||||
-- ^ The goalie's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON Goalie where
|
||||
parseJSON = withObject "Goalie" $ \v -> Goalie
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "ytd"
|
||||
<*> v .: "lifetime"
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .:? "rookie" .!= False
|
||||
<*> v .:? "ytd" .!= newGoalieStats
|
||||
<*> v .:? "lifetime" .!= newGoalieStats
|
||||
|
||||
instance ToJSON Goalie where
|
||||
toJSON (Goalie num name ytd lt) = object
|
||||
toJSON (Goalie num name rk ytd lt) = object
|
||||
[ "number" .= num
|
||||
, "name" .= name
|
||||
, "ytd" .= ytd
|
||||
, "rookie" .= rk
|
||||
, "lifetime" .= lt
|
||||
]
|
||||
toEncoding (Goalie num name ytd lt) = pairs $
|
||||
toEncoding (Goalie num name rk ytd lt) = pairs $
|
||||
"number" .= num <>
|
||||
"name" .= name <>
|
||||
"rookie" .= rk <>
|
||||
"ytd" .= ytd <>
|
||||
"lifetime" .= lt
|
||||
|
||||
-- | Represents a goalie's stats
|
||||
data GoalieStats = GoalieStats
|
||||
{ _gsGames :: Int
|
||||
-- ^ The number of games played
|
||||
, _gsMinsPlayed :: Int
|
||||
-- ^ The number of minutes played
|
||||
, _gsGoalsAllowed :: Int
|
||||
-- ^ The number of goals allowed
|
||||
, _gsWins :: Int
|
||||
-- ^ The number of wins
|
||||
, _gsLosses :: Int
|
||||
-- ^ The number of losses
|
||||
, _gsTies :: Int
|
||||
-- ^ The number of ties
|
||||
} deriving (Eq, Show)
|
||||
|
||||
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
|
||||
|
||||
-- | Game statistics
|
||||
data GameStats = GameStats
|
||||
{ _gmsWins :: Int
|
||||
-- ^ Games won
|
||||
, _gmsLosses :: Int
|
||||
-- ^ Games lost
|
||||
, _gmsOvertime :: Int
|
||||
-- ^ Games lost in overtime
|
||||
, _gmsGoalsFor :: Int
|
||||
-- ^ Goals for the team
|
||||
, _gmsGoalsAgainst :: Int
|
||||
-- ^ Goals against the team
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON GameStats where
|
||||
parseJSON = withObject "GameStats" $ \v -> GameStats
|
||||
<$> v .: "wins"
|
||||
@@ -583,49 +667,6 @@ instance ToJSON GameStats where
|
||||
"goals_for" .= gf <>
|
||||
"goals_against" .= ga
|
||||
|
||||
-- | Defines a user prompt
|
||||
data Prompt = Prompt
|
||||
{ promptDrawer :: ProgState -> C.Update ()
|
||||
-- ^ Draws the prompt to the screen
|
||||
, promptCharCheck :: Char -> Bool
|
||||
-- ^ Determines whether or not the character is valid
|
||||
, promptAction :: String -> Action ()
|
||||
-- ^ Action to perform when the value is entered
|
||||
, promptSpecialKey :: C.Key -> Action ()
|
||||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''EditPlayerState
|
||||
makeLenses ''EditGoalieState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
makeLenses ''Goalie
|
||||
makeLenses ''GoalieStats
|
||||
makeLenses ''GameStats
|
||||
|
||||
gameStateL :: Lens' ProgMode GameState
|
||||
gameStateL = lens
|
||||
(\case
|
||||
@@ -753,6 +794,7 @@ newPlayer num name pos = Player
|
||||
{ _pNumber = num
|
||||
, _pName = name
|
||||
, _pPosition = pos
|
||||
, _pRookie = True
|
||||
, _pYtd = newPlayerStats
|
||||
, _pLifetime = newPlayerStats
|
||||
}
|
||||
@@ -775,6 +817,7 @@ newGoalie
|
||||
newGoalie num name = Goalie
|
||||
{ _gNumber = num
|
||||
, _gName = name
|
||||
, _gRookie = True
|
||||
, _gYtd = newGoalieStats
|
||||
, _gLifetime = newGoalieStats
|
||||
}
|
||||
@@ -785,6 +828,7 @@ newGoalieStats = GoalieStats
|
||||
{ _gsGames = 0
|
||||
, _gsMinsPlayed = 0
|
||||
, _gsGoalsAllowed = 0
|
||||
, _gsShutouts = 0
|
||||
, _gsWins = 0
|
||||
, _gsLosses = 0
|
||||
, _gsTies = 0
|
||||
@@ -881,7 +925,7 @@ playerSearch
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearch sStr =
|
||||
filter match . zip [0..]
|
||||
where match (_, p) = sStr `isInfixOf` (p^.pName)
|
||||
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||
|
||||
-- | Searches for a player by exact match on name
|
||||
playerSearchExact
|
||||
@@ -915,20 +959,6 @@ playerSummary :: Player -> String
|
||||
playerSummary p =
|
||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines
|
||||
[ " Number: " ++ show (p^.pNumber)
|
||||
, " Name: " ++ p^.pName
|
||||
, " Position: " ++ p^.pPosition
|
||||
, " YTD goals: " ++ show (p^.pYtd.psGoals)
|
||||
, " YTD assists: " ++ show (p^.pYtd.psAssists)
|
||||
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
|
||||
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
|
||||
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
|
||||
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
|
||||
]
|
||||
|
||||
-- | Determines whether or not a player has been active in the current
|
||||
-- season/year
|
||||
playerIsActive :: Player -> Bool
|
||||
@@ -958,8 +988,9 @@ goalieSearch
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
|
||||
zip [0..]
|
||||
goalieSearch sStr =
|
||||
filter match . zip [0..]
|
||||
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||
|
||||
-- | Searches a list of goalies for an exact match
|
||||
goalieSearchExact
|
||||
@@ -979,3 +1010,30 @@ 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 = let
|
||||
allowed = fromIntegral $ gs^.gsGoalsAllowed
|
||||
mins = fromIntegral $ gs^.gsMinsPlayed
|
||||
gLen = fromIntegral gameLength
|
||||
in if mins == 0
|
||||
then 0
|
||||
else allowed / mins * gLen
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,8 +19,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
||||
module Mtlstats.Util
|
||||
( nth
|
||||
, modifyNth
|
||||
, updateMap
|
||||
, slice
|
||||
, capitalizeName
|
||||
) where
|
||||
|
||||
import Data.Char (isSpace, toUpper)
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- | Attempt to select the element from a list at a given index
|
||||
@@ -75,3 +82,25 @@ slice
|
||||
-- ^ The list to take a subset of
|
||||
-> [a]
|
||||
slice offset len = take len . drop offset
|
||||
|
||||
-- | Name capitalization function for a player
|
||||
capitalizeName
|
||||
:: Char
|
||||
-- ^ The character being input
|
||||
-> String
|
||||
-- ^ The current string
|
||||
-> String
|
||||
-- ^ The resulting string
|
||||
capitalizeName ch str = str ++ [ch']
|
||||
where
|
||||
ch' = if lockFlag str
|
||||
then toUpper ch
|
||||
else ch
|
||||
lockFlag "" = True
|
||||
lockFlag (c:cs)
|
||||
| c == ',' = lockFlag' cs
|
||||
| otherwise = lockFlag cs
|
||||
lockFlag' "" = True
|
||||
lockFlag' (c:cs)
|
||||
| isSpace c = lockFlag' cs
|
||||
| otherwise = False
|
||||
|
||||
@@ -1,537 +0,0 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.EditGoalieSpec (spec) where
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.EditGoalie
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "EditGoalie" $ do
|
||||
editGoalieNumberSpec
|
||||
editGoalieNameSpec
|
||||
editGoalieYtdGamesSpec
|
||||
editGoalieYtdMinsSpec
|
||||
editGoalieYtdGoalsSpec
|
||||
editGoalieYtdWinsSpec
|
||||
editGoalieYtdLossesSpec
|
||||
editGoalieYtdTiesSpec
|
||||
editGoalieLtGamesSpec
|
||||
editGoalieLtMinsSpec
|
||||
editGoalieLtGoalsSpec
|
||||
editGoalieLtWinsSpec
|
||||
editGoalieLtLossesSpec
|
||||
editGoalieLtTiesSpec
|
||||
|
||||
editGoalieNumberSpec :: Spec
|
||||
editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
|
||||
(editGoalieNumber 5)
|
||||
EGNumber
|
||||
(uncurry newGoalie)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, (5, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGMenu
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, (2, "Joe")
|
||||
, (5, "Bob")
|
||||
, EGMenu
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, (2, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGNumber
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, (2, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGNumber
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieNameSpec :: Spec
|
||||
editGoalieNameSpec = describe "editGoalieName" $ editTest
|
||||
(editGoalieName "foo")
|
||||
EGName
|
||||
(uncurry newGoalie)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "foo" )
|
||||
, ( 3, "Bob" )
|
||||
, EGMenu
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "foo" )
|
||||
, EGMenu
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "Bob" )
|
||||
, EGName
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "Bob" )
|
||||
, EGName
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdGamesSpec :: Spec
|
||||
editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
|
||||
(editGoalieYtdGames 1)
|
||||
EGYtdGames
|
||||
(\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGames
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGames
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdMinsSpec :: Spec
|
||||
editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
|
||||
(editGoalieYtdMins 1)
|
||||
EGYtdMins
|
||||
(\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, (2, "Joe", 0 )
|
||||
, (3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdMins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdMins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdGoalsSpec :: Spec
|
||||
editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
|
||||
(editGoalieYtdGoals 1)
|
||||
EGYtdGoals
|
||||
(\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGoals
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGoals
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdWinsSpec :: Spec
|
||||
editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
|
||||
(editGoalieYtdWins 1)
|
||||
EGYtdWins
|
||||
(\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdWins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdWins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdLossesSpec :: Spec
|
||||
editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
|
||||
(editGoalieYtdLosses 1)
|
||||
EGYtdLosses
|
||||
(\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdLosses
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdLosses
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdTiesSpec :: Spec
|
||||
editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
|
||||
(editGoalieYtdTies 1)
|
||||
EGYtdTies
|
||||
(\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdTies
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdTies
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtGamesSpec :: Spec
|
||||
editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
|
||||
(editGoalieLtGames 1)
|
||||
EGLtGames
|
||||
(\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGames
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGames
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtMinsSpec :: Spec
|
||||
editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
|
||||
(editGoalieLtMins 1)
|
||||
EGLtMins
|
||||
(\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtMins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtMins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtGoalsSpec :: Spec
|
||||
editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
|
||||
(editGoalieLtGoals 1)
|
||||
EGLtGoals
|
||||
(\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGoals
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGoals
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtWinsSpec :: Spec
|
||||
editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
|
||||
(editGoalieLtWins 1)
|
||||
EGLtWins
|
||||
(\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtWins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtWins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtLossesSpec :: Spec
|
||||
editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
|
||||
(editGoalieLtLosses 1)
|
||||
EGLtLosses
|
||||
(\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtLosses
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtLosses
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtTiesSpec :: Spec
|
||||
editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
|
||||
(editGoalieLtTies 1)
|
||||
EGLtTies
|
||||
(\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtTies
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtTies
|
||||
)
|
||||
]
|
||||
|
||||
editTest
|
||||
:: (ProgState -> ProgState)
|
||||
-> EditGoalieMode
|
||||
-> (a -> Goalie)
|
||||
-> [(String, Maybe Int, a, a, EditGoalieMode)]
|
||||
-> Spec
|
||||
editTest func setMode mkGoalie params = do
|
||||
mapM_
|
||||
(\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
|
||||
let
|
||||
egs = newEditGoalieState
|
||||
& egsSelectedGoalie .~ setGid
|
||||
& egsMode .~ setMode
|
||||
|
||||
ps = func $ progState $ EditGoalie egs
|
||||
|
||||
mapM_
|
||||
(\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
|
||||
actual = fromJust $ nth chkGid $ ps^.database.dbGoalies
|
||||
expected = mkGoalie goalieData
|
||||
in it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected)
|
||||
-- label, goalie ID, goalie data
|
||||
[ ( "check Joe", 0, joeData )
|
||||
, ( "check Bob", 1, bobData )
|
||||
]
|
||||
|
||||
context "check mode" $
|
||||
it ("should be " ++ show expectMode) $
|
||||
ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
|
||||
|
||||
params
|
||||
|
||||
context "wrong progMode" $ do
|
||||
let ps = func $ progState MainMenu
|
||||
|
||||
it "should not change the database" $
|
||||
ps^.database `shouldBe` db
|
||||
|
||||
it "should not change the progMode" $
|
||||
show (ps^.progMode) `shouldBe` "MainMenu"
|
||||
|
||||
joe :: Goalie
|
||||
joe = newGoalie 2 "Joe"
|
||||
|
||||
bob :: Goalie
|
||||
bob = newGoalie 3 "Bob"
|
||||
|
||||
db :: Database
|
||||
db = newDatabase & dbGoalies .~ [joe, bob]
|
||||
|
||||
progState :: ProgMode -> ProgState
|
||||
progState mode = newProgState
|
||||
& progMode .~ mode
|
||||
& database .~ db
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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 )
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -38,7 +38,6 @@ import Test.Hspec
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
|
||||
import qualified Actions.EditGoalieSpec as EditGoalie
|
||||
import qualified Actions.NewGameSpec as NewGame
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
@@ -52,8 +51,11 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
removeCharSpec
|
||||
createPlayerSpec
|
||||
createGoalieSpec
|
||||
editSpec
|
||||
editPlayerSpec
|
||||
editSelectedPlayerSpec
|
||||
editGoalieSpec
|
||||
editSelectedGoalieSpec
|
||||
addPlayerSpec
|
||||
addGoalieSpec
|
||||
resetCreatePlayerStateSpec
|
||||
@@ -62,7 +64,6 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
scrollUpSpec
|
||||
scrollDownSpec
|
||||
NewGame.spec
|
||||
EditGoalie.spec
|
||||
|
||||
startNewSeasonSpec :: Spec
|
||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||
@@ -198,18 +199,76 @@ createGoalieSpec = describe "createGoalie" $
|
||||
s = createGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||
|
||||
editSpec :: Spec
|
||||
editSpec = describe "edit" $
|
||||
it "should change the mode to EditMenu" $ let
|
||||
ps = edit newProgState
|
||||
in show (ps^.progMode) `shouldBe` "EditMenu"
|
||||
|
||||
editPlayerSpec :: Spec
|
||||
editPlayerSpec = describe "editPlayer" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = editPlayer newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||
|
||||
editSelectedPlayerSpec :: Spec
|
||||
editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
|
||||
(\(label, pState, expected) -> context label $
|
||||
it "should edit the players appropriately" $ let
|
||||
pState' = editSelectedPlayer (pName .~ "foo") pState
|
||||
players' = pState'^.database.dbPlayers
|
||||
in players' `shouldBe` expected)
|
||||
|
||||
-- label, initial state, expected
|
||||
[ ( "wrong mode", baseState, players )
|
||||
, ( "not selected", changePlayer Nothing, players )
|
||||
, ( "player 0", changePlayer $ Just 0, changed0 )
|
||||
, ( "player 1", changePlayer $ Just 1, changed1 )
|
||||
, ( "out of bounds", changePlayer $ Just 2, players )
|
||||
]
|
||||
|
||||
where
|
||||
baseState = newProgState & database.dbPlayers .~ players
|
||||
changePlayer n = baseState
|
||||
& (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
|
||||
players = [ player 0, player 1 ]
|
||||
changed0 = [ player' 0, player 1 ]
|
||||
changed1 = [ player 0, player' 1 ]
|
||||
player n = newPlayer n ("Player " ++ show n) "pos"
|
||||
player' n = newPlayer n "foo" "pos"
|
||||
|
||||
editGoalieSpec :: Spec
|
||||
editGoalieSpec = describe "editGoalie" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = editGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||
|
||||
editSelectedGoalieSpec :: Spec
|
||||
editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
|
||||
(\(label, pState, expected) -> context label $
|
||||
it "should edit the goalies appropriately" $ let
|
||||
pState' = editSelectedGoalie (gName .~ "foo") pState
|
||||
goalies' = pState'^.database.dbGoalies
|
||||
in goalies' `shouldBe` expected)
|
||||
|
||||
-- label, initial state, expected
|
||||
[ ( "wrong mode", baseState, goalies )
|
||||
, ( "not selected", changeGoalie Nothing, goalies )
|
||||
, ( "goalie 0", changeGoalie $ Just 0, changed0 )
|
||||
, ( "goalie 1", changeGoalie $ Just 1, changed1 )
|
||||
, ( "out of bounds", changeGoalie $ Just 2, goalies )
|
||||
]
|
||||
|
||||
where
|
||||
baseState = newProgState & database.dbGoalies .~ goalies
|
||||
changeGoalie n = baseState
|
||||
& (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
|
||||
goalies = [ goalie 0, goalie 1 ]
|
||||
changed0 = [ goalie' 0, goalie 1 ]
|
||||
changed1 = [ goalie 0, goalie' 1 ]
|
||||
goalie n = newGoalie n ("Player " ++ show n)
|
||||
goalie' n = newGoalie n "foo"
|
||||
|
||||
addPlayerSpec :: Spec
|
||||
addPlayerSpec = describe "addPlayer" $ do
|
||||
let
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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
|
||||
@@ -31,8 +33,15 @@ spec = describe "Mtlstats.Format" $ do
|
||||
leftSpec
|
||||
rightSpec
|
||||
centreSpec
|
||||
padRightSpec
|
||||
overlaySpec
|
||||
monthSpec
|
||||
labelTableSpec
|
||||
numTableSpec
|
||||
tableWithSpec
|
||||
complexTableSpec
|
||||
overlayLastSpec
|
||||
showFloatingSpec
|
||||
|
||||
padNumSpec :: Spec
|
||||
padNumSpec = describe "padNum" $ do
|
||||
@@ -90,6 +99,16 @@ centreSpec = describe "centre" $ do
|
||||
it "should truncate the text" $
|
||||
centre 2 "foo" `shouldBe` "fo"
|
||||
|
||||
padRightSpec :: Spec
|
||||
padRightSpec = describe "padRight" $ mapM_
|
||||
(\(label, width, str, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
padRight width str `shouldBe` expected)
|
||||
-- label, width, input string, expected
|
||||
[ ( "text shorter", 5, "foo", "foo " )
|
||||
, ( "text longer", 3, "foobar", "foobar" )
|
||||
]
|
||||
|
||||
overlaySpec :: Spec
|
||||
overlaySpec = describe "overlay" $ do
|
||||
|
||||
@@ -111,3 +130,120 @@ monthSpec = describe "month" $ do
|
||||
context "invalid" $
|
||||
it "should return an empty string" $
|
||||
month 0 `shouldBe` ""
|
||||
|
||||
labelTableSpec :: Spec
|
||||
labelTableSpec = describe "labelTable" $
|
||||
it "should format the table" $ let
|
||||
input =
|
||||
[ ( "foo", "bar" )
|
||||
, ( "baz", "quux" )
|
||||
, ( "longer", "x" )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo: bar"
|
||||
, " baz: quux"
|
||||
, "longer: x"
|
||||
]
|
||||
|
||||
in labelTable input `shouldBe` expected
|
||||
|
||||
numTableSpec :: Spec
|
||||
numTableSpec = describe "numTable" $
|
||||
it "should format the table" $ let
|
||||
headers = ["foo", "bar", "baz"]
|
||||
|
||||
rows =
|
||||
[ ( "quux", [ 1, 2, 3 ] )
|
||||
, ( "xyzzy", [ 9, 99, 999 ] )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo bar baz"
|
||||
, " quux 1 2 3"
|
||||
, "xyzzy 9 99 999"
|
||||
]
|
||||
|
||||
in numTable headers rows `shouldBe` expected
|
||||
|
||||
tableWithSpec :: Spec
|
||||
tableWithSpec = describe "tableWith" $ let
|
||||
vals =
|
||||
[ [ "foo", "bar", "baz" ]
|
||||
, [ "quux", "xyzzy", "x" ]
|
||||
]
|
||||
|
||||
in mapM_
|
||||
(\(label, func, expected) -> context label $
|
||||
it "should format the table" $
|
||||
tableWith func vals `shouldBe` expected)
|
||||
[ ( "align left"
|
||||
, left
|
||||
, [ "foo bar baz"
|
||||
, "quux xyzzy x "
|
||||
]
|
||||
)
|
||||
, ( "align right"
|
||||
, right
|
||||
, [ " foo bar baz"
|
||||
, "quux xyzzy x"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
85
test/Helpers/GoalieSpec.hs
Normal file
85
test/Helpers/GoalieSpec.hs
Normal file
@@ -0,0 +1,85 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.GoalieSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Goalie" $ do
|
||||
goalieDetailsSpec
|
||||
goalieNameSpec
|
||||
|
||||
goalieDetailsSpec :: Spec
|
||||
goalieDetailsSpec = describe "goalieDetails" $ let
|
||||
input = newGoalie 1 "Joe"
|
||||
& gRookie .~ True
|
||||
& gYtd
|
||||
%~ ( gsGames .~ 2 )
|
||||
. ( gsMinsPlayed .~ 3 )
|
||||
. ( gsGoalsAllowed .~ 4 )
|
||||
. ( gsShutouts .~ 5 )
|
||||
. ( gsWins .~ 6 )
|
||||
. ( gsLosses .~ 7 )
|
||||
. ( gsTies .~ 8 )
|
||||
& gLifetime
|
||||
%~ ( gsGames .~ 9 )
|
||||
. ( gsMinsPlayed .~ 10 )
|
||||
. ( gsGoalsAllowed .~ 11 )
|
||||
. ( gsShutouts .~ 12 )
|
||||
. ( gsWins .~ 13 )
|
||||
. ( gsLosses .~ 14 )
|
||||
. ( gsTies .~ 15 )
|
||||
|
||||
expected = unlines
|
||||
[ "Number: 1"
|
||||
, " Name: Joe*"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Games played 2 9"
|
||||
, " Mins played 3 10"
|
||||
, "Goals allowed 4 11"
|
||||
, " Shutouts 5 12"
|
||||
, " Wins 6 13"
|
||||
, " Losses 7 14"
|
||||
, " Ties 8 15"
|
||||
]
|
||||
|
||||
in it "should format the output correctly" $
|
||||
goalieDetails input `shouldBe` expected
|
||||
|
||||
goalieNameSpec :: Spec
|
||||
goalieNameSpec = describe "goalieName" $ mapM_
|
||||
(\(label, g, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
goalieName g `shouldBe` expected)
|
||||
|
||||
-- label, goalie, expected
|
||||
[ ( "rookie", goalie True, "foo*" )
|
||||
, ( "non-rookie", goalie False, "foo" )
|
||||
]
|
||||
|
||||
where
|
||||
goalie r = newGoalie 1 "foo" & gRookie .~ r
|
||||
79
test/Helpers/PlayerSpec.hs
Normal file
79
test/Helpers/PlayerSpec.hs
Normal file
@@ -0,0 +1,79 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.PlayerSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Player" $ do
|
||||
playerDetailsSpec
|
||||
playerNameSpec
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
p = newPlayer 1 "Joe" "centre"
|
||||
& pRookie .~ True
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe*"
|
||||
, "Position: centre"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Goals 2 5"
|
||||
, " Assists 3 6"
|
||||
, "Penalty mins 4 7"
|
||||
]
|
||||
|
||||
in playerDetails p `shouldBe` expected
|
||||
|
||||
playerNameSpec :: Spec
|
||||
playerNameSpec = describe "playerName" $ mapM_
|
||||
(\(label, p, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
playerName p `shouldBe` expected)
|
||||
|
||||
-- label, player, expected
|
||||
[ ( "rookie", rookie, "foo*" )
|
||||
, ( "non-rookie", nonRookie, "foo" )
|
||||
]
|
||||
|
||||
where
|
||||
rookie = player True
|
||||
nonRookie = player False
|
||||
player r = newPlayer 1 "foo" "centre" & pRookie .~ r
|
||||
32
test/HelpersSpec.hs
Normal file
32
test/HelpersSpec.hs
Normal file
@@ -0,0 +1,32 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module HelpersSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, describe)
|
||||
|
||||
import qualified Helpers.GoalieSpec as Goalie
|
||||
import qualified Helpers.PlayerSpec as Player
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Helper" $ do
|
||||
Player.spec
|
||||
Goalie.spec
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -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 )
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
|
||||
import qualified ActionsSpec as Actions
|
||||
import qualified FormatSpec as Format
|
||||
import qualified HandlersSpec as Handlers
|
||||
import qualified HelpersSpec as Helpers
|
||||
import qualified ReportSpec as Report
|
||||
import qualified TypesSpec as Types
|
||||
import qualified UtilSpec as Util
|
||||
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
Types.spec
|
||||
Helpers.spec
|
||||
Actions.spec
|
||||
Format.spec
|
||||
Handlers.spec
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -34,8 +34,9 @@ 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 System.Random (randomIO, randomRIO)
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Config
|
||||
@@ -72,13 +73,15 @@ spec = describe "Mtlstats.Types" $ do
|
||||
playerSearchExactSpec
|
||||
modifyPlayerSpec
|
||||
playerSummarySpec
|
||||
playerDetailsSpec
|
||||
playerIsActiveSpec
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
goalieSearchSpec
|
||||
goalieSearchExactSpec
|
||||
goalieSummarySpec
|
||||
goalieIsActiveSpec
|
||||
addGoalieStatsSpec
|
||||
gsAverageSpec
|
||||
Menu.spec
|
||||
|
||||
playerSpec :: Spec
|
||||
@@ -268,6 +271,7 @@ lensSpec lens getters setters = do
|
||||
|
||||
player :: Player
|
||||
player = newPlayer 1 "Joe" "centre"
|
||||
& pRookie .~ False
|
||||
& pYtd .~ playerStats 1
|
||||
& pLifetime .~ playerStats 2
|
||||
|
||||
@@ -276,6 +280,7 @@ playerJSON = Object $ HM.fromList
|
||||
[ ( "number", toJSON (1 :: Int) )
|
||||
, ( "name", toJSON ("Joe" :: String) )
|
||||
, ( "position", toJSON ("centre" :: String) )
|
||||
, ( "rookie", toJSON False )
|
||||
, ( "ytd", playerStatsJSON 1 )
|
||||
, ( "lifetime", playerStatsJSON 2 )
|
||||
]
|
||||
@@ -295,6 +300,7 @@ playerStatsJSON n = Object $ HM.fromList
|
||||
|
||||
goalie :: Goalie
|
||||
goalie = newGoalie 1 "Joe"
|
||||
& gRookie .~ False
|
||||
& gYtd .~ goalieStats 1
|
||||
& gLifetime .~ goalieStats 2
|
||||
|
||||
@@ -302,6 +308,7 @@ goalieJSON :: Value
|
||||
goalieJSON = Object $ HM.fromList
|
||||
[ ( "number", toJSON (1 :: Int) )
|
||||
, ( "name", toJSON ("Joe" :: String ) )
|
||||
, ( "rookie", toJSON False )
|
||||
, ( "ytd", goalieStatsJSON 1 )
|
||||
, ( "lifetime", goalieStatsJSON 2 )
|
||||
]
|
||||
@@ -311,18 +318,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
|
||||
@@ -586,7 +595,7 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
||||
ps = [joe, bob, steve]
|
||||
in playerSearch sStr ps `shouldBe` expected)
|
||||
-- search, result
|
||||
[ ( "Joe", [(0, joe)] )
|
||||
[ ( "joe", [(0, joe)] )
|
||||
, ( "o", [(0, joe), (1, bob)] )
|
||||
, ( "e", [(0, joe), (2, steve)] )
|
||||
, ( "x", [] )
|
||||
@@ -636,36 +645,6 @@ playerSummarySpec = describe "playerSummary" $
|
||||
it "should be \"Joe (2) center\"" $
|
||||
playerSummary joe `shouldBe` "Joe (2) center"
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
p = newPlayer 1 "Joe" "centre"
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe"
|
||||
, " Position: centre"
|
||||
, " YTD goals: 2"
|
||||
, " YTD assists: 3"
|
||||
, " YTD penalty mins: 4"
|
||||
, " Lifetime goals: 5"
|
||||
, " Lifetime assists: 6"
|
||||
, "Lifetime penalty mins: 7"
|
||||
]
|
||||
|
||||
in playerDetails p `shouldBe` expected
|
||||
|
||||
playerIsActiveSpec :: Spec
|
||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||
let
|
||||
@@ -750,8 +729,8 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
||||
goalieSearch "x" goalies `shouldBe` []
|
||||
|
||||
context "exact match" $
|
||||
it "should return Steve" $
|
||||
goalieSearch "Bob" goalies `shouldBe` [result 1]
|
||||
it "should return Bob" $
|
||||
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||
|
||||
goalieSearchExactSpec :: Spec
|
||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||
@@ -782,6 +761,77 @@ 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" $ mapM_
|
||||
(\(label, stats, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
gsAverage stats `shouldBe` expected)
|
||||
|
||||
-- label, stats, expected
|
||||
[ ( "with minutes", gs, 3 % 2 )
|
||||
, ( "no minutes", newGoalieStats , 0 )
|
||||
]
|
||||
|
||||
where
|
||||
gs = newGoalieStats
|
||||
& gsMinsPlayed .~ 2 * gameLength
|
||||
& gsGoalsAllowed .~ 3
|
||||
|
||||
joe :: Player
|
||||
joe = newPlayer 2 "Joe" "center"
|
||||
|
||||
@@ -797,6 +847,7 @@ makePlayer = Player
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeName
|
||||
<*> makeBool
|
||||
<*> makePlayerStats
|
||||
<*> makePlayerStats
|
||||
|
||||
@@ -805,6 +856,7 @@ makeGoalie :: IO Goalie
|
||||
makeGoalie = Goalie
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeBool
|
||||
<*> makeGoalieStats
|
||||
<*> makeGoalieStats
|
||||
|
||||
@@ -824,11 +876,14 @@ makeGoalieStats = GoalieStats
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
||||
makeBool :: IO Bool
|
||||
makeBool = randomIO
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -32,6 +32,7 @@ spec = describe "Mtlstats.Util" $ do
|
||||
modifyNthSpec
|
||||
updateMapSpec
|
||||
sliceSpec
|
||||
capitalizeNameSpec
|
||||
|
||||
nthSpec :: Spec
|
||||
nthSpec = describe "nth" $ mapM_
|
||||
@@ -93,3 +94,23 @@ sliceSpec = describe "slice" $ do
|
||||
context "negative offset" $
|
||||
it "should return the correct number of elements from the beginning" $
|
||||
slice (-10) 2 list `shouldBe` [2, 4]
|
||||
|
||||
capitalizeNameSpec :: Spec
|
||||
capitalizeNameSpec = describe "capitalizeName" $ mapM_
|
||||
(\(label, ch, str, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
capitalizeName ch str `shouldBe` expected)
|
||||
-- label, character, string, expected
|
||||
[ ( "initial lower", 'a', "", "A" )
|
||||
, ( "initial upper", 'A', "", "A" )
|
||||
, ( "initial non-alpha", '0', "", "0" )
|
||||
, ( "pre-comma lower", 'a', "A", "AA" )
|
||||
, ( "pre-comma upper", 'A', "A", "AA" )
|
||||
, ( "pre-comma non-alpha", '0', "A", "A0" )
|
||||
, ( "post-comma first lower", 'a', "FOO, ", "FOO, A" )
|
||||
, ( "post-comma first upper", 'A', "FOO, ", "FOO, A" )
|
||||
, ( "post-comma first non-alpha", '0', "FOO, ", "FOO, 0" )
|
||||
, ( "unrestricted upper", 'A', "FOO, A", "FOO, AA" )
|
||||
, ( "unrestricted lower", 'a', "FOO, A", "FOO, Aa" )
|
||||
, ( "unrestricted non-alpha", '0', "FOO, A", "FOO, A0" )
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user