167 Commits

Author SHA1 Message Date
Jonathan Lamothe
c20fb30f5b version 0.15.0 2020-03-13 00:00:52 -04:00
Jonathan Lamothe
3c0e690ed3 Merge pull request #82 from mtlstats/del-player
delete player/goalie
2020-03-12 23:59:16 -04:00
Jonathan Lamothe
f37e231623 updated change log 2020-03-12 23:53:27 -04:00
Jonathan Lamothe
fbaf2a1e60 exit properly from delete menus 2020-03-12 23:52:40 -04:00
Jonathan Lamothe
65979329bd added player/goalie delete to menus 2020-03-12 23:42:40 -04:00
Jonathan Lamothe
ded019faac implemented deleting of goalies 2020-03-12 23:37:42 -04:00
Jonathan Lamothe
1322004d38 implemented player deletion 2020-03-12 23:19:17 -04:00
Jonathan Lamothe
2cb279e7e7 implemented dropNth 2020-03-12 22:41:28 -04:00
Jonathan Lamothe
7ca66ad801 Merge pull request #81 from mtlstats/page-break
add page break to report
2020-03-12 22:14:40 -04:00
Jonathan Lamothe
82544046ce add page break to report 2020-03-12 22:09:05 -04:00
Jonathan Lamothe
95c97d722e removed unnecessary dbFname config value 2020-03-12 12:47:38 -04:00
Jonathan Lamothe
0eb46cacce Merge pull request #80 from mtlstats/season-select
Select season database on startup
2020-03-12 03:27:04 -04:00
Jonathan Lamothe
25f887a5e8 don't call modify if database isn't changing 2020-03-12 03:19:27 -04:00
Jonathan Lamothe
7ba670948b updated change log 2020-03-12 02:46:44 -04:00
Jonathan Lamothe
ca06b0570e load and save databases properly 2020-03-12 02:44:41 -04:00
Jonathan Lamothe
1e8473538a prompt for database name 2020-03-11 03:56:58 -04:00
Jonathan Lamothe
87336dcd1d control flow branch for reading database 2020-03-11 03:20:38 -04:00
Jonathan Lamothe
ffa241c1f7 added dbName field to ProgState 2020-03-11 03:09:47 -04:00
Jonathan Lamothe
f9085832f4 version 0.14.0 2020-03-05 16:56:48 -05:00
Jonathan Lamothe
e15623bde3 Merge pull request #79 from mtlstats/report-file
output report to a text file (report.txt)
2020-03-05 16:54:55 -05:00
Jonathan Lamothe
db62fbb542 output report to a text file (report.txt) 2020-03-05 16:45:40 -05:00
Jonathan Lamothe
4a8515b862 Merge pull request #78 from mtlstats/fix-shutouts
Fix shutouts
2020-03-05 05:35:17 -05:00
Jonathan Lamothe
e4c668d1e4 updated change log 2020-03-05 05:28:56 -05:00
Jonathan Lamothe
9ee33cbd03 hlint suggestions 2020-03-05 05:26:25 -05:00
Jonathan Lamothe
53c49492cb fixed shutout bug
shutouts weren't being recorded
2020-03-05 05:26:25 -05:00
Jonathan Lamothe
4d1eaa1523 Merge branch 'master' into dev 2020-03-05 05:24:57 -05:00
Jonathan Lamothe
29fae81513 version 0.13.0 2020-03-05 05:21:34 -05:00
Jonathan Lamothe
8a8a550854 Merge pull request #77 from mtlstats/vagrant
vagrant setup
2020-03-03 14:33:58 -05:00
Jonathan Lamothe
6227df8e01 vagrant setup 2020-03-03 14:23:13 -05:00
Jonathan Lamothe
0676bf4067 Merge pull request #76 from mtlstats/single-goalie
don't ask which goalie to assign the game to when there's only one
2020-02-14 23:02:47 -05:00
Jonathan Lamothe
119032ca80 don't ask which goalie to assign the game to when there's only one 2020-02-14 22:56:35 -05:00
Jonathan Lamothe
2607fc5ce8 Merge pull request #75 from mtlstats/active-check
ask whether player/goalie is active on creation
2020-02-14 00:15:17 -05:00
Jonathan Lamothe
d18cb7dd59 updated change log 2020-02-14 00:09:34 -05:00
Jonathan Lamothe
dff11a8316 assume goalie is active on creation of rookie 2020-02-14 00:08:19 -05:00
Jonathan Lamothe
747bdf8f32 assume player is active on creation of rookie 2020-02-14 00:08:19 -05:00
Jonathan Lamothe
9b07c6d249 record active flag on goalie creation 2020-02-13 23:55:00 -05:00
Jonathan Lamothe
e28ef1ff0e record active flag on player creation 2020-02-13 23:40:43 -05:00
Jonathan Lamothe
960fbb3443 display active flags in new player/goalie creation summaries 2020-02-13 23:30:31 -05:00
Jonathan Lamothe
439aab99d3 prompt whether or not a new player/goalie is active 2020-02-13 23:28:10 -05:00
Jonathan Lamothe
8d7a7997b1 created active flag controller branches 2020-02-13 23:23:18 -05:00
Jonathan Lamothe
7e409fdbd4 added cpsActiveFlag and cgsActiveFlag 2020-02-13 23:18:53 -05:00
Jonathan Lamothe
28b1fa0e06 Merge pull request #74 from mtlstats/rookie-check
Rookie check
2020-02-13 20:20:46 -05:00
Jonathan Lamothe
7c4b7331e8 updated change log 2020-02-13 20:12:00 -05:00
Jonathan Lamothe
214710661a code cleanup 2020-02-13 20:08:10 -05:00
Jonathan Lamothe
6bb4601e6b only ask for goalie lifetime stats when not rookie 2020-02-13 20:03:27 -05:00
Jonathan Lamothe
e51953650c set rookie flag appropriately on goalie creation 2020-02-13 19:45:36 -05:00
Jonathan Lamothe
14386f9c7d display whether or not goalie is a rookie on creation confirmation 2020-02-13 15:23:40 -05:00
Jonathan Lamothe
ec10aa7998 ask if a new goalie is a rookie 2020-02-13 14:57:29 -05:00
Jonathan Lamothe
fe28e96145 use promptController in Mtlstats.Control.CreateGoalie 2020-02-13 14:45:43 -05:00
Jonathan Lamothe
2941998058 only edit player lifetime stats if rookie
...on new player creation
2020-02-13 11:08:32 -05:00
Jonathan Lamothe
c22849bb3b set rookie flag on player creation 2020-02-13 10:35:35 -05:00
Jonathan Lamothe
4315b40732 added rookie flag to player creation confirmation 2020-02-13 03:24:11 -05:00
Jonathan Lamothe
fefa217df1 implemented Mtlstats.Control.CreatePlayer.getRookieFlagC
...also refactored some other controllers to use promptController
2020-02-13 02:55:51 -05:00
Jonathan Lamothe
6d77caaa14 added cpsRookieFlag and cgsRookieFlag 2020-02-13 02:31:20 -05:00
Jonathan Lamothe
a69853858d Merge pull request #73 from mtlstats/position-shortcuts
autocompletion of player positions
2020-02-13 02:20:39 -05:00
Jonathan Lamothe
045f2915e1 updated change log 2020-02-13 02:00:52 -05:00
Jonathan Lamothe
dfd226c7bd implement position selection prompt on player creation/edit 2020-02-13 01:58:59 -05:00
Jonathan Lamothe
b9d8b263df implemented posCallback 2020-02-13 01:39:56 -05:00
Jonathan Lamothe
a2968595d8 implemented posSearchExact 2020-02-12 00:27:28 -05:00
Jonathan Lamothe
25e4929f0b implemented posSearch 2020-02-11 23:58:47 -05:00
Jonathan Lamothe
457298e565 implemented getPositions 2020-02-11 23:37:43 -05:00
Jonathan Lamothe
a80eaa2a40 implemented selectPositionPrompt 2020-02-11 23:00:13 -05:00
Jonathan Lamothe
8a6cf10ad3 version 0.12.0 2020-02-07 18:26:09 -05:00
Jonathan Lamothe
bd5bc21661 Merge pull request #72 from mtlstats/allow-dashes
allow dashes in database backup files
2020-02-04 00:25:09 -05:00
Jonathan Lamothe
accc831bc5 allow dashes in database backup files 2020-02-04 00:19:15 -05:00
Jonathan Lamothe
2c78a591ca Merge pull request #71 from mtlstats/remove-edit
removed the word "edit" from edit menus (mostly)
2020-02-04 00:07:17 -05:00
Jonathan Lamothe
77dc89c76d removed the word "edit" from edit menus (mostly) 2020-02-03 23:58:30 -05:00
Jonathan Lamothe
607a78ccea Merge pull request #70 from mtlstats/sort-players
subsort players by lifetime points
2020-01-31 22:18:58 -05:00
Jonathan Lamothe
d7c5f24c26 subsort players by lifetime points 2020-01-31 22:13:30 -05:00
Jonathan Lamothe
d94c6a588e Merge pull request #69 from mtlstats/sort-goalies
sort goalies by number of minutes played
2020-01-31 21:59:48 -05:00
Jonathan Lamothe
bdbe0131d7 sort goalies by number of minutes played 2020-01-31 21:54:32 -05:00
Jonathan Lamothe
b0638b95b8 Merge pull request #68 from mtlstats/new-goalie-lifetime
Automatically set lifetime stats on new goalie creation
2020-01-31 21:31:24 -05:00
Jonathan Lamothe
ce2d32407e updated change log 2020-01-31 21:24:05 -05:00
Jonathan Lamothe
5771091f18 edit lifetime stats on goalie creation 2020-01-31 21:23:22 -05:00
Jonathan Lamothe
13a1949446 perform action on completion of goalie edit 2020-01-31 21:14:56 -05:00
Jonathan Lamothe
835cb9582b created Mtlstats.Control.CreateGoalie module 2020-01-31 00:36:16 -05:00
Jonathan Lamothe
8bc9b48aa2 added callback to EditGoalieState 2020-01-31 00:25:20 -05:00
Jonathan Lamothe
378efea24e Merge pull request #67 from mtlstats/lifetime-new-player
Lifetime new player
2020-01-30 23:47:28 -05:00
Jonathan Lamothe
6418ab0eea update change log 2020-01-30 23:41:08 -05:00
Jonathan Lamothe
95e74accd4 edit lifetime stats on new player creation 2020-01-30 23:39:20 -05:00
Jonathan Lamothe
ffc1390755 created Mtlstats.Control.CreatePlayer module 2020-01-29 12:10:57 -05:00
Jonathan Lamothe
2f0a3a5c57 perform follow-up action on player edit 2020-01-29 01:19:25 -05:00
Jonathan Lamothe
79d527866f added callback to EditPlayerState 2020-01-29 00:26:43 -05:00
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
58 changed files with 2857 additions and 1568 deletions

3
.gitignore vendored
View File

@@ -1,3 +1,6 @@
.stack-work/
mtlstats.cabal
.vagrant
data
*.log
*~

View File

@@ -1,5 +1,43 @@
# Changelog for mtlstats
## 0.15.0
- Ask for database to load on start-up
- Add page break to report file
- Implemented player/goalie deletion
## 0.14.0
- Fixed a bug that was causing shutouts to not be recorded
- Output report to a text file (report.txt)
## 0.13.0
- Added autocomplete to player position prompt
- Don't prompt for lifetime stats on rookie player/goalie creation
- Ask whether a player/goalie is active on creation
- Don't ask which goalie to assign the game to when there's only one
## 0.12.0
- Edit lifetime stats on new player/goalie creation
- Sort goalies by minutes played
- Subsort players by lifetime points
- Changed wording on edit menus
## 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
@@ -24,24 +62,20 @@
- Reset game standings on new season
## 0.5.0
- Fixed player creation bug
- Prompt for goalie informaiton on game data entry
- Implemented player editing
## v0.4.0
- Record penalty minutes
- Calculate total game statistics
- Generate year-to-date statistics report
## v0.3.0
- Record goals and assists
- Track goals for and goals against
## v0.2.0
- Overtime losses don't count in the loss column
- Confirm game data with user before updating stats
- Implemented player creation

10
Vagrantfile vendored Normal file
View File

@@ -0,0 +1,10 @@
# -*- mode: ruby -*-
# vi: set ft=ruby :
Vagrant.configure("2") do |config|
config.vm.box = "ubuntu/xenial64"
config.vm.provision "shell", path: "vagrant/provision.sh"
config.vm.provider :virtualbox do |v|
v.customize ["modifyvm", :id, "--memory", 4096]
end
end

View File

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

View File

@@ -1,5 +1,5 @@
name: mtlstats
version: 0.9.0
version: 0.15.0
github: "mtlstats/mtlstats"
license: GPL-3
author: "Jonathan Lamothe"

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,23 +19,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE ScopedTypeVariables #-}
module Mtlstats (initState, mainLoop) where
import Control.Exception (IOException, catch)
import Control.Monad (void)
import Control.Monad.Extra (whenM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (get, gets)
import Data.Aeson (decodeFileStrict)
import Data.Maybe (fromJust, fromMaybe)
import Lens.Micro ((&), (.~))
import System.EasyFile (getAppUserDataDirectory, (</>))
import Data.Maybe (fromJust)
import qualified UI.NCurses as C
import Mtlstats.Config
import Mtlstats.Control
import Mtlstats.Types
@@ -44,15 +36,7 @@ initState :: C.Curses ProgState
initState = do
C.setEcho False
void $ C.setCursorMode C.CursorInvisible
db <- liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> dbFname
fromMaybe newDatabase <$> catch
(decodeFileStrict dbFile)
(\(_ :: IOException) -> return Nothing)
return
$ newProgState
& database .~ db
return newProgState
-- | Main program loop
mainLoop :: Action ()

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,11 +19,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
module Mtlstats.Actions
( startNewSeason
, resetYtd
, clearRookies
, resetStandings
, startNewGame
, addChar
@@ -32,7 +33,9 @@ module Mtlstats.Actions
, createGoalie
, edit
, editPlayer
, editSelectedPlayer
, editGoalie
, editSelectedGoalie
, addPlayer
, addGoalie
, resetCreatePlayerState
@@ -40,17 +43,31 @@ module Mtlstats.Actions
, backHome
, scrollUp
, scrollDown
, loadDatabase
, saveDatabase
) where
import Control.Monad.Trans.State (modify)
import Control.Exception (IOException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (decodeFileStrict, encodeFile)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~))
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Util
-- | Starts a new season
startNewSeason :: ProgState -> ProgState
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
startNewSeason
= (progMode .~ NewSeason False)
. (database.dbGames .~ 0)
-- | Resets all players year-to-date stats
resetYtd :: ProgState -> ProgState
@@ -58,6 +75,12 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (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
@@ -106,19 +129,49 @@ edit = progMode .~ EditMenu
editPlayer :: ProgState -> ProgState
editPlayer = progMode .~ EditPlayer newEditPlayerState
-- | Edits the selected 'Player'
editSelectedPlayer
:: (Player -> Player)
-- ^ The modification to be made to the 'Player'
-> ProgState
-> ProgState
editSelectedPlayer f s = fromMaybe s $ do
n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
let
players = s^.database.dbPlayers
players' = modifyNth n f players
Just $ s & database.dbPlayers .~ players'
-- | Starts the 'Goalie' editing process
editGoalie :: ProgState -> ProgState
editGoalie = progMode .~ EditGoalie newEditGoalieState
-- | Edits the selected 'Goalie'
editSelectedGoalie
:: (Goalie -> Goalie)
-- ^ The modification to be made to the 'Goalie'
-> ProgState
-> ProgState
editSelectedGoalie f s = fromMaybe s $ do
n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
let
goalies = s^.database.dbGoalies
goalies' = modifyNth n f goalies
Just $ s & database.dbGoalies .~ goalies'
-- | Adds the entered player to the roster
addPlayer :: ProgState -> ProgState
addPlayer s = fromMaybe s $ do
let cps = s^.progMode.createPlayerStateL
num <- cps^.cpsNumber
num <- cps^.cpsNumber
rFlag <- cps^.cpsRookieFlag
aFlag <- cps^.cpsActiveFlag
let
name = cps^.cpsName
pos = cps^.cpsPosition
player = newPlayer num name pos
& pRookie .~ rFlag
& pActive .~ aFlag
Just $ s & database.dbPlayers
%~ (++[player])
@@ -126,10 +179,14 @@ addPlayer s = fromMaybe s $ do
addGoalie :: ProgState -> ProgState
addGoalie s = fromMaybe s $ do
let cgs = s^.progMode.createGoalieStateL
num <- cgs^.cgsNumber
num <- cgs^.cgsNumber
rFlag <- cgs^.cgsRookieFlag
aFlag <- cgs^.cgsActiveFlag
let
name = cgs^.cgsName
goalie = newGoalie num name
& gRookie .~ rFlag
& gActive .~ aFlag
Just $ s & database.dbGoalies
%~ (++[goalie])
@@ -160,3 +217,28 @@ scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down
scrollDown :: ProgState -> ProgState
scrollDown = scrollOffset %~ succ
-- | Loads the database
loadDatabase :: Action ()
loadDatabase = do
dbFile <- dbSetup
liftIO
(catch
(decodeFileStrict dbFile)
(\(_ :: IOException) -> return Nothing))
>>= mapM_ (modify . (database .~))
-- | Saves the database
saveDatabase :: Action ()
saveDatabase = do
db <- gets (^.database)
dbFile <- dbSetup
liftIO $ encodeFile dbFile db
dbSetup :: Action String
dbSetup = do
fn <- gets (^.dbName)
liftIO $ do
dir <- getAppUserDataDirectory appName
createDirectoryIfMissing True dir
return $ dir </> fn ++ ".json"

View File

@@ -1,164 +0,0 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Actions.EditGoalie
( editGoalieNumber
, editGoalieName
, editGoalieYtdGames
, editGoalieYtdMins
, editGoalieYtdGoals
, editGoalieYtdWins
, editGoalieYtdLosses
, editGoalieYtdTies
, editGoalieLtGames
, editGoalieLtMins
, editGoalieLtGoals
, editGoalieLtWins
, editGoalieLtLosses
, editGoalieLtTies
) where
import Control.Monad (void)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~))
import Mtlstats.Types
import Mtlstats.Util
-- | Edits a goalie's number
editGoalieNumber
:: Int
-- ^ New goalie number
-> ProgState
-> ProgState
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
-- | Edits a goalie's name
editGoalieName
:: String
-- ^ The new name
-> ProgState
-> ProgState
editGoalieName name = editGoalie (gName .~ name) EGMenu
-- | Edits a goalie's YTD games
editGoalieYtdGames
:: Int
-- ^ The number of games played
-> ProgState
-> ProgState
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
-- | Edits a goalie's YTD minutes
editGoalieYtdMins
:: Int
-- ^ The number of minutes played
-> ProgState
-> ProgState
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
-- | Edits a goalie's YTD goals allowed
editGoalieYtdGoals
:: Int
-- ^ The number of goals
-> ProgState
-> ProgState
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
-- | Edits a goalie's YTD wins
editGoalieYtdWins
:: Int
-- ^ The number of wins
-> ProgState
-> ProgState
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
-- | Edits a goalie's YTD losses
editGoalieYtdLosses
:: Int
-- ^ The number of losses
-> ProgState
-> ProgState
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
-- | Edits a goalie's YTD ties
editGoalieYtdTies
:: Int
-- ^ The number of ties
-> ProgState
-> ProgState
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
-- | Edits a goalie's lifetime games played
editGoalieLtGames
:: Int
-- ^ The number of games
-> ProgState
-> ProgState
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
-- | Edits a goalie's lifetime minutes played
editGoalieLtMins
:: Int
-- ^ The number of minutes
-> ProgState
-> ProgState
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
-- | Edits a goalie's lifetime goals allowed
editGoalieLtGoals
:: Int
-- ^ The number of goals
-> ProgState
-> ProgState
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
-- | Edits a goalie's lifetime wins
editGoalieLtWins
:: Int
-- ^ The number of wins
-> ProgState
-> ProgState
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
-- | Edits a goalie's lifetime losses
editGoalieLtLosses
:: Int
-- ^ The number of losses
-> ProgState
-> ProgState
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
-- | Edits a goalie's lifetime ties
editGoalieLtTies
:: Int
-- ^ The number of ties
-> ProgState
-> ProgState
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
editGoalie f mode s = fromMaybe s $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
void $ nth gid $ s^.database.dbGoalies
Just $ s
& database.dbGoalies %~ modifyNth gid f
& progMode.editGoalieStateL.egsMode .~ mode

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

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -124,12 +124,13 @@ awardGoal n ps = ps
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
& database.dbPlayers %~ zipWith
(\i p -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
else p)
[0..]
-- | Awards an assist to a player
awardAssist
@@ -142,12 +143,13 @@ awardAssist n ps = ps
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
& database.dbPlayers %~ zipWith
(\i p -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
else p)
[0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -36,8 +36,12 @@ import Mtlstats.Util
-- | Attempts to finish game goalie entry
finishGoalieEntry :: ProgState -> ProgState
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
[] -> s
[(gid, _)] -> setGameGoalie gid s'
_ -> s'
where
s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
-- | Records the goalie's game stats
recordGoalieStats :: ProgState -> ProgState
@@ -83,18 +87,22 @@ setGameGoalie
-> ProgState
setGameGoalie gid s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
won <- gameWon gs
lost <- gameLost gs
tied <- gs^.overtimeFlag
won <- gameWon gs
lost <- gameLost gs
tied <- gs^.overtimeFlag
shutout <- (==0) <$> otherScore gs
let
w = if won then 1 else 0
l = if lost then 1 else 0
t = if tied then 1 else 0
w = if won then 1 else 0
l = if lost then 1 else 0
t = if tied then 1 else 0
so = if shutout then 1 else 0
updateStats
= (gsWins +~ w)
. (gsLosses +~ l)
. (gsTies +~ t)
= (gsWins +~ w)
. (gsLosses +~ l)
. (gsTies +~ t)
. (gsShutouts +~ so)
updateGoalie
= (gYtd %~ updateStats)

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -33,10 +33,6 @@ maxFunKeys = 9
appName :: String
appName = "mtlstats"
-- | The database filename
dbFname :: String
dbFname = "database.json"
-- | The maximum number of assists
maxAssists :: Int
maxAssists = 2
@@ -44,3 +40,11 @@ maxAssists = 2
-- | The length of a typical game (in minutes)
gameLength :: Int
gameLength = 60
-- | Report output filename
reportFilename :: FilePath
reportFilename = "report.txt"
-- | Number of columns in report file
reportCols :: Int
reportCols = 79

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -21,18 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where
import Control.Monad (join)
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromJust)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Control.CreateGoalie
import Mtlstats.Control.CreatePlayer
import Mtlstats.Control.EditGoalie
import Mtlstats.Control.EditPlayer
import Mtlstats.Control.EditStandings
import Mtlstats.Control.NewGame
import Mtlstats.Handlers
import Mtlstats.Control.TitleScreen
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Types
@@ -41,117 +38,28 @@ import Mtlstats.Types
-- run
dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of
MainMenu -> mainMenuC
NewSeason -> newSeasonC
NewGame gs -> newGameC gs
EditMenu -> editMenuC
CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC
| null $ cps^.cpsPosition -> getPlayerPosC
| otherwise -> confirmCreatePlayerC
CreateGoalie cgs
| null $ cgs^.cgsNumber -> getGoalieNumC
| null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
TitleScreen -> titleScreenC
MainMenu -> mainMenuC s
NewSeason flag -> newSeasonC flag
NewGame gs -> newGameC gs
EditMenu -> editMenuC
CreatePlayer cps -> createPlayerC cps
CreateGoalie cgs -> createGoalieC cgs
EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
(EditStandings esm) -> editStandingsC esm
mainMenuC :: Controller
mainMenuC = Controller
{ drawController = const $ drawMenu mainMenu
, handleController = menuHandler mainMenu
}
mainMenuC :: ProgState -> Controller
mainMenuC s = if null $ s^.dbName
then promptController getDBPrompt
else Controller
{ drawController = const $ drawMenu mainMenu
, handleController = menuHandler mainMenu
}
newSeasonC :: Controller
newSeasonC = Controller
{ drawController = const $ drawMenu newSeasonMenu
, handleController = \e -> do
menuHandler newSeasonMenu e
return True
}
newSeasonC :: Bool -> Controller
newSeasonC False = promptController newSeasonPrompt
newSeasonC True = menuController newSeasonMenu
editMenuC :: Controller
editMenuC = menuController editMenu
getPlayerNumC :: Controller
getPlayerNumC = Controller
{ drawController = drawPrompt playerNumPrompt
, handleController = \e -> do
promptHandler playerNumPrompt e
return True
}
getPlayerNameC :: Controller
getPlayerNameC = Controller
{ drawController = drawPrompt playerNamePrompt
, handleController = \e -> do
promptHandler playerNamePrompt e
return True
}
getPlayerPosC :: Controller
getPlayerPosC = Controller
{ drawController = drawPrompt playerPosPrompt
, handleController = \e -> do
promptHandler playerPosPrompt e
return True
}
confirmCreatePlayerC :: Controller
confirmCreatePlayerC = Controller
{ drawController = \s -> do
let cps = s^.progMode.createPlayerStateL
C.drawString $ " Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
C.drawString $ " Player name: " ++ cps^.cpsName ++ "\n"
C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
C.drawString "Create player: are you sure? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify addPlayer
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
Just False ->
join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
Nothing -> return ()
return True
}
getGoalieNumC :: Controller
getGoalieNumC = Controller
{ drawController = drawPrompt goalieNumPrompt
, handleController = \e -> do
promptHandler goalieNumPrompt e
return True
}
getGoalieNameC :: Controller
getGoalieNameC = Controller
{ drawController = drawPrompt goalieNamePrompt
, handleController = \e -> do
promptHandler goalieNamePrompt e
return True
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
, " Goalie name: " ++ cgs^.cgsName
, ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify addGoalie
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
Just False ->
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
Nothing -> return ()
return True
}

View File

@@ -0,0 +1,107 @@
{- |
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.CreateGoalie (createGoalieC) where
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
-- | Handles goalie creation
createGoalieC :: CreateGoalieState -> Controller
createGoalieC cgs
| null $ cgs^.cgsNumber = getGoalieNumC
| null $ cgs^.cgsName = getGoalieNameC
| null $ cgs^.cgsRookieFlag = getRookieFlagC
| null $ cgs^.cgsActiveFlag = getActiveFlagC
| otherwise = confirmCreateGoalieC
getGoalieNumC :: Controller
getGoalieNumC = promptController goalieNumPrompt
getGoalieNameC :: Controller
getGoalieNameC = promptController goalieNamePrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ case ynHandler e of
Just True -> progMode.createGoalieStateL
%~ (cgsRookieFlag ?~ True)
. (cgsActiveFlag ?~ True)
rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
return True
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
$ labelTable
[ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber )
, ( "Goalie name", cgs^.cgsName )
, ( "Rookie", maybe "?" show $ cgs^.cgsRookieFlag )
, ( "Active", maybe "?" show $ cgs^.cgsActiveFlag )
]
++ [ ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cgs <- gets (^.progMode.createGoalieStateL)
let
success = cgs^.cgsSuccessCallback
failure = cgs^.cgsFailureCallback
case ynHandler e of
Just True -> do
gid <- gets (^.database.dbGoalies.to length)
let rookie = cgs^.cgsRookieFlag == Just True
modify addGoalie
if rookie
then success
else modify $ progMode.editGoalieStateL
%~ (egsSelectedGoalie ?~ gid)
. (egsMode .~ EGLtGames True)
. (egsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

View File

@@ -0,0 +1,112 @@
{- |
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.CreatePlayer (createPlayerC) where
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
-- | Handles player creation
createPlayerC :: CreatePlayerState -> Controller
createPlayerC cps
| null $ cps^.cpsNumber = getPlayerNumC
| null $ cps^.cpsName = getPlayerNameC
| null $ cps^.cpsPosition = getPlayerPosC
| null $ cps^.cpsRookieFlag = getRookieFlagC
| null $ cps^.cpsActiveFlag = getActiveFlagC
| otherwise = confirmCreatePlayerC
getPlayerNumC :: Controller
getPlayerNumC = promptController playerNumPrompt
getPlayerNameC :: Controller
getPlayerNameC = promptController playerNamePrompt
getPlayerPosC :: Controller
getPlayerPosC = promptController playerPosPrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this player a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ case ynHandler e of
Just True -> progMode.createPlayerStateL
%~ (cpsRookieFlag ?~ True)
. (cpsActiveFlag ?~ True)
rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is the player active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
return True
}
confirmCreatePlayerC :: Controller
confirmCreatePlayerC = Controller
{ drawController = \s -> do
let cps = s^.progMode.createPlayerStateL
C.drawString $ unlines
$ labelTable
[ ( "Player number", maybe "?" show $ cps^.cpsNumber )
, ( "Player name", cps^.cpsName )
, ( "Player position", cps^.cpsPosition )
, ( "Rookie", maybe "?" show $ cps^.cpsRookieFlag )
, ( "Active", maybe "?" show $ cps^.cpsActiveFlag )
]
++ [ ""
, "Create player: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cps <- gets (^.progMode.createPlayerStateL)
let
success = cps^.cpsSuccessCallback
failure = cps^.cpsFailureCallback
case ynHandler e of
Just True -> do
pid <- gets (^.database.dbPlayers.to length)
let rookie = cps^.cpsRookieFlag == Just True
modify addPlayer
if rookie
then success
else modify $ progMode.editPlayerStateL
%~ (epsSelectedPlayer ?~ pid)
. (epsMode .~ EPLtGoals True)
. (epsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -23,10 +23,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.EditGoalie (editGoalieC) where
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import Lens.Micro ((^.), (.~), (%~))
import UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Handlers
import Mtlstats.Helpers.Goalie
import Mtlstats.Menu
import Mtlstats.Menu.EditGoalie
@@ -39,81 +42,136 @@ import Mtlstats.Util
editGoalieC :: EditGoalieState -> Controller
editGoalieC egs
| null $ egs^.egsSelectedGoalie = selectC
| otherwise = editC $ egs^.egsMode
| otherwise = editC (egs^.egsCallback) (egs^.egsMode)
selectC :: Controller
selectC = promptController goalieToEditPrompt
editC :: EditGoalieMode -> Controller
editC = \case
EGMenu -> menuC
EGNumber -> numberC
EGName -> nameC
EGYtd -> ytdMenuC
EGLifetime -> lifetimeMenuC
EGYtdGames -> ytdGamesC
EGYtdMins -> ytdMinsC
EGYtdGoals -> ytdGoalsC
EGYtdWins -> ytdWinsC
EGYtdLosses -> ytdLossesC
EGYtdTies -> ytdTiesC
EGLtGames -> ltGamesC
EGLtMins -> ltMinsC
EGLtGoals -> ltGoalsC
EGLtWins -> ltWinsC
EGLtLosses -> ltLossesC
EGLtTies -> ltTiesC
editC :: Action () -> EditGoalieMode -> Controller
editC cb =
( \case
EGMenu -> menuC
EGNumber -> numberC
EGName -> nameC
EGYtd -> ytdMenuC
EGLifetime -> lifetimeMenuC
EGDelete -> deleteC
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
) <*> return cb
menuC :: Controller
menuC = menuControllerWith header editGoalieMenu
menuC :: Action () -> Controller
menuC _ = menuControllerWith header editGoalieMenu
numberC :: Controller
numberC = promptController editGoalieNumberPrompt
numberC :: Action () -> Controller
numberC = promptController . editGoalieNumberPrompt
nameC :: Controller
nameC = promptController editGoalieNamePrompt
nameC :: Action () -> Controller
nameC = promptController . editGoalieNamePrompt
ytdMenuC :: Controller
ytdMenuC = menuControllerWith header editGoalieYtdMenu
ytdMenuC :: Action () -> Controller
ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
lifetimeMenuC :: Controller
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
lifetimeMenuC :: Action () -> Controller
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
ytdGamesC :: Controller
ytdGamesC = promptController editGoalieYtdGamesPrompt
deleteC :: Action () -> Controller
deleteC _ = Controller
ytdMinsC :: Controller
ytdMinsC = promptController editGoalieYtdMinsPrompt
{ drawController = \s -> do
ytdGoalsC :: Controller
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
C.drawString $ let
ytdWinsC :: Controller
ytdWinsC = promptController editGoalieYtdWinsPrompt
hdr = fromMaybe [] $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
ytdLossesC :: Controller
ytdLossesC = promptController editGoalieYtdLossesPrompt
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
ytdTiesC :: Controller
ytdTiesC = promptController editGoalieYtdTiesPrompt
return C.CursorInvisible
ltGamesC :: Controller
ltGamesC = promptController editGoalieLtGamesPrompt
, handleController = \e -> do
ltMinsC :: Controller
ltMinsC = promptController editGoalieLtMinsPrompt
case ynHandler e of
ltGoalsC :: Controller
ltGoalsC = promptController editGoalieLtGoalsPrompt
Just True -> do
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
modify edit
ltWinsC :: Controller
ltWinsC = promptController editGoalieLtWinsPrompt
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
Nothing -> return ()
ltLossesC :: Controller
ltLossesC = promptController editGoalieLtLossesPrompt
return True
ltTiesC :: Controller
ltTiesC = promptController editGoalieLtTiesPrompt
}
ytdGamesC :: Bool -> Action () -> Controller
ytdGamesC = curry $ promptController .
uncurry editGoalieYtdGamesPrompt
ytdMinsC :: Bool -> Action () -> Controller
ytdMinsC = curry $ promptController .
uncurry editGoalieYtdMinsPrompt
ytdGoalsC :: Bool -> Action () -> Controller
ytdGoalsC = curry $ promptController .
uncurry editGoalieYtdGoalsPrompt
ytdShutoutsC :: Bool -> Action () -> Controller
ytdShutoutsC = curry $ promptController .
uncurry editGoalieYtdShutoutsPrompt
ytdWinsC :: Bool -> Action () -> Controller
ytdWinsC = curry $ promptController .
uncurry editGoalieYtdWinsPrompt
ytdLossesC :: Bool -> Action () -> Controller
ytdLossesC = curry $ promptController .
uncurry editGoalieYtdLossesPrompt
ytdTiesC :: Action () -> Controller
ytdTiesC = promptController . editGoalieYtdTiesPrompt
ltGamesC :: Bool -> Action () -> Controller
ltGamesC = curry $ promptController .
uncurry editGoalieLtGamesPrompt
ltMinsC :: Bool -> Action () -> Controller
ltMinsC = curry $ promptController .
uncurry editGoalieLtMinsPrompt
ltGoalsC :: Bool -> Action() -> Controller
ltGoalsC = curry $ promptController .
uncurry editGoalieLtGoalsPrompt
ltShutoutsC :: Bool -> Action () -> Controller
ltShutoutsC = curry $ promptController .
uncurry editGoalieLtShutoutsPrompt
ltWinsC :: Bool -> Action () -> Controller
ltWinsC = curry $ promptController .
uncurry editGoalieLtWinsPrompt
ltLossesC :: Bool -> Action () -> Controller
ltLossesC = curry $ promptController .
uncurry editGoalieLtLossesPrompt
ltTiesC :: Action () -> Controller
ltTiesC = promptController . editGoalieLtTiesPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -21,10 +21,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.EditPlayer (editPlayerC) where
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import Lens.Micro ((^.), (.~), (%~))
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Handlers
import Mtlstats.Helpers.Player
import Mtlstats.Menu
import Mtlstats.Menu.EditPlayer
@@ -37,58 +40,97 @@ import Mtlstats.Util
editPlayerC :: EditPlayerState -> Controller
editPlayerC eps
| null $ eps^.epsSelectedPlayer = selectPlayerC
| otherwise = case eps^.epsMode of
EPMenu -> menuC
EPNumber -> numberC
EPName -> nameC
EPPosition -> positionC
EPYtd -> ytdC
EPLifetime -> lifetimeC
EPYtdGoals -> ytdGoalsC
EPYtdAssists -> ytdAssistsC
EPYtdPMin -> ytdPMinC
EPLtGoals -> ltGoalsC
EPLtAssists -> ltAssistsC
EPLtPMin -> ltPMinC
| otherwise =
( case eps^.epsMode of
EPMenu -> menuC
EPNumber -> numberC
EPName -> nameC
EPPosition -> positionC
EPYtd -> ytdC
EPLifetime -> lifetimeC
EPDelete -> deleteC
EPYtdGoals b -> ytdGoalsC b
EPYtdAssists b -> ytdAssistsC b
EPYtdPMin -> ytdPMinC
EPLtGoals b -> ltGoalsC b
EPLtAssists b -> ltAssistsC b
EPLtPMin -> ltPMinC
) $ eps^.epsCallback
selectPlayerC :: Controller
selectPlayerC = promptController playerToEditPrompt
menuC :: Controller
menuC = menuControllerWith header editPlayerMenu
menuC :: Action () -> Controller
menuC _ = menuControllerWith header editPlayerMenu
numberC :: Controller
numberC = promptController editPlayerNumPrompt
numberC :: Action () -> Controller
numberC = promptController . editPlayerNumPrompt
nameC :: Controller
nameC = promptController editPlayerNamePrompt
nameC :: Action () -> Controller
nameC = promptController . editPlayerNamePrompt
positionC :: Controller
positionC = promptController editPlayerPosPrompt
positionC :: Action () -> Controller
positionC = promptController . editPlayerPosPrompt
ytdC :: Controller
ytdC = menuControllerWith header editPlayerYtdMenu
ytdC :: Action () -> Controller
ytdC _ = menuControllerWith header editPlayerYtdMenu
lifetimeC :: Controller
lifetimeC = menuControllerWith header editPlayerLtMenu
lifetimeC :: Action () -> Controller
lifetimeC _ = menuControllerWith header editPlayerLtMenu
ytdGoalsC :: Controller
ytdGoalsC = promptController editPlayerYtdGoalsPrompt
deleteC :: Action () -> Controller
deleteC _ = Controller
ytdAssistsC :: Controller
ytdAssistsC = promptController editPlayerYtdAssistsPrompt
{ drawController = \s -> do
ytdPMinC :: Controller
ytdPMinC = promptController editPlayerYtdPMinPrompt
C.drawString $ let
ltGoalsC :: Controller
ltGoalsC = promptController editPlayerLtGoalsPrompt
hdr = fromMaybe [] $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ "Player: " ++ playerDetails player ++ "\n\n"
ltAssistsC :: Controller
ltAssistsC = promptController editPlayerLtAssistsPrompt
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
ltPMinC :: Controller
ltPMinC = promptController editPlayerLtPMinPrompt
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
modify edit
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
Nothing -> return ()
return True
}
ytdGoalsC :: Bool -> Action () -> Controller
ytdGoalsC batchMode callback = promptController $
editPlayerYtdGoalsPrompt batchMode callback
ytdAssistsC :: Bool -> Action () -> Controller
ytdAssistsC batchMode callback = promptController $
editPlayerYtdAssistsPrompt batchMode callback
ytdPMinC :: Action () -> Controller
ytdPMinC = promptController . editPlayerYtdPMinPrompt
ltGoalsC :: Bool -> Action () -> Controller
ltGoalsC batchMode callback = promptController $
editPlayerLtGoalsPrompt batchMode callback
ltAssistsC :: Bool -> Action () -> Controller
ltAssistsC batchMode callback = promptController $
editPlayerLtAssistsPrompt batchMode callback
ltPMinC :: Action () -> Controller
ltPMinC = promptController . editPlayerLtPMinPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do

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

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -21,13 +21,15 @@ 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 Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (get, 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.Config
import Mtlstats.Control.NewGame.GoalieInput
import Mtlstats.Format
import Mtlstats.Handlers
@@ -204,16 +206,19 @@ reportC = Controller
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
(displayReport (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 ()
C.EventCharacter '\n' -> do
get >>= liftIO . writeFile reportFilename . exportReport reportCols
modify backHome
_ -> return ()
return True
}

View File

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

View File

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

View File

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

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Helpers.Goalie (goalieDetails) where
module Mtlstats.Helpers.Goalie (goalieDetails, goalieName) where
import Lens.Micro ((^.))
@@ -31,7 +31,7 @@ goalieDetails :: Goalie -> String
goalieDetails g = let
header = unlines $ labelTable
[ ( "Number", show $ g^.gNumber )
, ( "Name", g^.gName )
, ( "Name", goalieName g )
]
body = unlines $ numTable ["YTD", "Lifetime"] $ map
@@ -39,9 +39,24 @@ goalieDetails g = let
[ ( "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

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Helpers.Player (playerDetails) where
module Mtlstats.Helpers.Player (playerDetails, playerName) where
import Lens.Micro ((^.))
@@ -32,7 +32,7 @@ playerDetails p = unlines $ top ++ [""] ++ table
where
top = labelTable
[ ( "Number", show $ p^.pNumber )
, ( "Name", p^.pName )
, ( "Name", playerName p )
, ( "Position", p^.pPosition )
]
@@ -43,3 +43,18 @@ playerDetails p = unlines $ top ++ [""] ++ table
, ( "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

@@ -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/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Helpers.Position
( posSearch
, posSearchExact
, posCallback
, getPositions
) where
import Control.Monad.Trans.State (gets)
import Data.Char (toUpper)
import Data.List (isInfixOf)
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import Lens.Micro ((^.), to)
import Mtlstats.Types
import Mtlstats.Util
-- | Searches the 'Database' for all the positions used
posSearch
:: String
-- ^ The search string
-> Database
-- ^ The database
-> [(Int, String)]
-- ^ A list of result indices and their values
posSearch sStr db = filter sFunc $ zip [0..] ps
where
sFunc (_, pos) = map toUpper sStr `isInfixOf` map toUpper pos
ps = getPositions db
-- | Searches the 'Database' for an exact position
posSearchExact
:: String
-- ^ The search string
-> Database
-- ^ The database
-> Maybe Int
-- ^ The index of the result (or 'Nothing' if not found)
posSearchExact sStr db = case filter sFunc $ zip [0..] ps of
[] -> Nothing
(n,_):_ -> Just n
where
sFunc (_, pos) = sStr == pos
ps = getPositions db
-- | Builds a callback function for when a 'Player' position is
-- selected
posCallback
:: (String -> Action ())
-- ^ The raw callback function
-> Maybe Int
-- ^ The index number of the position selected or 'Nothing' if blank
-> Action ()
-- ^ The action to perform
posCallback callback = \case
Nothing -> callback ""
Just n -> do
ps <- gets (^.database.to getPositions)
let pos = fromMaybe "" $ nth n ps
callback pos
-- | Extracts a list of positions from a 'Database'
getPositions :: Database -> [String]
getPositions = do
raw <- map (^.pPosition) . (^.dbPlayers)
return $ S.toList $ S.fromList raw

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -35,24 +35,17 @@ module Mtlstats.Menu (
editMenu
) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile)
import Data.Char (toUpper)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Lens.Micro ((^.), (?~))
import Lens.Micro.Extras (view)
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import qualified UI.NCurses as C
import Mtlstats.Actions
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Config
import Mtlstats.Actions.EditStandings
import Mtlstats.Format
import Mtlstats.Types
import Mtlstats.Types.Menu
import Mtlstats.Util
@@ -96,7 +89,11 @@ menuStateController menuFunc = Controller
-- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode
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
-- | The event handler for a 'Menu'
@@ -109,61 +106,56 @@ menuHandler m _ = return $ m^.menuDefault
-- | The main menu
mainMenu :: Menu Bool
mainMenu = Menu "*** MAIN MENU ***" True
[ MenuItem '1' "New Season" $
mainMenu = Menu "MASTER MENU" True
[ MenuItem 'A' "NEW SEASON" $
modify startNewSeason >> return True
, MenuItem '2' "New Game" $
, MenuItem 'B' "NEW GAME" $
modify startNewGame >> return True
, MenuItem '3' "Edit" $
, MenuItem 'C' "EDIT MENU" $
modify edit >> return True
, MenuItem 'X' "Exit" $ do
db <- gets $ view database
liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> dbFname
createDirectoryIfMissing True dir
encodeFile dbFile db
return False
, MenuItem 'E' "EXIT" $
saveDatabase >> return False
]
-- | The new season menu
newSeasonMenu :: Menu ()
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
[ MenuItem 'R' "Regular Season" $ modify
newSeasonMenu = Menu "SEASON TYPE" ()
[ MenuItem 'R' "REGULAR SEASON" $ modify
$ resetYtd
. clearRookies
. resetStandings
. startNewGame
, MenuItem 'P' "Playoffs" $ modify
, MenuItem 'P' "PLAYOFFS" $ modify
$ resetStandings
. startNewGame
]
-- | Requests the month in which the game took place
gameMonthMenu :: Menu ()
gameMonthMenu = Menu "Month:" () $ map
gameMonthMenu = Menu "MONTH:" () $ map
(\(ch, name, val) ->
MenuItem ch name $
modify $ progMode.gameStateL.gameMonth ?~ val)
[ ( 'A', "January", 1 )
, ( 'B', "February", 2 )
, ( 'C', "March", 3 )
, ( 'D', "April", 4 )
, ( 'E', "May", 5 )
, ( 'F', "June", 6 )
, ( 'G', "July", 7 )
, ( 'H', "August", 8 )
, ( 'I', "September", 9 )
, ( 'J', "October", 10 )
, ( 'K', "November", 11 )
, ( 'L', "December", 12 )
[ ( 'A', "JANUARY", 1 )
, ( 'B', "FEBRUARY", 2 )
, ( 'C', "MARCH", 3 )
, ( 'D', "APRIL", 4 )
, ( 'E', "MAY", 5 )
, ( 'F', "JUNE", 6 )
, ( 'G', "JULY", 7 )
, ( 'H', "AUGUST", 8 )
, ( 'I', "SEPTEMBER", 9 )
, ( 'J', "OCTOBER", 10 )
, ( 'K', "NOVEMBER", 11 )
, ( 'L', "DECEMBER", 12 )
]
-- | The game type menu (home/away)
gameTypeMenu :: Menu ()
gameTypeMenu = Menu "Game type:" ()
[ MenuItem '1' "Home Game" $
gameTypeMenu = Menu "GAME TYPE:" ()
[ MenuItem 'H' "HOME GAME" $
modify $ progMode.gameStateL.gameType ?~ HomeGame
, MenuItem '2' "Away Game" $
, MenuItem 'A' "AWAY GAME" $
modify $ progMode.gameStateL.gameType ?~ AwayGame
]
@@ -177,22 +169,25 @@ gameGoalieMenu s = let
goalie <- nth n $ s^.database.dbGoalies
Just (n, goalie))
gids
in Menu title () $ map
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
modify $ GI.setGameGoalie gid) $
zip ['1'..] goalies
in Menu title () $ zipWith
(\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
modify $ GI.setGameGoalie gid)
['1'..]
goalies
-- | The edit menu
editMenu :: Menu ()
editMenu = Menu "*** EDIT ***" ()
[ MenuItem '1' "Create Player" $
editMenu = Menu "EDIT MENU" ()
[ MenuItem 'A' "CREATE PLAYER" $
modify createPlayer
, MenuItem '2' "Create Goalie" $
, MenuItem 'B' "CREATE GOALIE" $
modify createGoalie
, MenuItem '3' "Edit Player" $
, MenuItem 'C' "EDIT PLAYER" $
modify editPlayer
, MenuItem '4' "Edit Goalie" $
, MenuItem 'D' "EDIT GOALIE" $
modify editGoalie
, MenuItem 'R' "Return to Main Menu" $
, MenuItem 'E' "EDIT STANDINGS" $
modify editStandings
, MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome
]

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -26,7 +26,7 @@ module Mtlstats.Menu.EditGoalie
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Lens.Micro ((.~), (%~))
import Mtlstats.Actions
import Mtlstats.Types
@@ -34,44 +34,54 @@ import Mtlstats.Types.Menu
-- | The 'Goalie' edit menu
editGoalieMenu :: Menu ()
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $
modify $ case mode of
Nothing -> edit
Just m -> progMode.editGoalieStateL.egsMode .~ m)
editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value
[ ( '1', "Edit number", Just EGNumber )
, ( '2', "Edit name", Just EGName )
, ( '3', "Edit YTD stats", Just EGYtd )
, ( '4', "Edit Lifetime stats", Just EGLifetime )
, ( 'R', "Return to Edit Menu", Nothing )
[ ( 'A', "NUMBER", set EGNumber )
, ( 'B', "NAME", set EGName )
, ( 'C', "ROOKIE FLAG", toggleRookie )
, ( 'D', "ACTIVE FLAG", toggleActive )
, ( 'E', "YTD STATS", set EGYtd )
, ( 'F', "LIFETIME STATS", set EGLifetime )
, ( 'G', "DELETE RECORD", set EGDelete )
, ( '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 ***"
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
-- key, label, value
[ ( '1', "Edit YTD games", EGYtdGames )
, ( '2', "Edit YTD minutes", EGYtdMins )
, ( '3', "Edit YTD goals", EGYtdGoals )
, ( '4', "Edit YTD wins", EGYtdWins )
, ( '5', "Edit YTD losses", EGYtdLosses )
, ( '6', "Edit YTD ties", EGYtdTies )
, ( 'R', "Return to edit menu", EGMenu )
[ ( 'A', "ALL YTD STATS", EGYtdGames True )
, ( 'B', "YTD GAMES", EGYtdGames False )
, ( 'C', "YTD MINUTES", EGYtdMins False )
, ( 'D', "YTD GOALS", EGYtdGoals False )
, ( 'E', "YTD SHUTOUTS", EGYtdShutouts False )
, ( 'F', "YTD WINS", EGYtdWins False )
, ( 'G', "YTD LOSSES", EGYtdLosses False )
, ( 'H', "YTD TIES", EGYtdTies )
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
]
-- | The 'Goalie' lifetime edit menu
editGoalieLtMenu :: Menu ()
editGoalieLtMenu = editMenu
"*** EDIT GOALTENDER LIFETIME ***"
-- key, label, value
[ ( '1', "Edit lifetime games", EGLtGames )
, ( '2', "Edit lifetime minutes", EGLtMins )
, ( '3', "Edit lifetime goals", EGLtGoals )
, ( '4', "Edit lifetime wins", EGLtWins )
, ( '5', "Edit lifetime losses", EGLtLosses )
, ( '6', "Edit lifetime ties", EGLtTies )
, ( 'R', "Return to edit menu", EGMenu )
"EDIT GOALTENDER LIFETIME"
-- key, label, value
[ ( 'A', "ALL LIFETIME STATS", EGLtGames True )
, ( 'B', "LIFETIME GAMES", EGLtGames False )
, ( 'C', "LIFETIME MINUTES", EGLtMins False )
, ( 'D', "LIFETIME GOALS", EGLtGoals False )
, ( 'E', "LIFETIME SHUTOUTS", EGLtShutouts False )
, ( 'F', "LIFETIME WINS", EGLtWins False )
, ( 'G', "LIFETIME LOSSES", EGLtLosses False )
, ( 'H', "LIFETIME TIES", EGLtTies )
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
]
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -26,7 +26,7 @@ module Mtlstats.Menu.EditPlayer
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Lens.Micro ((.~), (%~))
import Mtlstats.Actions
import Mtlstats.Types
@@ -34,40 +34,48 @@ import Mtlstats.Types.Menu
-- | The 'Player' edit menu
editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $
modify $ case mode of
Nothing -> edit
Just m -> progMode.editPlayerStateL.epsMode .~ m)
editPlayerMenu = Menu "EDIT PLAYER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value
[ ( '1', "Edit number", Just EPNumber )
, ( '2', "Edit name", Just EPName )
, ( '3', "Edit position", Just EPPosition )
, ( '4', "Edit YTD stats", Just EPYtd )
, ( '5', "Edit lifetime stats", Just EPLifetime )
, ( 'R', "Return to Edit Menu", Nothing )
[ ( 'A', "NUMBER", set EPNumber )
, ( 'B', "NAME", set EPName )
, ( 'C', "POSITION", set EPPosition )
, ( 'D', "ROOKIE FLAG", toggleRookie )
, ( 'E', "ACTIVE FLAG", toggleActive )
, ( 'F', "YTD STATS", set EPYtd )
, ( 'G', "LIFETIME STATS", set EPLifetime )
, ( 'H', "DELETE RECORD", set EPDelete )
, ( '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 ***"
"EDIT PLAYER YEAR-TO-DATE"
-- key, label, value
[ ( '1', "Edit YTD goals", EPYtdGoals )
, ( '2', "Edit YTD assists", EPYtdAssists )
, ( '3', "Edit YTD penalty mins", EPYtdPMin )
, ( 'R', "Return to player edit menu", EPMenu )
[ ( 'A', "ALL YTD STATS", EPYtdGoals True )
, ( 'B', "YTD GOALS", EPYtdGoals False )
, ( 'C', "YTD ASSISTS", EPYtdAssists False )
, ( 'D', "YTD PENALTY MINS", EPYtdPMin )
, ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
]
-- | The 'Player' lifetime stats edit menu
editPlayerLtMenu :: Menu ()
editPlayerLtMenu = editMenu
"*** EDIT PLAYER LIFETIME ***"
"EDIT PLAYER LIFETIME"
-- key, label, value
[ ( '1', "Edit lifetime goals", EPLtGoals )
, ( '2', "Edit lifetime assits", EPLtAssists )
, ( '3', "Edit lifetime penalty mins", EPLtPMin )
, ( 'R', "Return to edit player menu", EPMenu )
[ ( 'A', "ALL LIFETIME STATS", EPLtGoals True )
, ( 'B', "LIFETIME GOALS", EPLtGoals False )
, ( 'C', "LIFETIME ASSITS", EPLtAssists False )
, ( 'D', "LIFETIME PENALTY MINS", EPLtPMin )
, ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
]
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()

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
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -31,8 +31,12 @@ module Mtlstats.Prompt (
ucStrPrompt,
namePrompt,
numPrompt,
numPromptWithFallback,
dbNamePrompt,
selectPrompt,
-- * Individual prompts
getDBPrompt,
newSeasonPrompt,
playerNumPrompt,
playerNamePrompt,
playerPosPrompt,
@@ -40,14 +44,14 @@ module Mtlstats.Prompt (
goalieNamePrompt,
selectPlayerPrompt,
selectGoaliePrompt,
selectPositionPrompt,
playerToEditPrompt
) where
import Control.Monad (when)
import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper)
import Data.Foldable (forM_)
import Data.Char (isAlphaNum, isDigit, toUpper)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Extras (view)
import Text.Read (readMaybe)
@@ -55,6 +59,7 @@ import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Helpers.Position
import Mtlstats.Types
import Mtlstats.Util
@@ -145,15 +150,51 @@ numPrompt
-> (Int -> Action ())
-- ^ The callback function for the result
-> Prompt
numPrompt pStr act = Prompt
numPrompt pStr = numPromptWithFallback pStr $ return ()
-- | Builds a numeric prompt with a fallback action
numPromptWithFallback
:: String
-- ^ The prompt string
-> Action ()
-- ^ The action to call on invalid (or blank) input
-> (Int -> Action ())
-- ^ The callback function for the result
-> Prompt
numPromptWithFallback pStr fallback act = Prompt
{ promptDrawer = drawSimplePrompt pStr
, promptProcessChar = \ch str -> if isDigit ch
then str ++ [ch]
else str
, promptAction = \inStr -> forM_ (readMaybe inStr) act
, promptAction = maybe fallback act . readMaybe
, promptSpecialKey = const $ return ()
}
-- | Prompts for a database name
dbNamePrompt
:: String
-- ^ The prompt string
-> (String -> Action ())
-- ^ The callback to pass the result to
-> Prompt
dbNamePrompt pStr act = (strPrompt pStr act)
{ promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
then (++[toUpper ch])
else id
}
-- | Prompts the user for a filename to save a backup of the database
-- to
newSeasonPrompt :: Prompt
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
if null fn
then modify backHome
else do
saveDatabase
modify
$ (dbName .~ fn)
. (progMode .~ NewSeason True)
-- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
@@ -191,6 +232,12 @@ selectPrompt params = Prompt
_ -> return ()
}
-- | Prompts for the database to load
getDBPrompt :: Prompt
getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
modify $ dbName .~ fn
loadDatabase
-- | Prompts for a new player's number
playerNumPrompt :: Prompt
playerNumPrompt = numPrompt "Player number: " $
@@ -203,7 +250,7 @@ playerNamePrompt = namePrompt "Player name: " $
-- | Prompts for a new player's position
playerPosPrompt :: Prompt
playerPosPrompt = ucStrPrompt "Player position: " $
playerPosPrompt = selectPositionPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~)
-- | Prompts tor the goalie's number
@@ -274,6 +321,24 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
modify $ progMode .~ CreateGoalie cgs
}
-- | Selects (or creates) a player position
selectPositionPrompt
:: String
-- ^ The 'Prompt' string
-> (String -> Action ())
-- ^ The action to perform when a value is entered
-> Prompt
selectPositionPrompt pStr callback = selectPrompt SelectParams
{ spPrompt = pStr
, spSearchHeader = "Positions:"
, spSearch = posSearch
, spSearchExact = posSearchExact
, spElemDesc = id
, spProcessChar = \ch -> (++ [toUpper ch])
, spCallback = posCallback callback
, spNotFound = callback
}
playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -26,12 +26,14 @@ module Mtlstats.Prompt.EditGoalie
, editGoalieYtdGamesPrompt
, editGoalieYtdMinsPrompt
, editGoalieYtdGoalsPrompt
, editGoalieYtdShutoutsPrompt
, editGoalieYtdWinsPrompt
, editGoalieYtdLossesPrompt
, editGoalieYtdTiesPrompt
, editGoalieLtGamesPrompt
, editGoalieLtMinsPrompt
, editGoalieLtGoalsPrompt
, editGoalieLtShutoutsPrompt
, editGoalieLtWinsPrompt
, editGoalieLtLossesPrompt
, editGoalieLtTiesPrompt
@@ -40,7 +42,7 @@ module Mtlstats.Prompt.EditGoalie
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions.EditGoalie
import Mtlstats.Actions
import Mtlstats.Prompt
import Mtlstats.Types
@@ -50,71 +52,236 @@ goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
-- | Prompt to edit a goalie's number
editGoalieNumberPrompt :: Prompt
editGoalieNumberPrompt = numPrompt "Goalie number: " $
modify . editGoalieNumber
editGoalieNumberPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
(gNumber .~)
-- | Prompt to edit a goalie's name
editGoalieNamePrompt :: Prompt
editGoalieNamePrompt = strPrompt "Goalie name: " $
modify . editGoalieName
editGoalieNamePrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieNamePrompt cb = namePrompt "Goalie name: " $ \name -> do
if null name
then goto EGMenu
else doEdit EGMenu $ gName .~ name
cb
-- | Prompt to edit a goalie's YTD games played
editGoalieYtdGamesPrompt :: Prompt
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
modify . editGoalieYtdGames
editGoalieYtdGamesPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdGamesPrompt batchMode cb =
editNum "Year-to-date games played: " mode
(gYtd.gsGames .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdMins True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD minutes played
editGoalieYtdMinsPrompt :: Prompt
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
modify . editGoalieYtdMins
editGoalieYtdMinsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdMinsPrompt batchMode cb =
editNum "Year-to-date minutes played: " mode
(gYtd.gsMinsPlayed .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdGoals True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD goales allowed
editGoalieYtdGoalsPrompt :: Prompt
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
modify . editGoalieYtdGoals
editGoalieYtdGoalsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdGoalsPrompt batchMode cb =
editNum "Year-to-date goals allowed: " mode
(gYtd.gsGoalsAllowed .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdShutouts True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD shutouts
editGoalieYtdShutoutsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdShutoutsPrompt batchMode cb =
editNum "Year-to-date shutouts: " mode
(gYtd.gsShutouts .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdWins True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD wins
editGoalieYtdWinsPrompt :: Prompt
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
modify . editGoalieYtdWins
editGoalieYtdWinsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdWinsPrompt batchMode cb =
editNum "Year-to-date wins: " mode
(gYtd.gsWins .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdLosses True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD losses
editGoalieYtdLossesPrompt :: Prompt
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
modify . editGoalieYtdLosses
editGoalieYtdLossesPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdLossesPrompt batchMode cb =
editNum "Year-to-date losses: " mode
(gYtd.gsLosses .~) cb'
where
(mode, cb') = if batchMode
then (EGYtdTies, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD ties
editGoalieYtdTiesPrompt :: Prompt
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
modify . editGoalieYtdTies
editGoalieYtdTiesPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
(gYtd.gsTies .~)
-- | Prompt to edit a goalie's lifetime games played
editGoalieLtGamesPrompt :: Prompt
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
modify . editGoalieLtGames
editGoalieLtGamesPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtGamesPrompt batchMode cb =
editNum "Lifetime games played: " mode
(gLifetime.gsGames .~) cb'
where
(mode, cb') = if batchMode
then (EGLtMins True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime minutes played
editGoalieLtMinsPrompt :: Prompt
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
modify . editGoalieLtMins
editGoalieLtMinsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtMinsPrompt batchMode cb =
editNum "Lifetime minutes played: " mode
(gLifetime.gsMinsPlayed .~) cb'
where
(mode, cb') = if batchMode
then (EGLtGoals True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime goals allowed
editGoalieLtGoalsPrompt :: Prompt
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
modify . editGoalieLtGoals
editGoalieLtGoalsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtGoalsPrompt batchMode cb =
editNum "Lifetime goals allowed: " mode
(gLifetime.gsGoalsAllowed .~) cb'
where
(mode, cb') = if batchMode
then (EGLtShutouts True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime shutouts
editGoalieLtShutoutsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtShutoutsPrompt batchMode cb =
editNum "Lifetime shutouts: " mode
(gLifetime.gsShutouts .~) cb'
where
(mode, cb') = if batchMode
then (EGLtWins True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime wins
editGoalieLtWinsPrompt :: Prompt
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
modify . editGoalieLtWins
editGoalieLtWinsPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtWinsPrompt batchMode cb =
editNum "Lifetime wins: " mode
(gLifetime.gsWins .~) cb'
where
(mode, cb') = if batchMode
then (EGLtLosses True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime losses
editGoalieLtLossesPrompt :: Prompt
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
modify . editGoalieLtLosses
editGoalieLtLossesPrompt
:: Bool
-- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtLossesPrompt batchMode cb =
editNum "Lifetime losses: " mode
(gLifetime.gsLosses .~) cb'
where
(mode, cb') = if batchMode
then (EGLtTies, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime ties
editGoalieLtTiesPrompt :: Prompt
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
modify . editGoalieLtTies
editGoalieLtTiesPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
(gLifetime.gsTies .~)
editNum
:: String
-> EditGoalieMode
-> (Int -> Goalie -> Goalie)
-> Action ()
-> Prompt
editNum pStr mode f cb = numPromptWithFallback pStr
(goto mode >> cb)
(\num -> do
doEdit mode $ f num
cb)
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
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -31,62 +31,131 @@ module Mtlstats.Prompt.EditPlayer
, editPlayerLtPMinPrompt
) where
import Control.Monad.Extra (whenJustM)
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (%~))
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions
import Mtlstats.Prompt
import Mtlstats.Types
import Mtlstats.Util
-- | Prompt to edit a player's number
editPlayerNumPrompt :: Prompt
editPlayerNumPrompt = numPrompt "Player number: " $
editPlayer . (pNumber .~)
editPlayerNumPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerNumPrompt = editNum "Player number: " EPMenu
(pNumber .~)
-- | Prompt to edit a player's name
editPlayerNamePrompt :: Prompt
editPlayerNamePrompt = strPrompt "Player name: " $
editPlayer . (pName .~)
editPlayerNamePrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
if null name
then goto EPMenu
else doEdit EPMenu $ pName .~ name
callback
-- | Prompt to edit a player's position
editPlayerPosPrompt :: Prompt
editPlayerPosPrompt = ucStrPrompt "Player position: " $
editPlayer . (pPosition .~)
editPlayerPosPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
if null pos
then goto EPMenu
else doEdit EPMenu $ pPosition .~ pos
callback
-- | Prompt to edit a player's year-to-date goals
editPlayerYtdGoalsPrompt :: Prompt
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
editPlayer . (pYtd.psGoals .~)
editPlayerYtdGoalsPrompt
:: Bool
-- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
(pYtd.psGoals .~) callback'
where
(mode, callback') = if batchMode
then (EPYtdAssists True, return ())
else (EPYtd, callback)
-- | Prompt to edit a player's year-to-date assists
editPlayerYtdAssistsPrompt :: Prompt
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
editPlayer . (pYtd.psAssists .~)
editPlayerYtdAssistsPrompt
:: Bool
-- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
(pYtd.psAssists .~) callback'
where
(mode, callback') = if batchMode
then (EPYtdPMin, return ())
else (EPYtd, callback)
-- | Prompt to edit a player's year-to-date penalty minutes
editPlayerYtdPMinPrompt :: Prompt
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
editPlayer . (pYtd.psPMin .~)
editPlayerYtdPMinPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
(pYtd.psPMin .~)
-- | Prompt to edit a player's lifetime goals
editPlayerLtGoalsPrompt :: Prompt
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
editPlayer . (pLifetime.psGoals .~)
editPlayerLtGoalsPrompt
:: Bool
-- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
(pLifetime.psGoals .~) callback'
where
(mode, callback') = if batchMode
then (EPLtAssists True, return ())
else (EPLifetime, callback)
-- | Prompt to edit a player's lifetime assists
editPlayerLtAssistsPrompt :: Prompt
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
editPlayer . (pLifetime.psAssists .~)
editPlayerLtAssistsPrompt
:: Bool
-- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
(pLifetime.psAssists .~) callback'
where
(mode, callback') = if batchMode
then (EPLtPMin, return ())
else (EPLifetime, callback)
-- | Prompt to edit a player's lifetime penalty minutes
editPlayerLtPMinPrompt :: Prompt
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
editPlayer . (pLifetime.psPMin .~)
editPlayerLtPMinPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
(pLifetime.psPMin .~)
editPlayer :: (Player -> Player) -> Action ()
editPlayer f =
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
modify
$ (database.dbPlayers %~ modifyNth pid f)
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
editNum
:: String
-> EditPlayerMode
-> (Int -> Player -> Player)
-> Action ()
-> Prompt
editNum pStr mode f callback = numPromptWithFallback pStr
(goto mode >> callback)
(\num -> do
doEdit mode $ f num
callback)
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

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

View File

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

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Report (report, gameDate) where
module Mtlstats.Report (displayReport, exportReport, gameDate) where
import Data.List (sortOn)
import qualified Data.Map as M
@@ -29,24 +29,42 @@ import Lens.Micro ((^.))
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Helpers.Goalie
import Mtlstats.Helpers.Player
import Mtlstats.Types
import Mtlstats.Util
-- | Generates the report
report
-- | Generates the report displayed on screen
displayReport
:: Int
-- ^ The number of columns for the report
-> ProgState
-- ^ The program state
-> [String]
displayReport width s
= report width s
++ [""]
++ lifetimeStatsReport width s
-- | Generates the report to be exported to file
exportReport
:: Int
-- ^ The number of columns in the report
-> ProgState
-- ^ The program state
-> String
exportReport width s
= unlines (report width s)
++ "\f"
++ unlines (lifetimeStatsReport width s)
report :: Int -> ProgState -> [String]
report width s
= standingsReport width s
++ [""]
++ gameStatsReport width s
++ [""]
++ yearToDateStatsReport width s
++ [""]
++ lifetimeStatsReport width s
standingsReport :: Int -> ProgState -> [String]
standingsReport width s = fromMaybe [] $ do
@@ -115,7 +133,7 @@ gameStatsReport width s = let
gs = s^.progMode.gameStateL
db = s^.database
playerStats = mapMaybe
playerStats = sortPlayers $ mapMaybe
(\(pid, stats) -> do
p <- nth pid $ db^.dbPlayers
Just (p, stats))
@@ -129,7 +147,7 @@ gameStatsReport width s = let
criteria (_, ps) = psPoints ps > 0
in filteredPlayerReport width "GAME" criteria True playerStats
in filteredPlayerReport width "GAME" criteria True False playerStats
++ [""]
++ gameGoalieReport width goalieStats
@@ -137,7 +155,7 @@ yearToDateStatsReport :: Int -> ProgState -> [String]
yearToDateStatsReport width s = let
db = s^.database
playerStats = sortOn (Down . psPoints . snd)
playerStats = sortPlayers
$ map (\p -> (p, p^.pYtd))
$ filter playerIsActive
$ db^.dbPlayers
@@ -146,24 +164,24 @@ yearToDateStatsReport width s = let
$ filter goalieIsActive
$ db^.dbGoalies
in playerReport width "YEAR TO DATE" True playerStats
in playerReport width "YEAR TO DATE" True False playerStats
++ [""]
++ goalieReport width True goalieStats
++ goalieReport width True False goalieStats
lifetimeStatsReport :: Int -> ProgState -> [String]
lifetimeStatsReport width s = let
db = s^.database
playerStats = sortOn (Down . psPoints . snd)
playerStats = sortPlayers
$ map (\p -> (p, p^.pLifetime))
$ db^.dbPlayers
goalieStats = map (\g -> (g, g^.gLifetime))
$ db^.dbGoalies
in playerReport width "LIFETIME" False playerStats
in playerReport width "LIFETIME" False True playerStats
++ [""]
++ goalieReport width False goalieStats
++ goalieReport width False True goalieStats
gameDate :: GameState -> String
gameDate gs = fromMaybe "" $ do
@@ -176,6 +194,7 @@ playerReport
:: Int
-> String
-> Bool
-> Bool
-> [(Player, PlayerStats)]
-> [String]
playerReport width label =
@@ -186,11 +205,13 @@ filteredPlayerReport
-> String
-> ((Player, PlayerStats) -> Bool)
-> Bool
-> Bool
-> [(Player, PlayerStats)]
-> [String]
filteredPlayerReport width label criteria showTotals ps = let
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
fps = filter criteria ps
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")
@@ -216,7 +237,7 @@ filteredPlayerReport width label criteria showTotals ps = let
body = map
(\(p, stats) ->
[ CellText $ show (p^.pNumber) ++ " "
, CellText $ p^.pName
, CellText $ playerName p
] ++ statsCells stats)
fps
@@ -231,8 +252,12 @@ filteredPlayerReport width label criteria showTotals ps = let
then label ++ " TOTALS"
else ""
lnOverlay = if lineNumbers
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
else repeat ""
table = overlayLast olayText
$ map (centre width)
$ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
$ complexTable ([right, left] ++ repeat right)
$ tHeader : body ++ if showTotals
then [separator, totals]
@@ -243,15 +268,18 @@ filteredPlayerReport width label criteria showTotals ps = let
goalieReport
:: Int
-> Bool
-> Bool
-> [(Goalie, GoalieStats)]
-> [String]
goalieReport width showTotals goalieData = let
goalieReport width showTotals lineNumbers goalieData = let
olayText = if showTotals
then "GOALTENDING TOTALS"
else ""
goalieData' = sortGoalies goalieData
tData = foldl addGoalieStats newGoalieStats
$ map snd goalieData
$ map snd goalieData'
header =
[ CellText "NO."
@@ -274,9 +302,9 @@ goalieReport width showTotals goalieData = let
body = map
(\(goalie, stats) ->
[ CellText $ show (goalie^.gNumber) ++ " "
, CellText $ goalie^.gName
, CellText $ goalieName goalie
] ++ rowCells stats)
goalieData
goalieData'
separator
= replicate 2 (CellText "")
@@ -284,7 +312,11 @@ goalieReport width showTotals goalieData = let
summary = replicate 2 (CellText "") ++ rowCells tData
in map (centre width)
lnOverlay = if lineNumbers
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
else repeat ""
in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
$ overlayLast olayText
$ complexTable ([right, left] ++ repeat right)
$ header : body ++ if showTotals
@@ -293,6 +325,8 @@ goalieReport width showTotals goalieData = let
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
gameGoalieReport width goalieData = let
goalieData' = sortGoalies goalieData
header =
[ CellText "NO."
, CellText "GOALTENDER"
@@ -304,13 +338,21 @@ gameGoalieReport width goalieData = let
body = map
(\(goalie, stats) ->
[ CellText $ show (goalie^.gNumber) ++ " "
, CellText $ goalie^.gName
, CellText $ goalieName goalie
, CellText $ show $ stats^.gsMinsPlayed
, CellText $ show $ stats^.gsGoalsAllowed
, CellText $ showFloating $ gsAverage stats
])
goalieData
goalieData'
in map (centre width)
$ complexTable ([right, left] ++ repeat right)
$ header : body
sortPlayers :: [(Player, PlayerStats)] -> [(Player, PlayerStats)]
sortPlayers = sortOn $ Down . \(p, ps) ->
(psPoints ps, psPoints $ p^.pLifetime)
sortGoalies :: [(Goalie, GoalieStats)] -> [(Goalie, GoalieStats)]
sortGoalies = sortOn $ Down . \(g, gs) ->
(gs^.gsMinsPlayed, g^.gLifetime.gsMinsPlayed)

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -35,6 +35,8 @@ module Mtlstats.Types (
EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
EditStandingsMode (..),
ESMSubMode (..),
Database (..),
Player (..),
PlayerStats (..),
@@ -48,6 +50,7 @@ module Mtlstats.Types (
-- ** ProgState Lenses
database,
progMode,
dbName,
inputBuffer,
scrollOffset,
-- ** ProgMode Lenses
@@ -56,6 +59,9 @@ module Mtlstats.Types (
createGoalieStateL,
editPlayerStateL,
editGoalieStateL,
editStandingsModeL,
-- ** EditStandingsMode Lenses
esmSubModeL,
-- ** GameState Lenses
gameYear,
gameMonth,
@@ -83,19 +89,25 @@ module Mtlstats.Types (
cpsNumber,
cpsName,
cpsPosition,
cpsRookieFlag,
cpsActiveFlag,
cpsSuccessCallback,
cpsFailureCallback,
-- ** CreateGoalieState Lenses
cgsNumber,
cgsName,
cgsRookieFlag,
cgsActiveFlag,
cgsSuccessCallback,
cgsFailureCallback,
-- ** EditPlayerState Lenses
epsSelectedPlayer,
epsMode,
epsCallback,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
egsCallback,
-- ** Database Lenses
dbPlayers,
dbGoalies,
@@ -106,6 +118,8 @@ module Mtlstats.Types (
pNumber,
pName,
pPosition,
pRookie,
pActive,
pYtd,
pLifetime,
-- ** PlayerStats Lenses
@@ -115,6 +129,8 @@ module Mtlstats.Types (
-- ** Goalie Lenses
gNumber,
gName,
gRookie,
gActive,
gYtd,
gLifetime,
-- ** GoalieStats Lenses
@@ -193,9 +209,8 @@ import Data.Aeson
, (.=)
)
import Data.Char (toUpper)
import Data.List (isInfixOf)
import Data.List (find, isInfixOf)
import qualified Data.Map as M
import Data.Maybe (listToMaybe)
import Lens.Micro (Lens', lens, (&), (^.), (.~))
import Lens.Micro.TH (makeLenses)
import qualified UI.NCurses as C
@@ -219,6 +234,8 @@ data ProgState = ProgState
-- ^ The data to be saved
, _progMode :: ProgMode
-- ^ The program's mode
, _dbName :: String
-- ^ The name of the database file
, _inputBuffer :: String
-- ^ Buffer for user input
, _scrollOffset :: Int
@@ -227,24 +244,28 @@ data ProgState = ProgState
-- | The program mode
data ProgMode
= MainMenu
| NewSeason
= TitleScreen
| MainMenu
| NewSeason Bool
| NewGame GameState
| EditMenu
| CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState
| EditGoalie EditGoalieState
| EditStandings EditStandingsMode
instance Show ProgMode where
show MainMenu = "MainMenu"
show NewSeason = "NewSeason"
show (NewGame _) = "NewGame"
show EditMenu = "EditMenu"
show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
show TitleScreen = "TitleScreen"
show MainMenu = "MainMenu"
show (NewSeason _) = "NewSeason"
show (NewGame _) = "NewGame"
show EditMenu = "EditMenu"
show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
show (EditStandings _) = "EditStandings"
-- | The game state
data GameState = GameState
@@ -313,6 +334,10 @@ data CreatePlayerState = CreatePlayerState
-- ^ The player's name
, _cpsPosition :: String
-- ^ The player's position
, _cpsRookieFlag :: Maybe Bool
-- ^ Indicates whether or not the player is a rookie
, _cpsActiveFlag :: Maybe Bool
-- ^ Indicates whether or not the plauer is active
, _cpsSuccessCallback :: Action ()
-- ^ The function to call on success
, _cpsFailureCallback :: Action ()
@@ -321,10 +346,14 @@ data CreatePlayerState = CreatePlayerState
-- | Goalie creation status
data CreateGoalieState = CreateGoalieState
{ _cgsNumber :: Maybe Int
{ _cgsNumber :: Maybe Int
-- ^ The goalie's number
, _cgsName :: String
, _cgsName :: String
-- ^ The goalie's name
, _cgsRookieFlag :: Maybe Bool
-- ^ Indicates whether or not the goalie is a rookie
, _cgsActiveFlag :: Maybe Bool
-- ^ Indicates whether or not the goalie is active
, _cgsSuccessCallback :: Action ()
-- ^ The function to call on success
, _cgsFailureCallback :: Action ()
@@ -337,6 +366,8 @@ data EditPlayerState = EditPlayerState
-- ^ The index number of the player being edited
, _epsMode :: EditPlayerMode
-- ^ The editing mode
, _epsCallback :: Action ()
-- ^ The action to perform when the edit is complete
}
-- | Player editing mode
@@ -347,11 +378,12 @@ data EditPlayerMode
| EPPosition
| EPYtd
| EPLifetime
| EPYtdGoals
| EPYtdAssists
| EPDelete
| EPYtdGoals Bool
| EPYtdAssists Bool
| EPYtdPMin
| EPLtGoals
| EPLtAssists
| EPLtGoals Bool
| EPLtAssists Bool
| EPLtPMin
deriving (Eq, Show)
@@ -360,6 +392,9 @@ data EditGoalieState = EditGoalieState
{ _egsSelectedGoalie :: Maybe Int
-- ^ The index number of the 'Goalie' being edited
, _egsMode :: EditGoalieMode
-- ^ The editing mode
, _egsCallback :: Action ()
-- ^ The action to perform when the edit is complete
}
-- | 'Goalie' editing mode
@@ -369,20 +404,40 @@ data EditGoalieMode
| EGName
| EGYtd
| EGLifetime
| EGYtdGames
| EGYtdMins
| EGYtdGoals
| EGYtdWins
| EGYtdLosses
| EGDelete
| EGYtdGames Bool
| EGYtdMins Bool
| EGYtdGoals Bool
| EGYtdShutouts Bool
| EGYtdWins Bool
| EGYtdLosses Bool
| EGYtdTies
| EGLtGames
| EGLtMins
| EGLtGoals
| EGLtWins
| EGLtLosses
| EGLtGames Bool
| EGLtMins Bool
| EGLtGoals Bool
| EGLtShutouts Bool
| EGLtWins Bool
| EGLtLosses Bool
| EGLtTies
deriving (Eq, Show)
-- | 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
data Database = Database
{ _dbPlayers :: [Player]
@@ -397,29 +452,6 @@ data Database = Database
-- ^ Statistics for away games
} deriving (Eq, Show)
instance FromJSON Database where
parseJSON = withObject "Database" $ \v -> Database
<$> v .: "players"
<*> v .: "goalies"
<*> v .: "games"
<*> v .: "home_game_stats"
<*> v .: "away_game_stats"
instance ToJSON Database where
toJSON (Database players goalies games hgs ags) = object
[ "players" .= players
, "goalies" .= goalies
, "games" .= games
, "home_game_stats" .= hgs
, "away_game_stats" .= ags
]
toEncoding (Database players goalies games hgs ags) = pairs $
"players" .= players <>
"goalies" .= goalies <>
"games" .= games <>
"home_game_stats" .= hgs <>
"away_game_stats" .= ags
-- | Represents a (non-goalie) player
data Player = Player
{ _pNumber :: Int
@@ -428,35 +460,16 @@ data Player = Player
-- ^ 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)
instance FromJSON Player where
parseJSON = withObject "Player" $ \v -> Player
<$> v .: "number"
<*> v .: "name"
<*> v .: "position"
<*> v .: "ytd"
<*> v .: "lifetime"
instance ToJSON Player where
toJSON (Player num name pos ytd lt) = object
[ "number" .= num
, "name" .= name
, "position" .= pos
, "ytd" .= ytd
, "lifetime" .= lt
]
toEncoding (Player num name pos ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"position" .= pos <>
"ytd" .= ytd <>
"lifetime" .= lt
-- | Represents a (non-goalie) player's stats
data PlayerStats = PlayerStats
{ _psGoals :: Int
@@ -467,55 +480,22 @@ data PlayerStats = PlayerStats
-- ^ The number of penalty minutes
} deriving (Eq, Show)
instance FromJSON PlayerStats where
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
<$> v .: "goals"
<*> v .: "assists"
<*> v .: "penalty_mins"
instance ToJSON PlayerStats where
toJSON (PlayerStats g a pm) = object
[ "goals" .= g
, "assists" .= a
, "penalty_mins" .= pm
]
toEncoding (PlayerStats g a pm) = pairs $
"goals" .= g <>
"assists" .= a <>
"penalty_mins" .= pm
-- | 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)
instance FromJSON Goalie where
parseJSON = withObject "Goalie" $ \v -> Goalie
<$> v .: "number"
<*> v .: "name"
<*> v .: "ytd"
<*> v .: "lifetime"
instance ToJSON Goalie where
toJSON (Goalie num name ytd lt) = object
[ "number" .= num
, "name" .= name
, "ytd" .= ytd
, "lifetime" .= lt
]
toEncoding (Goalie num name ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"ytd" .= ytd <>
"lifetime" .= lt
-- | Represents a goalie's stats
data GoalieStats = GoalieStats
{ _gsGames :: Int
@@ -534,35 +514,6 @@ data GoalieStats = GoalieStats
-- ^ The number of ties
} deriving (Eq, Show)
instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .:? "games" .!= 0
<*> v .:? "mins_played" .!= 0
<*> v .:? "goals_allowed" .!= 0
<*> v .:? "shutouts" .!= 0
<*> v .:? "wins" .!= 0
<*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where
toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g
, "mins_played" .= m
, "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w
, "losses" .= l
, "ties" .= t
]
toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <>
"mins_played" .= m <>
"goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <>
"losses" .= l <>
"ties" .= t
-- | Game statistics
data GameStats = GameStats
{ _gmsWins :: Int
@@ -577,29 +528,6 @@ data GameStats = GameStats
-- ^ Goals against the team
} deriving (Eq, Show)
instance FromJSON GameStats where
parseJSON = withObject "GameStats" $ \v -> GameStats
<$> v .: "wins"
<*> v .: "losses"
<*> v .: "overtime"
<*> v .: "goals_for"
<*> v .: "goals_against"
instance ToJSON GameStats where
toJSON (GameStats w l ot gf ga) = object
[ "wins" .= w
, "losses" .= l
, "overtime" .= ot
, "goals_for" .= gf
, "goals_against" .= ga
]
toEncoding (GameStats w l ot gf ga) = pairs $
"wins" .= w <>
"losses" .= l <>
"overtime" .= ot <>
"goals_for" .= gf <>
"goals_against" .= ga
-- | Defines a user prompt
data Prompt = Prompt
{ promptDrawer :: ProgState -> C.Update ()
@@ -653,6 +581,153 @@ makeLenses ''Goalie
makeLenses ''GoalieStats
makeLenses ''GameStats
instance FromJSON Database where
parseJSON = withObject "Database" $ \v -> Database
<$> v .:? "players" .!= []
<*> v .:? "goalies" .!= []
<*> v .:? "games" .!= 0
<*> v .:? "home_game_stats" .!= newGameStats
<*> v .:? "away_game_stats" .!= newGameStats
instance ToJSON Database where
toJSON (Database players goalies games hgs ags) = object
[ "players" .= players
, "goalies" .= goalies
, "games" .= games
, "home_game_stats" .= hgs
, "away_game_stats" .= ags
]
toEncoding (Database players goalies games hgs ags) = pairs $
"players" .= players <>
"goalies" .= goalies <>
"games" .= games <>
"home_game_stats" .= hgs <>
"away_game_stats" .= ags
instance FromJSON Player where
parseJSON = withObject "Player" $ \v -> Player
<$> v .: "number"
<*> v .: "name"
<*> v .: "position"
<*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newPlayerStats
<*> v .:? "lifetime" .!= newPlayerStats
instance ToJSON Player where
toJSON (Player num name pos rk act ytd lt) = object
[ "number" .= num
, "name" .= name
, "position" .= pos
, "rookie" .= rk
, "active" .= act
, "ytd" .= ytd
, "lifetime" .= lt
]
toEncoding (Player num name pos rk act ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"position" .= pos <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <>
"lifetime" .= lt
instance FromJSON PlayerStats where
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
<$> v .:? "goals" .!= 0
<*> v .:? "assists" .!= 0
<*> v .:? "penalty_mins" .!= 0
instance ToJSON PlayerStats where
toJSON (PlayerStats g a pm) = object
[ "goals" .= g
, "assists" .= a
, "penalty_mins" .= pm
]
toEncoding (PlayerStats g a pm) = pairs $
"goals" .= g <>
"assists" .= a <>
"penalty_mins" .= pm
instance FromJSON Goalie where
parseJSON = withObject "Goalie" $ \v -> Goalie
<$> v .: "number"
<*> v .: "name"
<*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newGoalieStats
<*> v .:? "lifetime" .!= newGoalieStats
instance ToJSON Goalie where
toJSON (Goalie num name rk act ytd lt) = object
[ "number" .= num
, "name" .= name
, "ytd" .= ytd
, "rookie" .= rk
, "active" .= act
, "lifetime" .= lt
]
toEncoding (Goalie num name rk act ytd lt) = pairs $
"number" .= num <>
"name" .= name <>
"rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <>
"lifetime" .= lt
instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .:? "games" .!= 0
<*> v .:? "mins_played" .!= 0
<*> v .:? "goals_allowed" .!= 0
<*> v .:? "shutouts" .!= 0
<*> v .:? "wins" .!= 0
<*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where
toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g
, "mins_played" .= m
, "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w
, "losses" .= l
, "ties" .= t
]
toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <>
"mins_played" .= m <>
"goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <>
"losses" .= l <>
"ties" .= t
instance FromJSON GameStats where
parseJSON = withObject "GameStats" $ \v -> GameStats
<$> v .: "wins"
<*> v .: "losses"
<*> v .: "overtime"
<*> v .: "goals_for"
<*> v .: "goals_against"
instance ToJSON GameStats where
toJSON (GameStats w l ot gf ga) = object
[ "wins" .= w
, "losses" .= l
, "overtime" .= ot
, "goals_for" .= gf
, "goals_against" .= ga
]
toEncoding (GameStats w l ot gf ga) = pairs $
"wins" .= w <>
"losses" .= l <>
"overtime" .= ot <>
"goals_for" .= gf <>
"goals_against" .= ga
gameStateL :: Lens' ProgMode GameState
gameStateL = lens
(\case
@@ -688,11 +763,30 @@ editGoalieStateL = lens
_ -> 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'
newProgState :: ProgState
newProgState = ProgState
{ _database = newDatabase
, _progMode = MainMenu
, _progMode = TitleScreen
, _dbName = ""
, _inputBuffer = ""
, _scrollOffset = 0
}
@@ -730,6 +824,8 @@ newCreatePlayerState = CreatePlayerState
{ _cpsNumber = Nothing
, _cpsName = ""
, _cpsPosition = ""
, _cpsRookieFlag = Nothing
, _cpsActiveFlag = Nothing
, _cpsSuccessCallback = return ()
, _cpsFailureCallback = return ()
}
@@ -739,6 +835,8 @@ newCreateGoalieState :: CreateGoalieState
newCreateGoalieState = CreateGoalieState
{ _cgsNumber = Nothing
, _cgsName = ""
, _cgsRookieFlag = Nothing
, _cgsActiveFlag = Nothing
, _cgsSuccessCallback = return ()
, _cgsFailureCallback = return ()
}
@@ -748,6 +846,7 @@ newEditPlayerState :: EditPlayerState
newEditPlayerState = EditPlayerState
{ _epsSelectedPlayer = Nothing
, _epsMode = EPMenu
, _epsCallback = return ()
}
-- | Constructor for an 'EditGoalieState' value
@@ -755,6 +854,7 @@ newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing
, _egsMode = EGMenu
, _egsCallback = return ()
}
-- | Constructor for a 'Database'
@@ -780,6 +880,8 @@ newPlayer num name pos = Player
{ _pNumber = num
, _pName = name
, _pPosition = pos
, _pRookie = True
, _pActive = True
, _pYtd = newPlayerStats
, _pLifetime = newPlayerStats
}
@@ -802,6 +904,8 @@ newGoalie
newGoalie num name = Goalie
{ _gNumber = num
, _gName = name
, _gRookie = True
, _gActive = True
, _gYtd = newGoalieStats
, _gLifetime = newGoalieStats
}
@@ -920,7 +1024,7 @@ playerSearchExact
-> Maybe (Int, Player)
-- ^ The player's index and value
playerSearchExact sStr =
listToMaybe . filter match . zip [0..]
find match . zip [0..]
where match (_, p) = p^.pName == sStr
-- | Modifies a player with a given name

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -39,6 +39,7 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses)
import Mtlstats.Format
import Mtlstats.Types
-- | Defines a menu
@@ -65,8 +66,15 @@ makeLenses ''Menu
makeLenses ''MenuItem
instance Show (Menu a) where
show m = m ^. menuTitle ++ "\n" ++ items
where items = unlines $ map show $ m ^. menuItems
show m = unlines
$ [ m^.menuTitle
, ""
]
++ body
where
body = map (left width) items
width = maximum $ map length items
items = map show $ m^.menuItems
instance Show (MenuItem a) where
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription
show i = [i ^. miKey] ++ ": " ++ i ^. miDescription

View File

@@ -1,7 +1,7 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Util
( nth
, modifyNth
, dropNth
, updateMap
, slice
, capitalizeName
@@ -52,8 +53,21 @@ modifyNth
-> [a]
-- ^ The list
-> [a]
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
. zip [0..]
modifyNth n f = zipWith
(\i x -> if i == n then f x else x)
[0..]
-- | Attempt to drop the nth element from a list
dropNth
:: Int
-- ^ The index of the element to drop
-> [a]
-- ^ The list to be modified
-> [a]
-- ^ The modified list
dropNth n = foldr
(\(i, x) acc -> if i == n then acc else x : acc)
[] . zip [0..]
-- | Modify a value indexed by a given key in a map using a default
-- initial value if not present

View File

@@ -1,537 +0,0 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Actions.EditGoalieSpec (spec) where
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.EditGoalie
import Mtlstats.Types
import Mtlstats.Util
spec :: Spec
spec = describe "EditGoalie" $ do
editGoalieNumberSpec
editGoalieNameSpec
editGoalieYtdGamesSpec
editGoalieYtdMinsSpec
editGoalieYtdGoalsSpec
editGoalieYtdWinsSpec
editGoalieYtdLossesSpec
editGoalieYtdTiesSpec
editGoalieLtGamesSpec
editGoalieLtMinsSpec
editGoalieLtGoalsSpec
editGoalieLtWinsSpec
editGoalieLtLossesSpec
editGoalieLtTiesSpec
editGoalieNumberSpec :: Spec
editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
(editGoalieNumber 5)
EGNumber
(uncurry newGoalie)
[ ( "set Joe"
, Just 0
, (5, "Joe")
, (3, "Bob")
, EGMenu
)
, ( "set Bob"
, Just 1
, (2, "Joe")
, (5, "Bob")
, EGMenu
)
, ( "out of bounds"
, Just 2
, (2, "Joe")
, (3, "Bob")
, EGNumber
)
, ( "no goalie selected"
, Nothing
, (2, "Joe")
, (3, "Bob")
, EGNumber
)
]
editGoalieNameSpec :: Spec
editGoalieNameSpec = describe "editGoalieName" $ editTest
(editGoalieName "foo")
EGName
(uncurry newGoalie)
[ ( "set Joe"
, Just 0
, ( 2, "foo" )
, ( 3, "Bob" )
, EGMenu
)
, ( "set Bob"
, Just 1
, ( 2, "Joe" )
, ( 3, "foo" )
, EGMenu
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe" )
, ( 3, "Bob" )
, EGName
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe" )
, ( 3, "Bob" )
, EGName
)
]
editGoalieYtdGamesSpec :: Spec
editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
(editGoalieYtdGames 1)
EGYtdGames
(\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdGames
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdGames
)
]
editGoalieYtdMinsSpec :: Spec
editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
(editGoalieYtdMins 1)
EGYtdMins
(\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, (2, "Joe", 0 )
, (3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdMins
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdMins
)
]
editGoalieYtdGoalsSpec :: Spec
editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
(editGoalieYtdGoals 1)
EGYtdGoals
(\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdGoals
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdGoals
)
]
editGoalieYtdWinsSpec :: Spec
editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
(editGoalieYtdWins 1)
EGYtdWins
(\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdWins
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdWins
)
]
editGoalieYtdLossesSpec :: Spec
editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
(editGoalieYtdLosses 1)
EGYtdLosses
(\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdLosses
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdLosses
)
]
editGoalieYtdTiesSpec :: Spec
editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
(editGoalieYtdTies 1)
EGYtdTies
(\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGYtd
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGYtd
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdTies
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGYtdTies
)
]
editGoalieLtGamesSpec :: Spec
editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
(editGoalieLtGames 1)
EGLtGames
(\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtGames
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtGames
)
]
editGoalieLtMinsSpec :: Spec
editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
(editGoalieLtMins 1)
EGLtMins
(\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtMins
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtMins
)
]
editGoalieLtGoalsSpec :: Spec
editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
(editGoalieLtGoals 1)
EGLtGoals
(\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtGoals
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtGoals
)
]
editGoalieLtWinsSpec :: Spec
editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
(editGoalieLtWins 1)
EGLtWins
(\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtWins
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtWins
)
]
editGoalieLtLossesSpec :: Spec
editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
(editGoalieLtLosses 1)
EGLtLosses
(\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtLosses
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtLosses
)
]
editGoalieLtTiesSpec :: Spec
editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
(editGoalieLtTies 1)
EGLtTies
(\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
[ ( "set Joe"
, Just 0
, ( 2, "Joe", 1 )
, ( 3, "Bob", 0 )
, EGLifetime
)
, ( "set Bob"
, Just 1
, ( 2, "Joe", 0 )
, ( 3, "Bob", 1 )
, EGLifetime
)
, ( "out of bounds"
, Just 2
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtTies
)
, ( "no goalie selected"
, Nothing
, ( 2, "Joe", 0 )
, ( 3, "Bob", 0 )
, EGLtTies
)
]
editTest
:: (ProgState -> ProgState)
-> EditGoalieMode
-> (a -> Goalie)
-> [(String, Maybe Int, a, a, EditGoalieMode)]
-> Spec
editTest func setMode mkGoalie params = do
mapM_
(\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
let
egs = newEditGoalieState
& egsSelectedGoalie .~ setGid
& egsMode .~ setMode
ps = func $ progState $ EditGoalie egs
mapM_
(\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
actual = fromJust $ nth chkGid $ ps^.database.dbGoalies
expected = mkGoalie goalieData
in it ("should be " ++ show expected) $
actual `shouldBe` expected)
-- label, goalie ID, goalie data
[ ( "check Joe", 0, joeData )
, ( "check Bob", 1, bobData )
]
context "check mode" $
it ("should be " ++ show expectMode) $
ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
params
context "wrong progMode" $ do
let ps = func $ progState MainMenu
it "should not change the database" $
ps^.database `shouldBe` db
it "should not change the progMode" $
show (ps^.progMode) `shouldBe` "MainMenu"
joe :: Goalie
joe = newGoalie 2 "Joe"
bob :: Goalie
bob = newGoalie 3 "Bob"
db :: Database
db = newDatabase & dbGoalies .~ [joe, bob]
progState :: ProgMode -> ProgState
progState mode = newProgState
& progMode .~ mode
& database .~ db

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
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -23,7 +23,7 @@ module Actions.NewGame.GoalieInputSpec (spec) where
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~))
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.NewGame.GoalieInput
@@ -33,27 +33,50 @@ import Mtlstats.Util
import qualified TypesSpec as TS
spec :: Spec
spec = describe "Mtlstats.Actions.GoalieInput" $ do
spec = describe "GoalieInput" $ do
finishGoalieEntrySpec
recordGoalieStatsSpec
setGameGoalieSpec
finishGoalieEntrySpec :: Spec
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
let
progState stats = newProgState
& progMode.gameStateL.gameGoalieStats .~ stats
& finishGoalieEntry
finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
(\(label, stats, grFlag, gaFlag) -> context label $ do
let
ps = newProgState
& progMode.gameStateL
%~ (gameGoalieStats .~ stats)
. (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 0)
. (overtimeFlag ?~ False)
& database.dbGoalies .~ goalies
context "no goalie data" $
it "should not set goaliesRecorded" $ let
s = progState M.empty
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
ps' = finishGoalieEntry ps
gs = ps'^.progMode.gameStateL
context "goalie data" $
it "should set goaliesRecorded" $ let
s = progState $ M.fromList [(1, newGoalieStats)]
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
describe "gameGoaliesRecorded" $
it ("should be " ++ show grFlag) $
gs^.gameGoaliesRecorded `shouldBe` grFlag
describe "gameGoalieAssigned" $
it ("should be " ++ show gaFlag) $
gs^.gameGoalieAssigned `shouldBe` gaFlag)
-- label, initial stats, goalies recorded, goalie assigned
[ ( "no goalies", noGoalies, False, False )
, ( "one goalie", oneGoalie, True, True )
, ( "two goalies", twoGoalies, True, False )
]
where
goalies = [joe, bob]
joe = newGoalie 2 "Joe"
bob = newGoalie 3 "Bob"
noGoalies = M.empty
oneGoalie = M.fromList [joeStats]
twoGoalies = M.fromList [joeStats, bobStats]
joeStats = (0, newGoalieStats)
bobStats = (1, newGoalieStats)
recordGoalieStatsSpec :: Spec
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
@@ -185,107 +208,175 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
]
setGameGoalieSpec :: Spec
setGameGoalieSpec = describe "setGameGoalie" $ let
setGameGoalieSpec = describe "setGameGoalie" $ mapM_
goalieStats w l t = newGoalieStats
& gsWins .~ w
& gsLosses .~ l
& gsTies .~ t
(\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
context label $ do
bob = newGoalie 2 "Bob"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
let
ps' = setGameGoalie goalieId ps
[joe', bob'] = ps'^.database.dbGoalies
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
joe = newGoalie 3 "Joe"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
context "Joe" $ joe' `TS.compareTest` expectedJoe
context "Bob" $ bob' `TS.compareTest` expectedBob
context "game stats" $ gStats' `TS.compareTest` expectedGStats)
gameState h a ot = newGameState
& gameType ?~ HomeGame
& homeScore ?~ h
& awayScore ?~ a
& overtimeFlag ?~ ot
[ ( "Joe wins - no shutout"
, 0
, psWin
, joeWin
, bob
, gsJoeWin
)
winningGame = gameState 1 0 False
losingGame = gameState 0 1 False
tiedGame = gameState 0 1 True
, ( "Bob wins - no shutout"
, 1
, psWin
, joe
, bobWin
, gsBobWin
)
in mapM_
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
, ( "Joe wins - shutout"
, 0
, psWinSO
, joeWinSO
, bob
, gsJoeWinSO
)
progState = newProgState
& database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gs
& setGameGoalie setGid
, ( "Bob wins - shutout"
, 1
, psWinSO
, joe
, bobWinSO
, gsBobWinSO
)
in mapM_
(\( chkLabel
, chkGid
, ( gWins
, gLosses
, gTies
, ytdWins
, ytdLosses
, ytdTies
, ltWins
, ltLosses
, ltTies
)
) -> context chkLabel $ do
let
goalie = (progState^.database.dbGoalies) !! chkGid
gameStats = progState^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats chkGid gameStats
ytd = goalie^.gYtd
lifetime = goalie^.gLifetime
, ( "Joe loses"
, 0
, psLose
, joeLose
, bob
, gsJoeLose
)
mapM_
(\(label', expected, actual) -> context label' $
expected `TS.compareTest` actual)
[ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
]
, ( "Bob loses"
, 1
, psLose
, joe
, bobLose
, gsBobLose
)
it "should set the gameGoalieAssigned flag" $
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
[ ( "checking Bob", 0, bobData )
, ( "checking Joe", 1, joeData )
])
[ ( "Bob wins"
, winningGame
, 0
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob loses"
, losingGame
, 0
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob ties"
, tiedGame
, 0
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Joe wins"
, winningGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
)
, ( "Joe loses"
, losingGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
)
, ( "Joe ties"
, tiedGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
)
]
, ( "Joe overtime"
, 0
, psOT
, joeOT
, bob
, gsJoeOT
)
, ( "Bob overtime"
, 1
, psOT
, joe
, bobOT
, gsBobOT
)
]
where
joe
= newGoalie 2 "Joe"
& gYtd
%~ (gsShutouts .~ 11)
. (gsWins .~ 12)
. (gsLosses .~ 13)
. (gsTies .~ 14)
& gLifetime
%~ (gsShutouts .~ 21)
. (gsWins .~ 22)
. (gsLosses .~ 23)
. (gsTies .~ 24)
bob
= newGoalie 3 "Bob"
& gYtd
%~ (gsShutouts .~ 31)
. (gsWins .~ 32)
. (gsLosses .~ 33)
. (gsTies .~ 34)
& gLifetime
%~ (gsShutouts .~ 41)
. (gsWins .~ 42)
. (gsLosses .~ 43)
. (gsTies .~ 44)
joeWin = win joe
bobWin = win bob
joeWinSO = winSO joe
bobWinSO = winSO bob
joeLose = lose joe
bobLose = lose bob
joeOT = tie joe
bobOT = tie bob
psWin = mkProgState
$ (homeScore ?~ 2)
. (awayScore ?~ 1)
psWinSO = mkProgState
$ (homeScore ?~ 1)
. (awayScore ?~ 0)
psLose = mkProgState
$ (homeScore ?~ 0)
. (awayScore ?~ 1)
psOT = mkProgState
$ (homeScore ?~ 0)
. (awayScore ?~ 1)
. (overtimeFlag ?~ True)
mkProgState f
= newProgState
& database.dbGoalies .~ [joe, bob]
& progMode.gameStateL
%~ f
. (gameType ?~ HomeGame)
. (overtimeFlag ?~ False)
gsJoeWin = mkGameStats 0 incWin
gsBobWin = mkGameStats 1 incWin
gsJoeWinSO = mkGameStats 0 $ incWin . incSO
gsBobWinSO = mkGameStats 1 $ incWin . incSO
gsJoeLose = mkGameStats 0 incLoss
gsBobLose = mkGameStats 1 incLoss
gsJoeOT = mkGameStats 0 incOT
gsBobOT = mkGameStats 1 incOT
mkGameStats n f = M.fromList [(n, f newGoalieStats)]
win
= (gYtd %~ incWin)
. (gLifetime %~ incWin)
winSO
= (gYtd %~ (incWin . incSO))
. (gLifetime %~ (incWin . incSO))
lose
= (gYtd %~ incLoss)
. (gLifetime %~ incLoss)
tie
= (gYtd %~ incOT)
. (gLifetime %~ incOT)
incWin = gsWins %~ succ
incSO = gsShutouts %~ succ
incLoss = gsLosses %~ succ
incOT = gsTies %~ succ

View File

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

View File

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -24,7 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where
import Control.Monad (replicateM)
import Lens.Micro ((^.), (&), (.~), (?~))
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Test.Hspec
( Spec
, context
@@ -38,8 +38,8 @@ import Test.Hspec
import Mtlstats.Actions
import Mtlstats.Types
import qualified Actions.EditGoalieSpec as EditGoalie
import qualified Actions.NewGameSpec as NewGame
import qualified Actions.EditStandingsSpec as EditStandings
import qualified TypesSpec as TS
spec :: Spec
@@ -47,6 +47,7 @@ spec = describe "Mtlstats.Actions" $ do
startNewSeasonSpec
startNewGameSpec
resetYtdSpec
clearRookiesSpec
resetStandingsSpec
addCharSpec
removeCharSpec
@@ -54,7 +55,9 @@ spec = describe "Mtlstats.Actions" $ do
createGoalieSpec
editSpec
editPlayerSpec
editSelectedPlayerSpec
editGoalieSpec
editSelectedGoalieSpec
addPlayerSpec
addGoalieSpec
resetCreatePlayerStateSpec
@@ -63,7 +66,7 @@ spec = describe "Mtlstats.Actions" $ do
scrollUpSpec
scrollDownSpec
NewGame.spec
EditGoalie.spec
EditStandings.spec
startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do
@@ -129,6 +132,45 @@ resetYtdSpec = describe "resetYtd" $
lt ^. gsTies `shouldNotBe` 0) $
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
@@ -211,58 +253,152 @@ editPlayerSpec = describe "editPlayer" $
s = editPlayer newProgState
in show (s^.progMode) `shouldBe` "EditPlayer"
editSelectedPlayerSpec :: Spec
editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
(\(label, pState, expected) -> context label $
it "should edit the players appropriately" $ let
pState' = editSelectedPlayer (pName .~ "foo") pState
players' = pState'^.database.dbPlayers
in players' `shouldBe` expected)
-- label, initial state, expected
[ ( "wrong mode", baseState, players )
, ( "not selected", changePlayer Nothing, players )
, ( "player 0", changePlayer $ Just 0, changed0 )
, ( "player 1", changePlayer $ Just 1, changed1 )
, ( "out of bounds", changePlayer $ Just 2, players )
]
where
baseState = newProgState & database.dbPlayers .~ players
changePlayer n = baseState
& (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
players = [ player 0, player 1 ]
changed0 = [ player' 0, player 1 ]
changed1 = [ player 0, player' 1 ]
player n = newPlayer n ("Player " ++ show n) "pos"
player' n = newPlayer n "foo" "pos"
editGoalieSpec :: Spec
editGoalieSpec = describe "editGoalie" $
it "should change the mode appropriately" $ let
s = editGoalie newProgState
in show (s^.progMode) `shouldBe` "EditGoalie"
editSelectedGoalieSpec :: Spec
editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
(\(label, pState, expected) -> context label $
it "should edit the goalies appropriately" $ let
pState' = editSelectedGoalie (gName .~ "foo") pState
goalies' = pState'^.database.dbGoalies
in goalies' `shouldBe` expected)
-- label, initial state, expected
[ ( "wrong mode", baseState, goalies )
, ( "not selected", changeGoalie Nothing, goalies )
, ( "goalie 0", changeGoalie $ Just 0, changed0 )
, ( "goalie 1", changeGoalie $ Just 1, changed1 )
, ( "out of bounds", changeGoalie $ Just 2, goalies )
]
where
baseState = newProgState & database.dbGoalies .~ goalies
changeGoalie n = baseState
& (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
goalies = [ goalie 0, goalie 1 ]
changed0 = [ goalie' 0, goalie 1 ]
changed1 = [ goalie 0, goalie' 1 ]
goalie n = newGoalie n ("Player " ++ show n)
goalie' n = newGoalie n "foo"
addPlayerSpec :: Spec
addPlayerSpec = describe "addPlayer" $ do
let
p1 = newPlayer 1 "Joe" "centre"
p2 = newPlayer 2 "Bob" "defense"
db = newDatabase
& dbPlayers .~ [p1]
s pm = newProgState
& progMode .~ pm
& database .~ db
addPlayerSpec = describe "addPlayer" $ mapM_
(\(label, expectation, pm, players) -> context label $
it expectation $ let
ps = newProgState
& progMode .~ pm
& database.dbPlayers .~ [joe]
ps' = addPlayer ps
in ps'^.database.dbPlayers `shouldBe` players)
context "data available" $
it "should create the player" $ let
s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
& cpsNumber ?~ 2
& cpsName .~ "Bob"
& cpsPosition .~ "defense"
in s'^.database.dbPlayers `shouldBe` [p1, p2]
-- label, expectation, progMode, players
[ ( "wrong mode", failure, MainMenu, [joe] )
, ( "missing number", failure, noNum, [joe] )
, ( "missing rookie flag", failure, noRookie, [joe] )
, ( "missing active flag", failure, noActive, [joe] )
, ( "rookie", success, mkRookie, [joe, rookie] )
, ( "retired", success, mkRetired, [joe, retired] )
, ( "normal player", success, mkNormal, [joe, normal] )
]
context "data unavailable" $
it "should not create the player" $ let
s' = addPlayer $ s MainMenu
in s'^.database.dbPlayers `shouldBe` [p1]
where
failure = "should not create the player"
success = "should create the player"
noNum = mkpm Nothing (Just False) (Just True)
noRookie = mkpm (Just 3) Nothing (Just True)
noActive = mkpm (Just 3) (Just False) Nothing
mkRookie = mkpm (Just 3) (Just True) (Just True)
mkRetired = mkpm (Just 3) (Just False) (Just False)
mkNormal = mkpm (Just 3) (Just False) (Just True)
joe = newPlayer 2 "Joe" "centre"
rookie = player True True
retired = player False False
normal = player False True
player r a = newPlayer 3 "Bob" "defense"
& pRookie .~ r
& pActive .~ a
mkpm n r a = CreatePlayer $ newCreatePlayerState
& cpsNumber .~ n
& cpsName .~ "Bob"
& cpsPosition .~ "defense"
& cpsRookieFlag .~ r
& cpsActiveFlag .~ a
addGoalieSpec :: Spec
addGoalieSpec = describe "addGoalie" $ do
let
g1 = newGoalie 2 "Joe"
g2 = newGoalie 3 "Bob"
db = newDatabase
& dbGoalies .~ [g1]
s pm = newProgState
& database .~ db
& progMode .~ pm
addGoalieSpec = describe "addGoalie" $ mapM_
(\(label, expectation, pm, goalies) -> context label $
it expectation $ let
ps = newProgState
& progMode .~ pm
& database.dbGoalies .~ [joe]
ps' = addGoalie ps
in ps'^.database.dbGoalies `shouldBe` goalies)
context "data available" $
it "should create the goalie" $ let
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
& cgsNumber ?~ 3
& cgsName .~ "Bob"
in s'^.database.dbGoalies `shouldBe` [g1, g2]
-- label, expectation, progMode, expected goalies
[ ( "wrong mode", failure, MainMenu, [joe] )
, ( "no number", failure, noNum, [joe] )
, ( "no rookie flag", failure, noRookie, [joe] )
, ( "no active flag", failure, noActive, [joe] )
, ( "rookie", success, mkRookie, [joe, rookie] )
, ( "retired", success, mkRetired, [joe, retired] )
, ( "normal goalie", success, mkNormal, [joe, normal] )
]
context "data unavailable" $
it "should not create the goalie" $ let
s' = addGoalie $ s MainMenu
in s'^.database.dbGoalies `shouldBe` [g1]
where
failure = "should not create the goalie"
success = "should create the goalie"
noNum = cgs Nothing (Just False) (Just True)
noRookie = cgs (Just 3) Nothing (Just True)
noActive = cgs (Just 3) (Just False) Nothing
mkRookie = cgs (Just 3) (Just True) (Just True)
mkRetired = cgs (Just 3) (Just False) (Just False)
mkNormal = cgs (Just 3) (Just False) (Just True)
joe = newGoalie 2 "Joe"
rookie = goalie True True
retired = goalie False False
normal = goalie False True
goalie r a = newGoalie 3 "Bob"
& gRookie .~ r
& gActive .~ a
cgs n r a = CreateGoalie $ newCreateGoalieState
& cgsNumber .~ n
& cgsName .~ "Bob"
& cgsRookieFlag .~ r
& cgsActiveFlag .~ a
resetCreatePlayerStateSpec :: Spec
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let

View File

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

View File

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

View File

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -22,45 +22,70 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Helpers.GoalieSpec (spec) where
import Lens.Micro ((&), (.~), (%~))
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Helpers.Goalie
import Mtlstats.Types
spec :: Spec
spec = describe "Goalie"
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 )
. ( gsWins .~ 5 )
. ( gsLosses .~ 6 )
. ( gsTies .~ 7 )
. ( gsShutouts .~ 5 )
. ( gsWins .~ 6 )
. ( gsLosses .~ 7 )
. ( gsTies .~ 8 )
& gLifetime
%~ ( gsGames .~ 8 )
. ( gsMinsPlayed .~ 9 )
. ( gsGoalsAllowed .~ 10 )
. ( gsWins .~ 11 )
. ( gsLosses .~ 12 )
. ( gsTies .~ 13 )
%~ ( gsGames .~ 9 )
. ( gsMinsPlayed .~ 10 )
. ( gsGoalsAllowed .~ 11 )
. ( gsShutouts .~ 12 )
. ( gsWins .~ 13 )
. ( gsLosses .~ 14 )
. ( gsTies .~ 15 )
expected = unlines
[ "Number: 1"
, " Name: Joe"
, " Name: Joe*"
, ""
, " YTD Lifetime"
, " Games played 2 8"
, " Mins played 3 9"
, "Goals allowed 4 10"
, " Wins 5 11"
, " Losses 6 12"
, " Ties 7 13"
, " 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

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -22,20 +22,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Helpers.PlayerSpec (spec) where
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Helpers.Player
import Mtlstats.Types
spec :: Spec
spec = describe "Player"
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
@@ -49,7 +51,7 @@ playerDetailsSpec = describe "playerDetails" $
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Name: Joe*"
, "Position: centre"
, ""
, " YTD Lifetime"
@@ -59,3 +61,23 @@ playerDetailsSpec = describe "playerDetails" $
]
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

View File

@@ -0,0 +1,79 @@
{-
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Helpers.PositionSpec (spec) where
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Helpers.Position
import Mtlstats.Types
spec :: Spec
spec = describe "Position" $ do
posSearchSpec
posSearchExactSpec
getPositionsSpec
posSearchSpec :: Spec
posSearchSpec = describe "posSearch" $ mapM_
(\(sStr, expected) -> context ("search string: " ++ show sStr) $
it ("should be " ++ show expected) $
posSearch sStr db `shouldBe` expected)
[ ( "fOo"
, [ ( 2, "foo" )
]
)
, ( "A"
, [ ( 0, "bar" )
, ( 1, "baz" )
]
)
]
posSearchExactSpec :: Spec
posSearchExactSpec = describe "posSearchExact" $ mapM_
(\(input, expected) -> context ("input: " ++ show input) $
it ("should be " ++ show expected) $
posSearchExact input db `shouldBe` expected)
-- input, expected
[ ( "foo", Just 2 )
, ( "FOO", Nothing )
, ( "bar", Just 0 )
, ( "baz", Just 1 )
, ( "a", Nothing )
, ( "quux", Nothing )
]
getPositionsSpec :: Spec
getPositionsSpec = describe "getPositions" $ let
expected = ["bar", "baz", "foo"]
in it ("should be " ++ show expected) $
getPositions db `shouldBe` expected
db :: Database
db = newDatabase & dbPlayers .~
[ newPlayer 2 "Joe" "foo"
, newPlayer 3 "Bob" "bar"
, newPlayer 5 "Bill" "foo"
, newPlayer 8 "Ed" "baz"
]

View File

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -25,8 +25,10 @@ import Test.Hspec (Spec, describe)
import qualified Helpers.GoalieSpec as Goalie
import qualified Helpers.PlayerSpec as Player
import qualified Helpers.PositionSpec as Position
spec :: Spec
spec = describe "Helper" $ do
Player.spec
Goalie.spec
Position.spec

View File

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

View File

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

View File

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

View File

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
module TypesSpec
( Comparable (..)
@@ -33,10 +33,11 @@ module TypesSpec
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import qualified Data.Map.Lazy as M
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomRIO)
import System.Random (randomIO, randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config
@@ -58,6 +59,8 @@ spec = describe "Mtlstats.Types" $ do
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
editStandingsModeLSpec
esmSubModeLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
@@ -191,6 +194,47 @@ editGoalieStateLSpec = describe "editGoalieStateL" $
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 = describe "teamScore" $ do
let
@@ -271,6 +315,7 @@ lensSpec lens getters setters = do
player :: Player
player = newPlayer 1 "Joe" "centre"
& pRookie .~ False
& pYtd .~ playerStats 1
& pLifetime .~ playerStats 2
@@ -279,6 +324,8 @@ playerJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 )
]
@@ -298,6 +345,7 @@ playerStatsJSON n = Object $ HM.fromList
goalie :: Goalie
goalie = newGoalie 1 "Joe"
& gRookie .~ False
& gYtd .~ goalieStats 1
& gLifetime .~ goalieStats 2
@@ -305,6 +353,8 @@ goalieJSON :: Value
goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
@@ -843,6 +893,8 @@ makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makeBool
<*> makeBool
<*> makePlayerStats
<*> makePlayerStats
@@ -851,6 +903,8 @@ makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeBool
<*> makeBool
<*> makeGoalieStats
<*> makeGoalieStats
@@ -875,6 +929,9 @@ makeGoalieStats = GoalieStats
makeNum :: IO Int
makeNum = randomRIO (1, 10)
makeBool :: IO Bool
makeBool = randomIO
makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z')
@@ -944,3 +1001,53 @@ instance Comparable CreateGoalieState where
describe "cgsName" $
it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName
instance Comparable EditStandingsMode where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
instance Comparable Goalie where
compareTest actual expected = do
describe "gNumber" $
it ("should be " ++ show (expected^.gNumber)) $
actual^.gNumber `shouldBe` expected^.gNumber
describe "gName" $
it ("should be " ++ show (expected^.gName)) $
actual^.gName `shouldBe` expected^.gName
describe "gRookie" $
it ("should be " ++ show (expected^.gRookie)) $
actual^.gRookie `shouldBe` expected^.gRookie
describe "gActive" $
it ("should be " ++ show (expected^.gActive)) $
actual^.gActive `shouldBe` expected^.gActive
describe "gYtd" $
(actual^.gYtd) `compareTest` (expected^.gYtd)
describe "gLifetime" $
(actual^.gLifetime) `compareTest` (expected^.gLifetime)
instance Comparable (M.Map Int GoalieStats) where
compareTest actual expected = do
let
aList = M.toList actual
eList = M.toList expected
it "should have the correct number of elements" $
length aList `shouldBe` length eList
mapM_
(\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
context "key" $
it ("should be " ++ show ke) $
ka `shouldBe` ke
context "value" $ va `compareTest` ve)
(zip3 ([0..] :: [Int]) aList eList)

View File

@@ -1,7 +1,7 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
@@ -30,6 +30,7 @@ spec :: Spec
spec = describe "Mtlstats.Util" $ do
nthSpec
modifyNthSpec
dropNthSpec
updateMapSpec
sliceSpec
capitalizeNameSpec
@@ -64,6 +65,20 @@ modifyNthSpec = describe "modifyNth" $ do
it "should not modify the value" $
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
dropNthSpec :: Spec
dropNthSpec = describe "dropNth" $ mapM_
(\(label, n, expected) ->
context label $
it ("should be " ++ show expected) $
dropNth n list `shouldBe` expected)
[ ( "out of bounds", 1, ["foo", "baz"] )
, ( "in bounds", 3, list )
]
where list = ["foo", "bar", "baz"]
updateMapSpec :: Spec
updateMapSpec = describe "updateMap" $ do
let

8
vagrant/as_user.sh Executable file
View File

@@ -0,0 +1,8 @@
#!/bin/sh
echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc
mkdir /vagrant/data
ln -s /vagrant/data ~vagrant/.mtlstats
cd /vagrant
stack install

10
vagrant/provision.sh Executable file
View File

@@ -0,0 +1,10 @@
#!/bin/sh
apt-get update
apt-get upgrade
apt-get -y install libghc-ncurses-dev
wget -qO- https://get.haskellstack.org/ | sh
export HOME=/home/vagrant
sudo -u vagrant /vagrant/vagrant/as_user.sh