113 Commits

Author SHA1 Message Date
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
43 changed files with 2106 additions and 616 deletions

3
.gitignore vendored
View File

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

View File

@@ -1,5 +1,29 @@
# Changelog for mtlstats # Changelog for mtlstats
## 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 ## 0.10.0
- Don't show player number zero in reports - Don't show player number zero in reports
- Fixed player/goalie name capitalisation on edit - Fixed player/goalie name capitalisation on edit
@@ -33,24 +57,20 @@
- Reset game standings on new season - Reset game standings on new season
## 0.5.0 ## 0.5.0
- Fixed player creation bug - Fixed player creation bug
- Prompt for goalie informaiton on game data entry - Prompt for goalie informaiton on game data entry
- Implemented player editing - Implemented player editing
## v0.4.0 ## v0.4.0
- Record penalty minutes - Record penalty minutes
- Calculate total game statistics - Calculate total game statistics
- Generate year-to-date statistics report - Generate year-to-date statistics report
## v0.3.0 ## v0.3.0
- Record goals and assists - Record goals and assists
- Track goals for and goals against - Track goals for and goals against
## v0.2.0 ## v0.2.0
- Overtime losses don't count in the loss column - Overtime losses don't count in the loss column
- Confirm game data with user before updating stats - Confirm game data with user before updating stats
- Implemented player creation - Implemented player creation

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,5 +1,5 @@
name: mtlstats name: mtlstats
version: 0.10.0 version: 0.14.0
github: "mtlstats/mtlstats" github: "mtlstats/mtlstats"
license: GPL-3 license: GPL-3
author: "Jonathan Lamothe" author: "Jonathan Lamothe"

View File

@@ -24,6 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Actions module Mtlstats.Actions
( startNewSeason ( startNewSeason
, resetYtd , resetYtd
, clearRookies
, resetStandings , resetStandings
, startNewGame , startNewGame
, addChar , addChar
@@ -42,18 +43,29 @@ module Mtlstats.Actions
, backHome , backHome
, scrollUp , scrollUp
, scrollDown , scrollDown
, saveDatabase
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~)) import Lens.Micro ((^.), (&), (.~), (%~))
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import Mtlstats.Config
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
-- | Starts a new season -- | Starts a new season
startNewSeason :: ProgState -> ProgState startNewSeason :: ProgState -> ProgState
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0) startNewSeason
= (progMode .~ NewSeason False)
. (database.dbGames .~ 0)
-- | Resets all players year-to-date stats -- | Resets all players year-to-date stats
resetYtd :: ProgState -> ProgState resetYtd :: ProgState -> ProgState
@@ -61,6 +73,12 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats)) = (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats)) . (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
-- | Clears the rookie flag from all players/goalies
clearRookies :: ProgState -> ProgState
clearRookies = database
%~ (dbPlayers %~ map (pRookie .~ False))
. (dbGoalies %~ map (gRookie .~ False))
-- | Resets game standings -- | Resets game standings
resetStandings :: ProgState -> ProgState resetStandings :: ProgState -> ProgState
resetStandings = database resetStandings = database
@@ -143,11 +161,15 @@ editSelectedGoalie f s = fromMaybe s $ do
addPlayer :: ProgState -> ProgState addPlayer :: ProgState -> ProgState
addPlayer s = fromMaybe s $ do addPlayer s = fromMaybe s $ do
let cps = s^.progMode.createPlayerStateL let cps = s^.progMode.createPlayerStateL
num <- cps^.cpsNumber num <- cps^.cpsNumber
rFlag <- cps^.cpsRookieFlag
aFlag <- cps^.cpsActiveFlag
let let
name = cps^.cpsName name = cps^.cpsName
pos = cps^.cpsPosition pos = cps^.cpsPosition
player = newPlayer num name pos player = newPlayer num name pos
& pRookie .~ rFlag
& pActive .~ aFlag
Just $ s & database.dbPlayers Just $ s & database.dbPlayers
%~ (++[player]) %~ (++[player])
@@ -155,10 +177,14 @@ addPlayer s = fromMaybe s $ do
addGoalie :: ProgState -> ProgState addGoalie :: ProgState -> ProgState
addGoalie s = fromMaybe s $ do addGoalie s = fromMaybe s $ do
let cgs = s^.progMode.createGoalieStateL let cgs = s^.progMode.createGoalieStateL
num <- cgs^.cgsNumber num <- cgs^.cgsNumber
rFlag <- cgs^.cgsRookieFlag
aFlag <- cgs^.cgsActiveFlag
let let
name = cgs^.cgsName name = cgs^.cgsName
goalie = newGoalie num name goalie = newGoalie num name
& gRookie .~ rFlag
& gActive .~ aFlag
Just $ s & database.dbGoalies Just $ s & database.dbGoalies
%~ (++[goalie]) %~ (++[goalie])
@@ -189,3 +215,13 @@ scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down -- | Scrolls the display down
scrollDown :: ProgState -> ProgState scrollDown :: ProgState -> ProgState
scrollDown = scrollOffset %~ succ scrollDown = scrollOffset %~ succ
-- | Saves the database
saveDatabase :: String -> Action ()
saveDatabase fn = do
db <- gets (^.database)
liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> fn
createDirectoryIfMissing True dir
encodeFile dbFile db

View File

@@ -0,0 +1,70 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Actions.EditStandings
( editStandings
, editHomeStandings
, editAwayStandings
, editWins
, editLosses
, editOvertime
, editGoalsFor
, editGoalsAgainst
) where
import Lens.Micro ((.~))
import Mtlstats.Types
-- | Enters edit standings mode
editStandings :: ProgState -> ProgState
editStandings = progMode .~ EditStandings ESMMenu
-- | Edits the home standings
editHomeStandings :: ProgState -> ProgState
editHomeStandings = progMode .~ EditStandings (ESMHome ESMSubMenu)
-- | Edits the road standings
editAwayStandings :: ProgState -> ProgState
editAwayStandings = progMode .~ EditStandings (ESMAway ESMSubMenu)
-- | Changes to edit wins mode
editWins :: ProgState -> ProgState
editWins = doEdit ESMEditWins
-- | Changes to edit losses mode
editLosses :: ProgState -> ProgState
editLosses = doEdit ESMEditLosses
-- | Changes to edit overtime mode
editOvertime :: ProgState -> ProgState
editOvertime = doEdit ESMEditOvertime
-- | Changes to edit goals for mode
editGoalsFor :: ProgState -> ProgState
editGoalsFor = doEdit ESMEditGoalsFor
-- | Changes to edit goals against mode
editGoalsAgainst :: ProgState -> ProgState
editGoalsAgainst = doEdit ESMEditGoalsAgainst
doEdit :: ESMSubMode -> ProgState -> ProgState
doEdit = (progMode.editStandingsModeL.esmSubModeL .~)

View File

@@ -124,12 +124,13 @@ awardGoal n ps = ps
(\m -> let (\m -> let
stats = M.findWithDefault newPlayerStats n m stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m) in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map & database.dbPlayers %~ zipWith
(\(i, p) -> if i == n (\i p -> if i == n
then p then p
& pYtd.psGoals %~ succ & pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ & pLifetime.psGoals %~ succ
else p) . zip [0..] else p)
[0..]
-- | Awards an assist to a player -- | Awards an assist to a player
awardAssist awardAssist
@@ -142,12 +143,13 @@ awardAssist n ps = ps
(\m -> let (\m -> let
stats = M.findWithDefault newPlayerStats n m stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m) in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map & database.dbPlayers %~ zipWith
(\(i, p) -> if i == n (\i p -> if i == n
then p then p
& pYtd.psAssists %~ succ & pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ & pLifetime.psAssists %~ succ
else p) . zip [0..] else p)
[0..]
-- | Resets the entered data for the current goal -- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState resetGoalData :: ProgState -> ProgState

View File

@@ -36,8 +36,12 @@ import Mtlstats.Util
-- | Attempts to finish game goalie entry -- | Attempts to finish game goalie entry
finishGoalieEntry :: ProgState -> ProgState finishGoalieEntry :: ProgState -> ProgState
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats) [] -> s
[(gid, _)] -> setGameGoalie gid s'
_ -> s'
where
s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
-- | Records the goalie's game stats -- | Records the goalie's game stats
recordGoalieStats :: ProgState -> ProgState recordGoalieStats :: ProgState -> ProgState
@@ -83,18 +87,22 @@ setGameGoalie
-> ProgState -> ProgState
setGameGoalie gid s = fromMaybe s $ do setGameGoalie gid s = fromMaybe s $ do
let gs = s^.progMode.gameStateL let gs = s^.progMode.gameStateL
won <- gameWon gs won <- gameWon gs
lost <- gameLost gs lost <- gameLost gs
tied <- gs^.overtimeFlag tied <- gs^.overtimeFlag
shutout <- (==0) <$> otherScore gs
let let
w = if won then 1 else 0 w = if won then 1 else 0
l = if lost then 1 else 0 l = if lost then 1 else 0
t = if tied then 1 else 0 t = if tied then 1 else 0
so = if shutout then 1 else 0
updateStats updateStats
= (gsWins +~ w) = (gsWins +~ w)
. (gsLosses +~ l) . (gsLosses +~ l)
. (gsTies +~ t) . (gsTies +~ t)
. (gsShutouts +~ so)
updateGoalie updateGoalie
= (gYtd %~ updateStats) = (gYtd %~ updateStats)

View File

@@ -44,3 +44,11 @@ maxAssists = 2
-- | The length of a typical game (in minutes) -- | The length of a typical game (in minutes)
gameLength :: Int gameLength :: Int
gameLength = 60 gameLength = 60
-- | Report output filename
reportFilename :: FilePath
reportFilename = "report.txt"
-- | Number of columns in report file
reportCols :: Int
reportCols = 79

View File

@@ -21,18 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where module Mtlstats.Control (dispatch) where
import Control.Monad (join)
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromJust)
import Lens.Micro ((^.)) 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.EditGoalie
import Mtlstats.Control.EditPlayer import Mtlstats.Control.EditPlayer
import Mtlstats.Control.EditStandings
import Mtlstats.Control.NewGame import Mtlstats.Control.NewGame
import Mtlstats.Handlers import Mtlstats.Control.TitleScreen
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Types import Mtlstats.Types
@@ -41,21 +38,16 @@ import Mtlstats.Types
-- run -- run
dispatch :: ProgState -> Controller dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of dispatch s = case s^.progMode of
MainMenu -> mainMenuC TitleScreen -> titleScreenC
NewSeason -> newSeasonC MainMenu -> mainMenuC
NewGame gs -> newGameC gs NewSeason flag -> newSeasonC flag
EditMenu -> editMenuC NewGame gs -> newGameC gs
CreatePlayer cps EditMenu -> editMenuC
| null $ cps^.cpsNumber -> getPlayerNumC CreatePlayer cps -> createPlayerC cps
| null $ cps^.cpsName -> getPlayerNameC CreateGoalie cgs -> createGoalieC cgs
| null $ cps^.cpsPosition -> getPlayerPosC EditPlayer eps -> editPlayerC eps
| otherwise -> confirmCreatePlayerC EditGoalie egs -> editGoalieC egs
CreateGoalie cgs (EditStandings esm) -> editStandingsC esm
| null $ cgs^.cgsNumber -> getGoalieNumC
| null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
mainMenuC :: Controller mainMenuC :: Controller
mainMenuC = Controller mainMenuC = Controller
@@ -63,95 +55,9 @@ mainMenuC = Controller
, handleController = menuHandler mainMenu , handleController = menuHandler mainMenu
} }
newSeasonC :: Controller newSeasonC :: Bool -> Controller
newSeasonC = Controller newSeasonC False = promptController newSeasonPrompt
{ drawController = const $ drawMenu newSeasonMenu newSeasonC True = menuController newSeasonMenu
, handleController = \e -> do
menuHandler newSeasonMenu e
return True
}
editMenuC :: Controller editMenuC :: Controller
editMenuC = menuController editMenu 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

@@ -39,89 +39,103 @@ import Mtlstats.Util
editGoalieC :: EditGoalieState -> Controller editGoalieC :: EditGoalieState -> Controller
editGoalieC egs editGoalieC egs
| null $ egs^.egsSelectedGoalie = selectC | null $ egs^.egsSelectedGoalie = selectC
| otherwise = editC $ egs^.egsMode | otherwise = editC (egs^.egsCallback) (egs^.egsMode)
selectC :: Controller selectC :: Controller
selectC = promptController goalieToEditPrompt selectC = promptController goalieToEditPrompt
editC :: EditGoalieMode -> Controller editC :: Action () -> EditGoalieMode -> Controller
editC = \case editC cb =
EGMenu -> menuC ( \case
EGNumber -> numberC EGMenu -> menuC
EGName -> nameC EGNumber -> numberC
EGYtd -> ytdMenuC EGName -> nameC
EGLifetime -> lifetimeMenuC EGYtd -> ytdMenuC
EGYtdGames b -> ytdGamesC b EGLifetime -> lifetimeMenuC
EGYtdMins b -> ytdMinsC b EGYtdGames b -> ytdGamesC b
EGYtdGoals b -> ytdGoalsC b EGYtdMins b -> ytdMinsC b
EGYtdShutouts b -> ytdShutoutsC b EGYtdGoals b -> ytdGoalsC b
EGYtdWins b -> ytdWinsC b EGYtdShutouts b -> ytdShutoutsC b
EGYtdLosses b -> ytdLossesC b EGYtdWins b -> ytdWinsC b
EGYtdTies -> ytdTiesC EGYtdLosses b -> ytdLossesC b
EGLtGames b -> ltGamesC b EGYtdTies -> ytdTiesC
EGLtMins b -> ltMinsC b EGLtGames b -> ltGamesC b
EGLtGoals b -> ltGoalsC b EGLtMins b -> ltMinsC b
EGLtShutouts b -> ltShutoutsC b EGLtGoals b -> ltGoalsC b
EGLtWins b -> ltWinsC b EGLtShutouts b -> ltShutoutsC b
EGLtLosses b -> ltLossesC b EGLtWins b -> ltWinsC b
EGLtTies -> ltTiesC EGLtLosses b -> ltLossesC b
EGLtTies -> ltTiesC
) <*> return cb
menuC :: Controller menuC :: Action () -> Controller
menuC = menuControllerWith header editGoalieMenu menuC _ = menuControllerWith header editGoalieMenu
numberC :: Controller numberC :: Action () -> Controller
numberC = promptController editGoalieNumberPrompt numberC = promptController . editGoalieNumberPrompt
nameC :: Controller nameC :: Action () -> Controller
nameC = promptController editGoalieNamePrompt nameC = promptController . editGoalieNamePrompt
ytdMenuC :: Controller ytdMenuC :: Action () -> Controller
ytdMenuC = menuControllerWith header editGoalieYtdMenu ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
lifetimeMenuC :: Controller lifetimeMenuC :: Action () -> Controller
lifetimeMenuC = menuControllerWith header editGoalieLtMenu lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
ytdGamesC :: Bool -> Controller ytdGamesC :: Bool -> Action () -> Controller
ytdGamesC = promptController . editGoalieYtdGamesPrompt ytdGamesC = curry $ promptController .
uncurry editGoalieYtdGamesPrompt
ytdMinsC :: Bool -> Controller ytdMinsC :: Bool -> Action () -> Controller
ytdMinsC = promptController . editGoalieYtdMinsPrompt ytdMinsC = curry $ promptController .
uncurry editGoalieYtdMinsPrompt
ytdGoalsC :: Bool -> Controller ytdGoalsC :: Bool -> Action () -> Controller
ytdGoalsC = promptController . editGoalieYtdGoalsPrompt ytdGoalsC = curry $ promptController .
uncurry editGoalieYtdGoalsPrompt
ytdShutoutsC :: Bool -> Controller ytdShutoutsC :: Bool -> Action () -> Controller
ytdShutoutsC = promptController . editGoalieYtdShutoutsPrompt ytdShutoutsC = curry $ promptController .
uncurry editGoalieYtdShutoutsPrompt
ytdWinsC :: Bool -> Controller ytdWinsC :: Bool -> Action () -> Controller
ytdWinsC = promptController . editGoalieYtdWinsPrompt ytdWinsC = curry $ promptController .
uncurry editGoalieYtdWinsPrompt
ytdLossesC :: Bool -> Controller ytdLossesC :: Bool -> Action () -> Controller
ytdLossesC = promptController . editGoalieYtdLossesPrompt ytdLossesC = curry $ promptController .
uncurry editGoalieYtdLossesPrompt
ytdTiesC :: Controller ytdTiesC :: Action () -> Controller
ytdTiesC = promptController editGoalieYtdTiesPrompt ytdTiesC = promptController . editGoalieYtdTiesPrompt
ltGamesC :: Bool -> Controller ltGamesC :: Bool -> Action () -> Controller
ltGamesC = promptController . editGoalieLtGamesPrompt ltGamesC = curry $ promptController .
uncurry editGoalieLtGamesPrompt
ltMinsC :: Bool -> Controller ltMinsC :: Bool -> Action () -> Controller
ltMinsC = promptController . editGoalieLtMinsPrompt ltMinsC = curry $ promptController .
uncurry editGoalieLtMinsPrompt
ltGoalsC :: Bool -> Controller ltGoalsC :: Bool -> Action() -> Controller
ltGoalsC = promptController . editGoalieLtGoalsPrompt ltGoalsC = curry $ promptController .
uncurry editGoalieLtGoalsPrompt
ltShutoutsC :: Bool -> Controller ltShutoutsC :: Bool -> Action () -> Controller
ltShutoutsC = promptController . editGoalieLtShutoutsPrompt ltShutoutsC = curry $ promptController .
uncurry editGoalieLtShutoutsPrompt
ltWinsC :: Bool -> Controller ltWinsC :: Bool -> Action () -> Controller
ltWinsC = promptController . editGoalieLtWinsPrompt ltWinsC = curry $ promptController .
uncurry editGoalieLtWinsPrompt
ltLossesC :: Bool -> Controller ltLossesC :: Bool -> Action () -> Controller
ltLossesC = promptController . editGoalieLtLossesPrompt ltLossesC = curry $ promptController .
uncurry editGoalieLtLossesPrompt
ltTiesC :: Controller ltTiesC :: Action () -> Controller
ltTiesC = promptController editGoalieLtTiesPrompt ltTiesC = promptController . editGoalieLtTiesPrompt
header :: ProgState -> C.Update () header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do header s = C.drawString $ fromMaybe "" $ do

View File

@@ -37,58 +37,64 @@ import Mtlstats.Util
editPlayerC :: EditPlayerState -> Controller editPlayerC :: EditPlayerState -> Controller
editPlayerC eps editPlayerC eps
| null $ eps^.epsSelectedPlayer = selectPlayerC | null $ eps^.epsSelectedPlayer = selectPlayerC
| otherwise = case eps^.epsMode of | otherwise =
EPMenu -> menuC ( case eps^.epsMode of
EPNumber -> numberC EPMenu -> menuC
EPName -> nameC EPNumber -> numberC
EPPosition -> positionC EPName -> nameC
EPYtd -> ytdC EPPosition -> positionC
EPLifetime -> lifetimeC EPYtd -> ytdC
EPYtdGoals b -> ytdGoalsC b EPLifetime -> lifetimeC
EPYtdAssists b -> ytdAssistsC b EPYtdGoals b -> ytdGoalsC b
EPYtdPMin -> ytdPMinC EPYtdAssists b -> ytdAssistsC b
EPLtGoals b -> ltGoalsC b EPYtdPMin -> ytdPMinC
EPLtAssists b -> ltAssistsC b EPLtGoals b -> ltGoalsC b
EPLtPMin -> ltPMinC EPLtAssists b -> ltAssistsC b
EPLtPMin -> ltPMinC
) $ eps^.epsCallback
selectPlayerC :: Controller selectPlayerC :: Controller
selectPlayerC = promptController playerToEditPrompt selectPlayerC = promptController playerToEditPrompt
menuC :: Controller menuC :: Action () -> Controller
menuC = menuControllerWith header editPlayerMenu menuC _ = menuControllerWith header editPlayerMenu
numberC :: Controller numberC :: Action () -> Controller
numberC = promptController editPlayerNumPrompt numberC = promptController . editPlayerNumPrompt
nameC :: Controller nameC :: Action () -> Controller
nameC = promptController editPlayerNamePrompt nameC = promptController . editPlayerNamePrompt
positionC :: Controller positionC :: Action () -> Controller
positionC = promptController editPlayerPosPrompt positionC = promptController . editPlayerPosPrompt
ytdC :: Controller ytdC :: Action () -> Controller
ytdC = menuControllerWith header editPlayerYtdMenu ytdC _ = menuControllerWith header editPlayerYtdMenu
lifetimeC :: Controller lifetimeC :: Action () -> Controller
lifetimeC = menuControllerWith header editPlayerLtMenu lifetimeC _ = menuControllerWith header editPlayerLtMenu
ytdGoalsC :: Bool -> Controller ytdGoalsC :: Bool -> Action () -> Controller
ytdGoalsC = promptController . editPlayerYtdGoalsPrompt ytdGoalsC batchMode callback = promptController $
editPlayerYtdGoalsPrompt batchMode callback
ytdAssistsC :: Bool -> Controller ytdAssistsC :: Bool -> Action () -> Controller
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt ytdAssistsC batchMode callback = promptController $
editPlayerYtdAssistsPrompt batchMode callback
ytdPMinC :: Controller ytdPMinC :: Action () -> Controller
ytdPMinC = promptController editPlayerYtdPMinPrompt ytdPMinC = promptController . editPlayerYtdPMinPrompt
ltGoalsC :: Bool -> Controller ltGoalsC :: Bool -> Action () -> Controller
ltGoalsC = promptController . editPlayerLtGoalsPrompt ltGoalsC batchMode callback = promptController $
editPlayerLtGoalsPrompt batchMode callback
ltAssistsC :: Bool -> Controller ltAssistsC :: Bool -> Action () -> Controller
ltAssistsC = promptController . editPlayerLtAssistsPrompt ltAssistsC batchMode callback = promptController $
editPlayerLtAssistsPrompt batchMode callback
ltPMinC :: Controller ltPMinC :: Action () -> Controller
ltPMinC = promptController editPlayerLtPMinPrompt ltPMinC = promptController . editPlayerLtPMinPrompt
header :: ProgState -> C.Update () header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do 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

@@ -21,13 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control.NewGame (newGameC) where 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 Data.Maybe (fromJust, fromMaybe, isJust)
import Lens.Micro ((^.), (.~)) import Lens.Micro ((^.), (.~))
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Actions.NewGame import Mtlstats.Actions.NewGame
import Mtlstats.Config
import Mtlstats.Control.NewGame.GoalieInput import Mtlstats.Control.NewGame.GoalieInput
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Handlers import Mtlstats.Handlers
@@ -211,9 +213,12 @@ reportC = Controller
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0 C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome C.EventCharacter '\n' -> do
_ -> return () get >>= liftIO . writeFile reportFilename . unlines . report reportCols
modify backHome
_ -> return ()
return True return True
} }

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

@@ -51,8 +51,12 @@ goalieDetails g = let
goalieName :: Goalie -> String goalieName :: Goalie -> String
goalieName g = let goalieName g = let
prefix = if g^.gActive
then ""
else "*"
suffix = if g^.gRookie suffix = if g^.gRookie
then "*" then "*"
else "" else ""
in g^.gName ++ suffix in prefix ++ g^.gName ++ suffix

View File

@@ -49,8 +49,12 @@ playerDetails p = unlines $ top ++ [""] ++ table
playerName :: Player -> String playerName :: Player -> String
playerName p = let playerName p = let
prefix = if p^.pActive
then ""
else "*"
suffix = if p^.pRookie suffix = if p^.pRookie
then "*" then "*"
else "" else ""
in p^.pName ++ suffix 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

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

View File

@@ -34,51 +34,53 @@ import Mtlstats.Types.Menu
-- | The 'Goalie' edit menu -- | The 'Goalie' edit menu
editGoalieMenu :: Menu () editGoalieMenu :: Menu ()
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action) (\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value -- key, label, value
[ ( '1', "Edit number", set EGNumber ) [ ( 'A', "NUMBER", set EGNumber )
, ( '2', "Edit name", set EGName ) , ( 'B', "NAME", set EGName )
, ( '3', "Toggle rookie flag", toggle ) , ( 'C', "ROOKIE FLAG", toggleRookie )
, ( '4', "Edit YTD stats", set EGYtd ) , ( 'D', "ACTIVE FLAG", toggleActive )
, ( '5', "Edit Lifetime stats", set EGLifetime ) , ( 'E', "YTD STATS", set EGYtd )
, ( 'R', "Return to Edit Menu", edit ) , ( 'F', "LIFETIME STATS", set EGLifetime )
, ( 'R', "RETURN TO EDIT MENU", edit )
] ]
where where
set mode = progMode.editGoalieStateL.egsMode .~ mode set mode = progMode.editGoalieStateL.egsMode .~ mode
toggle = editSelectedGoalie (gRookie %~ not) toggleRookie = editSelectedGoalie (gRookie %~ not)
toggleActive = editSelectedGoalie (gActive %~ not)
-- | The 'Goalie' YTD edit menu -- | The 'Goalie' YTD edit menu
editGoalieYtdMenu :: Menu () editGoalieYtdMenu :: Menu ()
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***" editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
-- key, label, value -- key, label, value
[ ( '1', "Edit all YTD stats", EGYtdGames True ) [ ( 'A', "ALL YTD STATS", EGYtdGames True )
, ( '2', "Edit YTD games", EGYtdGames False ) , ( 'B', "YTD GAMES", EGYtdGames False )
, ( '3', "Edit YTD minutes", EGYtdMins False ) , ( 'C', "YTD MINUTES", EGYtdMins False )
, ( '4', "Edit YTD goals", EGYtdGoals False ) , ( 'D', "YTD GOALS", EGYtdGoals False )
, ( '5', "Edit YTD shutouts", EGYtdShutouts False ) , ( 'E', "YTD SHUTOUTS", EGYtdShutouts False )
, ( '6', "Edit YTD wins", EGYtdWins False ) , ( 'F', "YTD WINS", EGYtdWins False )
, ( '7', "Edit YTD losses", EGYtdLosses False ) , ( 'G', "YTD LOSSES", EGYtdLosses False )
, ( '8', "Edit YTD ties", EGYtdTies ) , ( 'H', "YTD TIES", EGYtdTies )
, ( 'R', "Return to edit menu", EGMenu ) , ( 'R', "RETURN TO EDIT MENU", EGMenu )
] ]
-- | The 'Goalie' lifetime edit menu -- | The 'Goalie' lifetime edit menu
editGoalieLtMenu :: Menu () editGoalieLtMenu :: Menu ()
editGoalieLtMenu = editMenu editGoalieLtMenu = editMenu
"*** EDIT GOALTENDER LIFETIME ***" "EDIT GOALTENDER LIFETIME"
-- key, label, value -- key, label, value
[ ( '1', "Edit all lifetime stats", EGLtGames True ) [ ( 'A', "ALL LIFETIME STATS", EGLtGames True )
, ( '2', "Edit lifetime games", EGLtGames False ) , ( 'B', "LIFETIME GAMES", EGLtGames False )
, ( '3', "Edit lifetime minutes", EGLtMins False ) , ( 'C', "LIFETIME MINUTES", EGLtMins False )
, ( '4', "Edit lifetime goals", EGLtGoals False ) , ( 'D', "LIFETIME GOALS", EGLtGoals False )
, ( '5', "Edit lifetime shutouts", EGLtShutouts False ) , ( 'E', "LIFETIME SHUTOUTS", EGLtShutouts False )
, ( '6', "Edit lifetime wins", EGLtWins False ) , ( 'F', "LIFETIME WINS", EGLtWins False )
, ( '7', "Edit lifetime losses", EGLtLosses False ) , ( 'G', "LIFETIME LOSSES", EGLtLosses False )
, ( '8', "Edit lifetime ties", EGLtTies ) , ( 'H', "LIFETIME TIES", EGLtTies )
, ( 'R', "Return to edit menu", EGMenu ) , ( 'R', "RETURN TO EDIT MENU", EGMenu )
] ]
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu () editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()

View File

@@ -34,45 +34,47 @@ import Mtlstats.Types.Menu
-- | The 'Player' edit menu -- | The 'Player' edit menu
editPlayerMenu :: Menu () editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map editPlayerMenu = Menu "EDIT PLAYER" () $ map
(\(ch, label, action) -> MenuItem ch label $ modify action) (\(ch, label, action) -> MenuItem ch label $ modify action)
-- key, label, value -- key, label, value
[ ( '1', "Edit number", set EPNumber ) [ ( 'A', "NUMBER", set EPNumber )
, ( '2', "Edit name", set EPName ) , ( 'B', "NAME", set EPName )
, ( '3', "Edit position", set EPPosition ) , ( 'C', "POSITION", set EPPosition )
, ( '4', "Toggle rookie flag", toggle ) , ( 'D', "ROOKIE FLAG", toggleRookie )
, ( '5', "Edit YTD stats", set EPYtd ) , ( 'E', "ACTIVE FLAG", toggleActive )
, ( '6', "Edit lifetime stats", set EPLifetime ) , ( 'F', "YTD STATS", set EPYtd )
, ( 'R', "Return to Edit Menu", edit ) , ( 'G', "LIFETIME STATS", set EPLifetime )
, ( 'R', "RETURN TO EDIT MENU", edit )
] ]
where where
set mode = progMode.editPlayerStateL.epsMode .~ mode set mode = progMode.editPlayerStateL.epsMode .~ mode
toggle = editSelectedPlayer $ pRookie %~ not toggleRookie = editSelectedPlayer $ pRookie %~ not
toggleActive = editSelectedPlayer $ pActive %~ not
-- | The 'Player' YTD stats edit menu -- | The 'Player' YTD stats edit menu
editPlayerYtdMenu :: Menu () editPlayerYtdMenu :: Menu ()
editPlayerYtdMenu = editMenu editPlayerYtdMenu = editMenu
"*** EDIT PLAYER YEAR-TO-DATE ***" "EDIT PLAYER YEAR-TO-DATE"
-- key, label, value -- key, label, value
[ ( '1', "Edit all YTD stats", EPYtdGoals True ) [ ( 'A', "ALL YTD STATS", EPYtdGoals True )
, ( '2', "Edit YTD goals", EPYtdGoals False ) , ( 'B', "YTD GOALS", EPYtdGoals False )
, ( '3', "Edit YTD assists", EPYtdAssists False ) , ( 'C', "YTD ASSISTS", EPYtdAssists False )
, ( '4', "Edit YTD penalty mins", EPYtdPMin ) , ( 'D', "YTD PENALTY MINS", EPYtdPMin )
, ( 'R', "Return to player edit menu", EPMenu ) , ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
] ]
-- | The 'Player' lifetime stats edit menu -- | The 'Player' lifetime stats edit menu
editPlayerLtMenu :: Menu () editPlayerLtMenu :: Menu ()
editPlayerLtMenu = editMenu editPlayerLtMenu = editMenu
"*** EDIT PLAYER LIFETIME ***" "EDIT PLAYER LIFETIME"
-- key, label, value -- key, label, value
[ ( '1', "Edit all lifetime stats", EPLtGoals True ) [ ( 'A', "ALL LIFETIME STATS", EPLtGoals True )
, ( '2', "Edit lifetime goals", EPLtGoals False ) , ( 'B', "LIFETIME GOALS", EPLtGoals False )
, ( '3', "Edit lifetime assits", EPLtAssists False ) , ( 'C', "LIFETIME ASSITS", EPLtAssists False )
, ( '4', "Edit lifetime penalty mins", EPLtPMin ) , ( 'D', "LIFETIME PENALTY MINS", EPLtPMin )
, ( 'R', "Return to edit player menu", EPMenu ) , ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
] ]
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu () 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

@@ -34,6 +34,7 @@ module Mtlstats.Prompt (
numPromptWithFallback, numPromptWithFallback,
selectPrompt, selectPrompt,
-- * Individual prompts -- * Individual prompts
newSeasonPrompt,
playerNumPrompt, playerNumPrompt,
playerNamePrompt, playerNamePrompt,
playerPosPrompt, playerPosPrompt,
@@ -41,13 +42,14 @@ module Mtlstats.Prompt (
goalieNamePrompt, goalieNamePrompt,
selectPlayerPrompt, selectPlayerPrompt,
selectGoaliePrompt, selectGoaliePrompt,
selectPositionPrompt,
playerToEditPrompt playerToEditPrompt
) where ) where
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Extra (whenJust) import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper) import Data.Char (isAlphaNum, isDigit, toUpper)
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Extras (view) import Lens.Micro.Extras (view)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@@ -55,6 +57,7 @@ import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Config import Mtlstats.Config
import Mtlstats.Helpers.Position
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util import Mtlstats.Util
@@ -161,12 +164,29 @@ numPromptWithFallback pStr fallback act = Prompt
, promptProcessChar = \ch str -> if isDigit ch , promptProcessChar = \ch str -> if isDigit ch
then str ++ [ch] then str ++ [ch]
else str else str
, promptAction = \inStr -> case readMaybe inStr of , promptAction = maybe fallback act . readMaybe
Nothing -> fallback
Just n -> act n
, promptSpecialKey = const $ return () , promptSpecialKey = const $ return ()
} }
-- | Prompts the user for a filename to save a backup of the database
-- to
newSeasonPrompt :: Prompt
newSeasonPrompt = prompt
{ promptProcessChar = \ch str -> if validChar ch
then str ++ [toUpper ch]
else str
}
where
prompt = strPrompt "Filename to save database: " $ \fn ->
if null fn
then modify backHome
else do
saveDatabase $ fn ++ ".json"
modify $ progMode .~ NewSeason True
validChar = (||) <$> isAlphaNum <*> (=='-')
-- | Builds a selection prompt -- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt selectPrompt params = Prompt
@@ -216,7 +236,7 @@ playerNamePrompt = namePrompt "Player name: " $
-- | Prompts for a new player's position -- | Prompts for a new player's position
playerPosPrompt :: Prompt playerPosPrompt :: Prompt
playerPosPrompt = ucStrPrompt "Player position: " $ playerPosPrompt = selectPositionPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~) modify . (progMode.createPlayerStateL.cpsPosition .~)
-- | Prompts tor the goalie's number -- | Prompts tor the goalie's number
@@ -287,6 +307,24 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
modify $ progMode .~ CreateGoalie cgs 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 :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $ playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~) modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

View File

@@ -52,85 +52,119 @@ goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~) modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
-- | Prompt to edit a goalie's number -- | Prompt to edit a goalie's number
editGoalieNumberPrompt :: Prompt editGoalieNumberPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
(gNumber .~) (gNumber .~)
-- | Prompt to edit a goalie's name -- | Prompt to edit a goalie's name
editGoalieNamePrompt :: Prompt editGoalieNamePrompt
editGoalieNamePrompt = namePrompt "Goalie name: " $ \name -> :: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieNamePrompt cb = namePrompt "Goalie name: " $ \name -> do
if null name if null name
then goto EGMenu then goto EGMenu
else doEdit EGMenu $ gName .~ name else doEdit EGMenu $ gName .~ name
cb
-- | Prompt to edit a goalie's YTD games played -- | Prompt to edit a goalie's YTD games played
editGoalieYtdGamesPrompt editGoalieYtdGamesPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdGamesPrompt batchMode = editGoalieYtdGamesPrompt batchMode cb =
editNum "Year-to-date games played: " mode editNum "Year-to-date games played: " mode
(gYtd.gsGames .~) (gYtd.gsGames .~) cb'
where where
mode = if batchMode then EGYtdMins True else EGYtd (mode, cb') = if batchMode
then (EGYtdMins True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD minutes played -- | Prompt to edit a goalie's YTD minutes played
editGoalieYtdMinsPrompt editGoalieYtdMinsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdMinsPrompt batchMode = editGoalieYtdMinsPrompt batchMode cb =
editNum "Year-to-date minutes played: " mode editNum "Year-to-date minutes played: " mode
(gYtd.gsMinsPlayed .~) (gYtd.gsMinsPlayed .~) cb'
where where
mode = if batchMode then EGYtdGoals True else EGYtd (mode, cb') = if batchMode
then (EGYtdGoals True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD goales allowed -- | Prompt to edit a goalie's YTD goales allowed
editGoalieYtdGoalsPrompt editGoalieYtdGoalsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdGoalsPrompt batchMode = editGoalieYtdGoalsPrompt batchMode cb =
editNum "Year-to-date goals allowed: " mode editNum "Year-to-date goals allowed: " mode
(gYtd.gsGoalsAllowed .~) (gYtd.gsGoalsAllowed .~) cb'
where where
mode = if batchMode then EGYtdShutouts True else EGYtd (mode, cb') = if batchMode
then (EGYtdShutouts True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD shutouts -- | Prompt to edit a goalie's YTD shutouts
editGoalieYtdShutoutsPrompt editGoalieYtdShutoutsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdShutoutsPrompt batchMode = editGoalieYtdShutoutsPrompt batchMode cb =
editNum "Year-to-date shutouts: " mode editNum "Year-to-date shutouts: " mode
(gYtd.gsShutouts .~) (gYtd.gsShutouts .~) cb'
where where
mode = if batchMode then EGYtdWins True else EGYtd (mode, cb') = if batchMode
then (EGYtdWins True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD wins -- | Prompt to edit a goalie's YTD wins
editGoalieYtdWinsPrompt editGoalieYtdWinsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdWinsPrompt batchMode = editGoalieYtdWinsPrompt batchMode cb =
editNum "Year-to-date wins: " mode editNum "Year-to-date wins: " mode
(gYtd.gsWins .~) (gYtd.gsWins .~) cb'
where where
mode = if batchMode then EGYtdLosses True else EGYtd (mode, cb') = if batchMode
then (EGYtdLosses True, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD losses -- | Prompt to edit a goalie's YTD losses
editGoalieYtdLossesPrompt editGoalieYtdLossesPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieYtdLossesPrompt batchMode = editGoalieYtdLossesPrompt batchMode cb =
editNum "Year-to-date losses: " mode editNum "Year-to-date losses: " mode
(gYtd.gsLosses .~) (gYtd.gsLosses .~) cb'
where where
mode = if batchMode then EGYtdTies else EGYtd (mode, cb') = if batchMode
then (EGYtdTies, return ())
else (EGYtd, cb)
-- | Prompt to edit a goalie's YTD ties -- | Prompt to edit a goalie's YTD ties
editGoalieYtdTiesPrompt :: Prompt editGoalieYtdTiesPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
(gYtd.gsTies .~) (gYtd.gsTies .~)
@@ -138,70 +172,97 @@ editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
editGoalieLtGamesPrompt editGoalieLtGamesPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtGamesPrompt batchMode = editGoalieLtGamesPrompt batchMode cb =
editNum "Lifetime games played: " mode editNum "Lifetime games played: " mode
(gLifetime.gsGames .~) (gLifetime.gsGames .~) cb'
where where
mode = if batchMode then EGLtMins True else EGLifetime (mode, cb') = if batchMode
then (EGLtMins True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime minutes played -- | Prompt to edit a goalie's lifetime minutes played
editGoalieLtMinsPrompt editGoalieLtMinsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtMinsPrompt batchMode = editGoalieLtMinsPrompt batchMode cb =
editNum "Lifetime minutes played: " mode editNum "Lifetime minutes played: " mode
(gLifetime.gsMinsPlayed .~) (gLifetime.gsMinsPlayed .~) cb'
where where
mode = if batchMode then EGLtGoals True else EGLifetime (mode, cb') = if batchMode
then (EGLtGoals True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime goals allowed -- | Prompt to edit a goalie's lifetime goals allowed
editGoalieLtGoalsPrompt editGoalieLtGoalsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtGoalsPrompt batchMode = editGoalieLtGoalsPrompt batchMode cb =
editNum "Lifetime goals allowed: " mode editNum "Lifetime goals allowed: " mode
(gLifetime.gsGoalsAllowed .~) (gLifetime.gsGoalsAllowed .~) cb'
where where
mode = if batchMode then EGLtShutouts True else EGLifetime (mode, cb') = if batchMode
then (EGLtShutouts True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime shutouts -- | Prompt to edit a goalie's lifetime shutouts
editGoalieLtShutoutsPrompt editGoalieLtShutoutsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtShutoutsPrompt batchMode = editGoalieLtShutoutsPrompt batchMode cb =
editNum "Lifetime shutouts: " mode editNum "Lifetime shutouts: " mode
(gLifetime.gsShutouts .~) (gLifetime.gsShutouts .~) cb'
where where
mode = if batchMode then EGLtWins True else EGLifetime (mode, cb') = if batchMode
then (EGLtWins True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime wins -- | Prompt to edit a goalie's lifetime wins
editGoalieLtWinsPrompt editGoalieLtWinsPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtWinsPrompt batchMode = editGoalieLtWinsPrompt batchMode cb =
editNum "Lifetime wins: " mode editNum "Lifetime wins: " mode
(gLifetime.gsWins .~) (gLifetime.gsWins .~) cb'
where where
mode = if batchMode then EGLtLosses True else EGLifetime (mode, cb') = if batchMode
then (EGLtLosses True, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime losses -- | Prompt to edit a goalie's lifetime losses
editGoalieLtLossesPrompt editGoalieLtLossesPrompt
:: Bool :: Bool
-- ^ Indicates whether or not we're in batch mode -- ^ Indicates whether or not we're in batch mode
-> Action ()
-- ^ Action to perform on completion
-> Prompt -> Prompt
editGoalieLtLossesPrompt batchMode = editGoalieLtLossesPrompt batchMode cb =
editNum "Lifetime losses: " mode editNum "Lifetime losses: " mode
(gLifetime.gsLosses .~) (gLifetime.gsLosses .~) cb'
where where
mode = if batchMode then EGLtTies else EGLifetime (mode, cb') = if batchMode
then (EGLtTies, return ())
else (EGLifetime, cb)
-- | Prompt to edit a goalie's lifetime ties -- | Prompt to edit a goalie's lifetime ties
editGoalieLtTiesPrompt :: Prompt editGoalieLtTiesPrompt
:: Action ()
-- ^ Action to perform on completion
-> Prompt
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
(gLifetime.gsTies .~) (gLifetime.gsTies .~)
@@ -209,10 +270,13 @@ editNum
:: String :: String
-> EditGoalieMode -> EditGoalieMode
-> (Int -> Goalie -> Goalie) -> (Int -> Goalie -> Goalie)
-> Action ()
-> Prompt -> Prompt
editNum pStr mode f = numPromptWithFallback pStr editNum pStr mode f cb = numPromptWithFallback pStr
(goto mode) (goto mode >> cb)
(doEdit mode . f) (\num -> do
doEdit mode $ f num
cb)
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action () doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
doEdit mode f = do doEdit mode f = do

View File

@@ -39,46 +39,68 @@ import Mtlstats.Prompt
import Mtlstats.Types import Mtlstats.Types
-- | Prompt to edit a player's number -- | Prompt to edit a player's number
editPlayerNumPrompt :: Prompt editPlayerNumPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerNumPrompt = editNum "Player number: " EPMenu editPlayerNumPrompt = editNum "Player number: " EPMenu
(pNumber .~) (pNumber .~)
-- | Prompt to edit a player's name -- | Prompt to edit a player's name
editPlayerNamePrompt :: Prompt editPlayerNamePrompt
editPlayerNamePrompt = namePrompt "Player name: " $ \name -> :: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
if null name if null name
then goto EPMenu then goto EPMenu
else doEdit EPMenu $ pName .~ name else doEdit EPMenu $ pName .~ name
callback
-- | Prompt to edit a player's position -- | Prompt to edit a player's position
editPlayerPosPrompt :: Prompt editPlayerPosPrompt
editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos -> :: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
if null pos if null pos
then goto EPMenu then goto EPMenu
else doEdit EPMenu $ pPosition .~ pos else doEdit EPMenu $ pPosition .~ pos
callback
-- | Prompt to edit a player's year-to-date goals -- | Prompt to edit a player's year-to-date goals
editPlayerYtdGoalsPrompt editPlayerYtdGoalsPrompt
:: Bool :: Bool
-- ^ Indicates wheter or not we're editing in batch mode -- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt -> Prompt
editPlayerYtdGoalsPrompt batchMode = editNum "Year-to-date goals: " mode editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
(pYtd.psGoals .~) (pYtd.psGoals .~) callback'
where where
mode = if batchMode then EPYtdAssists True else EPYtd (mode, callback') = if batchMode
then (EPYtdAssists True, return ())
else (EPYtd, callback)
-- | Prompt to edit a player's year-to-date assists -- | Prompt to edit a player's year-to-date assists
editPlayerYtdAssistsPrompt editPlayerYtdAssistsPrompt
:: Bool :: Bool
-- ^ Indicates wheter or not we're editing in batch mode -- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt -> Prompt
editPlayerYtdAssistsPrompt batchMode = editNum "Year-to-date assists: " mode editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
(pYtd.psAssists .~) (pYtd.psAssists .~) callback'
where where
mode = if batchMode then EPYtdPMin else EPYtd (mode, callback') = if batchMode
then (EPYtdPMin, return ())
else (EPYtd, callback)
-- | Prompt to edit a player's year-to-date penalty minutes -- | Prompt to edit a player's year-to-date penalty minutes
editPlayerYtdPMinPrompt :: Prompt editPlayerYtdPMinPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
(pYtd.psPMin .~) (pYtd.psPMin .~)
@@ -86,24 +108,35 @@ editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
editPlayerLtGoalsPrompt editPlayerLtGoalsPrompt
:: Bool :: Bool
-- ^ Indicates wheter or not we're editing in batch mode -- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt -> Prompt
editPlayerLtGoalsPrompt batchMode = editNum "Lifetime goals: " mode editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
(pLifetime.psGoals .~) (pLifetime.psGoals .~) callback'
where where
mode = if batchMode then EPLtAssists True else EPLifetime (mode, callback') = if batchMode
then (EPLtAssists True, return ())
else (EPLifetime, callback)
-- | Prompt to edit a player's lifetime assists -- | Prompt to edit a player's lifetime assists
editPlayerLtAssistsPrompt editPlayerLtAssistsPrompt
:: Bool :: Bool
-- ^ Indicates wheter or not we're editing in batch mode -- ^ Indicates wheter or not we're editing in batch mode
-> Action ()
-- ^ The action to be performed upon completion
-> Prompt -> Prompt
editPlayerLtAssistsPrompt batchMode = editNum "Lifetime assists: " mode editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
(pLifetime.psAssists .~) (pLifetime.psAssists .~) callback'
where where
mode = if batchMode then EPLtPMin else EPLifetime (mode, callback') = if batchMode
then (EPLtPMin, return ())
else (EPLifetime, callback)
-- | Prompt to edit a player's lifetime penalty minutes -- | Prompt to edit a player's lifetime penalty minutes
editPlayerLtPMinPrompt :: Prompt editPlayerLtPMinPrompt
:: Action ()
-- ^ The action to be performed upon completion
-> Prompt
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
(pLifetime.psPMin .~) (pLifetime.psPMin .~)
@@ -111,10 +144,13 @@ editNum
:: String :: String
-> EditPlayerMode -> EditPlayerMode
-> (Int -> Player -> Player) -> (Int -> Player -> Player)
-> Action ()
-> Prompt -> Prompt
editNum pStr mode f = numPromptWithFallback pStr editNum pStr mode f callback = numPromptWithFallback pStr
(goto mode) (goto mode >> callback)
(doEdit mode . f) (\num -> do
doEdit mode $ f num
callback)
doEdit :: EditPlayerMode -> (Player -> Player) -> Action () doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
doEdit mode f = do doEdit mode f = do

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

@@ -117,7 +117,7 @@ gameStatsReport width s = let
gs = s^.progMode.gameStateL gs = s^.progMode.gameStateL
db = s^.database db = s^.database
playerStats = mapMaybe playerStats = sortPlayers $ mapMaybe
(\(pid, stats) -> do (\(pid, stats) -> do
p <- nth pid $ db^.dbPlayers p <- nth pid $ db^.dbPlayers
Just (p, stats)) Just (p, stats))
@@ -139,7 +139,7 @@ yearToDateStatsReport :: Int -> ProgState -> [String]
yearToDateStatsReport width s = let yearToDateStatsReport width s = let
db = s^.database db = s^.database
playerStats = sortOn (Down . psPoints . snd) playerStats = sortPlayers
$ map (\p -> (p, p^.pYtd)) $ map (\p -> (p, p^.pYtd))
$ filter playerIsActive $ filter playerIsActive
$ db^.dbPlayers $ db^.dbPlayers
@@ -156,7 +156,7 @@ lifetimeStatsReport :: Int -> ProgState -> [String]
lifetimeStatsReport width s = let lifetimeStatsReport width s = let
db = s^.database db = s^.database
playerStats = sortOn (Down . psPoints . snd) playerStats = sortPlayers
$ map (\p -> (p, p^.pLifetime)) $ map (\p -> (p, p^.pLifetime))
$ db^.dbPlayers $ db^.dbPlayers
@@ -241,8 +241,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let
else repeat "" else repeat ""
table = overlayLast olayText table = overlayLast olayText
$ map (\(ln, line) -> overlay ln $ centre width line) $ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
$ zip lnOverlay
$ complexTable ([right, left] ++ repeat right) $ complexTable ([right, left] ++ repeat right)
$ tHeader : body ++ if showTotals $ tHeader : body ++ if showTotals
then [separator, totals] then [separator, totals]
@@ -261,8 +260,10 @@ goalieReport width showTotals lineNumbers goalieData = let
then "GOALTENDING TOTALS" then "GOALTENDING TOTALS"
else "" else ""
goalieData' = sortGoalies goalieData
tData = foldl addGoalieStats newGoalieStats tData = foldl addGoalieStats newGoalieStats
$ map snd goalieData $ map snd goalieData'
header = header =
[ CellText "NO." [ CellText "NO."
@@ -287,7 +288,7 @@ goalieReport width showTotals lineNumbers goalieData = let
[ CellText $ show (goalie^.gNumber) ++ " " [ CellText $ show (goalie^.gNumber) ++ " "
, CellText $ goalieName goalie , CellText $ goalieName goalie
] ++ rowCells stats) ] ++ rowCells stats)
goalieData goalieData'
separator separator
= replicate 2 (CellText "") = replicate 2 (CellText "")
@@ -299,8 +300,7 @@ goalieReport width showTotals lineNumbers goalieData = let
then "" : [right 2 $ show x | x <- [(1 :: Int)..]] then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
else repeat "" else repeat ""
in map (\(ln, line) -> overlay ln $ centre width line) in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
$ zip lnOverlay
$ overlayLast olayText $ overlayLast olayText
$ complexTable ([right, left] ++ repeat right) $ complexTable ([right, left] ++ repeat right)
$ header : body ++ if showTotals $ header : body ++ if showTotals
@@ -309,6 +309,8 @@ goalieReport width showTotals lineNumbers goalieData = let
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String] gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
gameGoalieReport width goalieData = let gameGoalieReport width goalieData = let
goalieData' = sortGoalies goalieData
header = header =
[ CellText "NO." [ CellText "NO."
, CellText "GOALTENDER" , CellText "GOALTENDER"
@@ -325,8 +327,16 @@ gameGoalieReport width goalieData = let
, CellText $ show $ stats^.gsGoalsAllowed , CellText $ show $ stats^.gsGoalsAllowed
, CellText $ showFloating $ gsAverage stats , CellText $ showFloating $ gsAverage stats
]) ])
goalieData goalieData'
in map (centre width) in map (centre width)
$ complexTable ([right, left] ++ repeat right) $ complexTable ([right, left] ++ repeat right)
$ header : body $ 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

@@ -35,6 +35,8 @@ module Mtlstats.Types (
EditPlayerMode (..), EditPlayerMode (..),
EditGoalieState (..), EditGoalieState (..),
EditGoalieMode (..), EditGoalieMode (..),
EditStandingsMode (..),
ESMSubMode (..),
Database (..), Database (..),
Player (..), Player (..),
PlayerStats (..), PlayerStats (..),
@@ -56,6 +58,9 @@ module Mtlstats.Types (
createGoalieStateL, createGoalieStateL,
editPlayerStateL, editPlayerStateL,
editGoalieStateL, editGoalieStateL,
editStandingsModeL,
-- ** EditStandingsMode Lenses
esmSubModeL,
-- ** GameState Lenses -- ** GameState Lenses
gameYear, gameYear,
gameMonth, gameMonth,
@@ -83,19 +88,25 @@ module Mtlstats.Types (
cpsNumber, cpsNumber,
cpsName, cpsName,
cpsPosition, cpsPosition,
cpsRookieFlag,
cpsActiveFlag,
cpsSuccessCallback, cpsSuccessCallback,
cpsFailureCallback, cpsFailureCallback,
-- ** CreateGoalieState Lenses -- ** CreateGoalieState Lenses
cgsNumber, cgsNumber,
cgsName, cgsName,
cgsRookieFlag,
cgsActiveFlag,
cgsSuccessCallback, cgsSuccessCallback,
cgsFailureCallback, cgsFailureCallback,
-- ** EditPlayerState Lenses -- ** EditPlayerState Lenses
epsSelectedPlayer, epsSelectedPlayer,
epsMode, epsMode,
epsCallback,
-- ** EditGoalieState Lenses -- ** EditGoalieState Lenses
egsSelectedGoalie, egsSelectedGoalie,
egsMode, egsMode,
egsCallback,
-- ** Database Lenses -- ** Database Lenses
dbPlayers, dbPlayers,
dbGoalies, dbGoalies,
@@ -107,6 +118,7 @@ module Mtlstats.Types (
pName, pName,
pPosition, pPosition,
pRookie, pRookie,
pActive,
pYtd, pYtd,
pLifetime, pLifetime,
-- ** PlayerStats Lenses -- ** PlayerStats Lenses
@@ -117,6 +129,7 @@ module Mtlstats.Types (
gNumber, gNumber,
gName, gName,
gRookie, gRookie,
gActive,
gYtd, gYtd,
gLifetime, gLifetime,
-- ** GoalieStats Lenses -- ** GoalieStats Lenses
@@ -195,9 +208,8 @@ import Data.Aeson
, (.=) , (.=)
) )
import Data.Char (toUpper) import Data.Char (toUpper)
import Data.List (isInfixOf) import Data.List (find, isInfixOf)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (listToMaybe)
import Lens.Micro (Lens', lens, (&), (^.), (.~)) import Lens.Micro (Lens', lens, (&), (^.), (.~))
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
import qualified UI.NCurses as C import qualified UI.NCurses as C
@@ -229,24 +241,28 @@ data ProgState = ProgState
-- | The program mode -- | The program mode
data ProgMode data ProgMode
= MainMenu = TitleScreen
| NewSeason | MainMenu
| NewSeason Bool
| NewGame GameState | NewGame GameState
| EditMenu | EditMenu
| CreatePlayer CreatePlayerState | CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState | CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState | EditPlayer EditPlayerState
| EditGoalie EditGoalieState | EditGoalie EditGoalieState
| EditStandings EditStandingsMode
instance Show ProgMode where instance Show ProgMode where
show MainMenu = "MainMenu" show TitleScreen = "TitleScreen"
show NewSeason = "NewSeason" show MainMenu = "MainMenu"
show (NewGame _) = "NewGame" show (NewSeason _) = "NewSeason"
show EditMenu = "EditMenu" show (NewGame _) = "NewGame"
show (CreatePlayer _) = "CreatePlayer" show EditMenu = "EditMenu"
show (CreateGoalie _) = "CreateGoalie" show (CreatePlayer _) = "CreatePlayer"
show (EditPlayer _) = "EditPlayer" show (CreateGoalie _) = "CreateGoalie"
show (EditGoalie _) = "EditGoalie" show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
show (EditStandings _) = "EditStandings"
-- | The game state -- | The game state
data GameState = GameState data GameState = GameState
@@ -315,6 +331,10 @@ data CreatePlayerState = CreatePlayerState
-- ^ The player's name -- ^ The player's name
, _cpsPosition :: String , _cpsPosition :: String
-- ^ The player's position -- ^ 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 () , _cpsSuccessCallback :: Action ()
-- ^ The function to call on success -- ^ The function to call on success
, _cpsFailureCallback :: Action () , _cpsFailureCallback :: Action ()
@@ -323,10 +343,14 @@ data CreatePlayerState = CreatePlayerState
-- | Goalie creation status -- | Goalie creation status
data CreateGoalieState = CreateGoalieState data CreateGoalieState = CreateGoalieState
{ _cgsNumber :: Maybe Int { _cgsNumber :: Maybe Int
-- ^ The goalie's number -- ^ The goalie's number
, _cgsName :: String , _cgsName :: String
-- ^ The goalie's name -- ^ 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 () , _cgsSuccessCallback :: Action ()
-- ^ The function to call on success -- ^ The function to call on success
, _cgsFailureCallback :: Action () , _cgsFailureCallback :: Action ()
@@ -339,6 +363,8 @@ data EditPlayerState = EditPlayerState
-- ^ The index number of the player being edited -- ^ The index number of the player being edited
, _epsMode :: EditPlayerMode , _epsMode :: EditPlayerMode
-- ^ The editing mode -- ^ The editing mode
, _epsCallback :: Action ()
-- ^ The action to perform when the edit is complete
} }
-- | Player editing mode -- | Player editing mode
@@ -362,6 +388,9 @@ data EditGoalieState = EditGoalieState
{ _egsSelectedGoalie :: Maybe Int { _egsSelectedGoalie :: Maybe Int
-- ^ The index number of the 'Goalie' being edited -- ^ The index number of the 'Goalie' being edited
, _egsMode :: EditGoalieMode , _egsMode :: EditGoalieMode
-- ^ The editing mode
, _egsCallback :: Action ()
-- ^ The action to perform when the edit is complete
} }
-- | 'Goalie' editing mode -- | 'Goalie' editing mode
@@ -387,6 +416,23 @@ data EditGoalieMode
| EGLtTies | EGLtTies
deriving (Eq, Show) deriving (Eq, Show)
-- | Represents the standings edit mode
data EditStandingsMode
= ESMMenu
| ESMHome ESMSubMode
| ESMAway ESMSubMode
deriving (Eq, Show)
-- | Represents the standings edit sub-mode
data ESMSubMode
= ESMSubMenu
| ESMEditWins
| ESMEditLosses
| ESMEditOvertime
| ESMEditGoalsFor
| ESMEditGoalsAgainst
deriving (Eq, Show)
-- | Represents the database -- | Represents the database
data Database = Database data Database = Database
{ _dbPlayers :: [Player] { _dbPlayers :: [Player]
@@ -411,6 +457,8 @@ data Player = Player
-- ^ The player's position -- ^ The player's position
, _pRookie :: Bool , _pRookie :: Bool
-- ^ Indicates that the player is a rookie -- ^ Indicates that the player is a rookie
, _pActive :: Bool
-- ^ Indicates that the player is active
, _pYtd :: PlayerStats , _pYtd :: PlayerStats
-- ^ The Player's year-to-date stats -- ^ The Player's year-to-date stats
, _pLifetime :: PlayerStats , _pLifetime :: PlayerStats
@@ -435,6 +483,8 @@ data Goalie = Goalie
-- ^ The goalie's name -- ^ The goalie's name
, _gRookie :: Bool , _gRookie :: Bool
-- ^ Indicates that the goalie is a rookie -- ^ Indicates that the goalie is a rookie
, _gActive :: Bool
-- ^ Indicates that the goalie is active
, _gYtd :: GoalieStats , _gYtd :: GoalieStats
-- ^ The goalie's year-to-date stats -- ^ The goalie's year-to-date stats
, _gLifetime :: GoalieStats , _gLifetime :: GoalieStats
@@ -555,23 +605,26 @@ instance FromJSON Player where
<*> v .: "name" <*> v .: "name"
<*> v .: "position" <*> v .: "position"
<*> v .:? "rookie" .!= False <*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newPlayerStats <*> v .:? "ytd" .!= newPlayerStats
<*> v .:? "lifetime" .!= newPlayerStats <*> v .:? "lifetime" .!= newPlayerStats
instance ToJSON Player where instance ToJSON Player where
toJSON (Player num name pos rk ytd lt) = object toJSON (Player num name pos rk act ytd lt) = object
[ "number" .= num [ "number" .= num
, "name" .= name , "name" .= name
, "position" .= pos , "position" .= pos
, "rookie" .= rk , "rookie" .= rk
, "active" .= act
, "ytd" .= ytd , "ytd" .= ytd
, "lifetime" .= lt , "lifetime" .= lt
] ]
toEncoding (Player num name pos rk ytd lt) = pairs $ toEncoding (Player num name pos rk act ytd lt) = pairs $
"number" .= num <> "number" .= num <>
"name" .= name <> "name" .= name <>
"position" .= pos <> "position" .= pos <>
"rookie" .= rk <> "rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <> "ytd" .= ytd <>
"lifetime" .= lt "lifetime" .= lt
@@ -597,21 +650,24 @@ instance FromJSON Goalie where
<$> v .: "number" <$> v .: "number"
<*> v .: "name" <*> v .: "name"
<*> v .:? "rookie" .!= False <*> v .:? "rookie" .!= False
<*> v .:? "active" .!= True
<*> v .:? "ytd" .!= newGoalieStats <*> v .:? "ytd" .!= newGoalieStats
<*> v .:? "lifetime" .!= newGoalieStats <*> v .:? "lifetime" .!= newGoalieStats
instance ToJSON Goalie where instance ToJSON Goalie where
toJSON (Goalie num name rk ytd lt) = object toJSON (Goalie num name rk act ytd lt) = object
[ "number" .= num [ "number" .= num
, "name" .= name , "name" .= name
, "ytd" .= ytd , "ytd" .= ytd
, "rookie" .= rk , "rookie" .= rk
, "active" .= act
, "lifetime" .= lt , "lifetime" .= lt
] ]
toEncoding (Goalie num name rk ytd lt) = pairs $ toEncoding (Goalie num name rk act ytd lt) = pairs $
"number" .= num <> "number" .= num <>
"name" .= name <> "name" .= name <>
"rookie" .= rk <> "rookie" .= rk <>
"active" .= act <>
"ytd" .= ytd <> "ytd" .= ytd <>
"lifetime" .= lt "lifetime" .= lt
@@ -702,11 +758,29 @@ editGoalieStateL = lens
_ -> newEditGoalieState) _ -> newEditGoalieState)
(\_ egs -> EditGoalie egs) (\_ egs -> EditGoalie egs)
editStandingsModeL :: Lens' ProgMode EditStandingsMode
editStandingsModeL = lens
(\case
EditStandings esm -> esm
_ -> ESMMenu)
(\_ esm -> EditStandings esm)
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
esmSubModeL = lens
(\case
ESMMenu -> ESMSubMenu
ESMHome m -> m
ESMAway m -> m)
(\mode subMode -> case mode of
ESMMenu -> ESMMenu
ESMHome _ -> ESMHome subMode
ESMAway _ -> ESMAway subMode)
-- | Constructor for a 'ProgState' -- | Constructor for a 'ProgState'
newProgState :: ProgState newProgState :: ProgState
newProgState = ProgState newProgState = ProgState
{ _database = newDatabase { _database = newDatabase
, _progMode = MainMenu , _progMode = TitleScreen
, _inputBuffer = "" , _inputBuffer = ""
, _scrollOffset = 0 , _scrollOffset = 0
} }
@@ -744,6 +818,8 @@ newCreatePlayerState = CreatePlayerState
{ _cpsNumber = Nothing { _cpsNumber = Nothing
, _cpsName = "" , _cpsName = ""
, _cpsPosition = "" , _cpsPosition = ""
, _cpsRookieFlag = Nothing
, _cpsActiveFlag = Nothing
, _cpsSuccessCallback = return () , _cpsSuccessCallback = return ()
, _cpsFailureCallback = return () , _cpsFailureCallback = return ()
} }
@@ -753,6 +829,8 @@ newCreateGoalieState :: CreateGoalieState
newCreateGoalieState = CreateGoalieState newCreateGoalieState = CreateGoalieState
{ _cgsNumber = Nothing { _cgsNumber = Nothing
, _cgsName = "" , _cgsName = ""
, _cgsRookieFlag = Nothing
, _cgsActiveFlag = Nothing
, _cgsSuccessCallback = return () , _cgsSuccessCallback = return ()
, _cgsFailureCallback = return () , _cgsFailureCallback = return ()
} }
@@ -762,6 +840,7 @@ newEditPlayerState :: EditPlayerState
newEditPlayerState = EditPlayerState newEditPlayerState = EditPlayerState
{ _epsSelectedPlayer = Nothing { _epsSelectedPlayer = Nothing
, _epsMode = EPMenu , _epsMode = EPMenu
, _epsCallback = return ()
} }
-- | Constructor for an 'EditGoalieState' value -- | Constructor for an 'EditGoalieState' value
@@ -769,6 +848,7 @@ newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing { _egsSelectedGoalie = Nothing
, _egsMode = EGMenu , _egsMode = EGMenu
, _egsCallback = return ()
} }
-- | Constructor for a 'Database' -- | Constructor for a 'Database'
@@ -795,6 +875,7 @@ newPlayer num name pos = Player
, _pName = name , _pName = name
, _pPosition = pos , _pPosition = pos
, _pRookie = True , _pRookie = True
, _pActive = True
, _pYtd = newPlayerStats , _pYtd = newPlayerStats
, _pLifetime = newPlayerStats , _pLifetime = newPlayerStats
} }
@@ -818,6 +899,7 @@ newGoalie num name = Goalie
{ _gNumber = num { _gNumber = num
, _gName = name , _gName = name
, _gRookie = True , _gRookie = True
, _gActive = True
, _gYtd = newGoalieStats , _gYtd = newGoalieStats
, _gLifetime = newGoalieStats , _gLifetime = newGoalieStats
} }
@@ -936,7 +1018,7 @@ playerSearchExact
-> Maybe (Int, Player) -> Maybe (Int, Player)
-- ^ The player's index and value -- ^ The player's index and value
playerSearchExact sStr = playerSearchExact sStr =
listToMaybe . filter match . zip [0..] find match . zip [0..]
where match (_, p) = p^.pName == sStr where match (_, p) = p^.pName == sStr
-- | Modifies a player with a given name -- | Modifies a player with a given name

View File

@@ -39,6 +39,7 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
import Mtlstats.Format
import Mtlstats.Types import Mtlstats.Types
-- | Defines a menu -- | Defines a menu
@@ -65,8 +66,15 @@ makeLenses ''Menu
makeLenses ''MenuItem makeLenses ''MenuItem
instance Show (Menu a) where instance Show (Menu a) where
show m = m ^. menuTitle ++ "\n" ++ items show m = unlines
where items = unlines $ map show $ m ^. menuItems $ [ m^.menuTitle
, ""
]
++ body
where
body = map (left width) items
width = maximum $ map length items
items = map show $ m^.menuItems
instance Show (MenuItem a) where instance Show (MenuItem a) where
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription show i = [i ^. miKey] ++ ": " ++ i ^. miDescription

View File

@@ -52,8 +52,9 @@ modifyNth
-> [a] -> [a]
-- ^ The list -- ^ The list
-> [a] -> [a]
modifyNth n f = map (\(i, x) -> if i == n then f x else x) modifyNth n f = zipWith
. zip [0..] (\i x -> if i == n then f x else x)
[0..]
-- | Modify a value indexed by a given key in a map using a default -- | Modify a value indexed by a given key in a map using a default
-- initial value if not present -- initial value if not present

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

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

@@ -24,7 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where module ActionsSpec (spec) where
import Control.Monad (replicateM) import Control.Monad (replicateM)
import Lens.Micro ((^.), (&), (.~), (?~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Test.Hspec import Test.Hspec
( Spec ( Spec
, context , context
@@ -39,6 +39,7 @@ import Mtlstats.Actions
import Mtlstats.Types import Mtlstats.Types
import qualified Actions.NewGameSpec as NewGame import qualified Actions.NewGameSpec as NewGame
import qualified Actions.EditStandingsSpec as EditStandings
import qualified TypesSpec as TS import qualified TypesSpec as TS
spec :: Spec spec :: Spec
@@ -46,6 +47,7 @@ spec = describe "Mtlstats.Actions" $ do
startNewSeasonSpec startNewSeasonSpec
startNewGameSpec startNewGameSpec
resetYtdSpec resetYtdSpec
clearRookiesSpec
resetStandingsSpec resetStandingsSpec
addCharSpec addCharSpec
removeCharSpec removeCharSpec
@@ -64,6 +66,7 @@ spec = describe "Mtlstats.Actions" $ do
scrollUpSpec scrollUpSpec
scrollDownSpec scrollDownSpec
NewGame.spec NewGame.spec
EditStandings.spec
startNewSeasonSpec :: Spec startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do startNewSeasonSpec = describe "startNewSeason" $ do
@@ -129,6 +132,45 @@ resetYtdSpec = describe "resetYtd" $
lt ^. gsTies `shouldNotBe` 0) $ lt ^. gsTies `shouldNotBe` 0) $
s ^. database . dbGoalies s ^. database . dbGoalies
clearRookiesSpec :: Spec
clearRookiesSpec = describe "clearRookies" $ do
let
players =
[ newPlayer 1 "Joe" "centre" & pRookie .~ True
, newPlayer 2 "Bob" "centre" & pRookie .~ False
]
goalies =
[ newGoalie 3 "Bill" & gRookie .~ True
, newGoalie 4 "Doug" & gRookie .~ False
]
ps = newProgState
& database
%~ (dbPlayers .~ players)
. (dbGoalies .~ goalies)
ps' = clearRookies ps
context "Players" $ mapM_
(\p -> let
name = p^.pName
rFlag = p^.pRookie
in context name $
it "should not be a rookie" $
rFlag `shouldBe` False)
(ps'^.database.dbPlayers)
context "Goalies" $ mapM_
(\g -> let
name = g^.gName
rFlag = g^.gRookie
in context name $
it "should not be a rookie" $
rFlag `shouldBe` False)
(ps'^.database.dbGoalies)
resetStandingsSpec :: Spec resetStandingsSpec :: Spec
resetStandingsSpec = describe "resetStandings" $ do resetStandingsSpec = describe "resetStandings" $ do
let let
@@ -270,51 +312,93 @@ editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
goalie' n = newGoalie n "foo" goalie' n = newGoalie n "foo"
addPlayerSpec :: Spec addPlayerSpec :: Spec
addPlayerSpec = describe "addPlayer" $ do addPlayerSpec = describe "addPlayer" $ mapM_
let (\(label, expectation, pm, players) -> context label $
p1 = newPlayer 1 "Joe" "centre" it expectation $ let
p2 = newPlayer 2 "Bob" "defense" ps = newProgState
db = newDatabase & progMode .~ pm
& dbPlayers .~ [p1] & database.dbPlayers .~ [joe]
s pm = newProgState ps' = addPlayer ps
& progMode .~ pm in ps'^.database.dbPlayers `shouldBe` players)
& database .~ db
context "data available" $ -- label, expectation, progMode, players
it "should create the player" $ let [ ( "wrong mode", failure, MainMenu, [joe] )
s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState , ( "missing number", failure, noNum, [joe] )
& cpsNumber ?~ 2 , ( "missing rookie flag", failure, noRookie, [joe] )
& cpsName .~ "Bob" , ( "missing active flag", failure, noActive, [joe] )
& cpsPosition .~ "defense" , ( "rookie", success, mkRookie, [joe, rookie] )
in s'^.database.dbPlayers `shouldBe` [p1, p2] , ( "retired", success, mkRetired, [joe, retired] )
, ( "normal player", success, mkNormal, [joe, normal] )
]
context "data unavailable" $ where
it "should not create the player" $ let failure = "should not create the player"
s' = addPlayer $ s MainMenu success = "should create the player"
in s'^.database.dbPlayers `shouldBe` [p1] 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 :: Spec
addGoalieSpec = describe "addGoalie" $ do addGoalieSpec = describe "addGoalie" $ mapM_
let (\(label, expectation, pm, goalies) -> context label $
g1 = newGoalie 2 "Joe" it expectation $ let
g2 = newGoalie 3 "Bob" ps = newProgState
db = newDatabase & progMode .~ pm
& dbGoalies .~ [g1] & database.dbGoalies .~ [joe]
s pm = newProgState ps' = addGoalie ps
& database .~ db in ps'^.database.dbGoalies `shouldBe` goalies)
& progMode .~ pm
context "data available" $ -- label, expectation, progMode, expected goalies
it "should create the goalie" $ let [ ( "wrong mode", failure, MainMenu, [joe] )
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState , ( "no number", failure, noNum, [joe] )
& cgsNumber ?~ 3 , ( "no rookie flag", failure, noRookie, [joe] )
& cgsName .~ "Bob" , ( "no active flag", failure, noActive, [joe] )
in s'^.database.dbGoalies `shouldBe` [g1, g2] , ( "rookie", success, mkRookie, [joe, rookie] )
, ( "retired", success, mkRetired, [joe, retired] )
, ( "normal goalie", success, mkNormal, [joe, normal] )
]
context "data unavailable" $ where
it "should not create the goalie" $ let failure = "should not create the goalie"
s' = addGoalie $ s MainMenu success = "should create the goalie"
in s'^.database.dbGoalies `shouldBe` [g1] 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 :: Spec
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let

View File

@@ -76,10 +76,16 @@ goalieNameSpec = describe "goalieName" $ mapM_
it ("should be " ++ expected) $ it ("should be " ++ expected) $
goalieName g `shouldBe` expected) goalieName g `shouldBe` expected)
-- label, goalie, expected -- label, goalie, expected
[ ( "rookie", goalie True, "foo*" ) [ ( "rookie", rookie, "foo*" )
, ( "non-rookie", goalie False, "foo" ) , ( "non-rookie", active, "foo" )
, ( "retired", retired, "*foo" )
] ]
where where
goalie r = newGoalie 1 "foo" & gRookie .~ r rookie = goalie True True
active = goalie False True
retired = goalie False False
goalie r a = newGoalie 1 "foo"
& gRookie .~ r
& gActive .~ a

View File

@@ -71,9 +71,13 @@ playerNameSpec = describe "playerName" $ mapM_
-- label, player, expected -- label, player, expected
[ ( "rookie", rookie, "foo*" ) [ ( "rookie", rookie, "foo*" )
, ( "non-rookie", nonRookie, "foo" ) , ( "non-rookie", nonRookie, "foo" )
, ( "retired", retired, "*foo" )
] ]
where where
rookie = player True rookie = player True True
nonRookie = player False nonRookie = player False True
player r = newPlayer 1 "foo" "centre" & pRookie .~ r 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

@@ -25,8 +25,10 @@ import Test.Hspec (Spec, describe)
import qualified Helpers.GoalieSpec as Goalie import qualified Helpers.GoalieSpec as Goalie
import qualified Helpers.PlayerSpec as Player import qualified Helpers.PlayerSpec as Player
import qualified Helpers.PositionSpec as Position
spec :: Spec spec :: Spec
spec = describe "Helper" $ do spec = describe "Helper" $ do
Player.spec Player.spec
Goalie.spec Goalie.spec
Position.spec

View File

@@ -37,11 +37,11 @@ showSpec :: Spec
showSpec = describe "show" $ showSpec = describe "show" $
it "should display correctly" $ let it "should display correctly" $ let
menu = Menu "Foo" () menu = Menu "Foo" ()
[ MenuItem '1' "Item 1" $ return () [ MenuItem '1' "foo" $ return ()
, MenuItem '2' "Item 2" $ return () , MenuItem '2' "bar baz" $ return ()
] ]
expected = expected =
"Foo\n\ "Foo\n\n\
\1) Item 1\n\ \1: foo \n\
\2) Item 2\n" \2: bar baz\n"
in show menu `shouldBe` expected in show menu `shouldBe` expected

View File

@@ -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 module TypesSpec
( Comparable (..) ( Comparable (..)
@@ -33,6 +33,7 @@ module TypesSpec
import Control.Monad (replicateM) import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON) import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object)) import Data.Aeson.Types (Value (Object))
import qualified Data.Map.Lazy as M
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%)) import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~)) import Lens.Micro (Lens', (&), (^.), (.~), (?~))
@@ -58,6 +59,8 @@ spec = describe "Mtlstats.Types" $ do
createGoalieStateLSpec createGoalieStateLSpec
editPlayerStateLSpec editPlayerStateLSpec
editGoalieStateLSpec editGoalieStateLSpec
editStandingsModeLSpec
esmSubModeLSpec
teamScoreSpec teamScoreSpec
otherScoreSpec otherScoreSpec
homeTeamSpec homeTeamSpec
@@ -191,6 +194,47 @@ editGoalieStateLSpec = describe "editGoalieStateL" $
egs2 = newEditGoalieState egs2 = newEditGoalieState
& egsSelectedGoalie ?~ 2 & egsSelectedGoalie ?~ 2
editStandingsModeLSpec :: Spec
editStandingsModeLSpec = describe "editStandingsModeL" $
lensSpec editStandingsModeL
-- getters
[ ( "missing mode", MainMenu, menu )
, ( "with mode", EditStandings home, home )
]
-- setters
[ ( "set mode", MainMenu, home )
, ( "change mode", EditStandings home, away )
]
where
menu = ESMMenu
home = ESMHome ESMSubMenu
away = ESMAway ESMSubMenu
esmSubModeLSpec :: Spec
esmSubModeLSpec = describe "esmSubModeL" $ do
context "getters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $
mode^.esmSubModeL `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMSubMenu )
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
]
context "setters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $ let
mode' = mode & esmSubModeL .~ ESMEditWins
in mode' `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMMenu )
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
]
teamScoreSpec :: Spec teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do teamScoreSpec = describe "teamScore" $ do
let let
@@ -281,6 +325,7 @@ playerJSON = Object $ HM.fromList
, ( "name", toJSON ("Joe" :: String) ) , ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) ) , ( "position", toJSON ("centre" :: String) )
, ( "rookie", toJSON False ) , ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", playerStatsJSON 1 ) , ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 ) , ( "lifetime", playerStatsJSON 2 )
] ]
@@ -309,6 +354,7 @@ goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) ) [ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) ) , ( "name", toJSON ("Joe" :: String ) )
, ( "rookie", toJSON False ) , ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", goalieStatsJSON 1 ) , ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 ) , ( "lifetime", goalieStatsJSON 2 )
] ]
@@ -848,6 +894,7 @@ makePlayer = Player
<*> makeName <*> makeName
<*> makeName <*> makeName
<*> makeBool <*> makeBool
<*> makeBool
<*> makePlayerStats <*> makePlayerStats
<*> makePlayerStats <*> makePlayerStats
@@ -857,6 +904,7 @@ makeGoalie = Goalie
<$> makeNum <$> makeNum
<*> makeName <*> makeName
<*> makeBool <*> makeBool
<*> makeBool
<*> makeGoalieStats <*> makeGoalieStats
<*> makeGoalieStats <*> makeGoalieStats
@@ -953,3 +1001,53 @@ instance Comparable CreateGoalieState where
describe "cgsName" $ describe "cgsName" $
it ("should be " ++ expected^.cgsName) $ it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName actual^.cgsName `shouldBe` expected^.cgsName
instance Comparable EditStandingsMode where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
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)

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