Compare commits
232 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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 |
44
ChangeLog.md
44
ChangeLog.md
@@ -1,24 +1,60 @@
|
|||||||
# Changelog for mtlstats
|
# Changelog for mtlstats
|
||||||
|
|
||||||
## 0.5.0
|
## 0.11.0
|
||||||
|
- Added active flag to players/goalies
|
||||||
|
- Clear rookie flag on new (regular) season
|
||||||
|
- Save a copy of the database on new season
|
||||||
|
- Implemented game standings editing
|
||||||
|
- Added title screen
|
||||||
|
- Changed sytling of menus
|
||||||
|
|
||||||
|
## 0.10.0
|
||||||
|
- Don't show player number zero in reports
|
||||||
|
- Fixed player/goalie name capitalisation on edit
|
||||||
|
- Return to correct edit menus after editing player stats
|
||||||
|
- Enabled batch editing of player/goalie YTD/lifetime stats
|
||||||
|
- Bugfix: allow user to edit goalie shutouts
|
||||||
|
- Added line numbers to lifetime player/goalie reports
|
||||||
|
- Implemented rookie flag
|
||||||
|
|
||||||
|
## 0.9.0
|
||||||
|
- Bugfix: Display lifetime stats in report, not YTD
|
||||||
|
- Force expected capitalization on player/goalie names
|
||||||
|
- Don't show lifetime totals in report
|
||||||
|
- Sort players in YTD and lifetime reports by points
|
||||||
|
- Moved player/goalie creation/editing to edit submenu
|
||||||
|
|
||||||
|
## 0.8.0
|
||||||
|
- Bugfix: removed quotation marks from goalie names in report
|
||||||
|
- Allow lower case player names
|
||||||
|
- Don't show players without points in game report
|
||||||
|
- Removed unnecessary goalie statistics from game report
|
||||||
|
- Fixed goalie average calculation
|
||||||
|
|
||||||
|
## 0.7.0
|
||||||
|
- Shortened views to fit within 25 lines
|
||||||
|
- Implemented goalie reports
|
||||||
|
|
||||||
|
## 0.6.0
|
||||||
|
- Generate lifetime statistics report
|
||||||
|
- Implemented goalie editing
|
||||||
|
- Reset game standings on new season
|
||||||
|
|
||||||
|
## 0.5.0
|
||||||
- Fixed player creation bug
|
- Fixed player creation bug
|
||||||
- Prompt for goalie informaiton on game data entry
|
- Prompt for goalie informaiton on game data entry
|
||||||
- Implemented player editing
|
- Implemented player editing
|
||||||
|
|
||||||
## v0.4.0
|
## v0.4.0
|
||||||
|
|
||||||
- Record penalty minutes
|
- Record penalty minutes
|
||||||
- Calculate total game statistics
|
- Calculate total game statistics
|
||||||
- Generate year-to-date statistics report
|
- Generate year-to-date statistics report
|
||||||
|
|
||||||
## v0.3.0
|
## v0.3.0
|
||||||
|
|
||||||
- Record goals and assists
|
- Record goals and assists
|
||||||
- Track goals for and goals against
|
- Track goals for and goals against
|
||||||
|
|
||||||
## v0.2.0
|
## v0.2.0
|
||||||
|
|
||||||
- Overtime losses don't count in the loss column
|
- Overtime losses don't count in the loss column
|
||||||
- Confirm game data with user before updating stats
|
- Confirm game data with user before updating stats
|
||||||
- Implemented player creation
|
- Implemented player creation
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
12
package.yaml
12
package.yaml
@@ -1,5 +1,5 @@
|
|||||||
name: mtlstats
|
name: mtlstats
|
||||||
version: 0.5.0
|
version: 0.11.0
|
||||||
github: "mtlstats/mtlstats"
|
github: "mtlstats/mtlstats"
|
||||||
license: GPL-3
|
license: GPL-3
|
||||||
author: "Jonathan Lamothe"
|
author: "Jonathan Lamothe"
|
||||||
@@ -11,13 +11,13 @@ extra-source-files:
|
|||||||
- ChangeLog.md
|
- ChangeLog.md
|
||||||
|
|
||||||
# Metadata used when publishing your package
|
# Metadata used when publishing your package
|
||||||
# synopsis: Short description of your package
|
synopsis: Hockey statistics tracker
|
||||||
# category: Web
|
category: Statistics
|
||||||
|
|
||||||
# To avoid duplicated efforts in documentation and dealing with the
|
# To avoid duplicated efforts in documentation and dealing with the
|
||||||
# complications of embedding Haddock markup inside cabal files, it is
|
# complications of embedding Haddock markup inside cabal files, it is
|
||||||
# common to point users to the README.md file.
|
# common to point users to the README.md file.
|
||||||
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
|
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
@@ -33,6 +33,10 @@ dependencies:
|
|||||||
- bytestring
|
- bytestring
|
||||||
- microlens
|
- microlens
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
- -Werror
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -24,41 +24,48 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Actions
|
module Mtlstats.Actions
|
||||||
( startNewSeason
|
( startNewSeason
|
||||||
, resetYtd
|
, resetYtd
|
||||||
|
, clearRookies
|
||||||
|
, resetStandings
|
||||||
, startNewGame
|
, startNewGame
|
||||||
, addChar
|
, addChar
|
||||||
, removeChar
|
, removeChar
|
||||||
, overtimeCheck
|
|
||||||
, updateGameStats
|
|
||||||
, validateGameDate
|
|
||||||
, createPlayer
|
, createPlayer
|
||||||
, createGoalie
|
, createGoalie
|
||||||
|
, edit
|
||||||
, editPlayer
|
, editPlayer
|
||||||
|
, editSelectedPlayer
|
||||||
|
, editGoalie
|
||||||
|
, editSelectedGoalie
|
||||||
, addPlayer
|
, addPlayer
|
||||||
, addGoalie
|
, addGoalie
|
||||||
, resetCreatePlayerState
|
, resetCreatePlayerState
|
||||||
, resetCreateGoalieState
|
, resetCreateGoalieState
|
||||||
, recordGoalAssists
|
|
||||||
, awardGoal
|
|
||||||
, awardAssist
|
|
||||||
, resetGoalData
|
|
||||||
, assignPMins
|
|
||||||
, backHome
|
, backHome
|
||||||
, scrollUp
|
, scrollUp
|
||||||
, scrollDown
|
, scrollDown
|
||||||
|
, saveDatabase
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Data.Map as M
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Data.Aeson (encodeFile)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time.Calendar (fromGregorianValid)
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
import System.EasyFile
|
||||||
|
( createDirectoryIfMissing
|
||||||
|
, getAppUserDataDirectory
|
||||||
|
, (</>)
|
||||||
|
)
|
||||||
|
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Starts a new season
|
-- | Starts a new season
|
||||||
startNewSeason :: ProgState -> ProgState
|
startNewSeason :: ProgState -> ProgState
|
||||||
startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
|
startNewSeason
|
||||||
|
= (progMode .~ NewSeason False)
|
||||||
|
. (database.dbGames .~ 0)
|
||||||
|
|
||||||
-- | Resets all players year-to-date stats
|
-- | Resets all players year-to-date stats
|
||||||
resetYtd :: ProgState -> ProgState
|
resetYtd :: ProgState -> ProgState
|
||||||
@@ -66,6 +73,18 @@ resetYtd
|
|||||||
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
||||||
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
||||||
|
|
||||||
|
-- | Clears the rookie flag from all players/goalies
|
||||||
|
clearRookies :: ProgState -> ProgState
|
||||||
|
clearRookies = database
|
||||||
|
%~ (dbPlayers %~ map (pRookie .~ False))
|
||||||
|
. (dbGoalies %~ map (gRookie .~ False))
|
||||||
|
|
||||||
|
-- | Resets game standings
|
||||||
|
resetStandings :: ProgState -> ProgState
|
||||||
|
resetStandings = database
|
||||||
|
%~ ( dbHomeGameStats .~ newGameStats)
|
||||||
|
. ( dbAwayGameStats .~ newGameStats)
|
||||||
|
|
||||||
-- | Starts a new game
|
-- | Starts a new game
|
||||||
startNewGame :: ProgState -> ProgState
|
startNewGame :: ProgState -> ProgState
|
||||||
startNewGame
|
startNewGame
|
||||||
@@ -82,69 +101,10 @@ removeChar = inputBuffer %~ \case
|
|||||||
"" -> ""
|
"" -> ""
|
||||||
str -> init str
|
str -> init str
|
||||||
|
|
||||||
-- | Determines whether or not to perform a check for overtime
|
|
||||||
overtimeCheck :: ProgState -> ProgState
|
|
||||||
overtimeCheck s
|
|
||||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
|
||||||
s & progMode.gameStateL
|
|
||||||
%~ (homeScore .~ Nothing)
|
|
||||||
. (awayScore .~ Nothing)
|
|
||||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
|
||||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
|
||||||
| otherwise = s
|
|
||||||
|
|
||||||
-- | Adjusts the game stats based on the results of the current game
|
|
||||||
updateGameStats :: ProgState -> ProgState
|
|
||||||
updateGameStats s = fromMaybe s $ do
|
|
||||||
let gs = s^.progMode.gameStateL
|
|
||||||
gType <- gs^.gameType
|
|
||||||
won <- gameWon gs
|
|
||||||
lost <- gameLost gs
|
|
||||||
ot <- gs^.overtimeFlag
|
|
||||||
tScore <- teamScore gs
|
|
||||||
oScore <- otherScore gs
|
|
||||||
let
|
|
||||||
hw = if gType == HomeGame && won then 1 else 0
|
|
||||||
hl = if gType == HomeGame && lost then 1 else 0
|
|
||||||
hot = if gType == HomeGame && ot then 1 else 0
|
|
||||||
hgf = if gType == HomeGame then tScore else 0
|
|
||||||
hga = if gType == HomeGame then oScore else 0
|
|
||||||
aw = if gType == AwayGame && won then 1 else 0
|
|
||||||
al = if gType == AwayGame && lost then 1 else 0
|
|
||||||
aot = if gType == AwayGame && ot then 1 else 0
|
|
||||||
agf = if gType == AwayGame then tScore else 0
|
|
||||||
aga = if gType == AwayGame then oScore else 0
|
|
||||||
Just $ s
|
|
||||||
& database.dbHomeGameStats
|
|
||||||
%~ (gmsWins +~ hw)
|
|
||||||
. (gmsLosses +~ hl)
|
|
||||||
. (gmsOvertime +~ hot)
|
|
||||||
. (gmsGoalsFor +~ hgf)
|
|
||||||
. (gmsGoalsAgainst +~ hga)
|
|
||||||
& database.dbAwayGameStats
|
|
||||||
%~ (gmsWins +~ aw)
|
|
||||||
. (gmsLosses +~ al)
|
|
||||||
. (gmsOvertime +~ aot)
|
|
||||||
. (gmsGoalsFor +~ agf)
|
|
||||||
. (gmsGoalsAgainst +~ aga)
|
|
||||||
|
|
||||||
-- | Validates the game date
|
|
||||||
validateGameDate :: ProgState -> ProgState
|
|
||||||
validateGameDate s = fromMaybe s $ do
|
|
||||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
|
||||||
m <- s^.progMode.gameStateL.gameMonth
|
|
||||||
d <- s^.progMode.gameStateL.gameDay
|
|
||||||
Just $ if null $ fromGregorianValid y m d
|
|
||||||
then s & progMode.gameStateL
|
|
||||||
%~ (gameYear .~ Nothing)
|
|
||||||
. (gameMonth .~ Nothing)
|
|
||||||
. (gameDay .~ Nothing)
|
|
||||||
else s
|
|
||||||
|
|
||||||
-- | Starts player creation mode
|
-- | Starts player creation mode
|
||||||
createPlayer :: ProgState -> ProgState
|
createPlayer :: ProgState -> ProgState
|
||||||
createPlayer = let
|
createPlayer = let
|
||||||
callback = modify $ progMode .~ MainMenu
|
callback = modify edit
|
||||||
cps = newCreatePlayerState
|
cps = newCreatePlayerState
|
||||||
& cpsSuccessCallback .~ callback
|
& cpsSuccessCallback .~ callback
|
||||||
& cpsFailureCallback .~ callback
|
& cpsFailureCallback .~ callback
|
||||||
@@ -153,16 +113,50 @@ createPlayer = let
|
|||||||
-- | Starts goalie creation mode
|
-- | Starts goalie creation mode
|
||||||
createGoalie :: ProgState -> ProgState
|
createGoalie :: ProgState -> ProgState
|
||||||
createGoalie = let
|
createGoalie = let
|
||||||
callback = modify $ progMode .~ MainMenu
|
callback = modify edit
|
||||||
cgs = newCreateGoalieState
|
cgs = newCreateGoalieState
|
||||||
& cgsSuccessCallback .~ callback
|
& cgsSuccessCallback .~ callback
|
||||||
& cgsFailureCallback .~ callback
|
& cgsFailureCallback .~ callback
|
||||||
in progMode .~ CreateGoalie cgs
|
in progMode .~ CreateGoalie cgs
|
||||||
|
|
||||||
|
-- | Launches the edit menu
|
||||||
|
edit :: ProgState -> ProgState
|
||||||
|
edit = progMode .~ EditMenu
|
||||||
|
|
||||||
-- | Starts the player editing process
|
-- | Starts the player editing process
|
||||||
editPlayer :: ProgState -> ProgState
|
editPlayer :: ProgState -> ProgState
|
||||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||||
|
|
||||||
|
-- | Edits the selected 'Player'
|
||||||
|
editSelectedPlayer
|
||||||
|
:: (Player -> Player)
|
||||||
|
-- ^ The modification to be made to the 'Player'
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editSelectedPlayer f s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
|
let
|
||||||
|
players = s^.database.dbPlayers
|
||||||
|
players' = modifyNth n f players
|
||||||
|
Just $ s & database.dbPlayers .~ players'
|
||||||
|
|
||||||
|
-- | Starts the 'Goalie' editing process
|
||||||
|
editGoalie :: ProgState -> ProgState
|
||||||
|
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||||
|
|
||||||
|
-- | Edits the selected 'Goalie'
|
||||||
|
editSelectedGoalie
|
||||||
|
:: (Goalie -> Goalie)
|
||||||
|
-- ^ The modification to be made to the 'Goalie'
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editSelectedGoalie f s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
let
|
||||||
|
goalies = s^.database.dbGoalies
|
||||||
|
goalies' = modifyNth n f goalies
|
||||||
|
Just $ s & database.dbGoalies .~ goalies'
|
||||||
|
|
||||||
-- | Adds the entered player to the roster
|
-- | Adds the entered player to the roster
|
||||||
addPlayer :: ProgState -> ProgState
|
addPlayer :: ProgState -> ProgState
|
||||||
addPlayer s = fromMaybe s $ do
|
addPlayer s = fromMaybe s $ do
|
||||||
@@ -199,81 +193,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
|
|||||||
%~ (cgsNumber .~ Nothing)
|
%~ (cgsNumber .~ Nothing)
|
||||||
. (cgsName .~ "")
|
. (cgsName .~ "")
|
||||||
|
|
||||||
-- | Awards the goal and assists to the players
|
|
||||||
recordGoalAssists :: ProgState -> ProgState
|
|
||||||
recordGoalAssists ps = fromMaybe ps $ do
|
|
||||||
let gs = ps^.progMode.gameStateL
|
|
||||||
goalId <- gs^.goalBy
|
|
||||||
let assistIds = gs^.assistsBy
|
|
||||||
Just $ ps
|
|
||||||
& awardGoal goalId
|
|
||||||
& (\s -> foldr awardAssist s assistIds)
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (goalBy .~ Nothing)
|
|
||||||
. (assistsBy .~ [])
|
|
||||||
. (pointsAccounted %~ succ)
|
|
||||||
. (confirmGoalDataFlag .~ False)
|
|
||||||
|
|
||||||
-- | Awards a goal to a player
|
|
||||||
awardGoal
|
|
||||||
:: Int
|
|
||||||
-- ^ The player's index number
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
awardGoal n ps = ps
|
|
||||||
& progMode.gameStateL.gamePlayerStats %~
|
|
||||||
(\m -> let
|
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
|
||||||
in M.insert n (stats & psGoals %~ succ) m)
|
|
||||||
& database.dbPlayers %~ map
|
|
||||||
(\(i, p) -> if i == n
|
|
||||||
then p
|
|
||||||
& pYtd.psGoals %~ succ
|
|
||||||
& pLifetime.psGoals %~ succ
|
|
||||||
else p) . zip [0..]
|
|
||||||
|
|
||||||
-- | Awards an assist to a player
|
|
||||||
awardAssist
|
|
||||||
:: Int
|
|
||||||
-- ^ The player's index number
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
awardAssist n ps = ps
|
|
||||||
& progMode.gameStateL.gamePlayerStats %~
|
|
||||||
(\m -> let
|
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
|
||||||
in M.insert n (stats & psAssists %~ succ) m)
|
|
||||||
& database.dbPlayers %~ map
|
|
||||||
(\(i, p) -> if i == n
|
|
||||||
then p
|
|
||||||
& pYtd.psAssists %~ succ
|
|
||||||
& pLifetime.psAssists %~ succ
|
|
||||||
else p) . zip [0..]
|
|
||||||
|
|
||||||
-- | Resets the entered data for the current goal
|
|
||||||
resetGoalData :: ProgState -> ProgState
|
|
||||||
resetGoalData ps = ps & progMode.gameStateL
|
|
||||||
%~ (goalBy .~ Nothing)
|
|
||||||
. (assistsBy .~ [])
|
|
||||||
. (confirmGoalDataFlag .~ False)
|
|
||||||
|
|
||||||
-- | Adds penalty minutes to a player
|
|
||||||
assignPMins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of minutes to add
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
assignPMins mins s = fromMaybe s $ do
|
|
||||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
|
||||||
Just $ s
|
|
||||||
& database.dbPlayers %~ modifyNth n
|
|
||||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
|
||||||
(psPMin +~ mins)
|
|
||||||
)
|
|
||||||
. (gameSelectedPlayer .~ Nothing)
|
|
||||||
|
|
||||||
-- | Resets the program state back to the main menu
|
-- | Resets the program state back to the main menu
|
||||||
backHome :: ProgState -> ProgState
|
backHome :: ProgState -> ProgState
|
||||||
backHome
|
backHome
|
||||||
@@ -288,3 +207,13 @@ scrollUp = scrollOffset %~ max 0 . pred
|
|||||||
-- | Scrolls the display down
|
-- | Scrolls the display down
|
||||||
scrollDown :: ProgState -> ProgState
|
scrollDown :: ProgState -> ProgState
|
||||||
scrollDown = scrollOffset %~ succ
|
scrollDown = scrollOffset %~ succ
|
||||||
|
|
||||||
|
-- | Saves the database
|
||||||
|
saveDatabase :: String -> Action ()
|
||||||
|
saveDatabase fn = do
|
||||||
|
db <- gets (^.database)
|
||||||
|
liftIO $ do
|
||||||
|
dir <- getAppUserDataDirectory appName
|
||||||
|
let dbFile = dir </> fn
|
||||||
|
createDirectoryIfMissing True dir
|
||||||
|
encodeFile dbFile db
|
||||||
|
|||||||
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 .~)
|
||||||
191
src/Mtlstats/Actions/NewGame.hs
Normal file
191
src/Mtlstats/Actions/NewGame.hs
Normal file
@@ -0,0 +1,191 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Actions.NewGame
|
||||||
|
( overtimeCheck
|
||||||
|
, updateGameStats
|
||||||
|
, validateGameDate
|
||||||
|
, recordGoalAssists
|
||||||
|
, awardGoal
|
||||||
|
, awardAssist
|
||||||
|
, resetGoalData
|
||||||
|
, assignPMins
|
||||||
|
, awardShutouts
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Time.Calendar (fromGregorianValid)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Determines whether or not to perform a check for overtime
|
||||||
|
overtimeCheck :: ProgState -> ProgState
|
||||||
|
overtimeCheck s
|
||||||
|
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||||
|
s & progMode.gameStateL
|
||||||
|
%~ (homeScore .~ Nothing)
|
||||||
|
. (awayScore .~ Nothing)
|
||||||
|
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||||
|
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||||
|
| otherwise = s
|
||||||
|
|
||||||
|
-- | Adjusts the game stats based on the results of the current game
|
||||||
|
updateGameStats :: ProgState -> ProgState
|
||||||
|
updateGameStats s = fromMaybe s $ do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
gType <- gs^.gameType
|
||||||
|
won <- gameWon gs
|
||||||
|
lost <- gameLost gs
|
||||||
|
ot <- gs^.overtimeFlag
|
||||||
|
tScore <- teamScore gs
|
||||||
|
oScore <- otherScore gs
|
||||||
|
let
|
||||||
|
hw = if gType == HomeGame && won then 1 else 0
|
||||||
|
hl = if gType == HomeGame && lost then 1 else 0
|
||||||
|
hot = if gType == HomeGame && ot then 1 else 0
|
||||||
|
hgf = if gType == HomeGame then tScore else 0
|
||||||
|
hga = if gType == HomeGame then oScore else 0
|
||||||
|
aw = if gType == AwayGame && won then 1 else 0
|
||||||
|
al = if gType == AwayGame && lost then 1 else 0
|
||||||
|
aot = if gType == AwayGame && ot then 1 else 0
|
||||||
|
agf = if gType == AwayGame then tScore else 0
|
||||||
|
aga = if gType == AwayGame then oScore else 0
|
||||||
|
Just $ s
|
||||||
|
& database.dbHomeGameStats
|
||||||
|
%~ (gmsWins +~ hw)
|
||||||
|
. (gmsLosses +~ hl)
|
||||||
|
. (gmsOvertime +~ hot)
|
||||||
|
. (gmsGoalsFor +~ hgf)
|
||||||
|
. (gmsGoalsAgainst +~ hga)
|
||||||
|
& database.dbAwayGameStats
|
||||||
|
%~ (gmsWins +~ aw)
|
||||||
|
. (gmsLosses +~ al)
|
||||||
|
. (gmsOvertime +~ aot)
|
||||||
|
. (gmsGoalsFor +~ agf)
|
||||||
|
. (gmsGoalsAgainst +~ aga)
|
||||||
|
|
||||||
|
-- | Validates the game date
|
||||||
|
validateGameDate :: ProgState -> ProgState
|
||||||
|
validateGameDate s = fromMaybe s $ do
|
||||||
|
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||||
|
m <- s^.progMode.gameStateL.gameMonth
|
||||||
|
d <- s^.progMode.gameStateL.gameDay
|
||||||
|
Just $ if null $ fromGregorianValid y m d
|
||||||
|
then s & progMode.gameStateL
|
||||||
|
%~ (gameYear .~ Nothing)
|
||||||
|
. (gameMonth .~ Nothing)
|
||||||
|
. (gameDay .~ Nothing)
|
||||||
|
else s
|
||||||
|
|
||||||
|
-- | Awards the goal and assists to the players
|
||||||
|
recordGoalAssists :: ProgState -> ProgState
|
||||||
|
recordGoalAssists ps = fromMaybe ps $ do
|
||||||
|
let gs = ps^.progMode.gameStateL
|
||||||
|
goalId <- gs^.goalBy
|
||||||
|
let assistIds = gs^.assistsBy
|
||||||
|
Just $ ps
|
||||||
|
& awardGoal goalId
|
||||||
|
& (\s -> foldr awardAssist s assistIds)
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (goalBy .~ Nothing)
|
||||||
|
. (assistsBy .~ [])
|
||||||
|
. (pointsAccounted %~ succ)
|
||||||
|
. (confirmGoalDataFlag .~ False)
|
||||||
|
|
||||||
|
-- | Awards a goal to a player
|
||||||
|
awardGoal
|
||||||
|
:: Int
|
||||||
|
-- ^ The player's index number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
awardGoal n ps = ps
|
||||||
|
& progMode.gameStateL.gamePlayerStats %~
|
||||||
|
(\m -> let
|
||||||
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
|
in M.insert n (stats & psGoals %~ succ) m)
|
||||||
|
& database.dbPlayers %~ map
|
||||||
|
(\(i, p) -> if i == n
|
||||||
|
then p
|
||||||
|
& pYtd.psGoals %~ succ
|
||||||
|
& pLifetime.psGoals %~ succ
|
||||||
|
else p) . zip [0..]
|
||||||
|
|
||||||
|
-- | Awards an assist to a player
|
||||||
|
awardAssist
|
||||||
|
:: Int
|
||||||
|
-- ^ The player's index number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
awardAssist n ps = ps
|
||||||
|
& progMode.gameStateL.gamePlayerStats %~
|
||||||
|
(\m -> let
|
||||||
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
|
in M.insert n (stats & psAssists %~ succ) m)
|
||||||
|
& database.dbPlayers %~ map
|
||||||
|
(\(i, p) -> if i == n
|
||||||
|
then p
|
||||||
|
& pYtd.psAssists %~ succ
|
||||||
|
& pLifetime.psAssists %~ succ
|
||||||
|
else p) . zip [0..]
|
||||||
|
|
||||||
|
-- | Resets the entered data for the current goal
|
||||||
|
resetGoalData :: ProgState -> ProgState
|
||||||
|
resetGoalData ps = ps & progMode.gameStateL
|
||||||
|
%~ (goalBy .~ Nothing)
|
||||||
|
. (assistsBy .~ [])
|
||||||
|
. (confirmGoalDataFlag .~ False)
|
||||||
|
|
||||||
|
-- | Adds penalty minutes to a player
|
||||||
|
assignPMins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of minutes to add
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
assignPMins mins s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||||
|
Just $ s
|
||||||
|
& database.dbPlayers %~ modifyNth n
|
||||||
|
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||||
|
(psPMin +~ mins)
|
||||||
|
)
|
||||||
|
. (gameSelectedPlayer .~ Nothing)
|
||||||
|
|
||||||
|
-- | Awards a shutout to any 'Goalie' who played and didn't allow any
|
||||||
|
-- goals
|
||||||
|
awardShutouts :: ProgState -> ProgState
|
||||||
|
awardShutouts s = foldl
|
||||||
|
(\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0
|
||||||
|
then s'
|
||||||
|
& database.dbGoalies %~ modifyNth gid
|
||||||
|
( ( gYtd.gsShutouts %~ succ )
|
||||||
|
. ( gLifetime.gsShutouts %~ succ )
|
||||||
|
)
|
||||||
|
& progMode.gameStateL.gameGoalieStats %~ M.adjust
|
||||||
|
(gsShutouts %~ succ)
|
||||||
|
gid
|
||||||
|
else s')
|
||||||
|
s
|
||||||
|
(M.toList $ s^.progMode.gameStateL.gameGoalieStats)
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Actions.GoalieInput
|
module Mtlstats.Actions.NewGame.GoalieInput
|
||||||
( finishGoalieEntry
|
( finishGoalieEntry
|
||||||
, recordGoalieStats
|
, recordGoalieStats
|
||||||
, setGameGoalie
|
, setGameGoalie
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
||||||
@@ -42,10 +43,10 @@ finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
|
|||||||
recordGoalieStats :: ProgState -> ProgState
|
recordGoalieStats :: ProgState -> ProgState
|
||||||
recordGoalieStats s = fromMaybe s $ do
|
recordGoalieStats s = fromMaybe s $ do
|
||||||
let gs = s^.progMode.gameStateL
|
let gs = s^.progMode.gameStateL
|
||||||
gid <- gs^.gameSelectedGoalie
|
gid <- gs^.gameSelectedGoalie
|
||||||
goalie <- nth gid $ s^.database.dbGoalies
|
mins <- gs^.gameGoalieMinsPlayed
|
||||||
mins <- gs^.gameGoalieMinsPlayed
|
goals <- gs^.gameGoalsAllowed
|
||||||
goals <- gs^.gameGoalsAllowed
|
void $ nth gid $ s^.database.dbGoalies
|
||||||
|
|
||||||
let
|
let
|
||||||
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
||||||
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
|
|||||||
then 1
|
then 1
|
||||||
else 0
|
else 0
|
||||||
|
|
||||||
bumpStats gs = gs
|
bumpStats
|
||||||
& gsGames +~ bumpVal
|
= (gsGames +~ bumpVal)
|
||||||
& gsMinsPlayed +~ mins
|
. (gsMinsPlayed +~ mins)
|
||||||
& gsGoalsAllowed +~ goals
|
. (gsGoalsAllowed +~ goals)
|
||||||
|
|
||||||
tryFinish = if mins >= gameLength
|
tryFinish = if mins >= gameLength
|
||||||
then finishGoalieEntry
|
then finishGoalieEntry
|
||||||
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
|
|||||||
l = if lost then 1 else 0
|
l = if lost then 1 else 0
|
||||||
t = if tied then 1 else 0
|
t = if tied then 1 else 0
|
||||||
|
|
||||||
updateStats gs = gs
|
updateStats
|
||||||
& gsWins +~ w
|
= (gsWins +~ w)
|
||||||
& gsLosses +~ l
|
. (gsLosses +~ l)
|
||||||
& gsTies +~ t
|
. (gsTies +~ t)
|
||||||
|
|
||||||
updateGoalie g = g
|
updateGoalie
|
||||||
& gYtd %~ updateStats
|
= (gYtd %~ updateStats)
|
||||||
& gLifetime %~ updateStats
|
. (gLifetime %~ updateStats)
|
||||||
|
|
||||||
updateGameState gs = gs
|
updateGameState
|
||||||
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
|
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
|
||||||
& gameGoalieAssigned .~ True
|
. (gameGoalieAssigned .~ True)
|
||||||
|
|
||||||
Just $ s
|
Just $ s
|
||||||
& database.dbGoalies %~ modifyNth gid updateGoalie
|
& database.dbGoalies %~ modifyNth gid updateGoalie
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,47 +21,33 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control (dispatch) where
|
module Mtlstats.Control (dispatch) where
|
||||||
|
|
||||||
import Control.Monad (join, when)
|
import Control.Monad (join)
|
||||||
import Control.Monad.Extra (ifM)
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (toUpper)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Control.TitleScreen
|
||||||
|
import Mtlstats.Control.EditGoalie
|
||||||
import Mtlstats.Control.EditPlayer
|
import Mtlstats.Control.EditPlayer
|
||||||
import Mtlstats.Control.GoalieInput
|
import Mtlstats.Control.EditStandings
|
||||||
import Mtlstats.Format
|
import Mtlstats.Control.NewGame
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Report
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Reads the program state and returs the apropriate controller to
|
-- | Reads the program state and returs the apropriate controller to
|
||||||
-- run
|
-- run
|
||||||
dispatch :: ProgState -> Controller
|
dispatch :: ProgState -> Controller
|
||||||
dispatch s = case s^.progMode of
|
dispatch s = case s^.progMode of
|
||||||
MainMenu -> mainMenuC
|
TitleScreen -> titleScreenC
|
||||||
NewSeason -> newSeasonC
|
MainMenu -> mainMenuC
|
||||||
NewGame gs
|
NewSeason flag -> newSeasonC flag
|
||||||
| null $ gs^.gameYear -> gameYearC
|
NewGame gs -> newGameC gs
|
||||||
| null $ gs^.gameMonth -> gameMonthC
|
EditMenu -> editMenuC
|
||||||
| null $ gs^.gameDay -> gameDayC
|
|
||||||
| null $ gs^.gameType -> gameTypeC
|
|
||||||
| null $ gs^.otherTeam -> otherTeamC
|
|
||||||
| null $ gs^.homeScore -> homeScoreC
|
|
||||||
| null $ gs^.awayScore -> awayScoreC
|
|
||||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
|
||||||
| not $ gs^.dataVerified -> verifyDataC
|
|
||||||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
|
||||||
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
|
|
||||||
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
|
|
||||||
| not $ gs^.gameGoalieAssigned -> goalieInput s
|
|
||||||
| otherwise -> reportC
|
|
||||||
CreatePlayer cps
|
CreatePlayer cps
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
| null $ cps^.cpsName -> getPlayerNameC
|
||||||
@@ -71,7 +57,9 @@ dispatch s = case s^.progMode of
|
|||||||
| null $ cgs^.cgsNumber -> getGoalieNumC
|
| null $ cgs^.cgsNumber -> getGoalieNumC
|
||||||
| null $ cgs^.cgsName -> getGoalieNameC
|
| null $ cgs^.cgsName -> getGoalieNameC
|
||||||
| otherwise -> confirmCreateGoalieC
|
| otherwise -> confirmCreateGoalieC
|
||||||
EditPlayer eps -> editPlayerC eps
|
EditPlayer eps -> editPlayerC eps
|
||||||
|
EditGoalie egs -> editGoalieC egs
|
||||||
|
(EditStandings esm) -> editStandingsC esm
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: Controller
|
||||||
mainMenuC = Controller
|
mainMenuC = Controller
|
||||||
@@ -79,226 +67,12 @@ mainMenuC = Controller
|
|||||||
, handleController = menuHandler mainMenu
|
, handleController = menuHandler mainMenu
|
||||||
}
|
}
|
||||||
|
|
||||||
newSeasonC :: Controller
|
newSeasonC :: Bool -> Controller
|
||||||
newSeasonC = Controller
|
newSeasonC False = promptController newSeasonPrompt
|
||||||
{ drawController = const $ drawMenu newSeasonMenu
|
newSeasonC True = menuController newSeasonMenu
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler newSeasonMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameYearC :: Controller
|
editMenuC :: Controller
|
||||||
gameYearC = Controller
|
editMenuC = menuController editMenu
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameYearPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameYearPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameMonthC :: Controller
|
|
||||||
gameMonthC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameMonthMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameMonthMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameDayC :: Controller
|
|
||||||
gameDayC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameDayPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameDayPrompt e
|
|
||||||
modify validateGameDate
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameTypeC :: Controller
|
|
||||||
gameTypeC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameTypeMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameTypeMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
otherTeamC :: Controller
|
|
||||||
otherTeamC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt otherTeamPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler otherTeamPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
homeScoreC :: Controller
|
|
||||||
homeScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt homeScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler homeScorePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
awayScoreC :: Controller
|
|
||||||
awayScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt awayScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler awayScorePrompt e
|
|
||||||
modify overtimeCheck
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
overtimeFlagC :: Controller
|
|
||||||
overtimeFlagC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
C.drawString "Did the game go into overtime? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
verifyDataC :: Controller
|
|
||||||
verifyDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let gs = s^.progMode.gameStateL
|
|
||||||
header s
|
|
||||||
C.drawString "\n"
|
|
||||||
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
|
||||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
|
||||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
|
||||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
|
||||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
|
||||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
|
||||||
C.drawString "Is the above information correct? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify $ progMode.gameStateL.dataVerified .~ True
|
|
||||||
modify updateGameStats
|
|
||||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
goalInput :: GameState -> Controller
|
|
||||||
goalInput gs
|
|
||||||
| null (gs^.goalBy ) = recordGoalC
|
|
||||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
|
||||||
| otherwise = confirmGoalDataC
|
|
||||||
|
|
||||||
recordGoalC :: Controller
|
|
||||||
recordGoalC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
in drawPrompt (recordGoalPrompt game goal) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal) <- gets gameGoal
|
|
||||||
promptHandler (recordGoalPrompt game goal) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
recordAssistC :: Controller
|
|
||||||
recordAssistC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal, assist) = gameGoalAssist s
|
|
||||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal, assist) <- gets gameGoalAssist
|
|
||||||
promptHandler (recordAssistPrompt game goal assist) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmGoalDataC :: Controller
|
|
||||||
confirmGoalDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
gs = s^.progMode.gameStateL
|
|
||||||
players = s^.database.dbPlayers
|
|
||||||
msg = unlines $
|
|
||||||
[ " Game: " ++ padNum 2 game
|
|
||||||
, " Goal: " ++ show goal
|
|
||||||
, "Goal scored by: " ++
|
|
||||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
|
||||||
] ++
|
|
||||||
map
|
|
||||||
(\pid -> " Assisted by: " ++
|
|
||||||
playerSummary (fromJust $ nth pid players))
|
|
||||||
(gs^.assistsBy) ++
|
|
||||||
[ ""
|
|
||||||
, "Is the above information correct? (Y/N)"
|
|
||||||
]
|
|
||||||
C.drawString msg
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> modify recordGoalAssists
|
|
||||||
Just False -> modify resetGoalData
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
pMinPlayerC :: Controller
|
|
||||||
pMinPlayerC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt pMinPlayerPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler pMinPlayerPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPMinsC :: Controller
|
|
||||||
getPMinsC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
C.drawString $ fromMaybe "" $ do
|
|
||||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
|
||||||
Just $ playerSummary player ++ "\n"
|
|
||||||
drawPrompt assignPMinsPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler assignPMinsPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
reportC :: Controller
|
|
||||||
reportC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
(rows, cols) <- C.windowSize
|
|
||||||
C.drawString $ unlines $ slice
|
|
||||||
(s^.scrollOffset)
|
|
||||||
(fromInteger $ pred rows)
|
|
||||||
(report (fromInteger $ pred cols) s)
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case e of
|
|
||||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
|
||||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
|
||||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
|
||||||
C.EventSpecialKey _ -> modify backHome
|
|
||||||
C.EventCharacter _ -> modify backHome
|
|
||||||
_ -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
|
||||||
header s = C.drawString $
|
|
||||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
|
||||||
|
|
||||||
getPlayerNumC :: Controller
|
getPlayerNumC :: Controller
|
||||||
getPlayerNumC = Controller
|
getPlayerNumC = Controller
|
||||||
@@ -381,15 +155,3 @@ confirmCreateGoalieC = Controller
|
|||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
gameGoal :: ProgState -> (Int, Int)
|
|
||||||
gameGoal s =
|
|
||||||
( s^.database.dbGames
|
|
||||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
|
||||||
)
|
|
||||||
|
|
||||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
|
||||||
gameGoalAssist s = let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
|
||||||
in (game, goal, assist)
|
|
||||||
|
|||||||
130
src/Mtlstats/Control/EditGoalie.hs
Normal file
130
src/Mtlstats/Control/EditGoalie.hs
Normal file
@@ -0,0 +1,130 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
import UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Goalie
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Menu.EditGoalie
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.EditGoalie
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Controller/dispatcher for editing a 'Goalie'
|
||||||
|
editGoalieC :: EditGoalieState -> Controller
|
||||||
|
editGoalieC egs
|
||||||
|
| null $ egs^.egsSelectedGoalie = selectC
|
||||||
|
| otherwise = editC $ egs^.egsMode
|
||||||
|
|
||||||
|
selectC :: Controller
|
||||||
|
selectC = promptController goalieToEditPrompt
|
||||||
|
|
||||||
|
editC :: EditGoalieMode -> Controller
|
||||||
|
editC = \case
|
||||||
|
EGMenu -> menuC
|
||||||
|
EGNumber -> numberC
|
||||||
|
EGName -> nameC
|
||||||
|
EGYtd -> ytdMenuC
|
||||||
|
EGLifetime -> lifetimeMenuC
|
||||||
|
EGYtdGames b -> ytdGamesC b
|
||||||
|
EGYtdMins b -> ytdMinsC b
|
||||||
|
EGYtdGoals b -> ytdGoalsC b
|
||||||
|
EGYtdShutouts b -> ytdShutoutsC b
|
||||||
|
EGYtdWins b -> ytdWinsC b
|
||||||
|
EGYtdLosses b -> ytdLossesC b
|
||||||
|
EGYtdTies -> ytdTiesC
|
||||||
|
EGLtGames b -> ltGamesC b
|
||||||
|
EGLtMins b -> ltMinsC b
|
||||||
|
EGLtGoals b -> ltGoalsC b
|
||||||
|
EGLtShutouts b -> ltShutoutsC b
|
||||||
|
EGLtWins b -> ltWinsC b
|
||||||
|
EGLtLosses b -> ltLossesC b
|
||||||
|
EGLtTies -> ltTiesC
|
||||||
|
|
||||||
|
menuC :: Controller
|
||||||
|
menuC = menuControllerWith header editGoalieMenu
|
||||||
|
|
||||||
|
numberC :: Controller
|
||||||
|
numberC = promptController editGoalieNumberPrompt
|
||||||
|
|
||||||
|
nameC :: Controller
|
||||||
|
nameC = promptController editGoalieNamePrompt
|
||||||
|
|
||||||
|
ytdMenuC :: Controller
|
||||||
|
ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
||||||
|
|
||||||
|
lifetimeMenuC :: Controller
|
||||||
|
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
||||||
|
|
||||||
|
ytdGamesC :: Bool -> Controller
|
||||||
|
ytdGamesC = promptController . editGoalieYtdGamesPrompt
|
||||||
|
|
||||||
|
ytdMinsC :: Bool -> Controller
|
||||||
|
ytdMinsC = promptController . editGoalieYtdMinsPrompt
|
||||||
|
|
||||||
|
ytdGoalsC :: Bool -> Controller
|
||||||
|
ytdGoalsC = promptController . editGoalieYtdGoalsPrompt
|
||||||
|
|
||||||
|
ytdShutoutsC :: Bool -> Controller
|
||||||
|
ytdShutoutsC = promptController . editGoalieYtdShutoutsPrompt
|
||||||
|
|
||||||
|
ytdWinsC :: Bool -> Controller
|
||||||
|
ytdWinsC = promptController . editGoalieYtdWinsPrompt
|
||||||
|
|
||||||
|
ytdLossesC :: Bool -> Controller
|
||||||
|
ytdLossesC = promptController . editGoalieYtdLossesPrompt
|
||||||
|
|
||||||
|
ytdTiesC :: Controller
|
||||||
|
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
||||||
|
|
||||||
|
ltGamesC :: Bool -> Controller
|
||||||
|
ltGamesC = promptController . editGoalieLtGamesPrompt
|
||||||
|
|
||||||
|
ltMinsC :: Bool -> Controller
|
||||||
|
ltMinsC = promptController . editGoalieLtMinsPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Bool -> Controller
|
||||||
|
ltGoalsC = promptController . editGoalieLtGoalsPrompt
|
||||||
|
|
||||||
|
ltShutoutsC :: Bool -> Controller
|
||||||
|
ltShutoutsC = promptController . editGoalieLtShutoutsPrompt
|
||||||
|
|
||||||
|
ltWinsC :: Bool -> Controller
|
||||||
|
ltWinsC = promptController . editGoalieLtWinsPrompt
|
||||||
|
|
||||||
|
ltLossesC :: Bool -> Controller
|
||||||
|
ltLossesC = promptController . editGoalieLtLossesPrompt
|
||||||
|
|
||||||
|
ltTiesC :: Controller
|
||||||
|
ltTiesC = promptController editGoalieLtTiesPrompt
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
g <- nth gid $ s^.database.dbGoalies
|
||||||
|
Just $ goalieDetails g ++ "\n"
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -25,7 +25,9 @@ import Data.Maybe (fromMaybe)
|
|||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Player
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Menu.EditPlayer
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Prompt.EditPlayer
|
import Mtlstats.Prompt.EditPlayer
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
@@ -36,108 +38,60 @@ editPlayerC :: EditPlayerState -> Controller
|
|||||||
editPlayerC eps
|
editPlayerC eps
|
||||||
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
||||||
| otherwise = case eps^.epsMode of
|
| otherwise = case eps^.epsMode of
|
||||||
EPMenu -> menuC
|
EPMenu -> menuC
|
||||||
EPNumber -> numberC
|
EPNumber -> numberC
|
||||||
EPName -> nameC
|
EPName -> nameC
|
||||||
EPPosition -> positionC
|
EPPosition -> positionC
|
||||||
EPYtdGoals -> ytdGoalsC
|
EPYtd -> ytdC
|
||||||
EPYtdAssists -> ytdAssistsC
|
EPLifetime -> lifetimeC
|
||||||
EPYtdPMin -> ytdPMinC
|
EPYtdGoals b -> ytdGoalsC b
|
||||||
EPLtGoals -> ltGoalsC
|
EPYtdAssists b -> ytdAssistsC b
|
||||||
EPLtAssists -> ltAssistsC
|
EPYtdPMin -> ytdPMinC
|
||||||
EPLtPMin -> ltPMinC
|
EPLtGoals b -> ltGoalsC b
|
||||||
|
EPLtAssists b -> ltAssistsC b
|
||||||
|
EPLtPMin -> ltPMinC
|
||||||
|
|
||||||
selectPlayerC :: Controller
|
selectPlayerC :: Controller
|
||||||
selectPlayerC = Controller
|
selectPlayerC = promptController playerToEditPrompt
|
||||||
{ drawController = drawPrompt playerToEditPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerToEditPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
menuC :: Controller
|
menuC :: Controller
|
||||||
menuC = Controller
|
menuC = menuControllerWith header editPlayerMenu
|
||||||
{ drawController = \s -> do
|
|
||||||
let
|
|
||||||
header = fromMaybe "" $ do
|
|
||||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
|
||||||
p <- nth pid $ s^.database.dbPlayers
|
|
||||||
Just $ playerDetails p ++ "\n"
|
|
||||||
C.drawString header
|
|
||||||
drawMenu editPlayerMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler editPlayerMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
numberC :: Controller
|
numberC :: Controller
|
||||||
numberC = Controller
|
numberC = promptController editPlayerNumPrompt
|
||||||
{ drawController = drawPrompt editPlayerNumPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerNumPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
nameC :: Controller
|
nameC :: Controller
|
||||||
nameC = Controller
|
nameC = promptController editPlayerNamePrompt
|
||||||
{ drawController = drawPrompt editPlayerNamePrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerNamePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
positionC :: Controller
|
positionC :: Controller
|
||||||
positionC = Controller
|
positionC = promptController editPlayerPosPrompt
|
||||||
{ drawController = drawPrompt editPlayerPosPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerPosPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
ytdGoalsC :: Controller
|
ytdC :: Controller
|
||||||
ytdGoalsC = Controller
|
ytdC = menuControllerWith header editPlayerYtdMenu
|
||||||
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerYtdGoalsPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
ytdAssistsC :: Controller
|
lifetimeC :: Controller
|
||||||
ytdAssistsC = Controller
|
lifetimeC = menuControllerWith header editPlayerLtMenu
|
||||||
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
|
|
||||||
, handleController = \e -> do
|
ytdGoalsC :: Bool -> Controller
|
||||||
promptHandler editPlayerYtdAssistsPrompt e
|
ytdGoalsC = promptController . editPlayerYtdGoalsPrompt
|
||||||
return True
|
|
||||||
}
|
ytdAssistsC :: Bool -> Controller
|
||||||
|
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt
|
||||||
|
|
||||||
ytdPMinC :: Controller
|
ytdPMinC :: Controller
|
||||||
ytdPMinC = Controller
|
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
||||||
{ drawController = drawPrompt editPlayerYtdPMinPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerYtdPMinPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
ltGoalsC :: Controller
|
ltGoalsC :: Bool -> Controller
|
||||||
ltGoalsC = Controller
|
ltGoalsC = promptController . editPlayerLtGoalsPrompt
|
||||||
{ drawController = drawPrompt editPlayerLtGoalsPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerLtGoalsPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
ltAssistsC :: Controller
|
ltAssistsC :: Bool -> Controller
|
||||||
ltAssistsC = Controller
|
ltAssistsC = promptController . editPlayerLtAssistsPrompt
|
||||||
{ drawController = drawPrompt editPlayerLtAssistsPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler editPlayerLtAssistsPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
ltPMinC :: Controller
|
ltPMinC :: Controller
|
||||||
ltPMinC = Controller
|
ltPMinC = promptController editPlayerLtPMinPrompt
|
||||||
{ drawController = drawPrompt editPlayerLtPMinPrompt
|
|
||||||
, handleController = \e -> do
|
header :: ProgState -> C.Update ()
|
||||||
promptHandler editPlayerLtPMinPrompt e
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
return True
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
}
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
|
Just $ playerDetails player ++ "\n"
|
||||||
|
|||||||
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
|
||||||
|
]
|
||||||
234
src/Mtlstats/Control/NewGame.hs
Normal file
234
src/Mtlstats/Control/NewGame.hs
Normal file
@@ -0,0 +1,234 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.NewGame (newGameC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||||
|
import Lens.Micro ((^.), (.~))
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Control.NewGame.GoalieInput
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Handlers
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.NewGame
|
||||||
|
import Mtlstats.Report
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Dispatcher for a new game
|
||||||
|
newGameC :: GameState -> Controller
|
||||||
|
newGameC gs
|
||||||
|
| null $ gs^.gameYear = gameYearC
|
||||||
|
| null $ gs^.gameMonth = gameMonthC
|
||||||
|
| null $ gs^.gameDay = gameDayC
|
||||||
|
| null $ gs^.gameType = gameTypeC
|
||||||
|
| null $ gs^.otherTeam = otherTeamC
|
||||||
|
| null $ gs^.homeScore = homeScoreC
|
||||||
|
| null $ gs^.awayScore = awayScoreC
|
||||||
|
| null $ gs^.overtimeFlag = overtimeFlagC
|
||||||
|
| not $ gs^.dataVerified = verifyDataC
|
||||||
|
| fromJust (unaccountedPoints gs) = goalInput gs
|
||||||
|
| isJust $ gs^.gameSelectedPlayer = getPMinsC
|
||||||
|
| not $ gs^.gamePMinsRecorded = pMinPlayerC
|
||||||
|
| not $ gs^.gameGoalieAssigned = goalieInputC gs
|
||||||
|
| otherwise = reportC
|
||||||
|
|
||||||
|
gameYearC :: Controller
|
||||||
|
gameYearC = promptControllerWith header gameYearPrompt
|
||||||
|
|
||||||
|
gameMonthC :: Controller
|
||||||
|
gameMonthC = menuControllerWith header gameMonthMenu
|
||||||
|
|
||||||
|
gameDayC :: Controller
|
||||||
|
gameDayC = promptControllerWith header gameDayPrompt
|
||||||
|
|
||||||
|
gameTypeC :: Controller
|
||||||
|
gameTypeC = menuControllerWith header gameTypeMenu
|
||||||
|
|
||||||
|
otherTeamC :: Controller
|
||||||
|
otherTeamC = promptControllerWith header otherTeamPrompt
|
||||||
|
|
||||||
|
homeScoreC :: Controller
|
||||||
|
homeScoreC = promptControllerWith header homeScorePrompt
|
||||||
|
|
||||||
|
awayScoreC :: Controller
|
||||||
|
awayScoreC = promptControllerWith header awayScorePrompt
|
||||||
|
|
||||||
|
overtimeFlagC :: Controller
|
||||||
|
overtimeFlagC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
C.drawString "Did the game go into overtime? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
verifyDataC :: Controller
|
||||||
|
verifyDataC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
header s
|
||||||
|
C.drawString "\n"
|
||||||
|
C.drawString $ unlines $ labelTable
|
||||||
|
[ ( "Date", gameDate gs )
|
||||||
|
, ( "Game type", show $ fromJust $ gs^.gameType )
|
||||||
|
, ( "Other team", gs^.otherTeam )
|
||||||
|
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
||||||
|
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
||||||
|
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
||||||
|
]
|
||||||
|
C.drawString "\nIs the above information correct? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> modify
|
||||||
|
$ (progMode.gameStateL.dataVerified .~ True)
|
||||||
|
. updateGameStats
|
||||||
|
. awardShutouts
|
||||||
|
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
goalInput :: GameState -> Controller
|
||||||
|
goalInput gs
|
||||||
|
| null (gs^.goalBy ) = recordGoalC
|
||||||
|
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||||
|
| otherwise = confirmGoalDataC
|
||||||
|
|
||||||
|
recordGoalC :: Controller
|
||||||
|
recordGoalC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
in drawPrompt (recordGoalPrompt game goal) s
|
||||||
|
, handleController = \e -> do
|
||||||
|
(game, goal) <- gets gameGoal
|
||||||
|
promptHandler (recordGoalPrompt game goal) e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
recordAssistC :: Controller
|
||||||
|
recordAssistC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
(game, goal, assist) = gameGoalAssist s
|
||||||
|
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||||
|
, handleController = \e -> do
|
||||||
|
(game, goal, assist) <- gets gameGoalAssist
|
||||||
|
promptHandler (recordAssistPrompt game goal assist) e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmGoalDataC :: Controller
|
||||||
|
confirmGoalDataC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
gs = s^.progMode.gameStateL
|
||||||
|
players = s^.database.dbPlayers
|
||||||
|
msg = unlines $
|
||||||
|
[ " Game: " ++ padNum 2 game
|
||||||
|
, " Goal: " ++ show goal
|
||||||
|
, "Goal scored by: " ++
|
||||||
|
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||||
|
] ++
|
||||||
|
map
|
||||||
|
(\pid -> " Assisted by: " ++
|
||||||
|
playerSummary (fromJust $ nth pid players))
|
||||||
|
(gs^.assistsBy) ++
|
||||||
|
[ ""
|
||||||
|
, "Is the above information correct? (Y/N)"
|
||||||
|
]
|
||||||
|
C.drawString msg
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> modify recordGoalAssists
|
||||||
|
Just False -> modify resetGoalData
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
pMinPlayerC :: Controller
|
||||||
|
pMinPlayerC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt pMinPlayerPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler pMinPlayerPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
getPMinsC :: Controller
|
||||||
|
getPMinsC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
C.drawString $ fromMaybe "" $ do
|
||||||
|
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||||
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
|
Just $ playerSummary player ++ "\n"
|
||||||
|
drawPrompt assignPMinsPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler assignPMinsPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
reportC :: Controller
|
||||||
|
reportC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
(rows, cols) <- C.windowSize
|
||||||
|
C.drawString $ unlines $ slice
|
||||||
|
(s^.scrollOffset)
|
||||||
|
(fromInteger $ pred rows)
|
||||||
|
(report (fromInteger $ pred cols) s)
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case e of
|
||||||
|
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||||
|
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||||
|
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||||
|
C.EventSpecialKey _ -> modify backHome
|
||||||
|
C.EventCharacter _ -> modify backHome
|
||||||
|
_ -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $
|
||||||
|
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||||
|
|
||||||
|
gameGoal :: ProgState -> (Int, Int)
|
||||||
|
gameGoal s =
|
||||||
|
( s^.database.dbGames
|
||||||
|
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||||
|
)
|
||||||
|
|
||||||
|
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||||
|
gameGoalAssist s = let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||||
|
in (game, goal, assist)
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Control.GoalieInput (goalieInput) where
|
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
@@ -28,21 +28,17 @@ import qualified UI.NCurses as C
|
|||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Prompt.GoalieInput
|
import Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | The dispatcher for handling goalie input
|
-- | The dispatcher for handling goalie input
|
||||||
goalieInput :: ProgState -> Controller
|
goalieInputC :: GameState -> Controller
|
||||||
goalieInput s = let
|
goalieInputC gs
|
||||||
gs = s^.progMode.gameStateL
|
| gs^.gameGoaliesRecorded = selectGameGoalieC
|
||||||
in if gs^.gameGoaliesRecorded
|
| null $ gs^.gameSelectedGoalie = selectGoalieC
|
||||||
then selectGameGoalieC s
|
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
|
||||||
else if null $ gs^.gameSelectedGoalie
|
| otherwise = goalsAllowedC
|
||||||
then selectGoalieC
|
|
||||||
else if null $ gs^.gameGoalieMinsPlayed
|
|
||||||
then minsPlayedC
|
|
||||||
else goalsAllowedC
|
|
||||||
|
|
||||||
selectGoalieC :: Controller
|
selectGoalieC :: Controller
|
||||||
selectGoalieC = promptController selectGameGoaliePrompt
|
selectGoalieC = promptController selectGameGoaliePrompt
|
||||||
@@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
|
|||||||
goalsAllowedC :: Controller
|
goalsAllowedC :: Controller
|
||||||
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
||||||
|
|
||||||
selectGameGoalieC :: ProgState -> Controller
|
selectGameGoalieC :: Controller
|
||||||
selectGameGoalieC = menuController . gameGoalieMenu
|
selectGameGoalieC = menuStateController gameGoalieMenu
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
header :: ProgState -> C.Update ()
|
||||||
header s = C.drawString $ unlines
|
header s = C.drawString $ unlines
|
||||||
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,15 +19,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Format
|
module Mtlstats.Format
|
||||||
( padNum
|
( padNum
|
||||||
, left
|
, left
|
||||||
, right
|
, right
|
||||||
, centre
|
, centre
|
||||||
|
, padRight
|
||||||
, overlay
|
, overlay
|
||||||
, month
|
, month
|
||||||
|
, labelTable
|
||||||
|
, numTable
|
||||||
|
, tableWith
|
||||||
|
, complexTable
|
||||||
|
, overlayLast
|
||||||
|
, showFloating
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.List (transpose)
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
||||||
padNum
|
padNum
|
||||||
:: Int
|
:: Int
|
||||||
@@ -75,6 +88,16 @@ centre n str = let
|
|||||||
pad = replicate pLen ' '
|
pad = replicate pLen ' '
|
||||||
in take n $ pad ++ str ++ repeat ' '
|
in take n $ pad ++ str ++ repeat ' '
|
||||||
|
|
||||||
|
-- | Pads text on the right with spaces to fit a minimum width
|
||||||
|
padRight
|
||||||
|
:: Int
|
||||||
|
-- ^ The width to pad to
|
||||||
|
-> String
|
||||||
|
-- ^ The text to pad
|
||||||
|
-> String
|
||||||
|
padRight width str =
|
||||||
|
overlay str $ replicate width ' '
|
||||||
|
|
||||||
-- | Overlays one string on top of another
|
-- | Overlays one string on top of another
|
||||||
overlay
|
overlay
|
||||||
:: String
|
:: String
|
||||||
@@ -101,3 +124,84 @@ month 10 = "OCT"
|
|||||||
month 11 = "NOV"
|
month 11 = "NOV"
|
||||||
month 12 = "DEC"
|
month 12 = "DEC"
|
||||||
month _ = ""
|
month _ = ""
|
||||||
|
|
||||||
|
-- | Creates a two-column table with labels
|
||||||
|
labelTable :: [(String, String)] -> [String]
|
||||||
|
labelTable xs = let
|
||||||
|
labelWidth = maximum $ map (length . fst) xs
|
||||||
|
in map
|
||||||
|
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
||||||
|
xs
|
||||||
|
|
||||||
|
-- | Creates a variable column table of numbers with two axes
|
||||||
|
numTable
|
||||||
|
:: [String]
|
||||||
|
-- ^ The top column labels
|
||||||
|
-> [(String, [Int])]
|
||||||
|
-- ^ The rows with their labels
|
||||||
|
-> [String]
|
||||||
|
numTable headers rows = tableWith right $ header : body
|
||||||
|
where
|
||||||
|
header = "" : headers
|
||||||
|
body = map
|
||||||
|
(\(label, row) ->
|
||||||
|
label : map show row)
|
||||||
|
rows
|
||||||
|
|
||||||
|
-- | Creates a table from a two-dimensional list with a specified
|
||||||
|
-- padding function
|
||||||
|
tableWith
|
||||||
|
:: (Int -> String -> String)
|
||||||
|
-- ^ The padding function
|
||||||
|
-> [[String]]
|
||||||
|
-- ^ The cells
|
||||||
|
-> [String]
|
||||||
|
tableWith pFunc tData = complexTable
|
||||||
|
(repeat pFunc)
|
||||||
|
(map (map CellText) tData)
|
||||||
|
|
||||||
|
-- | Creates a complex table
|
||||||
|
complexTable
|
||||||
|
:: [Int -> String -> String]
|
||||||
|
-- ^ The padding function for each column
|
||||||
|
-> [[TableCell]]
|
||||||
|
-- ^ The table cells (an array of rows)
|
||||||
|
-> [String]
|
||||||
|
complexTable pFuncs tData = let
|
||||||
|
widths = map
|
||||||
|
(map $ \case
|
||||||
|
CellText str -> length str
|
||||||
|
CellFill _ -> 0)
|
||||||
|
tData
|
||||||
|
colWidths = map maximum $ transpose widths
|
||||||
|
|
||||||
|
bFunc = \case
|
||||||
|
[] -> ""
|
||||||
|
[(f, len, CellText str)] -> f len str
|
||||||
|
[(_, len, CellFill ch)] -> replicate len ch
|
||||||
|
(f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
|
||||||
|
(_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells
|
||||||
|
|
||||||
|
in map
|
||||||
|
(bFunc . zip3 pFuncs colWidths)
|
||||||
|
tData
|
||||||
|
|
||||||
|
-- | Places an overlay on the last line of an report
|
||||||
|
overlayLast
|
||||||
|
:: String
|
||||||
|
-- ^ The text to overlay
|
||||||
|
-> [String]
|
||||||
|
-- ^ The report to modify
|
||||||
|
-> [String]
|
||||||
|
-- ^ The resulting report
|
||||||
|
overlayLast _ [] = []
|
||||||
|
overlayLast str [l] = [overlay str l]
|
||||||
|
overlayLast str (l:ls) = l : overlayLast str ls
|
||||||
|
|
||||||
|
-- | Converts a non-integer into a string
|
||||||
|
showFloating :: RealFrac n => n -> String
|
||||||
|
showFloating n = let
|
||||||
|
i = round $ n * 100
|
||||||
|
whole = i `div` 100
|
||||||
|
fraction = i `mod` 100
|
||||||
|
in show whole ++ "." ++ padNum 2 fraction
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
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
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -22,6 +22,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Menu (
|
module Mtlstats.Menu (
|
||||||
-- * Menu Functions
|
-- * Menu Functions
|
||||||
menuController,
|
menuController,
|
||||||
|
menuControllerWith,
|
||||||
|
menuStateController,
|
||||||
drawMenu,
|
drawMenu,
|
||||||
menuHandler,
|
menuHandler,
|
||||||
-- * Menus
|
-- * Menus
|
||||||
@@ -29,45 +31,70 @@ module Mtlstats.Menu (
|
|||||||
newSeasonMenu,
|
newSeasonMenu,
|
||||||
gameMonthMenu,
|
gameMonthMenu,
|
||||||
gameTypeMenu,
|
gameTypeMenu,
|
||||||
editPlayerMenu,
|
gameGoalieMenu,
|
||||||
gameGoalieMenu
|
editMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Aeson (encodeFile)
|
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (mapMaybe)
|
import Data.Maybe (mapMaybe)
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
import Lens.Micro ((^.), (?~))
|
||||||
import Lens.Micro.Extras (view)
|
|
||||||
import System.EasyFile
|
|
||||||
( createDirectoryIfMissing
|
|
||||||
, getAppUserDataDirectory
|
|
||||||
, (</>)
|
|
||||||
)
|
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import qualified Mtlstats.Actions.GoalieInput as GI
|
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||||
|
import Mtlstats.Actions.EditStandings
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Format
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Generates a simple 'Controller' for a Menu
|
-- | Generates a simple 'Controller' for a Menu
|
||||||
menuController :: Menu () -> Controller
|
menuController :: Menu () -> Controller
|
||||||
menuController menu = Controller
|
menuController = menuControllerWith $ const $ return ()
|
||||||
{ drawController = const $ drawMenu menu
|
|
||||||
|
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||||
|
menuControllerWith
|
||||||
|
:: (ProgState -> C.Update ())
|
||||||
|
-- ^ Generates the header
|
||||||
|
-> Menu ()
|
||||||
|
-- ^ The menu
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
menuControllerWith header menu = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawMenu menu
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
menuHandler menu e
|
menuHandler menu e
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Generate and create a controller for a menu based on the current
|
||||||
|
-- 'ProgState'
|
||||||
|
menuStateController
|
||||||
|
:: (ProgState -> Menu ())
|
||||||
|
-- ^ The function to generate the menu
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
menuStateController menuFunc = Controller
|
||||||
|
{ drawController = drawMenu . menuFunc
|
||||||
|
, handleController = \e -> do
|
||||||
|
menu <- gets menuFunc
|
||||||
|
menuHandler menu e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
-- | The draw function for a 'Menu'
|
-- | The draw function for a 'Menu'
|
||||||
drawMenu :: Menu a -> C.Update C.CursorMode
|
drawMenu :: Menu a -> C.Update C.CursorMode
|
||||||
drawMenu m = do
|
drawMenu m = do
|
||||||
C.drawString $ show m
|
(_, cols) <- C.windowSize
|
||||||
|
let
|
||||||
|
width = fromIntegral $ pred cols
|
||||||
|
menuText = map (centre width) $ lines $ show m
|
||||||
|
C.drawString $ unlines menuText
|
||||||
return C.CursorInvisible
|
return C.CursorInvisible
|
||||||
|
|
||||||
-- | The event handler for a 'Menu'
|
-- | The event handler for a 'Menu'
|
||||||
@@ -80,84 +107,59 @@ menuHandler m _ = return $ m^.menuDefault
|
|||||||
|
|
||||||
-- | The main menu
|
-- | The main menu
|
||||||
mainMenu :: Menu Bool
|
mainMenu :: Menu Bool
|
||||||
mainMenu = Menu "*** MAIN MENU ***" True
|
mainMenu = Menu "MASTER MENU" True
|
||||||
[ MenuItem '1' "New Season" $
|
[ MenuItem 'A' "NEW SEASON" $
|
||||||
modify startNewSeason >> return True
|
modify startNewSeason >> return True
|
||||||
, MenuItem '2' "New Game" $
|
, MenuItem 'B' "NEW GAME" $
|
||||||
modify startNewGame >> return True
|
modify startNewGame >> return True
|
||||||
, MenuItem '3' "Create Player" $
|
, MenuItem 'C' "EDIT MENU" $
|
||||||
modify createPlayer >> return True
|
modify edit >> return True
|
||||||
, MenuItem '4' "Create Goalie" $
|
, MenuItem 'E' "EXIT" $
|
||||||
modify createGoalie >> return True
|
saveDatabase dbFname >> return False
|
||||||
, MenuItem '5' "Edit Player" $
|
|
||||||
modify editPlayer >> return True
|
|
||||||
, MenuItem '6' "Exit" $ do
|
|
||||||
db <- gets $ view database
|
|
||||||
liftIO $ do
|
|
||||||
dir <- getAppUserDataDirectory appName
|
|
||||||
let dbFile = dir </> dbFname
|
|
||||||
createDirectoryIfMissing True dir
|
|
||||||
encodeFile dbFile db
|
|
||||||
return False
|
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The new season menu
|
-- | The new season menu
|
||||||
newSeasonMenu :: Menu ()
|
newSeasonMenu :: Menu ()
|
||||||
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
newSeasonMenu = Menu "SEASON TYPE" ()
|
||||||
[ MenuItem '1' "Regular Season" $ do
|
[ MenuItem 'R' "REGULAR SEASON" $ modify
|
||||||
modify resetYtd
|
$ resetYtd
|
||||||
modify startNewGame
|
. clearRookies
|
||||||
, MenuItem '2' "Playoffs" $
|
. resetStandings
|
||||||
modify startNewGame
|
. startNewGame
|
||||||
|
, MenuItem 'P' "PLAYOFFS" $ modify
|
||||||
|
$ resetStandings
|
||||||
|
. startNewGame
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Requests the month in which the game took place
|
-- | Requests the month in which the game took place
|
||||||
gameMonthMenu :: Menu ()
|
gameMonthMenu :: Menu ()
|
||||||
gameMonthMenu = Menu "Month:" () $ map
|
gameMonthMenu = Menu "MONTH:" () $ map
|
||||||
(\(ch, name, val) ->
|
(\(ch, name, val) ->
|
||||||
MenuItem ch name $
|
MenuItem ch name $
|
||||||
modify $ progMode.gameStateL.gameMonth ?~ val)
|
modify $ progMode.gameStateL.gameMonth ?~ val)
|
||||||
[ ( 'A', "January", 1 )
|
[ ( 'A', "JANUARY", 1 )
|
||||||
, ( 'B', "February", 2 )
|
, ( 'B', "FEBRUARY", 2 )
|
||||||
, ( 'C', "March", 3 )
|
, ( 'C', "MARCH", 3 )
|
||||||
, ( 'D', "April", 4 )
|
, ( 'D', "APRIL", 4 )
|
||||||
, ( 'E', "May", 5 )
|
, ( 'E', "MAY", 5 )
|
||||||
, ( 'F', "June", 6 )
|
, ( 'F', "JUNE", 6 )
|
||||||
, ( 'G', "July", 7 )
|
, ( 'G', "JULY", 7 )
|
||||||
, ( 'H', "August", 8 )
|
, ( 'H', "AUGUST", 8 )
|
||||||
, ( 'I', "September", 9 )
|
, ( 'I', "SEPTEMBER", 9 )
|
||||||
, ( 'J', "October", 10 )
|
, ( 'J', "OCTOBER", 10 )
|
||||||
, ( 'K', "November", 11 )
|
, ( 'K', "NOVEMBER", 11 )
|
||||||
, ( 'L', "December", 12 )
|
, ( 'L', "DECEMBER", 12 )
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The game type menu (home/away)
|
-- | The game type menu (home/away)
|
||||||
gameTypeMenu :: Menu ()
|
gameTypeMenu :: Menu ()
|
||||||
gameTypeMenu = Menu "Game type:" ()
|
gameTypeMenu = Menu "GAME TYPE:" ()
|
||||||
[ MenuItem '1' "Home Game" $
|
[ MenuItem 'H' "HOME GAME" $
|
||||||
modify $ progMode.gameStateL.gameType ?~ HomeGame
|
modify $ progMode.gameStateL.gameType ?~ HomeGame
|
||||||
, MenuItem '2' "Away Game" $
|
, MenuItem 'A' "AWAY GAME" $
|
||||||
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The player edit menu
|
|
||||||
editPlayerMenu :: Menu ()
|
|
||||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
|
||||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
|
||||||
Nothing -> modify $ progMode .~ MainMenu
|
|
||||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
|
||||||
[ ( '1', "Change number", Just EPNumber )
|
|
||||||
, ( '2', "Change name", Just EPName )
|
|
||||||
, ( '3', "Change position", Just EPPosition )
|
|
||||||
, ( '4', "YTD goals", Just EPYtdGoals )
|
|
||||||
, ( '5', "YTD assists", Just EPYtdAssists )
|
|
||||||
, ( '6', "YTD penalty mins", Just EPYtdPMin )
|
|
||||||
, ( '7', "Lifetime goals", Just EPLtGoals )
|
|
||||||
, ( '8', "Lifetime assists", Just EPLtAssists )
|
|
||||||
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
|
|
||||||
, ( '0', "Finished editing", Nothing )
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Game goalie selection menu
|
-- | Game goalie selection menu
|
||||||
gameGoalieMenu :: ProgState -> Menu ()
|
gameGoalieMenu :: ProgState -> Menu ()
|
||||||
gameGoalieMenu s = let
|
gameGoalieMenu s = let
|
||||||
@@ -172,3 +174,20 @@ gameGoalieMenu s = let
|
|||||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
||||||
modify $ GI.setGameGoalie gid) $
|
modify $ GI.setGameGoalie gid) $
|
||||||
zip ['1'..] goalies
|
zip ['1'..] goalies
|
||||||
|
|
||||||
|
-- | The edit menu
|
||||||
|
editMenu :: Menu ()
|
||||||
|
editMenu = Menu "EDIT MENU" ()
|
||||||
|
[ MenuItem 'A' "CREATE PLAYER" $
|
||||||
|
modify createPlayer
|
||||||
|
, MenuItem 'B' "CREATE GOALIE" $
|
||||||
|
modify createGoalie
|
||||||
|
, MenuItem 'C' "EDIT PLAYER" $
|
||||||
|
modify editPlayer
|
||||||
|
, MenuItem 'D' "EDIT GOALIE" $
|
||||||
|
modify editGoalie
|
||||||
|
, MenuItem 'E' "EDIT STANDINGS" $
|
||||||
|
modify editStandings
|
||||||
|
, MenuItem 'R' "RETURN TO MAIN MENU" $
|
||||||
|
modify backHome
|
||||||
|
]
|
||||||
|
|||||||
89
src/Mtlstats/Menu/EditGoalie.hs
Normal file
89
src/Mtlstats/Menu/EditGoalie.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.Menu.EditGoalie
|
||||||
|
( editGoalieMenu
|
||||||
|
, editGoalieYtdMenu
|
||||||
|
, editGoalieLtMenu
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
-- | The 'Goalie' edit menu
|
||||||
|
editGoalieMenu :: Menu ()
|
||||||
|
editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
||||||
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
|
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT NUMBER", set EGNumber )
|
||||||
|
, ( 'B', "EDIT NAME", set EGName )
|
||||||
|
, ( 'C', "TOGGLE ROOKIE FLAG", toggleRookie )
|
||||||
|
, ( 'D', "TOGGLE ACTIVE FLAG", toggleActive )
|
||||||
|
, ( 'E', "EDIT YTD STATS", set EGYtd )
|
||||||
|
, ( 'F', "EDIT LIFETIME STATS", set EGLifetime )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
set mode = progMode.editGoalieStateL.egsMode .~ mode
|
||||||
|
toggleRookie = editSelectedGoalie (gRookie %~ not)
|
||||||
|
toggleActive = editSelectedGoalie (gActive %~ not)
|
||||||
|
|
||||||
|
-- | The 'Goalie' YTD edit menu
|
||||||
|
editGoalieYtdMenu :: Menu ()
|
||||||
|
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT ALL YTD STATS", EGYtdGames True )
|
||||||
|
, ( 'B', "EDIT YTD GAMES", EGYtdGames False )
|
||||||
|
, ( 'C', "EDIT YTD MINUTES", EGYtdMins False )
|
||||||
|
, ( 'D', "EDIT YTD GOALS", EGYtdGoals False )
|
||||||
|
, ( 'E', "EDIT YTD SHUTOUTS", EGYtdShutouts False )
|
||||||
|
, ( 'F', "EDIT YTD WINS", EGYtdWins False )
|
||||||
|
, ( 'G', "EDIT YTD LOSSES", EGYtdLosses False )
|
||||||
|
, ( 'H', "EDIT YTD TIES", EGYtdTies )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Goalie' lifetime edit menu
|
||||||
|
editGoalieLtMenu :: Menu ()
|
||||||
|
editGoalieLtMenu = editMenu
|
||||||
|
"EDIT GOALTENDER LIFETIME"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT ALL LIFETIME STATS", EGLtGames True )
|
||||||
|
, ( 'B', "EDIT LIFETIME GAMES", EGLtGames False )
|
||||||
|
, ( 'C', "EDIT LIFETIME MINUTES", EGLtMins False )
|
||||||
|
, ( 'D', "EDIT LIFETIME GOALS", EGLtGoals False )
|
||||||
|
, ( 'E', "EDIT LIFETIME SHUTOUTS", EGLtShutouts False )
|
||||||
|
, ( 'F', "EDIT LIFETIME WINS", EGLtWins False )
|
||||||
|
, ( 'G', "EDIT LIFETIME LOSSES", EGLtLosses False )
|
||||||
|
, ( 'H', "EDIT LIFETIME TIES", EGLtTies )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||||
|
editMenu title = Menu title () . map
|
||||||
|
(\(key, label, val) -> MenuItem key label $
|
||||||
|
modify $ progMode.editGoalieStateL.egsMode .~ val)
|
||||||
83
src/Mtlstats/Menu/EditPlayer.hs
Normal file
83
src/Mtlstats/Menu/EditPlayer.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 Mtlstats.Menu.EditPlayer
|
||||||
|
( editPlayerMenu
|
||||||
|
, editPlayerYtdMenu
|
||||||
|
, editPlayerLtMenu
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
-- | The 'Player' edit menu
|
||||||
|
editPlayerMenu :: Menu ()
|
||||||
|
editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
||||||
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
|
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT NUMBER", set EPNumber )
|
||||||
|
, ( 'B', "EDIT NAME", set EPName )
|
||||||
|
, ( 'C', "EDIT POSITION", set EPPosition )
|
||||||
|
, ( 'D', "TOGGLE ROOKIE FLAG", toggleRookie )
|
||||||
|
, ( 'E', "TOGGLE ACTIVE FLAG", toggleActive )
|
||||||
|
, ( 'F', "EDIT YTD STATS", set EPYtd )
|
||||||
|
, ( 'G', "EDIT LIFETIME STATS", set EPLifetime )
|
||||||
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
set mode = progMode.editPlayerStateL.epsMode .~ mode
|
||||||
|
toggleRookie = editSelectedPlayer $ pRookie %~ not
|
||||||
|
toggleActive = editSelectedPlayer $ pActive %~ not
|
||||||
|
|
||||||
|
-- | The 'Player' YTD stats edit menu
|
||||||
|
editPlayerYtdMenu :: Menu ()
|
||||||
|
editPlayerYtdMenu = editMenu
|
||||||
|
"EDIT PLAYER YEAR-TO-DATE"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT ALL YTD STATS", EPYtdGoals True )
|
||||||
|
, ( 'B', "EDIT YTD GOALS", EPYtdGoals False )
|
||||||
|
, ( 'C', "EDIT YTD ASSISTS", EPYtdAssists False )
|
||||||
|
, ( 'D', "EDIT YTD PENALTY MINS", EPYtdPMin )
|
||||||
|
, ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Player' lifetime stats edit menu
|
||||||
|
editPlayerLtMenu :: Menu ()
|
||||||
|
editPlayerLtMenu = editMenu
|
||||||
|
"EDIT PLAYER LIFETIME"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( 'A', "EDIT ALL LIFETIME STATS", EPLtGoals True )
|
||||||
|
, ( 'B', "EDIT LIFETIME GOALS", EPLtGoals False )
|
||||||
|
, ( 'C', "EDIT LIFETIME ASSITS", EPLtAssists False )
|
||||||
|
, ( 'D', "EDIT LIFETIME PENALTY MINS", EPLtPMin )
|
||||||
|
, ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
||||||
|
editMenu title = Menu title () . map
|
||||||
|
(\(key, label, val) -> MenuItem key label $
|
||||||
|
modify $ progMode.editPlayerStateL.epsMode .~ val)
|
||||||
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -28,14 +28,13 @@ module Mtlstats.Prompt (
|
|||||||
promptControllerWith,
|
promptControllerWith,
|
||||||
promptController,
|
promptController,
|
||||||
strPrompt,
|
strPrompt,
|
||||||
|
ucStrPrompt,
|
||||||
|
namePrompt,
|
||||||
numPrompt,
|
numPrompt,
|
||||||
|
numPromptWithFallback,
|
||||||
selectPrompt,
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
gameYearPrompt,
|
newSeasonPrompt,
|
||||||
gameDayPrompt,
|
|
||||||
otherTeamPrompt,
|
|
||||||
homeScorePrompt,
|
|
||||||
awayScorePrompt,
|
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
playerPosPrompt,
|
playerPosPrompt,
|
||||||
@@ -43,19 +42,13 @@ module Mtlstats.Prompt (
|
|||||||
goalieNamePrompt,
|
goalieNamePrompt,
|
||||||
selectPlayerPrompt,
|
selectPlayerPrompt,
|
||||||
selectGoaliePrompt,
|
selectGoaliePrompt,
|
||||||
recordGoalPrompt,
|
|
||||||
recordAssistPrompt,
|
|
||||||
pMinPlayerPrompt,
|
|
||||||
assignPMinsPrompt,
|
|
||||||
playerToEditPrompt
|
playerToEditPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.Extra (whenJust)
|
import Control.Monad.Extra (whenJust)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (isDigit, toUpper)
|
import Data.Char (isAlphaNum, isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
@@ -63,7 +56,6 @@ import qualified UI.NCurses as C
|
|||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Format
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -79,10 +71,8 @@ promptHandler p (C.EventCharacter '\n') = do
|
|||||||
val <- gets $ view inputBuffer
|
val <- gets $ view inputBuffer
|
||||||
modify $ inputBuffer .~ ""
|
modify $ inputBuffer .~ ""
|
||||||
promptAction p val
|
promptAction p val
|
||||||
promptHandler p (C.EventCharacter c) = let
|
promptHandler p (C.EventCharacter c) =
|
||||||
c' = toUpper c
|
modify $ inputBuffer %~ promptProcessChar p c
|
||||||
in when (promptCharCheck p c') $
|
|
||||||
modify $ addChar c'
|
|
||||||
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
promptHandler _ (C.EventSpecialKey C.KeyBackspace) =
|
||||||
modify removeChar
|
modify removeChar
|
||||||
promptHandler p (C.EventSpecialKey k) =
|
promptHandler p (C.EventSpecialKey k) =
|
||||||
@@ -122,12 +112,33 @@ strPrompt
|
|||||||
-- ^ The callback function for the result
|
-- ^ The callback function for the result
|
||||||
-> Prompt
|
-> Prompt
|
||||||
strPrompt pStr act = Prompt
|
strPrompt pStr act = Prompt
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
{ promptDrawer = drawSimplePrompt pStr
|
||||||
, promptCharCheck = const True
|
, promptProcessChar = \ch -> (++ [ch])
|
||||||
, promptAction = act
|
, promptAction = act
|
||||||
, promptSpecialKey = const $ return ()
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Creates an upper case string prompt
|
||||||
|
ucStrPrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
ucStrPrompt pStr act = (strPrompt pStr act)
|
||||||
|
{ promptProcessChar = \ch -> (++ [toUpper ch]) }
|
||||||
|
|
||||||
|
-- | Creates a prompt which forces capitalization of input to
|
||||||
|
-- accomodate a player or goalie name
|
||||||
|
namePrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
namePrompt pStr act = (strPrompt pStr act)
|
||||||
|
{ promptProcessChar = capitalizeName }
|
||||||
|
|
||||||
-- | Builds a numeric prompt
|
-- | Builds a numeric prompt
|
||||||
numPrompt
|
numPrompt
|
||||||
:: String
|
:: String
|
||||||
@@ -135,13 +146,44 @@ numPrompt
|
|||||||
-> (Int -> Action ())
|
-> (Int -> Action ())
|
||||||
-- ^ The callback function for the result
|
-- ^ The callback function for the result
|
||||||
-> Prompt
|
-> Prompt
|
||||||
numPrompt pStr act = Prompt
|
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
|
||||||
, promptCharCheck = isDigit
|
-- | Builds a numeric prompt with a fallback action
|
||||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
numPromptWithFallback
|
||||||
, promptSpecialKey = const $ return ()
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to call on invalid (or blank) input
|
||||||
|
-> (Int -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
numPromptWithFallback pStr fallback act = Prompt
|
||||||
|
{ promptDrawer = drawSimplePrompt pStr
|
||||||
|
, promptProcessChar = \ch str -> if isDigit ch
|
||||||
|
then str ++ [ch]
|
||||||
|
else str
|
||||||
|
, promptAction = \inStr -> case readMaybe inStr of
|
||||||
|
Nothing -> fallback
|
||||||
|
Just n -> act n
|
||||||
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Prompts the user for a filename to save a backup of the database
|
||||||
|
-- to
|
||||||
|
newSeasonPrompt :: Prompt
|
||||||
|
newSeasonPrompt = prompt
|
||||||
|
{ promptProcessChar = \ch str -> if isAlphaNum ch
|
||||||
|
then str ++ [toUpper ch]
|
||||||
|
else str
|
||||||
|
}
|
||||||
|
where
|
||||||
|
prompt = strPrompt "Filename to save database: " $ \fn ->
|
||||||
|
if null fn
|
||||||
|
then modify backHome
|
||||||
|
else do
|
||||||
|
saveDatabase $ fn ++ ".json"
|
||||||
|
modify $ progMode .~ NewSeason True
|
||||||
|
|
||||||
-- | Builds a selection prompt
|
-- | Builds a selection prompt
|
||||||
selectPrompt :: SelectParams a -> Prompt
|
selectPrompt :: SelectParams a -> Prompt
|
||||||
selectPrompt params = Prompt
|
selectPrompt params = Prompt
|
||||||
@@ -157,7 +199,7 @@ selectPrompt params = Prompt
|
|||||||
in "F" ++ show n ++ ") " ++ desc)
|
in "F" ++ show n ++ ") " ++ desc)
|
||||||
results
|
results
|
||||||
C.moveCursor row col
|
C.moveCursor row col
|
||||||
, promptCharCheck = const True
|
, promptProcessChar = spProcessChar params
|
||||||
, promptAction = \sStr -> if null sStr
|
, promptAction = \sStr -> if null sStr
|
||||||
then spCallback params Nothing
|
then spCallback params Nothing
|
||||||
else do
|
else do
|
||||||
@@ -173,37 +215,12 @@ selectPrompt params = Prompt
|
|||||||
n = pred $ fromInteger rawK
|
n = pred $ fromInteger rawK
|
||||||
results = spSearch params sStr db
|
results = spSearch params sStr db
|
||||||
when (n < maxFunKeys) $
|
when (n < maxFunKeys) $
|
||||||
whenJust (nth n results) $ \(n, _) -> do
|
whenJust (nth n results) $ \(sel, _) -> do
|
||||||
modify $ inputBuffer .~ ""
|
modify $ inputBuffer .~ ""
|
||||||
spCallback params $ Just n
|
spCallback params $ Just sel
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the game year
|
|
||||||
gameYearPrompt :: Prompt
|
|
||||||
gameYearPrompt = numPrompt "Game year: " $
|
|
||||||
modify . (progMode.gameStateL.gameYear ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the day of the month the game took place
|
|
||||||
gameDayPrompt :: Prompt
|
|
||||||
gameDayPrompt = numPrompt "Day of month: " $
|
|
||||||
modify . (progMode.gameStateL.gameDay ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the other team name
|
|
||||||
otherTeamPrompt :: Prompt
|
|
||||||
otherTeamPrompt = strPrompt "Other team: " $
|
|
||||||
modify . (progMode.gameStateL.otherTeam .~)
|
|
||||||
|
|
||||||
-- | Prompts for the home score
|
|
||||||
homeScorePrompt :: Prompt
|
|
||||||
homeScorePrompt = numPrompt "Home score: " $
|
|
||||||
modify . (progMode.gameStateL.homeScore ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the away score
|
|
||||||
awayScorePrompt :: Prompt
|
|
||||||
awayScorePrompt = numPrompt "Away score: " $
|
|
||||||
modify . (progMode.gameStateL.awayScore ?~)
|
|
||||||
|
|
||||||
-- | Prompts for a new player's number
|
-- | Prompts for a new player's number
|
||||||
playerNumPrompt :: Prompt
|
playerNumPrompt :: Prompt
|
||||||
playerNumPrompt = numPrompt "Player number: " $
|
playerNumPrompt = numPrompt "Player number: " $
|
||||||
@@ -211,12 +228,12 @@ playerNumPrompt = numPrompt "Player number: " $
|
|||||||
|
|
||||||
-- | Prompts for a new player's name
|
-- | Prompts for a new player's name
|
||||||
playerNamePrompt :: Prompt
|
playerNamePrompt :: Prompt
|
||||||
playerNamePrompt = strPrompt "Player name: " $
|
playerNamePrompt = namePrompt "Player name: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsName .~)
|
modify . (progMode.createPlayerStateL.cpsName .~)
|
||||||
|
|
||||||
-- | Prompts for a new player's position
|
-- | Prompts for a new player's position
|
||||||
playerPosPrompt :: Prompt
|
playerPosPrompt :: Prompt
|
||||||
playerPosPrompt = strPrompt "Player position: " $
|
playerPosPrompt = ucStrPrompt "Player position: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||||
|
|
||||||
-- | Prompts tor the goalie's number
|
-- | Prompts tor the goalie's number
|
||||||
@@ -226,7 +243,7 @@ goalieNumPrompt = numPrompt "Goalie number: " $
|
|||||||
|
|
||||||
-- | Prompts for the goalie's name
|
-- | Prompts for the goalie's name
|
||||||
goalieNamePrompt :: Prompt
|
goalieNamePrompt :: Prompt
|
||||||
goalieNamePrompt = strPrompt "Goalie name: " $
|
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||||
|
|
||||||
-- | Selects a player (creating one if necessary)
|
-- | Selects a player (creating one if necessary)
|
||||||
@@ -243,6 +260,7 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
|||||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||||
, spElemDesc = playerSummary
|
, spElemDesc = playerSummary
|
||||||
|
, spProcessChar = capitalizeName
|
||||||
, spCallback = callback
|
, spCallback = callback
|
||||||
, spNotFound = \sStr -> do
|
, spNotFound = \sStr -> do
|
||||||
mode <- gets (^.progMode)
|
mode <- gets (^.progMode)
|
||||||
@@ -271,6 +289,7 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
|||||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||||
, spElemDesc = goalieSummary
|
, spElemDesc = goalieSummary
|
||||||
|
, spProcessChar = capitalizeName
|
||||||
, spCallback = callback
|
, spCallback = callback
|
||||||
, spNotFound = \sStr -> do
|
, spNotFound = \sStr -> do
|
||||||
mode <- gets (^.progMode)
|
mode <- gets (^.progMode)
|
||||||
@@ -285,52 +304,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreateGoalie cgs
|
modify $ progMode .~ CreateGoalie cgs
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the player who scored the goal
|
|
||||||
recordGoalPrompt
|
|
||||||
:: Int
|
|
||||||
-- ^ The game number
|
|
||||||
-> Int
|
|
||||||
-- ^ The goal number
|
|
||||||
-> Prompt
|
|
||||||
recordGoalPrompt game goal = selectPlayerPrompt
|
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
|
||||||
++ "Who scored goal number " ++ show goal ++ "? "
|
|
||||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
|
||||||
|
|
||||||
-- | Prompts for a player who assisted the goal
|
|
||||||
recordAssistPrompt
|
|
||||||
:: Int
|
|
||||||
-- ^ The game number
|
|
||||||
-> Int
|
|
||||||
-- ^ The goal nuber
|
|
||||||
-> Int
|
|
||||||
-- ^ The assist number
|
|
||||||
-> Prompt
|
|
||||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
|
||||||
++ "Goal: " ++ show goal ++ "\n"
|
|
||||||
++ "Assist #" ++ show assist ++ ": "
|
|
||||||
) $ \case
|
|
||||||
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
|
||||||
Just n -> do
|
|
||||||
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
|
||||||
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
|
|
||||||
when (nAssists >= maxAssists) $
|
|
||||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
|
||||||
|
|
||||||
-- | Prompts for the player to assign penalty minutes to
|
|
||||||
pMinPlayerPrompt :: Prompt
|
|
||||||
pMinPlayerPrompt = selectPlayerPrompt
|
|
||||||
"Assign penalty minutes to: " $
|
|
||||||
\case
|
|
||||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
|
||||||
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
|
||||||
|
|
||||||
-- | Prompts for the number of penalty mintues to assign to the player
|
|
||||||
assignPMinsPrompt :: Prompt
|
|
||||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
|
||||||
modify . assignPMins
|
|
||||||
|
|
||||||
playerToEditPrompt :: Prompt
|
playerToEditPrompt :: Prompt
|
||||||
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||||
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||||
|
|||||||
223
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
223
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
@@ -0,0 +1,223 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Prompt.EditGoalie
|
||||||
|
( goalieToEditPrompt
|
||||||
|
, editGoalieNumberPrompt
|
||||||
|
, editGoalieNamePrompt
|
||||||
|
, editGoalieYtdGamesPrompt
|
||||||
|
, editGoalieYtdMinsPrompt
|
||||||
|
, editGoalieYtdGoalsPrompt
|
||||||
|
, editGoalieYtdShutoutsPrompt
|
||||||
|
, editGoalieYtdWinsPrompt
|
||||||
|
, editGoalieYtdLossesPrompt
|
||||||
|
, editGoalieYtdTiesPrompt
|
||||||
|
, editGoalieLtGamesPrompt
|
||||||
|
, editGoalieLtMinsPrompt
|
||||||
|
, editGoalieLtGoalsPrompt
|
||||||
|
, editGoalieLtShutoutsPrompt
|
||||||
|
, editGoalieLtWinsPrompt
|
||||||
|
, editGoalieLtLossesPrompt
|
||||||
|
, editGoalieLtTiesPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Prompt to select a 'Goalie' for editing
|
||||||
|
goalieToEditPrompt :: Prompt
|
||||||
|
goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
||||||
|
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's number
|
||||||
|
editGoalieNumberPrompt :: Prompt
|
||||||
|
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
||||||
|
(gNumber .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's name
|
||||||
|
editGoalieNamePrompt :: Prompt
|
||||||
|
editGoalieNamePrompt = namePrompt "Goalie name: " $ \name ->
|
||||||
|
if null name
|
||||||
|
then goto EGMenu
|
||||||
|
else doEdit EGMenu $ gName .~ name
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD games played
|
||||||
|
editGoalieYtdGamesPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdGamesPrompt batchMode =
|
||||||
|
editNum "Year-to-date games played: " mode
|
||||||
|
(gYtd.gsGames .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdMins True else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD minutes played
|
||||||
|
editGoalieYtdMinsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdMinsPrompt batchMode =
|
||||||
|
editNum "Year-to-date minutes played: " mode
|
||||||
|
(gYtd.gsMinsPlayed .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdGoals True else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD goales allowed
|
||||||
|
editGoalieYtdGoalsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdGoalsPrompt batchMode =
|
||||||
|
editNum "Year-to-date goals allowed: " mode
|
||||||
|
(gYtd.gsGoalsAllowed .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdShutouts True else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD shutouts
|
||||||
|
editGoalieYtdShutoutsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdShutoutsPrompt batchMode =
|
||||||
|
editNum "Year-to-date shutouts: " mode
|
||||||
|
(gYtd.gsShutouts .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdWins True else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD wins
|
||||||
|
editGoalieYtdWinsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdWinsPrompt batchMode =
|
||||||
|
editNum "Year-to-date wins: " mode
|
||||||
|
(gYtd.gsWins .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdLosses True else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD losses
|
||||||
|
editGoalieYtdLossesPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieYtdLossesPrompt batchMode =
|
||||||
|
editNum "Year-to-date losses: " mode
|
||||||
|
(gYtd.gsLosses .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGYtdTies else EGYtd
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD ties
|
||||||
|
editGoalieYtdTiesPrompt :: Prompt
|
||||||
|
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
||||||
|
(gYtd.gsTies .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime games played
|
||||||
|
editGoalieLtGamesPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtGamesPrompt batchMode =
|
||||||
|
editNum "Lifetime games played: " mode
|
||||||
|
(gLifetime.gsGames .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtMins True else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime minutes played
|
||||||
|
editGoalieLtMinsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtMinsPrompt batchMode =
|
||||||
|
editNum "Lifetime minutes played: " mode
|
||||||
|
(gLifetime.gsMinsPlayed .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtGoals True else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||||
|
editGoalieLtGoalsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtGoalsPrompt batchMode =
|
||||||
|
editNum "Lifetime goals allowed: " mode
|
||||||
|
(gLifetime.gsGoalsAllowed .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtShutouts True else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime shutouts
|
||||||
|
editGoalieLtShutoutsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtShutoutsPrompt batchMode =
|
||||||
|
editNum "Lifetime shutouts: " mode
|
||||||
|
(gLifetime.gsShutouts .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtWins True else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime wins
|
||||||
|
editGoalieLtWinsPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtWinsPrompt batchMode =
|
||||||
|
editNum "Lifetime wins: " mode
|
||||||
|
(gLifetime.gsWins .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtLosses True else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime losses
|
||||||
|
editGoalieLtLossesPrompt
|
||||||
|
:: Bool
|
||||||
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editGoalieLtLossesPrompt batchMode =
|
||||||
|
editNum "Lifetime losses: " mode
|
||||||
|
(gLifetime.gsLosses .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EGLtTies else EGLifetime
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime ties
|
||||||
|
editGoalieLtTiesPrompt :: Prompt
|
||||||
|
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
||||||
|
(gLifetime.gsTies .~)
|
||||||
|
|
||||||
|
editNum
|
||||||
|
:: String
|
||||||
|
-> EditGoalieMode
|
||||||
|
-> (Int -> Goalie -> Goalie)
|
||||||
|
-> Prompt
|
||||||
|
editNum pStr mode f = numPromptWithFallback pStr
|
||||||
|
(goto mode)
|
||||||
|
(doEdit mode . f)
|
||||||
|
|
||||||
|
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
||||||
|
doEdit mode f = do
|
||||||
|
modify $ editSelectedGoalie f
|
||||||
|
goto mode
|
||||||
|
|
||||||
|
goto :: EditGoalieMode -> Action ()
|
||||||
|
goto = modify . (progMode.editGoalieStateL.egsMode .~)
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -31,62 +31,95 @@ module Mtlstats.Prompt.EditPlayer
|
|||||||
, editPlayerLtPMinPrompt
|
, editPlayerLtPMinPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Extra (whenJustM)
|
import Control.Monad.Trans.State (modify)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Lens.Micro ((.~))
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Prompt to edit a player's number
|
-- | Prompt to edit a player's number
|
||||||
editPlayerNumPrompt :: Prompt
|
editPlayerNumPrompt :: Prompt
|
||||||
editPlayerNumPrompt = numPrompt "Player number: " $
|
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
||||||
editPlayer . (pNumber .~)
|
(pNumber .~)
|
||||||
|
|
||||||
-- | Prompt to edit a player's name
|
-- | Prompt to edit a player's name
|
||||||
editPlayerNamePrompt :: Prompt
|
editPlayerNamePrompt :: Prompt
|
||||||
editPlayerNamePrompt = strPrompt "Player name: " $
|
editPlayerNamePrompt = namePrompt "Player name: " $ \name ->
|
||||||
editPlayer . (pName .~)
|
if null name
|
||||||
|
then goto EPMenu
|
||||||
|
else doEdit EPMenu $ pName .~ name
|
||||||
|
|
||||||
-- | Prompt to edit a player's position
|
-- | Prompt to edit a player's position
|
||||||
editPlayerPosPrompt :: Prompt
|
editPlayerPosPrompt :: Prompt
|
||||||
editPlayerPosPrompt = strPrompt "Player position: " $
|
editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos ->
|
||||||
editPlayer . (pPosition .~)
|
if null pos
|
||||||
|
then goto EPMenu
|
||||||
|
else doEdit EPMenu $ pPosition .~ pos
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date goals
|
-- | Prompt to edit a player's year-to-date goals
|
||||||
editPlayerYtdGoalsPrompt :: Prompt
|
editPlayerYtdGoalsPrompt
|
||||||
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
|
:: Bool
|
||||||
editPlayer . (pYtd.psGoals .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editPlayerYtdGoalsPrompt batchMode = editNum "Year-to-date goals: " mode
|
||||||
|
(pYtd.psGoals .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EPYtdAssists True else EPYtd
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date assists
|
-- | Prompt to edit a player's year-to-date assists
|
||||||
editPlayerYtdAssistsPrompt :: Prompt
|
editPlayerYtdAssistsPrompt
|
||||||
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
|
:: Bool
|
||||||
editPlayer . (pYtd.psAssists .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editPlayerYtdAssistsPrompt batchMode = editNum "Year-to-date assists: " mode
|
||||||
|
(pYtd.psAssists .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EPYtdPMin else EPYtd
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date penalty minutes
|
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||||
editPlayerYtdPMinPrompt :: Prompt
|
editPlayerYtdPMinPrompt :: Prompt
|
||||||
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
|
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
||||||
editPlayer . (pYtd.psPMin .~)
|
(pYtd.psPMin .~)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime goals
|
-- | Prompt to edit a player's lifetime goals
|
||||||
editPlayerLtGoalsPrompt :: Prompt
|
editPlayerLtGoalsPrompt
|
||||||
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
|
:: Bool
|
||||||
editPlayer . (pLifetime.psGoals .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editPlayerLtGoalsPrompt batchMode = editNum "Lifetime goals: " mode
|
||||||
|
(pLifetime.psGoals .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EPLtAssists True else EPLifetime
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime assists
|
-- | Prompt to edit a player's lifetime assists
|
||||||
editPlayerLtAssistsPrompt :: Prompt
|
editPlayerLtAssistsPrompt
|
||||||
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
|
:: Bool
|
||||||
editPlayer . (pLifetime.psAssists .~)
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Prompt
|
||||||
|
editPlayerLtAssistsPrompt batchMode = editNum "Lifetime assists: " mode
|
||||||
|
(pLifetime.psAssists .~)
|
||||||
|
where
|
||||||
|
mode = if batchMode then EPLtPMin else EPLifetime
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime penalty minutes
|
-- | Prompt to edit a player's lifetime penalty minutes
|
||||||
editPlayerLtPMinPrompt :: Prompt
|
editPlayerLtPMinPrompt :: Prompt
|
||||||
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
|
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
||||||
editPlayer . (pLifetime.psPMin .~)
|
(pLifetime.psPMin .~)
|
||||||
|
|
||||||
editPlayer :: (Player -> Player) -> Action ()
|
editNum
|
||||||
editPlayer f =
|
:: String
|
||||||
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
|
-> EditPlayerMode
|
||||||
modify
|
-> (Int -> Player -> Player)
|
||||||
$ (database.dbPlayers %~ modifyNth pid f)
|
-> Prompt
|
||||||
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
|
editNum pStr mode f = numPromptWithFallback pStr
|
||||||
|
(goto mode)
|
||||||
|
(doEdit mode . f)
|
||||||
|
|
||||||
|
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
||||||
|
doEdit mode f = do
|
||||||
|
modify $ editSelectedPlayer f
|
||||||
|
goto mode
|
||||||
|
|
||||||
|
goto :: EditPlayerMode -> Action ()
|
||||||
|
goto = modify . (progMode.editPlayerStateL.epsMode .~)
|
||||||
|
|||||||
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 = selectPlayerPrompt
|
||||||
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
|
++ "Who scored goal number " ++ show goal ++ "? "
|
||||||
|
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||||
|
|
||||||
|
-- | Prompts for a player who assisted the goal
|
||||||
|
recordAssistPrompt
|
||||||
|
:: Int
|
||||||
|
-- ^ The game number
|
||||||
|
-> Int
|
||||||
|
-- ^ The goal nuber
|
||||||
|
-> Int
|
||||||
|
-- ^ The assist number
|
||||||
|
-> Prompt
|
||||||
|
recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||||
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
|
++ "Goal: " ++ show goal ++ "\n"
|
||||||
|
++ "Assist #" ++ show assist ++ ": "
|
||||||
|
) $ \case
|
||||||
|
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||||
|
Just n -> do
|
||||||
|
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
||||||
|
nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
|
||||||
|
when (nAssists >= maxAssists) $
|
||||||
|
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||||
|
|
||||||
|
-- | Prompts for the player to assign penalty minutes to
|
||||||
|
pMinPlayerPrompt :: Prompt
|
||||||
|
pMinPlayerPrompt = selectPlayerPrompt
|
||||||
|
"Assign penalty minutes to: " $
|
||||||
|
\case
|
||||||
|
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||||
|
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
||||||
|
|
||||||
|
-- | Prompts for the number of penalty mintues to assign to the player
|
||||||
|
assignPMinsPrompt :: Prompt
|
||||||
|
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||||
|
modify . assignPMins
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,19 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Prompt.GoalieInput
|
module Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
( selectGameGoaliePrompt
|
( selectGameGoaliePrompt
|
||||||
, goalieMinsPlayedPrompt
|
, goalieMinsPlayedPrompt
|
||||||
, goalsAllowedPrompt
|
, goalsAllowedPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad.Trans.State (modify)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Lens.Micro ((?~))
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
|
||||||
|
|
||||||
import Mtlstats.Actions.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
import Mtlstats.Config
|
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,14 +19,18 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Report (report, gameDate, playerNameColWidth) where
|
module Mtlstats.Report (report, gameDate) where
|
||||||
|
|
||||||
|
import Data.List (sortOn)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
|
import Data.Ord (Down (Down))
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Helpers.Goalie
|
||||||
|
import Mtlstats.Helpers.Player
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -43,6 +47,8 @@ report width s
|
|||||||
++ gameStatsReport width s
|
++ gameStatsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ yearToDateStatsReport width s
|
++ yearToDateStatsReport width s
|
||||||
|
++ [""]
|
||||||
|
++ lifetimeStatsReport width s
|
||||||
|
|
||||||
standingsReport :: Int -> ProgState -> [String]
|
standingsReport :: Int -> ProgState -> [String]
|
||||||
standingsReport width s = fromMaybe [] $ do
|
standingsReport width s = fromMaybe [] $ do
|
||||||
@@ -58,107 +64,269 @@ standingsReport width s = fromMaybe [] $ do
|
|||||||
tStats = addGameStats hStats aStats
|
tStats = addGameStats hStats aStats
|
||||||
hScore <- gs^.homeScore
|
hScore <- gs^.homeScore
|
||||||
aScore <- gs^.awayScore
|
aScore <- gs^.awayScore
|
||||||
Just
|
let
|
||||||
[ overlay
|
rHeader =
|
||||||
("GAME NUMBER " ++ padNum 2 gNum)
|
[ overlay
|
||||||
(centre width
|
("GAME NUMBER " ++ padNum 2 gNum)
|
||||||
$ aTeam ++ " " ++ show aScore ++ " AT "
|
(centre width
|
||||||
++ hTeam ++ " " ++ show hScore)
|
$ aTeam ++ " " ++ show aScore ++ " AT "
|
||||||
, date
|
++ hTeam ++ " " ++ show hScore)
|
||||||
, centre width "STANDINGS"
|
, date
|
||||||
, ""
|
, centre width "STANDINGS"
|
||||||
, centre width
|
, ""
|
||||||
$ left 11 myTeam
|
]
|
||||||
++ right 2 "G"
|
|
||||||
++ right 4 "W"
|
tHeader =
|
||||||
++ right 4 "L"
|
[ CellText myTeam
|
||||||
++ right 4 "OT"
|
, CellText " G"
|
||||||
++ right 4 "GF"
|
, CellText " W"
|
||||||
++ right 4 "GA"
|
, CellText " L"
|
||||||
++ right 4 "P"
|
, CellText " OT"
|
||||||
, centre width
|
, CellText " GF"
|
||||||
$ left 11 "HOME"
|
, CellText " GA"
|
||||||
++ showStats hStats
|
, CellText " P"
|
||||||
, centre width
|
]
|
||||||
$ left 11 "ROAD"
|
|
||||||
++ showStats aStats
|
rowCells stats =
|
||||||
, centre width
|
[ CellText $ show $ gmsGames stats
|
||||||
$ replicate 11 ' '
|
, CellText $ show $ stats^.gmsWins
|
||||||
++ replicate (2 + 4 * 6) '-'
|
, CellText $ show $ stats^.gmsLosses
|
||||||
, centre width
|
, CellText $ show $ stats^.gmsOvertime
|
||||||
$ left 11 "TOTALS"
|
, CellText $ show $ stats^.gmsGoalsFor
|
||||||
++ showStats tStats
|
, CellText $ show $ stats^.gmsGoalsAgainst
|
||||||
]
|
, CellText $ show $ gmsPoints stats
|
||||||
|
]
|
||||||
|
|
||||||
|
body =
|
||||||
|
[ CellText "HOME" : rowCells hStats
|
||||||
|
, CellText "ROAD" : rowCells aStats
|
||||||
|
]
|
||||||
|
|
||||||
|
separator = CellText "" : replicate 7 (CellFill '-')
|
||||||
|
totals = CellText "TOTALS" : rowCells tStats
|
||||||
|
|
||||||
|
table = map (centre width) $
|
||||||
|
complexTable
|
||||||
|
(left : repeat right)
|
||||||
|
(tHeader : body ++ [separator, totals])
|
||||||
|
|
||||||
|
Just $ rHeader ++ table
|
||||||
|
|
||||||
gameStatsReport :: Int -> ProgState -> [String]
|
gameStatsReport :: Int -> ProgState -> [String]
|
||||||
gameStatsReport width s = playerReport width "GAME" $
|
gameStatsReport width s = let
|
||||||
fromMaybe [] $ mapM
|
gs = s^.progMode.gameStateL
|
||||||
|
db = s^.database
|
||||||
|
|
||||||
|
playerStats = mapMaybe
|
||||||
(\(pid, stats) -> do
|
(\(pid, stats) -> do
|
||||||
p <- nth pid $ s^.database.dbPlayers
|
p <- nth pid $ db^.dbPlayers
|
||||||
Just (p, stats))
|
Just (p, stats))
|
||||||
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
|
(M.toList $ gs^.gamePlayerStats)
|
||||||
|
|
||||||
|
goalieStats = mapMaybe
|
||||||
|
(\(gid, stats) -> do
|
||||||
|
g <- nth gid $ db^.dbGoalies
|
||||||
|
Just (g, stats))
|
||||||
|
(M.toList $ gs^.gameGoalieStats)
|
||||||
|
|
||||||
|
criteria (_, ps) = psPoints ps > 0
|
||||||
|
|
||||||
|
in filteredPlayerReport width "GAME" criteria True False playerStats
|
||||||
|
++ [""]
|
||||||
|
++ gameGoalieReport width goalieStats
|
||||||
|
|
||||||
yearToDateStatsReport :: Int -> ProgState -> [String]
|
yearToDateStatsReport :: Int -> ProgState -> [String]
|
||||||
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
|
yearToDateStatsReport width s = let
|
||||||
map (\p -> (p, p^.pYtd)) $
|
db = s^.database
|
||||||
filter playerIsActive $ s^.database.dbPlayers
|
|
||||||
|
playerStats = sortOn (Down . psPoints . snd)
|
||||||
|
$ map (\p -> (p, p^.pYtd))
|
||||||
|
$ filter playerIsActive
|
||||||
|
$ db^.dbPlayers
|
||||||
|
|
||||||
|
goalieStats = map (\g -> (g, g^.gYtd))
|
||||||
|
$ filter goalieIsActive
|
||||||
|
$ db^.dbGoalies
|
||||||
|
|
||||||
|
in playerReport width "YEAR TO DATE" True False playerStats
|
||||||
|
++ [""]
|
||||||
|
++ goalieReport width True False goalieStats
|
||||||
|
|
||||||
|
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||||
|
lifetimeStatsReport width s = let
|
||||||
|
db = s^.database
|
||||||
|
|
||||||
|
playerStats = sortOn (Down . psPoints . snd)
|
||||||
|
$ map (\p -> (p, p^.pLifetime))
|
||||||
|
$ db^.dbPlayers
|
||||||
|
|
||||||
|
goalieStats = map (\g -> (g, g^.gLifetime))
|
||||||
|
$ db^.dbGoalies
|
||||||
|
|
||||||
|
in playerReport width "LIFETIME" False True playerStats
|
||||||
|
++ [""]
|
||||||
|
++ goalieReport width False True goalieStats
|
||||||
|
|
||||||
gameDate :: GameState -> String
|
gameDate :: GameState -> String
|
||||||
gameDate gs = fromMaybe "" $ do
|
gameDate gs = fromMaybe "" $ do
|
||||||
year <- show <$> gs^.gameYear
|
y <- show <$> gs^.gameYear
|
||||||
month <- month <$> gs^.gameMonth
|
m <- month <$> gs^.gameMonth
|
||||||
day <- padNum 2 <$> gs^.gameDay
|
d <- padNum 2 <$> gs^.gameDay
|
||||||
Just $ month ++ " " ++ day ++ " " ++ year
|
Just $ m ++ " " ++ d ++ " " ++ y
|
||||||
|
|
||||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
playerReport
|
||||||
playerReport width label ps = let
|
:: Int
|
||||||
nameWidth = playerNameColWidth $ map fst ps
|
-> String
|
||||||
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
|
-> Bool
|
||||||
in
|
-> Bool
|
||||||
|
-> [(Player, PlayerStats)]
|
||||||
|
-> [String]
|
||||||
|
playerReport width label =
|
||||||
|
filteredPlayerReport width label (const True)
|
||||||
|
|
||||||
|
filteredPlayerReport
|
||||||
|
:: Int
|
||||||
|
-> String
|
||||||
|
-> ((Player, PlayerStats) -> Bool)
|
||||||
|
-> Bool
|
||||||
|
-> Bool
|
||||||
|
-> [(Player, PlayerStats)]
|
||||||
|
-> [String]
|
||||||
|
filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
||||||
|
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||||
|
criteria' = (&&) <$> criteria <*> \(p, _) -> p^.pNumber /= 0
|
||||||
|
fps = filter criteria' ps
|
||||||
|
|
||||||
|
rHeader =
|
||||||
[ centre width (label ++ " STATISTICS")
|
[ centre width (label ++ " STATISTICS")
|
||||||
, ""
|
, ""
|
||||||
, centre width
|
|
||||||
$ "NO. "
|
|
||||||
++ left nameWidth "PLAYER"
|
|
||||||
++ right 3 "G"
|
|
||||||
++ right 6 "A"
|
|
||||||
++ right 6 "P"
|
|
||||||
++ right 6 "PM"
|
|
||||||
] ++ map
|
|
||||||
(\(p, stats) -> centre width
|
|
||||||
$ right 2 (show $ p^.pNumber)
|
|
||||||
++ " "
|
|
||||||
++ left nameWidth (p^.pName)
|
|
||||||
++ right 3 (show $ stats^.psGoals)
|
|
||||||
++ right 6 (show $ stats^.psAssists)
|
|
||||||
++ right 6 (show $ psPoints stats)
|
|
||||||
++ right 6 (show $ stats^.psPMin))
|
|
||||||
ps ++
|
|
||||||
[ centre width
|
|
||||||
$ replicate (4 + nameWidth) ' '
|
|
||||||
++ replicate (3 + 3 * 6) '-'
|
|
||||||
, overlay
|
|
||||||
(label ++ " TOTALS")
|
|
||||||
( centre width
|
|
||||||
$ replicate (4 + nameWidth) ' '
|
|
||||||
++ right 3 (show $ tStats^.psGoals)
|
|
||||||
++ right 6 (show $ tStats^.psAssists)
|
|
||||||
++ right 6 (show $ psPoints tStats)
|
|
||||||
++ right 6 (show $ tStats^.psPMin)
|
|
||||||
)
|
|
||||||
]
|
]
|
||||||
|
|
||||||
playerNameColWidth :: [Player] -> Int
|
tHeader =
|
||||||
playerNameColWidth = foldr
|
[ CellText "NO."
|
||||||
(\player current -> max current $ succ $ length $ player^.pName)
|
, CellText "Player"
|
||||||
10
|
, CellText " G"
|
||||||
|
, CellText " A"
|
||||||
|
, CellText " P"
|
||||||
|
, CellText " PM"
|
||||||
|
]
|
||||||
|
|
||||||
showStats :: GameStats -> String
|
statsCells stats =
|
||||||
showStats gs
|
[ CellText $ show $ stats^.psGoals
|
||||||
= right 2 (show $ gmsGames gs)
|
, CellText $ show $ stats^.psAssists
|
||||||
++ right 4 (show $ gs^.gmsWins)
|
, CellText $ show $ psPoints stats
|
||||||
++ right 4 (show $ gs^.gmsLosses)
|
, CellText $ show $ stats^.psPMin
|
||||||
++ right 4 (show $ gs^.gmsOvertime)
|
]
|
||||||
++ right 4 (show $ gs^.gmsGoalsFor)
|
|
||||||
++ right 4 (show $ gs^.gmsGoalsAgainst)
|
body = map
|
||||||
++ right 4 (show $ gmsPoints gs)
|
(\(p, stats) ->
|
||||||
|
[ CellText $ show (p^.pNumber) ++ " "
|
||||||
|
, CellText $ playerName p
|
||||||
|
] ++ statsCells stats)
|
||||||
|
fps
|
||||||
|
|
||||||
|
separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
|
||||||
|
|
||||||
|
totals =
|
||||||
|
[ CellText ""
|
||||||
|
, CellText ""
|
||||||
|
] ++ statsCells tStats
|
||||||
|
|
||||||
|
olayText = if showTotals
|
||||||
|
then label ++ " TOTALS"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
lnOverlay = if lineNumbers
|
||||||
|
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||||
|
else repeat ""
|
||||||
|
|
||||||
|
table = overlayLast olayText
|
||||||
|
$ map (\(ln, line) -> overlay ln $ centre width line)
|
||||||
|
$ zip lnOverlay
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ tHeader : body ++ if showTotals
|
||||||
|
then [separator, totals]
|
||||||
|
else []
|
||||||
|
|
||||||
|
in rHeader ++ table
|
||||||
|
|
||||||
|
goalieReport
|
||||||
|
:: Int
|
||||||
|
-> Bool
|
||||||
|
-> Bool
|
||||||
|
-> [(Goalie, GoalieStats)]
|
||||||
|
-> [String]
|
||||||
|
goalieReport width showTotals lineNumbers goalieData = let
|
||||||
|
olayText = if showTotals
|
||||||
|
then "GOALTENDING TOTALS"
|
||||||
|
else ""
|
||||||
|
|
||||||
|
tData = foldl addGoalieStats newGoalieStats
|
||||||
|
$ map snd goalieData
|
||||||
|
|
||||||
|
header =
|
||||||
|
[ CellText "NO."
|
||||||
|
, CellText $ padRight (length olayText) "GOALTENDER"
|
||||||
|
, CellText "GP"
|
||||||
|
, CellText " MIN"
|
||||||
|
, CellText " GA"
|
||||||
|
, CellText " SO"
|
||||||
|
, CellText "AVE"
|
||||||
|
]
|
||||||
|
|
||||||
|
rowCells stats =
|
||||||
|
[ CellText $ show $ stats^.gsGames
|
||||||
|
, CellText $ show $ stats^.gsMinsPlayed
|
||||||
|
, CellText $ show $ stats^.gsGoalsAllowed
|
||||||
|
, CellText $ show $ stats^.gsShutouts
|
||||||
|
, CellText $ showFloating $ gsAverage stats
|
||||||
|
]
|
||||||
|
|
||||||
|
body = map
|
||||||
|
(\(goalie, stats) ->
|
||||||
|
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||||
|
, CellText $ goalieName goalie
|
||||||
|
] ++ rowCells stats)
|
||||||
|
goalieData
|
||||||
|
|
||||||
|
separator
|
||||||
|
= replicate 2 (CellText "")
|
||||||
|
++ replicate 5 (CellFill '-')
|
||||||
|
|
||||||
|
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||||
|
|
||||||
|
lnOverlay = if lineNumbers
|
||||||
|
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||||
|
else repeat ""
|
||||||
|
|
||||||
|
in map (\(ln, line) -> overlay ln $ centre width line)
|
||||||
|
$ zip lnOverlay
|
||||||
|
$ overlayLast olayText
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ header : body ++ if showTotals
|
||||||
|
then [separator, summary]
|
||||||
|
else []
|
||||||
|
|
||||||
|
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||||
|
gameGoalieReport width goalieData = let
|
||||||
|
header =
|
||||||
|
[ CellText "NO."
|
||||||
|
, CellText "GOALTENDER"
|
||||||
|
, CellText " MIN"
|
||||||
|
, CellText " GA"
|
||||||
|
, CellText " AVE"
|
||||||
|
]
|
||||||
|
|
||||||
|
body = map
|
||||||
|
(\(goalie, stats) ->
|
||||||
|
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||||
|
, CellText $ goalieName goalie
|
||||||
|
, CellText $ show $ stats^.gsMinsPlayed
|
||||||
|
, CellText $ show $ stats^.gsGoalsAllowed
|
||||||
|
, CellText $ showFloating $ gsAverage stats
|
||||||
|
])
|
||||||
|
goalieData
|
||||||
|
|
||||||
|
in map (centre width)
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ header : body
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -33,6 +33,10 @@ module Mtlstats.Types (
|
|||||||
CreateGoalieState (..),
|
CreateGoalieState (..),
|
||||||
EditPlayerState (..),
|
EditPlayerState (..),
|
||||||
EditPlayerMode (..),
|
EditPlayerMode (..),
|
||||||
|
EditGoalieState (..),
|
||||||
|
EditGoalieMode (..),
|
||||||
|
EditStandingsMode (..),
|
||||||
|
ESMSubMode (..),
|
||||||
Database (..),
|
Database (..),
|
||||||
Player (..),
|
Player (..),
|
||||||
PlayerStats (..),
|
PlayerStats (..),
|
||||||
@@ -41,6 +45,7 @@ module Mtlstats.Types (
|
|||||||
GameStats (..),
|
GameStats (..),
|
||||||
Prompt (..),
|
Prompt (..),
|
||||||
SelectParams (..),
|
SelectParams (..),
|
||||||
|
TableCell (..),
|
||||||
-- * Lenses
|
-- * Lenses
|
||||||
-- ** ProgState Lenses
|
-- ** ProgState Lenses
|
||||||
database,
|
database,
|
||||||
@@ -52,6 +57,10 @@ module Mtlstats.Types (
|
|||||||
createPlayerStateL,
|
createPlayerStateL,
|
||||||
createGoalieStateL,
|
createGoalieStateL,
|
||||||
editPlayerStateL,
|
editPlayerStateL,
|
||||||
|
editGoalieStateL,
|
||||||
|
editStandingsModeL,
|
||||||
|
-- ** EditStandingsMode Lenses
|
||||||
|
esmSubModeL,
|
||||||
-- ** GameState Lenses
|
-- ** GameState Lenses
|
||||||
gameYear,
|
gameYear,
|
||||||
gameMonth,
|
gameMonth,
|
||||||
@@ -89,6 +98,9 @@ module Mtlstats.Types (
|
|||||||
-- ** EditPlayerState Lenses
|
-- ** EditPlayerState Lenses
|
||||||
epsSelectedPlayer,
|
epsSelectedPlayer,
|
||||||
epsMode,
|
epsMode,
|
||||||
|
-- ** EditGoalieState Lenses
|
||||||
|
egsSelectedGoalie,
|
||||||
|
egsMode,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
@@ -99,6 +111,8 @@ module Mtlstats.Types (
|
|||||||
pNumber,
|
pNumber,
|
||||||
pName,
|
pName,
|
||||||
pPosition,
|
pPosition,
|
||||||
|
pRookie,
|
||||||
|
pActive,
|
||||||
pYtd,
|
pYtd,
|
||||||
pLifetime,
|
pLifetime,
|
||||||
-- ** PlayerStats Lenses
|
-- ** PlayerStats Lenses
|
||||||
@@ -108,12 +122,15 @@ module Mtlstats.Types (
|
|||||||
-- ** Goalie Lenses
|
-- ** Goalie Lenses
|
||||||
gNumber,
|
gNumber,
|
||||||
gName,
|
gName,
|
||||||
|
gRookie,
|
||||||
|
gActive,
|
||||||
gYtd,
|
gYtd,
|
||||||
gLifetime,
|
gLifetime,
|
||||||
-- ** GoalieStats Lenses
|
-- ** GoalieStats Lenses
|
||||||
gsGames,
|
gsGames,
|
||||||
gsMinsPlayed,
|
gsMinsPlayed,
|
||||||
gsGoalsAllowed,
|
gsGoalsAllowed,
|
||||||
|
gsShutouts,
|
||||||
gsWins,
|
gsWins,
|
||||||
gsLosses,
|
gsLosses,
|
||||||
gsTies,
|
gsTies,
|
||||||
@@ -129,6 +146,7 @@ module Mtlstats.Types (
|
|||||||
newCreatePlayerState,
|
newCreatePlayerState,
|
||||||
newCreateGoalieState,
|
newCreateGoalieState,
|
||||||
newEditPlayerState,
|
newEditPlayerState,
|
||||||
|
newEditGoalieState,
|
||||||
newDatabase,
|
newDatabase,
|
||||||
newPlayer,
|
newPlayer,
|
||||||
newPlayerStats,
|
newPlayerStats,
|
||||||
@@ -154,7 +172,6 @@ module Mtlstats.Types (
|
|||||||
playerSearchExact,
|
playerSearchExact,
|
||||||
modifyPlayer,
|
modifyPlayer,
|
||||||
playerSummary,
|
playerSummary,
|
||||||
playerDetails,
|
|
||||||
playerIsActive,
|
playerIsActive,
|
||||||
-- ** PlayerStats Helpers
|
-- ** PlayerStats Helpers
|
||||||
psPoints,
|
psPoints,
|
||||||
@@ -162,7 +179,11 @@ module Mtlstats.Types (
|
|||||||
-- ** Goalie Helpers
|
-- ** Goalie Helpers
|
||||||
goalieSearch,
|
goalieSearch,
|
||||||
goalieSearchExact,
|
goalieSearchExact,
|
||||||
goalieSummary
|
goalieSummary,
|
||||||
|
goalieIsActive,
|
||||||
|
-- ** GoalieStats Helpers
|
||||||
|
addGoalieStats,
|
||||||
|
gsAverage
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (StateT)
|
import Control.Monad.Trans.State (StateT)
|
||||||
@@ -176,8 +197,11 @@ import Data.Aeson
|
|||||||
, toJSON
|
, toJSON
|
||||||
, withObject
|
, withObject
|
||||||
, (.:)
|
, (.:)
|
||||||
|
, (.:?)
|
||||||
|
, (.!=)
|
||||||
, (.=)
|
, (.=)
|
||||||
)
|
)
|
||||||
|
import Data.Char (toUpper)
|
||||||
import Data.List (isInfixOf)
|
import Data.List (isInfixOf)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (listToMaybe)
|
import Data.Maybe (listToMaybe)
|
||||||
@@ -212,20 +236,28 @@ data ProgState = ProgState
|
|||||||
|
|
||||||
-- | The program mode
|
-- | The program mode
|
||||||
data ProgMode
|
data ProgMode
|
||||||
= MainMenu
|
= TitleScreen
|
||||||
| NewSeason
|
| MainMenu
|
||||||
|
| NewSeason Bool
|
||||||
| NewGame GameState
|
| NewGame GameState
|
||||||
|
| EditMenu
|
||||||
| CreatePlayer CreatePlayerState
|
| CreatePlayer CreatePlayerState
|
||||||
| CreateGoalie CreateGoalieState
|
| CreateGoalie CreateGoalieState
|
||||||
| EditPlayer EditPlayerState
|
| EditPlayer EditPlayerState
|
||||||
|
| EditGoalie EditGoalieState
|
||||||
|
| EditStandings EditStandingsMode
|
||||||
|
|
||||||
instance Show ProgMode where
|
instance Show ProgMode where
|
||||||
show MainMenu = "MainMenu"
|
show TitleScreen = "TitleScreen"
|
||||||
show NewSeason = "NewSeason"
|
show MainMenu = "MainMenu"
|
||||||
show (NewGame _) = "NewGame"
|
show (NewSeason _) = "NewSeason"
|
||||||
show (CreatePlayer _) = "CreatePlayer"
|
show (NewGame _) = "NewGame"
|
||||||
show (CreateGoalie _) = "CreateGoalie"
|
show EditMenu = "EditMenu"
|
||||||
show (EditPlayer _) = "EditPlayer"
|
show (CreatePlayer _) = "CreatePlayer"
|
||||||
|
show (CreateGoalie _) = "CreateGoalie"
|
||||||
|
show (EditPlayer _) = "EditPlayer"
|
||||||
|
show (EditGoalie _) = "EditGoalie"
|
||||||
|
show (EditStandings _) = "EditStandings"
|
||||||
|
|
||||||
-- | The game state
|
-- | The game state
|
||||||
data GameState = GameState
|
data GameState = GameState
|
||||||
@@ -326,14 +358,63 @@ data EditPlayerMode
|
|||||||
| EPNumber
|
| EPNumber
|
||||||
| EPName
|
| EPName
|
||||||
| EPPosition
|
| EPPosition
|
||||||
| EPYtdGoals
|
| EPYtd
|
||||||
| EPYtdAssists
|
| EPLifetime
|
||||||
|
| EPYtdGoals Bool
|
||||||
|
| EPYtdAssists Bool
|
||||||
| EPYtdPMin
|
| EPYtdPMin
|
||||||
| EPLtGoals
|
| EPLtGoals Bool
|
||||||
| EPLtAssists
|
| EPLtAssists Bool
|
||||||
| EPLtPMin
|
| EPLtPMin
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | 'Goalie' edit status
|
||||||
|
data EditGoalieState = EditGoalieState
|
||||||
|
{ _egsSelectedGoalie :: Maybe Int
|
||||||
|
-- ^ The index number of the 'Goalie' being edited
|
||||||
|
, _egsMode :: EditGoalieMode
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | 'Goalie' editing mode
|
||||||
|
data EditGoalieMode
|
||||||
|
= EGMenu
|
||||||
|
| EGNumber
|
||||||
|
| EGName
|
||||||
|
| EGYtd
|
||||||
|
| EGLifetime
|
||||||
|
| EGYtdGames Bool
|
||||||
|
| EGYtdMins Bool
|
||||||
|
| EGYtdGoals Bool
|
||||||
|
| EGYtdShutouts Bool
|
||||||
|
| EGYtdWins Bool
|
||||||
|
| EGYtdLosses Bool
|
||||||
|
| EGYtdTies
|
||||||
|
| EGLtGames Bool
|
||||||
|
| EGLtMins Bool
|
||||||
|
| EGLtGoals Bool
|
||||||
|
| EGLtShutouts Bool
|
||||||
|
| EGLtWins Bool
|
||||||
|
| EGLtLosses Bool
|
||||||
|
| EGLtTies
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents the standings edit mode
|
||||||
|
data EditStandingsMode
|
||||||
|
= ESMMenu
|
||||||
|
| ESMHome ESMSubMode
|
||||||
|
| ESMAway ESMSubMode
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents the standings edit sub-mode
|
||||||
|
data ESMSubMode
|
||||||
|
= ESMSubMenu
|
||||||
|
| ESMEditWins
|
||||||
|
| ESMEditLosses
|
||||||
|
| ESMEditOvertime
|
||||||
|
| ESMEditGoalsFor
|
||||||
|
| ESMEditGoalsAgainst
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Represents the database
|
-- | Represents the database
|
||||||
data Database = Database
|
data Database = Database
|
||||||
{ _dbPlayers :: [Player]
|
{ _dbPlayers :: [Player]
|
||||||
@@ -348,13 +429,142 @@ data Database = Database
|
|||||||
-- ^ Statistics for away games
|
-- ^ Statistics for away games
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents a (non-goalie) player
|
||||||
|
data Player = Player
|
||||||
|
{ _pNumber :: Int
|
||||||
|
-- ^ The player's number
|
||||||
|
, _pName :: String
|
||||||
|
-- ^ The player's name
|
||||||
|
, _pPosition :: String
|
||||||
|
-- ^ The player's position
|
||||||
|
, _pRookie :: Bool
|
||||||
|
-- ^ Indicates that the player is a rookie
|
||||||
|
, _pActive :: Bool
|
||||||
|
-- ^ Indicates that the player is active
|
||||||
|
, _pYtd :: PlayerStats
|
||||||
|
-- ^ The Player's year-to-date stats
|
||||||
|
, _pLifetime :: PlayerStats
|
||||||
|
-- ^ The player's lifetime stats
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents a (non-goalie) player's stats
|
||||||
|
data PlayerStats = PlayerStats
|
||||||
|
{ _psGoals :: Int
|
||||||
|
-- ^ The number of goals
|
||||||
|
, _psAssists :: Int
|
||||||
|
-- ^ The number of assists
|
||||||
|
, _psPMin :: Int
|
||||||
|
-- ^ The number of penalty minutes
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents a goalie
|
||||||
|
data Goalie = Goalie
|
||||||
|
{ _gNumber :: Int
|
||||||
|
-- ^ The goalie's number
|
||||||
|
, _gName :: String
|
||||||
|
-- ^ The goalie's name
|
||||||
|
, _gRookie :: Bool
|
||||||
|
-- ^ Indicates that the goalie is a rookie
|
||||||
|
, _gActive :: Bool
|
||||||
|
-- ^ Indicates that the goalie is active
|
||||||
|
, _gYtd :: GoalieStats
|
||||||
|
-- ^ The goalie's year-to-date stats
|
||||||
|
, _gLifetime :: GoalieStats
|
||||||
|
-- ^ The goalie's lifetime stats
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Represents a goalie's stats
|
||||||
|
data GoalieStats = GoalieStats
|
||||||
|
{ _gsGames :: Int
|
||||||
|
-- ^ The number of games played
|
||||||
|
, _gsMinsPlayed :: Int
|
||||||
|
-- ^ The number of minutes played
|
||||||
|
, _gsGoalsAllowed :: Int
|
||||||
|
-- ^ The number of goals allowed
|
||||||
|
, _gsShutouts :: Int
|
||||||
|
-- ^ The number of shutouts the goalie has accumulated
|
||||||
|
, _gsWins :: Int
|
||||||
|
-- ^ The number of wins
|
||||||
|
, _gsLosses :: Int
|
||||||
|
-- ^ The number of losses
|
||||||
|
, _gsTies :: Int
|
||||||
|
-- ^ The number of ties
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Game statistics
|
||||||
|
data GameStats = GameStats
|
||||||
|
{ _gmsWins :: Int
|
||||||
|
-- ^ Games won
|
||||||
|
, _gmsLosses :: Int
|
||||||
|
-- ^ Games lost
|
||||||
|
, _gmsOvertime :: Int
|
||||||
|
-- ^ Games lost in overtime
|
||||||
|
, _gmsGoalsFor :: Int
|
||||||
|
-- ^ Goals for the team
|
||||||
|
, _gmsGoalsAgainst :: Int
|
||||||
|
-- ^ Goals against the team
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Defines a user prompt
|
||||||
|
data Prompt = Prompt
|
||||||
|
{ promptDrawer :: ProgState -> C.Update ()
|
||||||
|
-- ^ Draws the prompt to the screen
|
||||||
|
, promptProcessChar :: Char -> String -> String
|
||||||
|
-- ^ Modifies the string based on the character entered
|
||||||
|
, promptAction :: String -> Action ()
|
||||||
|
-- ^ Action to perform when the value is entered
|
||||||
|
, promptSpecialKey :: C.Key -> Action ()
|
||||||
|
-- ^ Action to perform when a special key is pressed
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Parameters for a search prompt
|
||||||
|
data SelectParams a = SelectParams
|
||||||
|
{ spPrompt :: String
|
||||||
|
-- ^ The search prompt
|
||||||
|
, spSearchHeader :: String
|
||||||
|
-- ^ The header to display at the top of the search list
|
||||||
|
, spSearch :: String -> Database -> [(Int, a)]
|
||||||
|
-- ^ The search function
|
||||||
|
, spSearchExact :: String -> Database -> Maybe Int
|
||||||
|
-- ^ Search function looking for an exact match
|
||||||
|
, spElemDesc :: a -> String
|
||||||
|
-- ^ Provides a string description of an element
|
||||||
|
, spProcessChar :: Char -> String -> String
|
||||||
|
-- ^ Processes a character entered by the user
|
||||||
|
, spCallback :: Maybe Int -> Action ()
|
||||||
|
-- ^ The function when the selection is made
|
||||||
|
, spNotFound :: String -> Action ()
|
||||||
|
-- ^ The function to call when the selection doesn't exist
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Describes a table cell
|
||||||
|
data TableCell
|
||||||
|
= CellText String
|
||||||
|
-- ^ A cell with text
|
||||||
|
| CellFill Char
|
||||||
|
-- ^ A cell filled with the given character
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
makeLenses ''ProgState
|
||||||
|
makeLenses ''GameState
|
||||||
|
makeLenses ''CreatePlayerState
|
||||||
|
makeLenses ''CreateGoalieState
|
||||||
|
makeLenses ''EditPlayerState
|
||||||
|
makeLenses ''EditGoalieState
|
||||||
|
makeLenses ''Database
|
||||||
|
makeLenses ''Player
|
||||||
|
makeLenses ''PlayerStats
|
||||||
|
makeLenses ''Goalie
|
||||||
|
makeLenses ''GoalieStats
|
||||||
|
makeLenses ''GameStats
|
||||||
|
|
||||||
instance FromJSON Database where
|
instance FromJSON Database where
|
||||||
parseJSON = withObject "Database" $ \v -> Database
|
parseJSON = withObject "Database" $ \v -> Database
|
||||||
<$> v .: "players"
|
<$> v .:? "players" .!= []
|
||||||
<*> v .: "goalies"
|
<*> v .:? "goalies" .!= []
|
||||||
<*> v .: "games"
|
<*> v .:? "games" .!= 0
|
||||||
<*> v .: "home_game_stats"
|
<*> v .:? "home_game_stats" .!= newGameStats
|
||||||
<*> v .: "away_game_stats"
|
<*> v .:? "away_game_stats" .!= newGameStats
|
||||||
|
|
||||||
instance ToJSON Database where
|
instance ToJSON Database where
|
||||||
toJSON (Database players goalies games hgs ags) = object
|
toJSON (Database players goalies games hgs ags) = object
|
||||||
@@ -371,58 +581,40 @@ instance ToJSON Database where
|
|||||||
"home_game_stats" .= hgs <>
|
"home_game_stats" .= hgs <>
|
||||||
"away_game_stats" .= ags
|
"away_game_stats" .= ags
|
||||||
|
|
||||||
-- | Represents a (non-goalie) player
|
|
||||||
data Player = Player
|
|
||||||
{ _pNumber :: Int
|
|
||||||
-- ^ The player's number
|
|
||||||
, _pName :: String
|
|
||||||
-- ^ The player's name
|
|
||||||
, _pPosition :: String
|
|
||||||
-- ^ The player's position
|
|
||||||
, _pYtd :: PlayerStats
|
|
||||||
-- ^ The Player's year-to-date stats
|
|
||||||
, _pLifetime :: PlayerStats
|
|
||||||
-- ^ The player's lifetime stats
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON Player where
|
instance FromJSON Player where
|
||||||
parseJSON = withObject "Player" $ \v -> Player
|
parseJSON = withObject "Player" $ \v -> Player
|
||||||
<$> v .: "number"
|
<$> v .: "number"
|
||||||
<*> v .: "name"
|
<*> v .: "name"
|
||||||
<*> v .: "position"
|
<*> v .: "position"
|
||||||
<*> v .: "ytd"
|
<*> v .:? "rookie" .!= False
|
||||||
<*> v .: "lifetime"
|
<*> v .:? "active" .!= True
|
||||||
|
<*> v .:? "ytd" .!= newPlayerStats
|
||||||
|
<*> v .:? "lifetime" .!= newPlayerStats
|
||||||
|
|
||||||
instance ToJSON Player where
|
instance ToJSON Player where
|
||||||
toJSON (Player num name pos ytd lt) = object
|
toJSON (Player num name pos rk act ytd lt) = object
|
||||||
[ "number" .= num
|
[ "number" .= num
|
||||||
, "name" .= name
|
, "name" .= name
|
||||||
, "position" .= pos
|
, "position" .= pos
|
||||||
|
, "rookie" .= rk
|
||||||
|
, "active" .= act
|
||||||
, "ytd" .= ytd
|
, "ytd" .= ytd
|
||||||
, "lifetime" .= lt
|
, "lifetime" .= lt
|
||||||
]
|
]
|
||||||
toEncoding (Player num name pos ytd lt) = pairs $
|
toEncoding (Player num name pos rk act ytd lt) = pairs $
|
||||||
"number" .= num <>
|
"number" .= num <>
|
||||||
"name" .= name <>
|
"name" .= name <>
|
||||||
"position" .= pos <>
|
"position" .= pos <>
|
||||||
|
"rookie" .= rk <>
|
||||||
|
"active" .= act <>
|
||||||
"ytd" .= ytd <>
|
"ytd" .= ytd <>
|
||||||
"lifetime" .= lt
|
"lifetime" .= lt
|
||||||
|
|
||||||
-- | Represents a (non-goalie) player's stats
|
|
||||||
data PlayerStats = PlayerStats
|
|
||||||
{ _psGoals :: Int
|
|
||||||
-- ^ The number of goals
|
|
||||||
, _psAssists :: Int
|
|
||||||
-- ^ The number of assists
|
|
||||||
, _psPMin :: Int
|
|
||||||
-- ^ The number of penalty minutes
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON PlayerStats where
|
instance FromJSON PlayerStats where
|
||||||
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
parseJSON = withObject "PlayerStats" $ \v -> PlayerStats
|
||||||
<$> v .: "goals"
|
<$> v .:? "goals" .!= 0
|
||||||
<*> v .: "assists"
|
<*> v .:? "assists" .!= 0
|
||||||
<*> v .: "penalty_mins"
|
<*> v .:? "penalty_mins" .!= 0
|
||||||
|
|
||||||
instance ToJSON PlayerStats where
|
instance ToJSON PlayerStats where
|
||||||
toJSON (PlayerStats g a pm) = object
|
toJSON (PlayerStats g a pm) = object
|
||||||
@@ -435,94 +627,61 @@ instance ToJSON PlayerStats where
|
|||||||
"assists" .= a <>
|
"assists" .= a <>
|
||||||
"penalty_mins" .= pm
|
"penalty_mins" .= pm
|
||||||
|
|
||||||
-- | Represents a goalie
|
|
||||||
data Goalie = Goalie
|
|
||||||
{ _gNumber :: Int
|
|
||||||
-- ^ The goalie's number
|
|
||||||
, _gName :: String
|
|
||||||
-- ^ The goalie's name
|
|
||||||
, _gYtd :: GoalieStats
|
|
||||||
-- ^ The goalie's year-to-date stats
|
|
||||||
, _gLifetime :: GoalieStats
|
|
||||||
-- ^ The goalie's lifetime stats
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON Goalie where
|
instance FromJSON Goalie where
|
||||||
parseJSON = withObject "Goalie" $ \v -> Goalie
|
parseJSON = withObject "Goalie" $ \v -> Goalie
|
||||||
<$> v .: "number"
|
<$> v .: "number"
|
||||||
<*> v .: "name"
|
<*> v .: "name"
|
||||||
<*> v .: "ytd"
|
<*> v .:? "rookie" .!= False
|
||||||
<*> v .: "lifetime"
|
<*> v .:? "active" .!= True
|
||||||
|
<*> v .:? "ytd" .!= newGoalieStats
|
||||||
|
<*> v .:? "lifetime" .!= newGoalieStats
|
||||||
|
|
||||||
instance ToJSON Goalie where
|
instance ToJSON Goalie where
|
||||||
toJSON (Goalie num name ytd lt) = object
|
toJSON (Goalie num name rk act ytd lt) = object
|
||||||
[ "number" .= num
|
[ "number" .= num
|
||||||
, "name" .= name
|
, "name" .= name
|
||||||
, "ytd" .= ytd
|
, "ytd" .= ytd
|
||||||
|
, "rookie" .= rk
|
||||||
|
, "active" .= act
|
||||||
, "lifetime" .= lt
|
, "lifetime" .= lt
|
||||||
]
|
]
|
||||||
toEncoding (Goalie num name ytd lt) = pairs $
|
toEncoding (Goalie num name rk act ytd lt) = pairs $
|
||||||
"number" .= num <>
|
"number" .= num <>
|
||||||
"name" .= name <>
|
"name" .= name <>
|
||||||
|
"rookie" .= rk <>
|
||||||
|
"active" .= act <>
|
||||||
"ytd" .= ytd <>
|
"ytd" .= ytd <>
|
||||||
"lifetime" .= lt
|
"lifetime" .= lt
|
||||||
|
|
||||||
-- | Represents a goalie's stats
|
|
||||||
data GoalieStats = GoalieStats
|
|
||||||
{ _gsGames :: Int
|
|
||||||
-- ^ The number of games played
|
|
||||||
, _gsMinsPlayed :: Int
|
|
||||||
-- ^ The number of minutes played
|
|
||||||
, _gsGoalsAllowed :: Int
|
|
||||||
-- ^ The number of goals allowed
|
|
||||||
, _gsWins :: Int
|
|
||||||
-- ^ The number of wins
|
|
||||||
, _gsLosses :: Int
|
|
||||||
-- ^ The number of losses
|
|
||||||
, _gsTies :: Int
|
|
||||||
-- ^ The number of ties
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON GoalieStats where
|
instance FromJSON GoalieStats where
|
||||||
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
||||||
<$> v .: "games"
|
<$> v .:? "games" .!= 0
|
||||||
<*> v .: "mins_played"
|
<*> v .:? "mins_played" .!= 0
|
||||||
<*> v .: "goals_allowed"
|
<*> v .:? "goals_allowed" .!= 0
|
||||||
<*> v .: "wins"
|
<*> v .:? "shutouts" .!= 0
|
||||||
<*> v .: "losses"
|
<*> v .:? "wins" .!= 0
|
||||||
<*> v .: "ties"
|
<*> v .:? "losses" .!= 0
|
||||||
|
<*> v .:? "ties" .!= 0
|
||||||
|
|
||||||
instance ToJSON GoalieStats where
|
instance ToJSON GoalieStats where
|
||||||
toJSON (GoalieStats g m a w l t) = object
|
toJSON (GoalieStats g m a s w l t) = object
|
||||||
[ "games" .= g
|
[ "games" .= g
|
||||||
, "mins_played" .= m
|
, "mins_played" .= m
|
||||||
, "goals_allowed" .= a
|
, "goals_allowed" .= a
|
||||||
|
, "shutouts" .= s
|
||||||
, "wins" .= w
|
, "wins" .= w
|
||||||
, "losses" .= l
|
, "losses" .= l
|
||||||
, "ties" .= t
|
, "ties" .= t
|
||||||
]
|
]
|
||||||
toEncoding (GoalieStats g m a w l t) = pairs $
|
toEncoding (GoalieStats g m a s w l t) = pairs $
|
||||||
"games" .= g <>
|
"games" .= g <>
|
||||||
"mins_played" .= m <>
|
"mins_played" .= m <>
|
||||||
"goals_allowed" .= a <>
|
"goals_allowed" .= a <>
|
||||||
|
"shutouts" .= s <>
|
||||||
"wins" .= w <>
|
"wins" .= w <>
|
||||||
"losses" .= l <>
|
"losses" .= l <>
|
||||||
"ties" .= t
|
"ties" .= t
|
||||||
|
|
||||||
-- | Game statistics
|
|
||||||
data GameStats = GameStats
|
|
||||||
{ _gmsWins :: Int
|
|
||||||
-- ^ Games won
|
|
||||||
, _gmsLosses :: Int
|
|
||||||
-- ^ Games lost
|
|
||||||
, _gmsOvertime :: Int
|
|
||||||
-- ^ Games lost in overtime
|
|
||||||
, _gmsGoalsFor :: Int
|
|
||||||
-- ^ Goals for the team
|
|
||||||
, _gmsGoalsAgainst :: Int
|
|
||||||
-- ^ Goals against the team
|
|
||||||
} deriving (Eq, Show)
|
|
||||||
|
|
||||||
instance FromJSON GameStats where
|
instance FromJSON GameStats where
|
||||||
parseJSON = withObject "GameStats" $ \v -> GameStats
|
parseJSON = withObject "GameStats" $ \v -> GameStats
|
||||||
<$> v .: "wins"
|
<$> v .: "wins"
|
||||||
@@ -546,48 +705,6 @@ instance ToJSON GameStats where
|
|||||||
"goals_for" .= gf <>
|
"goals_for" .= gf <>
|
||||||
"goals_against" .= ga
|
"goals_against" .= ga
|
||||||
|
|
||||||
-- | Defines a user prompt
|
|
||||||
data Prompt = Prompt
|
|
||||||
{ promptDrawer :: ProgState -> C.Update ()
|
|
||||||
-- ^ Draws the prompt to the screen
|
|
||||||
, promptCharCheck :: Char -> Bool
|
|
||||||
-- ^ Determines whether or not the character is valid
|
|
||||||
, promptAction :: String -> Action ()
|
|
||||||
-- ^ Action to perform when the value is entered
|
|
||||||
, promptSpecialKey :: C.Key -> Action ()
|
|
||||||
-- ^ Action to perform when a special key is pressed
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Parameters for a search prompt
|
|
||||||
data SelectParams a = SelectParams
|
|
||||||
{ spPrompt :: String
|
|
||||||
-- ^ The search prompt
|
|
||||||
, spSearchHeader :: String
|
|
||||||
-- ^ The header to display at the top of the search list
|
|
||||||
, spSearch :: String -> Database -> [(Int, a)]
|
|
||||||
-- ^ The search function
|
|
||||||
, spSearchExact :: String -> Database -> Maybe Int
|
|
||||||
-- ^ Search function looking for an exact match
|
|
||||||
, spElemDesc :: a -> String
|
|
||||||
-- ^ Provides a string description of an element
|
|
||||||
, spCallback :: Maybe Int -> Action ()
|
|
||||||
-- ^ The function when the selection is made
|
|
||||||
, spNotFound :: String -> Action ()
|
|
||||||
-- ^ The function to call when the selection doesn't exist
|
|
||||||
}
|
|
||||||
|
|
||||||
makeLenses ''ProgState
|
|
||||||
makeLenses ''GameState
|
|
||||||
makeLenses ''CreatePlayerState
|
|
||||||
makeLenses ''CreateGoalieState
|
|
||||||
makeLenses ''EditPlayerState
|
|
||||||
makeLenses ''Database
|
|
||||||
makeLenses ''Player
|
|
||||||
makeLenses ''PlayerStats
|
|
||||||
makeLenses ''Goalie
|
|
||||||
makeLenses ''GoalieStats
|
|
||||||
makeLenses ''GameStats
|
|
||||||
|
|
||||||
gameStateL :: Lens' ProgMode GameState
|
gameStateL :: Lens' ProgMode GameState
|
||||||
gameStateL = lens
|
gameStateL = lens
|
||||||
(\case
|
(\case
|
||||||
@@ -616,11 +733,36 @@ editPlayerStateL = lens
|
|||||||
_ -> newEditPlayerState)
|
_ -> newEditPlayerState)
|
||||||
(\_ eps -> EditPlayer eps)
|
(\_ eps -> EditPlayer eps)
|
||||||
|
|
||||||
|
editGoalieStateL :: Lens' ProgMode EditGoalieState
|
||||||
|
editGoalieStateL = lens
|
||||||
|
(\case
|
||||||
|
EditGoalie egs -> egs
|
||||||
|
_ -> newEditGoalieState)
|
||||||
|
(\_ egs -> EditGoalie egs)
|
||||||
|
|
||||||
|
editStandingsModeL :: Lens' ProgMode EditStandingsMode
|
||||||
|
editStandingsModeL = lens
|
||||||
|
(\case
|
||||||
|
EditStandings esm -> esm
|
||||||
|
_ -> ESMMenu)
|
||||||
|
(\_ esm -> EditStandings esm)
|
||||||
|
|
||||||
|
esmSubModeL :: Lens' EditStandingsMode ESMSubMode
|
||||||
|
esmSubModeL = lens
|
||||||
|
(\case
|
||||||
|
ESMMenu -> ESMSubMenu
|
||||||
|
ESMHome m -> m
|
||||||
|
ESMAway m -> m)
|
||||||
|
(\mode subMode -> case mode of
|
||||||
|
ESMMenu -> ESMMenu
|
||||||
|
ESMHome _ -> ESMHome subMode
|
||||||
|
ESMAway _ -> ESMAway subMode)
|
||||||
|
|
||||||
-- | Constructor for a 'ProgState'
|
-- | Constructor for a 'ProgState'
|
||||||
newProgState :: ProgState
|
newProgState :: ProgState
|
||||||
newProgState = ProgState
|
newProgState = ProgState
|
||||||
{ _database = newDatabase
|
{ _database = newDatabase
|
||||||
, _progMode = MainMenu
|
, _progMode = TitleScreen
|
||||||
, _inputBuffer = ""
|
, _inputBuffer = ""
|
||||||
, _scrollOffset = 0
|
, _scrollOffset = 0
|
||||||
}
|
}
|
||||||
@@ -678,6 +820,13 @@ newEditPlayerState = EditPlayerState
|
|||||||
, _epsMode = EPMenu
|
, _epsMode = EPMenu
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Constructor for an 'EditGoalieState' value
|
||||||
|
newEditGoalieState :: EditGoalieState
|
||||||
|
newEditGoalieState = EditGoalieState
|
||||||
|
{ _egsSelectedGoalie = Nothing
|
||||||
|
, _egsMode = EGMenu
|
||||||
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'Database'
|
-- | Constructor for a 'Database'
|
||||||
newDatabase :: Database
|
newDatabase :: Database
|
||||||
newDatabase = Database
|
newDatabase = Database
|
||||||
@@ -701,6 +850,8 @@ newPlayer num name pos = Player
|
|||||||
{ _pNumber = num
|
{ _pNumber = num
|
||||||
, _pName = name
|
, _pName = name
|
||||||
, _pPosition = pos
|
, _pPosition = pos
|
||||||
|
, _pRookie = True
|
||||||
|
, _pActive = True
|
||||||
, _pYtd = newPlayerStats
|
, _pYtd = newPlayerStats
|
||||||
, _pLifetime = newPlayerStats
|
, _pLifetime = newPlayerStats
|
||||||
}
|
}
|
||||||
@@ -723,6 +874,8 @@ newGoalie
|
|||||||
newGoalie num name = Goalie
|
newGoalie num name = Goalie
|
||||||
{ _gNumber = num
|
{ _gNumber = num
|
||||||
, _gName = name
|
, _gName = name
|
||||||
|
, _gRookie = True
|
||||||
|
, _gActive = True
|
||||||
, _gYtd = newGoalieStats
|
, _gYtd = newGoalieStats
|
||||||
, _gLifetime = newGoalieStats
|
, _gLifetime = newGoalieStats
|
||||||
}
|
}
|
||||||
@@ -733,6 +886,7 @@ newGoalieStats = GoalieStats
|
|||||||
{ _gsGames = 0
|
{ _gsGames = 0
|
||||||
, _gsMinsPlayed = 0
|
, _gsMinsPlayed = 0
|
||||||
, _gsGoalsAllowed = 0
|
, _gsGoalsAllowed = 0
|
||||||
|
, _gsShutouts = 0
|
||||||
, _gsWins = 0
|
, _gsWins = 0
|
||||||
, _gsLosses = 0
|
, _gsLosses = 0
|
||||||
, _gsTies = 0
|
, _gsTies = 0
|
||||||
@@ -828,9 +982,8 @@ playerSearch
|
|||||||
-> [(Int, Player)]
|
-> [(Int, Player)]
|
||||||
-- ^ The matching players with their index numbers
|
-- ^ The matching players with their index numbers
|
||||||
playerSearch sStr =
|
playerSearch sStr =
|
||||||
filter (match sStr) .
|
filter match . zip [0..]
|
||||||
zip [0..]
|
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||||
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
|
|
||||||
|
|
||||||
-- | Searches for a player by exact match on name
|
-- | Searches for a player by exact match on name
|
||||||
playerSearchExact
|
playerSearchExact
|
||||||
@@ -841,10 +994,8 @@ playerSearchExact
|
|||||||
-> Maybe (Int, Player)
|
-> Maybe (Int, Player)
|
||||||
-- ^ The player's index and value
|
-- ^ The player's index and value
|
||||||
playerSearchExact sStr =
|
playerSearchExact sStr =
|
||||||
listToMaybe .
|
listToMaybe . filter match . zip [0..]
|
||||||
filter (match sStr) .
|
where match (_, p) = p^.pName == sStr
|
||||||
zip [0..]
|
|
||||||
where match sStr (_, p) = p^.pName == sStr
|
|
||||||
|
|
||||||
-- | Modifies a player with a given name
|
-- | Modifies a player with a given name
|
||||||
modifyPlayer
|
modifyPlayer
|
||||||
@@ -866,20 +1017,6 @@ playerSummary :: Player -> String
|
|||||||
playerSummary p =
|
playerSummary p =
|
||||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||||
|
|
||||||
-- | Provides a detailed string describing a 'Player'
|
|
||||||
playerDetails :: Player -> String
|
|
||||||
playerDetails p = unlines
|
|
||||||
[ " Number: " ++ show (p^.pNumber)
|
|
||||||
, " Name: " ++ p^.pName
|
|
||||||
, " Position: " ++ p^.pPosition
|
|
||||||
, " YTD goals: " ++ show (p^.pYtd.psGoals)
|
|
||||||
, " YTD assists: " ++ show (p^.pYtd.psAssists)
|
|
||||||
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
|
|
||||||
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
|
|
||||||
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
|
|
||||||
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | Determines whether or not a player has been active in the current
|
-- | Determines whether or not a player has been active in the current
|
||||||
-- season/year
|
-- season/year
|
||||||
playerIsActive :: Player -> Bool
|
playerIsActive :: Player -> Bool
|
||||||
@@ -909,8 +1046,9 @@ goalieSearch
|
|||||||
-- ^ The list to search
|
-- ^ The list to search
|
||||||
-> [(Int, Goalie)]
|
-> [(Int, Goalie)]
|
||||||
-- ^ The search results with their corresponding index numbers
|
-- ^ The search results with their corresponding index numbers
|
||||||
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
|
goalieSearch sStr =
|
||||||
zip [0..]
|
filter match . zip [0..]
|
||||||
|
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||||
|
|
||||||
-- | Searches a list of goalies for an exact match
|
-- | Searches a list of goalies for an exact match
|
||||||
goalieSearchExact
|
goalieSearchExact
|
||||||
@@ -930,3 +1068,30 @@ goalieSearchExact sStr goalies = let
|
|||||||
-- | Provides a description string for a 'Goalie'
|
-- | Provides a description string for a 'Goalie'
|
||||||
goalieSummary :: Goalie -> String
|
goalieSummary :: Goalie -> String
|
||||||
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
||||||
|
|
||||||
|
-- | Determines whether or not a goalie has been active in the current
|
||||||
|
-- season
|
||||||
|
goalieIsActive :: Goalie -> Bool
|
||||||
|
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
|
||||||
|
|
||||||
|
-- | Adds two sets of 'GoalieStats'
|
||||||
|
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
|
||||||
|
addGoalieStats g1 g2 = GoalieStats
|
||||||
|
{ _gsGames = g1^.gsGames + g2^.gsGames
|
||||||
|
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
|
||||||
|
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
|
||||||
|
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
|
||||||
|
, _gsWins = g1^.gsWins + g2^.gsWins
|
||||||
|
, _gsLosses = g1^.gsLosses + g2^.gsLosses
|
||||||
|
, _gsTies = g1^.gsTies + g2^.gsTies
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Determines a goalie's average goals allowed per game.
|
||||||
|
gsAverage :: GoalieStats -> Rational
|
||||||
|
gsAverage gs = let
|
||||||
|
allowed = fromIntegral $ gs^.gsGoalsAllowed
|
||||||
|
mins = fromIntegral $ gs^.gsMinsPlayed
|
||||||
|
gLen = fromIntegral gameLength
|
||||||
|
in if mins == 0
|
||||||
|
then 0
|
||||||
|
else allowed / mins * gLen
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -38,8 +38,8 @@ module Mtlstats.Types.Menu (
|
|||||||
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
|
import Mtlstats.Format
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Defines a menu
|
-- | Defines a menu
|
||||||
@@ -66,8 +66,15 @@ makeLenses ''Menu
|
|||||||
makeLenses ''MenuItem
|
makeLenses ''MenuItem
|
||||||
|
|
||||||
instance Show (Menu a) where
|
instance Show (Menu a) where
|
||||||
show m = m ^. menuTitle ++ "\n" ++ items
|
show m = unlines
|
||||||
where items = unlines $ map show $ m ^. menuItems
|
$ [ m^.menuTitle
|
||||||
|
, ""
|
||||||
|
]
|
||||||
|
++ body
|
||||||
|
where
|
||||||
|
body = map (left width) items
|
||||||
|
width = maximum $ map length items
|
||||||
|
items = map show $ m^.menuItems
|
||||||
|
|
||||||
instance Show (MenuItem a) where
|
instance Show (MenuItem a) where
|
||||||
show i = [i ^. miKey] ++ ") " ++ i ^. miDescription
|
show i = [i ^. miKey] ++ ": " ++ i ^. miDescription
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{- |
|
{- |
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,8 +19,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
module Mtlstats.Util
|
||||||
|
( nth
|
||||||
|
, modifyNth
|
||||||
|
, updateMap
|
||||||
|
, slice
|
||||||
|
, capitalizeName
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Char (isSpace, toUpper)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
-- | Attempt to select the element from a list at a given index
|
-- | Attempt to select the element from a list at a given index
|
||||||
@@ -75,3 +82,25 @@ slice
|
|||||||
-- ^ The list to take a subset of
|
-- ^ The list to take a subset of
|
||||||
-> [a]
|
-> [a]
|
||||||
slice offset len = take len . drop offset
|
slice offset len = take len . drop offset
|
||||||
|
|
||||||
|
-- | Name capitalization function for a player
|
||||||
|
capitalizeName
|
||||||
|
:: Char
|
||||||
|
-- ^ The character being input
|
||||||
|
-> String
|
||||||
|
-- ^ The current string
|
||||||
|
-> String
|
||||||
|
-- ^ The resulting string
|
||||||
|
capitalizeName ch str = str ++ [ch']
|
||||||
|
where
|
||||||
|
ch' = if lockFlag str
|
||||||
|
then toUpper ch
|
||||||
|
else ch
|
||||||
|
lockFlag "" = True
|
||||||
|
lockFlag (c:cs)
|
||||||
|
| c == ',' = lockFlag' cs
|
||||||
|
| otherwise = lockFlag cs
|
||||||
|
lockFlag' "" = True
|
||||||
|
lockFlag' (c:cs)
|
||||||
|
| isSpace c = lockFlag' cs
|
||||||
|
| otherwise = False
|
||||||
|
|||||||
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,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -19,14 +19,14 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Actions.GoalieInputSpec (spec) where
|
module Actions.NewGame.GoalieInputSpec (spec) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Actions.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
& progMode.gameStateL .~ gameState n mins goals
|
& progMode.gameStateL .~ gameState n mins goals
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
|
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
|
||||||
s = recordGoalieStats $ progState gid mins goals
|
s = recordGoalieStats $ progState setGid mins goals
|
||||||
in context name $ do
|
in context setName $ do
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\( name
|
(\( chkName
|
||||||
, gid
|
, chkGid
|
||||||
, ( gGames
|
, ( gGames
|
||||||
, gMins
|
, gMins
|
||||||
, gGoals
|
, gGoals
|
||||||
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
, ltMins
|
, ltMins
|
||||||
, ltGoals
|
, ltGoals
|
||||||
)
|
)
|
||||||
) -> context name $ do
|
) -> context chkName $ do
|
||||||
let
|
let
|
||||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||||
game = M.findWithDefault newGoalieStats gid gs
|
game = M.findWithDefault newGoalieStats chkGid gs
|
||||||
goalie = fromJust $ nth gid $ s^.database.dbGoalies
|
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
|
||||||
ytd = goalie^.gYtd
|
ytd = goalie^.gYtd
|
||||||
lt = goalie^.gLifetime
|
lt = goalie^.gLifetime
|
||||||
|
|
||||||
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
]
|
]
|
||||||
|
|
||||||
context "selected goalie" $ let
|
context "selected goalie" $ let
|
||||||
expected = if reset then Nothing else gid
|
expected = if reset then Nothing else setGid
|
||||||
in it ("should be " ++ show expected) $
|
in it ("should be " ++ show expected) $
|
||||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||||
|
|
||||||
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
|||||||
tiedGame = gameState 0 1 True
|
tiedGame = gameState 0 1 True
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\(label, gameState, gid, bobData, joeData) -> context label $ let
|
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
||||||
|
|
||||||
progState = newProgState
|
progState = newProgState
|
||||||
& database.dbGoalies .~ [bob, joe]
|
& database.dbGoalies .~ [bob, joe]
|
||||||
& progMode.gameStateL .~ gameState
|
& progMode.gameStateL .~ gs
|
||||||
& setGameGoalie gid
|
& setGameGoalie setGid
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\( label
|
(\( chkLabel
|
||||||
, gid
|
, chkGid
|
||||||
, ( gWins
|
, ( gWins
|
||||||
, gLosses
|
, gLosses
|
||||||
, gTies
|
, gTies
|
||||||
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
|||||||
, ltLosses
|
, ltLosses
|
||||||
, ltTies
|
, ltTies
|
||||||
)
|
)
|
||||||
) -> context label $ do
|
) -> context chkLabel $ do
|
||||||
let
|
let
|
||||||
goalie = (progState^.database.dbGoalies) !! gid
|
goalie = (progState^.database.dbGoalies) !! chkGid
|
||||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||||
game = M.findWithDefault newGoalieStats gid gameStats
|
game = M.findWithDefault newGoalieStats chkGid gameStats
|
||||||
ytd = goalie^.gYtd
|
ytd = goalie^.gYtd
|
||||||
lifetime = goalie^.gLifetime
|
lifetime = goalie^.gLifetime
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\(label, expected, actual) -> context label $
|
(\(label', expected, actual) -> context label' $
|
||||||
expected `TS.compareTest` actual)
|
expected `TS.compareTest` actual)
|
||||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||||
526
test/Actions/NewGameSpec.hs
Normal file
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
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -24,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module ActionsSpec (spec) where
|
module ActionsSpec (spec) where
|
||||||
|
|
||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import qualified Data.Map as M
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import System.Random (randomRIO)
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
( Spec
|
( Spec
|
||||||
, context
|
, context
|
||||||
, describe
|
, describe
|
||||||
, it
|
, it
|
||||||
, runIO
|
|
||||||
, shouldBe
|
, shouldBe
|
||||||
, shouldNotBe
|
, shouldNotBe
|
||||||
, shouldSatisfy
|
, shouldSatisfy
|
||||||
@@ -41,9 +37,9 @@ import Test.Hspec
|
|||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
import qualified Actions.GoalieInputSpec as GoalieInput
|
import qualified Actions.NewGameSpec as NewGame
|
||||||
|
import qualified Actions.EditStandingsSpec as EditStandings
|
||||||
import qualified TypesSpec as TS
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
@@ -51,27 +47,26 @@ spec = describe "Mtlstats.Actions" $ do
|
|||||||
startNewSeasonSpec
|
startNewSeasonSpec
|
||||||
startNewGameSpec
|
startNewGameSpec
|
||||||
resetYtdSpec
|
resetYtdSpec
|
||||||
|
clearRookiesSpec
|
||||||
|
resetStandingsSpec
|
||||||
addCharSpec
|
addCharSpec
|
||||||
removeCharSpec
|
removeCharSpec
|
||||||
overtimeCheckSpec
|
|
||||||
updateGameStatsSpec
|
|
||||||
validateGameDateSpec
|
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
createGoalieSpec
|
createGoalieSpec
|
||||||
|
editSpec
|
||||||
editPlayerSpec
|
editPlayerSpec
|
||||||
|
editSelectedPlayerSpec
|
||||||
|
editGoalieSpec
|
||||||
|
editSelectedGoalieSpec
|
||||||
addPlayerSpec
|
addPlayerSpec
|
||||||
addGoalieSpec
|
addGoalieSpec
|
||||||
resetCreatePlayerStateSpec
|
resetCreatePlayerStateSpec
|
||||||
resetCreateGoalieStateSpec
|
resetCreateGoalieStateSpec
|
||||||
recordGoalAssistsSpec
|
|
||||||
awardGoalSpec
|
|
||||||
awardAssistSpec
|
|
||||||
resetGoalDataSpec
|
|
||||||
assignPMinsSpec
|
|
||||||
backHomeSpec
|
backHomeSpec
|
||||||
scrollUpSpec
|
scrollUpSpec
|
||||||
scrollDownSpec
|
scrollDownSpec
|
||||||
GoalieInput.spec
|
NewGame.spec
|
||||||
|
EditStandings.spec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
@@ -99,8 +94,8 @@ startNewGameSpec = describe "startNewGame" $ do
|
|||||||
resetYtdSpec :: Spec
|
resetYtdSpec :: Spec
|
||||||
resetYtdSpec = describe "resetYtd" $
|
resetYtdSpec = describe "resetYtd" $
|
||||||
it "should reset the year-to-date stats for all players" $ do
|
it "should reset the year-to-date stats for all players" $ do
|
||||||
ps <- replicateM 2 makePlayer
|
ps <- replicateM 2 TS.makePlayer
|
||||||
gs <- replicateM 2 makeGoalie
|
gs <- replicateM 2 TS.makeGoalie
|
||||||
let
|
let
|
||||||
s = newProgState
|
s = newProgState
|
||||||
& database . dbPlayers .~ ps
|
& database . dbPlayers .~ ps
|
||||||
@@ -137,6 +132,80 @@ resetYtdSpec = describe "resetYtd" $
|
|||||||
lt ^. gsTies `shouldNotBe` 0) $
|
lt ^. gsTies `shouldNotBe` 0) $
|
||||||
s ^. database . dbGoalies
|
s ^. database . dbGoalies
|
||||||
|
|
||||||
|
clearRookiesSpec :: Spec
|
||||||
|
clearRookiesSpec = describe "clearRookies" $ do
|
||||||
|
let
|
||||||
|
|
||||||
|
players =
|
||||||
|
[ newPlayer 1 "Joe" "centre" & pRookie .~ True
|
||||||
|
, newPlayer 2 "Bob" "centre" & pRookie .~ False
|
||||||
|
]
|
||||||
|
|
||||||
|
goalies =
|
||||||
|
[ newGoalie 3 "Bill" & gRookie .~ True
|
||||||
|
, newGoalie 4 "Doug" & gRookie .~ False
|
||||||
|
]
|
||||||
|
|
||||||
|
ps = newProgState
|
||||||
|
& database
|
||||||
|
%~ (dbPlayers .~ players)
|
||||||
|
. (dbGoalies .~ goalies)
|
||||||
|
|
||||||
|
ps' = clearRookies ps
|
||||||
|
|
||||||
|
context "Players" $ mapM_
|
||||||
|
(\p -> let
|
||||||
|
name = p^.pName
|
||||||
|
rFlag = p^.pRookie
|
||||||
|
in context name $
|
||||||
|
it "should not be a rookie" $
|
||||||
|
rFlag `shouldBe` False)
|
||||||
|
(ps'^.database.dbPlayers)
|
||||||
|
|
||||||
|
context "Goalies" $ mapM_
|
||||||
|
(\g -> let
|
||||||
|
name = g^.gName
|
||||||
|
rFlag = g^.gRookie
|
||||||
|
in context name $
|
||||||
|
it "should not be a rookie" $
|
||||||
|
rFlag `shouldBe` False)
|
||||||
|
(ps'^.database.dbGoalies)
|
||||||
|
|
||||||
|
resetStandingsSpec :: Spec
|
||||||
|
resetStandingsSpec = describe "resetStandings" $ do
|
||||||
|
let
|
||||||
|
home = GameStats
|
||||||
|
{ _gmsWins = 1
|
||||||
|
, _gmsLosses = 2
|
||||||
|
, _gmsOvertime = 3
|
||||||
|
, _gmsGoalsFor = 4
|
||||||
|
, _gmsGoalsAgainst = 5
|
||||||
|
}
|
||||||
|
|
||||||
|
away = GameStats
|
||||||
|
{ _gmsWins = 6
|
||||||
|
, _gmsLosses = 7
|
||||||
|
, _gmsOvertime = 8
|
||||||
|
, _gmsGoalsFor = 9
|
||||||
|
, _gmsGoalsAgainst = 10
|
||||||
|
}
|
||||||
|
|
||||||
|
db = newDatabase
|
||||||
|
& dbHomeGameStats .~ home
|
||||||
|
& dbAwayGameStats .~ away
|
||||||
|
|
||||||
|
ps = newProgState
|
||||||
|
& database .~ db
|
||||||
|
& resetStandings
|
||||||
|
|
||||||
|
context "home standings" $
|
||||||
|
it "should be reset" $
|
||||||
|
ps^.database.dbHomeGameStats `shouldBe` newGameStats
|
||||||
|
|
||||||
|
context "away standings" $
|
||||||
|
it "should be reset" $
|
||||||
|
ps^.database.dbAwayGameStats `shouldBe` newGameStats
|
||||||
|
|
||||||
addCharSpec :: Spec
|
addCharSpec :: Spec
|
||||||
addCharSpec = describe "addChar" $
|
addCharSpec = describe "addChar" $
|
||||||
it "should add the character to the input buffer" $ let
|
it "should add the character to the input buffer" $ let
|
||||||
@@ -160,202 +229,6 @@ removeCharSpec = describe "removeChar" $ do
|
|||||||
& removeChar
|
& removeChar
|
||||||
in s ^. inputBuffer `shouldBe` "fo"
|
in s ^. inputBuffer `shouldBe` "fo"
|
||||||
|
|
||||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
|
||||||
|
|
||||||
context "tie game" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should clear the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should leave the overtimeFlag blank" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
context "game won" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 2)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should set the overtimeCheck flag to False" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
|
||||||
|
|
||||||
context "game lost" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 2)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should leave the overtimeCheck flag blank" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
updateGameStatsSpec :: Spec
|
|
||||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
|
||||||
let
|
|
||||||
|
|
||||||
baseStats = newGameStats
|
|
||||||
& gmsWins .~ 1
|
|
||||||
& gmsLosses .~ 1
|
|
||||||
& gmsOvertime .~ 1
|
|
||||||
& gmsGoalsFor .~ 1
|
|
||||||
& gmsGoalsAgainst .~ 1
|
|
||||||
|
|
||||||
s t h a o = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType .~ t)
|
|
||||||
. (homeScore .~ h)
|
|
||||||
. (awayScore .~ a)
|
|
||||||
. (overtimeFlag .~ o)
|
|
||||||
& database
|
|
||||||
%~ (dbHomeGameStats .~ baseStats)
|
|
||||||
. (dbAwayGameStats .~ baseStats)
|
|
||||||
|
|
||||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
|
||||||
& dbHomeGameStats
|
|
||||||
%~ (gmsWins .~ hw)
|
|
||||||
. (gmsLosses .~ hl)
|
|
||||||
. (gmsOvertime .~ ho)
|
|
||||||
. (gmsGoalsFor .~ hf)
|
|
||||||
. (gmsGoalsAgainst .~ ha)
|
|
||||||
& dbAwayGameStats
|
|
||||||
%~ (gmsWins .~ aw)
|
|
||||||
. (gmsLosses .~ al)
|
|
||||||
. (gmsOvertime .~ ao)
|
|
||||||
. (gmsGoalsFor .~ af)
|
|
||||||
. (gmsGoalsAgainst .~ aa)
|
|
||||||
|
|
||||||
context "home win" $
|
|
||||||
it "should record a home win" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
|
||||||
|
|
||||||
context "home loss" $
|
|
||||||
it "should record a home loss" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
|
||||||
|
|
||||||
context "home overtime loss" $
|
|
||||||
it "should record a home overtime" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
|
||||||
|
|
||||||
context "away win" $
|
|
||||||
it "should record an away win" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
|
||||||
|
|
||||||
context "away loss" $
|
|
||||||
it "should record an away loss" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
|
||||||
|
|
||||||
context "away overtime loss" $
|
|
||||||
it "should record an away overtime" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
|
||||||
|
|
||||||
context "missing game type" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing home score" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing away score" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing overtime flag" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
validateGameDateSpec :: Spec
|
|
||||||
validateGameDateSpec = describe "validateGameDate" $ do
|
|
||||||
|
|
||||||
context "valid date" $
|
|
||||||
it "should leave the date unchanged" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameYear ?~ 2019)
|
|
||||||
. (gameMonth ?~ 6)
|
|
||||||
. (gameDay ?~ 25)
|
|
||||||
& validateGameDate
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
|
||||||
|
|
||||||
context "invalid date" $
|
|
||||||
it "should clear the date" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameYear ?~ 2019)
|
|
||||||
. (gameMonth ?~ 2)
|
|
||||||
. (gameDay ?~ 30)
|
|
||||||
& validateGameDate
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
|
||||||
|
|
||||||
context "missing day" $
|
|
||||||
it "should not change anything" $ do
|
|
||||||
let
|
|
||||||
|
|
||||||
gs = newGameState
|
|
||||||
& gameYear ?~ 2019
|
|
||||||
& gameMonth ?~ 6
|
|
||||||
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL .~ gs
|
|
||||||
& validateGameDate
|
|
||||||
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
|
||||||
|
|
||||||
createPlayerSpec :: Spec
|
createPlayerSpec :: Spec
|
||||||
createPlayerSpec = describe "createPlayer" $
|
createPlayerSpec = describe "createPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
@@ -368,12 +241,76 @@ createGoalieSpec = describe "createGoalie" $
|
|||||||
s = createGoalie newProgState
|
s = createGoalie newProgState
|
||||||
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||||
|
|
||||||
|
editSpec :: Spec
|
||||||
|
editSpec = describe "edit" $
|
||||||
|
it "should change the mode to EditMenu" $ let
|
||||||
|
ps = edit newProgState
|
||||||
|
in show (ps^.progMode) `shouldBe` "EditMenu"
|
||||||
|
|
||||||
editPlayerSpec :: Spec
|
editPlayerSpec :: Spec
|
||||||
editPlayerSpec = describe "editPlayer" $
|
editPlayerSpec = describe "editPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
s = editPlayer newProgState
|
s = editPlayer newProgState
|
||||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||||
|
|
||||||
|
editSelectedPlayerSpec :: Spec
|
||||||
|
editSelectedPlayerSpec = describe "editSelectedPlayer" $ mapM_
|
||||||
|
(\(label, pState, expected) -> context label $
|
||||||
|
it "should edit the players appropriately" $ let
|
||||||
|
pState' = editSelectedPlayer (pName .~ "foo") pState
|
||||||
|
players' = pState'^.database.dbPlayers
|
||||||
|
in players' `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, initial state, expected
|
||||||
|
[ ( "wrong mode", baseState, players )
|
||||||
|
, ( "not selected", changePlayer Nothing, players )
|
||||||
|
, ( "player 0", changePlayer $ Just 0, changed0 )
|
||||||
|
, ( "player 1", changePlayer $ Just 1, changed1 )
|
||||||
|
, ( "out of bounds", changePlayer $ Just 2, players )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
baseState = newProgState & database.dbPlayers .~ players
|
||||||
|
changePlayer n = baseState
|
||||||
|
& (progMode.editPlayerStateL.epsSelectedPlayer .~ n)
|
||||||
|
players = [ player 0, player 1 ]
|
||||||
|
changed0 = [ player' 0, player 1 ]
|
||||||
|
changed1 = [ player 0, player' 1 ]
|
||||||
|
player n = newPlayer n ("Player " ++ show n) "pos"
|
||||||
|
player' n = newPlayer n "foo" "pos"
|
||||||
|
|
||||||
|
editGoalieSpec :: Spec
|
||||||
|
editGoalieSpec = describe "editGoalie" $
|
||||||
|
it "should change the mode appropriately" $ let
|
||||||
|
s = editGoalie newProgState
|
||||||
|
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||||
|
|
||||||
|
editSelectedGoalieSpec :: Spec
|
||||||
|
editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
|
||||||
|
(\(label, pState, expected) -> context label $
|
||||||
|
it "should edit the goalies appropriately" $ let
|
||||||
|
pState' = editSelectedGoalie (gName .~ "foo") pState
|
||||||
|
goalies' = pState'^.database.dbGoalies
|
||||||
|
in goalies' `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, initial state, expected
|
||||||
|
[ ( "wrong mode", baseState, goalies )
|
||||||
|
, ( "not selected", changeGoalie Nothing, goalies )
|
||||||
|
, ( "goalie 0", changeGoalie $ Just 0, changed0 )
|
||||||
|
, ( "goalie 1", changeGoalie $ Just 1, changed1 )
|
||||||
|
, ( "out of bounds", changeGoalie $ Just 2, goalies )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
baseState = newProgState & database.dbGoalies .~ goalies
|
||||||
|
changeGoalie n = baseState
|
||||||
|
& (progMode.editGoalieStateL.egsSelectedGoalie .~ n)
|
||||||
|
goalies = [ goalie 0, goalie 1 ]
|
||||||
|
changed0 = [ goalie' 0, goalie 1 ]
|
||||||
|
changed1 = [ goalie 0, goalie' 1 ]
|
||||||
|
goalie n = newGoalie n ("Player " ++ show n)
|
||||||
|
goalie' n = newGoalie n "foo"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
addPlayerSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
addPlayerSpec = describe "addPlayer" $ do
|
||||||
let
|
let
|
||||||
@@ -440,281 +377,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
|||||||
newProgState & progMode.createGoalieStateL .~ cgs
|
newProgState & progMode.createGoalieStateL .~ cgs
|
||||||
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||||
|
|
||||||
recordGoalAssistsSpec :: Spec
|
|
||||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
|
||||||
let
|
|
||||||
joe = newPlayer 1 "Joe" "centre"
|
|
||||||
bob = newPlayer 2 "Bob" "defense"
|
|
||||||
steve = newPlayer 3 "Steve" "forward"
|
|
||||||
dave = newPlayer 4 "Dave" "somewhere"
|
|
||||||
frank = newPlayer 5 "Frank" "elsewhere"
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (goalBy ?~ 0)
|
|
||||||
. (assistsBy .~ [1, 2])
|
|
||||||
. (confirmGoalDataFlag .~ True)
|
|
||||||
& recordGoalAssists
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(name, n, goals, assists) -> context name $ do
|
|
||||||
let
|
|
||||||
player = (ps^.database.dbPlayers) !! n
|
|
||||||
stats = M.findWithDefault newPlayerStats n $
|
|
||||||
ps^.progMode.gameStateL.gamePlayerStats
|
|
||||||
|
|
||||||
it ("should set the year-to-date goals to " ++ show goals) $
|
|
||||||
player^.pYtd.psGoals `shouldBe` goals
|
|
||||||
|
|
||||||
it ("should set the lifetime goals to " ++ show goals) $
|
|
||||||
player^.pLifetime.psGoals `shouldBe` goals
|
|
||||||
|
|
||||||
it ("should set the game goals to " ++ show goals) $
|
|
||||||
stats^.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the year-to-date assists to " ++ show assists) $
|
|
||||||
player^.pYtd.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the lifetime assists to " ++ show assists) $
|
|
||||||
player^.pLifetime.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the game assists to " ++ show assists) $
|
|
||||||
stats^.psAssists `shouldBe` assists)
|
|
||||||
|
|
||||||
-- name, index, goals, assists
|
|
||||||
[ ( "Joe", 0, 1, 0 )
|
|
||||||
, ( "Bob", 1, 0, 1 )
|
|
||||||
, ( "Steve", 2, 0, 1 )
|
|
||||||
, ( "Dave", 3, 0, 0 )
|
|
||||||
]
|
|
||||||
|
|
||||||
it "should clear the goalBy value" $
|
|
||||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the assistsBy list" $
|
|
||||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
|
||||||
|
|
||||||
it "should increment the pointsAccounted counter" $
|
|
||||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
|
||||||
|
|
||||||
it "should clear the confirmGoalDataFlag" $
|
|
||||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
|
||||||
|
|
||||||
awardGoalSpec :: Spec
|
|
||||||
awardGoalSpec = describe "awardGoal" $ do
|
|
||||||
let
|
|
||||||
joe
|
|
||||||
= newPlayer 2 "Joe" "centre"
|
|
||||||
& pYtd.psGoals .~ 1
|
|
||||||
& pLifetime.psGoals .~ 2
|
|
||||||
bob
|
|
||||||
= newPlayer 3 "Bob" "defense"
|
|
||||||
& pYtd.psGoals .~ 3
|
|
||||||
& pLifetime.psGoals .~ 4
|
|
||||||
db
|
|
||||||
= newDatabase
|
|
||||||
& dbPlayers .~ [joe, bob]
|
|
||||||
joeStats
|
|
||||||
= newPlayerStats
|
|
||||||
& psGoals .~ 1
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
|
||||||
context pName $ do
|
|
||||||
let
|
|
||||||
ps' = awardGoal pid ps
|
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date goals") $
|
|
||||||
player^.pYtd.psGoals `shouldBe` ytd
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s lifetime goals") $
|
|
||||||
player^.pLifetime.psGoals `shouldBe` lt
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s game goals") $
|
|
||||||
gStats^.psGoals `shouldBe` game)
|
|
||||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
|
||||||
[ ( "Joe", 0, 2, 3, 2 )
|
|
||||||
, ( "Bob", 1, 4, 5, 1 )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "invalid index" $ let
|
|
||||||
ps' = awardGoal 2 ps
|
|
||||||
in it "should not change the database" $
|
|
||||||
ps'^.database `shouldBe` db
|
|
||||||
|
|
||||||
context "negative index" $ let
|
|
||||||
ps' = awardGoal (-1) ps
|
|
||||||
in it "should not change the database" $
|
|
||||||
ps'^.database `shouldBe` db
|
|
||||||
|
|
||||||
awardAssistSpec :: Spec
|
|
||||||
awardAssistSpec = describe "awardAssist" $ do
|
|
||||||
let
|
|
||||||
joe
|
|
||||||
= newPlayer 1 "Joe" "centre"
|
|
||||||
& pYtd.psAssists .~ 1
|
|
||||||
& pLifetime.psAssists .~ 2
|
|
||||||
bob
|
|
||||||
= newPlayer 2 "Bob" "defense"
|
|
||||||
& pYtd.psAssists .~ 3
|
|
||||||
& pLifetime.psAssists .~ 4
|
|
||||||
joeStats
|
|
||||||
= newPlayerStats
|
|
||||||
& psAssists .~ 1
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
|
||||||
& database.dbPlayers .~ [joe, bob]
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
|
||||||
context pName $ do
|
|
||||||
let
|
|
||||||
ps' = awardAssist pid ps
|
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date assists") $
|
|
||||||
player^.pYtd.psAssists `shouldBe` ytd
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s lifetime assists") $
|
|
||||||
player^.pLifetime.psAssists `shouldBe` lt
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s game assists") $
|
|
||||||
gStats^.psAssists `shouldBe` game)
|
|
||||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
|
||||||
[ ( "Joe", 0, 2, 3, 2 )
|
|
||||||
, ( "Bob", 1, 4, 5, 1 )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "invalid index" $ let
|
|
||||||
ps' = awardAssist (-1) ps
|
|
||||||
in it "should not change anything" $
|
|
||||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
|
||||||
|
|
||||||
resetGoalDataSpec :: Spec
|
|
||||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
|
||||||
players <- runIO $ replicateM 5 makePlayer
|
|
||||||
let
|
|
||||||
gs
|
|
||||||
= newGameState
|
|
||||||
& goalBy ?~ 1
|
|
||||||
& assistsBy .~ [2, 3]
|
|
||||||
& confirmGoalDataFlag .~ True
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& database.dbPlayers .~ players
|
|
||||||
& progMode.gameStateL .~ gs
|
|
||||||
& resetGoalData
|
|
||||||
|
|
||||||
it "should clear the goalBy value" $
|
|
||||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the assists by list" $
|
|
||||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
|
||||||
|
|
||||||
it "should clear confirmGoalDataFlag" $
|
|
||||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
|
||||||
|
|
||||||
assignPMinsSpec :: Spec
|
|
||||||
assignPMinsSpec = describe "assignPMins" $ let
|
|
||||||
|
|
||||||
bob = newPlayer 2 "Bob" "centre"
|
|
||||||
& pYtd.psPMin .~ 3
|
|
||||||
& pLifetime.psPMin .~ 4
|
|
||||||
|
|
||||||
joe = newPlayer 3 "Joe" "defense"
|
|
||||||
& pYtd.psPMin .~ 5
|
|
||||||
& pLifetime.psPMin .~ 6
|
|
||||||
|
|
||||||
ps pid = newProgState
|
|
||||||
& database.dbPlayers .~ [bob, joe]
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
|
||||||
. (gameSelectedPlayer .~ pid)
|
|
||||||
|
|
||||||
in mapM_
|
|
||||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
|
||||||
context ("selectedPlayer = " ++ show pid) $ do
|
|
||||||
let ps' = assignPMins 2 $ ps pid
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
|
||||||
let
|
|
||||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
|
||||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
|
||||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
|
||||||
|
|
||||||
context "lifetime penalty minutes" $
|
|
||||||
it ("should be " ++ show lt) $
|
|
||||||
player^.pLifetime.psPMin `shouldBe` lt
|
|
||||||
|
|
||||||
context "year-to-date penalty minutes" $
|
|
||||||
it ("should be " ++ show ytd) $
|
|
||||||
player^.pYtd.psPMin `shouldBe` ytd
|
|
||||||
|
|
||||||
context "game penalty minutes" $
|
|
||||||
it ("should be " ++ show game) $
|
|
||||||
pStats^.psPMin `shouldBe` game)
|
|
||||||
|
|
||||||
-- name, index, lifetime, ytd, game
|
|
||||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
|
||||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
|
||||||
]
|
|
||||||
|
|
||||||
it "should set selectedPlayer to Nothing" $
|
|
||||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
|
||||||
|
|
||||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
|
||||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
|
||||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
|
||||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
|
||||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
|
||||||
]
|
|
||||||
|
|
||||||
makePlayer :: IO Player
|
|
||||||
makePlayer = Player
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeName
|
|
||||||
<*> makeName
|
|
||||||
<*> makePlayerStats
|
|
||||||
<*> makePlayerStats
|
|
||||||
|
|
||||||
makeGoalie :: IO Goalie
|
|
||||||
makeGoalie = Goalie
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeName
|
|
||||||
<*> makeGoalieStats
|
|
||||||
<*> makeGoalieStats
|
|
||||||
|
|
||||||
makePlayerStats :: IO PlayerStats
|
|
||||||
makePlayerStats = PlayerStats
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
|
|
||||||
makeGoalieStats :: IO GoalieStats
|
|
||||||
makeGoalieStats = GoalieStats
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
|
|
||||||
makeNum :: IO Int
|
|
||||||
makeNum = randomRIO (1, 10)
|
|
||||||
|
|
||||||
makeName :: IO String
|
|
||||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
|
||||||
|
|
||||||
backHomeSpec :: Spec
|
backHomeSpec :: Spec
|
||||||
backHomeSpec = describe "backHome" $ do
|
backHomeSpec = describe "backHome" $ do
|
||||||
let
|
let
|
||||||
@@ -755,6 +417,7 @@ scrollUpSpec = describe "scrollUp" $ do
|
|||||||
ps' = scrollUp ps
|
ps' = scrollUp ps
|
||||||
in ps'^.scrollOffset `shouldBe` 0
|
in ps'^.scrollOffset `shouldBe` 0
|
||||||
|
|
||||||
|
scrollDownSpec :: Spec
|
||||||
scrollDownSpec = describe "scrollDown" $
|
scrollDownSpec = describe "scrollDown" $
|
||||||
it "should increase the scroll offset" $ let
|
it "should increase the scroll offset" $ let
|
||||||
ps = newProgState & scrollOffset .~ 10
|
ps = newProgState & scrollOffset .~ 10
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module FormatSpec (spec) where
|
module FormatSpec (spec) where
|
||||||
|
|
||||||
|
import Data.Ratio ((%))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Format" $ do
|
spec = describe "Mtlstats.Format" $ do
|
||||||
@@ -31,8 +33,15 @@ spec = describe "Mtlstats.Format" $ do
|
|||||||
leftSpec
|
leftSpec
|
||||||
rightSpec
|
rightSpec
|
||||||
centreSpec
|
centreSpec
|
||||||
|
padRightSpec
|
||||||
overlaySpec
|
overlaySpec
|
||||||
monthSpec
|
monthSpec
|
||||||
|
labelTableSpec
|
||||||
|
numTableSpec
|
||||||
|
tableWithSpec
|
||||||
|
complexTableSpec
|
||||||
|
overlayLastSpec
|
||||||
|
showFloatingSpec
|
||||||
|
|
||||||
padNumSpec :: Spec
|
padNumSpec :: Spec
|
||||||
padNumSpec = describe "padNum" $ do
|
padNumSpec = describe "padNum" $ do
|
||||||
@@ -90,6 +99,16 @@ centreSpec = describe "centre" $ do
|
|||||||
it "should truncate the text" $
|
it "should truncate the text" $
|
||||||
centre 2 "foo" `shouldBe` "fo"
|
centre 2 "foo" `shouldBe` "fo"
|
||||||
|
|
||||||
|
padRightSpec :: Spec
|
||||||
|
padRightSpec = describe "padRight" $ mapM_
|
||||||
|
(\(label, width, str, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
padRight width str `shouldBe` expected)
|
||||||
|
-- label, width, input string, expected
|
||||||
|
[ ( "text shorter", 5, "foo", "foo " )
|
||||||
|
, ( "text longer", 3, "foobar", "foobar" )
|
||||||
|
]
|
||||||
|
|
||||||
overlaySpec :: Spec
|
overlaySpec :: Spec
|
||||||
overlaySpec = describe "overlay" $ do
|
overlaySpec = describe "overlay" $ do
|
||||||
|
|
||||||
@@ -111,3 +130,120 @@ monthSpec = describe "month" $ do
|
|||||||
context "invalid" $
|
context "invalid" $
|
||||||
it "should return an empty string" $
|
it "should return an empty string" $
|
||||||
month 0 `shouldBe` ""
|
month 0 `shouldBe` ""
|
||||||
|
|
||||||
|
labelTableSpec :: Spec
|
||||||
|
labelTableSpec = describe "labelTable" $
|
||||||
|
it "should format the table" $ let
|
||||||
|
input =
|
||||||
|
[ ( "foo", "bar" )
|
||||||
|
, ( "baz", "quux" )
|
||||||
|
, ( "longer", "x" )
|
||||||
|
]
|
||||||
|
|
||||||
|
expected =
|
||||||
|
[ " foo: bar"
|
||||||
|
, " baz: quux"
|
||||||
|
, "longer: x"
|
||||||
|
]
|
||||||
|
|
||||||
|
in labelTable input `shouldBe` expected
|
||||||
|
|
||||||
|
numTableSpec :: Spec
|
||||||
|
numTableSpec = describe "numTable" $
|
||||||
|
it "should format the table" $ let
|
||||||
|
headers = ["foo", "bar", "baz"]
|
||||||
|
|
||||||
|
rows =
|
||||||
|
[ ( "quux", [ 1, 2, 3 ] )
|
||||||
|
, ( "xyzzy", [ 9, 99, 999 ] )
|
||||||
|
]
|
||||||
|
|
||||||
|
expected =
|
||||||
|
[ " foo bar baz"
|
||||||
|
, " quux 1 2 3"
|
||||||
|
, "xyzzy 9 99 999"
|
||||||
|
]
|
||||||
|
|
||||||
|
in numTable headers rows `shouldBe` expected
|
||||||
|
|
||||||
|
tableWithSpec :: Spec
|
||||||
|
tableWithSpec = describe "tableWith" $ let
|
||||||
|
vals =
|
||||||
|
[ [ "foo", "bar", "baz" ]
|
||||||
|
, [ "quux", "xyzzy", "x" ]
|
||||||
|
]
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\(label, func, expected) -> context label $
|
||||||
|
it "should format the table" $
|
||||||
|
tableWith func vals `shouldBe` expected)
|
||||||
|
[ ( "align left"
|
||||||
|
, left
|
||||||
|
, [ "foo bar baz"
|
||||||
|
, "quux xyzzy x "
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, ( "align right"
|
||||||
|
, right
|
||||||
|
, [ " foo bar baz"
|
||||||
|
, "quux xyzzy x"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
complexTableSpec :: Spec
|
||||||
|
complexTableSpec = describe "complexTable" $ mapM_
|
||||||
|
(\(label, pFuncs, cells, expected) -> context label $
|
||||||
|
it "should format correctly" $
|
||||||
|
complexTable pFuncs cells `shouldBe` expected)
|
||||||
|
[ ( "no fill"
|
||||||
|
, [left, right]
|
||||||
|
, [ [ CellText "foo", CellText "bar" ]
|
||||||
|
, [ CellText "baaz", CellText "quux" ]
|
||||||
|
]
|
||||||
|
, [ "foo bar"
|
||||||
|
, "baaz quux"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, ( "with fill"
|
||||||
|
, [left, left, left]
|
||||||
|
, [ [ CellText "foo", CellText "bar", CellText "baz" ]
|
||||||
|
, [ CellText "quux", CellFill '-', CellFill '@' ]
|
||||||
|
]
|
||||||
|
, [ "foo bar baz"
|
||||||
|
, "quux ----@@@"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
overlayLastSpec :: Spec
|
||||||
|
overlayLastSpec = describe "overlayLast" $ let
|
||||||
|
text = "foo"
|
||||||
|
|
||||||
|
sample =
|
||||||
|
[ "line 1"
|
||||||
|
, "line 2"
|
||||||
|
]
|
||||||
|
|
||||||
|
edited =
|
||||||
|
[ "line 1"
|
||||||
|
, "fooe 2"
|
||||||
|
]
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\(label, input, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
overlayLast text input `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, input, expected
|
||||||
|
[ ( "empty list", [], [] )
|
||||||
|
, ( "non-empty list", sample, edited )
|
||||||
|
]
|
||||||
|
|
||||||
|
showFloatingSpec :: Spec
|
||||||
|
showFloatingSpec = describe "showFloating" $ let
|
||||||
|
input = 3 % 2 :: Rational
|
||||||
|
expected = "1.50"
|
||||||
|
|
||||||
|
in it ("should be " ++ expected) $
|
||||||
|
showFloating input `shouldBe` expected
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
|||||||
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
|
||||||
32
test/HelpersSpec.hs
Normal file
32
test/HelpersSpec.hs
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module HelpersSpec (spec) where
|
||||||
|
|
||||||
|
import Test.Hspec (Spec, describe)
|
||||||
|
|
||||||
|
import qualified Helpers.GoalieSpec as Goalie
|
||||||
|
import qualified Helpers.PlayerSpec as Player
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Helper" $ do
|
||||||
|
Player.spec
|
||||||
|
Goalie.spec
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,16 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module ReportSpec (spec) where
|
module ReportSpec (spec) where
|
||||||
|
|
||||||
import Lens.Micro ((&), (?~), (%~))
|
import Lens.Micro ((&), (?~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Report
|
import Mtlstats.Report
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Report" $ do
|
spec = describe "Mtlstats.Report"
|
||||||
gameDateSpec
|
gameDateSpec
|
||||||
playerNameColWidthSpec
|
|
||||||
|
|
||||||
gameDateSpec :: Spec
|
gameDateSpec :: Spec
|
||||||
gameDateSpec = describe "gameDate" $ do
|
gameDateSpec = describe "gameDate" $ do
|
||||||
@@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
|
|||||||
context "invalid date" $
|
context "invalid date" $
|
||||||
it "should return an empty string" $
|
it "should return an empty string" $
|
||||||
gameDate newGameState `shouldBe` ""
|
gameDate newGameState `shouldBe` ""
|
||||||
|
|
||||||
playerNameColWidthSpec :: Spec
|
|
||||||
playerNameColWidthSpec = describe "playerNameColWidth" $ do
|
|
||||||
let
|
|
||||||
short1 = newPlayer 1 "short" "foo"
|
|
||||||
short2 = newPlayer 2 "shorty" "bar"
|
|
||||||
long = newPlayer 3 "123456789012345" "baz"
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(label, players, expected) -> context label $
|
|
||||||
it ("should be " ++ show expected) $
|
|
||||||
playerNameColWidth players `shouldBe` expected)
|
|
||||||
-- label, players, expected
|
|
||||||
[ ( "empty list", [], 10 )
|
|
||||||
, ( "short names", [short1, short2], 10 )
|
|
||||||
, ( "long name", [short1, long], 16 )
|
|
||||||
]
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
|
|||||||
import qualified ActionsSpec as Actions
|
import qualified ActionsSpec as Actions
|
||||||
import qualified FormatSpec as Format
|
import qualified FormatSpec as Format
|
||||||
import qualified HandlersSpec as Handlers
|
import qualified HandlersSpec as Handlers
|
||||||
|
import qualified HelpersSpec as Helpers
|
||||||
import qualified ReportSpec as Report
|
import qualified ReportSpec as Report
|
||||||
import qualified TypesSpec as Types
|
import qualified TypesSpec as Types
|
||||||
import qualified UtilSpec as Util
|
import qualified UtilSpec as Util
|
||||||
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
|
|||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec $ do
|
main = hspec $ do
|
||||||
Types.spec
|
Types.spec
|
||||||
|
Helpers.spec
|
||||||
Actions.spec
|
Actions.spec
|
||||||
Format.spec
|
Format.spec
|
||||||
Handlers.spec
|
Handlers.spec
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -37,11 +37,11 @@ showSpec :: Spec
|
|||||||
showSpec = describe "show" $
|
showSpec = describe "show" $
|
||||||
it "should display correctly" $ let
|
it "should display correctly" $ let
|
||||||
menu = Menu "Foo" ()
|
menu = Menu "Foo" ()
|
||||||
[ MenuItem '1' "Item 1" $ return ()
|
[ MenuItem '1' "foo" $ return ()
|
||||||
, MenuItem '2' "Item 2" $ return ()
|
, MenuItem '2' "bar baz" $ return ()
|
||||||
]
|
]
|
||||||
expected =
|
expected =
|
||||||
"Foo\n\
|
"Foo\n\n\
|
||||||
\1) Item 1\n\
|
\1: foo \n\
|
||||||
\2) Item 2\n"
|
\2: bar baz\n"
|
||||||
in show menu `shouldBe` expected
|
in show menu `shouldBe` expected
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -21,13 +21,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||||
|
|
||||||
module TypesSpec (Comparable (..), spec) where
|
module TypesSpec
|
||||||
|
( Comparable (..)
|
||||||
|
, spec
|
||||||
|
, makePlayer
|
||||||
|
, makeGoalie
|
||||||
|
, makePlayerStats
|
||||||
|
, makeGoalieStats
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (replicateM)
|
||||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||||
import Data.Aeson.Types (Value (Object))
|
import Data.Aeson.Types (Value (Object))
|
||||||
import Data.ByteString.Lazy (ByteString)
|
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
import Data.Ratio ((%))
|
||||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||||
|
import System.Random (randomIO, randomRIO)
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
@@ -48,6 +57,9 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
createPlayerStateLSpec
|
createPlayerStateLSpec
|
||||||
createGoalieStateLSpec
|
createGoalieStateLSpec
|
||||||
editPlayerStateLSpec
|
editPlayerStateLSpec
|
||||||
|
editGoalieStateLSpec
|
||||||
|
editStandingsModeLSpec
|
||||||
|
esmSubModeLSpec
|
||||||
teamScoreSpec
|
teamScoreSpec
|
||||||
otherScoreSpec
|
otherScoreSpec
|
||||||
homeTeamSpec
|
homeTeamSpec
|
||||||
@@ -63,13 +75,15 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
playerSearchExactSpec
|
playerSearchExactSpec
|
||||||
modifyPlayerSpec
|
modifyPlayerSpec
|
||||||
playerSummarySpec
|
playerSummarySpec
|
||||||
playerDetailsSpec
|
|
||||||
playerIsActiveSpec
|
playerIsActiveSpec
|
||||||
psPointsSpec
|
psPointsSpec
|
||||||
addPlayerStatsSpec
|
addPlayerStatsSpec
|
||||||
goalieSearchSpec
|
goalieSearchSpec
|
||||||
goalieSearchExactSpec
|
goalieSearchExactSpec
|
||||||
goalieSummarySpec
|
goalieSummarySpec
|
||||||
|
goalieIsActiveSpec
|
||||||
|
addGoalieStatsSpec
|
||||||
|
gsAverageSpec
|
||||||
Menu.spec
|
Menu.spec
|
||||||
|
|
||||||
playerSpec :: Spec
|
playerSpec :: Spec
|
||||||
@@ -161,6 +175,65 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
|
|||||||
eps2 = newEditPlayerState
|
eps2 = newEditPlayerState
|
||||||
& epsSelectedPlayer ?~ 2
|
& epsSelectedPlayer ?~ 2
|
||||||
|
|
||||||
|
editGoalieStateLSpec :: Spec
|
||||||
|
editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||||
|
lensSpec editGoalieStateL
|
||||||
|
-- getters
|
||||||
|
[ ( "missing state", MainMenu, newEditGoalieState )
|
||||||
|
, ( "with state", EditGoalie egs1, egs1 )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set state", MainMenu, egs1 )
|
||||||
|
, ( "change state", EditGoalie egs1, egs2 )
|
||||||
|
, ( "clear state", EditGoalie egs1, newEditGoalieState )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
egs1 = newEditGoalieState
|
||||||
|
& egsSelectedGoalie ?~ 1
|
||||||
|
egs2 = newEditGoalieState
|
||||||
|
& egsSelectedGoalie ?~ 2
|
||||||
|
|
||||||
|
editStandingsModeLSpec :: Spec
|
||||||
|
editStandingsModeLSpec = describe "editStandingsModeL" $
|
||||||
|
lensSpec editStandingsModeL
|
||||||
|
-- getters
|
||||||
|
[ ( "missing mode", MainMenu, menu )
|
||||||
|
, ( "with mode", EditStandings home, home )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set mode", MainMenu, home )
|
||||||
|
, ( "change mode", EditStandings home, away )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
menu = ESMMenu
|
||||||
|
home = ESMHome ESMSubMenu
|
||||||
|
away = ESMAway ESMSubMenu
|
||||||
|
|
||||||
|
esmSubModeLSpec :: Spec
|
||||||
|
esmSubModeLSpec = describe "esmSubModeL" $ do
|
||||||
|
|
||||||
|
context "getters" $ mapM_
|
||||||
|
(\(label, mode, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
mode^.esmSubModeL `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, mode, expected
|
||||||
|
[ ( "no state", ESMMenu, ESMSubMenu )
|
||||||
|
, ( "with state", ESMHome ESMEditWins, ESMEditWins )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "setters" $ mapM_
|
||||||
|
(\(label, mode, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $ let
|
||||||
|
mode' = mode & esmSubModeL .~ ESMEditWins
|
||||||
|
in mode' `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, mode, expected
|
||||||
|
[ ( "no state", ESMMenu, ESMMenu )
|
||||||
|
, ( "home mode", ESMHome ESMSubMenu, ESMHome ESMEditWins )
|
||||||
|
, ( "away mode", ESMAway ESMSubMenu, ESMAway ESMEditWins )
|
||||||
|
]
|
||||||
|
|
||||||
teamScoreSpec :: Spec
|
teamScoreSpec :: Spec
|
||||||
teamScoreSpec = describe "teamScore" $ do
|
teamScoreSpec = describe "teamScore" $ do
|
||||||
let
|
let
|
||||||
@@ -241,6 +314,7 @@ lensSpec lens getters setters = do
|
|||||||
|
|
||||||
player :: Player
|
player :: Player
|
||||||
player = newPlayer 1 "Joe" "centre"
|
player = newPlayer 1 "Joe" "centre"
|
||||||
|
& pRookie .~ False
|
||||||
& pYtd .~ playerStats 1
|
& pYtd .~ playerStats 1
|
||||||
& pLifetime .~ playerStats 2
|
& pLifetime .~ playerStats 2
|
||||||
|
|
||||||
@@ -249,6 +323,8 @@ playerJSON = Object $ HM.fromList
|
|||||||
[ ( "number", toJSON (1 :: Int) )
|
[ ( "number", toJSON (1 :: Int) )
|
||||||
, ( "name", toJSON ("Joe" :: String) )
|
, ( "name", toJSON ("Joe" :: String) )
|
||||||
, ( "position", toJSON ("centre" :: String) )
|
, ( "position", toJSON ("centre" :: String) )
|
||||||
|
, ( "rookie", toJSON False )
|
||||||
|
, ( "active", toJSON True )
|
||||||
, ( "ytd", playerStatsJSON 1 )
|
, ( "ytd", playerStatsJSON 1 )
|
||||||
, ( "lifetime", playerStatsJSON 2 )
|
, ( "lifetime", playerStatsJSON 2 )
|
||||||
]
|
]
|
||||||
@@ -268,6 +344,7 @@ playerStatsJSON n = Object $ HM.fromList
|
|||||||
|
|
||||||
goalie :: Goalie
|
goalie :: Goalie
|
||||||
goalie = newGoalie 1 "Joe"
|
goalie = newGoalie 1 "Joe"
|
||||||
|
& gRookie .~ False
|
||||||
& gYtd .~ goalieStats 1
|
& gYtd .~ goalieStats 1
|
||||||
& gLifetime .~ goalieStats 2
|
& gLifetime .~ goalieStats 2
|
||||||
|
|
||||||
@@ -275,6 +352,8 @@ goalieJSON :: Value
|
|||||||
goalieJSON = Object $ HM.fromList
|
goalieJSON = Object $ HM.fromList
|
||||||
[ ( "number", toJSON (1 :: Int) )
|
[ ( "number", toJSON (1 :: Int) )
|
||||||
, ( "name", toJSON ("Joe" :: String ) )
|
, ( "name", toJSON ("Joe" :: String ) )
|
||||||
|
, ( "rookie", toJSON False )
|
||||||
|
, ( "active", toJSON True )
|
||||||
, ( "ytd", goalieStatsJSON 1 )
|
, ( "ytd", goalieStatsJSON 1 )
|
||||||
, ( "lifetime", goalieStatsJSON 2 )
|
, ( "lifetime", goalieStatsJSON 2 )
|
||||||
]
|
]
|
||||||
@@ -284,18 +363,20 @@ goalieStats n = newGoalieStats
|
|||||||
& gsGames .~ n
|
& gsGames .~ n
|
||||||
& gsMinsPlayed .~ n + 1
|
& gsMinsPlayed .~ n + 1
|
||||||
& gsGoalsAllowed .~ n + 2
|
& gsGoalsAllowed .~ n + 2
|
||||||
& gsWins .~ n + 3
|
& gsShutouts .~ n + 3
|
||||||
& gsLosses .~ n + 4
|
& gsWins .~ n + 4
|
||||||
& gsTies .~ n + 5
|
& gsLosses .~ n + 5
|
||||||
|
& gsTies .~ n + 6
|
||||||
|
|
||||||
goalieStatsJSON :: Int -> Value
|
goalieStatsJSON :: Int -> Value
|
||||||
goalieStatsJSON n = Object $ HM.fromList
|
goalieStatsJSON n = Object $ HM.fromList
|
||||||
[ ( "games", toJSON n )
|
[ ( "games", toJSON n )
|
||||||
, ( "mins_played", toJSON $ n + 1 )
|
, ( "mins_played", toJSON $ n + 1 )
|
||||||
, ( "goals_allowed", toJSON $ n + 2 )
|
, ( "goals_allowed", toJSON $ n + 2 )
|
||||||
, ( "wins", toJSON $ n + 3 )
|
, ( "shutouts", toJSON $ n + 3 )
|
||||||
, ( "losses", toJSON $ n + 4 )
|
, ( "wins", toJSON $ n + 4 )
|
||||||
, ( "ties", toJSON $ n + 5 )
|
, ( "losses", toJSON $ n + 5 )
|
||||||
|
, ( "ties", toJSON $ n + 6 )
|
||||||
]
|
]
|
||||||
|
|
||||||
gameStats :: Int -> GameStats
|
gameStats :: Int -> GameStats
|
||||||
@@ -559,7 +640,7 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
|||||||
ps = [joe, bob, steve]
|
ps = [joe, bob, steve]
|
||||||
in playerSearch sStr ps `shouldBe` expected)
|
in playerSearch sStr ps `shouldBe` expected)
|
||||||
-- search, result
|
-- search, result
|
||||||
[ ( "Joe", [(0, joe)] )
|
[ ( "joe", [(0, joe)] )
|
||||||
, ( "o", [(0, joe), (1, bob)] )
|
, ( "o", [(0, joe), (1, bob)] )
|
||||||
, ( "e", [(0, joe), (2, steve)] )
|
, ( "e", [(0, joe), (2, steve)] )
|
||||||
, ( "x", [] )
|
, ( "x", [] )
|
||||||
@@ -581,22 +662,22 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
|||||||
|
|
||||||
modifyPlayerSpec :: Spec
|
modifyPlayerSpec :: Spec
|
||||||
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
||||||
(\(pName, j, b, s) -> let
|
(\(name, j, b, s) -> let
|
||||||
modifier = pLifetime.psGoals .~ 1
|
modifier = pLifetime.psGoals .~ 1
|
||||||
players = modifyPlayer modifier pName [joe, bob, steve]
|
players = modifyPlayer modifier name [joe, bob, steve]
|
||||||
in context ("modify " ++ pName) $ do
|
in context ("modify " ++ name) $ do
|
||||||
|
|
||||||
context "Joe's lifetime goals" $
|
context "Joe's lifetime goals" $
|
||||||
it ("should be " ++ show j) $
|
it ("should be " ++ show j) $
|
||||||
head players ^. pLifetime.psGoals `shouldBe` j
|
head players^.pLifetime.psGoals `shouldBe` j
|
||||||
|
|
||||||
context "Bob's lifetime goals" $
|
context "Bob's lifetime goals" $
|
||||||
it ("should be " ++ show b) $
|
it ("should be " ++ show b) $
|
||||||
(players !! 1) ^. pLifetime.psGoals `shouldBe` b
|
(players !! 1)^.pLifetime.psGoals `shouldBe` b
|
||||||
|
|
||||||
context "Steve's lifetime goals" $
|
context "Steve's lifetime goals" $
|
||||||
it ("should be " ++ show s) $
|
it ("should be " ++ show s) $
|
||||||
last players ^. pLifetime.psGoals `shouldBe` s)
|
last players^.pLifetime.psGoals `shouldBe` s)
|
||||||
-- player name, Joe's goals, Bob's goals, Steve's goals
|
-- player name, Joe's goals, Bob's goals, Steve's goals
|
||||||
[ ( "Joe", 1, 0, 0 )
|
[ ( "Joe", 1, 0, 0 )
|
||||||
, ( "Bob", 0, 1, 0 )
|
, ( "Bob", 0, 1, 0 )
|
||||||
@@ -609,54 +690,24 @@ playerSummarySpec = describe "playerSummary" $
|
|||||||
it "should be \"Joe (2) center\"" $
|
it "should be \"Joe (2) center\"" $
|
||||||
playerSummary joe `shouldBe` "Joe (2) center"
|
playerSummary joe `shouldBe` "Joe (2) center"
|
||||||
|
|
||||||
playerDetailsSpec :: Spec
|
|
||||||
playerDetailsSpec = describe "playerDetails" $
|
|
||||||
it "should give a detailed description" $ let
|
|
||||||
|
|
||||||
player = newPlayer 1 "Joe" "centre"
|
|
||||||
& pYtd .~ PlayerStats
|
|
||||||
{ _psGoals = 2
|
|
||||||
, _psAssists = 3
|
|
||||||
, _psPMin = 4
|
|
||||||
}
|
|
||||||
& pLifetime .~ PlayerStats
|
|
||||||
{ _psGoals = 5
|
|
||||||
, _psAssists = 6
|
|
||||||
, _psPMin = 7
|
|
||||||
}
|
|
||||||
|
|
||||||
expected = unlines
|
|
||||||
[ " Number: 1"
|
|
||||||
, " Name: Joe"
|
|
||||||
, " Position: centre"
|
|
||||||
, " YTD goals: 2"
|
|
||||||
, " YTD assists: 3"
|
|
||||||
, " YTD penalty mins: 4"
|
|
||||||
, " Lifetime goals: 5"
|
|
||||||
, " Lifetime assists: 6"
|
|
||||||
, "Lifetime penalty mins: 7"
|
|
||||||
]
|
|
||||||
|
|
||||||
in playerDetails player `shouldBe` expected
|
|
||||||
|
|
||||||
playerIsActiveSpec :: Spec
|
playerIsActiveSpec :: Spec
|
||||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||||
let
|
let
|
||||||
pState = newPlayerStats
|
pStats = newPlayerStats
|
||||||
& psGoals .~ 10
|
& psGoals .~ 10
|
||||||
& psAssists .~ 11
|
& psAssists .~ 11
|
||||||
& psPMin .~ 12
|
& psPMin .~ 12
|
||||||
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
|
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\(label, player', expected) -> context label $
|
(\(label, p', expected) -> context label $
|
||||||
it ("should be " ++ show expected) $
|
it ("should be " ++ show expected) $
|
||||||
playerIsActive player' `shouldBe` expected)
|
playerIsActive p' `shouldBe` expected)
|
||||||
-- label, player, expected
|
-- label, player, expected
|
||||||
[ ( "not active", player, False )
|
[ ( "not active", p, False )
|
||||||
, ( "has goal", player & pYtd.psGoals .~ 1, True )
|
, ( "has goal", p & pYtd.psGoals .~ 1, True )
|
||||||
, ( "has assist", player & pYtd.psAssists .~ 1, True )
|
, ( "has assist", p & pYtd.psAssists .~ 1, True )
|
||||||
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
|
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
|
||||||
]
|
]
|
||||||
|
|
||||||
psPointsSpec :: Spec
|
psPointsSpec :: Spec
|
||||||
@@ -723,8 +774,8 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
|||||||
goalieSearch "x" goalies `shouldBe` []
|
goalieSearch "x" goalies `shouldBe` []
|
||||||
|
|
||||||
context "exact match" $
|
context "exact match" $
|
||||||
it "should return Steve" $
|
it "should return Bob" $
|
||||||
goalieSearch "Bob" goalies `shouldBe` [result 1]
|
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||||
|
|
||||||
goalieSearchExactSpec :: Spec
|
goalieSearchExactSpec :: Spec
|
||||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||||
@@ -755,6 +806,77 @@ goalieSummarySpec = describe "goalieSummary" $
|
|||||||
it "should provide a summary string" $
|
it "should provide a summary string" $
|
||||||
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
||||||
|
|
||||||
|
goalieIsActiveSpec :: Spec
|
||||||
|
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
|
||||||
|
(\(label, input, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
goalieIsActive input `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, input, expected
|
||||||
|
[ ( "inactive", inactive, False )
|
||||||
|
, ( "active", active, True )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
inactive = newGoalie 1 "Joe"
|
||||||
|
& gLifetime.gsMinsPlayed .~ 1
|
||||||
|
|
||||||
|
active = inactive
|
||||||
|
& gYtd.gsMinsPlayed .~ 1
|
||||||
|
|
||||||
|
addGoalieStatsSpec :: Spec
|
||||||
|
addGoalieStatsSpec = describe "addGoalieStats" $ let
|
||||||
|
g1 = GoalieStats
|
||||||
|
{ _gsGames = 1
|
||||||
|
, _gsMinsPlayed = 2
|
||||||
|
, _gsGoalsAllowed = 3
|
||||||
|
, _gsShutouts = 4
|
||||||
|
, _gsWins = 5
|
||||||
|
, _gsLosses = 6
|
||||||
|
, _gsTies = 7
|
||||||
|
}
|
||||||
|
|
||||||
|
g2 = GoalieStats
|
||||||
|
{ _gsGames = 8
|
||||||
|
, _gsMinsPlayed = 9
|
||||||
|
, _gsGoalsAllowed = 10
|
||||||
|
, _gsShutouts = 11
|
||||||
|
, _gsWins = 12
|
||||||
|
, _gsLosses = 13
|
||||||
|
, _gsTies = 14
|
||||||
|
}
|
||||||
|
|
||||||
|
expected = GoalieStats
|
||||||
|
{ _gsGames = 9
|
||||||
|
, _gsMinsPlayed = 11
|
||||||
|
, _gsGoalsAllowed = 13
|
||||||
|
, _gsShutouts = 15
|
||||||
|
, _gsWins = 17
|
||||||
|
, _gsLosses = 19
|
||||||
|
, _gsTies = 21
|
||||||
|
}
|
||||||
|
|
||||||
|
actual = g1 `addGoalieStats` g2
|
||||||
|
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|
||||||
|
gsAverageSpec :: Spec
|
||||||
|
gsAverageSpec = describe "gsAverage" $ mapM_
|
||||||
|
(\(label, stats, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
gsAverage stats `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, stats, expected
|
||||||
|
[ ( "with minutes", gs, 3 % 2 )
|
||||||
|
, ( "no minutes", newGoalieStats , 0 )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
gs = newGoalieStats
|
||||||
|
& gsMinsPlayed .~ 2 * gameLength
|
||||||
|
& gsGoalsAllowed .~ 3
|
||||||
|
|
||||||
joe :: Player
|
joe :: Player
|
||||||
joe = newPlayer 2 "Joe" "center"
|
joe = newPlayer 2 "Joe" "center"
|
||||||
|
|
||||||
@@ -764,6 +886,54 @@ bob = newPlayer 3 "Bob" "defense"
|
|||||||
steve :: Player
|
steve :: Player
|
||||||
steve = newPlayer 5 "Steve" "forward"
|
steve = newPlayer 5 "Steve" "forward"
|
||||||
|
|
||||||
|
-- | Creates a 'Player'
|
||||||
|
makePlayer :: IO Player
|
||||||
|
makePlayer = Player
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeName
|
||||||
|
<*> makeName
|
||||||
|
<*> makeBool
|
||||||
|
<*> makeBool
|
||||||
|
<*> makePlayerStats
|
||||||
|
<*> makePlayerStats
|
||||||
|
|
||||||
|
-- | Creates a 'Goalie'
|
||||||
|
makeGoalie :: IO Goalie
|
||||||
|
makeGoalie = Goalie
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeName
|
||||||
|
<*> makeBool
|
||||||
|
<*> makeBool
|
||||||
|
<*> makeGoalieStats
|
||||||
|
<*> makeGoalieStats
|
||||||
|
|
||||||
|
-- | Creates a 'PlayerStats' value
|
||||||
|
makePlayerStats :: IO PlayerStats
|
||||||
|
makePlayerStats = PlayerStats
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
|
||||||
|
-- | Creates a 'GoalieStats' value
|
||||||
|
makeGoalieStats :: IO GoalieStats
|
||||||
|
makeGoalieStats = GoalieStats
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
|
||||||
|
makeNum :: IO Int
|
||||||
|
makeNum = randomRIO (1, 10)
|
||||||
|
|
||||||
|
makeBool :: IO Bool
|
||||||
|
makeBool = randomIO
|
||||||
|
|
||||||
|
makeName :: IO String
|
||||||
|
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||||
|
|
||||||
instance Comparable GoalieStats where
|
instance Comparable GoalieStats where
|
||||||
compareTest actual expected = mapM_
|
compareTest actual expected = mapM_
|
||||||
(\(name, lens) -> describe name $
|
(\(name, lens) -> describe name $
|
||||||
@@ -809,6 +979,17 @@ instance Comparable EditPlayerState where
|
|||||||
it ("should be " ++ show (expected^.epsMode)) $
|
it ("should be " ++ show (expected^.epsMode)) $
|
||||||
actual^.epsMode `shouldBe` expected^.epsMode
|
actual^.epsMode `shouldBe` expected^.epsMode
|
||||||
|
|
||||||
|
instance Comparable EditGoalieState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "egsSelectedGoalie" $
|
||||||
|
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
|
||||||
|
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
|
||||||
|
|
||||||
|
describe "egsMode" $
|
||||||
|
it ("should be " ++ show (expected^.egsMode)) $
|
||||||
|
actual^.egsMode `shouldBe` expected^.egsMode
|
||||||
|
|
||||||
instance Comparable CreateGoalieState where
|
instance Comparable CreateGoalieState where
|
||||||
compareTest actual expected = do
|
compareTest actual expected = do
|
||||||
|
|
||||||
@@ -819,3 +1000,8 @@ instance Comparable CreateGoalieState where
|
|||||||
describe "cgsName" $
|
describe "cgsName" $
|
||||||
it ("should be " ++ expected^.cgsName) $
|
it ("should be " ++ expected^.cgsName) $
|
||||||
actual^.cgsName `shouldBe` expected^.cgsName
|
actual^.cgsName `shouldBe` expected^.cgsName
|
||||||
|
|
||||||
|
instance Comparable EditStandingsMode where
|
||||||
|
compareTest actual expected =
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-
|
{-
|
||||||
|
|
||||||
mtlstats
|
mtlstats
|
||||||
Copyright (C) 2019 Rhéal Lamothe
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
<rheal.lamothe@gmail.com>
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
@@ -32,6 +32,7 @@ spec = describe "Mtlstats.Util" $ do
|
|||||||
modifyNthSpec
|
modifyNthSpec
|
||||||
updateMapSpec
|
updateMapSpec
|
||||||
sliceSpec
|
sliceSpec
|
||||||
|
capitalizeNameSpec
|
||||||
|
|
||||||
nthSpec :: Spec
|
nthSpec :: Spec
|
||||||
nthSpec = describe "nth" $ mapM_
|
nthSpec = describe "nth" $ mapM_
|
||||||
@@ -49,18 +50,19 @@ nthSpec = describe "nth" $ mapM_
|
|||||||
|
|
||||||
modifyNthSpec :: Spec
|
modifyNthSpec :: Spec
|
||||||
modifyNthSpec = describe "modifyNth" $ do
|
modifyNthSpec = describe "modifyNth" $ do
|
||||||
|
let list = [1, 2, 3] :: [Int]
|
||||||
|
|
||||||
context "in bounds" $
|
context "in bounds" $
|
||||||
it "should modify the value" $
|
it "should modify the value" $
|
||||||
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
|
modifyNth 1 succ list `shouldBe` [1, 3, 3]
|
||||||
|
|
||||||
context "out of bounds" $
|
context "out of bounds" $
|
||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
modifyNth 3 succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
context "negative index" $
|
context "negative index" $
|
||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
updateMapSpec :: Spec
|
updateMapSpec :: Spec
|
||||||
updateMapSpec = describe "updateMap" $ do
|
updateMapSpec = describe "updateMap" $ do
|
||||||
@@ -68,7 +70,7 @@ updateMapSpec = describe "updateMap" $ do
|
|||||||
input = M.fromList [(1, 2), (3, 5)]
|
input = M.fromList [(1, 2), (3, 5)]
|
||||||
|
|
||||||
context "key found" $ let
|
context "key found" $ let
|
||||||
expected = M.fromList [(1, 3), (3, 5)]
|
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
|
||||||
in it "should update the value" $
|
in it "should update the value" $
|
||||||
updateMap 1 10 succ input `shouldBe` expected
|
updateMap 1 10 succ input `shouldBe` expected
|
||||||
|
|
||||||
@@ -79,7 +81,7 @@ updateMapSpec = describe "updateMap" $ do
|
|||||||
|
|
||||||
sliceSpec :: Spec
|
sliceSpec :: Spec
|
||||||
sliceSpec = describe "slice" $ do
|
sliceSpec = describe "slice" $ do
|
||||||
let list = [2, 4, 6, 8]
|
let list = [2, 4, 6, 8] :: [Int]
|
||||||
|
|
||||||
context "sublist" $
|
context "sublist" $
|
||||||
it "should return the sublist" $
|
it "should return the sublist" $
|
||||||
@@ -92,3 +94,23 @@ sliceSpec = describe "slice" $ do
|
|||||||
context "negative offset" $
|
context "negative offset" $
|
||||||
it "should return the correct number of elements from the beginning" $
|
it "should return the correct number of elements from the beginning" $
|
||||||
slice (-10) 2 list `shouldBe` [2, 4]
|
slice (-10) 2 list `shouldBe` [2, 4]
|
||||||
|
|
||||||
|
capitalizeNameSpec :: Spec
|
||||||
|
capitalizeNameSpec = describe "capitalizeName" $ mapM_
|
||||||
|
(\(label, ch, str, expected) -> context label $
|
||||||
|
it ("should be " ++ expected) $
|
||||||
|
capitalizeName ch str `shouldBe` expected)
|
||||||
|
-- label, character, string, expected
|
||||||
|
[ ( "initial lower", 'a', "", "A" )
|
||||||
|
, ( "initial upper", 'A', "", "A" )
|
||||||
|
, ( "initial non-alpha", '0', "", "0" )
|
||||||
|
, ( "pre-comma lower", 'a', "A", "AA" )
|
||||||
|
, ( "pre-comma upper", 'A', "A", "AA" )
|
||||||
|
, ( "pre-comma non-alpha", '0', "A", "A0" )
|
||||||
|
, ( "post-comma first lower", 'a', "FOO, ", "FOO, A" )
|
||||||
|
, ( "post-comma first upper", 'A', "FOO, ", "FOO, A" )
|
||||||
|
, ( "post-comma first non-alpha", '0', "FOO, ", "FOO, 0" )
|
||||||
|
, ( "unrestricted upper", 'A', "FOO, A", "FOO, AA" )
|
||||||
|
, ( "unrestricted lower", 'a', "FOO, A", "FOO, Aa" )
|
||||||
|
, ( "unrestricted non-alpha", '0', "FOO, A", "FOO, A0" )
|
||||||
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user