Compare commits
321 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2adfe9b016 | ||
|
|
85a8e3baf1 | ||
|
|
393a2c6dc4 | ||
|
|
ed240c6a38 | ||
|
|
4f147cd5a4 | ||
|
|
9b6dfc4be9 | ||
|
|
c20fb30f5b | ||
|
|
3c0e690ed3 | ||
|
|
f37e231623 | ||
|
|
fbaf2a1e60 | ||
|
|
65979329bd | ||
|
|
ded019faac | ||
|
|
1322004d38 | ||
|
|
2cb279e7e7 | ||
|
|
7ca66ad801 | ||
|
|
82544046ce | ||
|
|
95c97d722e | ||
|
|
0eb46cacce | ||
|
|
25f887a5e8 | ||
|
|
7ba670948b | ||
|
|
ca06b0570e | ||
|
|
1e8473538a | ||
|
|
87336dcd1d | ||
|
|
ffa241c1f7 | ||
|
|
f9085832f4 | ||
|
|
e15623bde3 | ||
|
|
db62fbb542 | ||
|
|
4a8515b862 | ||
|
|
e4c668d1e4 | ||
|
|
9ee33cbd03 | ||
|
|
53c49492cb | ||
|
|
4d1eaa1523 | ||
|
|
29fae81513 | ||
|
|
8a8a550854 | ||
|
|
6227df8e01 | ||
|
|
0676bf4067 | ||
|
|
119032ca80 | ||
|
|
2607fc5ce8 | ||
|
|
d18cb7dd59 | ||
|
|
dff11a8316 | ||
|
|
747bdf8f32 | ||
|
|
9b07c6d249 | ||
|
|
e28ef1ff0e | ||
|
|
960fbb3443 | ||
|
|
439aab99d3 | ||
|
|
8d7a7997b1 | ||
|
|
7e409fdbd4 | ||
|
|
28b1fa0e06 | ||
|
|
7c4b7331e8 | ||
|
|
214710661a | ||
|
|
6bb4601e6b | ||
|
|
e51953650c | ||
|
|
14386f9c7d | ||
|
|
ec10aa7998 | ||
|
|
fe28e96145 | ||
|
|
2941998058 | ||
|
|
c22849bb3b | ||
|
|
4315b40732 | ||
|
|
fefa217df1 | ||
|
|
6d77caaa14 | ||
|
|
a69853858d | ||
|
|
045f2915e1 | ||
|
|
dfd226c7bd | ||
|
|
b9d8b263df | ||
|
|
a2968595d8 | ||
|
|
25e4929f0b | ||
|
|
457298e565 | ||
|
|
a80eaa2a40 | ||
|
|
8a6cf10ad3 | ||
|
|
bd5bc21661 | ||
|
|
accc831bc5 | ||
|
|
2c78a591ca | ||
|
|
77dc89c76d | ||
|
|
607a78ccea | ||
|
|
d7c5f24c26 | ||
|
|
d94c6a588e | ||
|
|
bdbe0131d7 | ||
|
|
b0638b95b8 | ||
|
|
ce2d32407e | ||
|
|
5771091f18 | ||
|
|
13a1949446 | ||
|
|
835cb9582b | ||
|
|
8bc9b48aa2 | ||
|
|
378efea24e | ||
|
|
6418ab0eea | ||
|
|
95e74accd4 | ||
|
|
ffc1390755 | ||
|
|
2f0a3a5c57 | ||
|
|
79d527866f | ||
|
|
994087a0e6 | ||
|
|
7fbeaac933 | ||
|
|
de56f4f94d | ||
|
|
04ba17324e | ||
|
|
d6ae171dc8 | ||
|
|
72b6f05700 | ||
|
|
4c7a756c5e | ||
|
|
ea3ca4e578 | ||
|
|
179a864cfa | ||
|
|
f2b2ff3fef | ||
|
|
9c2e2291c8 | ||
|
|
abad72ce01 | ||
|
|
a9d4d3351f | ||
|
|
45aea607b2 | ||
|
|
be9d7d80bb | ||
|
|
683c36e2b6 | ||
|
|
83c408cea2 | ||
|
|
dcbd68cdda | ||
|
|
717f2d5932 | ||
|
|
d5de834510 | ||
|
|
75a47ca852 | ||
|
|
d4de7c6f8b | ||
|
|
d50d055b0b | ||
|
|
9c7c295a4b | ||
|
|
49963277be | ||
|
|
264d9f81e2 | ||
|
|
6a0d1f7203 | ||
|
|
18683c1c6e | ||
|
|
107ed507e2 | ||
|
|
baf040deea | ||
|
|
c3bac5e624 | ||
|
|
119cb873eb | ||
|
|
82603ba504 | ||
|
|
a909b9ba7a | ||
|
|
802bf7314e | ||
|
|
a3124aca58 | ||
|
|
f113e46564 | ||
|
|
39646f3fa7 | ||
|
|
2bf8d15bd4 | ||
|
|
3009a8f60c | ||
|
|
3b4ce50ae8 | ||
|
|
fcfbcea72f | ||
|
|
d132ebd502 | ||
|
|
75cd253f3f | ||
|
|
063bebfbb5 | ||
|
|
7923827d22 | ||
|
|
461fb5d942 | ||
|
|
e38275aefe | ||
|
|
dd6f604cd7 | ||
|
|
1763f142f1 | ||
|
|
b442b6a360 | ||
|
|
119c28ef18 | ||
|
|
b69b3fce7a | ||
|
|
59026de077 | ||
|
|
52f1e34d49 | ||
|
|
2c561e9807 | ||
|
|
e2aeb5bfa4 | ||
|
|
5b40a5942b | ||
|
|
ee3cea5643 | ||
|
|
5209c4a296 | ||
|
|
e077c32956 | ||
|
|
8dcef502be | ||
|
|
3ee97406f1 | ||
|
|
2768934c7c | ||
|
|
6c8ec21ffe | ||
|
|
ba3f8a5a6c | ||
|
|
3a71dc1e62 | ||
|
|
d14f2ba527 | ||
|
|
acd45229e7 | ||
|
|
aff1d5c255 | ||
|
|
0448a4beee | ||
|
|
ddb9394ab7 | ||
|
|
071aa3bd8e | ||
|
|
ac95601609 | ||
|
|
9606436e9e | ||
|
|
30807b7e2e | ||
|
|
34b743a55b | ||
|
|
63bd9a6de4 | ||
|
|
1f3ff5912c | ||
|
|
7bb0981ed6 | ||
|
|
eb4107365c | ||
|
|
6238e39f69 | ||
|
|
1adf6de990 | ||
|
|
2840298467 | ||
|
|
89fe646d0e | ||
|
|
b35136944c | ||
|
|
4d41c454a1 | ||
|
|
18ba758c0c | ||
|
|
3aedd01b08 | ||
|
|
235dd4e611 | ||
|
|
adf09c2cc4 | ||
|
|
a44ecc5e24 | ||
|
|
9980a095ed | ||
|
|
1d6a4aa7f3 | ||
|
|
8988ad9146 | ||
|
|
59d48ec154 | ||
|
|
be990538bc | ||
|
|
55c8806186 | ||
|
|
0ecf899b56 | ||
|
|
2f06fd221d | ||
|
|
f1227da9ca | ||
|
|
38db3c8d8f | ||
|
|
2b9a21c28b | ||
|
|
84c487dba5 | ||
|
|
6345e3d5d8 | ||
|
|
0ca03b7f21 | ||
|
|
482f42dca7 | ||
|
|
996bad94f1 | ||
|
|
4ca0b54de2 | ||
|
|
3738088dde | ||
|
|
1ec9e93f16 | ||
|
|
9534218797 | ||
|
|
d7d3d1a4fd | ||
|
|
86c4fe316e | ||
|
|
d5ac42268f | ||
|
|
df26e9d265 | ||
|
|
cb5f2d7d15 | ||
|
|
152ea76bda | ||
|
|
36ab31a17c | ||
|
|
768cb47fac | ||
|
|
427ad12603 | ||
|
|
1ca2ffc378 | ||
|
|
9e6b71c464 | ||
|
|
2f4e963e41 | ||
|
|
05af939963 | ||
|
|
8af7974c8f | ||
|
|
f7cfd5d835 | ||
|
|
cc495fa589 | ||
|
|
9c5d166f31 | ||
|
|
a9e12d11a9 | ||
|
|
08be4154b3 | ||
|
|
4e25db12f1 | ||
|
|
50389b4f4c | ||
|
|
dcbb809ae1 | ||
|
|
be54198960 | ||
|
|
e3d5af5f88 | ||
|
|
de67628df0 | ||
|
|
4848e54d81 | ||
|
|
3b6f77ba21 | ||
|
|
e7606c8a5e | ||
|
|
3560aa7595 | ||
|
|
5979856578 | ||
|
|
4941e0e64f | ||
|
|
eedeaed8fc | ||
|
|
d0f237e707 | ||
|
|
8795cb46a9 | ||
|
|
f1f7077c8c | ||
|
|
a407a01339 | ||
|
|
3e1218f6ff | ||
|
|
7ff16b8ac2 | ||
|
|
d7879a92af | ||
|
|
9b9feefa4f | ||
|
|
26a90a5ed9 | ||
|
|
e8b850c23a | ||
|
|
0efac07a33 | ||
|
|
fba5f1b96c | ||
|
|
95853f8bd7 | ||
|
|
01a4141ff4 | ||
|
|
4d6c3faf5e | ||
|
|
7824d56d68 | ||
|
|
e6e28618a3 | ||
|
|
b830947d6c | ||
|
|
29ae55a01e | ||
|
|
5b9c18730c | ||
|
|
61d788cb4e | ||
|
|
aac2752e95 | ||
|
|
9456102935 | ||
|
|
3ba3875752 | ||
|
|
ac3b8e9522 | ||
|
|
2860309fc5 | ||
|
|
dd34429f59 | ||
|
|
13acbbdf35 | ||
|
|
954fe98998 | ||
|
|
c0386fa0b9 | ||
|
|
846d034435 | ||
|
|
3a1480115d | ||
|
|
30cfea0503 | ||
|
|
52d412942a | ||
|
|
afdb7653cd | ||
|
|
6b1aa85010 | ||
|
|
8c482ae785 | ||
|
|
f97db477dd | ||
|
|
101f436424 | ||
|
|
b8aa00aa81 | ||
|
|
4655cb37b9 | ||
|
|
01859634a1 | ||
|
|
e50861613d | ||
|
|
14da1096cd | ||
|
|
a8a5d6a305 | ||
|
|
4f5b4ff5f9 | ||
|
|
cb5aa63469 | ||
|
|
817c3c3fed | ||
|
|
5dcd140280 | ||
|
|
023430d737 | ||
|
|
0961f14c5f | ||
|
|
1b9c072a76 | ||
|
|
203650397e | ||
|
|
f739db4203 | ||
|
|
06348fe928 | ||
|
|
3839d6dd32 | ||
|
|
0234abec4c | ||
|
|
9682aa0af3 | ||
|
|
35eda4a309 | ||
|
|
61ba781c5d | ||
|
|
fceba7eed1 | ||
|
|
895f090f17 | ||
|
|
6c4b08bfcd | ||
|
|
0b3d70e7c3 | ||
|
|
0202ddadab | ||
|
|
75abf0ade8 | ||
|
|
c24016210c | ||
|
|
d1773324d5 | ||
|
|
758dc868ec | ||
|
|
3c9b7dd989 | ||
|
|
f1f0ffef99 | ||
|
|
d14abdb248 | ||
|
|
e1f92ce92e | ||
|
|
3dfbfe7090 | ||
|
|
f9849023bc | ||
|
|
8aa8d39f70 | ||
|
|
cadbd6354b | ||
|
|
dde0291321 | ||
|
|
9a179ed166 | ||
|
|
858da7ab5c | ||
|
|
030cafb571 | ||
|
|
c99a39b2b9 | ||
|
|
9288d885cd | ||
|
|
9f206ede72 | ||
|
|
e802fff7c5 | ||
|
|
04140df812 | ||
|
|
5339c57d5c | ||
|
|
ca2dd92bfe |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -1,3 +1,6 @@
|
||||
.stack-work/
|
||||
mtlstats.cabal
|
||||
.vagrant
|
||||
data
|
||||
*.log
|
||||
*~
|
||||
68
ChangeLog.md
68
ChangeLog.md
@@ -1,24 +1,84 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## 0.5.0
|
||||
## 0.15.1
|
||||
- only search for active players/goalies on game data input
|
||||
|
||||
## 0.15.0
|
||||
- Ask for database to load on start-up
|
||||
- Add page break to report file
|
||||
- Implemented player/goalie deletion
|
||||
|
||||
## 0.14.0
|
||||
- Fixed a bug that was causing shutouts to not be recorded
|
||||
- Output report to a text file (report.txt)
|
||||
|
||||
## 0.13.0
|
||||
- Added autocomplete to player position prompt
|
||||
- Don't prompt for lifetime stats on rookie player/goalie creation
|
||||
- Ask whether a player/goalie is active on creation
|
||||
- Don't ask which goalie to assign the game to when there's only one
|
||||
|
||||
## 0.12.0
|
||||
- Edit lifetime stats on new player/goalie creation
|
||||
- Sort goalies by minutes played
|
||||
- Subsort players by lifetime points
|
||||
- Changed wording on edit menus
|
||||
|
||||
## 0.11.0
|
||||
- Added active flag to players/goalies
|
||||
- Clear rookie flag on new (regular) season
|
||||
- Save a copy of the database on new season
|
||||
- Implemented game standings editing
|
||||
- Added title screen
|
||||
- Changed sytling of menus
|
||||
|
||||
## 0.10.0
|
||||
- Don't show player number zero in reports
|
||||
- Fixed player/goalie name capitalisation on edit
|
||||
- Return to correct edit menus after editing player stats
|
||||
- Enabled batch editing of player/goalie YTD/lifetime stats
|
||||
- Bugfix: allow user to edit goalie shutouts
|
||||
- Added line numbers to lifetime player/goalie reports
|
||||
- Implemented rookie flag
|
||||
|
||||
## 0.9.0
|
||||
- Bugfix: Display lifetime stats in report, not YTD
|
||||
- Force expected capitalization on player/goalie names
|
||||
- Don't show lifetime totals in report
|
||||
- Sort players in YTD and lifetime reports by points
|
||||
- Moved player/goalie creation/editing to edit submenu
|
||||
|
||||
## 0.8.0
|
||||
- Bugfix: removed quotation marks from goalie names in report
|
||||
- Allow lower case player names
|
||||
- Don't show players without points in game report
|
||||
- Removed unnecessary goalie statistics from game report
|
||||
- Fixed goalie average calculation
|
||||
|
||||
## 0.7.0
|
||||
- Shortened views to fit within 25 lines
|
||||
- Implemented goalie reports
|
||||
|
||||
## 0.6.0
|
||||
- Generate lifetime statistics report
|
||||
- Implemented goalie editing
|
||||
- Reset game standings on new season
|
||||
|
||||
## 0.5.0
|
||||
- Fixed player creation bug
|
||||
- Prompt for goalie informaiton on game data entry
|
||||
- Implemented player editing
|
||||
|
||||
## v0.4.0
|
||||
|
||||
- Record penalty minutes
|
||||
- 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
10
Vagrantfile
vendored
Normal 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
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
12
package.yaml
12
package.yaml
@@ -1,5 +1,5 @@
|
||||
name: mtlstats
|
||||
version: 0.5.0
|
||||
version: 0.15.1
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
author: "Jonathan Lamothe"
|
||||
@@ -11,13 +11,13 @@ extra-source-files:
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
synopsis: Hockey statistics tracker
|
||||
category: Statistics
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
|
||||
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
|
||||
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
@@ -33,6 +33,10 @@ dependencies:
|
||||
- bytestring
|
||||
- microlens
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
- -Werror
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,23 +19,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Mtlstats (initState, mainLoop) where
|
||||
|
||||
import Control.Exception (IOException, catch)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Extra (whenM)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.State (get, gets)
|
||||
import Data.Aeson (decodeFileStrict)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Lens.Micro ((&), (.~))
|
||||
import System.EasyFile (getAppUserDataDirectory, (</>))
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Control
|
||||
import Mtlstats.Types
|
||||
|
||||
@@ -44,15 +36,7 @@ initState :: C.Curses ProgState
|
||||
initState = do
|
||||
C.setEcho False
|
||||
void $ C.setCursorMode C.CursorInvisible
|
||||
db <- liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> dbFname
|
||||
fromMaybe newDatabase <$> catch
|
||||
(decodeFileStrict dbFile)
|
||||
(\(_ :: IOException) -> return Nothing)
|
||||
return
|
||||
$ newProgState
|
||||
& database .~ db
|
||||
return newProgState
|
||||
|
||||
-- | Main program loop
|
||||
mainLoop :: Action ()
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,46 +19,55 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
|
||||
|
||||
module Mtlstats.Actions
|
||||
( startNewSeason
|
||||
, resetYtd
|
||||
, clearRookies
|
||||
, resetStandings
|
||||
, startNewGame
|
||||
, addChar
|
||||
, removeChar
|
||||
, overtimeCheck
|
||||
, updateGameStats
|
||||
, validateGameDate
|
||||
, createPlayer
|
||||
, createGoalie
|
||||
, edit
|
||||
, editPlayer
|
||||
, editSelectedPlayer
|
||||
, editGoalie
|
||||
, editSelectedGoalie
|
||||
, addPlayer
|
||||
, addGoalie
|
||||
, resetCreatePlayerState
|
||||
, resetCreateGoalieState
|
||||
, recordGoalAssists
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, backHome
|
||||
, scrollUp
|
||||
, scrollDown
|
||||
, loadDatabase
|
||||
, saveDatabase
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import qualified Data.Map as M
|
||||
import Control.Exception (IOException, catch)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Aeson (decodeFileStrict, encodeFile)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Calendar (fromGregorianValid)
|
||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
||||
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
|
||||
@@ -66,6 +75,18 @@ 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
|
||||
%~ ( dbHomeGameStats .~ newGameStats)
|
||||
. ( dbAwayGameStats .~ newGameStats)
|
||||
|
||||
-- | Starts a new game
|
||||
startNewGame :: ProgState -> ProgState
|
||||
startNewGame
|
||||
@@ -82,69 +103,10 @@ removeChar = inputBuffer %~ \case
|
||||
"" -> ""
|
||||
str -> init str
|
||||
|
||||
-- | Determines whether or not to perform a check for overtime
|
||||
overtimeCheck :: ProgState -> ProgState
|
||||
overtimeCheck s
|
||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL
|
||||
%~ (homeScore .~ Nothing)
|
||||
. (awayScore .~ Nothing)
|
||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||
| otherwise = s
|
||||
|
||||
-- | Adjusts the game stats based on the results of the current game
|
||||
updateGameStats :: ProgState -> ProgState
|
||||
updateGameStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gType <- gs^.gameType
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
ot <- gs^.overtimeFlag
|
||||
tScore <- teamScore gs
|
||||
oScore <- otherScore gs
|
||||
let
|
||||
hw = if gType == HomeGame && won then 1 else 0
|
||||
hl = if gType == HomeGame && lost then 1 else 0
|
||||
hot = if gType == HomeGame && ot then 1 else 0
|
||||
hgf = if gType == HomeGame then tScore else 0
|
||||
hga = if gType == HomeGame then oScore else 0
|
||||
aw = if gType == AwayGame && won then 1 else 0
|
||||
al = if gType == AwayGame && lost then 1 else 0
|
||||
aot = if gType == AwayGame && ot then 1 else 0
|
||||
agf = if gType == AwayGame then tScore else 0
|
||||
aga = if gType == AwayGame then oScore else 0
|
||||
Just $ s
|
||||
& database.dbHomeGameStats
|
||||
%~ (gmsWins +~ hw)
|
||||
. (gmsLosses +~ hl)
|
||||
. (gmsOvertime +~ hot)
|
||||
. (gmsGoalsFor +~ hgf)
|
||||
. (gmsGoalsAgainst +~ hga)
|
||||
& database.dbAwayGameStats
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
. (gmsGoalsFor +~ agf)
|
||||
. (gmsGoalsAgainst +~ aga)
|
||||
|
||||
-- | Validates the game date
|
||||
validateGameDate :: ProgState -> ProgState
|
||||
validateGameDate s = fromMaybe s $ do
|
||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||
m <- s^.progMode.gameStateL.gameMonth
|
||||
d <- s^.progMode.gameStateL.gameDay
|
||||
Just $ if null $ fromGregorianValid y m d
|
||||
then s & progMode.gameStateL
|
||||
%~ (gameYear .~ Nothing)
|
||||
. (gameMonth .~ Nothing)
|
||||
. (gameDay .~ Nothing)
|
||||
else s
|
||||
|
||||
-- | Starts player creation mode
|
||||
createPlayer :: ProgState -> ProgState
|
||||
createPlayer = let
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
callback = modify edit
|
||||
cps = newCreatePlayerState
|
||||
& cpsSuccessCallback .~ callback
|
||||
& cpsFailureCallback .~ callback
|
||||
@@ -153,25 +115,63 @@ createPlayer = let
|
||||
-- | Starts goalie creation mode
|
||||
createGoalie :: ProgState -> ProgState
|
||||
createGoalie = let
|
||||
callback = modify $ progMode .~ MainMenu
|
||||
callback = modify edit
|
||||
cgs = newCreateGoalieState
|
||||
& cgsSuccessCallback .~ callback
|
||||
& cgsFailureCallback .~ callback
|
||||
in progMode .~ CreateGoalie cgs
|
||||
|
||||
-- | Launches the edit menu
|
||||
edit :: ProgState -> ProgState
|
||||
edit = progMode .~ EditMenu
|
||||
|
||||
-- | Starts the player editing process
|
||||
editPlayer :: ProgState -> ProgState
|
||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||
|
||||
-- | Edits the selected 'Player'
|
||||
editSelectedPlayer
|
||||
:: (Player -> Player)
|
||||
-- ^ The modification to be made to the 'Player'
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editSelectedPlayer f s = fromMaybe s $ do
|
||||
n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
let
|
||||
players = s^.database.dbPlayers
|
||||
players' = modifyNth n f players
|
||||
Just $ s & database.dbPlayers .~ players'
|
||||
|
||||
-- | Starts the 'Goalie' editing process
|
||||
editGoalie :: ProgState -> ProgState
|
||||
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||
|
||||
-- | Edits the selected 'Goalie'
|
||||
editSelectedGoalie
|
||||
:: (Goalie -> Goalie)
|
||||
-- ^ The modification to be made to the 'Goalie'
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editSelectedGoalie f s = fromMaybe s $ do
|
||||
n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
let
|
||||
goalies = s^.database.dbGoalies
|
||||
goalies' = modifyNth n f goalies
|
||||
Just $ s & database.dbGoalies .~ goalies'
|
||||
|
||||
-- | Adds the entered player to the roster
|
||||
addPlayer :: ProgState -> ProgState
|
||||
addPlayer s = fromMaybe s $ do
|
||||
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])
|
||||
|
||||
@@ -179,10 +179,14 @@ addPlayer s = fromMaybe s $ do
|
||||
addGoalie :: ProgState -> ProgState
|
||||
addGoalie s = fromMaybe s $ do
|
||||
let cgs = s^.progMode.createGoalieStateL
|
||||
num <- cgs^.cgsNumber
|
||||
num <- cgs^.cgsNumber
|
||||
rFlag <- cgs^.cgsRookieFlag
|
||||
aFlag <- cgs^.cgsActiveFlag
|
||||
let
|
||||
name = cgs^.cgsName
|
||||
goalie = newGoalie num name
|
||||
& gRookie .~ rFlag
|
||||
& gActive .~ aFlag
|
||||
Just $ s & database.dbGoalies
|
||||
%~ (++[goalie])
|
||||
|
||||
@@ -199,81 +203,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
|
||||
%~ (cgsNumber .~ Nothing)
|
||||
. (cgsName .~ "")
|
||||
|
||||
-- | Awards the goal and assists to the players
|
||||
recordGoalAssists :: ProgState -> ProgState
|
||||
recordGoalAssists ps = fromMaybe ps $ do
|
||||
let gs = ps^.progMode.gameStateL
|
||||
goalId <- gs^.goalBy
|
||||
let assistIds = gs^.assistsBy
|
||||
Just $ ps
|
||||
& awardGoal goalId
|
||||
& (\s -> foldr awardAssist s assistIds)
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (pointsAccounted %~ succ)
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Awards a goal to a player
|
||||
awardGoal
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardGoal n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psGoals %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psGoals %~ succ
|
||||
& pLifetime.psGoals %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Awards an assist to a player
|
||||
awardAssist
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardAssist n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psAssists %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psAssists %~ succ
|
||||
& pLifetime.psAssists %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Resets the entered data for the current goal
|
||||
resetGoalData :: ProgState -> ProgState
|
||||
resetGoalData ps = ps & progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Adds penalty minutes to a player
|
||||
assignPMins
|
||||
:: Int
|
||||
-- ^ The number of minutes to add
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
assignPMins mins s = fromMaybe s $ do
|
||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
Just $ s
|
||||
& database.dbPlayers %~ modifyNth n
|
||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||
& progMode.gameStateL
|
||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||
(psPMin +~ mins)
|
||||
)
|
||||
. (gameSelectedPlayer .~ Nothing)
|
||||
|
||||
-- | Resets the program state back to the main menu
|
||||
backHome :: ProgState -> ProgState
|
||||
backHome
|
||||
@@ -288,3 +217,28 @@ scrollUp = scrollOffset %~ max 0 . pred
|
||||
-- | Scrolls the display down
|
||||
scrollDown :: ProgState -> ProgState
|
||||
scrollDown = scrollOffset %~ succ
|
||||
|
||||
-- | Loads the database
|
||||
loadDatabase :: Action ()
|
||||
loadDatabase = do
|
||||
dbFile <- dbSetup
|
||||
liftIO
|
||||
(catch
|
||||
(decodeFileStrict dbFile)
|
||||
(\(_ :: IOException) -> return Nothing))
|
||||
>>= mapM_ (modify . (database .~))
|
||||
|
||||
-- | Saves the database
|
||||
saveDatabase :: Action ()
|
||||
saveDatabase = do
|
||||
db <- gets (^.database)
|
||||
dbFile <- dbSetup
|
||||
liftIO $ encodeFile dbFile db
|
||||
|
||||
dbSetup :: Action String
|
||||
dbSetup = do
|
||||
fn <- gets (^.dbName)
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
createDirectoryIfMissing True dir
|
||||
return $ dir </> fn ++ ".json"
|
||||
|
||||
70
src/Mtlstats/Actions/EditStandings.hs
Normal file
70
src/Mtlstats/Actions/EditStandings.hs
Normal 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 .~)
|
||||
193
src/Mtlstats/Actions/NewGame.hs
Normal file
193
src/Mtlstats/Actions/NewGame.hs
Normal file
@@ -0,0 +1,193 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.NewGame
|
||||
( overtimeCheck
|
||||
, updateGameStats
|
||||
, validateGameDate
|
||||
, recordGoalAssists
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, awardShutouts
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Calendar (fromGregorianValid)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Determines whether or not to perform a check for overtime
|
||||
overtimeCheck :: ProgState -> ProgState
|
||||
overtimeCheck s
|
||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL
|
||||
%~ (homeScore .~ Nothing)
|
||||
. (awayScore .~ Nothing)
|
||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||
| otherwise = s
|
||||
|
||||
-- | Adjusts the game stats based on the results of the current game
|
||||
updateGameStats :: ProgState -> ProgState
|
||||
updateGameStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gType <- gs^.gameType
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
ot <- gs^.overtimeFlag
|
||||
tScore <- teamScore gs
|
||||
oScore <- otherScore gs
|
||||
let
|
||||
hw = if gType == HomeGame && won then 1 else 0
|
||||
hl = if gType == HomeGame && lost then 1 else 0
|
||||
hot = if gType == HomeGame && ot then 1 else 0
|
||||
hgf = if gType == HomeGame then tScore else 0
|
||||
hga = if gType == HomeGame then oScore else 0
|
||||
aw = if gType == AwayGame && won then 1 else 0
|
||||
al = if gType == AwayGame && lost then 1 else 0
|
||||
aot = if gType == AwayGame && ot then 1 else 0
|
||||
agf = if gType == AwayGame then tScore else 0
|
||||
aga = if gType == AwayGame then oScore else 0
|
||||
Just $ s
|
||||
& database.dbHomeGameStats
|
||||
%~ (gmsWins +~ hw)
|
||||
. (gmsLosses +~ hl)
|
||||
. (gmsOvertime +~ hot)
|
||||
. (gmsGoalsFor +~ hgf)
|
||||
. (gmsGoalsAgainst +~ hga)
|
||||
& database.dbAwayGameStats
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
. (gmsGoalsFor +~ agf)
|
||||
. (gmsGoalsAgainst +~ aga)
|
||||
|
||||
-- | Validates the game date
|
||||
validateGameDate :: ProgState -> ProgState
|
||||
validateGameDate s = fromMaybe s $ do
|
||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||
m <- s^.progMode.gameStateL.gameMonth
|
||||
d <- s^.progMode.gameStateL.gameDay
|
||||
Just $ if null $ fromGregorianValid y m d
|
||||
then s & progMode.gameStateL
|
||||
%~ (gameYear .~ Nothing)
|
||||
. (gameMonth .~ Nothing)
|
||||
. (gameDay .~ Nothing)
|
||||
else s
|
||||
|
||||
-- | Awards the goal and assists to the players
|
||||
recordGoalAssists :: ProgState -> ProgState
|
||||
recordGoalAssists ps = fromMaybe ps $ do
|
||||
let gs = ps^.progMode.gameStateL
|
||||
goalId <- gs^.goalBy
|
||||
let assistIds = gs^.assistsBy
|
||||
Just $ ps
|
||||
& awardGoal goalId
|
||||
& (\s -> foldr awardAssist s assistIds)
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (pointsAccounted %~ succ)
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Awards a goal to a player
|
||||
awardGoal
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardGoal n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psGoals %~ succ) m)
|
||||
& database.dbPlayers %~ zipWith
|
||||
(\i p -> if i == n
|
||||
then p
|
||||
& pYtd.psGoals %~ succ
|
||||
& pLifetime.psGoals %~ succ
|
||||
else p)
|
||||
[0..]
|
||||
|
||||
-- | Awards an assist to a player
|
||||
awardAssist
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardAssist n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psAssists %~ succ) m)
|
||||
& database.dbPlayers %~ zipWith
|
||||
(\i p -> if i == n
|
||||
then p
|
||||
& pYtd.psAssists %~ succ
|
||||
& pLifetime.psAssists %~ succ
|
||||
else p)
|
||||
[0..]
|
||||
|
||||
-- | Resets the entered data for the current goal
|
||||
resetGoalData :: ProgState -> ProgState
|
||||
resetGoalData ps = ps & progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Adds penalty minutes to a player
|
||||
assignPMins
|
||||
:: Int
|
||||
-- ^ The number of minutes to add
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
assignPMins mins s = fromMaybe s $ do
|
||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
Just $ s
|
||||
& database.dbPlayers %~ modifyNth n
|
||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||
& progMode.gameStateL
|
||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||
(psPMin +~ mins)
|
||||
)
|
||||
. (gameSelectedPlayer .~ Nothing)
|
||||
|
||||
-- | Awards a shutout to any 'Goalie' who played and didn't allow any
|
||||
-- goals
|
||||
awardShutouts :: ProgState -> ProgState
|
||||
awardShutouts s = foldl
|
||||
(\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0
|
||||
then s'
|
||||
& database.dbGoalies %~ modifyNth gid
|
||||
( ( gYtd.gsShutouts %~ succ )
|
||||
. ( gLifetime.gsShutouts %~ succ )
|
||||
)
|
||||
& progMode.gameStateL.gameGoalieStats %~ M.adjust
|
||||
(gsShutouts %~ succ)
|
||||
gid
|
||||
else s')
|
||||
s
|
||||
(M.toList $ s^.progMode.gameStateL.gameGoalieStats)
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.GoalieInput
|
||||
module Mtlstats.Actions.NewGame.GoalieInput
|
||||
( finishGoalieEntry
|
||||
, recordGoalieStats
|
||||
, setGameGoalie
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
||||
@@ -35,17 +36,21 @@ 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
|
||||
recordGoalieStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gid <- gs^.gameSelectedGoalie
|
||||
goalie <- nth gid $ s^.database.dbGoalies
|
||||
mins <- gs^.gameGoalieMinsPlayed
|
||||
goals <- gs^.gameGoalsAllowed
|
||||
gid <- gs^.gameSelectedGoalie
|
||||
mins <- gs^.gameGoalieMinsPlayed
|
||||
goals <- gs^.gameGoalsAllowed
|
||||
void $ nth gid $ s^.database.dbGoalies
|
||||
|
||||
let
|
||||
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
||||
@@ -53,10 +58,10 @@ recordGoalieStats s = fromMaybe s $ do
|
||||
then 1
|
||||
else 0
|
||||
|
||||
bumpStats gs = gs
|
||||
& gsGames +~ bumpVal
|
||||
& gsMinsPlayed +~ mins
|
||||
& gsGoalsAllowed +~ goals
|
||||
bumpStats
|
||||
= (gsGames +~ bumpVal)
|
||||
. (gsMinsPlayed +~ mins)
|
||||
. (gsGoalsAllowed +~ goals)
|
||||
|
||||
tryFinish = if mins >= gameLength
|
||||
then finishGoalieEntry
|
||||
@@ -82,26 +87,30 @@ 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 gs = gs
|
||||
& gsWins +~ w
|
||||
& gsLosses +~ l
|
||||
& gsTies +~ t
|
||||
updateStats
|
||||
= (gsWins +~ w)
|
||||
. (gsLosses +~ l)
|
||||
. (gsTies +~ t)
|
||||
. (gsShutouts +~ so)
|
||||
|
||||
updateGoalie g = g
|
||||
& gYtd %~ updateStats
|
||||
& gLifetime %~ updateStats
|
||||
updateGoalie
|
||||
= (gYtd %~ updateStats)
|
||||
. (gLifetime %~ updateStats)
|
||||
|
||||
updateGameState gs = gs
|
||||
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
|
||||
& gameGoalieAssigned .~ True
|
||||
updateGameState
|
||||
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
|
||||
. (gameGoalieAssigned .~ True)
|
||||
|
||||
Just $ s
|
||||
& database.dbGoalies %~ modifyNth gid updateGoalie
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -33,10 +33,6 @@ maxFunKeys = 9
|
||||
appName :: String
|
||||
appName = "mtlstats"
|
||||
|
||||
-- | The database filename
|
||||
dbFname :: String
|
||||
dbFname = "database.json"
|
||||
|
||||
-- | The maximum number of assists
|
||||
maxAssists :: Int
|
||||
maxAssists = 2
|
||||
@@ -44,3 +40,11 @@ maxAssists = 2
|
||||
-- | The length of a typical game (in minutes)
|
||||
gameLength :: Int
|
||||
gameLength = 60
|
||||
|
||||
-- | Report output filename
|
||||
reportFilename :: FilePath
|
||||
reportFilename = "report.txt"
|
||||
|
||||
-- | Number of columns in report file
|
||||
reportCols :: Int
|
||||
reportCols = 79
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,375 +21,45 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control (dispatch) where
|
||||
|
||||
import Control.Monad (join, when)
|
||||
import Control.Monad.Extra (ifM)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (toUpper)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import qualified UI.NCurses as C
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Control.CreateGoalie
|
||||
import Mtlstats.Control.CreatePlayer
|
||||
import Mtlstats.Control.EditGoalie
|
||||
import Mtlstats.Control.EditPlayer
|
||||
import Mtlstats.Control.GoalieInput
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Control.EditStandings
|
||||
import Mtlstats.Control.NewGame
|
||||
import Mtlstats.Control.TitleScreen
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Reads the program state and returs the apropriate controller to
|
||||
-- run
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
NewGame gs
|
||||
| null $ gs^.gameYear -> gameYearC
|
||||
| null $ gs^.gameMonth -> gameMonthC
|
||||
| null $ gs^.gameDay -> gameDayC
|
||||
| null $ gs^.gameType -> gameTypeC
|
||||
| null $ gs^.otherTeam -> otherTeamC
|
||||
| null $ gs^.homeScore -> homeScoreC
|
||||
| null $ gs^.awayScore -> awayScoreC
|
||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
||||
| not $ gs^.dataVerified -> verifyDataC
|
||||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
||||
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
|
||||
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
|
||||
| not $ gs^.gameGoalieAssigned -> goalieInput s
|
||||
| otherwise -> reportC
|
||||
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
|
||||
TitleScreen -> titleScreenC
|
||||
MainMenu -> mainMenuC s
|
||||
NewSeason flag -> newSeasonC flag
|
||||
NewGame gs -> newGameC gs
|
||||
EditMenu -> editMenuC
|
||||
CreatePlayer cps -> createPlayerC cps
|
||||
CreateGoalie cgs -> createGoalieC cgs
|
||||
EditPlayer eps -> editPlayerC eps
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
(EditStandings esm) -> editStandingsC esm
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
mainMenuC :: ProgState -> Controller
|
||||
mainMenuC s = if null $ s^.dbName
|
||||
then promptController getDBPrompt
|
||||
else Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
newSeasonC :: Controller
|
||||
newSeasonC = Controller
|
||||
{ drawController = const $ drawMenu newSeasonMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler newSeasonMenu e
|
||||
return True
|
||||
}
|
||||
newSeasonC :: Bool -> Controller
|
||||
newSeasonC False = promptController newSeasonPrompt
|
||||
newSeasonC True = menuController newSeasonMenu
|
||||
|
||||
gameYearC :: Controller
|
||||
gameYearC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameYearPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameYearPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameMonthMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameMonthMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
gameDayC :: Controller
|
||||
gameDayC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameDayPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameDayPrompt e
|
||||
modify validateGameDate
|
||||
return True
|
||||
}
|
||||
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameTypeMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameTypeMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt otherTeamPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler otherTeamPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt homeScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler homeScorePrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt awayScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler awayScorePrompt e
|
||||
modify overtimeCheck
|
||||
return True
|
||||
}
|
||||
|
||||
overtimeFlagC :: Controller
|
||||
overtimeFlagC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
||||
C.drawString "Is the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> do
|
||||
modify $ progMode.gameStateL.dataVerified .~ True
|
||||
modify updateGameStats
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
goalInput gs
|
||||
| null (gs^.goalBy ) = recordGoalC
|
||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||
| otherwise = confirmGoalDataC
|
||||
|
||||
recordGoalC :: Controller
|
||||
recordGoalC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal) = gameGoal s
|
||||
in drawPrompt (recordGoalPrompt game goal) s
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
recordAssistC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal, assist) = gameGoalAssist s
|
||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||
, handleController = \e -> do
|
||||
(game, goal, assist) <- gets gameGoalAssist
|
||||
promptHandler (recordAssistPrompt game goal assist) e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmGoalDataC :: Controller
|
||||
confirmGoalDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
(game, goal) = gameGoal s
|
||||
gs = s^.progMode.gameStateL
|
||||
players = s^.database.dbPlayers
|
||||
msg = unlines $
|
||||
[ " Game: " ++ padNum 2 game
|
||||
, " Goal: " ++ show goal
|
||||
, "Goal scored by: " ++
|
||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||
] ++
|
||||
map
|
||||
(\pid -> " Assisted by: " ++
|
||||
playerSummary (fromJust $ nth pid players))
|
||||
(gs^.assistsBy) ++
|
||||
[ ""
|
||||
, "Is the above information correct? (Y/N)"
|
||||
]
|
||||
C.drawString msg
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify recordGoalAssists
|
||||
Just False -> modify resetGoalData
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(report (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
C.EventSpecialKey _ -> modify backHome
|
||||
C.EventCharacter _ -> modify backHome
|
||||
_ -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
|
||||
getPlayerNumC :: Controller
|
||||
getPlayerNumC = Controller
|
||||
{ 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
|
||||
}
|
||||
|
||||
gameGoal :: ProgState -> (Int, Int)
|
||||
gameGoal s =
|
||||
( s^.database.dbGames
|
||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||
)
|
||||
|
||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||
gameGoalAssist s = let
|
||||
(game, goal) = gameGoal s
|
||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||
in (game, goal, assist)
|
||||
editMenuC :: Controller
|
||||
editMenuC = menuController editMenu
|
||||
|
||||
107
src/Mtlstats/Control/CreateGoalie.hs
Normal file
107
src/Mtlstats/Control/CreateGoalie.hs
Normal 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
|
||||
}
|
||||
112
src/Mtlstats/Control/CreatePlayer.hs
Normal file
112
src/Mtlstats/Control/CreatePlayer.hs
Normal 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
|
||||
}
|
||||
180
src/Mtlstats/Control/EditGoalie.hs
Normal file
180
src/Mtlstats/Control/EditGoalie.hs
Normal file
@@ -0,0 +1,180 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditGoalie
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.EditGoalie
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Controller/dispatcher for editing a 'Goalie'
|
||||
editGoalieC :: EditGoalieState -> Controller
|
||||
editGoalieC egs
|
||||
| null $ egs^.egsSelectedGoalie = selectC
|
||||
| otherwise = editC (egs^.egsCallback) (egs^.egsMode)
|
||||
|
||||
selectC :: Controller
|
||||
selectC = promptController goalieToEditPrompt
|
||||
|
||||
editC :: Action () -> EditGoalieMode -> Controller
|
||||
editC cb =
|
||||
( \case
|
||||
EGMenu -> menuC
|
||||
EGNumber -> numberC
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGDelete -> deleteC
|
||||
EGYtdGames b -> ytdGamesC b
|
||||
EGYtdMins b -> ytdMinsC b
|
||||
EGYtdGoals b -> ytdGoalsC b
|
||||
EGYtdShutouts b -> ytdShutoutsC b
|
||||
EGYtdWins b -> ytdWinsC b
|
||||
EGYtdLosses b -> ytdLossesC b
|
||||
EGYtdTies -> ytdTiesC
|
||||
EGLtGames b -> ltGamesC b
|
||||
EGLtMins b -> ltMinsC b
|
||||
EGLtGoals b -> ltGoalsC b
|
||||
EGLtShutouts b -> ltShutoutsC b
|
||||
EGLtWins b -> ltWinsC b
|
||||
EGLtLosses b -> ltLossesC b
|
||||
EGLtTies -> ltTiesC
|
||||
) <*> return cb
|
||||
|
||||
menuC :: Action () -> Controller
|
||||
menuC _ = menuControllerWith header editGoalieMenu
|
||||
|
||||
numberC :: Action () -> Controller
|
||||
numberC = promptController . editGoalieNumberPrompt
|
||||
|
||||
nameC :: Action () -> Controller
|
||||
nameC = promptController . editGoalieNamePrompt
|
||||
|
||||
ytdMenuC :: Action () -> Controller
|
||||
ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
|
||||
|
||||
lifetimeMenuC :: Action () -> Controller
|
||||
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
|
||||
|
||||
deleteC :: Action () -> Controller
|
||||
deleteC _ = Controller
|
||||
|
||||
{ drawController = \s -> do
|
||||
|
||||
C.drawString $ let
|
||||
|
||||
hdr = fromMaybe [] $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
goalie <- nth gid $ s^.database.dbGoalies
|
||||
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
|
||||
|
||||
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
|
||||
|
||||
return C.CursorInvisible
|
||||
|
||||
, handleController = \e -> do
|
||||
|
||||
case ynHandler e of
|
||||
|
||||
Just True -> do
|
||||
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
|
||||
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
|
||||
modify edit
|
||||
|
||||
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
|
||||
Nothing -> return ()
|
||||
|
||||
return True
|
||||
|
||||
}
|
||||
|
||||
ytdGamesC :: Bool -> Action () -> Controller
|
||||
ytdGamesC = curry $ promptController .
|
||||
uncurry editGoalieYtdGamesPrompt
|
||||
|
||||
ytdMinsC :: Bool -> Action () -> Controller
|
||||
ytdMinsC = curry $ promptController .
|
||||
uncurry editGoalieYtdMinsPrompt
|
||||
|
||||
ytdGoalsC :: Bool -> Action () -> Controller
|
||||
ytdGoalsC = curry $ promptController .
|
||||
uncurry editGoalieYtdGoalsPrompt
|
||||
|
||||
ytdShutoutsC :: Bool -> Action () -> Controller
|
||||
ytdShutoutsC = curry $ promptController .
|
||||
uncurry editGoalieYtdShutoutsPrompt
|
||||
|
||||
ytdWinsC :: Bool -> Action () -> Controller
|
||||
ytdWinsC = curry $ promptController .
|
||||
uncurry editGoalieYtdWinsPrompt
|
||||
|
||||
ytdLossesC :: Bool -> Action () -> Controller
|
||||
ytdLossesC = curry $ promptController .
|
||||
uncurry editGoalieYtdLossesPrompt
|
||||
|
||||
ytdTiesC :: Action () -> Controller
|
||||
ytdTiesC = promptController . editGoalieYtdTiesPrompt
|
||||
|
||||
ltGamesC :: Bool -> Action () -> Controller
|
||||
ltGamesC = curry $ promptController .
|
||||
uncurry editGoalieLtGamesPrompt
|
||||
|
||||
ltMinsC :: Bool -> Action () -> Controller
|
||||
ltMinsC = curry $ promptController .
|
||||
uncurry editGoalieLtMinsPrompt
|
||||
|
||||
ltGoalsC :: Bool -> Action() -> Controller
|
||||
ltGoalsC = curry $ promptController .
|
||||
uncurry editGoalieLtGoalsPrompt
|
||||
|
||||
ltShutoutsC :: Bool -> Action () -> Controller
|
||||
ltShutoutsC = curry $ promptController .
|
||||
uncurry editGoalieLtShutoutsPrompt
|
||||
|
||||
ltWinsC :: Bool -> Action () -> Controller
|
||||
ltWinsC = curry $ promptController .
|
||||
uncurry editGoalieLtWinsPrompt
|
||||
|
||||
ltLossesC :: Bool -> Action () -> Controller
|
||||
ltLossesC = curry $ promptController .
|
||||
uncurry editGoalieLtLossesPrompt
|
||||
|
||||
ltTiesC :: Action () -> Controller
|
||||
ltTiesC = promptController . editGoalieLtTiesPrompt
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
g <- nth gid $ s^.database.dbGoalies
|
||||
Just $ goalieDetails g ++ "\n"
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,11 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditPlayer
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.EditPlayer
|
||||
import Mtlstats.Types
|
||||
@@ -35,109 +40,100 @@ 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
|
||||
EPYtdGoals -> ytdGoalsC
|
||||
EPYtdAssists -> ytdAssistsC
|
||||
EPYtdPMin -> ytdPMinC
|
||||
EPLtGoals -> ltGoalsC
|
||||
EPLtAssists -> ltAssistsC
|
||||
EPLtPMin -> ltPMinC
|
||||
| otherwise =
|
||||
( case eps^.epsMode of
|
||||
EPMenu -> menuC
|
||||
EPNumber -> numberC
|
||||
EPName -> nameC
|
||||
EPPosition -> positionC
|
||||
EPYtd -> ytdC
|
||||
EPLifetime -> lifetimeC
|
||||
EPDelete -> deleteC
|
||||
EPYtdGoals b -> ytdGoalsC b
|
||||
EPYtdAssists b -> ytdAssistsC b
|
||||
EPYtdPMin -> ytdPMinC
|
||||
EPLtGoals b -> ltGoalsC b
|
||||
EPLtAssists b -> ltAssistsC b
|
||||
EPLtPMin -> ltPMinC
|
||||
) $ eps^.epsCallback
|
||||
|
||||
selectPlayerC :: Controller
|
||||
selectPlayerC = Controller
|
||||
{ drawController = drawPrompt playerToEditPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler playerToEditPrompt e
|
||||
return True
|
||||
}
|
||||
selectPlayerC = promptController playerToEditPrompt
|
||||
|
||||
menuC :: Action () -> Controller
|
||||
menuC _ = menuControllerWith header editPlayerMenu
|
||||
|
||||
numberC :: Action () -> Controller
|
||||
numberC = promptController . editPlayerNumPrompt
|
||||
|
||||
nameC :: Action () -> Controller
|
||||
nameC = promptController . editPlayerNamePrompt
|
||||
|
||||
positionC :: Action () -> Controller
|
||||
positionC = promptController . editPlayerPosPrompt
|
||||
|
||||
ytdC :: Action () -> Controller
|
||||
ytdC _ = menuControllerWith header editPlayerYtdMenu
|
||||
|
||||
lifetimeC :: Action () -> Controller
|
||||
lifetimeC _ = menuControllerWith header editPlayerLtMenu
|
||||
|
||||
deleteC :: Action () -> Controller
|
||||
deleteC _ = Controller
|
||||
|
||||
menuC :: Controller
|
||||
menuC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
header = fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails p ++ "\n"
|
||||
C.drawString header
|
||||
drawMenu editPlayerMenu
|
||||
|
||||
C.drawString $ let
|
||||
|
||||
hdr = fromMaybe [] $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ "Player: " ++ playerDetails player ++ "\n\n"
|
||||
|
||||
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
|
||||
|
||||
return C.CursorInvisible
|
||||
|
||||
, handleController = \e -> do
|
||||
menuHandler editPlayerMenu e
|
||||
|
||||
case ynHandler e of
|
||||
|
||||
Just True -> do
|
||||
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
|
||||
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
|
||||
modify edit
|
||||
|
||||
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
|
||||
Nothing -> return ()
|
||||
|
||||
return True
|
||||
|
||||
}
|
||||
|
||||
numberC :: Controller
|
||||
numberC = Controller
|
||||
{ drawController = drawPrompt editPlayerNumPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNumPrompt e
|
||||
return True
|
||||
}
|
||||
ytdGoalsC :: Bool -> Action () -> Controller
|
||||
ytdGoalsC batchMode callback = promptController $
|
||||
editPlayerYtdGoalsPrompt batchMode callback
|
||||
|
||||
nameC :: Controller
|
||||
nameC = Controller
|
||||
{ drawController = drawPrompt editPlayerNamePrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNamePrompt e
|
||||
return True
|
||||
}
|
||||
ytdAssistsC :: Bool -> Action () -> Controller
|
||||
ytdAssistsC batchMode callback = promptController $
|
||||
editPlayerYtdAssistsPrompt batchMode callback
|
||||
|
||||
positionC :: Controller
|
||||
positionC = Controller
|
||||
{ drawController = drawPrompt editPlayerPosPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerPosPrompt e
|
||||
return True
|
||||
}
|
||||
ytdPMinC :: Action () -> Controller
|
||||
ytdPMinC = promptController . editPlayerYtdPMinPrompt
|
||||
|
||||
ytdGoalsC :: Controller
|
||||
ytdGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
ltGoalsC :: Bool -> Action () -> Controller
|
||||
ltGoalsC batchMode callback = promptController $
|
||||
editPlayerLtGoalsPrompt batchMode callback
|
||||
|
||||
ytdAssistsC :: Controller
|
||||
ytdAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
ltAssistsC :: Bool -> Action () -> Controller
|
||||
ltAssistsC batchMode callback = promptController $
|
||||
editPlayerLtAssistsPrompt batchMode callback
|
||||
|
||||
ytdPMinC :: Controller
|
||||
ytdPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdPMinPrompt e
|
||||
return True
|
||||
}
|
||||
ltPMinC :: Action () -> Controller
|
||||
ltPMinC = promptController . editPlayerLtPMinPrompt
|
||||
|
||||
ltGoalsC :: Controller
|
||||
ltGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
ltAssistsC :: Controller
|
||||
ltAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
ltPMinC :: Controller
|
||||
ltPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtPMinPrompt e
|
||||
return True
|
||||
}
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails player ++ "\n"
|
||||
|
||||
87
src/Mtlstats/Control/EditStandings.hs
Normal file
87
src/Mtlstats/Control/EditStandings.hs
Normal 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
|
||||
]
|
||||
239
src/Mtlstats/Control/NewGame.hs
Normal file
239
src/Mtlstats/Control/NewGame.hs
Normal file
@@ -0,0 +1,239 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Control.NewGame (newGameC) where
|
||||
|
||||
import Control.Monad.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
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.NewGame
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Dispatcher for a new game
|
||||
newGameC :: GameState -> Controller
|
||||
newGameC gs
|
||||
| null $ gs^.gameYear = gameYearC
|
||||
| null $ gs^.gameMonth = gameMonthC
|
||||
| null $ gs^.gameDay = gameDayC
|
||||
| null $ gs^.gameType = gameTypeC
|
||||
| null $ gs^.otherTeam = otherTeamC
|
||||
| null $ gs^.homeScore = homeScoreC
|
||||
| null $ gs^.awayScore = awayScoreC
|
||||
| null $ gs^.overtimeFlag = overtimeFlagC
|
||||
| not $ gs^.dataVerified = verifyDataC
|
||||
| fromJust (unaccountedPoints gs) = goalInput gs
|
||||
| isJust $ gs^.gameSelectedPlayer = getPMinsC
|
||||
| not $ gs^.gamePMinsRecorded = pMinPlayerC
|
||||
| not $ gs^.gameGoalieAssigned = goalieInputC gs
|
||||
| otherwise = reportC
|
||||
|
||||
gameYearC :: Controller
|
||||
gameYearC = promptControllerWith header gameYearPrompt
|
||||
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = menuControllerWith header gameMonthMenu
|
||||
|
||||
gameDayC :: Controller
|
||||
gameDayC = promptControllerWith header gameDayPrompt
|
||||
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = menuControllerWith header gameTypeMenu
|
||||
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = promptControllerWith header otherTeamPrompt
|
||||
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = promptControllerWith header homeScorePrompt
|
||||
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = promptControllerWith header awayScorePrompt
|
||||
|
||||
overtimeFlagC :: Controller
|
||||
overtimeFlagC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ unlines $ labelTable
|
||||
[ ( "Date", gameDate gs )
|
||||
, ( "Game type", show $ fromJust $ gs^.gameType )
|
||||
, ( "Other team", gs^.otherTeam )
|
||||
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
||||
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
||||
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
||||
]
|
||||
C.drawString "\nIs the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify
|
||||
$ (progMode.gameStateL.dataVerified .~ True)
|
||||
. updateGameStats
|
||||
. awardShutouts
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
goalInput gs
|
||||
| null (gs^.goalBy ) = recordGoalC
|
||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||
| otherwise = confirmGoalDataC
|
||||
|
||||
recordGoalC :: Controller
|
||||
recordGoalC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal) = gameGoal s
|
||||
in drawPrompt (recordGoalPrompt game goal) s
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
recordAssistC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal, assist) = gameGoalAssist s
|
||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||
, handleController = \e -> do
|
||||
(game, goal, assist) <- gets gameGoalAssist
|
||||
promptHandler (recordAssistPrompt game goal assist) e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmGoalDataC :: Controller
|
||||
confirmGoalDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
(game, goal) = gameGoal s
|
||||
gs = s^.progMode.gameStateL
|
||||
players = s^.database.dbPlayers
|
||||
msg = unlines $
|
||||
[ " Game: " ++ padNum 2 game
|
||||
, " Goal: " ++ show goal
|
||||
, "Goal scored by: " ++
|
||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||
] ++
|
||||
map
|
||||
(\pid -> " Assisted by: " ++
|
||||
playerSummary (fromJust $ nth pid players))
|
||||
(gs^.assistsBy) ++
|
||||
[ ""
|
||||
, "Is the above information correct? (Y/N)"
|
||||
]
|
||||
C.drawString msg
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify recordGoalAssists
|
||||
Just False -> modify resetGoalData
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(displayReport (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
|
||||
C.EventCharacter '\n' -> do
|
||||
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
||||
modify backHome
|
||||
|
||||
_ -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
|
||||
gameGoal :: ProgState -> (Int, Int)
|
||||
gameGoal s =
|
||||
( s^.database.dbGames
|
||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||
)
|
||||
|
||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||
gameGoalAssist s = let
|
||||
(game, goal) = gameGoal s
|
||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||
in (game, goal, assist)
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Control.GoalieInput (goalieInput) where
|
||||
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
@@ -28,21 +28,17 @@ import qualified UI.NCurses as C
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.GoalieInput
|
||||
import Mtlstats.Prompt.NewGame.GoalieInput
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | The dispatcher for handling goalie input
|
||||
goalieInput :: ProgState -> Controller
|
||||
goalieInput s = let
|
||||
gs = s^.progMode.gameStateL
|
||||
in if gs^.gameGoaliesRecorded
|
||||
then selectGameGoalieC s
|
||||
else if null $ gs^.gameSelectedGoalie
|
||||
then selectGoalieC
|
||||
else if null $ gs^.gameGoalieMinsPlayed
|
||||
then minsPlayedC
|
||||
else goalsAllowedC
|
||||
goalieInputC :: GameState -> Controller
|
||||
goalieInputC gs
|
||||
| gs^.gameGoaliesRecorded = selectGameGoalieC
|
||||
| null $ gs^.gameSelectedGoalie = selectGoalieC
|
||||
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
|
||||
| otherwise = goalsAllowedC
|
||||
|
||||
selectGoalieC :: Controller
|
||||
selectGoalieC = promptController selectGameGoaliePrompt
|
||||
@@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
|
||||
goalsAllowedC :: Controller
|
||||
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
||||
|
||||
selectGameGoalieC :: ProgState -> Controller
|
||||
selectGameGoalieC = menuController . gameGoalieMenu
|
||||
selectGameGoalieC :: Controller
|
||||
selectGameGoalieC = menuStateController gameGoalieMenu
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ unlines
|
||||
142
src/Mtlstats/Control/TitleScreen.hs
Normal file
142
src/Mtlstats/Control/TitleScreen.hs
Normal 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 =
|
||||
[ " >##< "
|
||||
, " ## "
|
||||
, " >##< "
|
||||
, " #### "
|
||||
, " >#<>#< "
|
||||
, " ###### "
|
||||
, ">#< >#<"
|
||||
, "### ###"
|
||||
]
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,15 +19,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Format
|
||||
( padNum
|
||||
, left
|
||||
, right
|
||||
, centre
|
||||
, padRight
|
||||
, overlay
|
||||
, month
|
||||
, labelTable
|
||||
, numTable
|
||||
, tableWith
|
||||
, complexTable
|
||||
, overlayLast
|
||||
, showFloating
|
||||
) where
|
||||
|
||||
import Data.List (transpose)
|
||||
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
||||
padNum
|
||||
:: Int
|
||||
@@ -75,6 +88,16 @@ centre n str = let
|
||||
pad = replicate pLen ' '
|
||||
in take n $ pad ++ str ++ repeat ' '
|
||||
|
||||
-- | Pads text on the right with spaces to fit a minimum width
|
||||
padRight
|
||||
:: Int
|
||||
-- ^ The width to pad to
|
||||
-> String
|
||||
-- ^ The text to pad
|
||||
-> String
|
||||
padRight width str =
|
||||
overlay str $ replicate width ' '
|
||||
|
||||
-- | Overlays one string on top of another
|
||||
overlay
|
||||
:: String
|
||||
@@ -101,3 +124,84 @@ month 10 = "OCT"
|
||||
month 11 = "NOV"
|
||||
month 12 = "DEC"
|
||||
month _ = ""
|
||||
|
||||
-- | Creates a two-column table with labels
|
||||
labelTable :: [(String, String)] -> [String]
|
||||
labelTable xs = let
|
||||
labelWidth = maximum $ map (length . fst) xs
|
||||
in map
|
||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
||||
xs
|
||||
|
||||
-- | Creates a variable column table of numbers with two axes
|
||||
numTable
|
||||
:: [String]
|
||||
-- ^ The top column labels
|
||||
-> [(String, [Int])]
|
||||
-- ^ The rows with their labels
|
||||
-> [String]
|
||||
numTable headers rows = tableWith right $ header : body
|
||||
where
|
||||
header = "" : headers
|
||||
body = map
|
||||
(\(label, row) ->
|
||||
label : map show row)
|
||||
rows
|
||||
|
||||
-- | Creates a table from a two-dimensional list with a specified
|
||||
-- padding function
|
||||
tableWith
|
||||
:: (Int -> String -> String)
|
||||
-- ^ The padding function
|
||||
-> [[String]]
|
||||
-- ^ The cells
|
||||
-> [String]
|
||||
tableWith pFunc tData = complexTable
|
||||
(repeat pFunc)
|
||||
(map (map CellText) tData)
|
||||
|
||||
-- | Creates a complex table
|
||||
complexTable
|
||||
:: [Int -> String -> String]
|
||||
-- ^ The padding function for each column
|
||||
-> [[TableCell]]
|
||||
-- ^ The table cells (an array of rows)
|
||||
-> [String]
|
||||
complexTable pFuncs tData = let
|
||||
widths = map
|
||||
(map $ \case
|
||||
CellText str -> length str
|
||||
CellFill _ -> 0)
|
||||
tData
|
||||
colWidths = map maximum $ transpose widths
|
||||
|
||||
bFunc = \case
|
||||
[] -> ""
|
||||
[(f, len, CellText str)] -> f len str
|
||||
[(_, len, CellFill ch)] -> replicate len ch
|
||||
(f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
|
||||
(_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells
|
||||
|
||||
in map
|
||||
(bFunc . zip3 pFuncs colWidths)
|
||||
tData
|
||||
|
||||
-- | Places an overlay on the last line of an report
|
||||
overlayLast
|
||||
:: String
|
||||
-- ^ The text to overlay
|
||||
-> [String]
|
||||
-- ^ The report to modify
|
||||
-> [String]
|
||||
-- ^ The resulting report
|
||||
overlayLast _ [] = []
|
||||
overlayLast str [l] = [overlay str l]
|
||||
overlayLast str (l:ls) = l : overlayLast str ls
|
||||
|
||||
-- | Converts a non-integer into a string
|
||||
showFloating :: RealFrac n => n -> String
|
||||
showFloating n = let
|
||||
i = round $ n * 100
|
||||
whole = i `div` 100
|
||||
fraction = i `mod` 100
|
||||
in show whole ++ "." ++ padNum 2 fraction
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
62
src/Mtlstats/Helpers/Goalie.hs
Normal file
62
src/Mtlstats/Helpers/Goalie.hs
Normal file
@@ -0,0 +1,62 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Goalie (goalieDetails, goalieName) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed 'String' describing a 'Goalie'
|
||||
goalieDetails :: Goalie -> String
|
||||
goalieDetails g = let
|
||||
header = unlines $ labelTable
|
||||
[ ( "Number", show $ g^.gNumber )
|
||||
, ( "Name", goalieName g )
|
||||
]
|
||||
|
||||
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
|
||||
[ ( "Games played", gsGames )
|
||||
, ( "Mins played", gsMinsPlayed )
|
||||
, ( "Goals allowed", gsGoalsAllowed )
|
||||
, ( "Shutouts", gsShutouts )
|
||||
, ( "Wins", gsWins )
|
||||
, ( "Losses", gsLosses )
|
||||
, ( "Ties", gsTies )
|
||||
]
|
||||
|
||||
in header ++ "\n" ++ body
|
||||
|
||||
-- | Returns the goalie name, modified if they are a rookie
|
||||
goalieName :: Goalie -> String
|
||||
goalieName g = let
|
||||
|
||||
prefix = if g^.gActive
|
||||
then ""
|
||||
else "*"
|
||||
|
||||
suffix = if g^.gRookie
|
||||
then "*"
|
||||
else ""
|
||||
|
||||
in prefix ++ g^.gName ++ suffix
|
||||
60
src/Mtlstats/Helpers/Player.hs
Normal file
60
src/Mtlstats/Helpers/Player.hs
Normal file
@@ -0,0 +1,60 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Player (playerDetails, playerName) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines $ top ++ [""] ++ table
|
||||
where
|
||||
top = labelTable
|
||||
[ ( "Number", show $ p^.pNumber )
|
||||
, ( "Name", playerName p )
|
||||
, ( "Position", p^.pPosition )
|
||||
]
|
||||
|
||||
table = numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) ->
|
||||
(label, [p^.pYtd.lens, p^.pLifetime.lens]))
|
||||
[ ( "Goals", psGoals )
|
||||
, ( "Assists", psAssists )
|
||||
, ( "Penalty mins", psPMin )
|
||||
]
|
||||
|
||||
-- | Presents a modified version of the player's name indicating
|
||||
-- whether or not they're a rookie
|
||||
playerName :: Player -> String
|
||||
playerName p = let
|
||||
|
||||
prefix = if p^.pActive
|
||||
then ""
|
||||
else "*"
|
||||
|
||||
suffix = if p^.pRookie
|
||||
then "*"
|
||||
else ""
|
||||
|
||||
in prefix ++ p^.pName ++ suffix
|
||||
89
src/Mtlstats/Helpers/Position.hs
Normal file
89
src/Mtlstats/Helpers/Position.hs
Normal 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
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -22,6 +22,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Menu (
|
||||
-- * Menu Functions
|
||||
menuController,
|
||||
menuControllerWith,
|
||||
menuStateController,
|
||||
drawMenu,
|
||||
menuHandler,
|
||||
-- * Menus
|
||||
@@ -29,45 +31,69 @@ module Mtlstats.Menu (
|
||||
newSeasonMenu,
|
||||
gameMonthMenu,
|
||||
gameTypeMenu,
|
||||
editPlayerMenu,
|
||||
gameGoalieMenu
|
||||
gameGoalieMenu,
|
||||
editMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Aeson (encodeFile)
|
||||
import Data.Char (toUpper)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Lens.Micro ((^.), (.~), (?~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import System.EasyFile
|
||||
( createDirectoryIfMissing
|
||||
, getAppUserDataDirectory
|
||||
, (</>)
|
||||
)
|
||||
import Lens.Micro ((^.), (?~))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import qualified Mtlstats.Actions.GoalieInput as GI
|
||||
import Mtlstats.Config
|
||||
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||
import Mtlstats.Actions.EditStandings
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Generates a simple 'Controller' for a Menu
|
||||
menuController :: Menu () -> Controller
|
||||
menuController menu = Controller
|
||||
{ drawController = const $ drawMenu menu
|
||||
menuController = menuControllerWith $ const $ return ()
|
||||
|
||||
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||
menuControllerWith
|
||||
:: (ProgState -> C.Update ())
|
||||
-- ^ Generates the header
|
||||
-> Menu ()
|
||||
-- ^ The menu
|
||||
-> Controller
|
||||
-- ^ The resulting controller
|
||||
menuControllerWith header menu = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu menu
|
||||
, handleController = \e -> do
|
||||
menuHandler menu e
|
||||
return True
|
||||
}
|
||||
|
||||
-- | Generate and create a controller for a menu based on the current
|
||||
-- 'ProgState'
|
||||
menuStateController
|
||||
:: (ProgState -> Menu ())
|
||||
-- ^ The function to generate the menu
|
||||
-> Controller
|
||||
-- ^ The resulting controller
|
||||
menuStateController menuFunc = Controller
|
||||
{ drawController = drawMenu . menuFunc
|
||||
, handleController = \e -> do
|
||||
menu <- gets menuFunc
|
||||
menuHandler menu e
|
||||
return True
|
||||
}
|
||||
|
||||
-- | The draw function for a 'Menu'
|
||||
drawMenu :: Menu a -> C.Update C.CursorMode
|
||||
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'
|
||||
@@ -80,84 +106,59 @@ 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' "Create Player" $
|
||||
modify createPlayer >> return True
|
||||
, MenuItem '4' "Create Goalie" $
|
||||
modify createGoalie >> return True
|
||||
, MenuItem '5' "Edit Player" $
|
||||
modify editPlayer >> return True
|
||||
, MenuItem '6' "Exit" $ do
|
||||
db <- gets $ view database
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> dbFname
|
||||
createDirectoryIfMissing True dir
|
||||
encodeFile dbFile db
|
||||
return False
|
||||
, MenuItem 'C' "EDIT MENU" $
|
||||
modify edit >> return True
|
||||
, MenuItem 'E' "EXIT" $
|
||||
saveDatabase >> return False
|
||||
]
|
||||
|
||||
-- | The new season menu
|
||||
newSeasonMenu :: Menu ()
|
||||
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
||||
[ MenuItem '1' "Regular Season" $ do
|
||||
modify resetYtd
|
||||
modify startNewGame
|
||||
, MenuItem '2' "Playoffs" $
|
||||
modify startNewGame
|
||||
newSeasonMenu = Menu "SEASON TYPE" ()
|
||||
[ MenuItem 'R' "REGULAR SEASON" $ modify
|
||||
$ resetYtd
|
||||
. clearRookies
|
||||
. resetStandings
|
||||
. startNewGame
|
||||
, 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
|
||||
]
|
||||
|
||||
-- | The player edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
||||
Nothing -> modify $ progMode .~ MainMenu
|
||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
||||
[ ( '1', "Change number", Just EPNumber )
|
||||
, ( '2', "Change name", Just EPName )
|
||||
, ( '3', "Change position", Just EPPosition )
|
||||
, ( '4', "YTD goals", Just EPYtdGoals )
|
||||
, ( '5', "YTD assists", Just EPYtdAssists )
|
||||
, ( '6', "YTD penalty mins", Just EPYtdPMin )
|
||||
, ( '7', "Lifetime goals", Just EPLtGoals )
|
||||
, ( '8', "Lifetime assists", Just EPLtAssists )
|
||||
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
|
||||
, ( '0', "Finished editing", Nothing )
|
||||
]
|
||||
|
||||
-- | Game goalie selection menu
|
||||
gameGoalieMenu :: ProgState -> Menu ()
|
||||
gameGoalieMenu s = let
|
||||
@@ -168,7 +169,25 @@ gameGoalieMenu s = let
|
||||
goalie <- nth n $ s^.database.dbGoalies
|
||||
Just (n, goalie))
|
||||
gids
|
||||
in Menu title () $ map
|
||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
||||
modify $ GI.setGameGoalie gid) $
|
||||
zip ['1'..] goalies
|
||||
in Menu title () $ zipWith
|
||||
(\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
|
||||
modify $ GI.setGameGoalie gid)
|
||||
['1'..]
|
||||
goalies
|
||||
|
||||
-- | The edit menu
|
||||
editMenu :: Menu ()
|
||||
editMenu = Menu "EDIT MENU" ()
|
||||
[ MenuItem 'A' "CREATE PLAYER" $
|
||||
modify createPlayer
|
||||
, MenuItem 'B' "CREATE GOALIE" $
|
||||
modify createGoalie
|
||||
, MenuItem 'C' "EDIT PLAYER" $
|
||||
modify editPlayer
|
||||
, MenuItem 'D' "EDIT GOALIE" $
|
||||
modify editGoalie
|
||||
, MenuItem 'E' "EDIT STANDINGS" $
|
||||
modify editStandings
|
||||
, MenuItem 'R' "RETURN TO MAIN MENU" $
|
||||
modify backHome
|
||||
]
|
||||
|
||||
90
src/Mtlstats/Menu/EditGoalie.hs
Normal file
90
src/Mtlstats/Menu/EditGoalie.hs
Normal file
@@ -0,0 +1,90 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Menu.EditGoalie
|
||||
( editGoalieMenu
|
||||
, editGoalieYtdMenu
|
||||
, editGoalieLtMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~), (%~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Goalie' edit menu
|
||||
editGoalieMenu :: Menu ()
|
||||
editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||
|
||||
-- key, label, value
|
||||
[ ( 'A', "NUMBER", set EGNumber )
|
||||
, ( 'B', "NAME", set EGName )
|
||||
, ( 'C', "ROOKIE FLAG", toggleRookie )
|
||||
, ( 'D', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'E', "YTD STATS", set EGYtd )
|
||||
, ( 'F', "LIFETIME STATS", set EGLifetime )
|
||||
, ( 'G', "DELETE RECORD", set EGDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
where
|
||||
set mode = progMode.editGoalieStateL.egsMode .~ mode
|
||||
toggleRookie = editSelectedGoalie (gRookie %~ not)
|
||||
toggleActive = editSelectedGoalie (gActive %~ not)
|
||||
|
||||
-- | The 'Goalie' YTD edit menu
|
||||
editGoalieYtdMenu :: Menu ()
|
||||
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
||||
-- key, label, value
|
||||
[ ( '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
|
||||
[ ( '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 ()
|
||||
editMenu title = Menu title () . map
|
||||
(\(key, label, val) -> MenuItem key label $
|
||||
modify $ progMode.editGoalieStateL.egsMode .~ val)
|
||||
84
src/Mtlstats/Menu/EditPlayer.hs
Normal file
84
src/Mtlstats/Menu/EditPlayer.hs
Normal file
@@ -0,0 +1,84 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Menu.EditPlayer
|
||||
( editPlayerMenu
|
||||
, editPlayerYtdMenu
|
||||
, editPlayerLtMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~), (%~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Player' edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||
|
||||
-- key, label, value
|
||||
[ ( 'A', "NUMBER", set EPNumber )
|
||||
, ( 'B', "NAME", set EPName )
|
||||
, ( 'C', "POSITION", set EPPosition )
|
||||
, ( 'D', "ROOKIE FLAG", toggleRookie )
|
||||
, ( 'E', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'F', "YTD STATS", set EPYtd )
|
||||
, ( 'G', "LIFETIME STATS", set EPLifetime )
|
||||
, ( 'H', "DELETE RECORD", set EPDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
where
|
||||
set mode = progMode.editPlayerStateL.epsMode .~ mode
|
||||
toggleRookie = editSelectedPlayer $ pRookie %~ not
|
||||
toggleActive = editSelectedPlayer $ pActive %~ not
|
||||
|
||||
-- | The 'Player' YTD stats edit menu
|
||||
editPlayerYtdMenu :: Menu ()
|
||||
editPlayerYtdMenu = editMenu
|
||||
"EDIT PLAYER YEAR-TO-DATE"
|
||||
-- key, label, value
|
||||
[ ( '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"
|
||||
-- key, label, value
|
||||
[ ( '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 ()
|
||||
editMenu title = Menu title () . map
|
||||
(\(key, label, val) -> MenuItem key label $
|
||||
modify $ progMode.editPlayerStateL.epsMode .~ val)
|
||||
64
src/Mtlstats/Menu/EditStandings.hs
Normal file
64
src/Mtlstats/Menu/EditStandings.hs
Normal 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
|
||||
]
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -28,34 +28,32 @@ module Mtlstats.Prompt (
|
||||
promptControllerWith,
|
||||
promptController,
|
||||
strPrompt,
|
||||
ucStrPrompt,
|
||||
namePrompt,
|
||||
numPrompt,
|
||||
numPromptWithFallback,
|
||||
dbNamePrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
gameYearPrompt,
|
||||
gameDayPrompt,
|
||||
otherTeamPrompt,
|
||||
homeScorePrompt,
|
||||
awayScorePrompt,
|
||||
getDBPrompt,
|
||||
newSeasonPrompt,
|
||||
playerNumPrompt,
|
||||
playerNamePrompt,
|
||||
playerPosPrompt,
|
||||
goalieNumPrompt,
|
||||
goalieNamePrompt,
|
||||
selectPlayerPrompt,
|
||||
selectActivePlayerPrompt,
|
||||
selectGoaliePrompt,
|
||||
recordGoalPrompt,
|
||||
recordAssistPrompt,
|
||||
pMinPlayerPrompt,
|
||||
assignPMinsPrompt,
|
||||
selectActiveGoaliePrompt,
|
||||
selectPositionPrompt,
|
||||
playerToEditPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Extra (whenJust)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (isDigit, toUpper)
|
||||
import Data.Foldable (forM_)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Char (isAlphaNum, isDigit, toUpper)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import Text.Read (readMaybe)
|
||||
@@ -63,7 +61,7 @@ import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Helpers.Position
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
@@ -79,10 +77,8 @@ promptHandler p (C.EventCharacter '\n') = do
|
||||
val <- gets $ view inputBuffer
|
||||
modify $ inputBuffer .~ ""
|
||||
promptAction p val
|
||||
promptHandler p (C.EventCharacter c) = let
|
||||
c' = toUpper c
|
||||
in when (promptCharCheck p c') $
|
||||
modify $ addChar c'
|
||||
promptHandler p (C.EventCharacter c) =
|
||||
modify $ inputBuffer %~ promptProcessChar p c
|
||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
||||
modify removeChar
|
||||
promptHandler p (C.EventSpecialKey k) =
|
||||
@@ -122,12 +118,33 @@ strPrompt
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
strPrompt pStr act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptCharCheck = const True
|
||||
, promptAction = act
|
||||
, promptSpecialKey = const $ return ()
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptProcessChar = \ch -> (++ [ch])
|
||||
, promptAction = act
|
||||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Creates an upper case string prompt
|
||||
ucStrPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
ucStrPrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = \ch -> (++ [toUpper ch]) }
|
||||
|
||||
-- | Creates a prompt which forces capitalization of input to
|
||||
-- accomodate a player or goalie name
|
||||
namePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
namePrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = capitalizeName }
|
||||
|
||||
-- | Builds a numeric prompt
|
||||
numPrompt
|
||||
:: String
|
||||
@@ -135,13 +152,51 @@ numPrompt
|
||||
-> (Int -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
numPrompt pStr act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptCharCheck = isDigit
|
||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
||||
, promptSpecialKey = const $ return ()
|
||||
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||
|
||||
-- | Builds a numeric prompt with a fallback action
|
||||
numPromptWithFallback
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> Action ()
|
||||
-- ^ The action to call on invalid (or blank) input
|
||||
-> (Int -> Action ())
|
||||
-- ^ The callback function for the result
|
||||
-> Prompt
|
||||
numPromptWithFallback pStr fallback act = Prompt
|
||||
{ promptDrawer = drawSimplePrompt pStr
|
||||
, promptProcessChar = \ch str -> if isDigit ch
|
||||
then str ++ [ch]
|
||||
else str
|
||||
, promptAction = maybe fallback act . readMaybe
|
||||
, promptSpecialKey = const $ return ()
|
||||
}
|
||||
|
||||
-- | Prompts for a database name
|
||||
dbNamePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (String -> Action ())
|
||||
-- ^ The callback to pass the result to
|
||||
-> Prompt
|
||||
dbNamePrompt pStr act = (strPrompt pStr act)
|
||||
{ promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
|
||||
then (++[toUpper ch])
|
||||
else id
|
||||
}
|
||||
|
||||
-- | Prompts the user for a filename to save a backup of the database
|
||||
-- to
|
||||
newSeasonPrompt :: Prompt
|
||||
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
|
||||
if null fn
|
||||
then modify backHome
|
||||
else do
|
||||
saveDatabase
|
||||
modify
|
||||
$ (dbName .~ fn)
|
||||
. (progMode .~ NewSeason True)
|
||||
|
||||
-- | Builds a selection prompt
|
||||
selectPrompt :: SelectParams a -> Prompt
|
||||
selectPrompt params = Prompt
|
||||
@@ -157,7 +212,7 @@ selectPrompt params = Prompt
|
||||
in "F" ++ show n ++ ") " ++ desc)
|
||||
results
|
||||
C.moveCursor row col
|
||||
, promptCharCheck = const True
|
||||
, promptProcessChar = spProcessChar params
|
||||
, promptAction = \sStr -> if null sStr
|
||||
then spCallback params Nothing
|
||||
else do
|
||||
@@ -173,36 +228,17 @@ selectPrompt params = Prompt
|
||||
n = pred $ fromInteger rawK
|
||||
results = spSearch params sStr db
|
||||
when (n < maxFunKeys) $
|
||||
whenJust (nth n results) $ \(n, _) -> do
|
||||
whenJust (nth n results) $ \(sel, _) -> do
|
||||
modify $ inputBuffer .~ ""
|
||||
spCallback params $ Just n
|
||||
spCallback params $ Just sel
|
||||
_ -> return ()
|
||||
}
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
modify . (progMode.gameStateL.gameYear ?~)
|
||||
|
||||
-- | Prompts for the day of the month the game took place
|
||||
gameDayPrompt :: Prompt
|
||||
gameDayPrompt = numPrompt "Day of month: " $
|
||||
modify . (progMode.gameStateL.gameDay ?~)
|
||||
|
||||
-- | Prompts for the other team name
|
||||
otherTeamPrompt :: Prompt
|
||||
otherTeamPrompt = strPrompt "Other team: " $
|
||||
modify . (progMode.gameStateL.otherTeam .~)
|
||||
|
||||
-- | Prompts for the home score
|
||||
homeScorePrompt :: Prompt
|
||||
homeScorePrompt = numPrompt "Home score: " $
|
||||
modify . (progMode.gameStateL.homeScore ?~)
|
||||
|
||||
-- | Prompts for the away score
|
||||
awayScorePrompt :: Prompt
|
||||
awayScorePrompt = numPrompt "Away score: " $
|
||||
modify . (progMode.gameStateL.awayScore ?~)
|
||||
-- | Prompts for the database to load
|
||||
getDBPrompt :: Prompt
|
||||
getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
|
||||
modify $ dbName .~ fn
|
||||
loadDatabase
|
||||
|
||||
-- | Prompts for a new player's number
|
||||
playerNumPrompt :: Prompt
|
||||
@@ -211,12 +247,12 @@ playerNumPrompt = numPrompt "Player number: " $
|
||||
|
||||
-- | Prompts for a new player's name
|
||||
playerNamePrompt :: Prompt
|
||||
playerNamePrompt = strPrompt "Player name: " $
|
||||
playerNamePrompt = namePrompt "Player name: " $
|
||||
modify . (progMode.createPlayerStateL.cpsName .~)
|
||||
|
||||
-- | Prompts for a new player's position
|
||||
playerPosPrompt :: Prompt
|
||||
playerPosPrompt = strPrompt "Player position: " $
|
||||
playerPosPrompt = selectPositionPrompt "Player position: " $
|
||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||
|
||||
-- | Prompts tor the goalie's number
|
||||
@@ -226,23 +262,27 @@ goalieNumPrompt = numPrompt "Goalie number: " $
|
||||
|
||||
-- | Prompts for the goalie's name
|
||||
goalieNamePrompt :: Prompt
|
||||
goalieNamePrompt = strPrompt "Goalie name: " $
|
||||
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||
|
||||
-- | Selects a player (creating one if necessary)
|
||||
selectPlayerPrompt
|
||||
:: String
|
||||
-- | Selects a player using a specified search function (creating the
|
||||
-- player if necessary)
|
||||
selectPlayerPromptWith
|
||||
:: (String -> [Player] -> [(Int, Player)])
|
||||
-- ^ The search function
|
||||
-> String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Player select:"
|
||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||
, spSearch = \sStr db -> sFunc sStr (db^.dbPlayers)
|
||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||
, spElemDesc = playerSummary
|
||||
, spProcessChar = capitalizeName
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
@@ -257,20 +297,44 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||
modify $ progMode .~ CreatePlayer cps
|
||||
}
|
||||
|
||||
-- | Selects a goalie (creating one if necessary)
|
||||
selectGoaliePrompt
|
||||
-- | Selects a player (creating one if necessary)
|
||||
selectPlayerPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectPlayerPrompt = selectPlayerPromptWith playerSearch
|
||||
|
||||
-- | Selects an active player (creating one if necessary)
|
||||
selectActivePlayerPrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the payer as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch
|
||||
|
||||
-- | Selects a goalie with a specified search criteria (creating the
|
||||
-- goalie if necessary)
|
||||
selectGoaliePromptWith
|
||||
:: (String -> [Goalie] -> [(Int, Goalie)])
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
|
||||
{ spPrompt = pStr
|
||||
, spSearchHeader = "Goalie select:"
|
||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||
, spSearch = \sStr db -> criteria sStr (db^.dbGoalies)
|
||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||
, spElemDesc = goalieSummary
|
||||
, spProcessChar = capitalizeName
|
||||
, spCallback = callback
|
||||
, spNotFound = \sStr -> do
|
||||
mode <- gets (^.progMode)
|
||||
@@ -285,51 +349,43 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
modify $ progMode .~ CreateGoalie cgs
|
||||
}
|
||||
|
||||
-- | Prompts for the player who scored the goal
|
||||
recordGoalPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal number
|
||||
-- | Selects a goalie (creating one if necessary)
|
||||
selectGoaliePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
recordGoalPrompt game goal = selectPlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Who scored goal number " ++ show goal ++ "? "
|
||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||
selectGoaliePrompt = selectGoaliePromptWith goalieSearch
|
||||
|
||||
-- | Prompts for a player who assisted the goal
|
||||
recordAssistPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal nuber
|
||||
-> Int
|
||||
-- ^ The assist number
|
||||
-- | Selects an active goalie (creating one if necessary)
|
||||
selectActiveGoaliePrompt
|
||||
:: String
|
||||
-- ^ The prompt string
|
||||
-> (Maybe Int -> Action ())
|
||||
-- ^ The callback to run (takes the index number of the goalie as
|
||||
-- input)
|
||||
-> Prompt
|
||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Goal: " ++ show goal ++ "\n"
|
||||
++ "Assist #" ++ show assist ++ ": "
|
||||
) $ \case
|
||||
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
Just n -> do
|
||||
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
||||
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
|
||||
when (nAssists >= maxAssists) $
|
||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch
|
||||
|
||||
-- | Prompts for the player to assign penalty minutes to
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectPlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
||||
|
||||
-- | Prompts for the number of penalty mintues to assign to the player
|
||||
assignPMinsPrompt :: Prompt
|
||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||
modify . assignPMins
|
||||
-- | 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: " $
|
||||
|
||||
287
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
287
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
@@ -0,0 +1,287 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Prompt.EditGoalie
|
||||
( goalieToEditPrompt
|
||||
, editGoalieNumberPrompt
|
||||
, editGoalieNamePrompt
|
||||
, editGoalieYtdGamesPrompt
|
||||
, editGoalieYtdMinsPrompt
|
||||
, editGoalieYtdGoalsPrompt
|
||||
, editGoalieYtdShutoutsPrompt
|
||||
, editGoalieYtdWinsPrompt
|
||||
, editGoalieYtdLossesPrompt
|
||||
, editGoalieYtdTiesPrompt
|
||||
, editGoalieLtGamesPrompt
|
||||
, editGoalieLtMinsPrompt
|
||||
, editGoalieLtGoalsPrompt
|
||||
, editGoalieLtShutoutsPrompt
|
||||
, editGoalieLtWinsPrompt
|
||||
, editGoalieLtLossesPrompt
|
||||
, editGoalieLtTiesPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Prompt to select a 'Goalie' for editing
|
||||
goalieToEditPrompt :: Prompt
|
||||
goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
||||
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
||||
|
||||
-- | Prompt to edit a goalie's number
|
||||
editGoalieNumberPrompt
|
||||
:: Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
||||
(gNumber .~)
|
||||
|
||||
-- | Prompt to edit a goalie's 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
|
||||
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 cb =
|
||||
editNum "Year-to-date games played: " mode
|
||||
(gYtd.gsGames .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdMins True, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD minutes played
|
||||
editGoalieYtdMinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdMinsPrompt batchMode cb =
|
||||
editNum "Year-to-date minutes played: " mode
|
||||
(gYtd.gsMinsPlayed .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdGoals True, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD goales allowed
|
||||
editGoalieYtdGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdGoalsPrompt batchMode cb =
|
||||
editNum "Year-to-date goals allowed: " mode
|
||||
(gYtd.gsGoalsAllowed .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdShutouts True, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD shutouts
|
||||
editGoalieYtdShutoutsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdShutoutsPrompt batchMode cb =
|
||||
editNum "Year-to-date shutouts: " mode
|
||||
(gYtd.gsShutouts .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdWins True, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD wins
|
||||
editGoalieYtdWinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdWinsPrompt batchMode cb =
|
||||
editNum "Year-to-date wins: " mode
|
||||
(gYtd.gsWins .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdLosses True, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD losses
|
||||
editGoalieYtdLossesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdLossesPrompt batchMode cb =
|
||||
editNum "Year-to-date losses: " mode
|
||||
(gYtd.gsLosses .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGYtdTies, return ())
|
||||
else (EGYtd, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's YTD ties
|
||||
editGoalieYtdTiesPrompt
|
||||
:: Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
||||
(gYtd.gsTies .~)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime games played
|
||||
editGoalieLtGamesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtGamesPrompt batchMode cb =
|
||||
editNum "Lifetime games played: " mode
|
||||
(gLifetime.gsGames .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtMins True, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime minutes played
|
||||
editGoalieLtMinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtMinsPrompt batchMode cb =
|
||||
editNum "Lifetime minutes played: " mode
|
||||
(gLifetime.gsMinsPlayed .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtGoals True, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||
editGoalieLtGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtGoalsPrompt batchMode cb =
|
||||
editNum "Lifetime goals allowed: " mode
|
||||
(gLifetime.gsGoalsAllowed .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtShutouts True, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime shutouts
|
||||
editGoalieLtShutoutsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtShutoutsPrompt batchMode cb =
|
||||
editNum "Lifetime shutouts: " mode
|
||||
(gLifetime.gsShutouts .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtWins True, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime wins
|
||||
editGoalieLtWinsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtWinsPrompt batchMode cb =
|
||||
editNum "Lifetime wins: " mode
|
||||
(gLifetime.gsWins .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtLosses True, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime losses
|
||||
editGoalieLtLossesPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates whether or not we're in batch mode
|
||||
-> Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtLossesPrompt batchMode cb =
|
||||
editNum "Lifetime losses: " mode
|
||||
(gLifetime.gsLosses .~) cb'
|
||||
where
|
||||
(mode, cb') = if batchMode
|
||||
then (EGLtTies, return ())
|
||||
else (EGLifetime, cb)
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime ties
|
||||
editGoalieLtTiesPrompt
|
||||
:: Action ()
|
||||
-- ^ Action to perform on completion
|
||||
-> Prompt
|
||||
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
||||
(gLifetime.gsTies .~)
|
||||
|
||||
editNum
|
||||
:: String
|
||||
-> EditGoalieMode
|
||||
-> (Int -> Goalie -> Goalie)
|
||||
-> Action ()
|
||||
-> Prompt
|
||||
editNum pStr mode f cb = numPromptWithFallback pStr
|
||||
(goto mode >> cb)
|
||||
(\num -> do
|
||||
doEdit mode $ f num
|
||||
cb)
|
||||
|
||||
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
||||
doEdit mode f = do
|
||||
modify $ editSelectedGoalie f
|
||||
goto mode
|
||||
|
||||
goto :: EditGoalieMode -> Action ()
|
||||
goto = modify . (progMode.editGoalieStateL.egsMode .~)
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -31,62 +31,131 @@ module Mtlstats.Prompt.EditPlayer
|
||||
, editPlayerLtPMinPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad.Extra (whenJustM)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Prompt to edit a player's number
|
||||
editPlayerNumPrompt :: Prompt
|
||||
editPlayerNumPrompt = numPrompt "Player number: " $
|
||||
editPlayer . (pNumber .~)
|
||||
editPlayerNumPrompt
|
||||
:: Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
||||
(pNumber .~)
|
||||
|
||||
-- | Prompt to edit a player's name
|
||||
editPlayerNamePrompt :: Prompt
|
||||
editPlayerNamePrompt = strPrompt "Player name: " $
|
||||
editPlayer . (pName .~)
|
||||
editPlayerNamePrompt
|
||||
:: Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
|
||||
if null name
|
||||
then goto EPMenu
|
||||
else doEdit EPMenu $ pName .~ name
|
||||
callback
|
||||
|
||||
-- | Prompt to edit a player's position
|
||||
editPlayerPosPrompt :: Prompt
|
||||
editPlayerPosPrompt = strPrompt "Player position: " $
|
||||
editPlayer . (pPosition .~)
|
||||
editPlayerPosPrompt
|
||||
:: Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
|
||||
if null pos
|
||||
then goto EPMenu
|
||||
else doEdit EPMenu $ pPosition .~ pos
|
||||
callback
|
||||
|
||||
-- | Prompt to edit a player's year-to-date goals
|
||||
editPlayerYtdGoalsPrompt :: Prompt
|
||||
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
|
||||
editPlayer . (pYtd.psGoals .~)
|
||||
editPlayerYtdGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
|
||||
(pYtd.psGoals .~) callback'
|
||||
where
|
||||
(mode, callback') = if batchMode
|
||||
then (EPYtdAssists True, return ())
|
||||
else (EPYtd, callback)
|
||||
|
||||
-- | Prompt to edit a player's year-to-date assists
|
||||
editPlayerYtdAssistsPrompt :: Prompt
|
||||
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
|
||||
editPlayer . (pYtd.psAssists .~)
|
||||
editPlayerYtdAssistsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
|
||||
(pYtd.psAssists .~) callback'
|
||||
where
|
||||
(mode, callback') = if batchMode
|
||||
then (EPYtdPMin, return ())
|
||||
else (EPYtd, callback)
|
||||
|
||||
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||
editPlayerYtdPMinPrompt :: Prompt
|
||||
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
|
||||
editPlayer . (pYtd.psPMin .~)
|
||||
editPlayerYtdPMinPrompt
|
||||
:: Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
||||
(pYtd.psPMin .~)
|
||||
|
||||
-- | Prompt to edit a player's lifetime goals
|
||||
editPlayerLtGoalsPrompt :: Prompt
|
||||
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
|
||||
editPlayer . (pLifetime.psGoals .~)
|
||||
editPlayerLtGoalsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
|
||||
(pLifetime.psGoals .~) callback'
|
||||
where
|
||||
(mode, callback') = if batchMode
|
||||
then (EPLtAssists True, return ())
|
||||
else (EPLifetime, callback)
|
||||
|
||||
-- | Prompt to edit a player's lifetime assists
|
||||
editPlayerLtAssistsPrompt :: Prompt
|
||||
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
|
||||
editPlayer . (pLifetime.psAssists .~)
|
||||
editPlayerLtAssistsPrompt
|
||||
:: Bool
|
||||
-- ^ Indicates wheter or not we're editing in batch mode
|
||||
-> Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
|
||||
(pLifetime.psAssists .~) callback'
|
||||
where
|
||||
(mode, callback') = if batchMode
|
||||
then (EPLtPMin, return ())
|
||||
else (EPLifetime, callback)
|
||||
|
||||
-- | Prompt to edit a player's lifetime penalty minutes
|
||||
editPlayerLtPMinPrompt :: Prompt
|
||||
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
|
||||
editPlayer . (pLifetime.psPMin .~)
|
||||
editPlayerLtPMinPrompt
|
||||
:: Action ()
|
||||
-- ^ The action to be performed upon completion
|
||||
-> Prompt
|
||||
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
||||
(pLifetime.psPMin .~)
|
||||
|
||||
editPlayer :: (Player -> Player) -> Action ()
|
||||
editPlayer f =
|
||||
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
|
||||
modify
|
||||
$ (database.dbPlayers %~ modifyNth pid f)
|
||||
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
|
||||
editNum
|
||||
:: String
|
||||
-> EditPlayerMode
|
||||
-> (Int -> Player -> Player)
|
||||
-> Action ()
|
||||
-> Prompt
|
||||
editNum pStr mode f callback = numPromptWithFallback pStr
|
||||
(goto mode >> callback)
|
||||
(\num -> do
|
||||
doEdit mode $ f num
|
||||
callback)
|
||||
|
||||
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
||||
doEdit mode f = do
|
||||
modify $ editSelectedPlayer f
|
||||
goto mode
|
||||
|
||||
goto :: EditPlayerMode -> Action ()
|
||||
goto = modify . (progMode.editPlayerStateL.epsMode .~)
|
||||
|
||||
89
src/Mtlstats/Prompt/EditStandings.hs
Normal file
89
src/Mtlstats/Prompt/EditStandings.hs
Normal 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
|
||||
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
@@ -0,0 +1,116 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Prompt.NewGame
|
||||
( gameYearPrompt
|
||||
, gameDayPrompt
|
||||
, otherTeamPrompt
|
||||
, homeScorePrompt
|
||||
, awayScorePrompt
|
||||
, recordGoalPrompt
|
||||
, recordAssistPrompt
|
||||
, pMinPlayerPrompt
|
||||
, assignPMinsPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Lens.Micro ((^.), (.~), (?~), (%~))
|
||||
|
||||
import Mtlstats.Actions.NewGame
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
modify . (progMode.gameStateL.gameYear ?~)
|
||||
|
||||
-- | Prompts for the day of the month the game took place
|
||||
gameDayPrompt :: Prompt
|
||||
gameDayPrompt = numPrompt "Day of month: " $
|
||||
modify . (progMode.gameStateL.gameDay ?~)
|
||||
|
||||
-- | Prompts for the other team name
|
||||
otherTeamPrompt :: Prompt
|
||||
otherTeamPrompt = ucStrPrompt "Other team: " $
|
||||
modify . (progMode.gameStateL.otherTeam .~)
|
||||
|
||||
-- | Prompts for the home score
|
||||
homeScorePrompt :: Prompt
|
||||
homeScorePrompt = numPrompt "Home score: " $
|
||||
modify . (progMode.gameStateL.homeScore ?~)
|
||||
|
||||
-- | Prompts for the away score
|
||||
awayScorePrompt :: Prompt
|
||||
awayScorePrompt = numPrompt "Away score: " $ \score -> modify
|
||||
$ overtimeCheck
|
||||
. (progMode.gameStateL.awayScore ?~ score)
|
||||
|
||||
-- | Prompts for the player who scored the goal
|
||||
recordGoalPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal number
|
||||
-> Prompt
|
||||
recordGoalPrompt game goal = selectActivePlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Who scored goal number " ++ show goal ++ "? "
|
||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||
|
||||
-- | Prompts for a player who assisted the goal
|
||||
recordAssistPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal nuber
|
||||
-> Int
|
||||
-- ^ The assist number
|
||||
-> Prompt
|
||||
recordAssistPrompt game goal assist = selectActivePlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Goal: " ++ show goal ++ "\n"
|
||||
++ "Assist #" ++ show assist ++ ": "
|
||||
) $ \case
|
||||
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
Just n -> do
|
||||
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
||||
nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
|
||||
when (nAssists >= maxAssists) $
|
||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
|
||||
-- | Prompts for the player to assign penalty minutes to
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectActivePlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
||||
|
||||
-- | Prompts for the number of penalty mintues to assign to the player
|
||||
assignPMinsPrompt :: Prompt
|
||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||
modify . assignPMins
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,25 +21,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Prompt.GoalieInput
|
||||
module Mtlstats.Prompt.NewGame.GoalieInput
|
||||
( selectGameGoaliePrompt
|
||||
, goalieMinsPlayedPrompt
|
||||
, goalsAllowedPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (.~), (?~))
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((?~))
|
||||
|
||||
import Mtlstats.Actions.GoalieInput
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Actions.NewGame.GoalieInput
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Prompts for a goalie who played in the game
|
||||
selectGameGoaliePrompt :: Prompt
|
||||
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
||||
selectGameGoaliePrompt = selectActiveGoaliePrompt
|
||||
"Which goalie played this game: " $
|
||||
\case
|
||||
Nothing -> modify finishGoalieEntry
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,24 +19,46 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Report (report, gameDate, playerNameColWidth) where
|
||||
module Mtlstats.Report (displayReport, exportReport, gameDate) where
|
||||
|
||||
import Data.List (sortOn)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Ord (Down (Down))
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Generates the report
|
||||
report
|
||||
-- | Generates the report displayed on screen
|
||||
displayReport
|
||||
:: Int
|
||||
-- ^ The number of columns for the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> [String]
|
||||
displayReport width s
|
||||
= report width s
|
||||
++ [""]
|
||||
++ lifetimeStatsReport width s
|
||||
|
||||
-- | Generates the report to be exported to file
|
||||
exportReport
|
||||
:: Int
|
||||
-- ^ The number of columns in the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> String
|
||||
exportReport width s
|
||||
= unlines (report width s)
|
||||
++ "\f"
|
||||
++ unlines (lifetimeStatsReport width s)
|
||||
|
||||
report :: Int -> ProgState -> [String]
|
||||
report width s
|
||||
= standingsReport width s
|
||||
++ [""]
|
||||
@@ -58,107 +80,279 @@ standingsReport width s = fromMaybe [] $ do
|
||||
tStats = addGameStats hStats aStats
|
||||
hScore <- gs^.homeScore
|
||||
aScore <- gs^.awayScore
|
||||
Just
|
||||
[ overlay
|
||||
("GAME NUMBER " ++ padNum 2 gNum)
|
||||
(centre width
|
||||
$ aTeam ++ " " ++ show aScore ++ " AT "
|
||||
++ hTeam ++ " " ++ show hScore)
|
||||
, date
|
||||
, centre width "STANDINGS"
|
||||
, ""
|
||||
, centre width
|
||||
$ left 11 myTeam
|
||||
++ right 2 "G"
|
||||
++ right 4 "W"
|
||||
++ right 4 "L"
|
||||
++ right 4 "OT"
|
||||
++ right 4 "GF"
|
||||
++ right 4 "GA"
|
||||
++ right 4 "P"
|
||||
, centre width
|
||||
$ left 11 "HOME"
|
||||
++ showStats hStats
|
||||
, centre width
|
||||
$ left 11 "ROAD"
|
||||
++ showStats aStats
|
||||
, centre width
|
||||
$ replicate 11 ' '
|
||||
++ replicate (2 + 4 * 6) '-'
|
||||
, centre width
|
||||
$ left 11 "TOTALS"
|
||||
++ showStats tStats
|
||||
]
|
||||
let
|
||||
rHeader =
|
||||
[ overlay
|
||||
("GAME NUMBER " ++ padNum 2 gNum)
|
||||
(centre width
|
||||
$ aTeam ++ " " ++ show aScore ++ " AT "
|
||||
++ hTeam ++ " " ++ show hScore)
|
||||
, date
|
||||
, centre width "STANDINGS"
|
||||
, ""
|
||||
]
|
||||
|
||||
tHeader =
|
||||
[ CellText myTeam
|
||||
, CellText " G"
|
||||
, CellText " W"
|
||||
, CellText " L"
|
||||
, CellText " OT"
|
||||
, CellText " GF"
|
||||
, CellText " GA"
|
||||
, CellText " P"
|
||||
]
|
||||
|
||||
rowCells stats =
|
||||
[ CellText $ show $ gmsGames stats
|
||||
, CellText $ show $ stats^.gmsWins
|
||||
, CellText $ show $ stats^.gmsLosses
|
||||
, CellText $ show $ stats^.gmsOvertime
|
||||
, CellText $ show $ stats^.gmsGoalsFor
|
||||
, CellText $ show $ stats^.gmsGoalsAgainst
|
||||
, CellText $ show $ gmsPoints stats
|
||||
]
|
||||
|
||||
body =
|
||||
[ CellText "HOME" : rowCells hStats
|
||||
, CellText "ROAD" : rowCells aStats
|
||||
]
|
||||
|
||||
separator = CellText "" : replicate 7 (CellFill '-')
|
||||
totals = CellText "TOTALS" : rowCells tStats
|
||||
|
||||
table = map (centre width) $
|
||||
complexTable
|
||||
(left : repeat right)
|
||||
(tHeader : body ++ [separator, totals])
|
||||
|
||||
Just $ rHeader ++ table
|
||||
|
||||
gameStatsReport :: Int -> ProgState -> [String]
|
||||
gameStatsReport width s = playerReport width "GAME" $
|
||||
fromMaybe [] $ mapM
|
||||
gameStatsReport width s = let
|
||||
gs = s^.progMode.gameStateL
|
||||
db = s^.database
|
||||
|
||||
playerStats = sortPlayers $ mapMaybe
|
||||
(\(pid, stats) -> do
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
p <- nth pid $ db^.dbPlayers
|
||||
Just (p, stats))
|
||||
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
|
||||
(M.toList $ gs^.gamePlayerStats)
|
||||
|
||||
goalieStats = mapMaybe
|
||||
(\(gid, stats) -> do
|
||||
g <- nth gid $ db^.dbGoalies
|
||||
Just (g, stats))
|
||||
(M.toList $ gs^.gameGoalieStats)
|
||||
|
||||
criteria (_, ps) = psPoints ps > 0
|
||||
|
||||
in filteredPlayerReport width "GAME" criteria True False playerStats
|
||||
++ [""]
|
||||
++ gameGoalieReport width goalieStats
|
||||
|
||||
yearToDateStatsReport :: Int -> ProgState -> [String]
|
||||
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
|
||||
map (\p -> (p, p^.pYtd)) $
|
||||
filter playerIsActive $ s^.database.dbPlayers
|
||||
yearToDateStatsReport width s = let
|
||||
db = s^.database
|
||||
|
||||
playerStats = sortPlayers
|
||||
$ map (\p -> (p, p^.pYtd))
|
||||
$ filter playerIsActive
|
||||
$ db^.dbPlayers
|
||||
|
||||
goalieStats = map (\g -> (g, g^.gYtd))
|
||||
$ filter goalieIsActive
|
||||
$ db^.dbGoalies
|
||||
|
||||
in playerReport width "YEAR TO DATE" True False playerStats
|
||||
++ [""]
|
||||
++ goalieReport width True False goalieStats
|
||||
|
||||
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||
lifetimeStatsReport width s = let
|
||||
db = s^.database
|
||||
|
||||
playerStats = sortPlayers
|
||||
$ map (\p -> (p, p^.pLifetime))
|
||||
$ db^.dbPlayers
|
||||
|
||||
goalieStats = map (\g -> (g, g^.gLifetime))
|
||||
$ db^.dbGoalies
|
||||
|
||||
in playerReport width "LIFETIME" False True playerStats
|
||||
++ [""]
|
||||
++ goalieReport width False True goalieStats
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
year <- show <$> gs^.gameYear
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
Just $ month ++ " " ++ day ++ " " ++ year
|
||||
y <- show <$> gs^.gameYear
|
||||
m <- month <$> gs^.gameMonth
|
||||
d <- padNum 2 <$> gs^.gameDay
|
||||
Just $ m ++ " " ++ d ++ " " ++ y
|
||||
|
||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||
playerReport width label ps = let
|
||||
nameWidth = playerNameColWidth $ map fst ps
|
||||
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
|
||||
in
|
||||
playerReport
|
||||
:: Int
|
||||
-> String
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Player, PlayerStats)]
|
||||
-> [String]
|
||||
playerReport width label =
|
||||
filteredPlayerReport width label (const True)
|
||||
|
||||
filteredPlayerReport
|
||||
:: Int
|
||||
-> String
|
||||
-> ((Player, PlayerStats) -> Bool)
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Player, PlayerStats)]
|
||||
-> [String]
|
||||
filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
||||
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||
criteria' = (&&) <$> criteria <*> \(p, _) -> p^.pNumber /= 0
|
||||
fps = filter criteria' ps
|
||||
|
||||
rHeader =
|
||||
[ centre width (label ++ " STATISTICS")
|
||||
, ""
|
||||
, centre width
|
||||
$ "NO. "
|
||||
++ left nameWidth "PLAYER"
|
||||
++ right 3 "G"
|
||||
++ right 6 "A"
|
||||
++ right 6 "P"
|
||||
++ right 6 "PM"
|
||||
] ++ map
|
||||
(\(p, stats) -> centre width
|
||||
$ right 2 (show $ p^.pNumber)
|
||||
++ " "
|
||||
++ left nameWidth (p^.pName)
|
||||
++ right 3 (show $ stats^.psGoals)
|
||||
++ right 6 (show $ stats^.psAssists)
|
||||
++ right 6 (show $ psPoints stats)
|
||||
++ right 6 (show $ stats^.psPMin))
|
||||
ps ++
|
||||
[ centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ replicate (3 + 3 * 6) '-'
|
||||
, overlay
|
||||
(label ++ " TOTALS")
|
||||
( centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ right 3 (show $ tStats^.psGoals)
|
||||
++ right 6 (show $ tStats^.psAssists)
|
||||
++ right 6 (show $ psPoints tStats)
|
||||
++ right 6 (show $ tStats^.psPMin)
|
||||
)
|
||||
]
|
||||
|
||||
playerNameColWidth :: [Player] -> Int
|
||||
playerNameColWidth = foldr
|
||||
(\player current -> max current $ succ $ length $ player^.pName)
|
||||
10
|
||||
tHeader =
|
||||
[ CellText "NO."
|
||||
, CellText "Player"
|
||||
, CellText " G"
|
||||
, CellText " A"
|
||||
, CellText " P"
|
||||
, CellText " PM"
|
||||
]
|
||||
|
||||
showStats :: GameStats -> String
|
||||
showStats gs
|
||||
= right 2 (show $ gmsGames gs)
|
||||
++ right 4 (show $ gs^.gmsWins)
|
||||
++ right 4 (show $ gs^.gmsLosses)
|
||||
++ right 4 (show $ gs^.gmsOvertime)
|
||||
++ right 4 (show $ gs^.gmsGoalsFor)
|
||||
++ right 4 (show $ gs^.gmsGoalsAgainst)
|
||||
++ right 4 (show $ gmsPoints gs)
|
||||
statsCells stats =
|
||||
[ CellText $ show $ stats^.psGoals
|
||||
, CellText $ show $ stats^.psAssists
|
||||
, CellText $ show $ psPoints stats
|
||||
, CellText $ show $ stats^.psPMin
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(p, stats) ->
|
||||
[ CellText $ show (p^.pNumber) ++ " "
|
||||
, CellText $ playerName p
|
||||
] ++ statsCells stats)
|
||||
fps
|
||||
|
||||
separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
|
||||
|
||||
totals =
|
||||
[ CellText ""
|
||||
, CellText ""
|
||||
] ++ statsCells tStats
|
||||
|
||||
olayText = if showTotals
|
||||
then label ++ " TOTALS"
|
||||
else ""
|
||||
|
||||
lnOverlay = if lineNumbers
|
||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||
else repeat ""
|
||||
|
||||
table = overlayLast olayText
|
||||
$ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ tHeader : body ++ if showTotals
|
||||
then [separator, totals]
|
||||
else []
|
||||
|
||||
in rHeader ++ table
|
||||
|
||||
goalieReport
|
||||
:: Int
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> [(Goalie, GoalieStats)]
|
||||
-> [String]
|
||||
goalieReport width showTotals lineNumbers goalieData = let
|
||||
olayText = if showTotals
|
||||
then "GOALTENDING TOTALS"
|
||||
else ""
|
||||
|
||||
goalieData' = sortGoalies goalieData
|
||||
|
||||
tData = foldl addGoalieStats newGoalieStats
|
||||
$ map snd goalieData'
|
||||
|
||||
header =
|
||||
[ CellText "NO."
|
||||
, CellText $ padRight (length olayText) "GOALTENDER"
|
||||
, CellText "GP"
|
||||
, CellText " MIN"
|
||||
, CellText " GA"
|
||||
, CellText " SO"
|
||||
, CellText "AVE"
|
||||
]
|
||||
|
||||
rowCells stats =
|
||||
[ CellText $ show $ stats^.gsGames
|
||||
, CellText $ show $ stats^.gsMinsPlayed
|
||||
, CellText $ show $ stats^.gsGoalsAllowed
|
||||
, CellText $ show $ stats^.gsShutouts
|
||||
, CellText $ showFloating $ gsAverage stats
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(goalie, stats) ->
|
||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||
, CellText $ goalieName goalie
|
||||
] ++ rowCells stats)
|
||||
goalieData'
|
||||
|
||||
separator
|
||||
= replicate 2 (CellText "")
|
||||
++ replicate 5 (CellFill '-')
|
||||
|
||||
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||
|
||||
lnOverlay = if lineNumbers
|
||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||
else repeat ""
|
||||
|
||||
in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||
$ overlayLast olayText
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body ++ if showTotals
|
||||
then [separator, summary]
|
||||
else []
|
||||
|
||||
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||
gameGoalieReport width goalieData = let
|
||||
goalieData' = sortGoalies goalieData
|
||||
|
||||
header =
|
||||
[ CellText "NO."
|
||||
, CellText "GOALTENDER"
|
||||
, CellText " MIN"
|
||||
, CellText " GA"
|
||||
, CellText " AVE"
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(goalie, stats) ->
|
||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||
, CellText $ goalieName goalie
|
||||
, CellText $ show $ stats^.gsMinsPlayed
|
||||
, CellText $ show $ stats^.gsGoalsAllowed
|
||||
, CellText $ showFloating $ gsAverage stats
|
||||
])
|
||||
goalieData'
|
||||
|
||||
in map (centre width)
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body
|
||||
|
||||
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)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -33,6 +33,10 @@ module Mtlstats.Types (
|
||||
CreateGoalieState (..),
|
||||
EditPlayerState (..),
|
||||
EditPlayerMode (..),
|
||||
EditGoalieState (..),
|
||||
EditGoalieMode (..),
|
||||
EditStandingsMode (..),
|
||||
ESMSubMode (..),
|
||||
Database (..),
|
||||
Player (..),
|
||||
PlayerStats (..),
|
||||
@@ -41,10 +45,12 @@ module Mtlstats.Types (
|
||||
GameStats (..),
|
||||
Prompt (..),
|
||||
SelectParams (..),
|
||||
TableCell (..),
|
||||
-- * Lenses
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
progMode,
|
||||
dbName,
|
||||
inputBuffer,
|
||||
scrollOffset,
|
||||
-- ** ProgMode Lenses
|
||||
@@ -52,6 +58,10 @@ module Mtlstats.Types (
|
||||
createPlayerStateL,
|
||||
createGoalieStateL,
|
||||
editPlayerStateL,
|
||||
editGoalieStateL,
|
||||
editStandingsModeL,
|
||||
-- ** EditStandingsMode Lenses
|
||||
esmSubModeL,
|
||||
-- ** GameState Lenses
|
||||
gameYear,
|
||||
gameMonth,
|
||||
@@ -79,16 +89,25 @@ module Mtlstats.Types (
|
||||
cpsNumber,
|
||||
cpsName,
|
||||
cpsPosition,
|
||||
cpsRookieFlag,
|
||||
cpsActiveFlag,
|
||||
cpsSuccessCallback,
|
||||
cpsFailureCallback,
|
||||
-- ** CreateGoalieState Lenses
|
||||
cgsNumber,
|
||||
cgsName,
|
||||
cgsRookieFlag,
|
||||
cgsActiveFlag,
|
||||
cgsSuccessCallback,
|
||||
cgsFailureCallback,
|
||||
-- ** EditPlayerState Lenses
|
||||
epsSelectedPlayer,
|
||||
epsMode,
|
||||
epsCallback,
|
||||
-- ** EditGoalieState Lenses
|
||||
egsSelectedGoalie,
|
||||
egsMode,
|
||||
egsCallback,
|
||||
-- ** Database Lenses
|
||||
dbPlayers,
|
||||
dbGoalies,
|
||||
@@ -99,6 +118,8 @@ module Mtlstats.Types (
|
||||
pNumber,
|
||||
pName,
|
||||
pPosition,
|
||||
pRookie,
|
||||
pActive,
|
||||
pYtd,
|
||||
pLifetime,
|
||||
-- ** PlayerStats Lenses
|
||||
@@ -108,12 +129,15 @@ module Mtlstats.Types (
|
||||
-- ** Goalie Lenses
|
||||
gNumber,
|
||||
gName,
|
||||
gRookie,
|
||||
gActive,
|
||||
gYtd,
|
||||
gLifetime,
|
||||
-- ** GoalieStats Lenses
|
||||
gsGames,
|
||||
gsMinsPlayed,
|
||||
gsGoalsAllowed,
|
||||
gsShutouts,
|
||||
gsWins,
|
||||
gsLosses,
|
||||
gsTies,
|
||||
@@ -129,6 +153,7 @@ module Mtlstats.Types (
|
||||
newCreatePlayerState,
|
||||
newCreateGoalieState,
|
||||
newEditPlayerState,
|
||||
newEditGoalieState,
|
||||
newDatabase,
|
||||
newPlayer,
|
||||
newPlayerStats,
|
||||
@@ -151,18 +176,23 @@ module Mtlstats.Types (
|
||||
addGameStats,
|
||||
-- ** Player Helpers
|
||||
playerSearch,
|
||||
activePlayerSearch,
|
||||
playerSearchExact,
|
||||
modifyPlayer,
|
||||
playerSummary,
|
||||
playerDetails,
|
||||
playerIsActive,
|
||||
-- ** PlayerStats Helpers
|
||||
psPoints,
|
||||
addPlayerStats,
|
||||
-- ** Goalie Helpers
|
||||
goalieSearch,
|
||||
activeGoalieSearch,
|
||||
goalieSearchExact,
|
||||
goalieSummary
|
||||
goalieSummary,
|
||||
goalieIsActive,
|
||||
-- ** GoalieStats Helpers
|
||||
addGoalieStats,
|
||||
gsAverage
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (StateT)
|
||||
@@ -176,11 +206,13 @@ import Data.Aeson
|
||||
, toJSON
|
||||
, withObject
|
||||
, (.:)
|
||||
, (.:?)
|
||||
, (.!=)
|
||||
, (.=)
|
||||
)
|
||||
import Data.List (isInfixOf)
|
||||
import Data.Char (toUpper)
|
||||
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
|
||||
@@ -204,6 +236,8 @@ data ProgState = ProgState
|
||||
-- ^ The data to be saved
|
||||
, _progMode :: ProgMode
|
||||
-- ^ The program's mode
|
||||
, _dbName :: String
|
||||
-- ^ The name of the database file
|
||||
, _inputBuffer :: String
|
||||
-- ^ Buffer for user input
|
||||
, _scrollOffset :: Int
|
||||
@@ -212,20 +246,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 (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
show (EditPlayer _) = "EditPlayer"
|
||||
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
|
||||
@@ -294,6 +336,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 ()
|
||||
@@ -302,10 +348,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 ()
|
||||
@@ -318,6 +368,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
|
||||
@@ -326,14 +378,68 @@ data EditPlayerMode
|
||||
| EPNumber
|
||||
| EPName
|
||||
| EPPosition
|
||||
| EPYtdGoals
|
||||
| EPYtdAssists
|
||||
| EPYtd
|
||||
| EPLifetime
|
||||
| EPDelete
|
||||
| EPYtdGoals Bool
|
||||
| EPYtdAssists Bool
|
||||
| EPYtdPMin
|
||||
| EPLtGoals
|
||||
| EPLtAssists
|
||||
| EPLtGoals Bool
|
||||
| EPLtAssists Bool
|
||||
| EPLtPMin
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | 'Goalie' edit status
|
||||
data EditGoalieState = EditGoalieState
|
||||
{ _egsSelectedGoalie :: Maybe Int
|
||||
-- ^ The index number of the 'Goalie' being edited
|
||||
, _egsMode :: EditGoalieMode
|
||||
-- ^ The editing mode
|
||||
, _egsCallback :: Action ()
|
||||
-- ^ The action to perform when the edit is complete
|
||||
}
|
||||
|
||||
-- | 'Goalie' editing mode
|
||||
data EditGoalieMode
|
||||
= EGMenu
|
||||
| EGNumber
|
||||
| EGName
|
||||
| EGYtd
|
||||
| EGLifetime
|
||||
| EGDelete
|
||||
| EGYtdGames Bool
|
||||
| EGYtdMins Bool
|
||||
| EGYtdGoals Bool
|
||||
| EGYtdShutouts Bool
|
||||
| EGYtdWins Bool
|
||||
| EGYtdLosses Bool
|
||||
| EGYtdTies
|
||||
| EGLtGames Bool
|
||||
| EGLtMins Bool
|
||||
| EGLtGoals Bool
|
||||
| EGLtShutouts Bool
|
||||
| EGLtWins Bool
|
||||
| EGLtLosses Bool
|
||||
| EGLtTies
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the standings edit mode
|
||||
data EditStandingsMode
|
||||
= ESMMenu
|
||||
| ESMHome ESMSubMode
|
||||
| ESMAway ESMSubMode
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the standings edit sub-mode
|
||||
data ESMSubMode
|
||||
= ESMSubMenu
|
||||
| ESMEditWins
|
||||
| ESMEditLosses
|
||||
| ESMEditOvertime
|
||||
| ESMEditGoalsFor
|
||||
| ESMEditGoalsAgainst
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the database
|
||||
data Database = Database
|
||||
{ _dbPlayers :: [Player]
|
||||
@@ -348,13 +454,142 @@ data Database = Database
|
||||
-- ^ Statistics for away games
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a (non-goalie) player
|
||||
data Player = Player
|
||||
{ _pNumber :: Int
|
||||
-- ^ The player's number
|
||||
, _pName :: String
|
||||
-- ^ The player's name
|
||||
, _pPosition :: String
|
||||
-- ^ The player's position
|
||||
, _pRookie :: Bool
|
||||
-- ^ Indicates that the player is a rookie
|
||||
, _pActive :: Bool
|
||||
-- ^ Indicates that the player is active
|
||||
, _pYtd :: PlayerStats
|
||||
-- ^ The Player's year-to-date stats
|
||||
, _pLifetime :: PlayerStats
|
||||
-- ^ The player's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a (non-goalie) player's stats
|
||||
data PlayerStats = PlayerStats
|
||||
{ _psGoals :: Int
|
||||
-- ^ The number of goals
|
||||
, _psAssists :: Int
|
||||
-- ^ The number of assists
|
||||
, _psPMin :: Int
|
||||
-- ^ The number of penalty minutes
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a goalie
|
||||
data Goalie = Goalie
|
||||
{ _gNumber :: Int
|
||||
-- ^ The goalie's number
|
||||
, _gName :: String
|
||||
-- ^ The goalie's name
|
||||
, _gRookie :: Bool
|
||||
-- ^ Indicates that the goalie is a rookie
|
||||
, _gActive :: Bool
|
||||
-- ^ Indicates that the goalie is active
|
||||
, _gYtd :: GoalieStats
|
||||
-- ^ The goalie's year-to-date stats
|
||||
, _gLifetime :: GoalieStats
|
||||
-- ^ The goalie's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Represents a goalie's stats
|
||||
data GoalieStats = GoalieStats
|
||||
{ _gsGames :: Int
|
||||
-- ^ The number of games played
|
||||
, _gsMinsPlayed :: Int
|
||||
-- ^ The number of minutes played
|
||||
, _gsGoalsAllowed :: Int
|
||||
-- ^ The number of goals allowed
|
||||
, _gsShutouts :: Int
|
||||
-- ^ The number of shutouts the goalie has accumulated
|
||||
, _gsWins :: Int
|
||||
-- ^ The number of wins
|
||||
, _gsLosses :: Int
|
||||
-- ^ The number of losses
|
||||
, _gsTies :: Int
|
||||
-- ^ The number of ties
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Game statistics
|
||||
data GameStats = GameStats
|
||||
{ _gmsWins :: Int
|
||||
-- ^ Games won
|
||||
, _gmsLosses :: Int
|
||||
-- ^ Games lost
|
||||
, _gmsOvertime :: Int
|
||||
-- ^ Games lost in overtime
|
||||
, _gmsGoalsFor :: Int
|
||||
-- ^ Goals for the team
|
||||
, _gmsGoalsAgainst :: Int
|
||||
-- ^ Goals against the team
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | Defines a user prompt
|
||||
data Prompt = Prompt
|
||||
{ promptDrawer :: ProgState -> C.Update ()
|
||||
-- ^ Draws the prompt to the screen
|
||||
, promptProcessChar :: Char -> String -> String
|
||||
-- ^ Modifies the string based on the character entered
|
||||
, promptAction :: String -> Action ()
|
||||
-- ^ Action to perform when the value is entered
|
||||
, promptSpecialKey :: C.Key -> Action ()
|
||||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spProcessChar :: Char -> String -> String
|
||||
-- ^ Processes a character entered by the user
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
-- | Describes a table cell
|
||||
data TableCell
|
||||
= CellText String
|
||||
-- ^ A cell with text
|
||||
| CellFill Char
|
||||
-- ^ A cell filled with the given character
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''EditPlayerState
|
||||
makeLenses ''EditGoalieState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
makeLenses ''Goalie
|
||||
makeLenses ''GoalieStats
|
||||
makeLenses ''GameStats
|
||||
|
||||
instance FromJSON Database where
|
||||
parseJSON = withObject "Database" $ \v -> Database
|
||||
<$> v .: "players"
|
||||
<*> v .: "goalies"
|
||||
<*> v .: "games"
|
||||
<*> v .: "home_game_stats"
|
||||
<*> v .: "away_game_stats"
|
||||
<$> v .:? "players" .!= []
|
||||
<*> v .:? "goalies" .!= []
|
||||
<*> v .:? "games" .!= 0
|
||||
<*> v .:? "home_game_stats" .!= newGameStats
|
||||
<*> v .:? "away_game_stats" .!= newGameStats
|
||||
|
||||
instance ToJSON Database where
|
||||
toJSON (Database players goalies games hgs ags) = object
|
||||
@@ -371,58 +606,40 @@ instance ToJSON Database where
|
||||
"home_game_stats" .= hgs <>
|
||||
"away_game_stats" .= ags
|
||||
|
||||
-- | Represents a (non-goalie) player
|
||||
data Player = Player
|
||||
{ _pNumber :: Int
|
||||
-- ^ The player's number
|
||||
, _pName :: String
|
||||
-- ^ The player's name
|
||||
, _pPosition :: String
|
||||
-- ^ The player's position
|
||||
, _pYtd :: PlayerStats
|
||||
-- ^ The Player's year-to-date stats
|
||||
, _pLifetime :: PlayerStats
|
||||
-- ^ The player's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON Player where
|
||||
parseJSON = withObject "Player" $ \v -> Player
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "position"
|
||||
<*> v .: "ytd"
|
||||
<*> v .: "lifetime"
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "position"
|
||||
<*> v .:? "rookie" .!= False
|
||||
<*> v .:? "active" .!= True
|
||||
<*> v .:? "ytd" .!= newPlayerStats
|
||||
<*> v .:? "lifetime" .!= newPlayerStats
|
||||
|
||||
instance ToJSON Player where
|
||||
toJSON (Player num name pos 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 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
|
||||
|
||||
-- | Represents a (non-goalie) player's stats
|
||||
data PlayerStats = PlayerStats
|
||||
{ _psGoals :: Int
|
||||
-- ^ The number of goals
|
||||
, _psAssists :: Int
|
||||
-- ^ The number of assists
|
||||
, _psPMin :: Int
|
||||
-- ^ The number of penalty minutes
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON PlayerStats where
|
||||
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
||||
<$> v .: "goals"
|
||||
<*> v .: "assists"
|
||||
<*> v .: "penalty_mins"
|
||||
<$> v .:? "goals" .!= 0
|
||||
<*> v .:? "assists" .!= 0
|
||||
<*> v .:? "penalty_mins" .!= 0
|
||||
|
||||
instance ToJSON PlayerStats where
|
||||
toJSON (PlayerStats g a pm) = object
|
||||
@@ -435,94 +652,61 @@ instance ToJSON PlayerStats where
|
||||
"assists" .= a <>
|
||||
"penalty_mins" .= pm
|
||||
|
||||
-- | Represents a goalie
|
||||
data Goalie = Goalie
|
||||
{ _gNumber :: Int
|
||||
-- ^ The goalie's number
|
||||
, _gName :: String
|
||||
-- ^ The goalie's name
|
||||
, _gYtd :: GoalieStats
|
||||
-- ^ The goalie's year-to-date stats
|
||||
, _gLifetime :: GoalieStats
|
||||
-- ^ The goalie's lifetime stats
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON Goalie where
|
||||
parseJSON = withObject "Goalie" $ \v -> Goalie
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .: "ytd"
|
||||
<*> v .: "lifetime"
|
||||
<$> v .: "number"
|
||||
<*> v .: "name"
|
||||
<*> v .:? "rookie" .!= False
|
||||
<*> v .:? "active" .!= True
|
||||
<*> v .:? "ytd" .!= newGoalieStats
|
||||
<*> v .:? "lifetime" .!= newGoalieStats
|
||||
|
||||
instance ToJSON Goalie where
|
||||
toJSON (Goalie num name 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 ytd lt) = pairs $
|
||||
toEncoding (Goalie num name rk act ytd lt) = pairs $
|
||||
"number" .= num <>
|
||||
"name" .= name <>
|
||||
"rookie" .= rk <>
|
||||
"active" .= act <>
|
||||
"ytd" .= ytd <>
|
||||
"lifetime" .= lt
|
||||
|
||||
-- | Represents a goalie's stats
|
||||
data GoalieStats = GoalieStats
|
||||
{ _gsGames :: Int
|
||||
-- ^ The number of games played
|
||||
, _gsMinsPlayed :: Int
|
||||
-- ^ The number of minutes played
|
||||
, _gsGoalsAllowed :: Int
|
||||
-- ^ The number of goals allowed
|
||||
, _gsWins :: Int
|
||||
-- ^ The number of wins
|
||||
, _gsLosses :: Int
|
||||
-- ^ The number of losses
|
||||
, _gsTies :: Int
|
||||
-- ^ The number of ties
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON GoalieStats where
|
||||
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
||||
<$> v .: "games"
|
||||
<*> v .: "mins_played"
|
||||
<*> v .: "goals_allowed"
|
||||
<*> v .: "wins"
|
||||
<*> v .: "losses"
|
||||
<*> v .: "ties"
|
||||
<$> v .:? "games" .!= 0
|
||||
<*> v .:? "mins_played" .!= 0
|
||||
<*> v .:? "goals_allowed" .!= 0
|
||||
<*> v .:? "shutouts" .!= 0
|
||||
<*> v .:? "wins" .!= 0
|
||||
<*> v .:? "losses" .!= 0
|
||||
<*> v .:? "ties" .!= 0
|
||||
|
||||
instance ToJSON GoalieStats where
|
||||
toJSON (GoalieStats g m a w l t) = object
|
||||
toJSON (GoalieStats g m a s w l t) = object
|
||||
[ "games" .= g
|
||||
, "mins_played" .= m
|
||||
, "goals_allowed" .= a
|
||||
, "shutouts" .= s
|
||||
, "wins" .= w
|
||||
, "losses" .= l
|
||||
, "ties" .= t
|
||||
]
|
||||
toEncoding (GoalieStats g m a w l t) = pairs $
|
||||
toEncoding (GoalieStats g m a s w l t) = pairs $
|
||||
"games" .= g <>
|
||||
"mins_played" .= m <>
|
||||
"goals_allowed" .= a <>
|
||||
"shutouts" .= s <>
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
"ties" .= t
|
||||
|
||||
-- | Game statistics
|
||||
data GameStats = GameStats
|
||||
{ _gmsWins :: Int
|
||||
-- ^ Games won
|
||||
, _gmsLosses :: Int
|
||||
-- ^ Games lost
|
||||
, _gmsOvertime :: Int
|
||||
-- ^ Games lost in overtime
|
||||
, _gmsGoalsFor :: Int
|
||||
-- ^ Goals for the team
|
||||
, _gmsGoalsAgainst :: Int
|
||||
-- ^ Goals against the team
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON GameStats where
|
||||
parseJSON = withObject "GameStats" $ \v -> GameStats
|
||||
<$> v .: "wins"
|
||||
@@ -546,48 +730,6 @@ instance ToJSON GameStats where
|
||||
"goals_for" .= gf <>
|
||||
"goals_against" .= ga
|
||||
|
||||
-- | Defines a user prompt
|
||||
data Prompt = Prompt
|
||||
{ promptDrawer :: ProgState -> C.Update ()
|
||||
-- ^ Draws the prompt to the screen
|
||||
, promptCharCheck :: Char -> Bool
|
||||
-- ^ Determines whether or not the character is valid
|
||||
, promptAction :: String -> Action ()
|
||||
-- ^ Action to perform when the value is entered
|
||||
, promptSpecialKey :: C.Key -> Action ()
|
||||
-- ^ Action to perform when a special key is pressed
|
||||
}
|
||||
|
||||
-- | Parameters for a search prompt
|
||||
data SelectParams a = SelectParams
|
||||
{ spPrompt :: String
|
||||
-- ^ The search prompt
|
||||
, spSearchHeader :: String
|
||||
-- ^ The header to display at the top of the search list
|
||||
, spSearch :: String -> Database -> [(Int, a)]
|
||||
-- ^ The search function
|
||||
, spSearchExact :: String -> Database -> Maybe Int
|
||||
-- ^ Search function looking for an exact match
|
||||
, spElemDesc :: a -> String
|
||||
-- ^ Provides a string description of an element
|
||||
, spCallback :: Maybe Int -> Action ()
|
||||
-- ^ The function when the selection is made
|
||||
, spNotFound :: String -> Action ()
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''EditPlayerState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
makeLenses ''Goalie
|
||||
makeLenses ''GoalieStats
|
||||
makeLenses ''GameStats
|
||||
|
||||
gameStateL :: Lens' ProgMode GameState
|
||||
gameStateL = lens
|
||||
(\case
|
||||
@@ -616,11 +758,37 @@ editPlayerStateL = lens
|
||||
_ -> newEditPlayerState)
|
||||
(\_ eps -> EditPlayer eps)
|
||||
|
||||
editGoalieStateL :: Lens' ProgMode EditGoalieState
|
||||
editGoalieStateL = lens
|
||||
(\case
|
||||
EditGoalie egs -> egs
|
||||
_ -> newEditGoalieState)
|
||||
(\_ egs -> EditGoalie egs)
|
||||
|
||||
editStandingsModeL :: Lens' ProgMode EditStandingsMode
|
||||
editStandingsModeL = lens
|
||||
(\case
|
||||
EditStandings esm -> esm
|
||||
_ -> ESMMenu)
|
||||
(\_ esm -> EditStandings esm)
|
||||
|
||||
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
|
||||
esmSubModeL = lens
|
||||
(\case
|
||||
ESMMenu -> ESMSubMenu
|
||||
ESMHome m -> m
|
||||
ESMAway m -> m)
|
||||
(\mode subMode -> case mode of
|
||||
ESMMenu -> ESMMenu
|
||||
ESMHome _ -> ESMHome subMode
|
||||
ESMAway _ -> ESMAway subMode)
|
||||
|
||||
-- | Constructor for a 'ProgState'
|
||||
newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
{ _database = newDatabase
|
||||
, _progMode = MainMenu
|
||||
, _progMode = TitleScreen
|
||||
, _dbName = ""
|
||||
, _inputBuffer = ""
|
||||
, _scrollOffset = 0
|
||||
}
|
||||
@@ -658,6 +826,8 @@ newCreatePlayerState = CreatePlayerState
|
||||
{ _cpsNumber = Nothing
|
||||
, _cpsName = ""
|
||||
, _cpsPosition = ""
|
||||
, _cpsRookieFlag = Nothing
|
||||
, _cpsActiveFlag = Nothing
|
||||
, _cpsSuccessCallback = return ()
|
||||
, _cpsFailureCallback = return ()
|
||||
}
|
||||
@@ -667,6 +837,8 @@ newCreateGoalieState :: CreateGoalieState
|
||||
newCreateGoalieState = CreateGoalieState
|
||||
{ _cgsNumber = Nothing
|
||||
, _cgsName = ""
|
||||
, _cgsRookieFlag = Nothing
|
||||
, _cgsActiveFlag = Nothing
|
||||
, _cgsSuccessCallback = return ()
|
||||
, _cgsFailureCallback = return ()
|
||||
}
|
||||
@@ -676,6 +848,15 @@ newEditPlayerState :: EditPlayerState
|
||||
newEditPlayerState = EditPlayerState
|
||||
{ _epsSelectedPlayer = Nothing
|
||||
, _epsMode = EPMenu
|
||||
, _epsCallback = return ()
|
||||
}
|
||||
|
||||
-- | Constructor for an 'EditGoalieState' value
|
||||
newEditGoalieState :: EditGoalieState
|
||||
newEditGoalieState = EditGoalieState
|
||||
{ _egsSelectedGoalie = Nothing
|
||||
, _egsMode = EGMenu
|
||||
, _egsCallback = return ()
|
||||
}
|
||||
|
||||
-- | Constructor for a 'Database'
|
||||
@@ -701,6 +882,8 @@ newPlayer num name pos = Player
|
||||
{ _pNumber = num
|
||||
, _pName = name
|
||||
, _pPosition = pos
|
||||
, _pRookie = True
|
||||
, _pActive = True
|
||||
, _pYtd = newPlayerStats
|
||||
, _pLifetime = newPlayerStats
|
||||
}
|
||||
@@ -723,6 +906,8 @@ newGoalie
|
||||
newGoalie num name = Goalie
|
||||
{ _gNumber = num
|
||||
, _gName = name
|
||||
, _gRookie = True
|
||||
, _gActive = True
|
||||
, _gYtd = newGoalieStats
|
||||
, _gLifetime = newGoalieStats
|
||||
}
|
||||
@@ -733,6 +918,7 @@ newGoalieStats = GoalieStats
|
||||
{ _gsGames = 0
|
||||
, _gsMinsPlayed = 0
|
||||
, _gsGoalsAllowed = 0
|
||||
, _gsShutouts = 0
|
||||
, _gsWins = 0
|
||||
, _gsLosses = 0
|
||||
, _gsTies = 0
|
||||
@@ -819,6 +1005,23 @@ addGameStats s1 s2 = GameStats
|
||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
||||
}
|
||||
|
||||
-- | Searches through a list of players with a specified criteria
|
||||
playerSearchWith
|
||||
:: (Player -> Bool)
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The search string
|
||||
-> [Player]
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearchWith criteria sStr =
|
||||
filter match . zip [0..]
|
||||
where
|
||||
match (_, p)
|
||||
= map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||
&& criteria p
|
||||
|
||||
-- | Searches through a list of players
|
||||
playerSearch
|
||||
:: String
|
||||
@@ -827,10 +1030,17 @@ playerSearch
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearch sStr =
|
||||
filter (match sStr) .
|
||||
zip [0..]
|
||||
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
|
||||
playerSearch = playerSearchWith $ const True
|
||||
|
||||
-- | Searches through a list of players for an active player
|
||||
activePlayerSearch
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Player]
|
||||
-- ^ The list of players to search
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
activePlayerSearch = playerSearchWith (^.pActive)
|
||||
|
||||
-- | Searches for a player by exact match on name
|
||||
playerSearchExact
|
||||
@@ -841,10 +1051,8 @@ playerSearchExact
|
||||
-> Maybe (Int, Player)
|
||||
-- ^ The player's index and value
|
||||
playerSearchExact sStr =
|
||||
listToMaybe .
|
||||
filter (match sStr) .
|
||||
zip [0..]
|
||||
where match sStr (_, p) = p^.pName == sStr
|
||||
find match . zip [0..]
|
||||
where match (_, p) = p^.pName == sStr
|
||||
|
||||
-- | Modifies a player with a given name
|
||||
modifyPlayer
|
||||
@@ -866,20 +1074,6 @@ playerSummary :: Player -> String
|
||||
playerSummary p =
|
||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines
|
||||
[ " Number: " ++ show (p^.pNumber)
|
||||
, " Name: " ++ p^.pName
|
||||
, " Position: " ++ p^.pPosition
|
||||
, " YTD goals: " ++ show (p^.pYtd.psGoals)
|
||||
, " YTD assists: " ++ show (p^.pYtd.psAssists)
|
||||
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
|
||||
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
|
||||
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
|
||||
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
|
||||
]
|
||||
|
||||
-- | Determines whether or not a player has been active in the current
|
||||
-- season/year
|
||||
playerIsActive :: Player -> Bool
|
||||
@@ -901,6 +1095,23 @@ addPlayerStats s1 s2 = newPlayerStats
|
||||
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||
& psPMin .~ s1^.psPMin + s2^.psPMin
|
||||
|
||||
-- | Searches a list of goalies with a search criteria
|
||||
goalieSearchWith
|
||||
:: (Goalie -> Bool)
|
||||
-- ^ The search criteria
|
||||
-> String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearchWith criteria sStr =
|
||||
filter match . zip [0..]
|
||||
where
|
||||
match (_, g)
|
||||
= map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||
&& criteria g
|
||||
|
||||
-- | Searches a list of goalies
|
||||
goalieSearch
|
||||
:: String
|
||||
@@ -909,8 +1120,17 @@ goalieSearch
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
|
||||
zip [0..]
|
||||
goalieSearch = goalieSearchWith $ const True
|
||||
|
||||
-- | Searches a list of goalies for an active goalie
|
||||
activeGoalieSearch
|
||||
:: String
|
||||
-- ^ The search string
|
||||
-> [Goalie]
|
||||
-- ^ The list to search
|
||||
-> [(Int, Goalie)]
|
||||
-- ^ The search results with their corresponding index numbers
|
||||
activeGoalieSearch = goalieSearchWith (^.gActive)
|
||||
|
||||
-- | Searches a list of goalies for an exact match
|
||||
goalieSearchExact
|
||||
@@ -930,3 +1150,30 @@ goalieSearchExact sStr goalies = let
|
||||
-- | Provides a description string for a 'Goalie'
|
||||
goalieSummary :: Goalie -> String
|
||||
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
||||
|
||||
-- | Determines whether or not a goalie has been active in the current
|
||||
-- season
|
||||
goalieIsActive :: Goalie -> Bool
|
||||
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
|
||||
|
||||
-- | Adds two sets of 'GoalieStats'
|
||||
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
|
||||
addGoalieStats g1 g2 = GoalieStats
|
||||
{ _gsGames = g1^.gsGames + g2^.gsGames
|
||||
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
|
||||
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
|
||||
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
|
||||
, _gsWins = g1^.gsWins + g2^.gsWins
|
||||
, _gsLosses = g1^.gsLosses + g2^.gsLosses
|
||||
, _gsTies = g1^.gsTies + g2^.gsTies
|
||||
}
|
||||
|
||||
-- | Determines a goalie's average goals allowed per game.
|
||||
gsAverage :: GoalieStats -> Rational
|
||||
gsAverage gs = let
|
||||
allowed = fromIntegral $ gs^.gsGoalsAllowed
|
||||
mins = fromIntegral $ gs^.gsMinsPlayed
|
||||
gLen = fromIntegral gameLength
|
||||
in if mins == 0
|
||||
then 0
|
||||
else allowed / mins * gLen
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -38,8 +38,8 @@ module Mtlstats.Types.Menu (
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro.TH (makeLenses)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Defines a menu
|
||||
@@ -66,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
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,8 +19,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
||||
module Mtlstats.Util
|
||||
( nth
|
||||
, modifyNth
|
||||
, dropNth
|
||||
, updateMap
|
||||
, slice
|
||||
, capitalizeName
|
||||
) where
|
||||
|
||||
import Data.Char (isSpace, toUpper)
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- | Attempt to select the element from a list at a given index
|
||||
@@ -45,8 +53,21 @@ modifyNth
|
||||
-> [a]
|
||||
-- ^ The list
|
||||
-> [a]
|
||||
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
||||
. zip [0..]
|
||||
modifyNth n f = zipWith
|
||||
(\i x -> if i == n then f x else x)
|
||||
[0..]
|
||||
|
||||
-- | Attempt to drop the nth element from a list
|
||||
dropNth
|
||||
:: Int
|
||||
-- ^ The index of the element to drop
|
||||
-> [a]
|
||||
-- ^ The list to be modified
|
||||
-> [a]
|
||||
-- ^ The modified list
|
||||
dropNth n = foldr
|
||||
(\(i, x) acc -> if i == n then acc else x : acc)
|
||||
[] . zip [0..]
|
||||
|
||||
-- | Modify a value indexed by a given key in a map using a default
|
||||
-- initial value if not present
|
||||
@@ -75,3 +96,25 @@ slice
|
||||
-- ^ The list to take a subset of
|
||||
-> [a]
|
||||
slice offset len = take len . drop offset
|
||||
|
||||
-- | Name capitalization function for a player
|
||||
capitalizeName
|
||||
:: Char
|
||||
-- ^ The character being input
|
||||
-> String
|
||||
-- ^ The current string
|
||||
-> String
|
||||
-- ^ The resulting string
|
||||
capitalizeName ch str = str ++ [ch']
|
||||
where
|
||||
ch' = if lockFlag str
|
||||
then toUpper ch
|
||||
else ch
|
||||
lockFlag "" = True
|
||||
lockFlag (c:cs)
|
||||
| c == ',' = lockFlag' cs
|
||||
| otherwise = lockFlag cs
|
||||
lockFlag' "" = True
|
||||
lockFlag' (c:cs)
|
||||
| isSpace c = lockFlag' cs
|
||||
| otherwise = False
|
||||
|
||||
83
test/Actions/EditStandingsSpec.hs
Normal file
83
test/Actions/EditStandingsSpec.hs
Normal 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 )
|
||||
]
|
||||
@@ -1,291 +0,0 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.GoalieInputSpec (spec) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.GoalieInput
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Actions.GoalieInput" $ do
|
||||
finishGoalieEntrySpec
|
||||
recordGoalieStatsSpec
|
||||
setGameGoalieSpec
|
||||
|
||||
finishGoalieEntrySpec :: Spec
|
||||
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
|
||||
let
|
||||
progState stats = newProgState
|
||||
& progMode.gameStateL.gameGoalieStats .~ stats
|
||||
& finishGoalieEntry
|
||||
|
||||
context "no goalie data" $
|
||||
it "should not set goaliesRecorded" $ let
|
||||
s = progState M.empty
|
||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
|
||||
|
||||
context "goalie data" $
|
||||
it "should set goaliesRecorded" $ let
|
||||
s = progState $ M.fromList [(1, newGoalieStats)]
|
||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
|
||||
|
||||
recordGoalieStatsSpec :: Spec
|
||||
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
goalieStats games mins goals = newGoalieStats
|
||||
& gsGames .~ games
|
||||
& gsMinsPlayed .~ mins
|
||||
& gsGoalsAllowed .~ goals
|
||||
|
||||
joe = newGoalie 2 "Joe"
|
||||
& gYtd .~ goalieStats 10 11 12
|
||||
& gLifetime .~ goalieStats 20 21 22
|
||||
|
||||
bob = newGoalie 3 "Bob"
|
||||
& gYtd .~ goalieStats 30 31 32
|
||||
& gLifetime .~ goalieStats 40 41 42
|
||||
|
||||
gameState n mins goals = newGameState
|
||||
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)]
|
||||
& gameSelectedGoalie .~ n
|
||||
& gameGoalieMinsPlayed .~ mins
|
||||
& gameGoalsAllowed .~ goals
|
||||
|
||||
progState n mins goals = newProgState
|
||||
& database.dbGoalies .~ [joe, bob]
|
||||
& progMode.gameStateL .~ gameState n mins goals
|
||||
|
||||
in mapM_
|
||||
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
|
||||
s = recordGoalieStats $ progState gid mins goals
|
||||
in context name $ do
|
||||
|
||||
mapM_
|
||||
(\( name
|
||||
, gid
|
||||
, ( gGames
|
||||
, gMins
|
||||
, gGoals
|
||||
, ytdGames
|
||||
, ytdMins
|
||||
, ytdGoals
|
||||
, ltGames
|
||||
, ltMins
|
||||
, ltGoals
|
||||
)
|
||||
) -> context name $ do
|
||||
let
|
||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats gid gs
|
||||
goalie = fromJust $ nth gid $ s^.database.dbGoalies
|
||||
ytd = goalie^.gYtd
|
||||
lt = goalie^.gLifetime
|
||||
|
||||
context "game" $
|
||||
game `TS.compareTest` goalieStats gGames gMins gGoals
|
||||
|
||||
context "year-to-date" $
|
||||
ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
|
||||
|
||||
context "lifetime" $
|
||||
lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
|
||||
|
||||
[ ( "checking Joe", 0, joeData )
|
||||
, ( "checking Bob", 1, bobData )
|
||||
]
|
||||
|
||||
context "selected goalie" $ let
|
||||
expected = if reset then Nothing else gid
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||
|
||||
context "minutes played" $ let
|
||||
expected = if reset then Nothing else mins
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
|
||||
|
||||
context "goals allowed" $ let
|
||||
expected = if reset then Nothing else goals
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
|
||||
|
||||
[ ( "updating Joe"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (1, 1, 2, 11, 12, 14, 21, 22, 24)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, True
|
||||
)
|
||||
, ( "updating Bob"
|
||||
, Just 1
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 3, 5, 30, 32, 34, 40, 42, 44)
|
||||
, True
|
||||
)
|
||||
, ( "goalie out of bounds"
|
||||
, Just 2
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing goalie"
|
||||
, Nothing
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing minutes"
|
||||
, Just 0
|
||||
, Nothing
|
||||
, Just 1
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing goals"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Nothing
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
]
|
||||
|
||||
setGameGoalieSpec :: Spec
|
||||
setGameGoalieSpec = describe "setGameGoalie" $ let
|
||||
|
||||
goalieStats w l t = newGoalieStats
|
||||
& gsWins .~ w
|
||||
& gsLosses .~ l
|
||||
& gsTies .~ t
|
||||
|
||||
bob = newGoalie 2 "Bob"
|
||||
& gYtd .~ goalieStats 10 11 12
|
||||
& gLifetime .~ goalieStats 20 21 22
|
||||
|
||||
joe = newGoalie 3 "Joe"
|
||||
& gYtd .~ goalieStats 30 31 32
|
||||
& gLifetime .~ goalieStats 40 41 42
|
||||
|
||||
gameState h a ot = newGameState
|
||||
& gameType ?~ HomeGame
|
||||
& homeScore ?~ h
|
||||
& awayScore ?~ a
|
||||
& overtimeFlag ?~ ot
|
||||
|
||||
winningGame = gameState 1 0 False
|
||||
losingGame = gameState 0 1 False
|
||||
tiedGame = gameState 0 1 True
|
||||
|
||||
in mapM_
|
||||
(\(label, gameState, gid, bobData, joeData) -> context label $ let
|
||||
|
||||
progState = newProgState
|
||||
& database.dbGoalies .~ [bob, joe]
|
||||
& progMode.gameStateL .~ gameState
|
||||
& setGameGoalie gid
|
||||
|
||||
in mapM_
|
||||
(\( label
|
||||
, gid
|
||||
, ( gWins
|
||||
, gLosses
|
||||
, gTies
|
||||
, ytdWins
|
||||
, ytdLosses
|
||||
, ytdTies
|
||||
, ltWins
|
||||
, ltLosses
|
||||
, ltTies
|
||||
)
|
||||
) -> context label $ do
|
||||
let
|
||||
goalie = (progState^.database.dbGoalies) !! gid
|
||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats gid gameStats
|
||||
ytd = goalie^.gYtd
|
||||
lifetime = goalie^.gLifetime
|
||||
|
||||
mapM_
|
||||
(\(label, expected, actual) -> context label $
|
||||
expected `TS.compareTest` actual)
|
||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
|
||||
]
|
||||
|
||||
it "should set the gameGoalieAssigned flag" $
|
||||
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
|
||||
[ ( "checking Bob", 0, bobData )
|
||||
, ( "checking Joe", 1, joeData )
|
||||
])
|
||||
[ ( "Bob wins"
|
||||
, winningGame
|
||||
, 0
|
||||
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Bob loses"
|
||||
, losingGame
|
||||
, 0
|
||||
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Bob ties"
|
||||
, tiedGame
|
||||
, 0
|
||||
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
|
||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||
)
|
||||
, ( "Joe wins"
|
||||
, winningGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
|
||||
)
|
||||
, ( "Joe loses"
|
||||
, losingGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
|
||||
)
|
||||
, ( "Joe ties"
|
||||
, tiedGame
|
||||
, 1
|
||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
|
||||
)
|
||||
]
|
||||
382
test/Actions/NewGame/GoalieInputSpec.hs
Normal file
382
test/Actions/NewGame/GoalieInputSpec.hs
Normal file
@@ -0,0 +1,382 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.NewGame.GoalieInputSpec (spec) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.NewGame.GoalieInput
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "GoalieInput" $ do
|
||||
finishGoalieEntrySpec
|
||||
recordGoalieStatsSpec
|
||||
setGameGoalieSpec
|
||||
|
||||
finishGoalieEntrySpec :: Spec
|
||||
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
|
||||
|
||||
ps' = finishGoalieEntry ps
|
||||
gs = ps'^.progMode.gameStateL
|
||||
|
||||
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
|
||||
goalieStats games mins goals = newGoalieStats
|
||||
& gsGames .~ games
|
||||
& gsMinsPlayed .~ mins
|
||||
& gsGoalsAllowed .~ goals
|
||||
|
||||
joe = newGoalie 2 "Joe"
|
||||
& gYtd .~ goalieStats 10 11 12
|
||||
& gLifetime .~ goalieStats 20 21 22
|
||||
|
||||
bob = newGoalie 3 "Bob"
|
||||
& gYtd .~ goalieStats 30 31 32
|
||||
& gLifetime .~ goalieStats 40 41 42
|
||||
|
||||
gameState n mins goals = newGameState
|
||||
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)]
|
||||
& gameSelectedGoalie .~ n
|
||||
& gameGoalieMinsPlayed .~ mins
|
||||
& gameGoalsAllowed .~ goals
|
||||
|
||||
progState n mins goals = newProgState
|
||||
& database.dbGoalies .~ [joe, bob]
|
||||
& progMode.gameStateL .~ gameState n mins goals
|
||||
|
||||
in mapM_
|
||||
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
|
||||
s = recordGoalieStats $ progState setGid mins goals
|
||||
in context setName $ do
|
||||
|
||||
mapM_
|
||||
(\( chkName
|
||||
, chkGid
|
||||
, ( gGames
|
||||
, gMins
|
||||
, gGoals
|
||||
, ytdGames
|
||||
, ytdMins
|
||||
, ytdGoals
|
||||
, ltGames
|
||||
, ltMins
|
||||
, ltGoals
|
||||
)
|
||||
) -> context chkName $ do
|
||||
let
|
||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats chkGid gs
|
||||
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
|
||||
ytd = goalie^.gYtd
|
||||
lt = goalie^.gLifetime
|
||||
|
||||
context "game" $
|
||||
game `TS.compareTest` goalieStats gGames gMins gGoals
|
||||
|
||||
context "year-to-date" $
|
||||
ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
|
||||
|
||||
context "lifetime" $
|
||||
lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
|
||||
|
||||
[ ( "checking Joe", 0, joeData )
|
||||
, ( "checking Bob", 1, bobData )
|
||||
]
|
||||
|
||||
context "selected goalie" $ let
|
||||
expected = if reset then Nothing else setGid
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||
|
||||
context "minutes played" $ let
|
||||
expected = if reset then Nothing else mins
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
|
||||
|
||||
context "goals allowed" $ let
|
||||
expected = if reset then Nothing else goals
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
|
||||
|
||||
[ ( "updating Joe"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (1, 1, 2, 11, 12, 14, 21, 22, 24)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, True
|
||||
)
|
||||
, ( "updating Bob"
|
||||
, Just 1
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 3, 5, 30, 32, 34, 40, 42, 44)
|
||||
, True
|
||||
)
|
||||
, ( "goalie out of bounds"
|
||||
, Just 2
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing goalie"
|
||||
, Nothing
|
||||
, Just 1
|
||||
, Just 2
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing minutes"
|
||||
, Just 0
|
||||
, Nothing
|
||||
, Just 1
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
, ( "missing goals"
|
||||
, Just 0
|
||||
, Just 1
|
||||
, Nothing
|
||||
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||
, False
|
||||
)
|
||||
]
|
||||
|
||||
setGameGoalieSpec :: Spec
|
||||
setGameGoalieSpec = describe "setGameGoalie" $ mapM_
|
||||
|
||||
(\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
|
||||
context label $ do
|
||||
|
||||
let
|
||||
ps' = setGameGoalie goalieId ps
|
||||
[joe', bob'] = ps'^.database.dbGoalies
|
||||
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
|
||||
|
||||
context "Joe" $ joe' `TS.compareTest` expectedJoe
|
||||
context "Bob" $ bob' `TS.compareTest` expectedBob
|
||||
context "game stats" $ gStats' `TS.compareTest` expectedGStats)
|
||||
|
||||
[ ( "Joe wins - no shutout"
|
||||
, 0
|
||||
, psWin
|
||||
, joeWin
|
||||
, bob
|
||||
, gsJoeWin
|
||||
)
|
||||
|
||||
, ( "Bob wins - no shutout"
|
||||
, 1
|
||||
, psWin
|
||||
, joe
|
||||
, bobWin
|
||||
, gsBobWin
|
||||
)
|
||||
|
||||
, ( "Joe wins - shutout"
|
||||
, 0
|
||||
, psWinSO
|
||||
, joeWinSO
|
||||
, bob
|
||||
, gsJoeWinSO
|
||||
)
|
||||
|
||||
, ( "Bob wins - shutout"
|
||||
, 1
|
||||
, psWinSO
|
||||
, joe
|
||||
, bobWinSO
|
||||
, gsBobWinSO
|
||||
)
|
||||
|
||||
, ( "Joe loses"
|
||||
, 0
|
||||
, psLose
|
||||
, joeLose
|
||||
, bob
|
||||
, gsJoeLose
|
||||
)
|
||||
|
||||
, ( "Bob loses"
|
||||
, 1
|
||||
, psLose
|
||||
, joe
|
||||
, bobLose
|
||||
, gsBobLose
|
||||
)
|
||||
|
||||
, ( "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
|
||||
526
test/Actions/NewGameSpec.hs
Normal file
526
test/Actions/NewGameSpec.hs
Normal file
@@ -0,0 +1,526 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.NewGameSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.NewGame
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "NewGame" $ do
|
||||
overtimeCheckSpec
|
||||
updateGameStatsSpec
|
||||
validateGameDateSpec
|
||||
recordGoalAssistsSpec
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
awardShutoutsSpec
|
||||
GoalieInput.spec
|
||||
|
||||
overtimeCheckSpec :: Spec
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||
|
||||
context "tie game" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should clear the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||
|
||||
it "should clear the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||
|
||||
it "should leave the overtimeFlag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
context "game won" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||
|
||||
it "should set the overtimeCheck flag to False" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||
|
||||
context "game lost" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 2)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||
|
||||
it "should leave the overtimeCheck flag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
updateGameStatsSpec :: Spec
|
||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||
let
|
||||
|
||||
baseStats = newGameStats
|
||||
& gmsWins .~ 1
|
||||
& gmsLosses .~ 1
|
||||
& gmsOvertime .~ 1
|
||||
& gmsGoalsFor .~ 1
|
||||
& gmsGoalsAgainst .~ 1
|
||||
|
||||
s t h a o = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType .~ t)
|
||||
. (homeScore .~ h)
|
||||
. (awayScore .~ a)
|
||||
. (overtimeFlag .~ o)
|
||||
& database
|
||||
%~ (dbHomeGameStats .~ baseStats)
|
||||
. (dbAwayGameStats .~ baseStats)
|
||||
|
||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
||||
& dbHomeGameStats
|
||||
%~ (gmsWins .~ hw)
|
||||
. (gmsLosses .~ hl)
|
||||
. (gmsOvertime .~ ho)
|
||||
. (gmsGoalsFor .~ hf)
|
||||
. (gmsGoalsAgainst .~ ha)
|
||||
& dbAwayGameStats
|
||||
%~ (gmsWins .~ aw)
|
||||
. (gmsLosses .~ al)
|
||||
. (gmsOvertime .~ ao)
|
||||
. (gmsGoalsFor .~ af)
|
||||
. (gmsGoalsAgainst .~ aa)
|
||||
|
||||
context "home win" $
|
||||
it "should record a home win" $ let
|
||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
||||
|
||||
context "home loss" $
|
||||
it "should record a home loss" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
||||
|
||||
context "home overtime loss" $
|
||||
it "should record a home overtime" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
||||
|
||||
context "away win" $
|
||||
it "should record an away win" $ let
|
||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
||||
|
||||
context "away loss" $
|
||||
it "should record an away loss" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
||||
|
||||
context "away overtime loss" $
|
||||
it "should record an away overtime" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
||||
|
||||
context "missing game type" $
|
||||
it "should not change anything" $ let
|
||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing home score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing away score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing overtime flag" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
validateGameDateSpec :: Spec
|
||||
validateGameDateSpec = describe "validateGameDate" $ do
|
||||
|
||||
context "valid date" $
|
||||
it "should leave the date unchanged" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 6)
|
||||
. (gameDay ?~ 25)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
||||
|
||||
context "invalid date" $
|
||||
it "should clear the date" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 2)
|
||||
. (gameDay ?~ 30)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
context "missing day" $
|
||||
it "should not change anything" $ do
|
||||
let
|
||||
|
||||
gs = newGameState
|
||||
& gameYear ?~ 2019
|
||||
& gameMonth ?~ 6
|
||||
|
||||
s = newProgState
|
||||
& progMode.gameStateL .~ gs
|
||||
& validateGameDate
|
||||
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
recordGoalAssistsSpec :: Spec
|
||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||
let
|
||||
joe = newPlayer 1 "Joe" "centre"
|
||||
bob = newPlayer 2 "Bob" "defense"
|
||||
steve = newPlayer 3 "Steve" "forward"
|
||||
dave = newPlayer 4 "Dave" "somewhere"
|
||||
frank = newPlayer 5 "Frank" "elsewhere"
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy ?~ 0)
|
||||
. (assistsBy .~ [1, 2])
|
||||
. (confirmGoalDataFlag .~ True)
|
||||
& recordGoalAssists
|
||||
|
||||
mapM_
|
||||
(\(name, n, goals, assists) -> context name $ do
|
||||
let
|
||||
player = (ps^.database.dbPlayers) !! n
|
||||
stats = M.findWithDefault newPlayerStats n $
|
||||
ps^.progMode.gameStateL.gamePlayerStats
|
||||
|
||||
it ("should set the year-to-date goals to " ++ show goals) $
|
||||
player^.pYtd.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the lifetime goals to " ++ show goals) $
|
||||
player^.pLifetime.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the game goals to " ++ show goals) $
|
||||
stats^.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the year-to-date assists to " ++ show assists) $
|
||||
player^.pYtd.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the lifetime assists to " ++ show assists) $
|
||||
player^.pLifetime.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the game assists to " ++ show assists) $
|
||||
stats^.psAssists `shouldBe` assists)
|
||||
|
||||
-- name, index, goals, assists
|
||||
[ ( "Joe", 0, 1, 0 )
|
||||
, ( "Bob", 1, 0, 1 )
|
||||
, ( "Steve", 2, 0, 1 )
|
||||
, ( "Dave", 3, 0, 0 )
|
||||
]
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assistsBy list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should increment the pointsAccounted counter" $
|
||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
||||
|
||||
it "should clear the confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
awardGoalSpec :: Spec
|
||||
awardGoalSpec = describe "awardGoal" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 2 "Joe" "centre"
|
||||
& pYtd.psGoals .~ 1
|
||||
& pLifetime.psGoals .~ 2
|
||||
bob
|
||||
= newPlayer 3 "Bob" "defense"
|
||||
& pYtd.psGoals .~ 3
|
||||
& pLifetime.psGoals .~ 4
|
||||
db
|
||||
= newDatabase
|
||||
& dbPlayers .~ [joe, bob]
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psGoals .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database .~ db
|
||||
|
||||
mapM_
|
||||
(\(name, pid, ytd, lt, game) ->
|
||||
context name $ do
|
||||
let
|
||||
ps' = awardGoal pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ name ++ "'s year-to-date goals") $
|
||||
player^.pYtd.psGoals `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ name ++ "'s lifetime goals") $
|
||||
player^.pLifetime.psGoals `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ name ++ "'s game goals") $
|
||||
gStats^.psGoals `shouldBe` game)
|
||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardGoal 2 ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
context "negative index" $ let
|
||||
ps' = awardGoal (-1) ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
awardAssistSpec :: Spec
|
||||
awardAssistSpec = describe "awardAssist" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 1 "Joe" "centre"
|
||||
& pYtd.psAssists .~ 1
|
||||
& pLifetime.psAssists .~ 2
|
||||
bob
|
||||
= newPlayer 2 "Bob" "defense"
|
||||
& pYtd.psAssists .~ 3
|
||||
& pLifetime.psAssists .~ 4
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psAssists .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database.dbPlayers .~ [joe, bob]
|
||||
|
||||
mapM_
|
||||
(\(name, pid, ytd, lt, game) ->
|
||||
context name $ do
|
||||
let
|
||||
ps' = awardAssist pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ name ++ "'s year-to-date assists") $
|
||||
player^.pYtd.psAssists `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ name ++ "'s lifetime assists") $
|
||||
player^.pLifetime.psAssists `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ name ++ "'s game assists") $
|
||||
gStats^.psAssists `shouldBe` game)
|
||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardAssist (-1) ps
|
||||
in it "should not change anything" $
|
||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
||||
|
||||
resetGoalDataSpec :: Spec
|
||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
||||
players <- runIO $ replicateM 5 TS.makePlayer
|
||||
let
|
||||
gs
|
||||
= newGameState
|
||||
& goalBy ?~ 1
|
||||
& assistsBy .~ [2, 3]
|
||||
& confirmGoalDataFlag .~ True
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ players
|
||||
& progMode.gameStateL .~ gs
|
||||
& resetGoalData
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assists by list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should clear confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
assignPMinsSpec :: Spec
|
||||
assignPMinsSpec = describe "assignPMins" $ let
|
||||
|
||||
bob = newPlayer 2 "Bob" "centre"
|
||||
& pYtd.psPMin .~ 3
|
||||
& pLifetime.psPMin .~ 4
|
||||
|
||||
joe = newPlayer 3 "Joe" "defense"
|
||||
& pYtd.psPMin .~ 5
|
||||
& pLifetime.psPMin .~ 6
|
||||
|
||||
ps pid = newProgState
|
||||
& database.dbPlayers .~ [bob, joe]
|
||||
& progMode.gameStateL
|
||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||
. (gameSelectedPlayer .~ pid)
|
||||
|
||||
in mapM_
|
||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||
context ("selectedPlayer = " ++ show pid) $ do
|
||||
let ps' = assignPMins 2 $ ps pid
|
||||
|
||||
mapM_
|
||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||
let
|
||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||
|
||||
context "lifetime penalty minutes" $
|
||||
it ("should be " ++ show lt) $
|
||||
player^.pLifetime.psPMin `shouldBe` lt
|
||||
|
||||
context "year-to-date penalty minutes" $
|
||||
it ("should be " ++ show ytd) $
|
||||
player^.pYtd.psPMin `shouldBe` ytd
|
||||
|
||||
context "game penalty minutes" $
|
||||
it ("should be " ++ show game) $
|
||||
pStats^.psPMin `shouldBe` game)
|
||||
|
||||
-- name, index, lifetime, ytd, game
|
||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||
]
|
||||
|
||||
it "should set selectedPlayer to Nothing" $
|
||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
||||
|
||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
awardShutoutsSpec :: Spec
|
||||
awardShutoutsSpec = describe "awardShutouts" $ let
|
||||
joe = newGoalie 2 "Joe"
|
||||
& gYtd.gsShutouts .~ 1
|
||||
& gLifetime.gsShutouts .~ 2
|
||||
|
||||
bob = newGoalie 3 "Bob"
|
||||
& gYtd.gsShutouts .~ 3
|
||||
& gLifetime.gsShutouts .~ 4
|
||||
|
||||
steve = newGoalie 5 "Steve"
|
||||
& gYtd.gsShutouts .~ 5
|
||||
& gLifetime.gsShutouts .~ 6
|
||||
|
||||
ps = newProgState
|
||||
& database.dbGoalies .~ [joe, bob, steve]
|
||||
& progMode.gameStateL.gameGoalieStats .~ M.fromList
|
||||
[ ( 0, newGoalieStats & gsGoalsAllowed .~ 1 )
|
||||
, ( 1, newGoalieStats )
|
||||
]
|
||||
& awardShutouts
|
||||
|
||||
in mapM_
|
||||
(\(name, gid, expectedGame, expectedYtd, expectedLt) -> context name $ let
|
||||
game = M.findWithDefault newGoalieStats gid $
|
||||
ps^.progMode.gameStateL.gameGoalieStats
|
||||
goalie = (ps^.database.dbGoalies) !! gid
|
||||
in mapM_
|
||||
(\(label, actual, expected) -> context label $
|
||||
it ("should be " ++ show actual) $
|
||||
actual `shouldBe` expected)
|
||||
-- label, actual, expected
|
||||
[ ( "Game", game^.gsShutouts, expectedGame )
|
||||
, ( "YTD", goalie^.gYtd.gsShutouts, expectedYtd )
|
||||
, ( "lifetime", goalie^.gLifetime.gsShutouts, expectedLt )
|
||||
])
|
||||
-- goalie, goalie ID, Game, YTD, lifetime
|
||||
[ ( "Joe", 0, 0, 1, 2 )
|
||||
, ( "Bob", 1, 1, 4, 5 )
|
||||
, ( "Steve", 2, 0, 5, 6 )
|
||||
]
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -24,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module ActionsSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import System.Random (randomRIO)
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, context
|
||||
, describe
|
||||
, it
|
||||
, runIO
|
||||
, shouldBe
|
||||
, shouldNotBe
|
||||
, shouldSatisfy
|
||||
@@ -41,9 +37,9 @@ import Test.Hspec
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified Actions.GoalieInputSpec as GoalieInput
|
||||
import qualified Actions.NewGameSpec as NewGame
|
||||
import qualified Actions.EditStandingsSpec as EditStandings
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
@@ -51,27 +47,26 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
startNewSeasonSpec
|
||||
startNewGameSpec
|
||||
resetYtdSpec
|
||||
clearRookiesSpec
|
||||
resetStandingsSpec
|
||||
addCharSpec
|
||||
removeCharSpec
|
||||
overtimeCheckSpec
|
||||
updateGameStatsSpec
|
||||
validateGameDateSpec
|
||||
createPlayerSpec
|
||||
createGoalieSpec
|
||||
editSpec
|
||||
editPlayerSpec
|
||||
editSelectedPlayerSpec
|
||||
editGoalieSpec
|
||||
editSelectedGoalieSpec
|
||||
addPlayerSpec
|
||||
addGoalieSpec
|
||||
resetCreatePlayerStateSpec
|
||||
resetCreateGoalieStateSpec
|
||||
recordGoalAssistsSpec
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
backHomeSpec
|
||||
scrollUpSpec
|
||||
scrollDownSpec
|
||||
GoalieInput.spec
|
||||
NewGame.spec
|
||||
EditStandings.spec
|
||||
|
||||
startNewSeasonSpec :: Spec
|
||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||
@@ -99,8 +94,8 @@ startNewGameSpec = describe "startNewGame" $ do
|
||||
resetYtdSpec :: Spec
|
||||
resetYtdSpec = describe "resetYtd" $
|
||||
it "should reset the year-to-date stats for all players" $ do
|
||||
ps <- replicateM 2 makePlayer
|
||||
gs <- replicateM 2 makeGoalie
|
||||
ps <- replicateM 2 TS.makePlayer
|
||||
gs <- replicateM 2 TS.makeGoalie
|
||||
let
|
||||
s = newProgState
|
||||
& database . dbPlayers .~ ps
|
||||
@@ -137,6 +132,80 @@ 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
|
||||
home = GameStats
|
||||
{ _gmsWins = 1
|
||||
, _gmsLosses = 2
|
||||
, _gmsOvertime = 3
|
||||
, _gmsGoalsFor = 4
|
||||
, _gmsGoalsAgainst = 5
|
||||
}
|
||||
|
||||
away = GameStats
|
||||
{ _gmsWins = 6
|
||||
, _gmsLosses = 7
|
||||
, _gmsOvertime = 8
|
||||
, _gmsGoalsFor = 9
|
||||
, _gmsGoalsAgainst = 10
|
||||
}
|
||||
|
||||
db = newDatabase
|
||||
& dbHomeGameStats .~ home
|
||||
& dbAwayGameStats .~ away
|
||||
|
||||
ps = newProgState
|
||||
& database .~ db
|
||||
& resetStandings
|
||||
|
||||
context "home standings" $
|
||||
it "should be reset" $
|
||||
ps^.database.dbHomeGameStats `shouldBe` newGameStats
|
||||
|
||||
context "away standings" $
|
||||
it "should be reset" $
|
||||
ps^.database.dbAwayGameStats `shouldBe` newGameStats
|
||||
|
||||
addCharSpec :: Spec
|
||||
addCharSpec = describe "addChar" $
|
||||
it "should add the character to the input buffer" $ let
|
||||
@@ -160,202 +229,6 @@ removeCharSpec = describe "removeChar" $ do
|
||||
& removeChar
|
||||
in s ^. inputBuffer `shouldBe` "fo"
|
||||
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||
|
||||
context "tie game" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should clear the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||
|
||||
it "should clear the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||
|
||||
it "should leave the overtimeFlag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
context "game won" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||
|
||||
it "should set the overtimeCheck flag to False" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||
|
||||
context "game lost" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 2)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||
|
||||
it "should leave the overtimeCheck flag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
updateGameStatsSpec :: Spec
|
||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||
let
|
||||
|
||||
baseStats = newGameStats
|
||||
& gmsWins .~ 1
|
||||
& gmsLosses .~ 1
|
||||
& gmsOvertime .~ 1
|
||||
& gmsGoalsFor .~ 1
|
||||
& gmsGoalsAgainst .~ 1
|
||||
|
||||
s t h a o = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType .~ t)
|
||||
. (homeScore .~ h)
|
||||
. (awayScore .~ a)
|
||||
. (overtimeFlag .~ o)
|
||||
& database
|
||||
%~ (dbHomeGameStats .~ baseStats)
|
||||
. (dbAwayGameStats .~ baseStats)
|
||||
|
||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
||||
& dbHomeGameStats
|
||||
%~ (gmsWins .~ hw)
|
||||
. (gmsLosses .~ hl)
|
||||
. (gmsOvertime .~ ho)
|
||||
. (gmsGoalsFor .~ hf)
|
||||
. (gmsGoalsAgainst .~ ha)
|
||||
& dbAwayGameStats
|
||||
%~ (gmsWins .~ aw)
|
||||
. (gmsLosses .~ al)
|
||||
. (gmsOvertime .~ ao)
|
||||
. (gmsGoalsFor .~ af)
|
||||
. (gmsGoalsAgainst .~ aa)
|
||||
|
||||
context "home win" $
|
||||
it "should record a home win" $ let
|
||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
||||
|
||||
context "home loss" $
|
||||
it "should record a home loss" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
||||
|
||||
context "home overtime loss" $
|
||||
it "should record a home overtime" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
||||
|
||||
context "away win" $
|
||||
it "should record an away win" $ let
|
||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
||||
|
||||
context "away loss" $
|
||||
it "should record an away loss" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
||||
|
||||
context "away overtime loss" $
|
||||
it "should record an away overtime" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
||||
|
||||
context "missing game type" $
|
||||
it "should not change anything" $ let
|
||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing home score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing away score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing overtime flag" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
validateGameDateSpec :: Spec
|
||||
validateGameDateSpec = describe "validateGameDate" $ do
|
||||
|
||||
context "valid date" $
|
||||
it "should leave the date unchanged" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 6)
|
||||
. (gameDay ?~ 25)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
||||
|
||||
context "invalid date" $
|
||||
it "should clear the date" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 2)
|
||||
. (gameDay ?~ 30)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
context "missing day" $
|
||||
it "should not change anything" $ do
|
||||
let
|
||||
|
||||
gs = newGameState
|
||||
& gameYear ?~ 2019
|
||||
& gameMonth ?~ 6
|
||||
|
||||
s = newProgState
|
||||
& progMode.gameStateL .~ gs
|
||||
& validateGameDate
|
||||
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
createPlayerSpec :: Spec
|
||||
createPlayerSpec = describe "createPlayer" $
|
||||
it "should change the mode appropriately" $ let
|
||||
@@ -368,58 +241,164 @@ createGoalieSpec = describe "createGoalie" $
|
||||
s = createGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||
|
||||
editSpec :: Spec
|
||||
editSpec = describe "edit" $
|
||||
it "should change the mode to EditMenu" $ let
|
||||
ps = edit newProgState
|
||||
in show (ps^.progMode) `shouldBe` "EditMenu"
|
||||
|
||||
editPlayerSpec :: Spec
|
||||
editPlayerSpec = describe "editPlayer" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = editPlayer newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||
|
||||
editSelectedPlayerSpec :: Spec
|
||||
editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
|
||||
(\(label, pState, expected) -> context label $
|
||||
it "should edit the players appropriately" $ let
|
||||
pState' = editSelectedPlayer (pName .~ "foo") pState
|
||||
players' = pState'^.database.dbPlayers
|
||||
in players' `shouldBe` expected)
|
||||
|
||||
-- label, initial state, expected
|
||||
[ ( "wrong mode", baseState, players )
|
||||
, ( "not selected", changePlayer Nothing, players )
|
||||
, ( "player 0", changePlayer $ Just 0, changed0 )
|
||||
, ( "player 1", changePlayer $ Just 1, changed1 )
|
||||
, ( "out of bounds", changePlayer $ Just 2, players )
|
||||
]
|
||||
|
||||
where
|
||||
baseState = newProgState & database.dbPlayers .~ players
|
||||
changePlayer n = baseState
|
||||
& (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
|
||||
players = [ player 0, player 1 ]
|
||||
changed0 = [ player' 0, player 1 ]
|
||||
changed1 = [ player 0, player' 1 ]
|
||||
player n = newPlayer n ("Player " ++ show n) "pos"
|
||||
player' n = newPlayer n "foo" "pos"
|
||||
|
||||
editGoalieSpec :: Spec
|
||||
editGoalieSpec = describe "editGoalie" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = editGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||
|
||||
editSelectedGoalieSpec :: Spec
|
||||
editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
|
||||
(\(label, pState, expected) -> context label $
|
||||
it "should edit the goalies appropriately" $ let
|
||||
pState' = editSelectedGoalie (gName .~ "foo") pState
|
||||
goalies' = pState'^.database.dbGoalies
|
||||
in goalies' `shouldBe` expected)
|
||||
|
||||
-- label, initial state, expected
|
||||
[ ( "wrong mode", baseState, goalies )
|
||||
, ( "not selected", changeGoalie Nothing, goalies )
|
||||
, ( "goalie 0", changeGoalie $ Just 0, changed0 )
|
||||
, ( "goalie 1", changeGoalie $ Just 1, changed1 )
|
||||
, ( "out of bounds", changeGoalie $ Just 2, goalies )
|
||||
]
|
||||
|
||||
where
|
||||
baseState = newProgState & database.dbGoalies .~ goalies
|
||||
changeGoalie n = baseState
|
||||
& (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
|
||||
goalies = [ goalie 0, goalie 1 ]
|
||||
changed0 = [ goalie' 0, goalie 1 ]
|
||||
changed1 = [ goalie 0, goalie' 1 ]
|
||||
goalie n = newGoalie n ("Player " ++ show n)
|
||||
goalie' n = newGoalie n "foo"
|
||||
|
||||
addPlayerSpec :: Spec
|
||||
addPlayerSpec = describe "addPlayer" $ do
|
||||
let
|
||||
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
|
||||
@@ -440,281 +419,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
||||
newProgState & progMode.createGoalieStateL .~ cgs
|
||||
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||
|
||||
recordGoalAssistsSpec :: Spec
|
||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||
let
|
||||
joe = newPlayer 1 "Joe" "centre"
|
||||
bob = newPlayer 2 "Bob" "defense"
|
||||
steve = newPlayer 3 "Steve" "forward"
|
||||
dave = newPlayer 4 "Dave" "somewhere"
|
||||
frank = newPlayer 5 "Frank" "elsewhere"
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy ?~ 0)
|
||||
. (assistsBy .~ [1, 2])
|
||||
. (confirmGoalDataFlag .~ True)
|
||||
& recordGoalAssists
|
||||
|
||||
mapM_
|
||||
(\(name, n, goals, assists) -> context name $ do
|
||||
let
|
||||
player = (ps^.database.dbPlayers) !! n
|
||||
stats = M.findWithDefault newPlayerStats n $
|
||||
ps^.progMode.gameStateL.gamePlayerStats
|
||||
|
||||
it ("should set the year-to-date goals to " ++ show goals) $
|
||||
player^.pYtd.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the lifetime goals to " ++ show goals) $
|
||||
player^.pLifetime.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the game goals to " ++ show goals) $
|
||||
stats^.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the year-to-date assists to " ++ show assists) $
|
||||
player^.pYtd.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the lifetime assists to " ++ show assists) $
|
||||
player^.pLifetime.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the game assists to " ++ show assists) $
|
||||
stats^.psAssists `shouldBe` assists)
|
||||
|
||||
-- name, index, goals, assists
|
||||
[ ( "Joe", 0, 1, 0 )
|
||||
, ( "Bob", 1, 0, 1 )
|
||||
, ( "Steve", 2, 0, 1 )
|
||||
, ( "Dave", 3, 0, 0 )
|
||||
]
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assistsBy list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should increment the pointsAccounted counter" $
|
||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
||||
|
||||
it "should clear the confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
awardGoalSpec :: Spec
|
||||
awardGoalSpec = describe "awardGoal" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 2 "Joe" "centre"
|
||||
& pYtd.psGoals .~ 1
|
||||
& pLifetime.psGoals .~ 2
|
||||
bob
|
||||
= newPlayer 3 "Bob" "defense"
|
||||
& pYtd.psGoals .~ 3
|
||||
& pLifetime.psGoals .~ 4
|
||||
db
|
||||
= newDatabase
|
||||
& dbPlayers .~ [joe, bob]
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psGoals .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database .~ db
|
||||
|
||||
mapM_
|
||||
(\(pName, pid, ytd, lt, game) ->
|
||||
context pName $ do
|
||||
let
|
||||
ps' = awardGoal pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ pName ++ "'s year-to-date goals") $
|
||||
player^.pYtd.psGoals `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ pName ++ "'s lifetime goals") $
|
||||
player^.pLifetime.psGoals `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ pName ++ "'s game goals") $
|
||||
gStats^.psGoals `shouldBe` game)
|
||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardGoal 2 ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
context "negative index" $ let
|
||||
ps' = awardGoal (-1) ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
awardAssistSpec :: Spec
|
||||
awardAssistSpec = describe "awardAssist" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 1 "Joe" "centre"
|
||||
& pYtd.psAssists .~ 1
|
||||
& pLifetime.psAssists .~ 2
|
||||
bob
|
||||
= newPlayer 2 "Bob" "defense"
|
||||
& pYtd.psAssists .~ 3
|
||||
& pLifetime.psAssists .~ 4
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psAssists .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database.dbPlayers .~ [joe, bob]
|
||||
|
||||
mapM_
|
||||
(\(pName, pid, ytd, lt, game) ->
|
||||
context pName $ do
|
||||
let
|
||||
ps' = awardAssist pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ pName ++ "'s year-to-date assists") $
|
||||
player^.pYtd.psAssists `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ pName ++ "'s lifetime assists") $
|
||||
player^.pLifetime.psAssists `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ pName ++ "'s game assists") $
|
||||
gStats^.psAssists `shouldBe` game)
|
||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardAssist (-1) ps
|
||||
in it "should not change anything" $
|
||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
||||
|
||||
resetGoalDataSpec :: Spec
|
||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
||||
players <- runIO $ replicateM 5 makePlayer
|
||||
let
|
||||
gs
|
||||
= newGameState
|
||||
& goalBy ?~ 1
|
||||
& assistsBy .~ [2, 3]
|
||||
& confirmGoalDataFlag .~ True
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ players
|
||||
& progMode.gameStateL .~ gs
|
||||
& resetGoalData
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assists by list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should clear confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
assignPMinsSpec :: Spec
|
||||
assignPMinsSpec = describe "assignPMins" $ let
|
||||
|
||||
bob = newPlayer 2 "Bob" "centre"
|
||||
& pYtd.psPMin .~ 3
|
||||
& pLifetime.psPMin .~ 4
|
||||
|
||||
joe = newPlayer 3 "Joe" "defense"
|
||||
& pYtd.psPMin .~ 5
|
||||
& pLifetime.psPMin .~ 6
|
||||
|
||||
ps pid = newProgState
|
||||
& database.dbPlayers .~ [bob, joe]
|
||||
& progMode.gameStateL
|
||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||
. (gameSelectedPlayer .~ pid)
|
||||
|
||||
in mapM_
|
||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||
context ("selectedPlayer = " ++ show pid) $ do
|
||||
let ps' = assignPMins 2 $ ps pid
|
||||
|
||||
mapM_
|
||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||
let
|
||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||
|
||||
context "lifetime penalty minutes" $
|
||||
it ("should be " ++ show lt) $
|
||||
player^.pLifetime.psPMin `shouldBe` lt
|
||||
|
||||
context "year-to-date penalty minutes" $
|
||||
it ("should be " ++ show ytd) $
|
||||
player^.pYtd.psPMin `shouldBe` ytd
|
||||
|
||||
context "game penalty minutes" $
|
||||
it ("should be " ++ show game) $
|
||||
pStats^.psPMin `shouldBe` game)
|
||||
|
||||
-- name, index, lifetime, ytd, game
|
||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||
]
|
||||
|
||||
it "should set selectedPlayer to Nothing" $
|
||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
||||
|
||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeName
|
||||
<*> makePlayerStats
|
||||
<*> makePlayerStats
|
||||
|
||||
makeGoalie :: IO Goalie
|
||||
makeGoalie = Goalie
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeGoalieStats
|
||||
<*> makeGoalieStats
|
||||
|
||||
makePlayerStats :: IO PlayerStats
|
||||
makePlayerStats = PlayerStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeGoalieStats :: IO GoalieStats
|
||||
makeGoalieStats = GoalieStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
backHomeSpec :: Spec
|
||||
backHomeSpec = describe "backHome" $ do
|
||||
let
|
||||
@@ -755,6 +459,7 @@ scrollUpSpec = describe "scrollUp" $ do
|
||||
ps' = scrollUp ps
|
||||
in ps'^.scrollOffset `shouldBe` 0
|
||||
|
||||
scrollDownSpec :: Spec
|
||||
scrollDownSpec = describe "scrollDown" $
|
||||
it "should increase the scroll offset" $ let
|
||||
ps = newProgState & scrollOffset .~ 10
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module FormatSpec (spec) where
|
||||
|
||||
import Data.Ratio ((%))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Format" $ do
|
||||
@@ -31,8 +33,15 @@ spec = describe "Mtlstats.Format" $ do
|
||||
leftSpec
|
||||
rightSpec
|
||||
centreSpec
|
||||
padRightSpec
|
||||
overlaySpec
|
||||
monthSpec
|
||||
labelTableSpec
|
||||
numTableSpec
|
||||
tableWithSpec
|
||||
complexTableSpec
|
||||
overlayLastSpec
|
||||
showFloatingSpec
|
||||
|
||||
padNumSpec :: Spec
|
||||
padNumSpec = describe "padNum" $ do
|
||||
@@ -90,6 +99,16 @@ centreSpec = describe "centre" $ do
|
||||
it "should truncate the text" $
|
||||
centre 2 "foo" `shouldBe` "fo"
|
||||
|
||||
padRightSpec :: Spec
|
||||
padRightSpec = describe "padRight" $ mapM_
|
||||
(\(label, width, str, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
padRight width str `shouldBe` expected)
|
||||
-- label, width, input string, expected
|
||||
[ ( "text shorter", 5, "foo", "foo " )
|
||||
, ( "text longer", 3, "foobar", "foobar" )
|
||||
]
|
||||
|
||||
overlaySpec :: Spec
|
||||
overlaySpec = describe "overlay" $ do
|
||||
|
||||
@@ -111,3 +130,120 @@ monthSpec = describe "month" $ do
|
||||
context "invalid" $
|
||||
it "should return an empty string" $
|
||||
month 0 `shouldBe` ""
|
||||
|
||||
labelTableSpec :: Spec
|
||||
labelTableSpec = describe "labelTable" $
|
||||
it "should format the table" $ let
|
||||
input =
|
||||
[ ( "foo", "bar" )
|
||||
, ( "baz", "quux" )
|
||||
, ( "longer", "x" )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo: bar"
|
||||
, " baz: quux"
|
||||
, "longer: x"
|
||||
]
|
||||
|
||||
in labelTable input `shouldBe` expected
|
||||
|
||||
numTableSpec :: Spec
|
||||
numTableSpec = describe "numTable" $
|
||||
it "should format the table" $ let
|
||||
headers = ["foo", "bar", "baz"]
|
||||
|
||||
rows =
|
||||
[ ( "quux", [ 1, 2, 3 ] )
|
||||
, ( "xyzzy", [ 9, 99, 999 ] )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo bar baz"
|
||||
, " quux 1 2 3"
|
||||
, "xyzzy 9 99 999"
|
||||
]
|
||||
|
||||
in numTable headers rows `shouldBe` expected
|
||||
|
||||
tableWithSpec :: Spec
|
||||
tableWithSpec = describe "tableWith" $ let
|
||||
vals =
|
||||
[ [ "foo", "bar", "baz" ]
|
||||
, [ "quux", "xyzzy", "x" ]
|
||||
]
|
||||
|
||||
in mapM_
|
||||
(\(label, func, expected) -> context label $
|
||||
it "should format the table" $
|
||||
tableWith func vals `shouldBe` expected)
|
||||
[ ( "align left"
|
||||
, left
|
||||
, [ "foo bar baz"
|
||||
, "quux xyzzy x "
|
||||
]
|
||||
)
|
||||
, ( "align right"
|
||||
, right
|
||||
, [ " foo bar baz"
|
||||
, "quux xyzzy x"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
complexTableSpec :: Spec
|
||||
complexTableSpec = describe "complexTable" $ mapM_
|
||||
(\(label, pFuncs, cells, expected) -> context label $
|
||||
it "should format correctly" $
|
||||
complexTable pFuncs cells `shouldBe` expected)
|
||||
[ ( "no fill"
|
||||
, [left, right]
|
||||
, [ [ CellText "foo", CellText "bar" ]
|
||||
, [ CellText "baaz", CellText "quux" ]
|
||||
]
|
||||
, [ "foo bar"
|
||||
, "baaz quux"
|
||||
]
|
||||
)
|
||||
, ( "with fill"
|
||||
, [left, left, left]
|
||||
, [ [ CellText "foo", CellText "bar", CellText "baz" ]
|
||||
, [ CellText "quux", CellFill '-', CellFill '@' ]
|
||||
]
|
||||
, [ "foo bar baz"
|
||||
, "quux ----@@@"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
overlayLastSpec :: Spec
|
||||
overlayLastSpec = describe "overlayLast" $ let
|
||||
text = "foo"
|
||||
|
||||
sample =
|
||||
[ "line 1"
|
||||
, "line 2"
|
||||
]
|
||||
|
||||
edited =
|
||||
[ "line 1"
|
||||
, "fooe 2"
|
||||
]
|
||||
|
||||
in mapM_
|
||||
(\(label, input, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
overlayLast text input `shouldBe` expected)
|
||||
|
||||
-- label, input, expected
|
||||
[ ( "empty list", [], [] )
|
||||
, ( "non-empty list", sample, edited )
|
||||
]
|
||||
|
||||
showFloatingSpec :: Spec
|
||||
showFloatingSpec = describe "showFloating" $ let
|
||||
input = 3 % 2 :: Rational
|
||||
expected = "1.50"
|
||||
|
||||
in it ("should be " ++ expected) $
|
||||
showFloating input `shouldBe` expected
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
|
||||
91
test/Helpers/GoalieSpec.hs
Normal file
91
test/Helpers/GoalieSpec.hs
Normal file
@@ -0,0 +1,91 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.GoalieSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Goalie" $ do
|
||||
goalieDetailsSpec
|
||||
goalieNameSpec
|
||||
|
||||
goalieDetailsSpec :: Spec
|
||||
goalieDetailsSpec = describe "goalieDetails" $ let
|
||||
input = newGoalie 1 "Joe"
|
||||
& gRookie .~ True
|
||||
& gYtd
|
||||
%~ ( gsGames .~ 2 )
|
||||
. ( gsMinsPlayed .~ 3 )
|
||||
. ( gsGoalsAllowed .~ 4 )
|
||||
. ( gsShutouts .~ 5 )
|
||||
. ( gsWins .~ 6 )
|
||||
. ( gsLosses .~ 7 )
|
||||
. ( gsTies .~ 8 )
|
||||
& gLifetime
|
||||
%~ ( gsGames .~ 9 )
|
||||
. ( gsMinsPlayed .~ 10 )
|
||||
. ( gsGoalsAllowed .~ 11 )
|
||||
. ( gsShutouts .~ 12 )
|
||||
. ( gsWins .~ 13 )
|
||||
. ( gsLosses .~ 14 )
|
||||
. ( gsTies .~ 15 )
|
||||
|
||||
expected = unlines
|
||||
[ "Number: 1"
|
||||
, " Name: Joe*"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Games played 2 9"
|
||||
, " Mins played 3 10"
|
||||
, "Goals allowed 4 11"
|
||||
, " Shutouts 5 12"
|
||||
, " Wins 6 13"
|
||||
, " Losses 7 14"
|
||||
, " Ties 8 15"
|
||||
]
|
||||
|
||||
in it "should format the output correctly" $
|
||||
goalieDetails input `shouldBe` expected
|
||||
|
||||
goalieNameSpec :: Spec
|
||||
goalieNameSpec = describe "goalieName" $ mapM_
|
||||
(\(label, g, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
goalieName g `shouldBe` expected)
|
||||
|
||||
-- label, goalie, expected
|
||||
[ ( "rookie", rookie, "foo*" )
|
||||
, ( "non-rookie", active, "foo" )
|
||||
, ( "retired", retired, "*foo" )
|
||||
]
|
||||
|
||||
where
|
||||
rookie = goalie True True
|
||||
active = goalie False True
|
||||
retired = goalie False False
|
||||
goalie r a = newGoalie 1 "foo"
|
||||
& gRookie .~ r
|
||||
& gActive .~ a
|
||||
83
test/Helpers/PlayerSpec.hs
Normal file
83
test/Helpers/PlayerSpec.hs
Normal file
@@ -0,0 +1,83 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.PlayerSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Player" $ do
|
||||
playerDetailsSpec
|
||||
playerNameSpec
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
p = newPlayer 1 "Joe" "centre"
|
||||
& pRookie .~ True
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe*"
|
||||
, "Position: centre"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Goals 2 5"
|
||||
, " Assists 3 6"
|
||||
, "Penalty mins 4 7"
|
||||
]
|
||||
|
||||
in playerDetails p `shouldBe` expected
|
||||
|
||||
playerNameSpec :: Spec
|
||||
playerNameSpec = describe "playerName" $ mapM_
|
||||
(\(label, p, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
playerName p `shouldBe` expected)
|
||||
|
||||
-- label, player, expected
|
||||
[ ( "rookie", rookie, "foo*" )
|
||||
, ( "non-rookie", nonRookie, "foo" )
|
||||
, ( "retired", retired, "*foo" )
|
||||
]
|
||||
|
||||
where
|
||||
rookie = player True True
|
||||
nonRookie = player False True
|
||||
retired = player False False
|
||||
player r a = newPlayer 1 "foo" "centre"
|
||||
& pRookie .~ r
|
||||
& pActive .~ a
|
||||
79
test/Helpers/PositionSpec.hs
Normal file
79
test/Helpers/PositionSpec.hs
Normal 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"
|
||||
]
|
||||
34
test/HelpersSpec.hs
Normal file
34
test/HelpersSpec.hs
Normal file
@@ -0,0 +1,34 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module HelpersSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, describe)
|
||||
|
||||
import qualified Helpers.GoalieSpec as Goalie
|
||||
import qualified Helpers.PlayerSpec as Player
|
||||
import qualified Helpers.PositionSpec as Position
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Helper" $ do
|
||||
Player.spec
|
||||
Goalie.spec
|
||||
Position.spec
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -21,16 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module ReportSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (?~), (%~))
|
||||
import Lens.Micro ((&), (?~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Report" $ do
|
||||
spec = describe "Mtlstats.Report"
|
||||
gameDateSpec
|
||||
playerNameColWidthSpec
|
||||
|
||||
gameDateSpec :: Spec
|
||||
gameDateSpec = describe "gameDate" $ do
|
||||
@@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
|
||||
context "invalid date" $
|
||||
it "should return an empty string" $
|
||||
gameDate newGameState `shouldBe` ""
|
||||
|
||||
playerNameColWidthSpec :: Spec
|
||||
playerNameColWidthSpec = describe "playerNameColWidth" $ do
|
||||
let
|
||||
short1 = newPlayer 1 "short" "foo"
|
||||
short2 = newPlayer 2 "shorty" "bar"
|
||||
long = newPlayer 3 "123456789012345" "baz"
|
||||
|
||||
mapM_
|
||||
(\(label, players, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerNameColWidth players `shouldBe` expected)
|
||||
-- label, players, expected
|
||||
[ ( "empty list", [], 10 )
|
||||
, ( "short names", [short1, short2], 10 )
|
||||
, ( "long name", [short1, long], 16 )
|
||||
]
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
|
||||
import qualified ActionsSpec as Actions
|
||||
import qualified FormatSpec as Format
|
||||
import qualified HandlersSpec as Handlers
|
||||
import qualified HelpersSpec as Helpers
|
||||
import qualified ReportSpec as Report
|
||||
import qualified TypesSpec as Types
|
||||
import qualified UtilSpec as Util
|
||||
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
Types.spec
|
||||
Helpers.spec
|
||||
Actions.spec
|
||||
Format.spec
|
||||
Handlers.spec
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -37,11 +37,11 @@ showSpec :: Spec
|
||||
showSpec = describe "show" $
|
||||
it "should display correctly" $ let
|
||||
menu = Menu "Foo" ()
|
||||
[ MenuItem '1' "Item 1" $ return ()
|
||||
, MenuItem '2' "Item 2" $ return ()
|
||||
[ MenuItem '1' "foo" $ return ()
|
||||
, MenuItem '2' "bar baz" $ return ()
|
||||
]
|
||||
expected =
|
||||
"Foo\n\
|
||||
\1) Item 1\n\
|
||||
\2) Item 2\n"
|
||||
"Foo\n\n\
|
||||
\1: foo \n\
|
||||
\2: bar baz\n"
|
||||
in show menu `shouldBe` expected
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -19,15 +19,25 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
|
||||
|
||||
module TypesSpec (Comparable (..), spec) where
|
||||
module TypesSpec
|
||||
( Comparable (..)
|
||||
, spec
|
||||
, makePlayer
|
||||
, makeGoalie
|
||||
, makePlayerStats
|
||||
, makeGoalieStats
|
||||
) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||
import Data.Aeson.Types (Value (Object))
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import qualified Data.Map.Lazy as M
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Ratio ((%))
|
||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||
import System.Random (randomIO, randomRIO)
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Config
|
||||
@@ -48,6 +58,9 @@ spec = describe "Mtlstats.Types" $ do
|
||||
createPlayerStateLSpec
|
||||
createGoalieStateLSpec
|
||||
editPlayerStateLSpec
|
||||
editGoalieStateLSpec
|
||||
editStandingsModeLSpec
|
||||
esmSubModeLSpec
|
||||
teamScoreSpec
|
||||
otherScoreSpec
|
||||
homeTeamSpec
|
||||
@@ -60,16 +73,20 @@ spec = describe "Mtlstats.Types" $ do
|
||||
gmsPointsSpec
|
||||
addGameStatsSpec
|
||||
playerSearchSpec
|
||||
activePlayerSearchSpec
|
||||
playerSearchExactSpec
|
||||
modifyPlayerSpec
|
||||
playerSummarySpec
|
||||
playerDetailsSpec
|
||||
playerIsActiveSpec
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
goalieSearchSpec
|
||||
activeGoalieSearchSpec
|
||||
goalieSearchExactSpec
|
||||
goalieSummarySpec
|
||||
goalieIsActiveSpec
|
||||
addGoalieStatsSpec
|
||||
gsAverageSpec
|
||||
Menu.spec
|
||||
|
||||
playerSpec :: Spec
|
||||
@@ -161,6 +178,65 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
|
||||
eps2 = newEditPlayerState
|
||||
& epsSelectedPlayer ?~ 2
|
||||
|
||||
editGoalieStateLSpec :: Spec
|
||||
editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||
lensSpec editGoalieStateL
|
||||
-- getters
|
||||
[ ( "missing state", MainMenu, newEditGoalieState )
|
||||
, ( "with state", EditGoalie egs1, egs1 )
|
||||
]
|
||||
-- setters
|
||||
[ ( "set state", MainMenu, egs1 )
|
||||
, ( "change state", EditGoalie egs1, egs2 )
|
||||
, ( "clear state", EditGoalie egs1, newEditGoalieState )
|
||||
]
|
||||
where
|
||||
egs1 = newEditGoalieState
|
||||
& egsSelectedGoalie ?~ 1
|
||||
egs2 = newEditGoalieState
|
||||
& egsSelectedGoalie ?~ 2
|
||||
|
||||
editStandingsModeLSpec :: Spec
|
||||
editStandingsModeLSpec = describe "editStandingsModeL" $
|
||||
lensSpec editStandingsModeL
|
||||
-- getters
|
||||
[ ( "missing mode", MainMenu, menu )
|
||||
, ( "with mode", EditStandings home, home )
|
||||
]
|
||||
-- setters
|
||||
[ ( "set mode", MainMenu, home )
|
||||
, ( "change mode", EditStandings home, away )
|
||||
]
|
||||
where
|
||||
menu = ESMMenu
|
||||
home = ESMHome ESMSubMenu
|
||||
away = ESMAway ESMSubMenu
|
||||
|
||||
esmSubModeLSpec :: Spec
|
||||
esmSubModeLSpec = describe "esmSubModeL" $ do
|
||||
|
||||
context "getters" $ mapM_
|
||||
(\(label, mode, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
mode^.esmSubModeL `shouldBe` expected)
|
||||
|
||||
-- label, mode, expected
|
||||
[ ( "no state", ESMMenu, ESMSubMenu )
|
||||
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
|
||||
]
|
||||
|
||||
context "setters" $ mapM_
|
||||
(\(label, mode, expected) -> context label $
|
||||
it ("should be " ++ show expected) $ let
|
||||
mode' = mode & esmSubModeL .~ ESMEditWins
|
||||
in mode' `shouldBe` expected)
|
||||
|
||||
-- label, mode, expected
|
||||
[ ( "no state", ESMMenu, ESMMenu )
|
||||
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
|
||||
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
|
||||
]
|
||||
|
||||
teamScoreSpec :: Spec
|
||||
teamScoreSpec = describe "teamScore" $ do
|
||||
let
|
||||
@@ -241,6 +317,7 @@ lensSpec lens getters setters = do
|
||||
|
||||
player :: Player
|
||||
player = newPlayer 1 "Joe" "centre"
|
||||
& pRookie .~ False
|
||||
& pYtd .~ playerStats 1
|
||||
& pLifetime .~ playerStats 2
|
||||
|
||||
@@ -249,6 +326,8 @@ playerJSON = Object $ HM.fromList
|
||||
[ ( "number", toJSON (1 :: Int) )
|
||||
, ( "name", toJSON ("Joe" :: String) )
|
||||
, ( "position", toJSON ("centre" :: String) )
|
||||
, ( "rookie", toJSON False )
|
||||
, ( "active", toJSON True )
|
||||
, ( "ytd", playerStatsJSON 1 )
|
||||
, ( "lifetime", playerStatsJSON 2 )
|
||||
]
|
||||
@@ -268,6 +347,7 @@ playerStatsJSON n = Object $ HM.fromList
|
||||
|
||||
goalie :: Goalie
|
||||
goalie = newGoalie 1 "Joe"
|
||||
& gRookie .~ False
|
||||
& gYtd .~ goalieStats 1
|
||||
& gLifetime .~ goalieStats 2
|
||||
|
||||
@@ -275,6 +355,8 @@ goalieJSON :: Value
|
||||
goalieJSON = Object $ HM.fromList
|
||||
[ ( "number", toJSON (1 :: Int) )
|
||||
, ( "name", toJSON ("Joe" :: String ) )
|
||||
, ( "rookie", toJSON False )
|
||||
, ( "active", toJSON True )
|
||||
, ( "ytd", goalieStatsJSON 1 )
|
||||
, ( "lifetime", goalieStatsJSON 2 )
|
||||
]
|
||||
@@ -284,18 +366,20 @@ goalieStats n = newGoalieStats
|
||||
& gsGames .~ n
|
||||
& gsMinsPlayed .~ n + 1
|
||||
& gsGoalsAllowed .~ n + 2
|
||||
& gsWins .~ n + 3
|
||||
& gsLosses .~ n + 4
|
||||
& gsTies .~ n + 5
|
||||
& gsShutouts .~ n + 3
|
||||
& gsWins .~ n + 4
|
||||
& gsLosses .~ n + 5
|
||||
& gsTies .~ n + 6
|
||||
|
||||
goalieStatsJSON :: Int -> Value
|
||||
goalieStatsJSON n = Object $ HM.fromList
|
||||
[ ( "games", toJSON n )
|
||||
, ( "mins_played", toJSON $ n + 1 )
|
||||
, ( "goals_allowed", toJSON $ n + 2 )
|
||||
, ( "wins", toJSON $ n + 3 )
|
||||
, ( "losses", toJSON $ n + 4 )
|
||||
, ( "ties", toJSON $ n + 5 )
|
||||
, ( "shutouts", toJSON $ n + 3 )
|
||||
, ( "wins", toJSON $ n + 4 )
|
||||
, ( "losses", toJSON $ n + 5 )
|
||||
, ( "ties", toJSON $ n + 6 )
|
||||
]
|
||||
|
||||
gameStats :: Int -> GameStats
|
||||
@@ -559,12 +643,25 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
||||
ps = [joe, bob, steve]
|
||||
in playerSearch sStr ps `shouldBe` expected)
|
||||
-- search, result
|
||||
[ ( "Joe", [(0, joe)] )
|
||||
[ ( "joe", [(0, joe)] )
|
||||
, ( "o", [(0, joe), (1, bob)] )
|
||||
, ( "e", [(0, joe), (2, steve)] )
|
||||
, ( "x", [] )
|
||||
]
|
||||
|
||||
activePlayerSearchSpec :: Spec
|
||||
activePlayerSearchSpec = describe "activePlayerSearch" $ mapM_
|
||||
(\(sStr, expected) -> context sStr $
|
||||
it ("should return " ++ show expected) $ let
|
||||
ps = [joe, bob, steve & pActive .~ False]
|
||||
in activePlayerSearch sStr ps `shouldBe` expected)
|
||||
-- search, result
|
||||
[ ( "joe", [(0, joe)] )
|
||||
, ( "o", [(0, joe), (1, bob)] )
|
||||
, ( "e", [(0, joe)] )
|
||||
, ( "x", [] )
|
||||
]
|
||||
|
||||
playerSearchExactSpec :: Spec
|
||||
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||
(\(sStr, expected) -> context sStr $
|
||||
@@ -581,22 +678,22 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||
|
||||
modifyPlayerSpec :: Spec
|
||||
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
||||
(\(pName, j, b, s) -> let
|
||||
(\(name, j, b, s) -> let
|
||||
modifier = pLifetime.psGoals .~ 1
|
||||
players = modifyPlayer modifier pName [joe, bob, steve]
|
||||
in context ("modify " ++ pName) $ do
|
||||
players = modifyPlayer modifier name [joe, bob, steve]
|
||||
in context ("modify " ++ name) $ do
|
||||
|
||||
context "Joe's lifetime goals" $
|
||||
it ("should be " ++ show j) $
|
||||
head players ^. pLifetime.psGoals `shouldBe` j
|
||||
head players^.pLifetime.psGoals `shouldBe` j
|
||||
|
||||
context "Bob's lifetime goals" $
|
||||
it ("should be " ++ show b) $
|
||||
(players !! 1) ^. pLifetime.psGoals `shouldBe` b
|
||||
(players !! 1)^.pLifetime.psGoals `shouldBe` b
|
||||
|
||||
context "Steve's lifetime goals" $
|
||||
it ("should be " ++ show s) $
|
||||
last players ^. pLifetime.psGoals `shouldBe` s)
|
||||
last players^.pLifetime.psGoals `shouldBe` s)
|
||||
-- player name, Joe's goals, Bob's goals, Steve's goals
|
||||
[ ( "Joe", 1, 0, 0 )
|
||||
, ( "Bob", 0, 1, 0 )
|
||||
@@ -609,54 +706,24 @@ playerSummarySpec = describe "playerSummary" $
|
||||
it "should be \"Joe (2) center\"" $
|
||||
playerSummary joe `shouldBe` "Joe (2) center"
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
player = newPlayer 1 "Joe" "centre"
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe"
|
||||
, " Position: centre"
|
||||
, " YTD goals: 2"
|
||||
, " YTD assists: 3"
|
||||
, " YTD penalty mins: 4"
|
||||
, " Lifetime goals: 5"
|
||||
, " Lifetime assists: 6"
|
||||
, "Lifetime penalty mins: 7"
|
||||
]
|
||||
|
||||
in playerDetails player `shouldBe` expected
|
||||
|
||||
playerIsActiveSpec :: Spec
|
||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||
let
|
||||
pState = newPlayerStats
|
||||
pStats = newPlayerStats
|
||||
& psGoals .~ 10
|
||||
& psAssists .~ 11
|
||||
& psPMin .~ 12
|
||||
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
|
||||
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
|
||||
|
||||
mapM_
|
||||
(\(label, player', expected) -> context label $
|
||||
(\(label, p', expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerIsActive player' `shouldBe` expected)
|
||||
-- label, player, expected
|
||||
[ ( "not active", player, False )
|
||||
, ( "has goal", player & pYtd.psGoals .~ 1, True )
|
||||
, ( "has assist", player & pYtd.psAssists .~ 1, True )
|
||||
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
|
||||
playerIsActive p' `shouldBe` expected)
|
||||
-- label, player, expected
|
||||
[ ( "not active", p, False )
|
||||
, ( "has goal", p & pYtd.psGoals .~ 1, True )
|
||||
, ( "has assist", p & pYtd.psAssists .~ 1, True )
|
||||
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
|
||||
]
|
||||
|
||||
psPointsSpec :: Spec
|
||||
@@ -723,8 +790,30 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
||||
goalieSearch "x" goalies `shouldBe` []
|
||||
|
||||
context "exact match" $
|
||||
it "should return Steve" $
|
||||
goalieSearch "Bob" goalies `shouldBe` [result 1]
|
||||
it "should return Bob" $
|
||||
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||
|
||||
activeGoalieSearchSpec :: Spec
|
||||
activeGoalieSearchSpec = describe "activeGoalieSearch" $ do
|
||||
let
|
||||
goalies =
|
||||
[ newGoalie 2 "Joe"
|
||||
, newGoalie 3 "Bob"
|
||||
, newGoalie 5 "Steve" & gActive .~ False
|
||||
]
|
||||
result n = (n, goalies!!n)
|
||||
|
||||
context "partial match" $
|
||||
it "should return Joe" $
|
||||
activeGoalieSearch "e" goalies `shouldBe` [result 0]
|
||||
|
||||
context "no match" $
|
||||
it "should return an empty list" $
|
||||
activeGoalieSearch "x" goalies `shouldBe` []
|
||||
|
||||
context "exact match" $
|
||||
it "should return Bob" $
|
||||
activeGoalieSearch "bob" goalies `shouldBe` [result 1]
|
||||
|
||||
goalieSearchExactSpec :: Spec
|
||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||
@@ -755,6 +844,77 @@ goalieSummarySpec = describe "goalieSummary" $
|
||||
it "should provide a summary string" $
|
||||
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
||||
|
||||
goalieIsActiveSpec :: Spec
|
||||
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
|
||||
(\(label, input, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
goalieIsActive input `shouldBe` expected)
|
||||
|
||||
-- label, input, expected
|
||||
[ ( "inactive", inactive, False )
|
||||
, ( "active", active, True )
|
||||
]
|
||||
|
||||
where
|
||||
inactive = newGoalie 1 "Joe"
|
||||
& gLifetime.gsMinsPlayed .~ 1
|
||||
|
||||
active = inactive
|
||||
& gYtd.gsMinsPlayed .~ 1
|
||||
|
||||
addGoalieStatsSpec :: Spec
|
||||
addGoalieStatsSpec = describe "addGoalieStats" $ let
|
||||
g1 = GoalieStats
|
||||
{ _gsGames = 1
|
||||
, _gsMinsPlayed = 2
|
||||
, _gsGoalsAllowed = 3
|
||||
, _gsShutouts = 4
|
||||
, _gsWins = 5
|
||||
, _gsLosses = 6
|
||||
, _gsTies = 7
|
||||
}
|
||||
|
||||
g2 = GoalieStats
|
||||
{ _gsGames = 8
|
||||
, _gsMinsPlayed = 9
|
||||
, _gsGoalsAllowed = 10
|
||||
, _gsShutouts = 11
|
||||
, _gsWins = 12
|
||||
, _gsLosses = 13
|
||||
, _gsTies = 14
|
||||
}
|
||||
|
||||
expected = GoalieStats
|
||||
{ _gsGames = 9
|
||||
, _gsMinsPlayed = 11
|
||||
, _gsGoalsAllowed = 13
|
||||
, _gsShutouts = 15
|
||||
, _gsWins = 17
|
||||
, _gsLosses = 19
|
||||
, _gsTies = 21
|
||||
}
|
||||
|
||||
actual = g1 `addGoalieStats` g2
|
||||
|
||||
in it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected
|
||||
|
||||
gsAverageSpec :: Spec
|
||||
gsAverageSpec = describe "gsAverage" $ mapM_
|
||||
(\(label, stats, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
gsAverage stats `shouldBe` expected)
|
||||
|
||||
-- label, stats, expected
|
||||
[ ( "with minutes", gs, 3 % 2 )
|
||||
, ( "no minutes", newGoalieStats , 0 )
|
||||
]
|
||||
|
||||
where
|
||||
gs = newGoalieStats
|
||||
& gsMinsPlayed .~ 2 * gameLength
|
||||
& gsGoalsAllowed .~ 3
|
||||
|
||||
joe :: Player
|
||||
joe = newPlayer 2 "Joe" "center"
|
||||
|
||||
@@ -764,6 +924,54 @@ bob = newPlayer 3 "Bob" "defense"
|
||||
steve :: Player
|
||||
steve = newPlayer 5 "Steve" "forward"
|
||||
|
||||
-- | Creates a 'Player'
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeName
|
||||
<*> makeBool
|
||||
<*> makeBool
|
||||
<*> makePlayerStats
|
||||
<*> makePlayerStats
|
||||
|
||||
-- | Creates a 'Goalie'
|
||||
makeGoalie :: IO Goalie
|
||||
makeGoalie = Goalie
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeBool
|
||||
<*> makeBool
|
||||
<*> makeGoalieStats
|
||||
<*> makeGoalieStats
|
||||
|
||||
-- | Creates a 'PlayerStats' value
|
||||
makePlayerStats :: IO PlayerStats
|
||||
makePlayerStats = PlayerStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
-- | Creates a 'GoalieStats' value
|
||||
makeGoalieStats :: IO GoalieStats
|
||||
makeGoalieStats = GoalieStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
||||
makeBool :: IO Bool
|
||||
makeBool = randomIO
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
instance Comparable GoalieStats where
|
||||
compareTest actual expected = mapM_
|
||||
(\(name, lens) -> describe name $
|
||||
@@ -809,6 +1017,17 @@ instance Comparable EditPlayerState where
|
||||
it ("should be " ++ show (expected^.epsMode)) $
|
||||
actual^.epsMode `shouldBe` expected^.epsMode
|
||||
|
||||
instance Comparable EditGoalieState where
|
||||
compareTest actual expected = do
|
||||
|
||||
describe "egsSelectedGoalie" $
|
||||
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
|
||||
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
|
||||
|
||||
describe "egsMode" $
|
||||
it ("should be " ++ show (expected^.egsMode)) $
|
||||
actual^.egsMode `shouldBe` expected^.egsMode
|
||||
|
||||
instance Comparable CreateGoalieState where
|
||||
compareTest actual expected = do
|
||||
|
||||
@@ -819,3 +1038,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)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
@@ -30,8 +30,10 @@ spec :: Spec
|
||||
spec = describe "Mtlstats.Util" $ do
|
||||
nthSpec
|
||||
modifyNthSpec
|
||||
dropNthSpec
|
||||
updateMapSpec
|
||||
sliceSpec
|
||||
capitalizeNameSpec
|
||||
|
||||
nthSpec :: Spec
|
||||
nthSpec = describe "nth" $ mapM_
|
||||
@@ -49,18 +51,33 @@ nthSpec = describe "nth" $ mapM_
|
||||
|
||||
modifyNthSpec :: Spec
|
||||
modifyNthSpec = describe "modifyNth" $ do
|
||||
let list = [1, 2, 3] :: [Int]
|
||||
|
||||
context "in bounds" $
|
||||
it "should modify the value" $
|
||||
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
|
||||
modifyNth 1 succ list `shouldBe` [1, 3, 3]
|
||||
|
||||
context "out of bounds" $
|
||||
it "should not modify the value" $
|
||||
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
modifyNth 3 succ list `shouldBe` [1, 2, 3]
|
||||
|
||||
context "negative index" $
|
||||
it "should not modify the value" $
|
||||
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||
|
||||
dropNthSpec :: Spec
|
||||
dropNthSpec = describe "dropNth" $ mapM_
|
||||
|
||||
(\(label, n, expected) ->
|
||||
context label $
|
||||
it ("should be " ++ show expected) $
|
||||
dropNth n list `shouldBe` expected)
|
||||
|
||||
[ ( "out of bounds", 1, ["foo", "baz"] )
|
||||
, ( "in bounds", 3, list )
|
||||
]
|
||||
|
||||
where list = ["foo", "bar", "baz"]
|
||||
|
||||
updateMapSpec :: Spec
|
||||
updateMapSpec = describe "updateMap" $ do
|
||||
@@ -68,7 +85,7 @@ updateMapSpec = describe "updateMap" $ do
|
||||
input = M.fromList [(1, 2), (3, 5)]
|
||||
|
||||
context "key found" $ let
|
||||
expected = M.fromList [(1, 3), (3, 5)]
|
||||
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
|
||||
in it "should update the value" $
|
||||
updateMap 1 10 succ input `shouldBe` expected
|
||||
|
||||
@@ -79,7 +96,7 @@ updateMapSpec = describe "updateMap" $ do
|
||||
|
||||
sliceSpec :: Spec
|
||||
sliceSpec = describe "slice" $ do
|
||||
let list = [2, 4, 6, 8]
|
||||
let list = [2, 4, 6, 8] :: [Int]
|
||||
|
||||
context "sublist" $
|
||||
it "should return the sublist" $
|
||||
@@ -92,3 +109,23 @@ sliceSpec = describe "slice" $ do
|
||||
context "negative offset" $
|
||||
it "should return the correct number of elements from the beginning" $
|
||||
slice (-10) 2 list `shouldBe` [2, 4]
|
||||
|
||||
capitalizeNameSpec :: Spec
|
||||
capitalizeNameSpec = describe "capitalizeName" $ mapM_
|
||||
(\(label, ch, str, expected) -> context label $
|
||||
it ("should be " ++ expected) $
|
||||
capitalizeName ch str `shouldBe` expected)
|
||||
-- label, character, string, expected
|
||||
[ ( "initial lower", 'a', "", "A" )
|
||||
, ( "initial upper", 'A', "", "A" )
|
||||
, ( "initial non-alpha", '0', "", "0" )
|
||||
, ( "pre-comma lower", 'a', "A", "AA" )
|
||||
, ( "pre-comma upper", 'A', "A", "AA" )
|
||||
, ( "pre-comma non-alpha", '0', "A", "A0" )
|
||||
, ( "post-comma first lower", 'a', "FOO, ", "FOO, A" )
|
||||
, ( "post-comma first upper", 'A', "FOO, ", "FOO, A" )
|
||||
, ( "post-comma first non-alpha", '0', "FOO, ", "FOO, 0" )
|
||||
, ( "unrestricted upper", 'A', "FOO, A", "FOO, AA" )
|
||||
, ( "unrestricted lower", 'a', "FOO, A", "FOO, Aa" )
|
||||
, ( "unrestricted non-alpha", '0', "FOO, A", "FOO, A0" )
|
||||
]
|
||||
|
||||
8
vagrant/as_user.sh
Executable file
8
vagrant/as_user.sh
Executable 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
10
vagrant/provision.sh
Executable 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
|
||||
Reference in New Issue
Block a user