232 Commits

Author SHA1 Message Date
Jonathan Lamothe
994087a0e6 version 0.11.0 2020-01-23 17:18:39 -05:00
Jonathan Lamothe
7fbeaac933 Merge pull request #66 from mtlstats/master-menu
Master menu
2020-01-22 21:53:09 -05:00
Jonathan Lamothe
de56f4f94d updated change log 2020-01-22 21:43:09 -05:00
Jonathan Lamothe
04ba17324e centre menus horizontally 2020-01-22 21:23:32 -05:00
Jonathan Lamothe
d6ae171dc8 pad menu selections to same width 2020-01-22 21:10:21 -05:00
Jonathan Lamothe
72b6f05700 changed menu style
...to be closer to the original program's menu style
2020-01-22 20:59:09 -05:00
Jonathan Lamothe
4c7a756c5e updated change log 2020-01-22 16:30:19 -05:00
Jonathan Lamothe
ea3ca4e578 Merge pull request #65 from mtlstats/title-screen
Title screen
2020-01-22 13:58:12 -05:00
Jonathan Lamothe
179a864cfa added header to title page 2020-01-22 13:48:34 -05:00
Jonathan Lamothe
f2b2ff3fef centred title screen 2020-01-22 13:43:58 -05:00
Jonathan Lamothe
9c2e2291c8 draw box around title 2020-01-22 08:49:13 -05:00
Jonathan Lamothe
abad72ce01 built basic title screen 2020-01-22 00:39:06 -05:00
Jonathan Lamothe
a9d4d3351f implemented title screen controller 2020-01-21 22:55:22 -05:00
Jonathan Lamothe
45aea607b2 added title screen logic branch 2020-01-21 22:20:01 -05:00
Jonathan Lamothe
be9d7d80bb updated change log 2020-01-16 22:16:20 -05:00
Jonathan Lamothe
683c36e2b6 Merge pull request #64 from mtlstats/edit-standings
Edit standings
2020-01-16 21:52:41 -05:00
Jonathan Lamothe
83c408cea2 implemented editing prompts 2020-01-16 21:46:35 -05:00
Jonathan Lamothe
dcbd68cdda implemented editHomeStandingsC and editAwayStandingsC 2020-01-16 21:10:14 -05:00
Jonathan Lamothe
717f2d5932 made standings table prettier 2020-01-16 19:58:07 -05:00
Jonathan Lamothe
d5de834510 implemented edit functions in Mtlstats.Actions.EditState module 2020-01-16 19:47:12 -05:00
Jonathan Lamothe
75a47ca852 implemented Mtlstats.Menu.EditStandings.subMenu 2020-01-16 17:54:05 -05:00
Jonathan Lamothe
d4de7c6f8b implemented editHomeStandings and editAwayStandings 2020-01-16 17:43:53 -05:00
Jonathan Lamothe
d50d055b0b implemented editHomeStandings and editAwayStandings 2020-01-16 17:17:24 -05:00
Jonathan Lamothe
9c7c295a4b implemented editAwayStandings 2020-01-16 15:00:08 -05:00
Jonathan Lamothe
49963277be implemented editHomeStandings 2020-01-16 12:42:33 -05:00
Jonathan Lamothe
264d9f81e2 moved editStandings to Mtlstats.Actions.EditStandings module 2020-01-16 00:03:31 -05:00
Jonathan Lamothe
6a0d1f7203 implemented editStandingsMenu 2020-01-15 23:21:37 -05:00
Jonathan Lamothe
18683c1c6e implemented Mtlstats.Control.EditStandings.valsFor 2020-01-15 01:05:45 -05:00
Jonathan Lamothe
107ed507e2 implemented Mtlstats.Control.EditStandings.header 2020-01-15 01:00:26 -05:00
Jonathan Lamothe
baf040deea implemented editStandingsC 2020-01-15 00:43:48 -05:00
Jonathan Lamothe
c3bac5e624 created Mtlstats.Control.EditStandings module 2020-01-15 00:34:45 -05:00
Jonathan Lamothe
119cb873eb implemented editStandings 2020-01-15 00:26:46 -05:00
Jonathan Lamothe
82603ba504 added "Edit Standings" to edit menu 2020-01-15 00:15:58 -05:00
Jonathan Lamothe
a909b9ba7a added EditStandings mode 2020-01-15 00:08:04 -05:00
Jonathan Lamothe
802bf7314e fixed formatting of change log 2020-01-14 23:33:39 -05:00
Jonathan Lamothe
a3124aca58 Merge pull request #63 from mtlstats/save-db
save a copy of the database on new season
2020-01-14 03:29:52 -05:00
Jonathan Lamothe
f113e46564 updated change log 2020-01-14 03:23:39 -05:00
Jonathan Lamothe
39646f3fa7 save a copy of the database on start of new season 2020-01-14 03:21:40 -05:00
Jonathan Lamothe
2bf8d15bd4 logic branch for database saving on new season 2020-01-14 02:42:30 -05:00
Jonathan Lamothe
3009a8f60c Merge pull request #62 from mtlstats/clear-rookies
clear rookies on new (regular) season
2020-01-11 02:39:41 -05:00
Jonathan Lamothe
3b4ce50ae8 clear rookies on new (regular) season 2020-01-11 02:30:09 -05:00
Jonathan Lamothe
fcfbcea72f Merge pull request #61 from mtlstats/active-col
Added active field to players/goalies
2020-01-11 01:59:51 -05:00
Jonathan Lamothe
d132ebd502 updated change log 2020-01-11 01:52:40 -05:00
Jonathan Lamothe
75cd253f3f allow user to toggle active flag for Player/Goalie 2020-01-11 01:49:27 -05:00
Jonathan Lamothe
063bebfbb5 test active field in JSON for Player/Goalie 2020-01-11 01:49:27 -05:00
Jonathan Lamothe
7923827d22 flag inactive goalies in goalieName 2020-01-11 01:49:27 -05:00
Jonathan Lamothe
461fb5d942 mark inactive players in playerName 2020-01-11 01:27:01 -05:00
Jonathan Lamothe
e38275aefe added active field to Player and Goalie 2020-01-11 01:21:16 -05:00
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
48 changed files with 4265 additions and 1642 deletions

View File

@@ -1,24 +1,60 @@
# Changelog for mtlstats # Changelog for mtlstats
## 0.5.0 ## 0.11.0
- Added active flag to players/goalies
- Clear rookie flag on new (regular) season
- Save a copy of the database on new season
- Implemented game standings editing
- Added title screen
- Changed sytling of menus
## 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 - Fixed player creation bug
- Prompt for goalie informaiton on game data entry - Prompt for goalie informaiton on game data entry
- Implemented player editing - Implemented player editing
## v0.4.0 ## v0.4.0
- Record penalty minutes - Record penalty minutes
- Calculate total game statistics - Calculate total game statistics
- Generate year-to-date statistics report - Generate year-to-date statistics report
## v0.3.0 ## v0.3.0
- Record goals and assists - Record goals and assists
- Track goals for and goals against - Track goals for and goals against
## v0.2.0 ## v0.2.0
- Overtime losses don't count in the loss column - Overtime losses don't count in the loss column
- Confirm game data with user before updating stats - Confirm game data with user before updating stats
- Implemented player creation - Implemented player creation

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -24,41 +24,48 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Actions module Mtlstats.Actions
( startNewSeason ( startNewSeason
, resetYtd , resetYtd
, clearRookies
, resetStandings
, startNewGame , startNewGame
, addChar , addChar
, removeChar , removeChar
, overtimeCheck
, updateGameStats
, validateGameDate
, createPlayer , createPlayer
, createGoalie , createGoalie
, edit
, editPlayer , editPlayer
, editSelectedPlayer
, editGoalie
, editSelectedGoalie
, addPlayer , addPlayer
, addGoalie , addGoalie
, resetCreatePlayerState , resetCreatePlayerState
, resetCreateGoalieState , resetCreateGoalieState
, recordGoalAssists
, awardGoal
, awardAssist
, resetGoalData
, assignPMins
, backHome , backHome
, scrollUp , scrollUp
, scrollDown , scrollDown
, saveDatabase
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid) import Lens.Micro ((^.), (&), (.~), (%~))
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~)) import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import Mtlstats.Config
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
-- | Starts a new season -- | Starts a new season
startNewSeason :: ProgState -> ProgState startNewSeason :: ProgState -> ProgState
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0) startNewSeason
= (progMode .~ NewSeason False)
. (database.dbGames .~ 0)
-- | Resets all players year-to-date stats -- | Resets all players year-to-date stats
resetYtd :: ProgState -> ProgState resetYtd :: ProgState -> ProgState
@@ -66,6 +73,18 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats)) = (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats)) . (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
-- | Clears the rookie flag from all players/goalies
clearRookies :: ProgState -> ProgState
clearRookies = database
%~ (dbPlayers %~ map (pRookie .~ False))
. (dbGoalies %~ map (gRookie .~ False))
-- | Resets game standings
resetStandings :: ProgState -> ProgState
resetStandings = database
%~ ( dbHomeGameStats .~ newGameStats)
. ( dbAwayGameStats .~ newGameStats)
-- | Starts a new game -- | Starts a new game
startNewGame :: ProgState -> ProgState startNewGame :: ProgState -> ProgState
startNewGame startNewGame
@@ -82,69 +101,10 @@ removeChar = inputBuffer %~ \case
"" -> "" "" -> ""
str -> init str 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 -- | Starts player creation mode
createPlayer :: ProgState -> ProgState createPlayer :: ProgState -> ProgState
createPlayer = let createPlayer = let
callback = modify $ progMode .~ MainMenu callback = modify edit
cps = newCreatePlayerState cps = newCreatePlayerState
& cpsSuccessCallback .~ callback & cpsSuccessCallback .~ callback
& cpsFailureCallback .~ callback & cpsFailureCallback .~ callback
@@ -153,16 +113,50 @@ createPlayer = let
-- | Starts goalie creation mode -- | Starts goalie creation mode
createGoalie :: ProgState -> ProgState createGoalie :: ProgState -> ProgState
createGoalie = let createGoalie = let
callback = modify $ progMode .~ MainMenu callback = modify edit
cgs = newCreateGoalieState cgs = newCreateGoalieState
& cgsSuccessCallback .~ callback & cgsSuccessCallback .~ callback
& cgsFailureCallback .~ callback & cgsFailureCallback .~ callback
in progMode .~ CreateGoalie cgs in progMode .~ CreateGoalie cgs
-- | Launches the edit menu
edit :: ProgState -> ProgState
edit = progMode .~ EditMenu
-- | Starts the player editing process -- | Starts the player editing process
editPlayer :: ProgState -> ProgState editPlayer :: ProgState -> ProgState
editPlayer = progMode .~ EditPlayer newEditPlayerState 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 -- | Adds the entered player to the roster
addPlayer :: ProgState -> ProgState addPlayer :: ProgState -> ProgState
addPlayer s = fromMaybe s $ do addPlayer s = fromMaybe s $ do
@@ -199,81 +193,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
%~ (cgsNumber .~ Nothing) %~ (cgsNumber .~ Nothing)
. (cgsName .~ "") . (cgsName .~ "")
-- | 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)
-- | Resets the program state back to the main menu -- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState backHome :: ProgState -> ProgState
backHome backHome
@@ -288,3 +207,13 @@ scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down -- | Scrolls the display down
scrollDown :: ProgState -> ProgState scrollDown :: ProgState -> ProgState
scrollDown = scrollOffset %~ succ scrollDown = scrollOffset %~ succ
-- | Saves the database
saveDatabase :: String -> Action ()
saveDatabase fn = do
db <- gets (^.database)
liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> fn
createDirectoryIfMissing True dir
encodeFile dbFile db

View File

@@ -0,0 +1,70 @@
{- |
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.EditStandings
( editStandings
, editHomeStandings
, editAwayStandings
, editWins
, editLosses
, editOvertime
, editGoalsFor
, editGoalsAgainst
) where
import Lens.Micro ((.~))
import Mtlstats.Types
-- | Enters edit standings mode
editStandings :: ProgState -> ProgState
editStandings = progMode .~ EditStandings ESMMenu
-- | Edits the home standings
editHomeStandings :: ProgState -> ProgState
editHomeStandings = progMode .~ EditStandings (ESMHome ESMSubMenu)
-- | Edits the road standings
editAwayStandings :: ProgState -> ProgState
editAwayStandings = progMode .~ EditStandings (ESMAway ESMSubMenu)
-- | Changes to edit wins mode
editWins :: ProgState -> ProgState
editWins = doEdit ESMEditWins
-- | Changes to edit losses mode
editLosses :: ProgState -> ProgState
editLosses = doEdit ESMEditLosses
-- | Changes to edit overtime mode
editOvertime :: ProgState -> ProgState
editOvertime = doEdit ESMEditOvertime
-- | Changes to edit goals for mode
editGoalsFor :: ProgState -> ProgState
editGoalsFor = doEdit ESMEditGoalsFor
-- | Changes to edit goals against mode
editGoalsAgainst :: ProgState -> ProgState
editGoalsAgainst = doEdit ESMEditGoalsAgainst
doEdit :: ESMSubMode -> ProgState -> ProgState
doEdit = (progMode.editStandingsModeL.esmSubModeL .~)

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

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Actions.GoalieInput module Mtlstats.Actions.NewGame.GoalieInput
( finishGoalieEntry ( finishGoalieEntry
, recordGoalieStats , recordGoalieStats
, setGameGoalie , setGameGoalie
) where ) where
import Control.Monad (void)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~), (+~)) import Lens.Micro ((^.), (&), (.~), (%~), (+~))
@@ -42,10 +43,10 @@ finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
recordGoalieStats :: ProgState -> ProgState recordGoalieStats :: ProgState -> ProgState
recordGoalieStats s = fromMaybe s $ do recordGoalieStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL let gs = s^.progMode.gameStateL
gid <- gs^.gameSelectedGoalie gid <- gs^.gameSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies mins <- gs^.gameGoalieMinsPlayed
mins <- gs^.gameGoalieMinsPlayed goals <- gs^.gameGoalsAllowed
goals <- gs^.gameGoalsAllowed void $ nth gid $ s^.database.dbGoalies
let let
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
then 1 then 1
else 0 else 0
bumpStats gs = gs bumpStats
& gsGames +~ bumpVal = (gsGames +~ bumpVal)
& gsMinsPlayed +~ mins . (gsMinsPlayed +~ mins)
& gsGoalsAllowed +~ goals . (gsGoalsAllowed +~ goals)
tryFinish = if mins >= gameLength tryFinish = if mins >= gameLength
then finishGoalieEntry then finishGoalieEntry
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
l = if lost then 1 else 0 l = if lost then 1 else 0
t = if tied then 1 else 0 t = if tied then 1 else 0
updateStats gs = gs updateStats
& gsWins +~ w = (gsWins +~ w)
& gsLosses +~ l . (gsLosses +~ l)
& gsTies +~ t . (gsTies +~ t)
updateGoalie g = g updateGoalie
& gYtd %~ updateStats = (gYtd %~ updateStats)
& gLifetime %~ updateStats . (gLifetime %~ updateStats)
updateGameState gs = gs updateGameState
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats = (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
& gameGoalieAssigned .~ True . (gameGoalieAssigned .~ True)
Just $ s Just $ s
& database.dbGoalies %~ modifyNth gid updateGoalie & database.dbGoalies %~ modifyNth gid updateGoalie

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -21,47 +21,33 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where module Mtlstats.Control (dispatch) where
import Control.Monad (join, when) import Control.Monad (join)
import Control.Monad.Extra (ifM)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper) import Data.Maybe (fromJust)
import Data.Maybe (fromJust, fromMaybe, isJust) import Lens.Micro ((^.))
import Lens.Micro ((^.), (.~), (%~))
import Lens.Micro.Extras (view) import Lens.Micro.Extras (view)
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Control.TitleScreen
import Mtlstats.Control.EditGoalie
import Mtlstats.Control.EditPlayer import Mtlstats.Control.EditPlayer
import Mtlstats.Control.GoalieInput import Mtlstats.Control.EditStandings
import Mtlstats.Format import Mtlstats.Control.NewGame
import Mtlstats.Handlers import Mtlstats.Handlers
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Report
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
-- | Reads the program state and returs the apropriate controller to -- | Reads the program state and returs the apropriate controller to
-- run -- run
dispatch :: ProgState -> Controller dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of dispatch s = case s^.progMode of
MainMenu -> mainMenuC TitleScreen -> titleScreenC
NewSeason -> newSeasonC MainMenu -> mainMenuC
NewGame gs NewSeason flag -> newSeasonC flag
| null $ gs^.gameYear -> gameYearC NewGame gs -> newGameC gs
| null $ gs^.gameMonth -> gameMonthC EditMenu -> editMenuC
| 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 -> goalieInput s
| otherwise -> reportC
CreatePlayer cps CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC | null $ cps^.cpsName -> getPlayerNameC
@@ -71,7 +57,9 @@ dispatch s = case s^.progMode of
| null $ cgs^.cgsNumber -> getGoalieNumC | null $ cgs^.cgsNumber -> getGoalieNumC
| null $ cgs^.cgsName -> getGoalieNameC | null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC | otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
(EditStandings esm) -> editStandingsC esm
mainMenuC :: Controller mainMenuC :: Controller
mainMenuC = Controller mainMenuC = Controller
@@ -79,226 +67,12 @@ mainMenuC = Controller
, handleController = menuHandler mainMenu , handleController = menuHandler mainMenu
} }
newSeasonC :: Controller newSeasonC :: Bool -> Controller
newSeasonC = Controller newSeasonC False = promptController newSeasonPrompt
{ drawController = const $ drawMenu newSeasonMenu newSeasonC True = menuController newSeasonMenu
, handleController = \e -> do
menuHandler newSeasonMenu e
return True
}
gameYearC :: Controller editMenuC :: Controller
gameYearC = Controller editMenuC = menuController editMenu
{ 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.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"
getPlayerNumC :: Controller getPlayerNumC :: Controller
getPlayerNumC = Controller getPlayerNumC = Controller
@@ -381,15 +155,3 @@ confirmCreateGoalieC = Controller
Nothing -> return () Nothing -> return ()
return True return True
} }
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,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

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -25,7 +25,9 @@ import Data.Maybe (fromMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Helpers.Player
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Menu.EditPlayer
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Prompt.EditPlayer import Mtlstats.Prompt.EditPlayer
import Mtlstats.Types import Mtlstats.Types
@@ -36,108 +38,60 @@ editPlayerC :: EditPlayerState -> Controller
editPlayerC eps editPlayerC eps
| null $ eps^.epsSelectedPlayer = selectPlayerC | null $ eps^.epsSelectedPlayer = selectPlayerC
| otherwise = case eps^.epsMode of | otherwise = case eps^.epsMode of
EPMenu -> menuC EPMenu -> menuC
EPNumber -> numberC EPNumber -> numberC
EPName -> nameC EPName -> nameC
EPPosition -> positionC EPPosition -> positionC
EPYtdGoals -> ytdGoalsC EPYtd -> ytdC
EPYtdAssists -> ytdAssistsC EPLifetime -> lifetimeC
EPYtdPMin -> ytdPMinC EPYtdGoals b -> ytdGoalsC b
EPLtGoals -> ltGoalsC EPYtdAssists b -> ytdAssistsC b
EPLtAssists -> ltAssistsC EPYtdPMin -> ytdPMinC
EPLtPMin -> ltPMinC EPLtGoals b -> ltGoalsC b
EPLtAssists b -> ltAssistsC b
EPLtPMin -> ltPMinC
selectPlayerC :: Controller selectPlayerC :: Controller
selectPlayerC = Controller selectPlayerC = promptController playerToEditPrompt
{ drawController = drawPrompt playerToEditPrompt
, handleController = \e -> do
promptHandler playerToEditPrompt e
return True
}
menuC :: Controller menuC :: Controller
menuC = Controller menuC = menuControllerWith header editPlayerMenu
{ drawController = \s -> do
let
header = fromMaybe "" $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
p <- nth pid $ s^.database.dbPlayers
Just $ playerDetails p ++ "\n"
C.drawString header
drawMenu editPlayerMenu
, handleController = \e -> do
menuHandler editPlayerMenu e
return True
}
numberC :: Controller numberC :: Controller
numberC = Controller numberC = promptController editPlayerNumPrompt
{ drawController = drawPrompt editPlayerNumPrompt
, handleController = \e -> do
promptHandler editPlayerNumPrompt e
return True
}
nameC :: Controller nameC :: Controller
nameC = Controller nameC = promptController editPlayerNamePrompt
{ drawController = drawPrompt editPlayerNamePrompt
, handleController = \e -> do
promptHandler editPlayerNamePrompt e
return True
}
positionC :: Controller positionC :: Controller
positionC = Controller positionC = promptController editPlayerPosPrompt
{ drawController = drawPrompt editPlayerPosPrompt
, handleController = \e -> do
promptHandler editPlayerPosPrompt e
return True
}
ytdGoalsC :: Controller ytdC :: Controller
ytdGoalsC = Controller ytdC = menuControllerWith header editPlayerYtdMenu
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdGoalsPrompt e
return True
}
ytdAssistsC :: Controller lifetimeC :: Controller
ytdAssistsC = Controller lifetimeC = menuControllerWith header editPlayerLtMenu
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
, handleController = \e -> do ytdGoalsC :: Bool -> Controller
promptHandler editPlayerYtdAssistsPrompt e ytdGoalsC = promptController . editPlayerYtdGoalsPrompt
return True
} ytdAssistsC :: Bool -> Controller
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt
ytdPMinC :: Controller ytdPMinC :: Controller
ytdPMinC = Controller ytdPMinC = promptController editPlayerYtdPMinPrompt
{ drawController = drawPrompt editPlayerYtdPMinPrompt
, handleController = \e -> do
promptHandler editPlayerYtdPMinPrompt e
return True
}
ltGoalsC :: Controller ltGoalsC :: Bool -> Controller
ltGoalsC = Controller ltGoalsC = promptController . editPlayerLtGoalsPrompt
{ drawController = drawPrompt editPlayerLtGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerLtGoalsPrompt e
return True
}
ltAssistsC :: Controller ltAssistsC :: Bool -> Controller
ltAssistsC = Controller ltAssistsC = promptController . editPlayerLtAssistsPrompt
{ drawController = drawPrompt editPlayerLtAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerLtAssistsPrompt e
return True
}
ltPMinC :: Controller ltPMinC :: Controller
ltPMinC = Controller ltPMinC = promptController editPlayerLtPMinPrompt
{ drawController = drawPrompt editPlayerLtPMinPrompt
, handleController = \e -> do header :: ProgState -> C.Update ()
promptHandler editPlayerLtPMinPrompt e header s = C.drawString $ fromMaybe "" $ do
return True pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
} player <- nth pid $ s^.database.dbPlayers
Just $ playerDetails player ++ "\n"

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/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Control.EditStandings (editStandingsC) where
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Menu.EditStandings
import Mtlstats.Prompt
import Mtlstats.Prompt.EditStandings
import Mtlstats.Types
import Mtlstats.Types.Menu
-- | Controller for the edit standings menu
editStandingsC :: EditStandingsMode -> Controller
editStandingsC = \case
ESMMenu -> menuControllerWith header editStandingsMenu
ESMHome m -> editHomeStandingsC m
ESMAway m -> editAwayStandingsC m
editHomeStandingsC :: ESMSubMode -> Controller
editHomeStandingsC = \case
ESMSubMenu -> menuC editHomeStandingsMenu
ESMEditWins -> promptC editHomeWinsPrompt
ESMEditLosses -> promptC editHomeLossesPrompt
ESMEditOvertime -> promptC editHomeOvertimePrompt
ESMEditGoalsFor -> promptC editHomeGoalsForPrompt
ESMEditGoalsAgainst -> promptC editHomeGoalsAgainstPrompt
editAwayStandingsC :: ESMSubMode -> Controller
editAwayStandingsC = \case
ESMSubMenu -> menuC editAwayStandingsMenu
ESMEditWins -> promptC editAwayWinsPrompt
ESMEditLosses -> promptC editAwayLossesPrompt
ESMEditOvertime -> promptC editAwayOvertimePrompt
ESMEditGoalsFor -> promptC editAwayGoalsForPrompt
ESMEditGoalsAgainst -> promptC editAwayGoalsAgainstPrompt
menuC :: Menu () -> Controller
menuC = menuControllerWith header
promptC :: Prompt -> Controller
promptC = promptControllerWith header
header :: ProgState -> C.Update ()
header = do
db <- (^.database)
let
home = db^.dbHomeGameStats
away = db^.dbAwayGameStats
table = numTable [" W", " L", " OT", " GF", " GA"]
[ ( "HOME", valsFor home )
, ( "ROAD", valsFor away )
]
return $ C.drawString $ unlines $ table ++ [""]
valsFor :: GameStats -> [Int]
valsFor gs =
[ gs^.gmsWins
, gs^.gmsLosses
, gs^.gmsOvertime
, gs^.gmsGoalsFor
, gs^.gmsGoalsAgainst
]

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

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Control.GoalieInput (goalieInput) where module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
@@ -28,21 +28,17 @@ import qualified UI.NCurses as C
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Prompt.GoalieInput import Mtlstats.Prompt.NewGame.GoalieInput
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
-- | The dispatcher for handling goalie input -- | The dispatcher for handling goalie input
goalieInput :: ProgState -> Controller goalieInputC :: GameState -> Controller
goalieInput s = let goalieInputC gs
gs = s^.progMode.gameStateL | gs^.gameGoaliesRecorded = selectGameGoalieC
in if gs^.gameGoaliesRecorded | null $ gs^.gameSelectedGoalie = selectGoalieC
then selectGameGoalieC s | null $ gs^.gameGoalieMinsPlayed = minsPlayedC
else if null $ gs^.gameSelectedGoalie | otherwise = goalsAllowedC
then selectGoalieC
else if null $ gs^.gameGoalieMinsPlayed
then minsPlayedC
else goalsAllowedC
selectGoalieC :: Controller selectGoalieC :: Controller
selectGoalieC = promptController selectGameGoaliePrompt selectGoalieC = promptController selectGameGoaliePrompt
@@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
goalsAllowedC :: Controller goalsAllowedC :: Controller
goalsAllowedC = promptControllerWith header goalsAllowedPrompt goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: ProgState -> Controller selectGameGoalieC :: Controller
selectGameGoalieC = menuController . gameGoalieMenu selectGameGoalieC = menuStateController gameGoalieMenu
header :: ProgState -> C.Update () header :: ProgState -> C.Update ()
header s = C.drawString $ unlines header s = C.drawString $ unlines

View File

@@ -0,0 +1,142 @@
{- |
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.TitleScreen (titleScreenC) where
import Control.Monad.Trans.State (modify)
import Data.Char (chr)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Types
titleScreenC :: Controller
titleScreenC = Controller
{ drawController = const $ do
(_, cols) <- C.windowSize
C.drawString $ unlines $ map (centre $ fromIntegral $ pred cols)
$ [ ""
, "MONTREAL CANADIENS STATISTICS"
]
++ titleText
++ [ ""
, "Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe"
, "<rheal.lamothe@gmail.com>"
, ""
, "Press any key to continue..."
]
return C.CursorInvisible
, handleController = \case
C.EventCharacter _ -> modify backHome >> return True
C.EventSpecialKey _ -> modify backHome >> return True
_ -> return True
}
titleText :: [String]
titleText = box $ map (map blockify) $ foldl joinBlocks (repeat "")
[chM, chT, chL, chS, chT, chA, chT, chS]
box :: [String] -> [String]
box strs
= [[tl] ++ replicate width horiz ++ [tr]]
++ map (\str -> [vert] ++ str ++ [vert]) strs
++ [[bl] ++ replicate width horiz ++ [br]]
where
width = length $ head strs
tl = chr 0x2554
tr = chr 0x2557
bl = chr 0x255a
br = chr 0x255d
horiz = chr 0x2550
vert = chr 0x2551
blockify :: Char -> Char
blockify = \case
'#' -> chr 0x2588
'>' -> chr 0x2590
'<' -> chr 0x258c
ch -> ch
joinBlocks :: [String] -> [String] -> [String]
joinBlocks = zipWith (++)
chM :: [String]
chM =
[ "##< >##"
, ">## ##<"
, ">##< >##<"
, ">### ###<"
, ">#######<"
, ">#<###>#<"
, ">#<>#<>#<"
, "##< >##"
]
chT :: [String]
chT =
[ ">########<"
, ">## ## ##<"
, ">#< ## >#<"
, " ## "
, " ## "
, " ## "
, " ## "
, " >##< "
]
chL :: [String]
chL =
[ "### "
, ">#< "
, ">#< "
, ">#< "
, ">#< "
, ">#< ##"
, ">#< >##"
, "#######"
]
chS :: [String]
chS =
[ " #####< "
, ">#< ## "
, "## "
, " #####< "
, " >#<"
, " ##"
, ">#< >#<"
, " ###### "
]
chA :: [String]
chA =
[ " >##< "
, " ## "
, " >##< "
, " #### "
, " >#<>#< "
, " ###### "
, ">#< >#<"
, "### ###"
]

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module Mtlstats.Format
( padNum ( padNum
, left , left
, right , right
, centre , centre
, padRight
, overlay , overlay
, month , month
, labelTable
, numTable
, tableWith
, complexTable
, overlayLast
, showFloating
) where ) where
import Data.List (transpose)
import Mtlstats.Types
-- | Pad an 'Int' with leading zeroes to fit a certain character width -- | Pad an 'Int' with leading zeroes to fit a certain character width
padNum padNum
:: Int :: Int
@@ -75,6 +88,16 @@ centre n str = let
pad = replicate pLen ' ' pad = replicate pLen ' '
in take n $ pad ++ str ++ repeat ' ' 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 -- | Overlays one string on top of another
overlay overlay
:: String :: String
@@ -101,3 +124,84 @@ month 10 = "OCT"
month 11 = "NOV" month 11 = "NOV"
month 12 = "DEC" month 12 = "DEC"
month _ = "" 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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

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.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
prefix = if g^.gActive
then ""
else "*"
suffix = if g^.gRookie
then "*"
else ""
in prefix ++ g^.gName ++ suffix

View File

@@ -0,0 +1,60 @@
{- |
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
prefix = if p^.pActive
then ""
else "*"
suffix = if p^.pRookie
then "*"
else ""
in prefix ++ p^.pName ++ suffix

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -22,6 +22,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Menu ( module Mtlstats.Menu (
-- * Menu Functions -- * Menu Functions
menuController, menuController,
menuControllerWith,
menuStateController,
drawMenu, drawMenu,
menuHandler, menuHandler,
-- * Menus -- * Menus
@@ -29,45 +31,70 @@ module Mtlstats.Menu (
newSeasonMenu, newSeasonMenu,
gameMonthMenu, gameMonthMenu,
gameTypeMenu, gameTypeMenu,
editPlayerMenu, gameGoalieMenu,
gameGoalieMenu editMenu
) where ) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile)
import Data.Char (toUpper) import Data.Char (toUpper)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Lens.Micro ((^.), (.~), (?~)) import Lens.Micro ((^.), (?~))
import Lens.Micro.Extras (view)
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import qualified Mtlstats.Actions.GoalieInput as GI import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Actions.EditStandings
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Types.Menu import Mtlstats.Types.Menu
import Mtlstats.Util import Mtlstats.Util
-- | Generates a simple 'Controller' for a Menu -- | Generates a simple 'Controller' for a Menu
menuController :: Menu () -> Controller menuController :: Menu () -> Controller
menuController menu = Controller menuController = menuControllerWith $ const $ return ()
{ drawController = const $ drawMenu menu
-- | 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 , handleController = \e -> do
menuHandler menu e menuHandler menu e
return True return True
} }
-- | Generate and create a controller for a menu based on the current
-- 'ProgState'
menuStateController
:: (ProgState -> Menu ())
-- ^ The function to generate the menu
-> Controller
-- ^ The resulting controller
menuStateController menuFunc = Controller
{ drawController = drawMenu . menuFunc
, handleController = \e -> do
menu <- gets menuFunc
menuHandler menu e
return True
}
-- | The draw function for a 'Menu' -- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode drawMenu :: Menu a -> C.Update C.CursorMode
drawMenu m = do drawMenu m = do
C.drawString $ show m (_, cols) <- C.windowSize
let
width = fromIntegral $ pred cols
menuText = map (centre width) $ lines $ show m
C.drawString $ unlines menuText
return C.CursorInvisible return C.CursorInvisible
-- | The event handler for a 'Menu' -- | The event handler for a 'Menu'
@@ -80,84 +107,59 @@ menuHandler m _ = return $ m^.menuDefault
-- | The main menu -- | The main menu
mainMenu :: Menu Bool mainMenu :: Menu Bool
mainMenu = Menu "*** MAIN MENU ***" True mainMenu = Menu "MASTER MENU" True
[ MenuItem '1' "New Season" $ [ MenuItem 'A' "NEW SEASON" $
modify startNewSeason >> return True modify startNewSeason >> return True
, MenuItem '2' "New Game" $ , MenuItem 'B' "NEW GAME" $
modify startNewGame >> return True modify startNewGame >> return True
, MenuItem '3' "Create Player" $ , MenuItem 'C' "EDIT MENU" $
modify createPlayer >> return True modify edit >> return True
, MenuItem '4' "Create Goalie" $ , MenuItem 'E' "EXIT" $
modify createGoalie >> return True saveDatabase dbFname >> return False
, MenuItem '5' "Edit Player" $
modify editPlayer >> return True
, MenuItem '6' "Exit" $ do
db <- gets $ view database
liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> dbFname
createDirectoryIfMissing True dir
encodeFile dbFile db
return False
] ]
-- | The new season menu -- | The new season menu
newSeasonMenu :: Menu () newSeasonMenu :: Menu ()
newSeasonMenu = Menu "*** SEASON TYPE ***" () newSeasonMenu = Menu "SEASON TYPE" ()
[ MenuItem '1' "Regular Season" $ do [ MenuItem 'R' "REGULAR SEASON" $ modify
modify resetYtd $ resetYtd
modify startNewGame . clearRookies
, MenuItem '2' "Playoffs" $ . resetStandings
modify startNewGame . startNewGame
, MenuItem 'P' "PLAYOFFS" $ modify
$ resetStandings
. startNewGame
] ]
-- | Requests the month in which the game took place -- | Requests the month in which the game took place
gameMonthMenu :: Menu () gameMonthMenu :: Menu ()
gameMonthMenu = Menu "Month:" () $ map gameMonthMenu = Menu "MONTH:" () $ map
(\(ch, name, val) -> (\(ch, name, val) ->
MenuItem ch name $ MenuItem ch name $
modify $ progMode.gameStateL.gameMonth ?~ val) modify $ progMode.gameStateL.gameMonth ?~ val)
[ ( 'A', "January", 1 ) [ ( 'A', "JANUARY", 1 )
, ( 'B', "February", 2 ) , ( 'B', "FEBRUARY", 2 )
, ( 'C', "March", 3 ) , ( 'C', "MARCH", 3 )
, ( 'D', "April", 4 ) , ( 'D', "APRIL", 4 )
, ( 'E', "May", 5 ) , ( 'E', "MAY", 5 )
, ( 'F', "June", 6 ) , ( 'F', "JUNE", 6 )
, ( 'G', "July", 7 ) , ( 'G', "JULY", 7 )
, ( 'H', "August", 8 ) , ( 'H', "AUGUST", 8 )
, ( 'I', "September", 9 ) , ( 'I', "SEPTEMBER", 9 )
, ( 'J', "October", 10 ) , ( 'J', "OCTOBER", 10 )
, ( 'K', "November", 11 ) , ( 'K', "NOVEMBER", 11 )
, ( 'L', "December", 12 ) , ( 'L', "DECEMBER", 12 )
] ]
-- | The game type menu (home/away) -- | The game type menu (home/away)
gameTypeMenu :: Menu () gameTypeMenu :: Menu ()
gameTypeMenu = Menu "Game type:" () gameTypeMenu = Menu "GAME TYPE:" ()
[ MenuItem '1' "Home Game" $ [ MenuItem 'H' "HOME GAME" $
modify $ progMode.gameStateL.gameType ?~ HomeGame modify $ progMode.gameStateL.gameType ?~ HomeGame
, MenuItem '2' "Away Game" $ , MenuItem 'A' "AWAY GAME" $
modify $ progMode.gameStateL.gameType ?~ AwayGame modify $ progMode.gameStateL.gameType ?~ AwayGame
] ]
-- | The player edit menu
editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $ case mode of
Nothing -> modify $ progMode .~ MainMenu
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
[ ( '1', "Change number", Just EPNumber )
, ( '2', "Change name", Just EPName )
, ( '3', "Change position", Just EPPosition )
, ( '4', "YTD goals", Just EPYtdGoals )
, ( '5', "YTD assists", Just EPYtdAssists )
, ( '6', "YTD penalty mins", Just EPYtdPMin )
, ( '7', "Lifetime goals", Just EPLtGoals )
, ( '8', "Lifetime assists", Just EPLtAssists )
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
, ( '0', "Finished editing", Nothing )
]
-- | Game goalie selection menu -- | Game goalie selection menu
gameGoalieMenu :: ProgState -> Menu () gameGoalieMenu :: ProgState -> Menu ()
gameGoalieMenu s = let gameGoalieMenu s = let
@@ -172,3 +174,20 @@ gameGoalieMenu s = let
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $ (\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
modify $ GI.setGameGoalie gid) $ modify $ GI.setGameGoalie gid) $
zip ['1'..] goalies zip ['1'..] goalies
-- | The edit menu
editMenu :: Menu ()
editMenu = Menu "EDIT MENU" ()
[ MenuItem 'A' "CREATE PLAYER" $
modify createPlayer
, MenuItem 'B' "CREATE GOALIE" $
modify createGoalie
, MenuItem 'C' "EDIT PLAYER" $
modify editPlayer
, MenuItem 'D' "EDIT GOALIE" $
modify editGoalie
, MenuItem 'E' "EDIT STANDINGS" $
modify editStandings
, MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome
]

View File

@@ -0,0 +1,89 @@
{- |
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
[ ( 'A', "EDIT NUMBER", set EGNumber )
, ( 'B', "EDIT NAME", set EGName )
, ( 'C', "TOGGLE ROOKIE FLAG", toggleRookie )
, ( 'D', "TOGGLE ACTIVE FLAG", toggleActive )
, ( 'E', "EDIT YTD STATS", set EGYtd )
, ( 'F', "EDIT LIFETIME STATS", set EGLifetime )
, ( 'R', "RETURN TO EDIT MENU", edit )
]
where
set mode = progMode.editGoalieStateL.egsMode .~ mode
toggleRookie = editSelectedGoalie (gRookie %~ not)
toggleActive = editSelectedGoalie (gActive %~ not)
-- | The 'Goalie' YTD edit menu
editGoalieYtdMenu :: Menu ()
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
-- key, label, value
[ ( 'A', "EDIT ALL YTD STATS", EGYtdGames True )
, ( 'B', "EDIT YTD GAMES", EGYtdGames False )
, ( 'C', "EDIT YTD MINUTES", EGYtdMins False )
, ( 'D', "EDIT YTD GOALS", EGYtdGoals False )
, ( 'E', "EDIT YTD SHUTOUTS", EGYtdShutouts False )
, ( 'F', "EDIT YTD WINS", EGYtdWins False )
, ( 'G', "EDIT YTD LOSSES", EGYtdLosses False )
, ( 'H', "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
[ ( 'A', "EDIT ALL LIFETIME STATS", EGLtGames True )
, ( 'B', "EDIT LIFETIME GAMES", EGLtGames False )
, ( 'C', "EDIT LIFETIME MINUTES", EGLtMins False )
, ( 'D', "EDIT LIFETIME GOALS", EGLtGoals False )
, ( 'E', "EDIT LIFETIME SHUTOUTS", EGLtShutouts False )
, ( 'F', "EDIT LIFETIME WINS", EGLtWins False )
, ( 'G', "EDIT LIFETIME LOSSES", EGLtLosses False )
, ( 'H', "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,83 @@
{- |
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
[ ( 'A', "EDIT NUMBER", set EPNumber )
, ( 'B', "EDIT NAME", set EPName )
, ( 'C', "EDIT POSITION", set EPPosition )
, ( 'D', "TOGGLE ROOKIE FLAG", toggleRookie )
, ( 'E', "TOGGLE ACTIVE FLAG", toggleActive )
, ( 'F', "EDIT YTD STATS", set EPYtd )
, ( 'G', "EDIT LIFETIME STATS", set EPLifetime )
, ( 'R', "RETURN TO EDIT MENU", edit )
]
where
set mode = progMode.editPlayerStateL.epsMode .~ mode
toggleRookie = editSelectedPlayer $ pRookie %~ not
toggleActive = editSelectedPlayer $ pActive %~ not
-- | The 'Player' YTD stats edit menu
editPlayerYtdMenu :: Menu ()
editPlayerYtdMenu = editMenu
"EDIT PLAYER YEAR-TO-DATE"
-- key, label, value
[ ( 'A', "EDIT ALL YTD STATS", EPYtdGoals True )
, ( 'B', "EDIT YTD GOALS", EPYtdGoals False )
, ( 'C', "EDIT YTD ASSISTS", EPYtdAssists False )
, ( 'D', "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
[ ( 'A', "EDIT ALL LIFETIME STATS", EPLtGoals True )
, ( 'B', "EDIT LIFETIME GOALS", EPLtGoals False )
, ( 'C', "EDIT LIFETIME ASSITS", EPLtAssists False )
, ( 'D', "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

@@ -0,0 +1,64 @@
{- |
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.EditStandings
( editStandingsMenu
, editHomeStandingsMenu
, editAwayStandingsMenu
) where
import Control.Monad.Trans.State (modify)
import Mtlstats.Actions
import Mtlstats.Actions.EditStandings
import Mtlstats.Types.Menu
editStandingsMenu :: Menu ()
editStandingsMenu = Menu "EDIT STANDINGS" ()
[ MenuItem 'A' "EDIT HOME STANDINGS" $
modify editHomeStandings
, MenuItem 'B' "EDIT ROAD STANDINGS" $
modify editAwayStandings
, MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome
]
editHomeStandingsMenu :: Menu ()
editHomeStandingsMenu = subMenu "HOME"
editAwayStandingsMenu :: Menu ()
editAwayStandingsMenu = subMenu "ROAD"
subMenu :: String -> Menu ()
subMenu str = Menu (str ++ " STANDINGS") ()
[ MenuItem 'W' "EDIT WINS" $
modify editWins
, MenuItem 'L' "EDIT LOSSES" $
modify editLosses
, MenuItem 'O' "EDIT OVERTIME GAMES" $
modify editOvertime
, MenuItem 'F' "EDIT GOALS FOR" $
modify editGoalsFor
, MenuItem 'A' "EDIT GOALS AGAINST" $
modify editGoalsAgainst
, MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $
modify editStandings
]

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -28,14 +28,13 @@ module Mtlstats.Prompt (
promptControllerWith, promptControllerWith,
promptController, promptController,
strPrompt, strPrompt,
ucStrPrompt,
namePrompt,
numPrompt, numPrompt,
numPromptWithFallback,
selectPrompt, selectPrompt,
-- * Individual prompts -- * Individual prompts
gameYearPrompt, newSeasonPrompt,
gameDayPrompt,
otherTeamPrompt,
homeScorePrompt,
awayScorePrompt,
playerNumPrompt, playerNumPrompt,
playerNamePrompt, playerNamePrompt,
playerPosPrompt, playerPosPrompt,
@@ -43,19 +42,13 @@ module Mtlstats.Prompt (
goalieNamePrompt, goalieNamePrompt,
selectPlayerPrompt, selectPlayerPrompt,
selectGoaliePrompt, selectGoaliePrompt,
recordGoalPrompt,
recordAssistPrompt,
pMinPlayerPrompt,
assignPMinsPrompt,
playerToEditPrompt playerToEditPrompt
) where ) where
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Extra (whenJust) import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper) import Data.Char (isAlphaNum, isDigit, toUpper)
import Data.Foldable (forM_)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Extras (view) import Lens.Micro.Extras (view)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@@ -63,7 +56,6 @@ import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
@@ -79,10 +71,8 @@ promptHandler p (C.EventCharacter '\n') = do
val <- gets $ view inputBuffer val <- gets $ view inputBuffer
modify $ inputBuffer .~ "" modify $ inputBuffer .~ ""
promptAction p val promptAction p val
promptHandler p (C.EventCharacter c) = let promptHandler p (C.EventCharacter c) =
c' = toUpper c modify $ inputBuffer %~ promptProcessChar p c
in when (promptCharCheck p c') $
modify $ addChar c'
promptHandler _ (C.EventSpecialKey C.KeyBackspace) = promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
modify removeChar modify removeChar
promptHandler p (C.EventSpecialKey k) = promptHandler p (C.EventSpecialKey k) =
@@ -122,12 +112,33 @@ strPrompt
-- ^ The callback function for the result -- ^ The callback function for the result
-> Prompt -> Prompt
strPrompt pStr act = Prompt strPrompt pStr act = Prompt
{ promptDrawer = drawSimplePrompt pStr { promptDrawer = drawSimplePrompt pStr
, promptCharCheck = const True , promptProcessChar = \ch -> (++ [ch])
, promptAction = act , promptAction = act
, promptSpecialKey = const $ return () , 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 -- | Builds a numeric prompt
numPrompt numPrompt
:: String :: String
@@ -135,13 +146,44 @@ numPrompt
-> (Int -> Action ()) -> (Int -> Action ())
-- ^ The callback function for the result -- ^ The callback function for the result
-> Prompt -> Prompt
numPrompt pStr act = Prompt numPrompt pStr = numPromptWithFallback pStr $ return ()
{ promptDrawer = drawSimplePrompt pStr
, promptCharCheck = isDigit -- | Builds a numeric prompt with a fallback action
, promptAction = \inStr -> forM_ (readMaybe inStr) act numPromptWithFallback
, promptSpecialKey = const $ return () :: String
-- ^ The prompt string
-> Action ()
-- ^ The action to call on invalid (or blank) input
-> (Int -> Action ())
-- ^ The callback function for the result
-> Prompt
numPromptWithFallback pStr fallback act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptProcessChar = \ch str -> if isDigit ch
then str ++ [ch]
else str
, promptAction = \inStr -> case readMaybe inStr of
Nothing -> fallback
Just n -> act n
, promptSpecialKey = const $ return ()
} }
-- | Prompts the user for a filename to save a backup of the database
-- to
newSeasonPrompt :: Prompt
newSeasonPrompt = prompt
{ promptProcessChar = \ch str -> if isAlphaNum ch
then str ++ [toUpper ch]
else str
}
where
prompt = strPrompt "Filename to save database: " $ \fn ->
if null fn
then modify backHome
else do
saveDatabase $ fn ++ ".json"
modify $ progMode .~ NewSeason True
-- | Builds a selection prompt -- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt selectPrompt params = Prompt
@@ -157,7 +199,7 @@ selectPrompt params = Prompt
in "F" ++ show n ++ ") " ++ desc) in "F" ++ show n ++ ") " ++ desc)
results results
C.moveCursor row col C.moveCursor row col
, promptCharCheck = const True , promptProcessChar = spProcessChar params
, promptAction = \sStr -> if null sStr , promptAction = \sStr -> if null sStr
then spCallback params Nothing then spCallback params Nothing
else do else do
@@ -173,37 +215,12 @@ selectPrompt params = Prompt
n = pred $ fromInteger rawK n = pred $ fromInteger rawK
results = spSearch params sStr db results = spSearch params sStr db
when (n < maxFunKeys) $ when (n < maxFunKeys) $
whenJust (nth n results) $ \(n, _) -> do whenJust (nth n results) $ \(sel, _) -> do
modify $ inputBuffer .~ "" modify $ inputBuffer .~ ""
spCallback params $ Just n spCallback params $ Just sel
_ -> return () _ -> 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 ?~)
-- | Prompts for a new player's number -- | Prompts for a new player's number
playerNumPrompt :: Prompt playerNumPrompt :: Prompt
playerNumPrompt = numPrompt "Player number: " $ playerNumPrompt = numPrompt "Player number: " $
@@ -211,12 +228,12 @@ playerNumPrompt = numPrompt "Player number: " $
-- | Prompts for a new player's name -- | Prompts for a new player's name
playerNamePrompt :: Prompt playerNamePrompt :: Prompt
playerNamePrompt = strPrompt "Player name: " $ playerNamePrompt = namePrompt "Player name: " $
modify . (progMode.createPlayerStateL.cpsName .~) modify . (progMode.createPlayerStateL.cpsName .~)
-- | Prompts for a new player's position -- | Prompts for a new player's position
playerPosPrompt :: Prompt playerPosPrompt :: Prompt
playerPosPrompt = strPrompt "Player position: " $ playerPosPrompt = ucStrPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~) modify . (progMode.createPlayerStateL.cpsPosition .~)
-- | Prompts tor the goalie's number -- | Prompts tor the goalie's number
@@ -226,7 +243,7 @@ goalieNumPrompt = numPrompt "Goalie number: " $
-- | Prompts for the goalie's name -- | Prompts for the goalie's name
goalieNamePrompt :: Prompt goalieNamePrompt :: Prompt
goalieNamePrompt = strPrompt "Goalie name: " $ goalieNamePrompt = namePrompt "Goalie name: " $
modify . (progMode.createGoalieStateL.cgsName .~) modify . (progMode.createGoalieStateL.cgsName .~)
-- | Selects a player (creating one if necessary) -- | Selects a player (creating one if necessary)
@@ -243,6 +260,7 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers) , spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers) , spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
, spElemDesc = playerSummary , spElemDesc = playerSummary
, spProcessChar = capitalizeName
, spCallback = callback , spCallback = callback
, spNotFound = \sStr -> do , spNotFound = \sStr -> do
mode <- gets (^.progMode) mode <- gets (^.progMode)
@@ -271,6 +289,7 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies) , spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies) , spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
, spElemDesc = goalieSummary , spElemDesc = goalieSummary
, spProcessChar = capitalizeName
, spCallback = callback , spCallback = callback
, spNotFound = \sStr -> do , spNotFound = \sStr -> do
mode <- gets (^.progMode) mode <- gets (^.progMode)
@@ -285,52 +304,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
modify $ progMode .~ CreateGoalie cgs modify $ progMode .~ CreateGoalie cgs
} }
-- | 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 (view $ 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
playerToEditPrompt :: Prompt playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $ playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~) modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

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

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -31,62 +31,95 @@ module Mtlstats.Prompt.EditPlayer
, editPlayerLtPMinPrompt , editPlayerLtPMinPrompt
) where ) where
import Control.Monad.Extra (whenJustM) import Control.Monad.Trans.State (modify)
import Control.Monad.Trans.State (gets, modify) import Lens.Micro ((.~))
import Lens.Micro ((^.), (.~), (%~))
import Mtlstats.Actions
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
-- | Prompt to edit a player's number -- | Prompt to edit a player's number
editPlayerNumPrompt :: Prompt editPlayerNumPrompt :: Prompt
editPlayerNumPrompt = numPrompt "Player number: " $ editPlayerNumPrompt = editNum "Player number: " EPMenu
editPlayer . (pNumber .~) (pNumber .~)
-- | Prompt to edit a player's name -- | Prompt to edit a player's name
editPlayerNamePrompt :: Prompt editPlayerNamePrompt :: Prompt
editPlayerNamePrompt = strPrompt "Player name: " $ editPlayerNamePrompt = namePrompt "Player name: " $ \name ->
editPlayer . (pName .~) if null name
then goto EPMenu
else doEdit EPMenu $ pName .~ name
-- | Prompt to edit a player's position -- | Prompt to edit a player's position
editPlayerPosPrompt :: Prompt editPlayerPosPrompt :: Prompt
editPlayerPosPrompt = strPrompt "Player position: " $ editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos ->
editPlayer . (pPosition .~) if null pos
then goto EPMenu
else doEdit EPMenu $ pPosition .~ pos
-- | Prompt to edit a player's year-to-date goals -- | Prompt to edit a player's year-to-date goals
editPlayerYtdGoalsPrompt :: Prompt editPlayerYtdGoalsPrompt
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $ :: Bool
editPlayer . (pYtd.psGoals .~) -- ^ 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 -- | Prompt to edit a player's year-to-date assists
editPlayerYtdAssistsPrompt :: Prompt editPlayerYtdAssistsPrompt
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $ :: Bool
editPlayer . (pYtd.psAssists .~) -- ^ 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 -- | Prompt to edit a player's year-to-date penalty minutes
editPlayerYtdPMinPrompt :: Prompt editPlayerYtdPMinPrompt :: Prompt
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $ editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
editPlayer . (pYtd.psPMin .~) (pYtd.psPMin .~)
-- | Prompt to edit a player's lifetime goals -- | Prompt to edit a player's lifetime goals
editPlayerLtGoalsPrompt :: Prompt editPlayerLtGoalsPrompt
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $ :: Bool
editPlayer . (pLifetime.psGoals .~) -- ^ 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 -- | Prompt to edit a player's lifetime assists
editPlayerLtAssistsPrompt :: Prompt editPlayerLtAssistsPrompt
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $ :: Bool
editPlayer . (pLifetime.psAssists .~) -- ^ 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 -- | Prompt to edit a player's lifetime penalty minutes
editPlayerLtPMinPrompt :: Prompt editPlayerLtPMinPrompt :: Prompt
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $ editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
editPlayer . (pLifetime.psPMin .~) (pLifetime.psPMin .~)
editPlayer :: (Player -> Player) -> Action () editNum
editPlayer f = :: String
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid -> -> EditPlayerMode
modify -> (Int -> Player -> Player)
$ (database.dbPlayers %~ modifyNth pid f) -> Prompt
. (progMode.editPlayerStateL.epsMode .~ EPMenu) 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,89 @@
{- |
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.EditStandings
( editHomeWinsPrompt
, editHomeLossesPrompt
, editHomeOvertimePrompt
, editHomeGoalsForPrompt
, editHomeGoalsAgainstPrompt
, editAwayWinsPrompt
, editAwayLossesPrompt
, editAwayOvertimePrompt
, editAwayGoalsForPrompt
, editAwayGoalsAgainstPrompt
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~), (%~))
import Mtlstats.Prompt
import Mtlstats.Types
editHomeWinsPrompt :: Prompt
editHomeWinsPrompt =
mkPrompt "Home wins: " (dbHomeGameStats.gmsWins .~)
editHomeLossesPrompt :: Prompt
editHomeLossesPrompt =
mkPrompt "Home losses: " (dbHomeGameStats.gmsLosses .~)
editHomeOvertimePrompt :: Prompt
editHomeOvertimePrompt =
mkPrompt "Home overtime games: " (dbHomeGameStats.gmsOvertime .~)
editHomeGoalsForPrompt :: Prompt
editHomeGoalsForPrompt =
mkPrompt "Home goals for: " (dbHomeGameStats.gmsGoalsFor .~)
editHomeGoalsAgainstPrompt :: Prompt
editHomeGoalsAgainstPrompt =
mkPrompt "Home goals against: " (dbHomeGameStats.gmsGoalsAgainst .~)
editAwayWinsPrompt :: Prompt
editAwayWinsPrompt =
mkPrompt "Road wins: " (dbAwayGameStats.gmsWins .~)
editAwayLossesPrompt :: Prompt
editAwayLossesPrompt =
mkPrompt "Road losses: " (dbAwayGameStats.gmsLosses .~)
editAwayOvertimePrompt :: Prompt
editAwayOvertimePrompt =
mkPrompt "Road overtime games: " (dbAwayGameStats.gmsOvertime .~)
editAwayGoalsForPrompt :: Prompt
editAwayGoalsForPrompt =
mkPrompt "Road goals for: " (dbAwayGameStats.gmsGoalsFor .~)
editAwayGoalsAgainstPrompt :: Prompt
editAwayGoalsAgainstPrompt =
mkPrompt "Road goals against: " (dbAwayGameStats.gmsGoalsAgainst .~)
mkPrompt :: String -> (Int -> Database -> Database) -> Prompt
mkPrompt pStr f = numPromptWithFallback pStr
(modify subMenu)
(\n -> modify
$ (database %~ f n)
. subMenu)
subMenu :: ProgState -> ProgState
subMenu = progMode.editStandingsModeL.esmSubModeL .~ ESMSubMenu

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

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -21,19 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt.GoalieInput module Mtlstats.Prompt.NewGame.GoalieInput
( selectGameGoaliePrompt ( selectGameGoaliePrompt
, goalieMinsPlayedPrompt , goalieMinsPlayedPrompt
, goalsAllowedPrompt , goalsAllowedPrompt
) where ) where
import Control.Monad (when) import Control.Monad.Trans.State (modify)
import Control.Monad.Trans.State (gets, modify) import Lens.Micro ((?~))
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (.~), (?~))
import Mtlstats.Actions.GoalieInput import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Config
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Types import Mtlstats.Types

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (Down (Down))
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Helpers.Goalie
import Mtlstats.Helpers.Player
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
@@ -43,6 +47,8 @@ report width s
++ gameStatsReport width s ++ gameStatsReport width s
++ [""] ++ [""]
++ yearToDateStatsReport width s ++ yearToDateStatsReport width s
++ [""]
++ lifetimeStatsReport width s
standingsReport :: Int -> ProgState -> [String] standingsReport :: Int -> ProgState -> [String]
standingsReport width s = fromMaybe [] $ do standingsReport width s = fromMaybe [] $ do
@@ -58,107 +64,269 @@ standingsReport width s = fromMaybe [] $ do
tStats = addGameStats hStats aStats tStats = addGameStats hStats aStats
hScore <- gs^.homeScore hScore <- gs^.homeScore
aScore <- gs^.awayScore aScore <- gs^.awayScore
Just let
[ overlay rHeader =
("GAME NUMBER " ++ padNum 2 gNum) [ overlay
(centre width ("GAME NUMBER " ++ padNum 2 gNum)
$ aTeam ++ " " ++ show aScore ++ " AT " (centre width
++ hTeam ++ " " ++ show hScore) $ aTeam ++ " " ++ show aScore ++ " AT "
, date ++ hTeam ++ " " ++ show hScore)
, centre width "STANDINGS" , date
, "" , centre width "STANDINGS"
, centre width , ""
$ left 11 myTeam ]
++ right 2 "G"
++ right 4 "W" tHeader =
++ right 4 "L" [ CellText myTeam
++ right 4 "OT" , CellText " G"
++ right 4 "GF" , CellText " W"
++ right 4 "GA" , CellText " L"
++ right 4 "P" , CellText " OT"
, centre width , CellText " GF"
$ left 11 "HOME" , CellText " GA"
++ showStats hStats , CellText " P"
, centre width ]
$ left 11 "ROAD"
++ showStats aStats rowCells stats =
, centre width [ CellText $ show $ gmsGames stats
$ replicate 11 ' ' , CellText $ show $ stats^.gmsWins
++ replicate (2 + 4 * 6) '-' , CellText $ show $ stats^.gmsLosses
, centre width , CellText $ show $ stats^.gmsOvertime
$ left 11 "TOTALS" , CellText $ show $ stats^.gmsGoalsFor
++ showStats tStats , CellText $ show $ stats^.gmsGoalsAgainst
] , CellText $ show $ gmsPoints stats
]
body =
[ CellText "HOME" : rowCells hStats
, CellText "ROAD" : rowCells aStats
]
separator = CellText "" : replicate 7 (CellFill '-')
totals = CellText "TOTALS" : rowCells tStats
table = map (centre width) $
complexTable
(left : repeat right)
(tHeader : body ++ [separator, totals])
Just $ rHeader ++ table
gameStatsReport :: Int -> ProgState -> [String] gameStatsReport :: Int -> ProgState -> [String]
gameStatsReport width s = playerReport width "GAME" $ gameStatsReport width s = let
fromMaybe [] $ mapM gs = s^.progMode.gameStateL
db = s^.database
playerStats = mapMaybe
(\(pid, stats) -> do (\(pid, stats) -> do
p <- nth pid $ s^.database.dbPlayers p <- nth pid $ db^.dbPlayers
Just (p, stats)) Just (p, stats))
(M.toList $ s^.progMode.gameStateL.gamePlayerStats) (M.toList $ gs^.gamePlayerStats)
goalieStats = mapMaybe
(\(gid, stats) -> do
g <- nth gid $ db^.dbGoalies
Just (g, stats))
(M.toList $ gs^.gameGoalieStats)
criteria (_, ps) = psPoints ps > 0
in filteredPlayerReport width "GAME" criteria True False playerStats
++ [""]
++ gameGoalieReport width goalieStats
yearToDateStatsReport :: Int -> ProgState -> [String] yearToDateStatsReport :: Int -> ProgState -> [String]
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $ yearToDateStatsReport width s = let
map (\p -> (p, p^.pYtd)) $ db = s^.database
filter playerIsActive $ s^.database.dbPlayers
playerStats = 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 :: GameState -> String
gameDate gs = fromMaybe "" $ do gameDate gs = fromMaybe "" $ do
year <- show <$> gs^.gameYear y <- show <$> gs^.gameYear
month <- month <$> gs^.gameMonth m <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay d <- padNum 2 <$> gs^.gameDay
Just $ month ++ " " ++ day ++ " " ++ year Just $ m ++ " " ++ d ++ " " ++ y
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String] playerReport
playerReport width label ps = let :: Int
nameWidth = playerNameColWidth $ map fst ps -> String
tStats = foldr (addPlayerStats . snd) newPlayerStats ps -> Bool
in -> 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 (label ++ " STATISTICS")
, "" , ""
, centre width
$ "NO. "
++ left nameWidth "PLAYER"
++ right 3 "G"
++ right 6 "A"
++ right 6 "P"
++ right 6 "PM"
] ++ map
(\(p, stats) -> centre width
$ right 2 (show $ p^.pNumber)
++ " "
++ left nameWidth (p^.pName)
++ right 3 (show $ stats^.psGoals)
++ right 6 (show $ stats^.psAssists)
++ right 6 (show $ psPoints stats)
++ right 6 (show $ stats^.psPMin))
ps ++
[ centre width
$ replicate (4 + nameWidth) ' '
++ replicate (3 + 3 * 6) '-'
, overlay
(label ++ " TOTALS")
( centre width
$ replicate (4 + nameWidth) ' '
++ right 3 (show $ tStats^.psGoals)
++ right 6 (show $ tStats^.psAssists)
++ right 6 (show $ psPoints tStats)
++ right 6 (show $ tStats^.psPMin)
)
] ]
playerNameColWidth :: [Player] -> Int tHeader =
playerNameColWidth = foldr [ CellText "NO."
(\player current -> max current $ succ $ length $ player^.pName) , CellText "Player"
10 , CellText " G"
, CellText " A"
, CellText " P"
, CellText " PM"
]
showStats :: GameStats -> String statsCells stats =
showStats gs [ CellText $ show $ stats^.psGoals
= right 2 (show $ gmsGames gs) , CellText $ show $ stats^.psAssists
++ right 4 (show $ gs^.gmsWins) , CellText $ show $ psPoints stats
++ right 4 (show $ gs^.gmsLosses) , CellText $ show $ stats^.psPMin
++ right 4 (show $ gs^.gmsOvertime) ]
++ right 4 (show $ gs^.gmsGoalsFor)
++ right 4 (show $ gs^.gmsGoalsAgainst) body = map
++ right 4 (show $ gmsPoints gs) (\(p, stats) ->
[ CellText $ show (p^.pNumber) ++ " "
, CellText $ 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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -33,6 +33,10 @@ module Mtlstats.Types (
CreateGoalieState (..), CreateGoalieState (..),
EditPlayerState (..), EditPlayerState (..),
EditPlayerMode (..), EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
EditStandingsMode (..),
ESMSubMode (..),
Database (..), Database (..),
Player (..), Player (..),
PlayerStats (..), PlayerStats (..),
@@ -41,6 +45,7 @@ module Mtlstats.Types (
GameStats (..), GameStats (..),
Prompt (..), Prompt (..),
SelectParams (..), SelectParams (..),
TableCell (..),
-- * Lenses -- * Lenses
-- ** ProgState Lenses -- ** ProgState Lenses
database, database,
@@ -52,6 +57,10 @@ module Mtlstats.Types (
createPlayerStateL, createPlayerStateL,
createGoalieStateL, createGoalieStateL,
editPlayerStateL, editPlayerStateL,
editGoalieStateL,
editStandingsModeL,
-- ** EditStandingsMode Lenses
esmSubModeL,
-- ** GameState Lenses -- ** GameState Lenses
gameYear, gameYear,
gameMonth, gameMonth,
@@ -89,6 +98,9 @@ module Mtlstats.Types (
-- ** EditPlayerState Lenses -- ** EditPlayerState Lenses
epsSelectedPlayer, epsSelectedPlayer,
epsMode, epsMode,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
-- ** Database Lenses -- ** Database Lenses
dbPlayers, dbPlayers,
dbGoalies, dbGoalies,
@@ -99,6 +111,8 @@ module Mtlstats.Types (
pNumber, pNumber,
pName, pName,
pPosition, pPosition,
pRookie,
pActive,
pYtd, pYtd,
pLifetime, pLifetime,
-- ** PlayerStats Lenses -- ** PlayerStats Lenses
@@ -108,12 +122,15 @@ module Mtlstats.Types (
-- ** Goalie Lenses -- ** Goalie Lenses
gNumber, gNumber,
gName, gName,
gRookie,
gActive,
gYtd, gYtd,
gLifetime, gLifetime,
-- ** GoalieStats Lenses -- ** GoalieStats Lenses
gsGames, gsGames,
gsMinsPlayed, gsMinsPlayed,
gsGoalsAllowed, gsGoalsAllowed,
gsShutouts,
gsWins, gsWins,
gsLosses, gsLosses,
gsTies, gsTies,
@@ -129,6 +146,7 @@ module Mtlstats.Types (
newCreatePlayerState, newCreatePlayerState,
newCreateGoalieState, newCreateGoalieState,
newEditPlayerState, newEditPlayerState,
newEditGoalieState,
newDatabase, newDatabase,
newPlayer, newPlayer,
newPlayerStats, newPlayerStats,
@@ -154,7 +172,6 @@ module Mtlstats.Types (
playerSearchExact, playerSearchExact,
modifyPlayer, modifyPlayer,
playerSummary, playerSummary,
playerDetails,
playerIsActive, playerIsActive,
-- ** PlayerStats Helpers -- ** PlayerStats Helpers
psPoints, psPoints,
@@ -162,7 +179,11 @@ module Mtlstats.Types (
-- ** Goalie Helpers -- ** Goalie Helpers
goalieSearch, goalieSearch,
goalieSearchExact, goalieSearchExact,
goalieSummary goalieSummary,
goalieIsActive,
-- ** GoalieStats Helpers
addGoalieStats,
gsAverage
) where ) where
import Control.Monad.Trans.State (StateT) import Control.Monad.Trans.State (StateT)
@@ -176,8 +197,11 @@ import Data.Aeson
, toJSON , toJSON
, withObject , withObject
, (.:) , (.:)
, (.:?)
, (.!=)
, (.=) , (.=)
) )
import Data.Char (toUpper)
import Data.List (isInfixOf) import Data.List (isInfixOf)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
@@ -212,20 +236,28 @@ data ProgState = ProgState
-- | The program mode -- | The program mode
data ProgMode data ProgMode
= MainMenu = TitleScreen
| NewSeason | MainMenu
| NewSeason Bool
| NewGame GameState | NewGame GameState
| EditMenu
| CreatePlayer CreatePlayerState | CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState | CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState | EditPlayer EditPlayerState
| EditGoalie EditGoalieState
| EditStandings EditStandingsMode
instance Show ProgMode where instance Show ProgMode where
show MainMenu = "MainMenu" show TitleScreen = "TitleScreen"
show NewSeason = "NewSeason" show MainMenu = "MainMenu"
show (NewGame _) = "NewGame" show (NewSeason _) = "NewSeason"
show (CreatePlayer _) = "CreatePlayer" show (NewGame _) = "NewGame"
show (CreateGoalie _) = "CreateGoalie" show EditMenu = "EditMenu"
show (EditPlayer _) = "EditPlayer" show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
show (EditStandings _) = "EditStandings"
-- | The game state -- | The game state
data GameState = GameState data GameState = GameState
@@ -326,14 +358,63 @@ data EditPlayerMode
| EPNumber | EPNumber
| EPName | EPName
| EPPosition | EPPosition
| EPYtdGoals | EPYtd
| EPYtdAssists | EPLifetime
| EPYtdGoals Bool
| EPYtdAssists Bool
| EPYtdPMin | EPYtdPMin
| EPLtGoals | EPLtGoals Bool
| EPLtAssists | EPLtAssists Bool
| EPLtPMin | EPLtPMin
deriving (Eq, Show) 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 standings edit mode
data EditStandingsMode
= ESMMenu
| ESMHome ESMSubMode
| ESMAway ESMSubMode
deriving (Eq, Show)
-- | Represents the standings edit sub-mode
data ESMSubMode
= ESMSubMenu
| ESMEditWins
| ESMEditLosses
| ESMEditOvertime
| ESMEditGoalsFor
| ESMEditGoalsAgainst
deriving (Eq, Show)
-- | Represents the database -- | Represents the database
data Database = Database data Database = Database
{ _dbPlayers :: [Player] { _dbPlayers :: [Player]
@@ -348,13 +429,142 @@ data Database = Database
-- ^ Statistics for away games -- ^ Statistics for away games
} deriving (Eq, Show) } 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
, _pActive :: Bool
-- ^ Indicates that the player is active
, _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
, _gActive :: Bool
-- ^ Indicates that the goalie is active
, _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 instance FromJSON Database where
parseJSON = withObject "Database" $ \v -> Database parseJSON = withObject "Database" $ \v -> Database
<$> v .: "players" <$> v .:? "players" .!= []
<*> v .: "goalies" <*> v .:? "goalies" .!= []
<*> v .: "games" <*> v .:? "games" .!= 0
<*> v .: "home_game_stats" <*> v .:? "home_game_stats" .!= newGameStats
<*> v .: "away_game_stats" <*> v .:? "away_game_stats" .!= newGameStats
instance ToJSON Database where instance ToJSON Database where
toJSON (Database players goalies games hgs ags) = object toJSON (Database players goalies games hgs ags) = object
@@ -371,58 +581,40 @@ instance ToJSON Database where
"home_game_stats" .= hgs <> "home_game_stats" .= hgs <>
"away_game_stats" .= ags "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 instance FromJSON Player where
parseJSON = withObject "Player" $ \v -> Player parseJSON = withObject "Player" $ \v -> Player
<$> v .: "number" <$> v .: "number"
<*> v .: "name" <*> v .: "name"
<*> v .: "position" <*> v .: "position"
<*> v .: "ytd" <*> v .:? "rookie" .!= False
<*> v .: "lifetime" <*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newPlayerStats
<*> v .:? "lifetime" .!= newPlayerStats
instance ToJSON Player where instance ToJSON Player where
toJSON (Player num name pos ytd lt) = object toJSON (Player num name pos rk act ytd lt) = object
[ "number" .= num [ "number" .= num
, "name" .= name , "name" .= name
, "position" .= pos , "position" .= pos
, "rookie" .= rk
, "active" .= act
, "ytd" .= ytd , "ytd" .= ytd
, "lifetime" .= lt , "lifetime" .= lt
] ]
toEncoding (Player num name pos ytd lt) = pairs $ toEncoding (Player num name pos rk act ytd lt) = pairs $
"number" .= num <> "number" .= num <>
"name" .= name <> "name" .= name <>
"position" .= pos <> "position" .= pos <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <> "ytd" .= ytd <>
"lifetime" .= lt "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 instance FromJSON PlayerStats where
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
<$> v .: "goals" <$> v .:? "goals" .!= 0
<*> v .: "assists" <*> v .:? "assists" .!= 0
<*> v .: "penalty_mins" <*> v .:? "penalty_mins" .!= 0
instance ToJSON PlayerStats where instance ToJSON PlayerStats where
toJSON (PlayerStats g a pm) = object toJSON (PlayerStats g a pm) = object
@@ -435,94 +627,61 @@ instance ToJSON PlayerStats where
"assists" .= a <> "assists" .= a <>
"penalty_mins" .= pm "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 instance FromJSON Goalie where
parseJSON = withObject "Goalie" $ \v -> Goalie parseJSON = withObject "Goalie" $ \v -> Goalie
<$> v .: "number" <$> v .: "number"
<*> v .: "name" <*> v .: "name"
<*> v .: "ytd" <*> v .:? "rookie" .!= False
<*> v .: "lifetime" <*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newGoalieStats
<*> v .:? "lifetime" .!= newGoalieStats
instance ToJSON Goalie where instance ToJSON Goalie where
toJSON (Goalie num name ytd lt) = object toJSON (Goalie num name rk act ytd lt) = object
[ "number" .= num [ "number" .= num
, "name" .= name , "name" .= name
, "ytd" .= ytd , "ytd" .= ytd
, "rookie" .= rk
, "active" .= act
, "lifetime" .= lt , "lifetime" .= lt
] ]
toEncoding (Goalie num name ytd lt) = pairs $ toEncoding (Goalie num name rk act ytd lt) = pairs $
"number" .= num <> "number" .= num <>
"name" .= name <> "name" .= name <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <> "ytd" .= ytd <>
"lifetime" .= lt "lifetime" .= lt
-- | Represents a goalie's stats
data GoalieStats = GoalieStats
{ _gsGames :: Int
-- ^ The number of games played
, _gsMinsPlayed :: Int
-- ^ The number of minutes played
, _gsGoalsAllowed :: Int
-- ^ The number of goals allowed
, _gsWins :: Int
-- ^ The number of wins
, _gsLosses :: Int
-- ^ The number of losses
, _gsTies :: Int
-- ^ The number of ties
} deriving (Eq, Show)
instance FromJSON GoalieStats where instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .: "games" <$> v .:? "games" .!= 0
<*> v .: "mins_played" <*> v .:? "mins_played" .!= 0
<*> v .: "goals_allowed" <*> v .:? "goals_allowed" .!= 0
<*> v .: "wins" <*> v .:? "shutouts" .!= 0
<*> v .: "losses" <*> v .:? "wins" .!= 0
<*> v .: "ties" <*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where instance ToJSON GoalieStats where
toJSON (GoalieStats g m a w l t) = object toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g [ "games" .= g
, "mins_played" .= m , "mins_played" .= m
, "goals_allowed" .= a , "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w , "wins" .= w
, "losses" .= l , "losses" .= l
, "ties" .= t , "ties" .= t
] ]
toEncoding (GoalieStats g m a w l t) = pairs $ toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <> "games" .= g <>
"mins_played" .= m <> "mins_played" .= m <>
"goals_allowed" .= a <> "goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <> "wins" .= w <>
"losses" .= l <> "losses" .= l <>
"ties" .= t "ties" .= t
-- | 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 instance FromJSON GameStats where
parseJSON = withObject "GameStats" $ \v -> GameStats parseJSON = withObject "GameStats" $ \v -> GameStats
<$> v .: "wins" <$> v .: "wins"
@@ -546,48 +705,6 @@ instance ToJSON GameStats where
"goals_for" .= gf <> "goals_for" .= gf <>
"goals_against" .= ga "goals_against" .= ga
-- | Defines a user prompt
data Prompt = Prompt
{ promptDrawer :: ProgState -> C.Update ()
-- ^ Draws the prompt to the screen
, promptCharCheck :: Char -> Bool
-- ^ Determines whether or not the character is valid
, promptAction :: String -> Action ()
-- ^ Action to perform when the value is entered
, promptSpecialKey :: C.Key -> Action ()
-- ^ Action to perform when a special key is pressed
}
-- | Parameters for a search prompt
data SelectParams a = SelectParams
{ spPrompt :: String
-- ^ The search prompt
, spSearchHeader :: String
-- ^ The header to display at the top of the search list
, spSearch :: String -> Database -> [(Int, a)]
-- ^ The search function
, spSearchExact :: String -> Database -> Maybe Int
-- ^ Search function looking for an exact match
, spElemDesc :: a -> String
-- ^ Provides a string description of an element
, spCallback :: Maybe Int -> Action ()
-- ^ The function when the selection is made
, spNotFound :: String -> Action ()
-- ^ The function to call when the selection doesn't exist
}
makeLenses ''ProgState
makeLenses ''GameState
makeLenses ''CreatePlayerState
makeLenses ''CreateGoalieState
makeLenses ''EditPlayerState
makeLenses ''Database
makeLenses ''Player
makeLenses ''PlayerStats
makeLenses ''Goalie
makeLenses ''GoalieStats
makeLenses ''GameStats
gameStateL :: Lens' ProgMode GameState gameStateL :: Lens' ProgMode GameState
gameStateL = lens gameStateL = lens
(\case (\case
@@ -616,11 +733,36 @@ editPlayerStateL = lens
_ -> newEditPlayerState) _ -> newEditPlayerState)
(\_ eps -> EditPlayer eps) (\_ eps -> EditPlayer eps)
editGoalieStateL :: Lens' ProgMode EditGoalieState
editGoalieStateL = lens
(\case
EditGoalie egs -> egs
_ -> newEditGoalieState)
(\_ egs -> EditGoalie egs)
editStandingsModeL :: Lens' ProgMode EditStandingsMode
editStandingsModeL = lens
(\case
EditStandings esm -> esm
_ -> ESMMenu)
(\_ esm -> EditStandings esm)
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
esmSubModeL = lens
(\case
ESMMenu -> ESMSubMenu
ESMHome m -> m
ESMAway m -> m)
(\mode subMode -> case mode of
ESMMenu -> ESMMenu
ESMHome _ -> ESMHome subMode
ESMAway _ -> ESMAway subMode)
-- | Constructor for a 'ProgState' -- | Constructor for a 'ProgState'
newProgState :: ProgState newProgState :: ProgState
newProgState = ProgState newProgState = ProgState
{ _database = newDatabase { _database = newDatabase
, _progMode = MainMenu , _progMode = TitleScreen
, _inputBuffer = "" , _inputBuffer = ""
, _scrollOffset = 0 , _scrollOffset = 0
} }
@@ -678,6 +820,13 @@ newEditPlayerState = EditPlayerState
, _epsMode = EPMenu , _epsMode = EPMenu
} }
-- | Constructor for an 'EditGoalieState' value
newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing
, _egsMode = EGMenu
}
-- | Constructor for a 'Database' -- | Constructor for a 'Database'
newDatabase :: Database newDatabase :: Database
newDatabase = Database newDatabase = Database
@@ -701,6 +850,8 @@ newPlayer num name pos = Player
{ _pNumber = num { _pNumber = num
, _pName = name , _pName = name
, _pPosition = pos , _pPosition = pos
, _pRookie = True
, _pActive = True
, _pYtd = newPlayerStats , _pYtd = newPlayerStats
, _pLifetime = newPlayerStats , _pLifetime = newPlayerStats
} }
@@ -723,6 +874,8 @@ newGoalie
newGoalie num name = Goalie newGoalie num name = Goalie
{ _gNumber = num { _gNumber = num
, _gName = name , _gName = name
, _gRookie = True
, _gActive = True
, _gYtd = newGoalieStats , _gYtd = newGoalieStats
, _gLifetime = newGoalieStats , _gLifetime = newGoalieStats
} }
@@ -733,6 +886,7 @@ newGoalieStats = GoalieStats
{ _gsGames = 0 { _gsGames = 0
, _gsMinsPlayed = 0 , _gsMinsPlayed = 0
, _gsGoalsAllowed = 0 , _gsGoalsAllowed = 0
, _gsShutouts = 0
, _gsWins = 0 , _gsWins = 0
, _gsLosses = 0 , _gsLosses = 0
, _gsTies = 0 , _gsTies = 0
@@ -828,9 +982,8 @@ playerSearch
-> [(Int, Player)] -> [(Int, Player)]
-- ^ The matching players with their index numbers -- ^ The matching players with their index numbers
playerSearch sStr = playerSearch sStr =
filter (match sStr) . filter match . zip [0..]
zip [0..] where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
-- | Searches for a player by exact match on name -- | Searches for a player by exact match on name
playerSearchExact playerSearchExact
@@ -841,10 +994,8 @@ playerSearchExact
-> Maybe (Int, Player) -> Maybe (Int, Player)
-- ^ The player's index and value -- ^ The player's index and value
playerSearchExact sStr = playerSearchExact sStr =
listToMaybe . listToMaybe . filter match . zip [0..]
filter (match sStr) . where match (_, p) = p^.pName == sStr
zip [0..]
where match sStr (_, p) = p^.pName == sStr
-- | Modifies a player with a given name -- | Modifies a player with a given name
modifyPlayer modifyPlayer
@@ -866,20 +1017,6 @@ playerSummary :: Player -> String
playerSummary p = playerSummary p =
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
-- | Provides a detailed string describing a 'Player'
playerDetails :: Player -> String
playerDetails p = unlines
[ " Number: " ++ show (p^.pNumber)
, " Name: " ++ p^.pName
, " Position: " ++ p^.pPosition
, " YTD goals: " ++ show (p^.pYtd.psGoals)
, " YTD assists: " ++ show (p^.pYtd.psAssists)
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
]
-- | Determines whether or not a player has been active in the current -- | Determines whether or not a player has been active in the current
-- season/year -- season/year
playerIsActive :: Player -> Bool playerIsActive :: Player -> Bool
@@ -909,8 +1046,9 @@ goalieSearch
-- ^ The list to search -- ^ The list to search
-> [(Int, Goalie)] -> [(Int, Goalie)]
-- ^ The search results with their corresponding index numbers -- ^ The search results with their corresponding index numbers
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) . goalieSearch sStr =
zip [0..] filter match . zip [0..]
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
-- | Searches a list of goalies for an exact match -- | Searches a list of goalies for an exact match
goalieSearchExact goalieSearchExact
@@ -930,3 +1068,30 @@ goalieSearchExact sStr goalies = let
-- | Provides a description string for a 'Goalie' -- | Provides a description string for a 'Goalie'
goalieSummary :: Goalie -> String goalieSummary :: Goalie -> String
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")" goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
-- | Determines whether or not a goalie has been active in the current
-- season
goalieIsActive :: Goalie -> Bool
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
-- | Adds two sets of 'GoalieStats'
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
addGoalieStats g1 g2 = GoalieStats
{ _gsGames = g1^.gsGames + g2^.gsGames
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
, _gsWins = g1^.gsWins + g2^.gsWins
, _gsLosses = g1^.gsLosses + g2^.gsLosses
, _gsTies = g1^.gsTies + g2^.gsTies
}
-- | Determines a goalie's average goals allowed per game.
gsAverage :: GoalieStats -> Rational
gsAverage gs = 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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -38,8 +38,8 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
-- | Defines a menu -- | Defines a menu
@@ -66,8 +66,15 @@ makeLenses ''Menu
makeLenses ''MenuItem makeLenses ''MenuItem
instance Show (Menu a) where instance Show (Menu a) where
show m = m ^. menuTitle ++ "\n" ++ items show m = unlines
where items = unlines $ map show $ m ^. menuItems $ [ m^.menuTitle
, ""
]
++ body
where
body = map (left width) items
width = maximum $ map length items
items = map show $ m^.menuItems
instance Show (MenuItem a) where instance Show (MenuItem a) where
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription show i = [i ^. miKey] ++ ": " ++ i ^. miDescription

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 import qualified Data.Map as M
-- | Attempt to select the element from a list at a given index -- | Attempt to select the element from a list at a given index
@@ -75,3 +82,25 @@ slice
-- ^ The list to take a subset of -- ^ The list to take a subset of
-> [a] -> [a]
slice offset len = take len . drop offset 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,83 @@
{-
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 Actions.EditStandingsSpec (spec) where
import Lens.Micro ((^.), (&), (.~))
import Test.Hspec
( Spec
, context
, describe
, it
, shouldBe
, shouldSatisfy
)
import Mtlstats.Actions.EditStandings
import Mtlstats.Types
spec :: Spec
spec = describe "EditStandings" $ do
mapM_
(\(label, f, expected) -> describe label $ do
let
ps = newProgState
ps' = f ps
it "should set progMode to EditStandings" $
ps'^.progMode `shouldSatisfy` \case
(EditStandings _) -> True
_ -> False
it ("should set editStandingsMode to " ++ show expected) $
ps'^.progMode.editStandingsModeL `shouldBe` expected)
-- label, function, expected mode
[ ( "editStandings", editStandings, ESMMenu )
, ( "editHomeStandings", editHomeStandings, ESMHome ESMSubMenu )
, ( "editAwayStandings", editAwayStandings, ESMAway ESMSubMenu )
]
mapM_
(\(label, f, expected) -> describe label $ do
mapM_
(\prefix -> context ("mode: " ++ show (prefix ESMSubMenu)) $ let
ps = newProgState & progMode.editStandingsModeL .~ prefix ESMSubMenu
ps' = f ps
in it ("should set the mode to " ++ show expected) $
ps'^.progMode.editStandingsModeL `shouldBe` prefix expected)
[ESMHome, ESMAway]
context "mode: ESMMenu" $ let
ps = newProgState & progMode.editStandingsModeL .~ ESMMenu
ps' = f ps
in it "should not change the mode" $
ps'^.progMode.editStandingsModeL `shouldBe` ESMMenu)
-- label, function, expected
[ ( "editWins", editWins, ESMEditWins )
, ( "editLosses", editLosses, ESMEditLosses )
, ( "editOvertime", editOvertime, ESMEditOvertime )
, ( "editGoalsFor", editGoalsFor, ESMEditGoalsFor )
, ( "editGoalsAgainst", editGoalsAgainst, ESMEditGoalsAgainst )
]

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -19,14 +19,14 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Actions.GoalieInputSpec (spec) where module Actions.NewGame.GoalieInputSpec (spec) where
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~)) import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.GoalieInput import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
& progMode.gameStateL .~ gameState n mins goals & progMode.gameStateL .~ gameState n mins goals
in mapM_ in mapM_
(\(name, gid, mins, goals, joeData, bobData, reset) -> let (\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
s = recordGoalieStats $ progState gid mins goals s = recordGoalieStats $ progState setGid mins goals
in context name $ do in context setName $ do
mapM_ mapM_
(\( name (\( chkName
, gid , chkGid
, ( gGames , ( gGames
, gMins , gMins
, gGoals , gGoals
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
, ltMins , ltMins
, ltGoals , ltGoals
) )
) -> context name $ do ) -> context chkName $ do
let let
gs = s^.progMode.gameStateL.gameGoalieStats gs = s^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gs game = M.findWithDefault newGoalieStats chkGid gs
goalie = fromJust $ nth gid $ s^.database.dbGoalies goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
ytd = goalie^.gYtd ytd = goalie^.gYtd
lt = goalie^.gLifetime lt = goalie^.gLifetime
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
] ]
context "selected goalie" $ let context "selected goalie" $ let
expected = if reset then Nothing else gid expected = if reset then Nothing else setGid
in it ("should be " ++ show expected) $ in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected (s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
tiedGame = gameState 0 1 True tiedGame = gameState 0 1 True
in mapM_ in mapM_
(\(label, gameState, gid, bobData, joeData) -> context label $ let (\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
progState = newProgState progState = newProgState
& database.dbGoalies .~ [bob, joe] & database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gameState & progMode.gameStateL .~ gs
& setGameGoalie gid & setGameGoalie setGid
in mapM_ in mapM_
(\( label (\( chkLabel
, gid , chkGid
, ( gWins , ( gWins
, gLosses , gLosses
, gTies , gTies
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
, ltLosses , ltLosses
, ltTies , ltTies
) )
) -> context label $ do ) -> context chkLabel $ do
let let
goalie = (progState^.database.dbGoalies) !! gid goalie = (progState^.database.dbGoalies) !! chkGid
gameStats = progState^.progMode.gameStateL.gameGoalieStats gameStats = progState^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gameStats game = M.findWithDefault newGoalieStats chkGid gameStats
ytd = goalie^.gYtd ytd = goalie^.gYtd
lifetime = goalie^.gLifetime lifetime = goalie^.gLifetime
mapM_ mapM_
(\(label, expected, actual) -> context label $ (\(label', expected, actual) -> context label' $
expected `TS.compareTest` actual) expected `TS.compareTest` actual)
[ ( "game stats", game, goalieStats gWins gLosses gTies ) [ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies ) , ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )

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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module ActionsSpec (spec) where
import Control.Monad (replicateM) import Control.Monad (replicateM)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO)
import Test.Hspec import Test.Hspec
( Spec ( Spec
, context , context
, describe , describe
, it , it
, runIO
, shouldBe , shouldBe
, shouldNotBe , shouldNotBe
, shouldSatisfy , shouldSatisfy
@@ -41,9 +37,9 @@ import Test.Hspec
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.GoalieInputSpec as GoalieInput import qualified Actions.NewGameSpec as NewGame
import qualified Actions.EditStandingsSpec as EditStandings
import qualified TypesSpec as TS import qualified TypesSpec as TS
spec :: Spec spec :: Spec
@@ -51,27 +47,26 @@ spec = describe "Mtlstats.Actions" $ do
startNewSeasonSpec startNewSeasonSpec
startNewGameSpec startNewGameSpec
resetYtdSpec resetYtdSpec
clearRookiesSpec
resetStandingsSpec
addCharSpec addCharSpec
removeCharSpec removeCharSpec
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
createPlayerSpec createPlayerSpec
createGoalieSpec createGoalieSpec
editSpec
editPlayerSpec editPlayerSpec
editSelectedPlayerSpec
editGoalieSpec
editSelectedGoalieSpec
addPlayerSpec addPlayerSpec
addGoalieSpec addGoalieSpec
resetCreatePlayerStateSpec resetCreatePlayerStateSpec
resetCreateGoalieStateSpec resetCreateGoalieStateSpec
recordGoalAssistsSpec
awardGoalSpec
awardAssistSpec
resetGoalDataSpec
assignPMinsSpec
backHomeSpec backHomeSpec
scrollUpSpec scrollUpSpec
scrollDownSpec scrollDownSpec
GoalieInput.spec NewGame.spec
EditStandings.spec
startNewSeasonSpec :: Spec startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do startNewSeasonSpec = describe "startNewSeason" $ do
@@ -99,8 +94,8 @@ startNewGameSpec = describe "startNewGame" $ do
resetYtdSpec :: Spec resetYtdSpec :: Spec
resetYtdSpec = describe "resetYtd" $ resetYtdSpec = describe "resetYtd" $
it "should reset the year-to-date stats for all players" $ do it "should reset the year-to-date stats for all players" $ do
ps <- replicateM 2 makePlayer ps <- replicateM 2 TS.makePlayer
gs <- replicateM 2 makeGoalie gs <- replicateM 2 TS.makeGoalie
let let
s = newProgState s = newProgState
& database . dbPlayers .~ ps & database . dbPlayers .~ ps
@@ -137,6 +132,80 @@ resetYtdSpec = describe "resetYtd" $
lt ^. gsTies `shouldNotBe` 0) $ lt ^. gsTies `shouldNotBe` 0) $
s ^. database . dbGoalies s ^. database . dbGoalies
clearRookiesSpec :: Spec
clearRookiesSpec = describe "clearRookies" $ do
let
players =
[ newPlayer 1 "Joe" "centre" & pRookie .~ True
, newPlayer 2 "Bob" "centre" & pRookie .~ False
]
goalies =
[ newGoalie 3 "Bill" & gRookie .~ True
, newGoalie 4 "Doug" & gRookie .~ False
]
ps = newProgState
& database
%~ (dbPlayers .~ players)
. (dbGoalies .~ goalies)
ps' = clearRookies ps
context "Players" $ mapM_
(\p -> let
name = p^.pName
rFlag = p^.pRookie
in context name $
it "should not be a rookie" $
rFlag `shouldBe` False)
(ps'^.database.dbPlayers)
context "Goalies" $ mapM_
(\g -> let
name = g^.gName
rFlag = g^.gRookie
in context name $
it "should not be a rookie" $
rFlag `shouldBe` False)
(ps'^.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 :: Spec
addCharSpec = describe "addChar" $ addCharSpec = describe "addChar" $
it "should add the character to the input buffer" $ let it "should add the character to the input buffer" $ let
@@ -160,202 +229,6 @@ removeCharSpec = describe "removeChar" $ do
& removeChar & removeChar
in s ^. inputBuffer `shouldBe` "fo" 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 :: Spec
createPlayerSpec = describe "createPlayer" $ createPlayerSpec = describe "createPlayer" $
it "should change the mode appropriately" $ let it "should change the mode appropriately" $ let
@@ -368,12 +241,76 @@ createGoalieSpec = describe "createGoalie" $
s = createGoalie newProgState s = createGoalie newProgState
in show (s^.progMode) `shouldBe` "CreateGoalie" 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 :: Spec
editPlayerSpec = describe "editPlayer" $ editPlayerSpec = describe "editPlayer" $
it "should change the mode appropriately" $ let it "should change the mode appropriately" $ let
s = editPlayer newProgState s = editPlayer newProgState
in show (s^.progMode) `shouldBe` "EditPlayer" 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 :: Spec
addPlayerSpec = describe "addPlayer" $ do addPlayerSpec = describe "addPlayer" $ do
let let
@@ -440,281 +377,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
newProgState & progMode.createGoalieStateL .~ cgs newProgState & progMode.createGoalieStateL .~ cgs
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
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_
(\(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
it ("should increment " ++ pName ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` ytd
it ("should increment " ++ pName ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` lt
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)])
. (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 )
]
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 :: IO Int
makeNum = randomRIO (1, 10)
makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z')
backHomeSpec :: Spec backHomeSpec :: Spec
backHomeSpec = describe "backHome" $ do backHomeSpec = describe "backHome" $ do
let let
@@ -755,6 +417,7 @@ scrollUpSpec = describe "scrollUp" $ do
ps' = scrollUp ps ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 0 in ps'^.scrollOffset `shouldBe` 0
scrollDownSpec :: Spec
scrollDownSpec = describe "scrollDown" $ scrollDownSpec = describe "scrollDown" $
it "should increase the scroll offset" $ let it "should increase the scroll offset" $ let
ps = newProgState & scrollOffset .~ 10 ps = newProgState & scrollOffset .~ 10

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module FormatSpec (spec) where
import Data.Ratio ((%))
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Types
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Format" $ do spec = describe "Mtlstats.Format" $ do
@@ -31,8 +33,15 @@ spec = describe "Mtlstats.Format" $ do
leftSpec leftSpec
rightSpec rightSpec
centreSpec centreSpec
padRightSpec
overlaySpec overlaySpec
monthSpec monthSpec
labelTableSpec
numTableSpec
tableWithSpec
complexTableSpec
overlayLastSpec
showFloatingSpec
padNumSpec :: Spec padNumSpec :: Spec
padNumSpec = describe "padNum" $ do padNumSpec = describe "padNum" $ do
@@ -90,6 +99,16 @@ centreSpec = describe "centre" $ do
it "should truncate the text" $ it "should truncate the text" $
centre 2 "foo" `shouldBe` "fo" 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 :: Spec
overlaySpec = describe "overlay" $ do overlaySpec = describe "overlay" $ do
@@ -111,3 +130,120 @@ monthSpec = describe "month" $ do
context "invalid" $ context "invalid" $
it "should return an empty string" $ it "should return an empty string" $
month 0 `shouldBe` "" 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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -0,0 +1,91 @@
{-
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", rookie, "foo*" )
, ( "non-rookie", active, "foo" )
, ( "retired", retired, "*foo" )
]
where
rookie = goalie True True
active = goalie False True
retired = goalie False False
goalie r a = newGoalie 1 "foo"
& gRookie .~ r
& gActive .~ a

View File

@@ -0,0 +1,83 @@
{-
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" )
, ( "retired", retired, "*foo" )
]
where
rookie = player True True
nonRookie = player False True
retired = player False False
player r a = newPlayer 1 "foo" "centre"
& pRookie .~ r
& pActive .~ a

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 mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 module ReportSpec (spec) where
import Lens.Micro ((&), (?~), (%~)) import Lens.Micro ((&), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Report import Mtlstats.Report
import Mtlstats.Types import Mtlstats.Types
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Report" $ do spec = describe "Mtlstats.Report"
gameDateSpec gameDateSpec
playerNameColWidthSpec
gameDateSpec :: Spec gameDateSpec :: Spec
gameDateSpec = describe "gameDate" $ do gameDateSpec = describe "gameDate" $ do
@@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
context "invalid date" $ context "invalid date" $
it "should return an empty string" $ it "should return an empty string" $
gameDate newGameState `shouldBe` "" gameDate newGameState `shouldBe` ""
playerNameColWidthSpec :: Spec
playerNameColWidthSpec = describe "playerNameColWidth" $ do
let
short1 = newPlayer 1 "short" "foo"
short2 = newPlayer 2 "shorty" "bar"
long = newPlayer 3 "123456789012345" "baz"
mapM_
(\(label, players, expected) -> context label $
it ("should be " ++ show expected) $
playerNameColWidth players `shouldBe` expected)
-- label, players, expected
[ ( "empty list", [], 10 )
, ( "short names", [short1, short2], 10 )
, ( "long name", [short1, long], 16 )
]

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 ActionsSpec as Actions
import qualified FormatSpec as Format import qualified FormatSpec as Format
import qualified HandlersSpec as Handlers import qualified HandlersSpec as Handlers
import qualified HelpersSpec as Helpers
import qualified ReportSpec as Report import qualified ReportSpec as Report
import qualified TypesSpec as Types import qualified TypesSpec as Types
import qualified UtilSpec as Util import qualified UtilSpec as Util
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
main :: IO () main :: IO ()
main = hspec $ do main = hspec $ do
Types.spec Types.spec
Helpers.spec
Actions.spec Actions.spec
Format.spec Format.spec
Handlers.spec Handlers.spec

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -37,11 +37,11 @@ showSpec :: Spec
showSpec = describe "show" $ showSpec = describe "show" $
it "should display correctly" $ let it "should display correctly" $ let
menu = Menu "Foo" () menu = Menu "Foo" ()
[ MenuItem '1' "Item 1" $ return () [ MenuItem '1' "foo" $ return ()
, MenuItem '2' "Item 2" $ return () , MenuItem '2' "bar baz" $ return ()
] ]
expected = expected =
"Foo\n\ "Foo\n\n\
\1) Item 1\n\ \1: foo \n\
\2) Item 2\n" \2: bar baz\n"
in show menu `shouldBe` expected in show menu `shouldBe` expected

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify 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 #-} {-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec (Comparable (..), 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 (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object)) import Data.Aeson.Types (Value (Object))
import Data.ByteString.Lazy (ByteString)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~)) import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomIO, randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config import Mtlstats.Config
@@ -48,6 +57,9 @@ spec = describe "Mtlstats.Types" $ do
createPlayerStateLSpec createPlayerStateLSpec
createGoalieStateLSpec createGoalieStateLSpec
editPlayerStateLSpec editPlayerStateLSpec
editGoalieStateLSpec
editStandingsModeLSpec
esmSubModeLSpec
teamScoreSpec teamScoreSpec
otherScoreSpec otherScoreSpec
homeTeamSpec homeTeamSpec
@@ -63,13 +75,15 @@ spec = describe "Mtlstats.Types" $ do
playerSearchExactSpec playerSearchExactSpec
modifyPlayerSpec modifyPlayerSpec
playerSummarySpec playerSummarySpec
playerDetailsSpec
playerIsActiveSpec playerIsActiveSpec
psPointsSpec psPointsSpec
addPlayerStatsSpec addPlayerStatsSpec
goalieSearchSpec goalieSearchSpec
goalieSearchExactSpec goalieSearchExactSpec
goalieSummarySpec goalieSummarySpec
goalieIsActiveSpec
addGoalieStatsSpec
gsAverageSpec
Menu.spec Menu.spec
playerSpec :: Spec playerSpec :: Spec
@@ -161,6 +175,65 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
eps2 = newEditPlayerState eps2 = newEditPlayerState
& epsSelectedPlayer ?~ 2 & epsSelectedPlayer ?~ 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
editStandingsModeLSpec :: Spec
editStandingsModeLSpec = describe "editStandingsModeL" $
lensSpec editStandingsModeL
-- getters
[ ( "missing mode", MainMenu, menu )
, ( "with mode", EditStandings home, home )
]
-- setters
[ ( "set mode", MainMenu, home )
, ( "change mode", EditStandings home, away )
]
where
menu = ESMMenu
home = ESMHome ESMSubMenu
away = ESMAway ESMSubMenu
esmSubModeLSpec :: Spec
esmSubModeLSpec = describe "esmSubModeL" $ do
context "getters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $
mode^.esmSubModeL `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMSubMenu )
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
]
context "setters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $ let
mode' = mode & esmSubModeL .~ ESMEditWins
in mode' `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMMenu )
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
]
teamScoreSpec :: Spec teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do teamScoreSpec = describe "teamScore" $ do
let let
@@ -241,6 +314,7 @@ lensSpec lens getters setters = do
player :: Player player :: Player
player = newPlayer 1 "Joe" "centre" player = newPlayer 1 "Joe" "centre"
& pRookie .~ False
& pYtd .~ playerStats 1 & pYtd .~ playerStats 1
& pLifetime .~ playerStats 2 & pLifetime .~ playerStats 2
@@ -249,6 +323,8 @@ playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) ) [ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) ) , ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) ) , ( "position", toJSON ("centre" :: String) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", playerStatsJSON 1 ) , ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 ) , ( "lifetime", playerStatsJSON 2 )
] ]
@@ -268,6 +344,7 @@ playerStatsJSON n = Object $ HM.fromList
goalie :: Goalie goalie :: Goalie
goalie = newGoalie 1 "Joe" goalie = newGoalie 1 "Joe"
& gRookie .~ False
& gYtd .~ goalieStats 1 & gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2 & gLifetime .~ goalieStats 2
@@ -275,6 +352,8 @@ goalieJSON :: Value
goalieJSON = Object $ HM.fromList goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) ) [ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) ) , ( "name", toJSON ("Joe" :: String ) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", goalieStatsJSON 1 ) , ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 ) , ( "lifetime", goalieStatsJSON 2 )
] ]
@@ -284,18 +363,20 @@ goalieStats n = newGoalieStats
& gsGames .~ n & gsGames .~ n
& gsMinsPlayed .~ n + 1 & gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2 & gsGoalsAllowed .~ n + 2
& gsWins .~ n + 3 & gsShutouts .~ n + 3
& gsLosses .~ n + 4 & gsWins .~ n + 4
& gsTies .~ n + 5 & gsLosses .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n ) [ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 ) , ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 ) , ( "goals_allowed", toJSON $ n + 2 )
, ( "wins", toJSON $ n + 3 ) , ( "shutouts", toJSON $ n + 3 )
, ( "losses", toJSON $ n + 4 ) , ( "wins", toJSON $ n + 4 )
, ( "ties", toJSON $ n + 5 ) , ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
] ]
gameStats :: Int -> GameStats gameStats :: Int -> GameStats
@@ -559,7 +640,7 @@ playerSearchSpec = describe "playerSearch" $ mapM_
ps = [joe, bob, steve] ps = [joe, bob, steve]
in playerSearch sStr ps `shouldBe` expected) in playerSearch sStr ps `shouldBe` expected)
-- search, result -- search, result
[ ( "Joe", [(0, joe)] ) [ ( "joe", [(0, joe)] )
, ( "o", [(0, joe), (1, bob)] ) , ( "o", [(0, joe), (1, bob)] )
, ( "e", [(0, joe), (2, steve)] ) , ( "e", [(0, joe), (2, steve)] )
, ( "x", [] ) , ( "x", [] )
@@ -581,22 +662,22 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
modifyPlayerSpec :: Spec modifyPlayerSpec :: Spec
modifyPlayerSpec = describe "modifyPlayer" $ mapM_ modifyPlayerSpec = describe "modifyPlayer" $ mapM_
(\(pName, j, b, s) -> let (\(name, j, b, s) -> let
modifier = pLifetime.psGoals .~ 1 modifier = pLifetime.psGoals .~ 1
players = modifyPlayer modifier pName [joe, bob, steve] players = modifyPlayer modifier name [joe, bob, steve]
in context ("modify " ++ pName) $ do in context ("modify " ++ name) $ do
context "Joe's lifetime goals" $ context "Joe's lifetime goals" $
it ("should be " ++ show j) $ it ("should be " ++ show j) $
head players ^. pLifetime.psGoals `shouldBe` j head players^.pLifetime.psGoals `shouldBe` j
context "Bob's lifetime goals" $ context "Bob's lifetime goals" $
it ("should be " ++ show b) $ it ("should be " ++ show b) $
(players !! 1) ^. pLifetime.psGoals `shouldBe` b (players !! 1)^.pLifetime.psGoals `shouldBe` b
context "Steve's lifetime goals" $ context "Steve's lifetime goals" $
it ("should be " ++ show s) $ it ("should be " ++ show s) $
last players ^. pLifetime.psGoals `shouldBe` s) last players^.pLifetime.psGoals `shouldBe` s)
-- player name, Joe's goals, Bob's goals, Steve's goals -- player name, Joe's goals, Bob's goals, Steve's goals
[ ( "Joe", 1, 0, 0 ) [ ( "Joe", 1, 0, 0 )
, ( "Bob", 0, 1, 0 ) , ( "Bob", 0, 1, 0 )
@@ -609,54 +690,24 @@ playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $ it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center" playerSummary joe `shouldBe` "Joe (2) center"
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
player = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Position: centre"
, " YTD goals: 2"
, " YTD assists: 3"
, " YTD penalty mins: 4"
, " Lifetime goals: 5"
, " Lifetime assists: 6"
, "Lifetime penalty mins: 7"
]
in playerDetails player `shouldBe` expected
playerIsActiveSpec :: Spec playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do playerIsActiveSpec = describe "playerIsActive" $ do
let let
pState = newPlayerStats pStats = newPlayerStats
& psGoals .~ 10 & psGoals .~ 10
& psAssists .~ 11 & psAssists .~ 11
& psPMin .~ 12 & psPMin .~ 12
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
mapM_ mapM_
(\(label, player', expected) -> context label $ (\(label, p', expected) -> context label $
it ("should be " ++ show expected) $ it ("should be " ++ show expected) $
playerIsActive player' `shouldBe` expected) playerIsActive p' `shouldBe` expected)
-- label, player, expected -- label, player, expected
[ ( "not active", player, False ) [ ( "not active", p, False )
, ( "has goal", player & pYtd.psGoals .~ 1, True ) , ( "has goal", p & pYtd.psGoals .~ 1, True )
, ( "has assist", player & pYtd.psAssists .~ 1, True ) , ( "has assist", p & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True ) , ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
] ]
psPointsSpec :: Spec psPointsSpec :: Spec
@@ -723,8 +774,8 @@ goalieSearchSpec = describe "goalieSearch" $ do
goalieSearch "x" goalies `shouldBe` [] goalieSearch "x" goalies `shouldBe` []
context "exact match" $ context "exact match" $
it "should return Steve" $ it "should return Bob" $
goalieSearch "Bob" goalies `shouldBe` [result 1] goalieSearch "bob" goalies `shouldBe` [result 1]
goalieSearchExactSpec :: Spec goalieSearchExactSpec :: Spec
goalieSearchExactSpec = describe "goalieSearchExact" $ do goalieSearchExactSpec = describe "goalieSearchExact" $ do
@@ -755,6 +806,77 @@ goalieSummarySpec = describe "goalieSummary" $
it "should provide a summary string" $ it "should provide a summary string" $
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)" goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
goalieIsActiveSpec :: Spec
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
(\(label, input, expected) -> context label $
it ("should be " ++ show expected) $
goalieIsActive input `shouldBe` expected)
-- label, input, expected
[ ( "inactive", inactive, False )
, ( "active", active, True )
]
where
inactive = newGoalie 1 "Joe"
& gLifetime.gsMinsPlayed .~ 1
active = inactive
& gYtd.gsMinsPlayed .~ 1
addGoalieStatsSpec :: Spec
addGoalieStatsSpec = describe "addGoalieStats" $ let
g1 = GoalieStats
{ _gsGames = 1
, _gsMinsPlayed = 2
, _gsGoalsAllowed = 3
, _gsShutouts = 4
, _gsWins = 5
, _gsLosses = 6
, _gsTies = 7
}
g2 = GoalieStats
{ _gsGames = 8
, _gsMinsPlayed = 9
, _gsGoalsAllowed = 10
, _gsShutouts = 11
, _gsWins = 12
, _gsLosses = 13
, _gsTies = 14
}
expected = GoalieStats
{ _gsGames = 9
, _gsMinsPlayed = 11
, _gsGoalsAllowed = 13
, _gsShutouts = 15
, _gsWins = 17
, _gsLosses = 19
, _gsTies = 21
}
actual = g1 `addGoalieStats` g2
in it ("should be " ++ show expected) $
actual `shouldBe` expected
gsAverageSpec :: Spec
gsAverageSpec = describe "gsAverage" $ 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 :: Player
joe = newPlayer 2 "Joe" "center" joe = newPlayer 2 "Joe" "center"
@@ -764,6 +886,54 @@ bob = newPlayer 3 "Bob" "defense"
steve :: Player steve :: Player
steve = newPlayer 5 "Steve" "forward" steve = newPlayer 5 "Steve" "forward"
-- | Creates a 'Player'
makePlayer :: IO Player
makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makeBool
<*> makeBool
<*> makePlayerStats
<*> makePlayerStats
-- | Creates a 'Goalie'
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeBool
<*> 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 instance Comparable GoalieStats where
compareTest actual expected = mapM_ compareTest actual expected = mapM_
(\(name, lens) -> describe name $ (\(name, lens) -> describe name $
@@ -809,6 +979,17 @@ instance Comparable EditPlayerState where
it ("should be " ++ show (expected^.epsMode)) $ it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` 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 instance Comparable CreateGoalieState where
compareTest actual expected = do compareTest actual expected = do
@@ -819,3 +1000,8 @@ instance Comparable CreateGoalieState where
describe "cgsName" $ describe "cgsName" $
it ("should be " ++ expected^.cgsName) $ it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName actual^.cgsName `shouldBe` expected^.cgsName
instance Comparable EditStandingsMode where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 2019 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -32,6 +32,7 @@ spec = describe "Mtlstats.Util" $ do
modifyNthSpec modifyNthSpec
updateMapSpec updateMapSpec
sliceSpec sliceSpec
capitalizeNameSpec
nthSpec :: Spec nthSpec :: Spec
nthSpec = describe "nth" $ mapM_ nthSpec = describe "nth" $ mapM_
@@ -49,18 +50,19 @@ nthSpec = describe "nth" $ mapM_
modifyNthSpec :: Spec modifyNthSpec :: Spec
modifyNthSpec = describe "modifyNth" $ do modifyNthSpec = describe "modifyNth" $ do
let list = [1, 2, 3] :: [Int]
context "in bounds" $ context "in bounds" $
it "should modify the value" $ 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" $ context "out of bounds" $
it "should not modify the value" $ 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" $ context "negative index" $
it "should not modify the value" $ 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 :: Spec
updateMapSpec = describe "updateMap" $ do updateMapSpec = describe "updateMap" $ do
@@ -68,7 +70,7 @@ updateMapSpec = describe "updateMap" $ do
input = M.fromList [(1, 2), (3, 5)] input = M.fromList [(1, 2), (3, 5)]
context "key found" $ let 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" $ in it "should update the value" $
updateMap 1 10 succ input `shouldBe` expected updateMap 1 10 succ input `shouldBe` expected
@@ -79,7 +81,7 @@ updateMapSpec = describe "updateMap" $ do
sliceSpec :: Spec sliceSpec :: Spec
sliceSpec = describe "slice" $ do sliceSpec = describe "slice" $ do
let list = [2, 4, 6, 8] let list = [2, 4, 6, 8] :: [Int]
context "sublist" $ context "sublist" $
it "should return the sublist" $ it "should return the sublist" $
@@ -92,3 +94,23 @@ sliceSpec = describe "slice" $ do
context "negative offset" $ context "negative offset" $
it "should return the correct number of elements from the beginning" $ it "should return the correct number of elements from the beginning" $
slice (-10) 2 list `shouldBe` [2, 4] 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" )
]