265 Commits

Author SHA1 Message Date
Jonathan Lamothe
dd6f604cd7 version 0.10.0 2020-01-11 00:30:51 -05:00
Jonathan Lamothe
1763f142f1 updated copyright 2020-01-11 00:29:45 -05:00
Jonathan Lamothe
b442b6a360 updated change log 2020-01-09 01:55:57 -05:00
Jonathan Lamothe
119c28ef18 Merge pull request #60 from mtlstats/rookie-col
Add rookie flag to players/goalies
2020-01-09 01:54:48 -05:00
Jonathan Lamothe
b69b3fce7a fixed editSelectedGoalie test labels 2020-01-09 01:43:35 -05:00
Jonathan Lamothe
59026de077 use editSelectedGoalie for all goalie editing 2020-01-09 01:35:37 -05:00
Jonathan Lamothe
52f1e34d49 implemented rookie flag toggling for goalies 2020-01-09 01:31:24 -05:00
Jonathan Lamothe
2c561e9807 use editSelectedPlayer for all player edits 2020-01-09 01:23:20 -05:00
Jonathan Lamothe
e2aeb5bfa4 enable toggling of rookie flag for players 2020-01-09 01:23:20 -05:00
Jonathan Lamothe
5b40a5942b mark rookies in reports 2020-01-09 00:00:05 -05:00
Jonathan Lamothe
ee3cea5643 mark rookies in goalieSummary 2020-01-08 23:54:16 -05:00
Jonathan Lamothe
5209c4a296 mark rookies in playerSummary 2020-01-04 12:10:19 -05:00
Jonathan Lamothe
e077c32956 implemented goalieName 2020-01-04 11:02:58 -05:00
Jonathan Lamothe
8dcef502be implemented playerName 2020-01-03 22:01:09 -05:00
Jonathan Lamothe
3ee97406f1 make database less brittle when something's wrong with the JSON file 2020-01-03 21:37:33 -05:00
Jonathan Lamothe
2768934c7c added rookie field to Player and Goalie values 2020-01-03 21:33:39 -05:00
Jonathan Lamothe
6c8ec21ffe Merge pull request #59 from mtlstats/line-numbers
add line numbers to lifetime player/goalie reports
2020-01-02 23:57:52 -05:00
Jonathan Lamothe
ba3f8a5a6c updated change log 2020-01-02 23:51:36 -05:00
Jonathan Lamothe
3a71dc1e62 add line numbers to lifetime goalie report 2020-01-02 23:50:21 -05:00
Jonathan Lamothe
d14f2ba527 line numbers on lifetime player report 2020-01-02 23:43:44 -05:00
Jonathan Lamothe
acd45229e7 Merge pull request #58 from mtlstats/edit-shutouts
allow user to edit goalie shutouts
2020-01-02 00:48:05 -05:00
Jonathan Lamothe
aff1d5c255 allow user to edit goalie shutouts 2020-01-02 00:42:04 -05:00
Jonathan Lamothe
0448a4beee updated change log 2020-01-02 00:20:26 -05:00
Jonathan Lamothe
ddb9394ab7 Merge pull request #57 from mtlstats/batch-edit
Allow editing of player/goalie YTD/lifetime stats at once
2020-01-02 00:16:39 -05:00
Jonathan Lamothe
071aa3bd8e allow batch editing of goalie YTD/lifetime stats 2020-01-02 00:07:29 -05:00
Jonathan Lamothe
ac95601609 removed (redundant) Mtlstats.Actions.EditGoalie module 2020-01-01 23:40:24 -05:00
Jonathan Lamothe
9606436e9e don't edit goalie stats when no input entered 2020-01-01 23:36:37 -05:00
Jonathan Lamothe
30807b7e2e implemented batch editing of all player ytd/lifetime stats 2020-01-01 23:09:07 -05:00
Jonathan Lamothe
34b743a55b don't edit player values when no new value entered 2020-01-01 23:09:07 -05:00
Jonathan Lamothe
63bd9a6de4 implemented numPromptWithFallback 2019-12-31 22:44:37 -05:00
Jonathan Lamothe
1f3ff5912c Merge pull request #56 from mtlstats/edit-return
make player edit prompts return to the appropriate menus
2019-12-28 21:58:35 -05:00
Jonathan Lamothe
7bb0981ed6 make player edit prompts return to the appropriate menus 2019-12-28 21:53:23 -05:00
Jonathan Lamothe
eb4107365c Merge pull request #55 from mtlstats/fix-case
force player/goalie names to correct case when editing
2019-12-28 21:36:24 -05:00
Jonathan Lamothe
6238e39f69 force player/goalie names to correct case when editing 2019-12-28 21:31:42 -05:00
Jonathan Lamothe
1adf6de990 Merge pull request #54 from mtlstats/player-zero
don't show player zero in reports
2019-12-28 21:05:23 -05:00
Jonathan Lamothe
2840298467 don't show player zero in reports 2019-12-28 20:59:04 -05:00
Jonathan Lamothe
89fe646d0e version 0.9.0 2019-12-27 00:54:08 -05:00
Jonathan Lamothe
b35136944c Merge pull request #53 from mtlstats/edit-menu
implement edit menu
2019-12-17 22:57:42 -05:00
Jonathan Lamothe
4d41c454a1 updated change log 2019-12-17 22:52:21 -05:00
Jonathan Lamothe
18ba758c0c changed return wording on player/goalie edit menus 2019-12-17 22:50:39 -05:00
Jonathan Lamothe
3aedd01b08 make player/goalie edit return to edit menu on completion 2019-12-17 22:47:17 -05:00
Jonathan Lamothe
235dd4e611 return to edit menu after player/goalie creation 2019-12-17 12:30:55 -05:00
Jonathan Lamothe
adf09c2cc4 moved player/goalie creation to edit menu 2019-12-17 12:23:53 -05:00
Jonathan Lamothe
a44ecc5e24 implemented edit 2019-12-17 12:16:26 -05:00
Jonathan Lamothe
9980a095ed added edit menu to main menu 2019-12-17 12:05:10 -05:00
Jonathan Lamothe
1d6a4aa7f3 implemented editMenu 2019-12-17 12:05:10 -05:00
Jonathan Lamothe
8988ad9146 implemented Mtlstats.Control.editMenuC 2019-12-17 11:38:35 -05:00
Jonathan Lamothe
59d48ec154 added EditMenu mode 2019-12-17 11:32:32 -05:00
Jonathan Lamothe
be990538bc Merge pull request #52 from mtlstats/hlint
hlint suggestions
2019-12-17 11:27:41 -05:00
Jonathan Lamothe
55c8806186 hlint suggestions
hlint didn't like reverse, and suggested using Data.Ord Down instead
2019-12-17 11:19:38 -05:00
Jonathan Lamothe
0ecf899b56 Merge pull request #51 from mtlstats/sort-players
sort players in YTD/lifetime reports by points
2019-12-15 13:30:47 -05:00
Jonathan Lamothe
2f06fd221d sort descending 2019-12-15 13:26:22 -05:00
Jonathan Lamothe
f1227da9ca sort players in YTD/lifetime reports by points 2019-12-15 13:19:12 -05:00
Jonathan Lamothe
38db3c8d8f Merge pull request #50 from mtlstats/no-totals
don't show totals in lifetime stats
2019-12-15 12:33:30 -05:00
Jonathan Lamothe
2b9a21c28b don't show totals in lifetime stats 2019-12-15 12:27:06 -05:00
Jonathan Lamothe
84c487dba5 typo in change log 2019-12-15 11:05:22 -05:00
Jonathan Lamothe
6345e3d5d8 Merge pull request #49 from mtlstats/auto-capitalize
Auto capitalize player/goalie names
2019-12-14 01:25:44 -05:00
Jonathan Lamothe
0ca03b7f21 updated change log 2019-12-14 01:19:18 -05:00
Jonathan Lamothe
482f42dca7 force proper name capitalization on player/goalie creation 2019-12-14 01:15:00 -05:00
Jonathan Lamothe
996bad94f1 force capitalization of player/goalie names in player selection 2019-12-14 01:09:40 -05:00
Jonathan Lamothe
4ca0b54de2 Merge pull request #48 from mtlstats/bugfix
Bugfix: display lifetime statistics in report instead of year-to-date
2019-12-14 00:16:55 -05:00
Jonathan Lamothe
3738088dde display lifetime stats in report 2019-12-13 11:43:22 -05:00
Jonathan Lamothe
1ec9e93f16 hlint recommenfations 2019-12-13 11:42:49 -05:00
Jonathan Lamothe
9534218797 version 0.8.0 2019-12-12 18:24:30 -05:00
Jonathan Lamothe
d7d3d1a4fd Merge pull request #47 from mtlstats/goalie-average
correctly calculate goalie average
2019-12-02 20:53:59 -05:00
Jonathan Lamothe
86c4fe316e correctly calculate goalie average 2019-12-02 20:48:09 -05:00
Jonathan Lamothe
d5ac42268f Merge pull request #46 from mtlstats/remove-extra-stats
removed unnecessary goalie stats from game report
2019-12-02 20:23:58 -05:00
Jonathan Lamothe
df26e9d265 removed unnecessary goalie stats from game report 2019-12-02 20:17:19 -05:00
Jonathan Lamothe
cb5f2d7d15 Merge pull request #45 from mtlstats/filter-game-stats
filter out players without points from game report
2019-12-02 15:20:03 -05:00
Jonathan Lamothe
152ea76bda filter out players without points from game report 2019-12-02 15:08:18 -05:00
Jonathan Lamothe
36ab31a17c Merge pull request #44 from mtlstats/bugfix-uppercase-team
bugfix: force other team name to uppercase
2019-12-02 14:54:07 -05:00
Jonathan Lamothe
768cb47fac bugfix: force other team name to uppercase 2019-12-02 14:43:08 -05:00
Jonathan Lamothe
427ad12603 Merge pull request #43 from mtlstats/bugfix-uc-hangs
bugfix: uppercase prompt hangs
2019-12-02 14:34:39 -05:00
Jonathan Lamothe
1ca2ffc378 bugfix: uppercase prompt hangs 2019-12-02 13:46:43 -05:00
Jonathan Lamothe
9e6b71c464 Merge pull request #42 from mtlstats/lower-case
allow lower case player names
2019-11-30 21:53:07 -05:00
Jonathan Lamothe
2f4e963e41 update change log 2019-11-30 21:09:24 -05:00
Jonathan Lamothe
05af939963 force player position to upper case 2019-11-30 13:02:42 -05:00
Jonathan Lamothe
8af7974c8f made playerSearch and goalieSearch case insensitive 2019-11-30 12:54:50 -05:00
Jonathan Lamothe
f7cfd5d835 allow lower case
- allow strPrompt to accept lower case letters
- implemented ucStrPrompt which forces characters to upper case
2019-11-30 11:52:06 -05:00
Jonathan Lamothe
cc495fa589 Merge pull request #41 from mtlstats/bugfix
bugfix: removed quotation makrks from goalie name in report
2019-11-29 20:20:06 -05:00
Jonathan Lamothe
9c5d166f31 bugfix: removed quotation makrks from goalie name in report 2019-11-29 20:12:45 -05:00
Jonathan Lamothe
a9e12d11a9 version 0.7.0 2019-11-28 12:09:09 -05:00
Jonathan Lamothe
08be4154b3 updated change log 2019-11-28 12:04:48 -05:00
Jonathan Lamothe
4e25db12f1 Merge pull request #40 from mtlstats/goalie-stats
Goalie stats
2019-11-28 12:00:25 -05:00
Jonathan Lamothe
50389b4f4c renamed variable 2019-11-28 11:41:47 -05:00
Jonathan Lamothe
dcbb809ae1 implemented showFloating 2019-11-28 06:20:14 -05:00
Jonathan Lamothe
be54198960 implemented gsAverage 2019-11-28 06:05:42 -05:00
Jonathan Lamothe
e3d5af5f88 implemented addGoalieStats 2019-11-28 05:59:06 -05:00
Jonathan Lamothe
de67628df0 defined the structure of a goalie report 2019-11-28 05:47:45 -05:00
Jonathan Lamothe
4848e54d81 implemented goalieIsActive 2019-11-28 05:12:59 -05:00
Jonathan Lamothe
3b6f77ba21 implemented basic logic for generating goalie reports 2019-11-28 05:05:52 -05:00
Jonathan Lamothe
e7606c8a5e removed playerNameColumnWidth (no longer necessary) 2019-11-28 04:50:19 -05:00
Jonathan Lamothe
3560aa7595 refactored standingsReport 2019-11-28 04:33:03 -05:00
Jonathan Lamothe
5979856578 refactored playerReport 2019-11-28 04:32:12 -05:00
Jonathan Lamothe
4941e0e64f award shutouts 2019-11-28 02:30:12 -05:00
Jonathan Lamothe
eedeaed8fc implemented complexTable 2019-11-26 01:33:33 -05:00
Jonathan Lamothe
d0f237e707 implemented TableCell type 2019-11-26 00:34:01 -05:00
Jonathan Lamothe
8795cb46a9 refactored game entry control flow 2019-11-25 23:58:11 -05:00
Jonathan Lamothe
f1f7077c8c added gsShutouts field to GoalieStats 2019-11-22 03:00:42 -05:00
Jonathan Lamothe
a407a01339 Merge pull request #39 from mtlstats/shorten
Shorten
2019-11-20 22:09:59 -05:00
Jonathan Lamothe
3e1218f6ff updated change log 2019-11-20 22:02:25 -05:00
Jonathan Lamothe
7ff16b8ac2 shortened goalie edit header 2019-11-20 22:00:58 -05:00
Jonathan Lamothe
d7879a92af broke YTD and lifetime menus off from player edit menu 2019-11-18 22:11:17 -05:00
Jonathan Lamothe
9b9feefa4f broke Mtlstats.Menu.EditPlayer off from Mtlstats.Menu 2019-11-18 21:52:54 -05:00
Jonathan Lamothe
26a90a5ed9 shortened describePlayer output 2019-11-18 21:43:18 -05:00
Jonathan Lamothe
e8b850c23a refactored Mtlstats.Control.EditPlayer 2019-11-16 11:37:41 -05:00
Jonathan Lamothe
0efac07a33 added year-to-date and lifetime player edit modes 2019-11-16 11:01:29 -05:00
Jonathan Lamothe
fba5f1b96c version 0.6.0 2019-11-15 11:11:20 -05:00
Jonathan Lamothe
95853f8bd7 Merge pull request #38 from mtlstats/season-menu
fixed new season menu
2019-11-14 12:06:06 -05:00
Jonathan Lamothe
01a4141ff4 fixed new season menu
- use 'R' and 'P' instead of '1' and '2'
2019-11-14 11:54:59 -05:00
Jonathan Lamothe
4d6c3faf5e updated change log 2019-11-14 11:48:04 -05:00
Jonathan Lamothe
7824d56d68 Merge pull request #37 from mtlstats/reset-standings
reset game standings on new season
2019-11-14 11:35:26 -05:00
Jonathan Lamothe
e6e28618a3 reset game standings on new season 2019-11-14 11:21:52 -05:00
Jonathan Lamothe
b830947d6c Merge pull request #36 from mtlstats/goalie-edit
implemented goalie editing
2019-11-14 10:13:35 -05:00
Jonathan Lamothe
29ae55a01e updated change log 2019-11-14 03:08:04 -05:00
Jonathan Lamothe
5b9c18730c implemented editGoalieLtTies 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
61d788cb4e implemented editGoalieLtTiesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
aac2752e95 implemented Mtlstats.Control.EditGoalie.ltTiesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9456102935 implemented editGoalieLtLosses 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3ba3875752 implemented editGoalieLtLossesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
ac3b8e9522 implemented Mtlstats.Control.EditGoalie.ltLossesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
2860309fc5 implemented editGoalieLtWins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
dd34429f59 implemented editGoalieLtWinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
13acbbdf35 implemented Mtlstats.Control.EditGoalie.ltWinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
954fe98998 implemented editGoalieLtGoals 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
c0386fa0b9 implemented editGoalieLtGoalsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
846d034435 implemented Mtlstats.Control.EditGoalie.ltGoalsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3a1480115d implemented editGoalieLtMins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
30cfea0503 implemented editGoalieLtMinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
52d412942a implemented Mtlstats.Control.EditGoalie.ltMinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
afdb7653cd implemented editGoalieLtGames 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
6b1aa85010 implemented editGoalieLtGamesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
8c482ae785 implemented Mtlstats.Control.EditGoalie.ltGamesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f97db477dd implemented editGoalieYtdTies 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
101f436424 implemented editGoalieYtdTiesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
b8aa00aa81 implemented Mtlstats.Control.EditGoalie.ytdTiesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
4655cb37b9 implemented editGoalieYtdLosses 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
01859634a1 implemented editGoalieYtdLossesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
e50861613d implemented Mtlstats.Control.EditGoalie.ytdLossesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
14da1096cd implemented editGoalieYtdWins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
a8a5d6a305 implemented editGoalieYtdWinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
4f5b4ff5f9 implemented Mtlstats.Control.EditGoalie.ytdWinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
cb5aa63469 implemented editGoalieYtdGoals 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
817c3c3fed implemented editGoalieYtdGoalsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
5dcd140280 implemented Mtlstats.Control.EditGoalie.ytdGoalsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
023430d737 implemented editGoalieYtdMins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0961f14c5f implemented editGoalieYtdMinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
1b9c072a76 implemented Mtlstats.Control.EditGoalie.ytdMinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
203650397e implemented editGoalieYtdGames 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f739db4203 implemented editGoalieYtdGamesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
06348fe928 implemented Mtlstats.Control.EditGoalie.ytdGamesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3839d6dd32 implemented editGoalieLtMenu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0234abec4c implemented Mtlstats.Control.EditGoalie.lifetimeMenuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9682aa0af3 implemented editGoalieYtdMenu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
35eda4a309 implemented Mtlstats.Control.EditGoalie.ytdMenuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
61ba781c5d implemented editGoalieName 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
fceba7eed1 implemented editGoalieNamePrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
895f090f17 implenented Mtlstats.Control.EditGoalie.nameC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
6c4b08bfcd renaned setGoalieNumber to editGoalieNumber 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0b3d70e7c3 implemented setGoalieNumber 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0202ddadab implemented editGoalieNumberPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
75abf0ade8 implemented Mtlstats.Control.EditGoalie.numberC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
c24016210c implemented editGoalie 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
d1773324d5 added "Edit Goalie" to main menu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
758dc868ec implemented Mtlstats.Control.EditGoalie.header 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3c9b7dd989 broke Mtlstats.Menu.EditGoalie module off from Mtlstats.Menu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f1f0ffef99 added control branches for goalie YTD and lifetime edit menus 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
d14abdb248 implemented menuControllerWith 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
e1f92ce92e implemented Mtlstats.Control.EditGoalie.menuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3dfbfe7090 implemented Mtlstats.Control.EditGoalie.editC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f9849023bc implemented editGoalieStateL 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
8aa8d39f70 implemented goalieToEditPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
cadbd6354b implemented Mtlstats.Control.EditGoalie.selectC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
dde0291321 implemented editGoalieC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9a179ed166 added EditGoalieState and EditGoalieMode types 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
858da7ab5c updated change log 2019-11-14 03:06:42 -05:00
Jonathan Lamothe
030cafb571 Merge pull request #35 from mtlstats/pedantic
be pedantic
2019-11-12 17:07:27 -05:00
Jonathan Lamothe
c99a39b2b9 be pedantic 2019-11-12 17:01:08 -05:00
Jonathan Lamothe
9288d885cd Merge pull request #34 from mtlstats/lifetime-report
generate lifetime report
2019-11-09 00:40:24 -05:00
Jonathan Lamothe
9f206ede72 generate lifetime report 2019-11-09 00:31:12 -05:00
Jonathan Lamothe
e802fff7c5 Merge pull request #33 from mtlstats/refactor
Refactor
2019-11-07 23:45:46 -05:00
Jonathan Lamothe
04140df812 removed redundant code (mostly imports) 2019-11-07 23:37:46 -05:00
Jonathan Lamothe
5339c57d5c fixed package.yaml
- added missing data
- fixed URL to readme
2019-11-07 22:56:56 -05:00
Jonathan Lamothe
ca2dd92bfe broke Actions Prompt and Control modules off into NewGame submodules 2019-11-07 22:36:08 -05:00
Jonathan Lamothe
90d1dfb581 version 0.5.0 2019-11-04 06:08:30 -05:00
Jonathan Lamothe
f48de6d53a Merge pull request #32 from mtlstats/game-goalie
Assign wins/losses/ties to goalies
2019-11-04 06:07:34 -05:00
Jonathan Lamothe
405ca1c5c7 don't hang on goalie selection 2019-11-04 05:58:39 -05:00
Jonathan Lamothe
c6c461f584 implemented win/loss/tie tallying 2019-11-04 05:44:08 -05:00
Jonathan Lamothe
4910200c96 implemented selectGameGoalieC 2019-11-04 04:12:20 -05:00
Jonathan Lamothe
d708bed77d simplified goalsAllowedPrompt 2019-11-04 03:07:39 -05:00
Jonathan Lamothe
7fd837863b call selectGameGoalieC when goalie info entered for game 2019-11-04 02:50:10 -05:00
Jonathan Lamothe
2a9ff93642 use proptController and promptControllerWith in goalie input controller 2019-11-04 02:47:11 -05:00
Jonathan Lamothe
76c0a85a50 don't show game report until a game goalie has been assigned 2019-11-04 02:41:50 -05:00
Jonathan Lamothe
2f767209bb broke goalie input functions for game off into separate modules 2019-11-04 02:38:48 -05:00
Jonathan Lamothe
43f3d9eb08 renamed GameState fields to prevent name collisions 2019-11-04 01:48:47 -05:00
Jonathan Lamothe
3f38160abd don't mark goalies recorded unless at least one has been entered 2019-11-04 01:30:09 -05:00
Jonathan Lamothe
b0cf9a83a1 added gameGoalieAssigned field to GameState 2019-11-04 01:30:09 -05:00
Jonathan Lamothe
8e74764cab implemented promptController and promptControllerWith 2019-11-04 00:51:50 -05:00
Jonathan Lamothe
b2226c0ca4 Merge pull request #31 from mtlstats/game-count
recordGoalieStats should bump a goalie's game count only once per game
2019-11-01 17:32:00 -04:00
Jonathan Lamothe
4fab3ec285 recordGoalieStats should bump a goalie's game count only once per game 2019-11-01 17:23:57 -04:00
Jonathan Lamothe
a63d822f02 Merge pull request #30 from mtlstats/edit-player
Implemented player editing
2019-11-01 06:58:19 -04:00
Jonathan Lamothe
bf78062455 updated change log 2019-11-01 06:51:49 -04:00
Jonathan Lamothe
b57f12310b implemented lifetime penalty minutes editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
a07c8a0242 implemented lifetime assists editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
9840e5a90e implemented lifetime goals editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
c9b198d106 implemented year-to-date penalty minute editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
24b304047c implemented year-to-date assist editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
4e9b3f635d implemented year-to-date goal editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
fc31794ef4 implemented player position editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5bf5a605aa implemented editPlayerNamePrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
911a61ba57 implemented nameC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
ece289d68d implemented editPlayerNumPrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b2362d2f5f implemented Mtlstats.Control.EditPlayer.numberC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b3af06b53d implemented playerDetails 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
0194f68996 implement player edit menu 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5bb4e509b8 implemented control flow for player edit mode 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
c26c0f54d1 added EditPlayerMode 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5fd67f3802 added "Edit Player" to main menu 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
cb4fc77dd6 renamed editPlayer to editPlayerC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
20ee194035 implemented playerToEditPrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
8b1e93386a implemented editPlayerStateL 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
e754d887c5 implemented Mtlstats.Control.EditPlayer.selectPlayerC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b19f1386ec player selection branch 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
43c2f6191d added player edit control flow branch 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
6ec7566b2c updated change log 2019-11-01 06:49:46 -04:00
Jonathan Lamothe
db105d4348 Merge pull request #29 from mtlstats/goalie-data
Record goalie data
2019-10-31 03:53:21 -04:00
Jonathan Lamothe
eb96ce6152 implemented recordGoalieStats 2019-10-31 03:42:07 -04:00
Jonathan Lamothe
ff541c2385 implemented goalsAllowedPrompt 2019-10-31 01:21:21 -04:00
Jonathan Lamothe
cb0b4f9d0b implemented goalsAllowedC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
4fa707bc0f implemented goalieMinsPlayedPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
a6395ada9c implemented minsPlayedC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
1c692a21f0 implemented goalieSummary 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
12c8d0bdd6 implemented goalieSearchExact 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
7e19ee072f implemented goalieSearch 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
2926e28e34 implemented selectGoaliePrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
d215f27f4f make selectPlayerPrompt call selectPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
1e78ca6f40 implemented selectPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
faa214bf6d implemented selectGameGoaliePrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
6c634cd366 implemented Mtlstats.Control.GoalieInput.selectGoalieC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
8ef1c6917a implemented goalieInput dispatcher 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
28a29e2f64 control flow branch for goalie input 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
c65bcbbca4 added goalie-related fields to GameState 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
66a2a70bbe implemented addGoalie 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
667cf34475 implemented resetCreatePlayerState and resetCreateGoalieState 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
2d2ee61aae implemented confirmCreateGoalieC 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
ed31ce5b1d added missing documentation comments 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
0812ae3ddd implemented goalie name prompt 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
ec914a38b1 implemented goalieNumPrompt 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
a9b5ada114 implemented getGoalieNumC 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
67bb12920c added goalie creation to main menu 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
e94bf59c81 implemented createGoalieStateL 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
ceb8132a13 broke long line 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
09c63da8bf refactored createPlayerStateLSpec to use lensSpec 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
4519ba4732 made lensSpec more generic 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
24c1673fc9 made GameState, CreatePlayerState and CreateGoalieState instances of Comparable 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
2f0989fb35 created Comparable typeclass 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
2a94e99371 allow ProgMode to handle goalie creation 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
1782c0bc48 implemented CreateGoalieState type 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
a234d8e802 removed (redundant) gsGoalsAgainst 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
6b30e27836 typo fix 2019-10-30 01:28:54 -04:00
Jonathan Lamothe
5677263750 Merge pull request #28 from mtlstats/bugfix-selection-abort
bugfix: don't abort player selection
2019-10-30 00:53:50 -04:00
Jonathan Lamothe
4a113d06e1 bugfix: don't abort player selection
...upon cancellation of player creation
2019-10-30 00:45:16 -04:00
Jonathan Lamothe
121f79a8a2 updated change log 2019-10-25 00:49:45 -04:00
Jonathan Lamothe
ba968657d9 Merge pull request #27 from mtlstats/bugfix-create-user
don't abort creating new player on selection
2019-10-19 00:49:59 -04:00
Jonathan Lamothe
ef8f7f3fee don't abort creating new player on selection 2019-10-19 00:41:56 -04:00
42 changed files with 4653 additions and 1385 deletions

View File

@@ -1,5 +1,43 @@
# 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
- Reset game standings on new season
## 0.5.0
- Fixed player creation bug
- Prompt for goalie informaiton on game data entry
- Implemented player editing
## v0.4.0
- Record penalty minutes

View File

@@ -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

View File

@@ -1,5 +1,5 @@
name: mtlstats
version: 0.4.0
version: 0.10.0
github: "mtlstats/mtlstats"
license: GPL-3
author: "Jonathan Lamothe"
@@ -11,13 +11,13 @@ extra-source-files:
- ChangeLog.md
# Metadata used when publishing your package
# synopsis: Short description of your package
# category: Web
synopsis: Hockey statistics tracker
category: Statistics
# To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file.
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
dependencies:
- base >= 4.7 && < 5
@@ -33,6 +33,10 @@ dependencies:
- bytestring
- microlens
ghc-options:
- -Wall
- -Werror
library:
source-dirs: src

View File

@@ -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

View File

@@ -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,29 +24,29 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Actions
( startNewSeason
, resetYtd
, resetStandings
, startNewGame
, addChar
, removeChar
, overtimeCheck
, updateGameStats
, validateGameDate
, createPlayer
, createGoalie
, edit
, editPlayer
, editSelectedPlayer
, editGoalie
, editSelectedGoalie
, addPlayer
, recordGoalAssists
, awardGoal
, awardAssist
, resetGoalData
, assignPMins
, addGoalie
, resetCreatePlayerState
, resetCreateGoalieState
, backHome
, scrollUp
, scrollDown
) where
import Control.Monad.Trans.State (modify)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
import Lens.Micro ((^.), (&), (.~), (%~))
import Mtlstats.Types
import Mtlstats.Util
@@ -61,6 +61,12 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
-- | Resets game standings
resetStandings :: ProgState -> ProgState
resetStandings = database
%~ ( dbHomeGameStats .~ newGameStats)
. ( dbAwayGameStats .~ newGameStats)
-- | Starts a new game
startNewGame :: ProgState -> ProgState
startNewGame
@@ -77,75 +83,62 @@ removeChar = inputBuffer %~ \case
"" -> ""
str -> init str
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gType <- gs^.gameType
won <- gameWon gs
lost <- gameLost gs
ot <- gs^.overtimeFlag
tScore <- teamScore gs
oScore <- otherScore gs
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
hgf = if gType == HomeGame then tScore else 0
hga = if gType == HomeGame then oScore else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
agf = if gType == AwayGame then tScore else 0
aga = if gType == AwayGame then oScore else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
. (gmsGoalsFor +~ hgf)
. (gmsGoalsAgainst +~ hga)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
. (gmsGoalsFor +~ agf)
. (gmsGoalsAgainst +~ aga)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState
validateGameDate s = fromMaybe s $ do
y <- toInteger <$> s^.progMode.gameStateL.gameYear
m <- s^.progMode.gameStateL.gameMonth
d <- s^.progMode.gameStateL.gameDay
Just $ if null $ fromGregorianValid y m d
then s & progMode.gameStateL
%~ (gameYear .~ Nothing)
. (gameMonth .~ Nothing)
. (gameDay .~ Nothing)
else s
-- | Starts player creation mode
createPlayer :: ProgState -> ProgState
createPlayer = let
cb = modify $ progMode .~ MainMenu
cps
= newCreatePlayerState
& cpsSuccessCallback .~ cb
& cpsFailureCallback .~ cb
callback = modify edit
cps = newCreatePlayerState
& cpsSuccessCallback .~ callback
& cpsFailureCallback .~ callback
in progMode .~ CreatePlayer cps
-- | Starts goalie creation mode
createGoalie :: ProgState -> ProgState
createGoalie = let
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
@@ -158,80 +151,29 @@ addPlayer s = fromMaybe s $ do
Just $ s & database.dbPlayers
%~ (++[player])
-- | Awards the goal and assists to the players
recordGoalAssists :: ProgState -> ProgState
recordGoalAssists ps = fromMaybe ps $ do
let gs = ps^.progMode.gameStateL
goalId <- gs^.goalBy
let assistIds = gs^.assistsBy
Just $ ps
& awardGoal goalId
& (\s -> foldr awardAssist s assistIds)
& progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (pointsAccounted %~ succ)
. (confirmGoalDataFlag .~ False)
-- | Adds the entered goalie to the roster
addGoalie :: ProgState -> ProgState
addGoalie s = fromMaybe s $ do
let cgs = s^.progMode.createGoalieStateL
num <- cgs^.cgsNumber
let
name = cgs^.cgsName
goalie = newGoalie num name
Just $ s & database.dbGoalies
%~ (++[goalie])
-- | Awards a goal to a player
awardGoal
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardGoal n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
-- | Resets the 'CreatePlayerState' value
resetCreatePlayerState :: ProgState -> ProgState
resetCreatePlayerState = progMode.createPlayerStateL
%~ (cpsNumber .~ Nothing)
. (cpsName .~ "")
. (cpsPosition .~ "")
-- | Awards an assist to a player
awardAssist
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardAssist n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState
resetGoalData ps = ps & progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (confirmGoalDataFlag .~ False)
-- | Adds penalty minutes to a player
assignPMins
:: Int
-- ^ The number of minutes to add
-> ProgState
-> ProgState
assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.selectedPlayer
Just $ s
& database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
& progMode.gameStateL
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
(psPMin +~ mins)
)
. (selectedPlayer .~ Nothing)
-- | Resets the 'CreateGoalieState' value
resetCreateGoalieState :: ProgState -> ProgState
resetCreateGoalieState = progMode.createGoalieStateL
%~ (cgsNumber .~ Nothing)
. (cgsName .~ "")
-- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState

View File

@@ -0,0 +1,191 @@
{- |
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.Actions.NewGame
( overtimeCheck
, updateGameStats
, validateGameDate
, recordGoalAssists
, awardGoal
, awardAssist
, resetGoalData
, assignPMins
, awardShutouts
) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
import Mtlstats.Types
import Mtlstats.Util
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gType <- gs^.gameType
won <- gameWon gs
lost <- gameLost gs
ot <- gs^.overtimeFlag
tScore <- teamScore gs
oScore <- otherScore gs
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
hgf = if gType == HomeGame then tScore else 0
hga = if gType == HomeGame then oScore else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
agf = if gType == AwayGame then tScore else 0
aga = if gType == AwayGame then oScore else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
. (gmsGoalsFor +~ hgf)
. (gmsGoalsAgainst +~ hga)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
. (gmsGoalsFor +~ agf)
. (gmsGoalsAgainst +~ aga)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState
validateGameDate s = fromMaybe s $ do
y <- toInteger <$> s^.progMode.gameStateL.gameYear
m <- s^.progMode.gameStateL.gameMonth
d <- s^.progMode.gameStateL.gameDay
Just $ if null $ fromGregorianValid y m d
then s & progMode.gameStateL
%~ (gameYear .~ Nothing)
. (gameMonth .~ Nothing)
. (gameDay .~ Nothing)
else s
-- | Awards the goal and assists to the players
recordGoalAssists :: ProgState -> ProgState
recordGoalAssists ps = fromMaybe ps $ do
let gs = ps^.progMode.gameStateL
goalId <- gs^.goalBy
let assistIds = gs^.assistsBy
Just $ ps
& awardGoal goalId
& (\s -> foldr awardAssist s assistIds)
& progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (pointsAccounted %~ succ)
. (confirmGoalDataFlag .~ False)
-- | Awards a goal to a player
awardGoal
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardGoal n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
-- | Awards an assist to a player
awardAssist
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardAssist n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState
resetGoalData ps = ps & progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (confirmGoalDataFlag .~ False)
-- | Adds penalty minutes to a player
assignPMins
:: Int
-- ^ The number of minutes to add
-> ProgState
-> ProgState
assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.gameSelectedPlayer
Just $ s
& database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
& progMode.gameStateL
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
(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)

View File

@@ -0,0 +1,109 @@
{- |
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.Actions.NewGame.GoalieInput
( finishGoalieEntry
, recordGoalieStats
, setGameGoalie
) where
import Control.Monad (void)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Util
-- | Attempts to finish game goalie entry
finishGoalieEntry :: ProgState -> ProgState
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
-- | Records the goalie's game stats
recordGoalieStats :: ProgState -> ProgState
recordGoalieStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gid <- gs^.gameSelectedGoalie
mins <- gs^.gameGoalieMinsPlayed
goals <- gs^.gameGoalsAllowed
void $ nth gid $ s^.database.dbGoalies
let
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
bumpVal = if gameStats^.gsGames == 0
then 1
else 0
bumpStats
= (gsGames +~ bumpVal)
. (gsMinsPlayed +~ mins)
. (gsGoalsAllowed +~ goals)
tryFinish = if mins >= gameLength
then finishGoalieEntry
else id
Just $ s
& progMode.gameStateL
%~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats)
. (gameSelectedGoalie .~ Nothing)
. (gameGoalieMinsPlayed .~ Nothing)
. (gameGoalsAllowed .~ Nothing)
& database.dbGoalies
%~ modifyNth gid (\goalie -> goalie
& gYtd %~ bumpStats
& gLifetime %~ bumpStats)
& tryFinish
-- | Records the win, loss, or tie to a specific 'Goalie'
setGameGoalie
:: Int
-- ^ The goalie's index
-> ProgState
-> ProgState
setGameGoalie gid s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
won <- gameWon gs
lost <- gameLost gs
tied <- gs^.overtimeFlag
let
w = if won then 1 else 0
l = if lost then 1 else 0
t = if tied then 1 else 0
updateStats
= (gsWins +~ w)
. (gsLosses +~ l)
. (gsTies +~ t)
updateGoalie
= (gYtd %~ updateStats)
. (gLifetime %~ updateStats)
updateGameState
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
. (gameGoalieAssigned .~ True)
Just $ s
& database.dbGoalies %~ modifyNth gid updateGoalie
& progMode.gameStateL %~ updateGameState

View File

@@ -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
@@ -40,3 +40,7 @@ dbFname = "database.json"
-- | The maximum number of assists
maxAssists :: Int
maxAssists = 2
-- | The length of a typical game (in minutes)
gameLength :: Int
gameLength = 60

View File

@@ -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,22 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where
import Control.Monad (join, when)
import Control.Monad (join)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Lens.Micro ((^.), (.~), (%~))
import Data.Maybe (fromJust)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Control.EditGoalie
import Mtlstats.Control.EditPlayer
import Mtlstats.Control.NewGame
import Mtlstats.Handlers
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Report
import Mtlstats.Types
import Mtlstats.Util
-- | Reads the program state and returs the apropriate controller to
-- run
@@ -44,25 +43,19 @@ dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of
MainMenu -> mainMenuC
NewSeason -> newSeasonC
NewGame 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^.selectedPlayer -> getPMinsC
| not $ gs^.pMinsRecorded -> pMinPlayerC
| otherwise -> reportC
NewGame gs -> newGameC gs
EditMenu -> editMenuC
CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC
| null $ cps^.cpsPosition -> getPlayerPosC
| otherwise -> confirmCreatePlayerC
CreateGoalie cgs
| null $ cgs^.cgsNumber -> getGoalieNumC
| null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
mainMenuC :: Controller
mainMenuC = Controller
@@ -78,218 +71,8 @@ newSeasonC = Controller
return True
}
gameYearC :: Controller
gameYearC = Controller
{ drawController = \s -> do
header s
drawPrompt gameYearPrompt s
, handleController = \e -> do
promptHandler gameYearPrompt e
return True
}
gameMonthC :: Controller
gameMonthC = Controller
{ drawController = \s -> do
header s
drawMenu gameMonthMenu
, handleController = \e -> do
menuHandler gameMonthMenu e
return True
}
gameDayC :: Controller
gameDayC = Controller
{ drawController = \s -> do
header s
drawPrompt gameDayPrompt s
, handleController = \e -> do
promptHandler gameDayPrompt e
modify validateGameDate
return True
}
gameTypeC :: Controller
gameTypeC = Controller
{ drawController = \s -> do
header s
drawMenu gameTypeMenu
, handleController = \e -> do
menuHandler gameTypeMenu e
return True
}
otherTeamC :: Controller
otherTeamC = Controller
{ drawController = \s -> do
header s
drawPrompt otherTeamPrompt s
, handleController = \e -> do
promptHandler otherTeamPrompt e
return True
}
homeScoreC :: Controller
homeScoreC = Controller
{ drawController = \s -> do
header s
drawPrompt homeScorePrompt s
, handleController = \e -> do
promptHandler homeScorePrompt e
return True
}
awayScoreC :: Controller
awayScoreC = Controller
{ drawController = \s -> do
header s
drawPrompt awayScorePrompt s
, handleController = \e -> do
promptHandler awayScorePrompt e
modify overtimeCheck
return True
}
overtimeFlagC :: Controller
overtimeFlagC = Controller
{ drawController = \s -> do
header s
C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
return True
}
verifyDataC :: Controller
verifyDataC = Controller
{ drawController = \s -> do
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)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify $ progMode.gameStateL.dataVerified .~ True
modify updateGameStats
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
goalInput :: GameState -> Controller
goalInput gs
| null (gs^.goalBy ) = recordGoalC
| not (gs^.confirmGoalDataFlag) = recordAssistC
| otherwise = confirmGoalDataC
recordGoalC :: Controller
recordGoalC = Controller
{ drawController = \s -> let
(game, goal) = gameGoal s
in drawPrompt (recordGoalPrompt game goal) s
, handleController = \e -> do
(game, goal) <- gets gameGoal
promptHandler (recordGoalPrompt game goal) e
return True
}
recordAssistC :: Controller
recordAssistC = Controller
{ drawController = \s -> let
(game, goal, assist) = gameGoalAssist s
in drawPrompt (recordAssistPrompt game goal assist) s
, handleController = \e -> do
(game, goal, assist) <- gets gameGoalAssist
promptHandler (recordAssistPrompt game goal assist) e
return True
}
confirmGoalDataC :: Controller
confirmGoalDataC = Controller
{ drawController = \s -> do
let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg = unlines $
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
(\pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players))
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
C.drawString msg
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> modify recordGoalAssists
Just False -> modify resetGoalData
Nothing -> return ()
return True
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.selectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible
, handleController = \e -> do
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
editMenuC :: Controller
editMenuC = menuController editMenu
getPlayerNumC :: Controller
getPlayerNumC = Controller
@@ -335,14 +118,40 @@ confirmCreatePlayerC = Controller
return True
}
gameGoal :: ProgState -> (Int, Int)
gameGoal s =
( s^.database.dbGames
, succ $ s^.progMode.gameStateL.pointsAccounted
)
getGoalieNumC :: Controller
getGoalieNumC = Controller
{ drawController = drawPrompt goalieNumPrompt
, handleController = \e -> do
promptHandler goalieNumPrompt e
return True
}
gameGoalAssist :: ProgState -> (Int, Int, Int)
gameGoalAssist s = let
(game, goal) = gameGoal s
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
in (game, goal, assist)
getGoalieNameC :: Controller
getGoalieNameC = Controller
{ drawController = drawPrompt goalieNamePrompt
, handleController = \e -> do
promptHandler goalieNamePrompt e
return True
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
, " Goalie name: " ++ cgs^.cgsName
, ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify addGoalie
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
Just False ->
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
Nothing -> return ()
return True
}

View File

@@ -0,0 +1,130 @@
{- |
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/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Control.EditGoalie (editGoalieC) where
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
import Mtlstats.Prompt.EditGoalie
import Mtlstats.Types
import Mtlstats.Util
-- | Controller/dispatcher for editing a 'Goalie'
editGoalieC :: EditGoalieState -> Controller
editGoalieC egs
| null $ egs^.egsSelectedGoalie = selectC
| otherwise = editC $ egs^.egsMode
selectC :: Controller
selectC = promptController goalieToEditPrompt
editC :: EditGoalieMode -> Controller
editC = \case
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
numberC :: Controller
numberC = promptController editGoalieNumberPrompt
nameC :: Controller
nameC = promptController editGoalieNamePrompt
ytdMenuC :: Controller
ytdMenuC = menuControllerWith header editGoalieYtdMenu
lifetimeMenuC :: Controller
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
ytdGamesC :: Bool -> Controller
ytdGamesC = promptController . editGoalieYtdGamesPrompt
ytdMinsC :: Bool -> Controller
ytdMinsC = promptController . editGoalieYtdMinsPrompt
ytdGoalsC :: Bool -> Controller
ytdGoalsC = promptController . editGoalieYtdGoalsPrompt
ytdShutoutsC :: Bool -> Controller
ytdShutoutsC = promptController . editGoalieYtdShutoutsPrompt
ytdWinsC :: Bool -> Controller
ytdWinsC = promptController . editGoalieYtdWinsPrompt
ytdLossesC :: Bool -> Controller
ytdLossesC = promptController . editGoalieYtdLossesPrompt
ytdTiesC :: Controller
ytdTiesC = promptController editGoalieYtdTiesPrompt
ltGamesC :: Bool -> Controller
ltGamesC = promptController . editGoalieLtGamesPrompt
ltMinsC :: Bool -> Controller
ltMinsC = promptController . editGoalieLtMinsPrompt
ltGoalsC :: Bool -> Controller
ltGoalsC = promptController . editGoalieLtGoalsPrompt
ltShutoutsC :: Bool -> Controller
ltShutoutsC = promptController . editGoalieLtShutoutsPrompt
ltWinsC :: Bool -> Controller
ltWinsC = promptController . editGoalieLtWinsPrompt
ltLossesC :: Bool -> Controller
ltLossesC = promptController . editGoalieLtLossesPrompt
ltTiesC :: Controller
ltTiesC = promptController editGoalieLtTiesPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
g <- nth gid $ s^.database.dbGoalies
Just $ goalieDetails g ++ "\n"

View File

@@ -0,0 +1,97 @@
{- |
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.Control.EditPlayer (editPlayerC) where
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
import Mtlstats.Util
-- | Dispatcher/controller for the player edit mode
editPlayerC :: EditPlayerState -> Controller
editPlayerC eps
| null $ eps^.epsSelectedPlayer = selectPlayerC
| otherwise = case eps^.epsMode of
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 = promptController playerToEditPrompt
menuC :: Controller
menuC = menuControllerWith header editPlayerMenu
numberC :: Controller
numberC = promptController editPlayerNumPrompt
nameC :: Controller
nameC = promptController editPlayerNamePrompt
positionC :: Controller
positionC = promptController editPlayerPosPrompt
ytdC :: Controller
ytdC = menuControllerWith header editPlayerYtdMenu
lifetimeC :: Controller
lifetimeC = menuControllerWith header editPlayerLtMenu
ytdGoalsC :: Bool -> Controller
ytdGoalsC = promptController . editPlayerYtdGoalsPrompt
ytdAssistsC :: Bool -> Controller
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt
ytdPMinC :: Controller
ytdPMinC = promptController editPlayerYtdPMinPrompt
ltGoalsC :: Bool -> Controller
ltGoalsC = promptController . editPlayerLtGoalsPrompt
ltAssistsC :: Bool -> Controller
ltAssistsC = promptController . editPlayerLtAssistsPrompt
ltPMinC :: Controller
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"

View File

@@ -0,0 +1,234 @@
{- |
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.Control.NewGame (newGameC) where
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Lens.Micro ((^.), (.~))
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Actions.NewGame
import Mtlstats.Control.NewGame.GoalieInput
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.NewGame
import Mtlstats.Report
import Mtlstats.Types
import Mtlstats.Util
-- | Dispatcher for a new game
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 = promptControllerWith header gameYearPrompt
gameMonthC :: Controller
gameMonthC = menuControllerWith header gameMonthMenu
gameDayC :: Controller
gameDayC = promptControllerWith header gameDayPrompt
gameTypeC :: Controller
gameTypeC = menuControllerWith header gameTypeMenu
otherTeamC :: Controller
otherTeamC = promptControllerWith header otherTeamPrompt
homeScoreC :: Controller
homeScoreC = promptControllerWith header homeScorePrompt
awayScoreC :: Controller
awayScoreC = promptControllerWith header awayScorePrompt
overtimeFlagC :: Controller
overtimeFlagC = Controller
{ drawController = \s -> do
header s
C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
return True
}
verifyDataC :: Controller
verifyDataC = Controller
{ drawController = \s -> do
let gs = s^.progMode.gameStateL
header s
C.drawString "\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 -> modify
$ (progMode.gameStateL.dataVerified .~ True)
. updateGameStats
. awardShutouts
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
goalInput :: GameState -> Controller
goalInput gs
| null (gs^.goalBy ) = recordGoalC
| not (gs^.confirmGoalDataFlag) = recordAssistC
| otherwise = confirmGoalDataC
recordGoalC :: Controller
recordGoalC = Controller
{ drawController = \s -> let
(game, goal) = gameGoal s
in drawPrompt (recordGoalPrompt game goal) s
, handleController = \e -> do
(game, goal) <- gets gameGoal
promptHandler (recordGoalPrompt game goal) e
return True
}
recordAssistC :: Controller
recordAssistC = Controller
{ drawController = \s -> let
(game, goal, assist) = gameGoalAssist s
in drawPrompt (recordAssistPrompt game goal assist) s
, handleController = \e -> do
(game, goal, assist) <- gets gameGoalAssist
promptHandler (recordAssistPrompt game goal assist) e
return True
}
confirmGoalDataC :: Controller
confirmGoalDataC = Controller
{ drawController = \s -> do
let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg = unlines $
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
(\pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players))
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
C.drawString msg
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> modify recordGoalAssists
Just False -> modify resetGoalData
Nothing -> return ()
return True
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible
, handleController = \e -> do
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
gameGoal :: ProgState -> (Int, Int)
gameGoal s =
( s^.database.dbGames
, succ $ s^.progMode.gameStateL.pointsAccounted
)
gameGoalAssist :: ProgState -> (Int, Int, Int)
gameGoalAssist s = let
(game, goal) = gameGoal s
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
in (game, goal, assist)

View File

@@ -0,0 +1,62 @@
{- |
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.Control.NewGame.GoalieInput (goalieInputC) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.NewGame.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
-- | The dispatcher for handling goalie input
goalieInputC :: GameState -> Controller
goalieInputC gs
| gs^.gameGoaliesRecorded = selectGameGoalieC
| null $ gs^.gameSelectedGoalie = selectGoalieC
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
| otherwise = goalsAllowedC
selectGoalieC :: Controller
selectGoalieC = promptController selectGameGoaliePrompt
minsPlayedC :: Controller
minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
goalsAllowedC :: Controller
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: Controller
selectGameGoalieC = menuStateController gameGoalieMenu
header :: ProgState -> C.Update ()
header s = C.drawString $ unlines
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
, fromMaybe "" $ do
n <- s^.progMode.gameStateL.gameSelectedGoalie
g <- nth n $ s^.database.dbGoalies
Just $ goalieSummary g
]

View File

@@ -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

View File

@@ -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

View 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

View 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

View File

@@ -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,20 +21,27 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Menu (
-- * Menu Functions
menuController,
menuControllerWith,
menuStateController,
drawMenu,
menuHandler,
-- * Menus
mainMenu,
newSeasonMenu,
gameMonthMenu,
gameTypeMenu
gameTypeMenu,
gameGoalieMenu,
editMenu
) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile)
import Data.Char (toUpper)
import Lens.Micro ((^.), (.~), (?~))
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Lens.Micro ((^.), (?~))
import Lens.Micro.Extras (view)
import System.EasyFile
( createDirectoryIfMissing
@@ -44,9 +51,47 @@ import System.EasyFile
import qualified UI.NCurses as C
import Mtlstats.Actions
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Types.Menu
import Mtlstats.Util
-- | Generates a simple 'Controller' for a Menu
menuController :: Menu () -> Controller
menuController = menuControllerWith $ const $ return ()
-- | Generate a simple 'Controller' for a 'Menu' with a header
menuControllerWith
:: (ProgState -> C.Update ())
-- ^ Generates the header
-> Menu ()
-- ^ The menu
-> Controller
-- ^ The resulting controller
menuControllerWith header menu = Controller
{ drawController = \s -> do
header s
drawMenu menu
, handleController = \e -> do
menuHandler menu e
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
@@ -69,9 +114,9 @@ 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' "Exit" $ do
, MenuItem '3' "Edit" $
modify edit >> return True
, MenuItem 'X' "Exit" $ do
db <- gets $ view database
liftIO $ do
dir <- getAppUserDataDirectory appName
@@ -84,11 +129,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
-- | The new season menu
newSeasonMenu :: Menu ()
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
[ MenuItem '1' "Regular Season" $ do
modify resetYtd
modify startNewGame
, MenuItem '2' "Playoffs" $
modify startNewGame
[ MenuItem 'R' "Regular Season" $ modify
$ resetYtd
. resetStandings
. startNewGame
, MenuItem 'P' "Playoffs" $ modify
$ resetStandings
. startNewGame
]
-- | Requests the month in which the game took place
@@ -119,3 +166,33 @@ gameTypeMenu = Menu "Game type:" ()
, MenuItem '2' "Away Game" $
modify $ progMode.gameStateL.gameType ?~ AwayGame
]
-- | Game goalie selection menu
gameGoalieMenu :: ProgState -> Menu ()
gameGoalieMenu s = let
title = "Which goalie should get credit for the game?"
gids = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats
goalies = mapMaybe
(\n -> do
goalie <- nth n $ s^.database.dbGoalies
Just (n, goalie))
gids
in Menu title () $ map
(\(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
]

View File

@@ -0,0 +1,87 @@
{- |
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.EditGoalie
( editGoalieMenu
, editGoalieYtdMenu
, editGoalieLtMenu
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~), (%~))
import Mtlstats.Actions
import Mtlstats.Types
import Mtlstats.Types.Menu
-- | The 'Goalie' edit menu
editGoalieMenu :: Menu ()
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value
[ ( '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 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
editGoalieLtMenu :: Menu ()
editGoalieLtMenu = editMenu
"*** EDIT GOALTENDER LIFETIME ***"
-- key, label, value
[ ( '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 ()
editMenu title = Menu title () . map
(\(key, label, val) -> MenuItem key label $
modify $ progMode.editGoalieStateL.egsMode .~ val)

View 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)

View File

@@ -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,28 +25,29 @@ module Mtlstats.Prompt (
-- * Prompt Functions
drawPrompt,
promptHandler,
promptControllerWith,
promptController,
strPrompt,
ucStrPrompt,
namePrompt,
numPrompt,
numPromptWithFallback,
selectPrompt,
-- * Individual prompts
gameYearPrompt,
gameDayPrompt,
otherTeamPrompt,
homeScorePrompt,
awayScorePrompt,
playerNumPrompt,
playerNamePrompt,
playerPosPrompt,
goalieNumPrompt,
goalieNamePrompt,
selectPlayerPrompt,
recordGoalPrompt,
recordAssistPrompt,
pMinPlayerPrompt,
assignPMinsPrompt
selectGoaliePrompt,
playerToEditPrompt
) where
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.Extras (view)
import Text.Read (readMaybe)
@@ -54,7 +55,6 @@ import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types
import Mtlstats.Util
@@ -70,16 +70,39 @@ 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) =
promptSpecialKey p k
promptHandler _ _ = return ()
-- | Builds a controller out of a prompt with a header
promptControllerWith
:: (ProgState -> C.Update ())
-- ^ The header
-> Prompt
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptControllerWith header prompt = Controller
{ drawController = \s -> do
header s
drawPrompt prompt s
, handleController = \e -> do
promptHandler prompt e
return True
}
-- | Builds a controller out of a prompt
promptController
:: Prompt
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptController = promptControllerWith (const $ return ())
-- | Builds a string prompt
strPrompt
:: String
@@ -89,11 +112,32 @@ strPrompt
-> Prompt
strPrompt pStr act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptCharCheck = const True
, 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
@@ -101,37 +145,64 @@ numPrompt
-> (Int -> Action ())
-- ^ The callback function for the result
-> Prompt
numPrompt pStr act = Prompt
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
, promptCharCheck = isDigit
, promptAction = \inStr -> forM_ (readMaybe inStr) act
, 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 ()
}
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
-- | Prompts for the other team name
otherTeamPrompt :: Prompt
otherTeamPrompt = strPrompt "Other team: " $
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $
modify . (progMode.gameStateL.awayScore ?~)
-- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
{ promptDrawer = \s -> do
let sStr = s^.inputBuffer
C.drawString $ spPrompt params ++ sStr
(row, col) <- C.cursorPosition
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
C.drawString $ unlines $ map
(\(n, (_, x)) -> let
desc = spElemDesc params x
in "F" ++ show n ++ ") " ++ desc)
results
C.moveCursor row col
, promptProcessChar = spProcessChar params
, promptAction = \sStr -> if null sStr
then spCallback params Nothing
else do
db <- gets (^.database)
case spSearchExact params sStr db of
Nothing -> spNotFound params sStr
Just n -> spCallback params $ Just n
, promptSpecialKey = \case
C.KeyFunction rawK -> do
sStr <- gets (^.inputBuffer)
db <- gets (^.database)
let
n = pred $ fromInteger rawK
results = spSearch params sStr db
when (n < maxFunKeys) $
whenJust (nth n results) $ \(sel, _) -> do
modify $ inputBuffer .~ ""
spCallback params $ Just sel
_ -> return ()
}
-- | Prompts for a new player's number
playerNumPrompt :: Prompt
@@ -140,14 +211,24 @@ 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
goalieNumPrompt :: Prompt
goalieNumPrompt = numPrompt "Goalie number: " $
modify . (progMode.createGoalieStateL.cgsNumber ?~)
-- | Prompts for the goalie's name
goalieNamePrompt :: Prompt
goalieNamePrompt = namePrompt "Goalie name: " $
modify . (progMode.createGoalieStateL.cgsName .~)
-- | Selects a player (creating one if necessary)
selectPlayerPrompt
:: String
@@ -156,96 +237,59 @@ selectPlayerPrompt
-- ^ The callback to run (takes the index number of the payer as
-- input)
-> Prompt
selectPlayerPrompt pStr callback = Prompt
{ promptDrawer = \s -> do
let sStr = s^.inputBuffer
C.drawString pStr
C.drawString sStr
(row, col) <- C.cursorPosition
C.drawString "\n\nPlayer select:\n"
let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
mapM_
(\(n, (_, p)) -> C.drawString $
"F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
sel
C.moveCursor row col
, promptCharCheck = const True
, promptAction = \sStr -> if null sStr
then callback Nothing
else do
players <- gets $ view $ database.dbPlayers
case playerSearchExact sStr players of
Just (n, _) -> callback $ Just n
Nothing -> do
mode <- gets $ view progMode
selectPlayerPrompt pStr callback = selectPrompt SelectParams
{ spPrompt = pStr
, spSearchHeader = "Player select:"
, 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)
let
cps
= newCreatePlayerState
cps = newCreatePlayerState
& cpsName .~ sStr
& cpsSuccessCallback .~ do
modify $ progMode .~ mode
pIndex <- pred . length <$> gets (view $ database.dbPlayers)
callback $ Just pIndex
& cpsFailureCallback .~ do
modify $ progMode .~ mode
callback Nothing
index <- pred . length <$> gets (^.database.dbPlayers)
callback $ Just index
& cpsFailureCallback .~ modify (progMode .~ mode)
modify $ progMode .~ CreatePlayer cps
, promptSpecialKey = \case
C.KeyFunction n -> do
sStr <- gets $ view inputBuffer
players <- gets $ view $ database.dbPlayers
modify $ inputBuffer .~ ""
let
fKey = pred $ fromIntegral n
options = playerSearch sStr players
sel = fst <$> nth fKey options
callback sel
_ -> return ()
}
-- | Prompts for the player who scored the goal
recordGoalPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal number
-- | Selects a goalie (creating one if necessary)
selectGoaliePrompt
:: String
-- ^ The prompt string
-> (Maybe Int -> Action ())
-- ^ The callback to run (takes the index number of the goalie as
-- input)
-> Prompt
recordGoalPrompt game goal = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Who scored goal number " ++ show goal ++ "? "
) $ modify . (progMode.gameStateL.goalBy .~)
selectGoaliePrompt pStr callback = selectPrompt SelectParams
{ spPrompt = pStr
, spSearchHeader = "Goalie select:"
, 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)
let
cgs = newCreateGoalieState
& cgsName .~ sStr
& cgsSuccessCallback .~ do
modify $ progMode .~ mode
index <- pred . length <$> gets (^.database.dbGoalies)
callback $ Just index
& cgsFailureCallback .~ modify (progMode .~ mode)
modify $ progMode .~ CreateGoalie cgs
}
-- | Prompts for a player who assisted the goal
recordAssistPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal nuber
-> Int
-- ^ The assist number
-> Prompt
recordAssistPrompt game goal assist = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Goal: " ++ show goal ++ "\n"
++ "Assist #" ++ show assist ++ ": "
) $ \case
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
Just n -> do
modify $ progMode.gameStateL.assistsBy %~ (++[n])
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
pMinPlayerPrompt :: Prompt
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n
assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins
playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
drawSimplePrompt :: String -> ProgState -> C.Update ()
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

View File

@@ -0,0 +1,223 @@
{- |
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.Prompt.EditGoalie
( goalieToEditPrompt
, editGoalieNumberPrompt
, editGoalieNamePrompt
, editGoalieYtdGamesPrompt
, editGoalieYtdMinsPrompt
, editGoalieYtdGoalsPrompt
, editGoalieYtdShutoutsPrompt
, editGoalieYtdWinsPrompt
, editGoalieYtdLossesPrompt
, editGoalieYtdTiesPrompt
, editGoalieLtGamesPrompt
, editGoalieLtMinsPrompt
, editGoalieLtGoalsPrompt
, editGoalieLtShutoutsPrompt
, editGoalieLtWinsPrompt
, editGoalieLtLossesPrompt
, editGoalieLtTiesPrompt
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompt to select a 'Goalie' for editing
goalieToEditPrompt :: Prompt
goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
-- | Prompt to edit a goalie's number
editGoalieNumberPrompt :: Prompt
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
(gNumber .~)
-- | Prompt to edit a goalie's name
editGoalieNamePrompt :: Prompt
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
:: 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
:: 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
:: 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
:: 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
:: 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 = editNum "Year-to-date ties: " EGYtd
(gYtd.gsTies .~)
-- | Prompt to edit a goalie's lifetime games played
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
:: 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
:: 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
:: 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
:: 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 = 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 .~)

View File

@@ -0,0 +1,125 @@
{- |
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.Prompt.EditPlayer
( editPlayerNumPrompt
, editPlayerNamePrompt
, editPlayerPosPrompt
, editPlayerYtdGoalsPrompt
, editPlayerYtdAssistsPrompt
, editPlayerYtdPMinPrompt
, editPlayerLtGoalsPrompt
, editPlayerLtAssistsPrompt
, editPlayerLtPMinPrompt
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompt to edit a player's number
editPlayerNumPrompt :: Prompt
editPlayerNumPrompt = editNum "Player number: " EPMenu
(pNumber .~)
-- | Prompt to edit a player's name
editPlayerNamePrompt :: Prompt
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 = 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
:: 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
:: 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 = editNum "Year-to-date penalty minutes: " EPYtd
(pYtd.psPMin .~)
-- | Prompt to edit a player's lifetime goals
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
:: 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 = editNum "Lifetime penalty minutes: " EPLifetime
(pLifetime.psPMin .~)
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 .~)

View File

@@ -0,0 +1,116 @@
{- |
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/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt.NewGame
( gameYearPrompt
, gameDayPrompt
, otherTeamPrompt
, homeScorePrompt
, awayScorePrompt
, recordGoalPrompt
, recordAssistPrompt
, pMinPlayerPrompt
, assignPMinsPrompt
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~))
import Mtlstats.Actions.NewGame
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
-- | Prompts for the other team name
otherTeamPrompt :: Prompt
otherTeamPrompt = ucStrPrompt "Other team: " $
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $ \score -> modify
$ overtimeCheck
. (progMode.gameStateL.awayScore ?~ score)
-- | Prompts for the player who scored the goal
recordGoalPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal number
-> Prompt
recordGoalPrompt game goal = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Who scored goal number " ++ show goal ++ "? "
) $ modify . (progMode.gameStateL.goalBy .~)
-- | Prompts for a player who assisted the goal
recordAssistPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal nuber
-> Int
-- ^ The assist number
-> Prompt
recordAssistPrompt game goal assist = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Goal: " ++ show goal ++ "\n"
++ "Assist #" ++ show assist ++ ": "
) $ \case
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
Just n -> do
modify $ progMode.gameStateL.assistsBy %~ (++[n])
nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-- | Prompts for the player to assign penalty minutes to
pMinPlayerPrompt :: Prompt
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-- | Prompts for the number of penalty mintues to assign to the player
assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins

View File

@@ -0,0 +1,53 @@
{- |
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/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt.NewGame.GoalieInput
( selectGameGoaliePrompt
, goalieMinsPlayedPrompt
, goalsAllowedPrompt
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((?~))
import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompts for a goalie who played in the game
selectGameGoaliePrompt :: Prompt
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
\case
Nothing -> modify finishGoalieEntry
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
-- | Prompts for the number of minutes the goalie has played
goalieMinsPlayedPrompt :: Prompt
goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~)
-- | Prompts for the number of goals the goalie allowed
goalsAllowedPrompt :: Prompt
goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
modify (progMode.gameStateL.gameGoalsAllowed ?~ n)
modify recordGoalieStats

View File

@@ -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
@@ -43,6 +47,8 @@ report width s
++ gameStatsReport width s
++ [""]
++ yearToDateStatsReport width s
++ [""]
++ lifetimeStatsReport width s
standingsReport :: Int -> ProgState -> [String]
standingsReport width s = fromMaybe [] $ do
@@ -58,7 +64,8 @@ standingsReport width s = fromMaybe [] $ do
tStats = addGameStats hStats aStats
hScore <- gs^.homeScore
aScore <- gs^.awayScore
Just
let
rHeader =
[ overlay
("GAME NUMBER " ++ padNum 2 gNum)
(centre width
@@ -67,98 +74,259 @@ standingsReport width s = fromMaybe [] $ do
, 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
]
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 = 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
year <- show <$> gs^.gameYear
month <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay
Just $ month ++ " " ++ day ++ " " ++ year
y <- show <$> gs^.gameYear
m <- month <$> gs^.gameMonth
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

View File

@@ -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,6 +30,11 @@ module Mtlstats.Types (
GameState (..),
GameType (..),
CreatePlayerState (..),
CreateGoalieState (..),
EditPlayerState (..),
EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
Database (..),
Player (..),
PlayerStats (..),
@@ -37,6 +42,8 @@ module Mtlstats.Types (
GoalieStats (..),
GameStats (..),
Prompt (..),
SelectParams (..),
TableCell (..),
-- * Lenses
-- ** ProgState Lenses
database,
@@ -46,6 +53,9 @@ module Mtlstats.Types (
-- ** ProgMode Lenses
gameStateL,
createPlayerStateL,
createGoalieStateL,
editPlayerStateL,
editGoalieStateL,
-- ** GameState Lenses
gameYear,
gameMonth,
@@ -61,14 +71,31 @@ module Mtlstats.Types (
assistsBy,
gamePlayerStats,
confirmGoalDataFlag,
selectedPlayer,
pMinsRecorded,
gameSelectedPlayer,
gamePMinsRecorded,
gameGoalieStats,
gameSelectedGoalie,
gameGoalieMinsPlayed,
gameGoalsAllowed,
gameGoaliesRecorded,
gameGoalieAssigned,
-- ** CreatePlayerState Lenses
cpsNumber,
cpsName,
cpsPosition,
cpsSuccessCallback,
cpsFailureCallback,
-- ** CreateGoalieState Lenses
cgsNumber,
cgsName,
cgsSuccessCallback,
cgsFailureCallback,
-- ** EditPlayerState Lenses
epsSelectedPlayer,
epsMode,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
-- ** Database Lenses
dbPlayers,
dbGoalies,
@@ -79,6 +106,7 @@ module Mtlstats.Types (
pNumber,
pName,
pPosition,
pRookie,
pYtd,
pLifetime,
-- ** PlayerStats Lenses
@@ -88,13 +116,14 @@ module Mtlstats.Types (
-- ** Goalie Lenses
gNumber,
gName,
gRookie,
gYtd,
gLifetime,
-- ** GoalieStats Lenses
gsGames,
gsMinsPlayed,
gsGoalsAllowed,
gsGoalsAgainst,
gsShutouts,
gsWins,
gsLosses,
gsTies,
@@ -108,6 +137,9 @@ module Mtlstats.Types (
newProgState,
newGameState,
newCreatePlayerState,
newCreateGoalieState,
newEditPlayerState,
newEditGoalieState,
newDatabase,
newPlayer,
newPlayerStats,
@@ -136,7 +168,15 @@ module Mtlstats.Types (
playerIsActive,
-- ** PlayerStats Helpers
psPoints,
addPlayerStats
addPlayerStats,
-- ** Goalie Helpers
goalieSearch,
goalieSearchExact,
goalieSummary,
goalieIsActive,
-- ** GoalieStats Helpers
addGoalieStats,
gsAverage
) where
import Control.Monad.Trans.State (StateT)
@@ -150,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)
@@ -189,13 +232,21 @@ data ProgMode
= MainMenu
| NewSeason
| NewGame GameState
| EditMenu
| CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState
| EditGoalie EditGoalieState
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"
show (EditGoalie _) = "EditGoalie"
-- | The game state
data GameState = GameState
@@ -229,10 +280,25 @@ data GameState = GameState
-- ^ The player stats accumulated over the game
, _confirmGoalDataFlag :: Bool
-- ^ Set when the user confirms the goal data
, _selectedPlayer :: Maybe Int
, _gameSelectedPlayer :: Maybe Int
-- ^ Index number of the selected 'Player'
, _pMinsRecorded :: Bool
, _gamePMinsRecorded :: Bool
-- ^ Set when the penalty mintes have been recorded
, _gameGoalieStats :: M.Map Int GoalieStats
-- ^ The goalie stats accumulated over the game
, _gameSelectedGoalie :: Maybe Int
-- ^ Index number of the selected 'Goalie'
, _gameGoalieMinsPlayed :: Maybe Int
-- ^ The number of minutes the currently selected goalie played in
-- the game
, _gameGoalsAllowed :: Maybe Int
-- ^ The number of goals the currently selected goalie allowed in
-- the game
, _gameGoaliesRecorded :: Bool
-- ^ Set when the user confirms that all goalie info has been entered
, _gameGoalieAssigned :: Bool
-- ^ Set to 'True' when the goalie has been selected who will be
-- given the win/loss/tie
} deriving (Eq, Show)
-- | The type of game
@@ -255,6 +321,72 @@ data CreatePlayerState = CreatePlayerState
-- ^ The function to call on failure
}
-- | Goalie creation status
data CreateGoalieState = CreateGoalieState
{ _cgsNumber :: Maybe Int
-- ^ The goalie's number
, _cgsName :: String
-- ^ The goalie's name
, _cgsSuccessCallback :: Action ()
-- ^ The function to call on success
, _cgsFailureCallback :: Action ()
-- ^ The function to call on failure
}
-- | Player edit status
data EditPlayerState = EditPlayerState
{ _epsSelectedPlayer :: Maybe Int
-- ^ The index number of the player being edited
, _epsMode :: EditPlayerMode
-- ^ The editing mode
}
-- | Player editing mode
data EditPlayerMode
= EPMenu
| EPNumber
| EPName
| EPPosition
| EPYtd
| EPLifetime
| EPYtdGoals Bool
| EPYtdAssists Bool
| EPYtdPMin
| EPLtGoals Bool
| EPLtAssists Bool
| EPLtPMin
deriving (Eq, Show)
-- | 'Goalie' edit status
data EditGoalieState = EditGoalieState
{ _egsSelectedGoalie :: Maybe Int
-- ^ The index number of the 'Goalie' being edited
, _egsMode :: EditGoalieMode
}
-- | 'Goalie' editing mode
data EditGoalieMode
= EGMenu
| EGNumber
| EGName
| EGYtd
| EGLifetime
| EGYtdGames Bool
| EGYtdMins Bool
| EGYtdGoals Bool
| EGYtdShutouts Bool
| EGYtdWins Bool
| EGYtdLosses Bool
| EGYtdTies
| EGLtGames Bool
| EGLtMins Bool
| EGLtGoals Bool
| EGLtShutouts Bool
| EGLtWins Bool
| EGLtLosses Bool
| EGLtTies
deriving (Eq, Show)
-- | Represents the database
data Database = Database
{ _dbPlayers :: [Player]
@@ -269,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
@@ -292,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 .:? "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
@@ -356,99 +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 .:? "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
, _gsGoalsAgainst :: Int
-- ^ The number of goals against
, _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 .: "goals_against"
<*> 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 al ag w l t) = object
toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g
, "mins_played" .= m
, "goals_allowed" .= al
, "goals_against" .= ag
, "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w
, "losses" .= l
, "ties" .= t
]
toEncoding (GoalieStats g m al ag w l t) = pairs $
toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <>
"mins_played" .= m <>
"goals_allowed" .= al <>
"goals_against" .= ag <>
"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"
@@ -472,28 +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 thr 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
}
makeLenses ''ProgState
makeLenses ''GameState
makeLenses ''CreatePlayerState
makeLenses ''Database
makeLenses ''Player
makeLenses ''PlayerStats
makeLenses ''Goalie
makeLenses ''GoalieStats
makeLenses ''GameStats
gameStateL :: Lens' ProgMode GameState
gameStateL = lens
(\case
@@ -508,6 +681,27 @@ createPlayerStateL = lens
_ -> newCreatePlayerState)
(\_ cps -> CreatePlayer cps)
createGoalieStateL :: Lens' ProgMode CreateGoalieState
createGoalieStateL = lens
(\case
CreateGoalie cgs -> cgs
_ -> newCreateGoalieState)
(\_ cgs -> CreateGoalie cgs)
editPlayerStateL :: Lens' ProgMode EditPlayerState
editPlayerStateL = lens
(\case
EditPlayer eps -> eps
_ -> newEditPlayerState)
(\_ eps -> EditPlayer eps)
editGoalieStateL :: Lens' ProgMode EditGoalieState
editGoalieStateL = lens
(\case
EditGoalie egs -> egs
_ -> newEditGoalieState)
(\_ egs -> EditGoalie egs)
-- | Constructor for a 'ProgState'
newProgState :: ProgState
newProgState = ProgState
@@ -534,8 +728,14 @@ newGameState = GameState
, _assistsBy = []
, _gamePlayerStats = M.empty
, _confirmGoalDataFlag = False
, _selectedPlayer = Nothing
, _pMinsRecorded = False
, _gameSelectedPlayer = Nothing
, _gamePMinsRecorded = False
, _gameGoalieStats = M.empty
, _gameSelectedGoalie = Nothing
, _gameGoalieMinsPlayed = Nothing
, _gameGoalsAllowed = Nothing
, _gameGoaliesRecorded = False
, _gameGoalieAssigned = False
}
-- | Constructor for a 'CreatePlayerState'
@@ -548,6 +748,29 @@ newCreatePlayerState = CreatePlayerState
, _cpsFailureCallback = return ()
}
-- | Constructor for a 'CreateGoalieState'
newCreateGoalieState :: CreateGoalieState
newCreateGoalieState = CreateGoalieState
{ _cgsNumber = Nothing
, _cgsName = ""
, _cgsSuccessCallback = return ()
, _cgsFailureCallback = return ()
}
-- | Constructor for an 'EditPlayerState'
newEditPlayerState :: EditPlayerState
newEditPlayerState = EditPlayerState
{ _epsSelectedPlayer = Nothing
, _epsMode = EPMenu
}
-- | Constructor for an 'EditGoalieState' value
newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing
, _egsMode = EGMenu
}
-- | Constructor for a 'Database'
newDatabase :: Database
newDatabase = Database
@@ -571,6 +794,7 @@ newPlayer num name pos = Player
{ _pNumber = num
, _pName = name
, _pPosition = pos
, _pRookie = True
, _pYtd = newPlayerStats
, _pLifetime = newPlayerStats
}
@@ -593,6 +817,7 @@ newGoalie
newGoalie num name = Goalie
{ _gNumber = num
, _gName = name
, _gRookie = True
, _gYtd = newGoalieStats
, _gLifetime = newGoalieStats
}
@@ -603,7 +828,7 @@ newGoalieStats = GoalieStats
{ _gsGames = 0
, _gsMinsPlayed = 0
, _gsGoalsAllowed = 0
, _gsGoalsAgainst = 0
, _gsShutouts = 0
, _gsWins = 0
, _gsLosses = 0
, _gsTies = 0
@@ -699,9 +924,8 @@ playerSearch
-> [(Int, Player)]
-- ^ The matching players with their index numbers
playerSearch sStr =
filter (match sStr) .
zip [0..]
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
filter match . zip [0..]
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
-- | Searches for a player by exact match on name
playerSearchExact
@@ -712,10 +936,8 @@ playerSearchExact
-> Maybe (Int, Player)
-- ^ The player's index and value
playerSearchExact sStr =
listToMaybe .
filter (match sStr) .
zip [0..]
where match sStr (_, p) = p^.pName == sStr
listToMaybe . filter match . zip [0..]
where match (_, p) = p^.pName == sStr
-- | Modifies a player with a given name
modifyPlayer
@@ -757,3 +979,61 @@ addPlayerStats s1 s2 = newPlayerStats
& psGoals .~ s1^.psGoals + s2^.psGoals
& psAssists .~ s1^.psAssists + s2^.psAssists
& psPMin .~ s1^.psPMin + s2^.psPMin
-- | Searches a list of goalies
goalieSearch
:: String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> [(Int, Goalie)]
-- ^ The search results with their corresponding index numbers
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
:: String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> Maybe (Int, Goalie)
-- ^ The result with its index number
goalieSearchExact sStr goalies = let
results = filter (\(_, goalie) -> sStr == goalie^.gName) $
zip [0..] goalies
in case results of
[] -> Nothing
result:_ -> Just result
-- | 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

View File

@@ -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 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses)
import qualified UI.NCurses as C
import Mtlstats.Types

View File

@@ -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

View File

@@ -0,0 +1,291 @@
{-
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 Actions.NewGame.GoalieInputSpec (spec) where
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
import qualified TypesSpec as TS
spec :: Spec
spec = describe "Mtlstats.Actions.GoalieInput" $ do
finishGoalieEntrySpec
recordGoalieStatsSpec
setGameGoalieSpec
finishGoalieEntrySpec :: Spec
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
let
progState stats = newProgState
& progMode.gameStateL.gameGoalieStats .~ stats
& finishGoalieEntry
context "no goalie data" $
it "should not set goaliesRecorded" $ let
s = progState M.empty
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
context "goalie data" $
it "should set goaliesRecorded" $ let
s = progState $ M.fromList [(1, newGoalieStats)]
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
recordGoalieStatsSpec :: Spec
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
goalieStats games mins goals = newGoalieStats
& gsGames .~ games
& gsMinsPlayed .~ mins
& gsGoalsAllowed .~ goals
joe = newGoalie 2 "Joe"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
bob = newGoalie 3 "Bob"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
gameState n mins goals = newGameState
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)]
& gameSelectedGoalie .~ n
& gameGoalieMinsPlayed .~ mins
& gameGoalsAllowed .~ goals
progState n mins goals = newProgState
& database.dbGoalies .~ [joe, bob]
& progMode.gameStateL .~ gameState n mins goals
in mapM_
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
s = recordGoalieStats $ progState setGid mins goals
in context setName $ do
mapM_
(\( chkName
, chkGid
, ( gGames
, gMins
, gGoals
, ytdGames
, ytdMins
, ytdGoals
, ltGames
, ltMins
, ltGoals
)
) -> context chkName $ do
let
gs = s^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats chkGid gs
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
ytd = goalie^.gYtd
lt = goalie^.gLifetime
context "game" $
game `TS.compareTest` goalieStats gGames gMins gGoals
context "year-to-date" $
ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
context "lifetime" $
lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
[ ( "checking Joe", 0, joeData )
, ( "checking Bob", 1, bobData )
]
context "selected goalie" $ let
expected = if reset then Nothing else setGid
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
context "minutes played" $ let
expected = if reset then Nothing else mins
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
context "goals allowed" $ let
expected = if reset then Nothing else goals
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
[ ( "updating Joe"
, Just 0
, Just 1
, Just 2
, (1, 1, 2, 11, 12, 14, 21, 22, 24)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, True
)
, ( "updating Bob"
, Just 1
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 3, 5, 30, 32, 34, 40, 42, 44)
, True
)
, ( "goalie out of bounds"
, Just 2
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing goalie"
, Nothing
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing minutes"
, Just 0
, Nothing
, Just 1
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing goals"
, Just 0
, Just 1
, Nothing
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
]
setGameGoalieSpec :: Spec
setGameGoalieSpec = describe "setGameGoalie" $ let
goalieStats w l t = newGoalieStats
& gsWins .~ w
& gsLosses .~ l
& gsTies .~ t
bob = newGoalie 2 "Bob"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
joe = newGoalie 3 "Joe"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
gameState h a ot = newGameState
& gameType ?~ HomeGame
& homeScore ?~ h
& awayScore ?~ a
& overtimeFlag ?~ ot
winningGame = gameState 1 0 False
losingGame = gameState 0 1 False
tiedGame = gameState 0 1 True
in mapM_
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
progState = newProgState
& database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gs
& setGameGoalie setGid
in mapM_
(\( chkLabel
, chkGid
, ( gWins
, gLosses
, gTies
, ytdWins
, ytdLosses
, ytdTies
, ltWins
, ltLosses
, ltTies
)
) -> context chkLabel $ do
let
goalie = (progState^.database.dbGoalies) !! chkGid
gameStats = progState^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats chkGid gameStats
ytd = goalie^.gYtd
lifetime = goalie^.gLifetime
mapM_
(\(label', expected, actual) -> context label' $
expected `TS.compareTest` actual)
[ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
]
it "should set the gameGoalieAssigned flag" $
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
[ ( "checking Bob", 0, bobData )
, ( "checking Joe", 1, joeData )
])
[ ( "Bob wins"
, winningGame
, 0
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob loses"
, losingGame
, 0
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob ties"
, tiedGame
, 0
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Joe wins"
, winningGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
)
, ( "Joe loses"
, losingGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
)
, ( "Joe ties"
, tiedGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
)
]

526
test/Actions/NewGameSpec.hs Normal file
View File

@@ -0,0 +1,526 @@
{-
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 Actions.NewGameSpec (spec) where
import Control.Monad (replicateM)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
import Mtlstats.Actions.NewGame
import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
import qualified TypesSpec as TS
spec :: Spec
spec = describe "NewGame" $ do
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
recordGoalAssistsSpec
awardGoalSpec
awardAssistSpec
resetGoalDataSpec
assignPMinsSpec
awardShutoutsSpec
GoalieInput.spec
overtimeCheckSpec :: Spec
overtimeCheckSpec = describe "overtimeCheck" $ do
context "tie game" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 1)
& overtimeCheck
it "should clear the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
it "should clear the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
it "should leave the overtimeFlag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
context "game won" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 2)
. (awayScore ?~ 1)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
it "should set the overtimeCheck flag to False" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
context "game lost" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 2)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
it "should leave the overtimeCheck flag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
updateGameStatsSpec :: Spec
updateGameStatsSpec = describe "updateGameStats" $ do
let
baseStats = newGameStats
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
& gmsGoalsFor .~ 1
& gmsGoalsAgainst .~ 1
s t h a o = newProgState
& progMode.gameStateL
%~ (gameType .~ t)
. (homeScore .~ h)
. (awayScore .~ a)
. (overtimeFlag .~ o)
& database
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho hf ha aw al ao af aa = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
. (gmsGoalsFor .~ hf)
. (gmsGoalsAgainst .~ ha)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
. (gmsGoalsFor .~ af)
. (gmsGoalsAgainst .~ aa)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
context "home overtime loss" $
it "should record a home overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
context "away overtime loss" $
it "should record an away overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do
context "valid date" $
it "should leave the date unchanged" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 6)
. (gameDay ?~ 25)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
context "invalid date" $
it "should clear the date" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 2)
. (gameDay ?~ 30)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
context "missing day" $
it "should not change anything" $ do
let
gs = newGameState
& gameYear ?~ 2019
& gameMonth ?~ 6
s = newProgState
& progMode.gameStateL .~ gs
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
recordGoalAssistsSpec :: Spec
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
let
joe = newPlayer 1 "Joe" "centre"
bob = newPlayer 2 "Bob" "defense"
steve = newPlayer 3 "Steve" "forward"
dave = newPlayer 4 "Dave" "somewhere"
frank = newPlayer 5 "Frank" "elsewhere"
ps
= newProgState
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
& progMode.gameStateL
%~ (goalBy ?~ 0)
. (assistsBy .~ [1, 2])
. (confirmGoalDataFlag .~ True)
& recordGoalAssists
mapM_
(\(name, n, goals, assists) -> context name $ do
let
player = (ps^.database.dbPlayers) !! n
stats = M.findWithDefault newPlayerStats n $
ps^.progMode.gameStateL.gamePlayerStats
it ("should set the year-to-date goals to " ++ show goals) $
player^.pYtd.psGoals `shouldBe` goals
it ("should set the lifetime goals to " ++ show goals) $
player^.pLifetime.psGoals `shouldBe` goals
it ("should set the game goals to " ++ show goals) $
stats^.psAssists `shouldBe` assists
it ("should set the year-to-date assists to " ++ show assists) $
player^.pYtd.psAssists `shouldBe` assists
it ("should set the lifetime assists to " ++ show assists) $
player^.pLifetime.psAssists `shouldBe` assists
it ("should set the game assists to " ++ show assists) $
stats^.psAssists `shouldBe` assists)
-- name, index, goals, assists
[ ( "Joe", 0, 1, 0 )
, ( "Bob", 1, 0, 1 )
, ( "Steve", 2, 0, 1 )
, ( "Dave", 3, 0, 0 )
]
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assistsBy list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should increment the pointsAccounted counter" $
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
it "should clear the confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
awardGoalSpec :: Spec
awardGoalSpec = describe "awardGoal" $ do
let
joe
= newPlayer 2 "Joe" "centre"
& pYtd.psGoals .~ 1
& pLifetime.psGoals .~ 2
bob
= newPlayer 3 "Bob" "defense"
& pYtd.psGoals .~ 3
& pLifetime.psGoals .~ 4
db
= newDatabase
& dbPlayers .~ [joe, bob]
joeStats
= newPlayerStats
& psGoals .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database .~ db
mapM_
(\(name, pid, ytd, lt, game) ->
context name $ do
let
ps' = awardGoal pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ name ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` ytd
it ("should increment " ++ name ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` lt
it ("should increment " ++ name ++ "'s game goals") $
gStats^.psGoals `shouldBe` game)
-- player name, player id, ytd goals, lifetime goals, game goals
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardGoal 2 ps
in it "should not change the database" $
ps'^.database `shouldBe` db
context "negative index" $ let
ps' = awardGoal (-1) ps
in it "should not change the database" $
ps'^.database `shouldBe` db
awardAssistSpec :: Spec
awardAssistSpec = describe "awardAssist" $ do
let
joe
= newPlayer 1 "Joe" "centre"
& pYtd.psAssists .~ 1
& pLifetime.psAssists .~ 2
bob
= newPlayer 2 "Bob" "defense"
& pYtd.psAssists .~ 3
& pLifetime.psAssists .~ 4
joeStats
= newPlayerStats
& psAssists .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database.dbPlayers .~ [joe, bob]
mapM_
(\(name, pid, ytd, lt, game) ->
context name $ do
let
ps' = awardAssist pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ name ++ "'s year-to-date assists") $
player^.pYtd.psAssists `shouldBe` ytd
it ("should increment " ++ name ++ "'s lifetime assists") $
player^.pLifetime.psAssists `shouldBe` lt
it ("should increment " ++ name ++ "'s game assists") $
gStats^.psAssists `shouldBe` game)
-- player name, player id, ytd assists, lifetime assists, game assists
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardAssist (-1) ps
in it "should not change anything" $
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
resetGoalDataSpec :: Spec
resetGoalDataSpec = describe "resetGoalData" $ do
players <- runIO $ replicateM 5 TS.makePlayer
let
gs
= newGameState
& goalBy ?~ 1
& assistsBy .~ [2, 3]
& confirmGoalDataFlag .~ True
ps
= newProgState
& database.dbPlayers .~ players
& progMode.gameStateL .~ gs
& resetGoalData
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assists by list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should clear confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
assignPMinsSpec :: Spec
assignPMinsSpec = describe "assignPMins" $ let
bob = newPlayer 2 "Bob" "centre"
& pYtd.psPMin .~ 3
& pLifetime.psPMin .~ 4
joe = newPlayer 3 "Joe" "defense"
& pYtd.psPMin .~ 5
& pLifetime.psPMin .~ 6
ps pid = newProgState
& database.dbPlayers .~ [bob, joe]
& progMode.gameStateL
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
. (gameSelectedPlayer .~ pid)
in mapM_
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
context ("selectedPlayer = " ++ show pid) $ do
let ps' = assignPMins 2 $ ps pid
mapM_
(\(name, pid', lt, ytd, game) -> context name $ do
let
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
gStats = ps'^.progMode.gameStateL.gamePlayerStats
pStats = M.findWithDefault newPlayerStats pid' gStats
context "lifetime penalty minutes" $
it ("should be " ++ show lt) $
player^.pLifetime.psPMin `shouldBe` lt
context "year-to-date penalty minutes" $
it ("should be " ++ show ytd) $
player^.pYtd.psPMin `shouldBe` ytd
context "game penalty minutes" $
it ("should be " ++ show game) $
pStats^.psPMin `shouldBe` game)
-- name, index, lifetime, ytd, game
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
, ( "Joe", 1, joeLt, joeYtd, joeGame )
]
it "should set selectedPlayer to Nothing" $
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
, ( Just 1, 4, 3, 2, 8, 7, 2 )
, ( 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 )
]

View File

@@ -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,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where
import Control.Monad (replicateM)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO)
import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec
( Spec
, context
, describe
, it
, runIO
, shouldBe
, shouldNotBe
, shouldSatisfy
@@ -41,28 +37,33 @@ import Test.Hspec
import Mtlstats.Actions
import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.NewGameSpec as NewGame
import qualified TypesSpec as TS
spec :: Spec
spec = describe "Mtlstats.Actions" $ do
startNewSeasonSpec
startNewGameSpec
resetYtdSpec
resetStandingsSpec
addCharSpec
removeCharSpec
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
createPlayerSpec
createGoalieSpec
editSpec
editPlayerSpec
editSelectedPlayerSpec
editGoalieSpec
editSelectedGoalieSpec
addPlayerSpec
recordGoalAssistsSpec
awardGoalSpec
awardAssistSpec
resetGoalDataSpec
assignPMinsSpec
addGoalieSpec
resetCreatePlayerStateSpec
resetCreateGoalieStateSpec
backHomeSpec
scrollUpSpec
scrollDownSpec
NewGame.spec
startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do
@@ -90,8 +91,8 @@ startNewGameSpec = describe "startNewGame" $ do
resetYtdSpec :: Spec
resetYtdSpec = describe "resetYtd" $
it "should reset the year-to-date stats for all players" $ do
ps <- replicateM 2 makePlayer
gs <- replicateM 2 makeGoalie
ps <- replicateM 2 TS.makePlayer
gs <- replicateM 2 TS.makeGoalie
let
s = newProgState
& database . dbPlayers .~ ps
@@ -117,19 +118,52 @@ resetYtdSpec = describe "resetYtd" $
ytd ^. gsGames `shouldBe` 0
ytd ^. gsMinsPlayed `shouldBe` 0
ytd ^. gsGoalsAllowed `shouldBe` 0
ytd ^. gsGoalsAgainst `shouldBe` 0
ytd ^. gsWins `shouldBe` 0
ytd ^. gsLosses `shouldBe` 0
ytd ^. gsTies `shouldBe` 0
lt ^. gsGames `shouldNotBe` 0
lt ^. gsMinsPlayed `shouldNotBe` 0
lt ^. gsGoalsAllowed `shouldNotBe` 0
lt ^. gsGoalsAgainst `shouldNotBe` 0
lt ^. gsWins `shouldNotBe` 0
lt ^. gsLosses `shouldNotBe` 0
lt ^. gsTies `shouldNotBe` 0) $
s ^. database . dbGoalies
resetStandingsSpec :: Spec
resetStandingsSpec = describe "resetStandings" $ do
let
home = GameStats
{ _gmsWins = 1
, _gmsLosses = 2
, _gmsOvertime = 3
, _gmsGoalsFor = 4
, _gmsGoalsAgainst = 5
}
away = GameStats
{ _gmsWins = 6
, _gmsLosses = 7
, _gmsOvertime = 8
, _gmsGoalsFor = 9
, _gmsGoalsAgainst = 10
}
db = newDatabase
& dbHomeGameStats .~ home
& dbAwayGameStats .~ away
ps = newProgState
& database .~ db
& resetStandings
context "home standings" $
it "should be reset" $
ps^.database.dbHomeGameStats `shouldBe` newGameStats
context "away standings" $
it "should be reset" $
ps^.database.dbAwayGameStats `shouldBe` newGameStats
addCharSpec :: Spec
addCharSpec = describe "addChar" $
it "should add the character to the input buffer" $ let
@@ -153,208 +187,88 @@ removeCharSpec = describe "removeChar" $ do
& removeChar
in s ^. inputBuffer `shouldBe` "fo"
overtimeCheckSpec = describe "overtimeCheck" $ do
context "tie game" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 1)
& overtimeCheck
it "should clear the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
it "should clear the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
it "should leave the overtimeFlag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
context "game won" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 2)
. (awayScore ?~ 1)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
it "should set the overtimeCheck flag to False" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
context "game lost" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 2)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
it "should leave the overtimeCheck flag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
updateGameStatsSpec :: Spec
updateGameStatsSpec = describe "updateGameStats" $ do
let
baseStats = newGameStats
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
& gmsGoalsFor .~ 1
& gmsGoalsAgainst .~ 1
s t h a o = newProgState
& progMode.gameStateL
%~ (gameType .~ t)
. (homeScore .~ h)
. (awayScore .~ a)
. (overtimeFlag .~ o)
& database
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho hf ha aw al ao af aa = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
. (gmsGoalsFor .~ hf)
. (gmsGoalsAgainst .~ ha)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
. (gmsGoalsFor .~ af)
. (gmsGoalsAgainst .~ aa)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
context "home overtime loss" $
it "should record a home overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
context "away overtime loss" $
it "should record an away overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do
context "valid date" $
it "should leave the date unchanged" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 6)
. (gameDay ?~ 25)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
context "invalid date" $
it "should clear the date" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 2)
. (gameDay ?~ 30)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
context "missing day" $
it "should not change anything" $ do
let
gs = newGameState
& gameYear ?~ 2019
& gameMonth ?~ 6
s = newProgState
& progMode.gameStateL .~ gs
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
createPlayerSpec :: Spec
createPlayerSpec = describe "createPlayer" $
it "should change the mode appropriately" $ let
s = createPlayer newProgState
in show (s^.progMode) `shouldBe` "CreatePlayer"
createGoalieSpec :: Spec
createGoalieSpec = describe "createGoalie" $
it "should change the mode appropriately" $ let
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
@@ -379,281 +293,47 @@ addPlayerSpec = describe "addPlayer" $ do
s' = addPlayer $ s MainMenu
in s'^.database.dbPlayers `shouldBe` [p1]
recordGoalAssistsSpec :: Spec
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
addGoalieSpec :: Spec
addGoalieSpec = describe "addGoalie" $ do
let
joe = newPlayer 1 "Joe" "centre"
bob = newPlayer 2 "Bob" "defense"
steve = newPlayer 3 "Steve" "forward"
dave = newPlayer 4 "Dave" "somewhere"
frank = newPlayer 5 "Frank" "elsewhere"
ps
= newProgState
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
& progMode.gameStateL
%~ (goalBy ?~ 0)
. (assistsBy .~ [1, 2])
. (confirmGoalDataFlag .~ True)
& recordGoalAssists
mapM_
(\(name, n, goals, assists) -> context name $ do
let
player = (ps^.database.dbPlayers) !! n
stats = M.findWithDefault newPlayerStats n $
ps^.progMode.gameStateL.gamePlayerStats
it ("should set the year-to-date goals to " ++ show goals) $
player^.pYtd.psGoals `shouldBe` goals
it ("should set the lifetime goals to " ++ show goals) $
player^.pLifetime.psGoals `shouldBe` goals
it ("should set the game goals to " ++ show goals) $
stats^.psAssists `shouldBe` assists
it ("should set the year-to-date assists to " ++ show assists) $
player^.pYtd.psAssists `shouldBe` assists
it ("should set the lifetime assists to " ++ show assists) $
player^.pLifetime.psAssists `shouldBe` assists
it ("should set the game assists to " ++ show assists) $
stats^.psAssists `shouldBe` assists)
-- name, index, goals, assists
[ ( "Joe", 0, 1, 0 )
, ( "Bob", 1, 0, 1 )
, ( "Steve", 2, 0, 1 )
, ( "Dave", 3, 0, 0 )
]
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assistsBy list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should increment the pointsAccounted counter" $
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
it "should clear the confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
awardGoalSpec :: Spec
awardGoalSpec = describe "awardGoal" $ do
let
joe
= newPlayer 2 "Joe" "centre"
& pYtd.psGoals .~ 1
& pLifetime.psGoals .~ 2
bob
= newPlayer 3 "Bob" "defense"
& pYtd.psGoals .~ 3
& pLifetime.psGoals .~ 4
db
= newDatabase
& dbPlayers .~ [joe, bob]
joeStats
= newPlayerStats
& psGoals .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
g1 = newGoalie 2 "Joe"
g2 = newGoalie 3 "Bob"
db = newDatabase
& dbGoalies .~ [g1]
s pm = newProgState
& database .~ db
& progMode .~ pm
mapM_
(\(pName, pid, ytd, lt, game) ->
context pName $ do
let
ps' = awardGoal pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
context "data available" $
it "should create the goalie" $ let
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
& cgsNumber ?~ 3
& cgsName .~ "Bob"
in s'^.database.dbGoalies `shouldBe` [g1, g2]
it ("should increment " ++ pName ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` ytd
context "data unavailable" $
it "should not create the goalie" $ let
s' = addGoalie $ s MainMenu
in s'^.database.dbGoalies `shouldBe` [g1]
it ("should increment " ++ pName ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` lt
resetCreatePlayerStateSpec :: Spec
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
cps = newCreatePlayerState
& cpsNumber ?~ 1
& cpsName .~ "Joe"
& cpsPosition .~ "centre"
ps = resetCreatePlayerState $
newProgState & progMode.createPlayerStateL .~ cps
in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
it ("should increment " ++ pName ++ "'s game goals") $
gStats^.psGoals `shouldBe` game)
-- player name, player id, ytd goals, lifetime goals, game goals
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardGoal 2 ps
in it "should not change the database" $
ps'^.database `shouldBe` db
context "negative index" $ let
ps' = awardGoal (-1) ps
in it "should not change the database" $
ps'^.database `shouldBe` db
awardAssistSpec :: Spec
awardAssistSpec = describe "awardAssist" $ do
let
joe
= newPlayer 1 "Joe" "centre"
& pYtd.psAssists .~ 1
& pLifetime.psAssists .~ 2
bob
= newPlayer 2 "Bob" "defense"
& pYtd.psAssists .~ 3
& pLifetime.psAssists .~ 4
joeStats
= newPlayerStats
& psAssists .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database.dbPlayers .~ [joe, bob]
mapM_
(\(pName, pid, ytd, lt, game) ->
context pName $ do
let
ps' = awardAssist pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ pName ++ "'s year-to-date assists") $
player^.pYtd.psAssists `shouldBe` ytd
it ("should increment " ++ pName ++ "'s lifetime assists") $
player^.pLifetime.psAssists `shouldBe` lt
it ("should increment " ++ pName ++ "'s game assists") $
gStats^.psAssists `shouldBe` game)
-- player name, player id, ytd assists, lifetime assists, game assists
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardAssist (-1) ps
in it "should not change anything" $
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
resetGoalDataSpec :: Spec
resetGoalDataSpec = describe "resetGoalData" $ do
players <- runIO $ replicateM 5 makePlayer
let
gs
= newGameState
& goalBy ?~ 1
& assistsBy .~ [2, 3]
& confirmGoalDataFlag .~ True
ps
= newProgState
& database.dbPlayers .~ players
& progMode.gameStateL .~ gs
& resetGoalData
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assists by list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should clear confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
assignPMinsSpec :: Spec
assignPMinsSpec = describe "assignPMins" $ let
bob = newPlayer 2 "Bob" "centre"
& pYtd.psPMin .~ 3
& pLifetime.psPMin .~ 4
joe = newPlayer 3 "Joe" "defense"
& pYtd.psPMin .~ 5
& pLifetime.psPMin .~ 6
ps pid = newProgState
& database.dbPlayers .~ [bob, joe]
& progMode.gameStateL
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
. (selectedPlayer .~ pid)
in mapM_
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
context ("selectedPlayer = " ++ show pid) $ do
let ps' = assignPMins 2 $ ps pid
mapM_
(\(name, pid', lt, ytd, game) -> context name $ do
let
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
gStats = ps'^.progMode.gameStateL.gamePlayerStats
pStats = M.findWithDefault newPlayerStats pid' gStats
context "lifetime penalty minutes" $
it ("should be " ++ show lt) $
player^.pLifetime.psPMin `shouldBe` lt
context "year-to-date penalty minutes" $
it ("should be " ++ show ytd) $
player^.pYtd.psPMin `shouldBe` ytd
context "game penalty minutes" $
it ("should be " ++ show game) $
pStats^.psPMin `shouldBe` game)
-- name, index, lifetime, ytd, game
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
, ( "Joe", 1, joeLt, joeYtd, joeGame )
]
it "should set selectedPlayer to Nothing" $
ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing)
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
, ( Just 1, 4, 3, 2, 8, 7, 2 )
, ( Just 2, 4, 3, 2, 6, 5, 0 )
, ( Nothing, 4, 3, 2, 6, 5, 0 )
]
makePlayer :: IO Player
makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makePlayerStats
<*> makePlayerStats
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeGoalieStats
<*> makeGoalieStats
makePlayerStats :: IO PlayerStats
makePlayerStats = PlayerStats
<$> makeNum
<*> makeNum
<*> makeNum
makeGoalieStats :: IO GoalieStats
makeGoalieStats = GoalieStats
<$> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
makeNum :: IO Int
makeNum = randomRIO (1, 10)
makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z')
resetCreateGoalieStateSpec :: Spec
resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
cgs = newCreateGoalieState
& cgsNumber ?~ 1
& cgsName .~ "Joe"
ps = resetCreateGoalieState $
newProgState & progMode.createGoalieStateL .~ cgs
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
backHomeSpec :: Spec
backHomeSpec = describe "backHome" $ do
@@ -695,6 +375,7 @@ scrollUpSpec = describe "scrollUp" $ do
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 0
scrollDownSpec :: Spec
scrollDownSpec = describe "scrollDown" $
it "should increase the scroll offset" $ let
ps = newProgState & scrollOffset .~ 10

View File

@@ -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

View File

@@ -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

View 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

View 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
View 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

View File

@@ -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,16 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ReportSpec (spec) where
import Lens.Micro ((&), (?~), (%~))
import Lens.Micro ((&), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
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 )
]

View File

@@ -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

View File

@@ -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

View File

@@ -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,13 +21,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec (spec) where
module TypesSpec
( Comparable (..)
, spec
, makePlayer
, makeGoalie
, makePlayerStats
, makeGoalieStats
) where
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import Data.ByteString.Lazy (ByteString)
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomIO, randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config
@@ -35,6 +44,9 @@ import Mtlstats.Types
import qualified Types.MenuSpec as Menu
class Comparable a where
compareTest :: a -> a -> Spec
spec :: Spec
spec = describe "Mtlstats.Types" $ do
playerSpec
@@ -43,6 +55,9 @@ spec = describe "Mtlstats.Types" $ do
databaseSpec
gameStateLSpec
createPlayerStateLSpec
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
@@ -61,6 +76,12 @@ spec = describe "Mtlstats.Types" $ do
playerIsActiveSpec
psPointsSpec
addPlayerStatsSpec
goalieSearchSpec
goalieSearchExactSpec
goalieSummarySpec
goalieIsActiveSpec
addGoalieStatsSpec
gsAverageSpec
Menu.spec
playerSpec :: Spec
@@ -79,43 +100,96 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters
[ ( MainMenu, newGameState )
, ( NewGame $ gs HomeGame, gs HomeGame )
[ ( "missing state", MainMenu, newGameState )
, ( "home game", NewGame $ gs HomeGame, gs HomeGame )
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
]
-- setters
[ ( MainMenu, gs HomeGame )
, ( NewGame $ gs HomeGame, gs AwayGame )
, ( NewGame $ gs HomeGame, newGameState )
[ ( "set home", MainMenu, gs HomeGame )
, ( "home to away", NewGame $ gs HomeGame, gs AwayGame )
, ( "away to home", NewGame $ gs AwayGame, gs HomeGame )
, ( "clear home", NewGame $ gs HomeGame, newGameState )
, ( "clear away", NewGame $ gs AwayGame, newGameState )
]
where gs t = newGameState & gameType ?~ t
createPlayerStateLSpec :: Spec
createPlayerStateLSpec = describe "createPlayerStateL" $ do
context "getters" $ do
context "state missing" $ let
pm = MainMenu
cps = pm^.createPlayerStateL
in it "should not have a number" $
cps^.cpsNumber `shouldBe` Nothing
createPlayerStateLSpec = describe "createPlayerStateL" $
lensSpec createPlayerStateL
-- getters
[ ( "missing state", MainMenu, newCreatePlayerState )
, ( "with state", CreatePlayer cps1, cps1 )
]
-- setters
[ ( "missing state", MainMenu, cps1 )
, ( "change state", CreatePlayer cps1, cps2 )
, ( "clear state", CreatePlayer cps1, newCreatePlayerState )
]
where
cps1 = newCreatePlayerState
& cpsNumber ?~ 1
& cpsName .~ "Joe"
& cpsPosition .~ "centre"
cps2 = newCreatePlayerState
& cpsNumber ?~ 2
& cpsName .~ "Bob"
& cpsPosition .~ "defense"
context "existing state" $ let
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
cps = pm^.createPlayerStateL
in it "should have a number of 1" $
cps^.cpsNumber `shouldBe` Just 1
createGoalieStateLSpec :: Spec
createGoalieStateLSpec = describe "createGoalieStateL" $
lensSpec createGoalieStateL
-- getters
[ ( "missing state", MainMenu, newCreateGoalieState )
, ( "with state", CreateGoalie cgs1, cgs1 )
]
-- setters
[ ( "set state", MainMenu, cgs1 )
, ( "change state", CreateGoalie cgs1, cgs2 )
, ( "clear state", CreateGoalie cgs1, newCreateGoalieState )
]
where
cgs1 = newCreateGoalieState
& cgsNumber ?~ 1
& cgsName .~ "Joe"
cgs2 = newCreateGoalieState
& cgsNumber ?~ 2
& cgsName .~ "Bob"
context "setters" $ do
context "state missing" $ let
pm = MainMenu
pm' = pm & createPlayerStateL.cpsNumber ?~ 1
in it "should set the player number to 1" $
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
editPlayerStateLSpec :: Spec
editPlayerStateLSpec = describe "editPlayerStateL" $
lensSpec editPlayerStateL
-- getters
[ ( "missing state", MainMenu, newEditPlayerState )
, ( "withState", EditPlayer eps1, eps1 )
]
-- setters
[ ( "set state", MainMenu, eps1 )
, ( "change state", EditPlayer eps1, eps2 )
, ( "clear state", EditPlayer eps1, newEditPlayerState )
]
where
eps1 = newEditPlayerState
& epsSelectedPlayer ?~ 1
eps2 = newEditPlayerState
& epsSelectedPlayer ?~ 2
context "existing state" $ let
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
pm' = pm & createPlayerStateL.cpsNumber ?~ 2
in it "should set the player number to 2" $
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
editGoalieStateLSpec :: Spec
editGoalieStateLSpec = describe "editGoalieStateL" $
lensSpec editGoalieStateL
-- getters
[ ( "missing state", MainMenu, newEditGoalieState )
, ( "with state", EditGoalie egs1, egs1 )
]
-- setters
[ ( "set state", MainMenu, egs1 )
, ( "change state", EditGoalie egs1, egs2 )
, ( "clear state", EditGoalie egs1, newEditGoalieState )
]
where
egs1 = newEditGoalieState
& egsSelectedGoalie ?~ 1
egs2 = newEditGoalieState
& egsSelectedGoalie ?~ 2
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
@@ -177,27 +251,27 @@ jsonSpec x j = do
decode (encode x) `shouldBe` Just x
lensSpec
:: (Eq a, Show s, Show a)
:: Comparable a
=> Lens' s a
-> [(s, a)]
-> [(s, a)]
-> [(String, s, a)]
-> [(String, s, a)]
-> Spec
lensSpec l gs ss = do
lensSpec lens getters setters = do
context "getters" $ mapM_
(\(s, x) -> context (show s) $
it ("should be " ++ show x) $
s ^. l `shouldBe` x)
gs
(\(label, s, x) -> context label $
compareTest (s^.lens) x)
getters
context "setters" $ mapM_
(\(s, x) -> context (show s) $
it ("should set to " ++ show x) $
(s & l .~ x) ^. l `shouldBe` x)
ss
(\(label, s, x) -> context label $ let
s' = s & lens .~ x
in compareTest (s'^.lens) x)
setters
player :: Player
player = newPlayer 1 "Joe" "centre"
& pRookie .~ False
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
@@ -206,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 )
]
@@ -225,6 +300,7 @@ playerStatsJSON n = Object $ HM.fromList
goalie :: Goalie
goalie = newGoalie 1 "Joe"
& gRookie .~ False
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
@@ -232,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 )
]
@@ -241,7 +318,7 @@ goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
& gsGoalsAgainst .~ n + 3
& gsShutouts .~ n + 3
& gsWins .~ n + 4
& gsLosses .~ n + 5
& gsTies .~ n + 6
@@ -251,7 +328,7 @@ goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 )
, ( "goals_against", toJSON $ n + 3 )
, ( "shutouts", toJSON $ n + 3 )
, ( "wins", toJSON $ n + 4 )
, ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
@@ -518,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", [] )
@@ -540,10 +617,10 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
modifyPlayerSpec :: Spec
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
(\(pName, j, b, s) -> let
(\(name, j, b, s) -> let
modifier = pLifetime.psGoals .~ 1
players = modifyPlayer modifier pName [joe, bob, steve]
in context ("modify " ++ pName) $ do
players = modifyPlayer modifier name [joe, bob, steve]
in context ("modify " ++ name) $ do
context "Joe's lifetime goals" $
it ("should be " ++ show j) $
@@ -571,21 +648,21 @@ playerSummarySpec = describe "playerSummary" $
playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do
let
pState = newPlayerStats
pStats = newPlayerStats
& psGoals .~ 10
& psAssists .~ 11
& psPMin .~ 12
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
mapM_
(\(label, player', expected) -> context label $
(\(label, p', expected) -> context label $
it ("should be " ++ show expected) $
playerIsActive player' `shouldBe` expected)
playerIsActive p' `shouldBe` expected)
-- label, player, expected
[ ( "not active", player, False )
, ( "has goal", player & pYtd.psGoals .~ 1, True )
, ( "has assist", player & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
[ ( "not active", p, False )
, ( "has goal", p & pYtd.psGoals .~ 1, True )
, ( "has assist", p & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
]
psPointsSpec :: Spec
@@ -633,6 +710,128 @@ addPlayerStatsSpec = describe "addPlayerStats" $ do
it "should be 9" $
s3^.psPMin `shouldBe` 9
goalieSearchSpec :: Spec
goalieSearchSpec = describe "goalieSearch" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
context "partial match" $
it "should return Joe and Steve" $
goalieSearch "e" goalies `shouldBe` [result 0, result 2]
context "no match" $
it "should return an empty list" $
goalieSearch "x" goalies `shouldBe` []
context "exact match" $
it "should return Bob" $
goalieSearch "bob" goalies `shouldBe` [result 1]
goalieSearchExactSpec :: Spec
goalieSearchExactSpec = describe "goalieSearchExact" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
mapM_
(\(name, num) -> context name $
it ("should return " ++ name) $
goalieSearchExact name goalies `shouldBe` Just (result num))
-- name, num
[ ( "Joe", 0 )
, ( "Bob", 1 )
, ( "Steve", 2 )
]
context "Greg" $
it "should return Nothing" $
goalieSearchExact "Greg" goalies `shouldBe` Nothing
goalieSummarySpec :: Spec
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"
@@ -641,3 +840,116 @@ bob = newPlayer 3 "Bob" "defense"
steve :: Player
steve = newPlayer 5 "Steve" "forward"
-- | Creates a 'Player'
makePlayer :: IO Player
makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makeBool
<*> makePlayerStats
<*> makePlayerStats
-- | Creates a 'Goalie'
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeBool
<*> makeGoalieStats
<*> makeGoalieStats
-- | Creates a 'PlayerStats' value
makePlayerStats :: IO PlayerStats
makePlayerStats = PlayerStats
<$> makeNum
<*> makeNum
<*> makeNum
-- | Creates a 'GoalieStats' value
makeGoalieStats :: IO GoalieStats
makeGoalieStats = GoalieStats
<$> makeNum
<*> makeNum
<*> makeNum
<*> 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')
instance Comparable GoalieStats where
compareTest actual expected = mapM_
(\(name, lens) -> describe name $
it ("should be " ++ show (expected^.lens)) $
actual^.lens `shouldBe` expected^.lens)
-- name, lens
[ ( "gsGames", gsGames )
, ( "gsMinsPlayed", gsMinsPlayed )
, ( "gsGoalsAllowed", gsGoalsAllowed )
, ( "gsWins", gsWins )
, ( "gsLosses", gsLosses )
, ( "gsTies", gsTies )
]
instance Comparable GameState where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
instance Comparable CreatePlayerState where
compareTest actual expected = do
describe "cpsNumber" $
it ("should be " ++ show (expected^.cpsNumber)) $
actual^.cpsNumber `shouldBe` expected^.cpsNumber
describe "cpsName" $
it ("should be " ++ expected^.cpsName) $
actual^.cpsName `shouldBe` expected^.cpsName
describe "cpsPosition" $
it ("should be " ++ expected^.cpsPosition) $
actual^.cpsPosition `shouldBe` expected^.cpsPosition
instance Comparable EditPlayerState where
compareTest actual expected = do
describe "epsSelectedPlayer" $
it ("should be " ++ show (expected^.epsSelectedPlayer)) $
actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
describe "epsMode" $
it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` expected^.epsMode
instance Comparable EditGoalieState where
compareTest actual expected = do
describe "egsSelectedGoalie" $
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
describe "egsMode" $
it ("should be " ++ show (expected^.egsMode)) $
actual^.egsMode `shouldBe` expected^.egsMode
instance Comparable CreateGoalieState where
compareTest actual expected = do
describe "cgsNuber" $
it("should be " ++ show (expected^.cgsNumber)) $
actual^.cgsNumber `shouldBe` expected^.cgsNumber
describe "cgsName" $
it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName

View File

@@ -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_
@@ -49,18 +50,19 @@ nthSpec = describe "nth" $ mapM_
modifyNthSpec :: Spec
modifyNthSpec = describe "modifyNth" $ do
let list = [1, 2, 3] :: [Int]
context "in bounds" $
it "should modify the value" $
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
modifyNth 1 succ list `shouldBe` [1, 3, 3]
context "out of bounds" $
it "should not modify the value" $
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
modifyNth 3 succ list `shouldBe` [1, 2, 3]
context "negative index" $
it "should not modify the value" $
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
updateMapSpec :: Spec
updateMapSpec = describe "updateMap" $ do
@@ -68,7 +70,7 @@ updateMapSpec = describe "updateMap" $ do
input = M.fromList [(1, 2), (3, 5)]
context "key found" $ let
expected = M.fromList [(1, 3), (3, 5)]
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
in it "should update the value" $
updateMap 1 10 succ input `shouldBe` expected
@@ -79,7 +81,7 @@ updateMapSpec = describe "updateMap" $ do
sliceSpec :: Spec
sliceSpec = describe "slice" $ do
let list = [2, 4, 6, 8]
let list = [2, 4, 6, 8] :: [Int]
context "sublist" $
it "should return the sublist" $
@@ -92,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" )
]