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/
mtlstats.cabal
.vagrant
data
*.log
*~

View File

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

10
Vagrantfile vendored Normal file
View File

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

View File

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

View File

@@ -24,6 +24,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Actions
( startNewSeason
, resetYtd
, clearRookies
, resetStandings
, startNewGame
, addChar
@@ -42,18 +43,29 @@ module Mtlstats.Actions
, backHome
, scrollUp
, scrollDown
, saveDatabase
) 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 Lens.Micro ((^.), (&), (.~), (%~))
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Util
-- | Starts a new season
startNewSeason :: ProgState -> ProgState
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
startNewSeason
= (progMode .~ NewSeason False)
. (database.dbGames .~ 0)
-- | Resets all players year-to-date stats
resetYtd :: ProgState -> ProgState
@@ -61,6 +73,12 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
-- | Clears the rookie flag from all players/goalies
clearRookies :: ProgState -> ProgState
clearRookies = database
%~ (dbPlayers %~ map (pRookie .~ False))
. (dbGoalies %~ map (gRookie .~ False))
-- | Resets game standings
resetStandings :: ProgState -> ProgState
resetStandings = database
@@ -143,11 +161,15 @@ editSelectedGoalie f s = fromMaybe s $ do
addPlayer :: ProgState -> ProgState
addPlayer s = fromMaybe s $ do
let cps = s^.progMode.createPlayerStateL
num <- cps^.cpsNumber
num <- cps^.cpsNumber
rFlag <- cps^.cpsRookieFlag
aFlag <- cps^.cpsActiveFlag
let
name = cps^.cpsName
pos = cps^.cpsPosition
player = newPlayer num name pos
& pRookie .~ rFlag
& pActive .~ aFlag
Just $ s & database.dbPlayers
%~ (++[player])
@@ -155,10 +177,14 @@ addPlayer s = fromMaybe s $ do
addGoalie :: ProgState -> ProgState
addGoalie s = fromMaybe s $ do
let cgs = s^.progMode.createGoalieStateL
num <- cgs^.cgsNumber
num <- cgs^.cgsNumber
rFlag <- cgs^.cgsRookieFlag
aFlag <- cgs^.cgsActiveFlag
let
name = cgs^.cgsName
goalie = newGoalie num name
& gRookie .~ rFlag
& gActive .~ aFlag
Just $ s & database.dbGoalies
%~ (++[goalie])
@@ -189,3 +215,13 @@ scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down
scrollDown :: ProgState -> ProgState
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
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
& database.dbPlayers %~ zipWith
(\i p -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
else p)
[0..]
-- | Awards an assist to a player
awardAssist
@@ -142,12 +143,13 @@ awardAssist n ps = ps
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
& database.dbPlayers %~ zipWith
(\i p -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
else p)
[0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,107 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Control.CreateGoalie (createGoalieC) where
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
-- | Handles goalie creation
createGoalieC :: CreateGoalieState -> Controller
createGoalieC cgs
| null $ cgs^.cgsNumber = getGoalieNumC
| null $ cgs^.cgsName = getGoalieNameC
| null $ cgs^.cgsRookieFlag = getRookieFlagC
| null $ cgs^.cgsActiveFlag = getActiveFlagC
| otherwise = confirmCreateGoalieC
getGoalieNumC :: Controller
getGoalieNumC = promptController goalieNumPrompt
getGoalieNameC :: Controller
getGoalieNameC = promptController goalieNamePrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ case ynHandler e of
Just True -> progMode.createGoalieStateL
%~ (cgsRookieFlag ?~ True)
. (cgsActiveFlag ?~ True)
rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is this goalie active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
return True
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
$ labelTable
[ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber )
, ( "Goalie name", cgs^.cgsName )
, ( "Rookie", maybe "?" show $ cgs^.cgsRookieFlag )
, ( "Active", maybe "?" show $ cgs^.cgsActiveFlag )
]
++ [ ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cgs <- gets (^.progMode.createGoalieStateL)
let
success = cgs^.cgsSuccessCallback
failure = cgs^.cgsFailureCallback
case ynHandler e of
Just True -> do
gid <- gets (^.database.dbGoalies.to length)
let rookie = cgs^.cgsRookieFlag == Just True
modify addGoalie
if rookie
then success
else modify $ progMode.editGoalieStateL
%~ (egsSelectedGoalie ?~ gid)
. (egsMode .~ EGLtGames True)
. (egsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

View File

@@ -0,0 +1,112 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Control.CreatePlayer (createPlayerC) where
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~), to)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Prompt
import Mtlstats.Types
-- | Handles player creation
createPlayerC :: CreatePlayerState -> Controller
createPlayerC cps
| null $ cps^.cpsNumber = getPlayerNumC
| null $ cps^.cpsName = getPlayerNameC
| null $ cps^.cpsPosition = getPlayerPosC
| null $ cps^.cpsRookieFlag = getRookieFlagC
| null $ cps^.cpsActiveFlag = getActiveFlagC
| otherwise = confirmCreatePlayerC
getPlayerNumC :: Controller
getPlayerNumC = promptController playerNumPrompt
getPlayerNameC :: Controller
getPlayerNameC = promptController playerNamePrompt
getPlayerPosC :: Controller
getPlayerPosC = promptController playerPosPrompt
getRookieFlagC :: Controller
getRookieFlagC = Controller
{ drawController = const $ do
C.drawString "Is this player a rookie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ case ynHandler e of
Just True -> progMode.createPlayerStateL
%~ (cpsRookieFlag ?~ True)
. (cpsActiveFlag ?~ True)
rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
return True
}
getActiveFlagC :: Controller
getActiveFlagC = Controller
{ drawController = const $ do
C.drawString "Is the player active? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
return True
}
confirmCreatePlayerC :: Controller
confirmCreatePlayerC = Controller
{ drawController = \s -> do
let cps = s^.progMode.createPlayerStateL
C.drawString $ unlines
$ labelTable
[ ( "Player number", maybe "?" show $ cps^.cpsNumber )
, ( "Player name", cps^.cpsName )
, ( "Player position", cps^.cpsPosition )
, ( "Rookie", maybe "?" show $ cps^.cpsRookieFlag )
, ( "Active", maybe "?" show $ cps^.cpsActiveFlag )
]
++ [ ""
, "Create player: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
cps <- gets (^.progMode.createPlayerStateL)
let
success = cps^.cpsSuccessCallback
failure = cps^.cpsFailureCallback
case ynHandler e of
Just True -> do
pid <- gets (^.database.dbPlayers.to length)
let rookie = cps^.cpsRookieFlag == Just True
modify addPlayer
if rookie
then success
else modify $ progMode.editPlayerStateL
%~ (epsSelectedPlayer ?~ pid)
. (epsMode .~ EPLtGoals True)
. (epsCallback .~ success)
Just False -> failure
Nothing -> return ()
return True
}

View File

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

View File

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

View File

@@ -0,0 +1,87 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Control.EditStandings (editStandingsC) where
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Menu.EditStandings
import Mtlstats.Prompt
import Mtlstats.Prompt.EditStandings
import Mtlstats.Types
import Mtlstats.Types.Menu
-- | Controller for the edit standings menu
editStandingsC :: EditStandingsMode -> Controller
editStandingsC = \case
ESMMenu -> menuControllerWith header editStandingsMenu
ESMHome m -> editHomeStandingsC m
ESMAway m -> editAwayStandingsC m
editHomeStandingsC :: ESMSubMode -> Controller
editHomeStandingsC = \case
ESMSubMenu -> menuC editHomeStandingsMenu
ESMEditWins -> promptC editHomeWinsPrompt
ESMEditLosses -> promptC editHomeLossesPrompt
ESMEditOvertime -> promptC editHomeOvertimePrompt
ESMEditGoalsFor -> promptC editHomeGoalsForPrompt
ESMEditGoalsAgainst -> promptC editHomeGoalsAgainstPrompt
editAwayStandingsC :: ESMSubMode -> Controller
editAwayStandingsC = \case
ESMSubMenu -> menuC editAwayStandingsMenu
ESMEditWins -> promptC editAwayWinsPrompt
ESMEditLosses -> promptC editAwayLossesPrompt
ESMEditOvertime -> promptC editAwayOvertimePrompt
ESMEditGoalsFor -> promptC editAwayGoalsForPrompt
ESMEditGoalsAgainst -> promptC editAwayGoalsAgainstPrompt
menuC :: Menu () -> Controller
menuC = menuControllerWith header
promptC :: Prompt -> Controller
promptC = promptControllerWith header
header :: ProgState -> C.Update ()
header = do
db <- (^.database)
let
home = db^.dbHomeGameStats
away = db^.dbAwayGameStats
table = numTable [" W", " L", " OT", " GF", " GA"]
[ ( "HOME", valsFor home )
, ( "ROAD", valsFor away )
]
return $ C.drawString $ unlines $ table ++ [""]
valsFor :: GameStats -> [Int]
valsFor gs =
[ gs^.gmsWins
, gs^.gmsLosses
, gs^.gmsOvertime
, gs^.gmsGoalsFor
, gs^.gmsGoalsAgainst
]

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,64 @@
{- |
mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Menu.EditStandings
( editStandingsMenu
, editHomeStandingsMenu
, editAwayStandingsMenu
) where
import Control.Monad.Trans.State (modify)
import Mtlstats.Actions
import Mtlstats.Actions.EditStandings
import Mtlstats.Types.Menu
editStandingsMenu :: Menu ()
editStandingsMenu = Menu "EDIT STANDINGS" ()
[ MenuItem 'A' "EDIT HOME STANDINGS" $
modify editHomeStandings
, MenuItem 'B' "EDIT ROAD STANDINGS" $
modify editAwayStandings
, MenuItem 'R' "RETURN TO MAIN MENU" $
modify backHome
]
editHomeStandingsMenu :: Menu ()
editHomeStandingsMenu = subMenu "HOME"
editAwayStandingsMenu :: Menu ()
editAwayStandingsMenu = subMenu "ROAD"
subMenu :: String -> Menu ()
subMenu str = Menu (str ++ " STANDINGS") ()
[ MenuItem 'W' "EDIT WINS" $
modify editWins
, MenuItem 'L' "EDIT LOSSES" $
modify editLosses
, MenuItem 'O' "EDIT OVERTIME GAMES" $
modify editOvertime
, MenuItem 'F' "EDIT GOALS FOR" $
modify editGoalsFor
, MenuItem 'A' "EDIT GOALS AGAINST" $
modify editGoalsAgainst
, MenuItem 'R' "RETURN TO EDIT STANDINGS MENU" $
modify editStandings
]

View File

@@ -34,6 +34,7 @@ module Mtlstats.Prompt (
numPromptWithFallback,
selectPrompt,
-- * Individual prompts
newSeasonPrompt,
playerNumPrompt,
playerNamePrompt,
playerPosPrompt,
@@ -41,13 +42,14 @@ module Mtlstats.Prompt (
goalieNamePrompt,
selectPlayerPrompt,
selectGoaliePrompt,
selectPositionPrompt,
playerToEditPrompt
) where
import Control.Monad (when)
import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper)
import Data.Char (isAlphaNum, isDigit, toUpper)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro.Extras (view)
import Text.Read (readMaybe)
@@ -55,6 +57,7 @@ import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Helpers.Position
import Mtlstats.Types
import Mtlstats.Util
@@ -161,12 +164,29 @@ numPromptWithFallback pStr fallback act = Prompt
, promptProcessChar = \ch str -> if isDigit ch
then str ++ [ch]
else str
, promptAction = \inStr -> case readMaybe inStr of
Nothing -> fallback
Just n -> act n
, promptAction = maybe fallback act . readMaybe
, 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
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
@@ -216,7 +236,7 @@ playerNamePrompt = namePrompt "Player name: " $
-- | Prompts for a new player's position
playerPosPrompt :: Prompt
playerPosPrompt = ucStrPrompt "Player position: " $
playerPosPrompt = selectPositionPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~)
-- | Prompts tor the goalie's number
@@ -287,6 +307,24 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
modify $ progMode .~ CreateGoalie cgs
}
-- | Selects (or creates) a player position
selectPositionPrompt
:: String
-- ^ The 'Prompt' string
-> (String -> Action ())
-- ^ The action to perform when a value is entered
-> Prompt
selectPositionPrompt pStr callback = selectPrompt SelectParams
{ spPrompt = pStr
, spSearchHeader = "Positions:"
, spSearch = posSearch
, spSearchExact = posSearchExact
, spElemDesc = id
, spProcessChar = \ch -> (++ [toUpper ch])
, spCallback = posCallback callback
, spNotFound = callback
}
playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

View File

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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -76,10 +76,16 @@ goalieNameSpec = describe "goalieName" $ mapM_
it ("should be " ++ expected) $
goalieName g `shouldBe` expected)
-- label, goalie, expected
[ ( "rookie", goalie True, "foo*" )
, ( "non-rookie", goalie False, "foo" )
-- label, goalie, expected
[ ( "rookie", rookie, "foo*" )
, ( "non-rookie", active, "foo" )
, ( "retired", retired, "*foo" )
]
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
[ ( "rookie", rookie, "foo*" )
, ( "non-rookie", nonRookie, "foo" )
, ( "retired", retired, "*foo" )
]
where
rookie = player True
nonRookie = player False
player r = newPlayer 1 "foo" "centre" & pRookie .~ r
rookie = player True True
nonRookie = player False True
retired = player False False
player r a = newPlayer 1 "foo" "centre"
& pRookie .~ r
& pActive .~ a

View File

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

View File

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

View File

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

View File

@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
module TypesSpec
( Comparable (..)
@@ -33,6 +33,7 @@ module TypesSpec
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import qualified Data.Map.Lazy as M
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
@@ -58,6 +59,8 @@ spec = describe "Mtlstats.Types" $ do
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
editStandingsModeLSpec
esmSubModeLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
@@ -191,6 +194,47 @@ editGoalieStateLSpec = describe "editGoalieStateL" $
egs2 = newEditGoalieState
& egsSelectedGoalie ?~ 2
editStandingsModeLSpec :: Spec
editStandingsModeLSpec = describe "editStandingsModeL" $
lensSpec editStandingsModeL
-- getters
[ ( "missing mode", MainMenu, menu )
, ( "with mode", EditStandings home, home )
]
-- setters
[ ( "set mode", MainMenu, home )
, ( "change mode", EditStandings home, away )
]
where
menu = ESMMenu
home = ESMHome ESMSubMenu
away = ESMAway ESMSubMenu
esmSubModeLSpec :: Spec
esmSubModeLSpec = describe "esmSubModeL" $ do
context "getters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $
mode^.esmSubModeL `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMSubMenu )
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
]
context "setters" $ mapM_
(\(label, mode, expected) -> context label $
it ("should be " ++ show expected) $ let
mode' = mode & esmSubModeL .~ ESMEditWins
in mode' `shouldBe` expected)
-- label, mode, expected
[ ( "no state", ESMMenu, ESMMenu )
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
]
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
@@ -281,6 +325,7 @@ playerJSON = Object $ HM.fromList
, ( "name", toJSON ("Joe" :: String) )
, ( "position", toJSON ("centre" :: String) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", playerStatsJSON 1 )
, ( "lifetime", playerStatsJSON 2 )
]
@@ -309,6 +354,7 @@ goalieJSON = Object $ HM.fromList
[ ( "number", toJSON (1 :: Int) )
, ( "name", toJSON ("Joe" :: String ) )
, ( "rookie", toJSON False )
, ( "active", toJSON True )
, ( "ytd", goalieStatsJSON 1 )
, ( "lifetime", goalieStatsJSON 2 )
]
@@ -848,6 +894,7 @@ makePlayer = Player
<*> makeName
<*> makeName
<*> makeBool
<*> makeBool
<*> makePlayerStats
<*> makePlayerStats
@@ -857,6 +904,7 @@ makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeBool
<*> makeBool
<*> makeGoalieStats
<*> makeGoalieStats
@@ -953,3 +1001,53 @@ instance Comparable CreateGoalieState where
describe "cgsName" $
it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName
instance Comparable EditStandingsMode where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
instance Comparable Goalie where
compareTest actual expected = do
describe "gNumber" $
it ("should be " ++ show (expected^.gNumber)) $
actual^.gNumber `shouldBe` expected^.gNumber
describe "gName" $
it ("should be " ++ show (expected^.gName)) $
actual^.gName `shouldBe` expected^.gName
describe "gRookie" $
it ("should be " ++ show (expected^.gRookie)) $
actual^.gRookie `shouldBe` expected^.gRookie
describe "gActive" $
it ("should be " ++ show (expected^.gActive)) $
actual^.gActive `shouldBe` expected^.gActive
describe "gYtd" $
(actual^.gYtd) `compareTest` (expected^.gYtd)
describe "gLifetime" $
(actual^.gLifetime) `compareTest` (expected^.gLifetime)
instance Comparable (M.Map Int GoalieStats) where
compareTest actual expected = do
let
aList = M.toList actual
eList = M.toList expected
it "should have the correct number of elements" $
length aList `shouldBe` length eList
mapM_
(\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
context "key" $
it ("should be " ++ show ke) $
ka `shouldBe` ke
context "value" $ va `compareTest` ve)
(zip3 ([0..] :: [Int]) aList eList)

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