Compare commits
227 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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 | ||
|
|
90d1dfb581 | ||
|
|
f48de6d53a | ||
|
|
405ca1c5c7 | ||
|
|
c6c461f584 | ||
|
|
4910200c96 | ||
|
|
d708bed77d | ||
|
|
7fd837863b | ||
|
|
2a9ff93642 | ||
|
|
76c0a85a50 | ||
|
|
2f767209bb | ||
|
|
43f3d9eb08 | ||
|
|
3f38160abd | ||
|
|
b0cf9a83a1 | ||
|
|
8e74764cab | ||
|
|
b2226c0ca4 | ||
|
|
4fab3ec285 | ||
|
|
a63d822f02 | ||
|
|
bf78062455 | ||
|
|
b57f12310b | ||
|
|
a07c8a0242 | ||
|
|
9840e5a90e | ||
|
|
c9b198d106 | ||
|
|
24b304047c | ||
|
|
4e9b3f635d | ||
|
|
fc31794ef4 | ||
|
|
5bf5a605aa | ||
|
|
911a61ba57 | ||
|
|
ece289d68d | ||
|
|
b2362d2f5f | ||
|
|
b3af06b53d | ||
|
|
0194f68996 | ||
|
|
5bb4e509b8 | ||
|
|
c26c0f54d1 | ||
|
|
5fd67f3802 | ||
|
|
cb4fc77dd6 | ||
|
|
20ee194035 | ||
|
|
8b1e93386a | ||
|
|
e754d887c5 | ||
|
|
b19f1386ec | ||
|
|
43c2f6191d | ||
|
|
6ec7566b2c | ||
|
|
db105d4348 | ||
|
|
eb96ce6152 | ||
|
|
ff541c2385 | ||
|
|
cb0b4f9d0b | ||
|
|
4fa707bc0f | ||
|
|
a6395ada9c | ||
|
|
1c692a21f0 | ||
|
|
12c8d0bdd6 | ||
|
|
7e19ee072f | ||
|
|
2926e28e34 | ||
|
|
d215f27f4f | ||
|
|
1e78ca6f40 | ||
|
|
faa214bf6d | ||
|
|
6c634cd366 | ||
|
|
8ef1c6917a | ||
|
|
28a29e2f64 | ||
|
|
c65bcbbca4 | ||
|
|
66a2a70bbe | ||
|
|
667cf34475 | ||
|
|
2d2ee61aae | ||
|
|
ed31ce5b1d | ||
|
|
0812ae3ddd | ||
|
|
ec914a38b1 | ||
|
|
a9b5ada114 | ||
|
|
67bb12920c | ||
|
|
e94bf59c81 | ||
|
|
ceb8132a13 | ||
|
|
09c63da8bf | ||
|
|
4519ba4732 | ||
|
|
24c1673fc9 | ||
|
|
2f0989fb35 | ||
|
|
2a94e99371 | ||
|
|
1782c0bc48 | ||
|
|
a234d8e802 | ||
|
|
6b30e27836 | ||
|
|
5677263750 | ||
|
|
4a113d06e1 | ||
|
|
121f79a8a2 | ||
|
|
ba968657d9 | ||
|
|
ef8f7f3fee | ||
|
|
c7849d3558 | ||
|
|
756d0997a8 | ||
|
|
569f009dcd | ||
|
|
cfe2969106 | ||
|
|
19e0242135 | ||
|
|
32f61ccc89 | ||
|
|
bfe568492d | ||
|
|
277ba9a9dd | ||
|
|
d338930800 | ||
|
|
363d0cb2d3 | ||
|
|
a91ed5afb3 | ||
|
|
db8bbd9786 | ||
|
|
c4f68bb29c | ||
|
|
e2c3b57749 | ||
|
|
3d1f6170f6 | ||
|
|
1a481ab49d | ||
|
|
afd2bac7b5 | ||
|
|
ffe9b7f87f | ||
|
|
e1a48afc5c | ||
|
|
1810434716 | ||
|
|
146e2e42a1 | ||
|
|
a9c036f876 | ||
|
|
0b249bcdae | ||
|
|
74fd4fe2fb | ||
|
|
5f53413ef7 |
28
ChangeLog.md
28
ChangeLog.md
@@ -1,5 +1,33 @@
|
|||||||
# Changelog for mtlstats
|
# Changelog for mtlstats
|
||||||
|
|
||||||
|
## 0.8.0
|
||||||
|
- Bugfix: removed quotation marks from goalie names in report
|
||||||
|
- Allow lower case player names
|
||||||
|
- Don't show players without points in game report
|
||||||
|
- Removed unnecessary goalie statistics from game report
|
||||||
|
- Fixed goalie average calculation
|
||||||
|
|
||||||
|
## 0.7.0
|
||||||
|
- Shortened views to fit within 25 lines
|
||||||
|
- Implemented goalie reports
|
||||||
|
|
||||||
|
## 0.6.0
|
||||||
|
- Generate lifetime statistics report
|
||||||
|
- Implemented goalie editing
|
||||||
|
- Reset game standings on new season
|
||||||
|
|
||||||
|
## 0.5.0
|
||||||
|
|
||||||
|
- Fixed player creation bug
|
||||||
|
- Prompt for goalie informaiton on game data entry
|
||||||
|
- Implemented player editing
|
||||||
|
|
||||||
|
## v0.4.0
|
||||||
|
|
||||||
|
- Record penalty minutes
|
||||||
|
- Calculate total game statistics
|
||||||
|
- Generate year-to-date statistics report
|
||||||
|
|
||||||
## v0.3.0
|
## v0.3.0
|
||||||
|
|
||||||
- Record goals and assists
|
- Record goals and assists
|
||||||
|
|||||||
12
package.yaml
12
package.yaml
@@ -1,5 +1,5 @@
|
|||||||
name: mtlstats
|
name: mtlstats
|
||||||
version: 0.3.0
|
version: 0.8.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
|
||||||
|
|
||||||
|
|||||||
@@ -24,25 +24,26 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Actions
|
module Mtlstats.Actions
|
||||||
( startNewSeason
|
( startNewSeason
|
||||||
, resetYtd
|
, resetYtd
|
||||||
|
, resetStandings
|
||||||
, startNewGame
|
, startNewGame
|
||||||
, addChar
|
, addChar
|
||||||
, removeChar
|
, removeChar
|
||||||
, overtimeCheck
|
|
||||||
, updateGameStats
|
|
||||||
, validateGameDate
|
|
||||||
, createPlayer
|
, createPlayer
|
||||||
|
, createGoalie
|
||||||
|
, editPlayer
|
||||||
|
, editGoalie
|
||||||
, addPlayer
|
, addPlayer
|
||||||
, recordGoalAssists
|
, addGoalie
|
||||||
, awardGoal
|
, resetCreatePlayerState
|
||||||
, awardAssist
|
, resetCreateGoalieState
|
||||||
, resetGoalData
|
, backHome
|
||||||
|
, scrollUp
|
||||||
|
, scrollDown
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.Trans.State (modify)
|
||||||
import qualified Data.Map as M
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time.Calendar (fromGregorianValid)
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
|
||||||
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
@@ -56,6 +57,12 @@ resetYtd
|
|||||||
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
||||||
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
||||||
|
|
||||||
|
-- | 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
|
||||||
@@ -72,75 +79,32 @@ 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
|
||||||
cb = modify $ progMode .~ MainMenu
|
callback = modify $ progMode .~ MainMenu
|
||||||
cps
|
cps = newCreatePlayerState
|
||||||
= newCreatePlayerState
|
& cpsSuccessCallback .~ callback
|
||||||
& cpsSuccessCallback .~ cb
|
& cpsFailureCallback .~ callback
|
||||||
& cpsFailureCallback .~ cb
|
|
||||||
in progMode .~ CreatePlayer cps
|
in progMode .~ CreatePlayer cps
|
||||||
|
|
||||||
|
-- | Starts goalie creation mode
|
||||||
|
createGoalie :: ProgState -> ProgState
|
||||||
|
createGoalie = let
|
||||||
|
callback = modify $ progMode .~ MainMenu
|
||||||
|
cgs = newCreateGoalieState
|
||||||
|
& cgsSuccessCallback .~ callback
|
||||||
|
& cgsFailureCallback .~ callback
|
||||||
|
in progMode .~ CreateGoalie cgs
|
||||||
|
|
||||||
|
-- | Starts the player editing process
|
||||||
|
editPlayer :: ProgState -> ProgState
|
||||||
|
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||||
|
|
||||||
|
-- | Starts the 'Goalie' editing process
|
||||||
|
editGoalie :: ProgState -> ProgState
|
||||||
|
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||||
|
|
||||||
-- | 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
|
||||||
@@ -153,60 +117,41 @@ addPlayer s = fromMaybe s $ do
|
|||||||
Just $ s & database.dbPlayers
|
Just $ s & database.dbPlayers
|
||||||
%~ (++[player])
|
%~ (++[player])
|
||||||
|
|
||||||
-- | Awards the goal and assists to the players
|
-- | Adds the entered goalie to the roster
|
||||||
recordGoalAssists :: ProgState -> ProgState
|
addGoalie :: ProgState -> ProgState
|
||||||
recordGoalAssists ps = fromMaybe ps $ do
|
addGoalie s = fromMaybe s $ do
|
||||||
let gs = ps^.progMode.gameStateL
|
let cgs = s^.progMode.createGoalieStateL
|
||||||
goalId <- gs^.goalBy
|
num <- cgs^.cgsNumber
|
||||||
let assistIds = gs^.assistsBy
|
let
|
||||||
Just $ ps
|
name = cgs^.cgsName
|
||||||
& awardGoal goalId
|
goalie = newGoalie num name
|
||||||
& (\s -> foldr awardAssist s assistIds)
|
Just $ s & database.dbGoalies
|
||||||
& progMode.gameStateL
|
%~ (++[goalie])
|
||||||
%~ (goalBy .~ Nothing)
|
|
||||||
. (assistsBy .~ [])
|
|
||||||
. (pointsAccounted %~ succ)
|
|
||||||
. (confirmGoalDataFlag .~ False)
|
|
||||||
|
|
||||||
-- | Awards a goal to a player
|
-- | Resets the 'CreatePlayerState' value
|
||||||
awardGoal
|
resetCreatePlayerState :: ProgState -> ProgState
|
||||||
:: Int
|
resetCreatePlayerState = progMode.createPlayerStateL
|
||||||
-- ^ The player's index number
|
%~ (cpsNumber .~ Nothing)
|
||||||
-> ProgState
|
. (cpsName .~ "")
|
||||||
-> ProgState
|
. (cpsPosition .~ "")
|
||||||
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
|
-- | Resets the 'CreateGoalieState' value
|
||||||
awardAssist
|
resetCreateGoalieState :: ProgState -> ProgState
|
||||||
:: Int
|
resetCreateGoalieState = progMode.createGoalieStateL
|
||||||
-- ^ The player's index number
|
%~ (cgsNumber .~ Nothing)
|
||||||
-> ProgState
|
. (cgsName .~ "")
|
||||||
-> 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
|
-- | Resets the program state back to the main menu
|
||||||
resetGoalData :: ProgState -> ProgState
|
backHome :: ProgState -> ProgState
|
||||||
resetGoalData ps = ps & progMode.gameStateL
|
backHome
|
||||||
%~ (goalBy .~ Nothing)
|
= (progMode .~ MainMenu)
|
||||||
. (assistsBy .~ [])
|
. (inputBuffer .~ "")
|
||||||
. (confirmGoalDataFlag .~ False)
|
. (scrollOffset .~ 0)
|
||||||
|
|
||||||
|
-- | Scrolls the display up
|
||||||
|
scrollUp :: ProgState -> ProgState
|
||||||
|
scrollUp = scrollOffset %~ max 0 . pred
|
||||||
|
|
||||||
|
-- | Scrolls the display down
|
||||||
|
scrollDown :: ProgState -> ProgState
|
||||||
|
scrollDown = scrollOffset %~ succ
|
||||||
|
|||||||
164
src/Mtlstats/Actions/EditGoalie.hs
Normal file
164
src/Mtlstats/Actions/EditGoalie.hs
Normal file
@@ -0,0 +1,164 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Actions.EditGoalie
|
||||||
|
( editGoalieNumber
|
||||||
|
, editGoalieName
|
||||||
|
, editGoalieYtdGames
|
||||||
|
, editGoalieYtdMins
|
||||||
|
, editGoalieYtdGoals
|
||||||
|
, editGoalieYtdWins
|
||||||
|
, editGoalieYtdLosses
|
||||||
|
, editGoalieYtdTies
|
||||||
|
, editGoalieLtGames
|
||||||
|
, editGoalieLtMins
|
||||||
|
, editGoalieLtGoals
|
||||||
|
, editGoalieLtWins
|
||||||
|
, editGoalieLtLosses
|
||||||
|
, editGoalieLtTies
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Edits a goalie's number
|
||||||
|
editGoalieNumber
|
||||||
|
:: Int
|
||||||
|
-- ^ New goalie number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
|
||||||
|
|
||||||
|
-- | Edits a goalie's name
|
||||||
|
editGoalieName
|
||||||
|
:: String
|
||||||
|
-- ^ The new name
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieName name = editGoalie (gName .~ name) EGMenu
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD games
|
||||||
|
editGoalieYtdGames
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of games played
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD minutes
|
||||||
|
editGoalieYtdMins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of minutes played
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD goals allowed
|
||||||
|
editGoalieYtdGoals
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of goals
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD wins
|
||||||
|
editGoalieYtdWins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of wins
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD losses
|
||||||
|
editGoalieYtdLosses
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of losses
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's YTD ties
|
||||||
|
editGoalieYtdTies
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of ties
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime games played
|
||||||
|
editGoalieLtGames
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of games
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime minutes played
|
||||||
|
editGoalieLtMins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of minutes
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime goals allowed
|
||||||
|
editGoalieLtGoals
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of goals
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime wins
|
||||||
|
editGoalieLtWins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of wins
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime losses
|
||||||
|
editGoalieLtLosses
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of losses
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
|
||||||
|
|
||||||
|
-- | Edits a goalie's lifetime ties
|
||||||
|
editGoalieLtTies
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of ties
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
|
||||||
|
|
||||||
|
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
|
||||||
|
editGoalie f mode s = fromMaybe s $ do
|
||||||
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
void $ nth gid $ s^.database.dbGoalies
|
||||||
|
Just $ s
|
||||||
|
& database.dbGoalies %~ modifyNth gid f
|
||||||
|
& progMode.editGoalieStateL.egsMode .~ mode
|
||||||
191
src/Mtlstats/Actions/NewGame.hs
Normal file
191
src/Mtlstats/Actions/NewGame.hs
Normal file
@@ -0,0 +1,191 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Actions.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)
|
||||||
109
src/Mtlstats/Actions/NewGame/GoalieInput.hs
Normal file
109
src/Mtlstats/Actions/NewGame/GoalieInput.hs
Normal file
@@ -0,0 +1,109 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Actions.NewGame.GoalieInput
|
||||||
|
( finishGoalieEntry
|
||||||
|
, recordGoalieStats
|
||||||
|
, setGameGoalie
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
||||||
|
|
||||||
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Attempts to finish game goalie entry
|
||||||
|
finishGoalieEntry :: ProgState -> ProgState
|
||||||
|
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
|
||||||
|
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
|
||||||
|
|
||||||
|
-- | Records the goalie's game stats
|
||||||
|
recordGoalieStats :: ProgState -> ProgState
|
||||||
|
recordGoalieStats s = fromMaybe s $ do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
gid <- gs^.gameSelectedGoalie
|
||||||
|
mins <- gs^.gameGoalieMinsPlayed
|
||||||
|
goals <- gs^.gameGoalsAllowed
|
||||||
|
void $ nth gid $ s^.database.dbGoalies
|
||||||
|
|
||||||
|
let
|
||||||
|
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
||||||
|
bumpVal = if gameStats^.gsGames == 0
|
||||||
|
then 1
|
||||||
|
else 0
|
||||||
|
|
||||||
|
bumpStats
|
||||||
|
= (gsGames +~ bumpVal)
|
||||||
|
. (gsMinsPlayed +~ mins)
|
||||||
|
. (gsGoalsAllowed +~ goals)
|
||||||
|
|
||||||
|
tryFinish = if mins >= gameLength
|
||||||
|
then finishGoalieEntry
|
||||||
|
else id
|
||||||
|
|
||||||
|
Just $ s
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats)
|
||||||
|
. (gameSelectedGoalie .~ Nothing)
|
||||||
|
. (gameGoalieMinsPlayed .~ Nothing)
|
||||||
|
. (gameGoalsAllowed .~ Nothing)
|
||||||
|
& database.dbGoalies
|
||||||
|
%~ modifyNth gid (\goalie -> goalie
|
||||||
|
& gYtd %~ bumpStats
|
||||||
|
& gLifetime %~ bumpStats)
|
||||||
|
& tryFinish
|
||||||
|
|
||||||
|
-- | Records the win, loss, or tie to a specific 'Goalie'
|
||||||
|
setGameGoalie
|
||||||
|
:: Int
|
||||||
|
-- ^ The goalie's index
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
setGameGoalie gid s = fromMaybe s $ do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
won <- gameWon gs
|
||||||
|
lost <- gameLost gs
|
||||||
|
tied <- gs^.overtimeFlag
|
||||||
|
let
|
||||||
|
w = if won then 1 else 0
|
||||||
|
l = if lost then 1 else 0
|
||||||
|
t = if tied then 1 else 0
|
||||||
|
|
||||||
|
updateStats
|
||||||
|
= (gsWins +~ w)
|
||||||
|
. (gsLosses +~ l)
|
||||||
|
. (gsTies +~ t)
|
||||||
|
|
||||||
|
updateGoalie
|
||||||
|
= (gYtd %~ updateStats)
|
||||||
|
. (gLifetime %~ updateStats)
|
||||||
|
|
||||||
|
updateGameState
|
||||||
|
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
|
||||||
|
. (gameGoalieAssigned .~ True)
|
||||||
|
|
||||||
|
Just $ s
|
||||||
|
& database.dbGoalies %~ modifyNth gid updateGoalie
|
||||||
|
& progMode.gameStateL %~ updateGameState
|
||||||
@@ -40,3 +40,7 @@ dbFname = "database.json"
|
|||||||
-- | The maximum number of assists
|
-- | The maximum number of assists
|
||||||
maxAssists :: Int
|
maxAssists :: Int
|
||||||
maxAssists = 2
|
maxAssists = 2
|
||||||
|
|
||||||
|
-- | The length of a typical game (in minutes)
|
||||||
|
gameLength :: Int
|
||||||
|
gameLength = 60
|
||||||
|
|||||||
@@ -21,22 +21,21 @@ 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.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (toUpper)
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
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.Format
|
import Mtlstats.Control.EditGoalie
|
||||||
|
import Mtlstats.Control.EditPlayer
|
||||||
|
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
|
||||||
@@ -44,23 +43,18 @@ dispatch :: ProgState -> Controller
|
|||||||
dispatch s = case s^.progMode of
|
dispatch s = case s^.progMode of
|
||||||
MainMenu -> mainMenuC
|
MainMenu -> mainMenuC
|
||||||
NewSeason -> newSeasonC
|
NewSeason -> newSeasonC
|
||||||
NewGame gs
|
NewGame gs -> 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
|
|
||||||
| otherwise -> reportC
|
|
||||||
CreatePlayer cps
|
CreatePlayer cps
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
| null $ cps^.cpsName -> getPlayerNameC
|
||||||
| null $ cps^.cpsPosition -> getPlayerPosC
|
| null $ cps^.cpsPosition -> getPlayerPosC
|
||||||
| otherwise -> confirmCreatePlayerC
|
| otherwise -> confirmCreatePlayerC
|
||||||
|
CreateGoalie cgs
|
||||||
|
| null $ cgs^.cgsNumber -> getGoalieNumC
|
||||||
|
| null $ cgs^.cgsName -> getGoalieNameC
|
||||||
|
| otherwise -> confirmCreateGoalieC
|
||||||
|
EditPlayer eps -> editPlayerC eps
|
||||||
|
EditGoalie egs -> editGoalieC egs
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: Controller
|
||||||
mainMenuC = Controller
|
mainMenuC = Controller
|
||||||
@@ -76,191 +70,6 @@ newSeasonC = Controller
|
|||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
gameYearC :: Controller
|
|
||||||
gameYearC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameYearPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameYearPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameMonthC :: Controller
|
|
||||||
gameMonthC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameMonthMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameMonthMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameDayC :: Controller
|
|
||||||
gameDayC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameDayPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameDayPrompt e
|
|
||||||
modify validateGameDate
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameTypeC :: Controller
|
|
||||||
gameTypeC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameTypeMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameTypeMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
otherTeamC :: Controller
|
|
||||||
otherTeamC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt otherTeamPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler otherTeamPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
homeScoreC :: Controller
|
|
||||||
homeScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt homeScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler homeScorePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
awayScoreC :: Controller
|
|
||||||
awayScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt awayScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler awayScorePrompt e
|
|
||||||
modify overtimeCheck
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
overtimeFlagC :: Controller
|
|
||||||
overtimeFlagC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
C.drawString "Did the game go into overtime? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
verifyDataC :: Controller
|
|
||||||
verifyDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let gs = s^.progMode.gameStateL
|
|
||||||
header s
|
|
||||||
C.drawString "\n"
|
|
||||||
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
|
||||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
|
||||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
|
||||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
|
||||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
|
||||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
|
||||||
C.drawString "Is the above information correct? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify $ progMode.gameStateL.dataVerified .~ True
|
|
||||||
modify updateGameStats
|
|
||||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
goalInput :: GameState -> Controller
|
|
||||||
goalInput gs
|
|
||||||
| null (gs^.goalBy ) = recordGoalC
|
|
||||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
|
||||||
| otherwise = confirmGoalDataC
|
|
||||||
|
|
||||||
recordGoalC :: Controller
|
|
||||||
recordGoalC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
in drawPrompt (recordGoalPrompt game goal) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal) <- gets gameGoal
|
|
||||||
promptHandler (recordGoalPrompt game goal) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
recordAssistC :: Controller
|
|
||||||
recordAssistC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal, assist) = gameGoalAssist s
|
|
||||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal, assist) <- gets gameGoalAssist
|
|
||||||
promptHandler (recordAssistPrompt game goal assist) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmGoalDataC :: Controller
|
|
||||||
confirmGoalDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
gs = s^.progMode.gameStateL
|
|
||||||
players = s^.database.dbPlayers
|
|
||||||
msg = unlines $
|
|
||||||
[ " Game: " ++ padNum 2 game
|
|
||||||
, " Goal: " ++ show goal
|
|
||||||
, "Goal scored by: " ++
|
|
||||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
|
||||||
] ++
|
|
||||||
map
|
|
||||||
(\pid -> " Assisted by: " ++
|
|
||||||
playerSummary (fromJust $ nth pid players))
|
|
||||||
(gs^.assistsBy) ++
|
|
||||||
[ ""
|
|
||||||
, "Is the above information correct? (Y/N)"
|
|
||||||
]
|
|
||||||
C.drawString msg
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> modify recordGoalAssists
|
|
||||||
Just False -> modify resetGoalData
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
reportC :: Controller
|
|
||||||
reportC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
(_, cols) <- C.windowSize
|
|
||||||
C.drawString $ report (fromInteger $ pred cols) s
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
when
|
|
||||||
(case e of
|
|
||||||
C.EventCharacter _ -> True
|
|
||||||
C.EventSpecialKey _ -> True
|
|
||||||
_ -> False) $
|
|
||||||
modify $ progMode .~ MainMenu
|
|
||||||
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
|
||||||
{ drawController = drawPrompt playerNumPrompt
|
{ drawController = drawPrompt playerNumPrompt
|
||||||
@@ -305,14 +114,40 @@ confirmCreatePlayerC = Controller
|
|||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
gameGoal :: ProgState -> (Int, Int)
|
getGoalieNumC :: Controller
|
||||||
gameGoal s =
|
getGoalieNumC = Controller
|
||||||
( s^.database.dbGames
|
{ drawController = drawPrompt goalieNumPrompt
|
||||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
, handleController = \e -> do
|
||||||
)
|
promptHandler goalieNumPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
getGoalieNameC :: Controller
|
||||||
gameGoalAssist s = let
|
getGoalieNameC = Controller
|
||||||
(game, goal) = gameGoal s
|
{ drawController = drawPrompt goalieNamePrompt
|
||||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
, handleController = \e -> do
|
||||||
in (game, goal, assist)
|
promptHandler goalieNamePrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmCreateGoalieC :: Controller
|
||||||
|
confirmCreateGoalieC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let cgs = s^.progMode.createGoalieStateL
|
||||||
|
C.drawString $ unlines
|
||||||
|
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
|
||||||
|
, " Goalie name: " ++ cgs^.cgsName
|
||||||
|
, ""
|
||||||
|
, "Create goalie: are you sure? (Y/N)"
|
||||||
|
]
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
modify addGoalie
|
||||||
|
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
|
||||||
|
Just False ->
|
||||||
|
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|||||||
122
src/Mtlstats/Control/EditGoalie.hs
Normal file
122
src/Mtlstats/Control/EditGoalie.hs
Normal file
@@ -0,0 +1,122 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# 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 -> ytdGamesC
|
||||||
|
EGYtdMins -> ytdMinsC
|
||||||
|
EGYtdGoals -> ytdGoalsC
|
||||||
|
EGYtdWins -> ytdWinsC
|
||||||
|
EGYtdLosses -> ytdLossesC
|
||||||
|
EGYtdTies -> ytdTiesC
|
||||||
|
EGLtGames -> ltGamesC
|
||||||
|
EGLtMins -> ltMinsC
|
||||||
|
EGLtGoals -> ltGoalsC
|
||||||
|
EGLtWins -> ltWinsC
|
||||||
|
EGLtLosses -> ltLossesC
|
||||||
|
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 :: Controller
|
||||||
|
ytdGamesC = promptController editGoalieYtdGamesPrompt
|
||||||
|
|
||||||
|
ytdMinsC :: Controller
|
||||||
|
ytdMinsC = promptController editGoalieYtdMinsPrompt
|
||||||
|
|
||||||
|
ytdGoalsC :: Controller
|
||||||
|
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
|
||||||
|
|
||||||
|
ytdWinsC :: Controller
|
||||||
|
ytdWinsC = promptController editGoalieYtdWinsPrompt
|
||||||
|
|
||||||
|
ytdLossesC :: Controller
|
||||||
|
ytdLossesC = promptController editGoalieYtdLossesPrompt
|
||||||
|
|
||||||
|
ytdTiesC :: Controller
|
||||||
|
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
||||||
|
|
||||||
|
ltGamesC :: Controller
|
||||||
|
ltGamesC = promptController editGoalieLtGamesPrompt
|
||||||
|
|
||||||
|
ltMinsC :: Controller
|
||||||
|
ltMinsC = promptController editGoalieLtMinsPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Controller
|
||||||
|
ltGoalsC = promptController editGoalieLtGoalsPrompt
|
||||||
|
|
||||||
|
ltWinsC :: Controller
|
||||||
|
ltWinsC = promptController editGoalieLtWinsPrompt
|
||||||
|
|
||||||
|
ltLossesC :: 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"
|
||||||
97
src/Mtlstats/Control/EditPlayer.hs
Normal file
97
src/Mtlstats/Control/EditPlayer.hs
Normal file
@@ -0,0 +1,97 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Player
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Menu.EditPlayer
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.EditPlayer
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Dispatcher/controller for the player edit mode
|
||||||
|
editPlayerC :: EditPlayerState -> Controller
|
||||||
|
editPlayerC eps
|
||||||
|
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
||||||
|
| otherwise = case eps^.epsMode of
|
||||||
|
EPMenu -> menuC
|
||||||
|
EPNumber -> numberC
|
||||||
|
EPName -> nameC
|
||||||
|
EPPosition -> positionC
|
||||||
|
EPYtd -> ytdC
|
||||||
|
EPLifetime -> lifetimeC
|
||||||
|
EPYtdGoals -> ytdGoalsC
|
||||||
|
EPYtdAssists -> ytdAssistsC
|
||||||
|
EPYtdPMin -> ytdPMinC
|
||||||
|
EPLtGoals -> ltGoalsC
|
||||||
|
EPLtAssists -> ltAssistsC
|
||||||
|
EPLtPMin -> ltPMinC
|
||||||
|
|
||||||
|
selectPlayerC :: Controller
|
||||||
|
selectPlayerC = promptController playerToEditPrompt
|
||||||
|
|
||||||
|
menuC :: Controller
|
||||||
|
menuC = menuControllerWith header editPlayerMenu
|
||||||
|
|
||||||
|
numberC :: Controller
|
||||||
|
numberC = promptController editPlayerNumPrompt
|
||||||
|
|
||||||
|
nameC :: Controller
|
||||||
|
nameC = promptController editPlayerNamePrompt
|
||||||
|
|
||||||
|
positionC :: Controller
|
||||||
|
positionC = promptController editPlayerPosPrompt
|
||||||
|
|
||||||
|
ytdC :: Controller
|
||||||
|
ytdC = menuControllerWith header editPlayerYtdMenu
|
||||||
|
|
||||||
|
lifetimeC :: Controller
|
||||||
|
lifetimeC = menuControllerWith header editPlayerLtMenu
|
||||||
|
|
||||||
|
ytdGoalsC :: Controller
|
||||||
|
ytdGoalsC = promptController editPlayerYtdGoalsPrompt
|
||||||
|
|
||||||
|
ytdAssistsC :: Controller
|
||||||
|
ytdAssistsC = promptController editPlayerYtdAssistsPrompt
|
||||||
|
|
||||||
|
ytdPMinC :: Controller
|
||||||
|
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Controller
|
||||||
|
ltGoalsC = promptController editPlayerLtGoalsPrompt
|
||||||
|
|
||||||
|
ltAssistsC :: Controller
|
||||||
|
ltAssistsC = promptController editPlayerLtAssistsPrompt
|
||||||
|
|
||||||
|
ltPMinC :: Controller
|
||||||
|
ltPMinC = promptController editPlayerLtPMinPrompt
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
|
Just $ playerDetails player ++ "\n"
|
||||||
234
src/Mtlstats/Control/NewGame.hs
Normal file
234
src/Mtlstats/Control/NewGame.hs
Normal file
@@ -0,0 +1,234 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.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)
|
||||||
62
src/Mtlstats/Control/NewGame/GoalieInput.hs
Normal file
62
src/Mtlstats/Control/NewGame/GoalieInput.hs
Normal file
@@ -0,0 +1,62 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | The dispatcher for handling goalie input
|
||||||
|
goalieInputC :: GameState -> Controller
|
||||||
|
goalieInputC gs
|
||||||
|
| gs^.gameGoaliesRecorded = selectGameGoalieC
|
||||||
|
| null $ gs^.gameSelectedGoalie = selectGoalieC
|
||||||
|
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
|
||||||
|
| otherwise = goalsAllowedC
|
||||||
|
|
||||||
|
selectGoalieC :: Controller
|
||||||
|
selectGoalieC = promptController selectGameGoaliePrompt
|
||||||
|
|
||||||
|
minsPlayedC :: Controller
|
||||||
|
minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
|
||||||
|
|
||||||
|
goalsAllowedC :: Controller
|
||||||
|
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
||||||
|
|
||||||
|
selectGameGoalieC :: Controller
|
||||||
|
selectGameGoalieC = menuStateController gameGoalieMenu
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $ unlines
|
||||||
|
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
|
||||||
|
, fromMaybe "" $ do
|
||||||
|
n <- s^.progMode.gameStateL.gameSelectedGoalie
|
||||||
|
g <- nth n $ s^.database.dbGoalies
|
||||||
|
Just $ goalieSummary g
|
||||||
|
]
|
||||||
@@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Format
|
module Mtlstats.Format
|
||||||
( padNum
|
( padNum
|
||||||
, left
|
, left
|
||||||
@@ -26,8 +28,18 @@ module Mtlstats.Format
|
|||||||
, centre
|
, centre
|
||||||
, 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
|
||||||
@@ -101,3 +113,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
|
||||||
|
|||||||
47
src/Mtlstats/Helpers/Goalie.hs
Normal file
47
src/Mtlstats/Helpers/Goalie.hs
Normal file
@@ -0,0 +1,47 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Helpers.Goalie (goalieDetails) 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", g^.gName )
|
||||||
|
]
|
||||||
|
|
||||||
|
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
||||||
|
(\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
|
||||||
|
[ ( "Games played", gsGames )
|
||||||
|
, ( "Mins played", gsMinsPlayed )
|
||||||
|
, ( "Goals allowed", gsGoalsAllowed )
|
||||||
|
, ( "Wins", gsWins )
|
||||||
|
, ( "Losses", gsLosses )
|
||||||
|
, ( "Ties", gsTies )
|
||||||
|
]
|
||||||
|
|
||||||
|
in header ++ "\n" ++ body
|
||||||
45
src/Mtlstats/Helpers/Player.hs
Normal file
45
src/Mtlstats/Helpers/Player.hs
Normal file
@@ -0,0 +1,45 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Helpers.Player (playerDetails) 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", p^.pName )
|
||||||
|
, ( "Position", p^.pPosition )
|
||||||
|
]
|
||||||
|
|
||||||
|
table = numTable ["YTD", "Lifetime"] $ map
|
||||||
|
(\(label, lens) ->
|
||||||
|
(label, [p^.pYtd.lens, p^.pLifetime.lens]))
|
||||||
|
[ ( "Goals", psGoals )
|
||||||
|
, ( "Assists", psAssists )
|
||||||
|
, ( "Penalty mins", psPMin )
|
||||||
|
]
|
||||||
@@ -21,20 +21,26 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Menu (
|
module Mtlstats.Menu (
|
||||||
-- * Menu Functions
|
-- * Menu Functions
|
||||||
|
menuController,
|
||||||
|
menuControllerWith,
|
||||||
|
menuStateController,
|
||||||
drawMenu,
|
drawMenu,
|
||||||
menuHandler,
|
menuHandler,
|
||||||
-- * Menus
|
-- * Menus
|
||||||
mainMenu,
|
mainMenu,
|
||||||
newSeasonMenu,
|
newSeasonMenu,
|
||||||
gameMonthMenu,
|
gameMonthMenu,
|
||||||
gameTypeMenu
|
gameTypeMenu,
|
||||||
|
gameGoalieMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
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.Aeson (encodeFile)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (mapMaybe)
|
||||||
|
import Lens.Micro ((^.), (?~))
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import System.EasyFile
|
import System.EasyFile
|
||||||
( createDirectoryIfMissing
|
( createDirectoryIfMissing
|
||||||
@@ -44,9 +50,47 @@ import System.EasyFile
|
|||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Generates a simple 'Controller' for a Menu
|
||||||
|
menuController :: Menu () -> Controller
|
||||||
|
menuController = menuControllerWith $ const $ return ()
|
||||||
|
|
||||||
|
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||||
|
menuControllerWith
|
||||||
|
:: (ProgState -> C.Update ())
|
||||||
|
-- ^ Generates the header
|
||||||
|
-> Menu ()
|
||||||
|
-- ^ The menu
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
menuControllerWith header menu = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawMenu menu
|
||||||
|
, handleController = \e -> do
|
||||||
|
menuHandler menu e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Generate and create a controller for a menu based on the current
|
||||||
|
-- 'ProgState'
|
||||||
|
menuStateController
|
||||||
|
:: (ProgState -> Menu ())
|
||||||
|
-- ^ The function to generate the menu
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
menuStateController menuFunc = Controller
|
||||||
|
{ drawController = drawMenu . menuFunc
|
||||||
|
, handleController = \e -> do
|
||||||
|
menu <- gets menuFunc
|
||||||
|
menuHandler menu e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
-- | The draw function for a 'Menu'
|
-- | The draw function for a 'Menu'
|
||||||
drawMenu :: Menu a -> C.Update C.CursorMode
|
drawMenu :: Menu a -> C.Update C.CursorMode
|
||||||
@@ -71,7 +115,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
|||||||
modify startNewGame >> return True
|
modify startNewGame >> return True
|
||||||
, MenuItem '3' "Create Player" $
|
, MenuItem '3' "Create Player" $
|
||||||
modify createPlayer >> return True
|
modify createPlayer >> return True
|
||||||
, MenuItem '4' "Exit" $ do
|
, MenuItem '4' "Create Goalie" $
|
||||||
|
modify createGoalie >> return True
|
||||||
|
, MenuItem '5' "Edit Player" $
|
||||||
|
modify editPlayer >> return True
|
||||||
|
, MenuItem '6' "Edit Goalie" $
|
||||||
|
modify editGoalie >> return True
|
||||||
|
, MenuItem 'X' "Exit" $ do
|
||||||
db <- gets $ view database
|
db <- gets $ view database
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
dir <- getAppUserDataDirectory appName
|
dir <- getAppUserDataDirectory appName
|
||||||
@@ -84,11 +134,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
|||||||
-- | 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
|
. resetStandings
|
||||||
, MenuItem '2' "Playoffs" $
|
. startNewGame
|
||||||
modify 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
|
||||||
@@ -119,3 +171,18 @@ gameTypeMenu = Menu "Game type:" ()
|
|||||||
, MenuItem '2' "Away Game" $
|
, MenuItem '2' "Away Game" $
|
||||||
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | Game goalie selection menu
|
||||||
|
gameGoalieMenu :: ProgState -> Menu ()
|
||||||
|
gameGoalieMenu s = let
|
||||||
|
title = "Which goalie should get credit for the game?"
|
||||||
|
gids = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats
|
||||||
|
goalies = mapMaybe
|
||||||
|
(\n -> do
|
||||||
|
goalie <- nth n $ s^.database.dbGoalies
|
||||||
|
Just (n, goalie))
|
||||||
|
gids
|
||||||
|
in Menu title () $ map
|
||||||
|
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
||||||
|
modify $ GI.setGameGoalie gid) $
|
||||||
|
zip ['1'..] goalies
|
||||||
|
|||||||
80
src/Mtlstats/Menu/EditGoalie.hs
Normal file
80
src/Mtlstats/Menu/EditGoalie.hs
Normal file
@@ -0,0 +1,80 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Menu.EditGoalie
|
||||||
|
( editGoalieMenu
|
||||||
|
, editGoalieYtdMenu
|
||||||
|
, editGoalieLtMenu
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Data.Maybe (maybe)
|
||||||
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
-- | The 'Goalie' edit menu
|
||||||
|
editGoalieMenu :: Menu ()
|
||||||
|
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
|
||||||
|
(\(key, label, val) -> MenuItem key label $ modify $ maybe
|
||||||
|
(progMode .~ MainMenu)
|
||||||
|
(progMode.editGoalieStateL.egsMode .~)
|
||||||
|
val)
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit number", Just EGNumber )
|
||||||
|
, ( '2', "Edit name", Just EGName )
|
||||||
|
, ( '3', "Edit YTD stats", Just EGYtd )
|
||||||
|
, ( '4', "Edit Lifetime stats", Just EGLifetime )
|
||||||
|
, ( 'R', "Return to Main Menu", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Goalie' YTD edit menu
|
||||||
|
editGoalieYtdMenu :: Menu ()
|
||||||
|
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit YTD games", EGYtdGames )
|
||||||
|
, ( '2', "Edit YTD minutes", EGYtdMins )
|
||||||
|
, ( '3', "Edit YTD goals", EGYtdGoals )
|
||||||
|
, ( '4', "Edit YTD wins", EGYtdWins )
|
||||||
|
, ( '5', "Edit YTD losses", EGYtdLosses )
|
||||||
|
, ( '6', "Edit YTD ties", EGYtdTies )
|
||||||
|
, ( 'R', "Return to edit menu", EGMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Goalie' lifetime edit menu
|
||||||
|
editGoalieLtMenu :: Menu ()
|
||||||
|
editGoalieLtMenu = editMenu
|
||||||
|
"*** EDIT GOALTENDER LIFETIME ***"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit lifetime games", EGLtGames )
|
||||||
|
, ( '2', "Edit lifetime minutes", EGLtMins )
|
||||||
|
, ( '3', "Edit lifetime goals", EGLtGoals )
|
||||||
|
, ( '4', "Edit lifetime wins", EGLtWins )
|
||||||
|
, ( '5', "Edit lifetime losses", EGLtLosses )
|
||||||
|
, ( '6', "Edit lifetime ties", EGLtTies )
|
||||||
|
, ( 'R', "Return to edit menu", EGMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||||
|
editMenu title = Menu title () . map
|
||||||
|
(\(key, label, val) -> MenuItem key label $
|
||||||
|
modify $ progMode.editGoalieStateL.egsMode .~ val)
|
||||||
74
src/Mtlstats/Menu/EditPlayer.hs
Normal file
74
src/Mtlstats/Menu/EditPlayer.hs
Normal file
@@ -0,0 +1,74 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Menu.EditPlayer
|
||||||
|
( editPlayerMenu
|
||||||
|
, editPlayerYtdMenu
|
||||||
|
, editPlayerLtMenu
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
-- | 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)
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit number", Just EPNumber )
|
||||||
|
, ( '2', "Edit name", Just EPName )
|
||||||
|
, ( '3', "Edit position", Just EPPosition )
|
||||||
|
, ( '4', "Edit YTD stats", Just EPYtd )
|
||||||
|
, ( '5', "Edit lifetime stats", Just EPLifetime )
|
||||||
|
, ( 'R', "Finished editing", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Player' YTD stats edit menu
|
||||||
|
editPlayerYtdMenu :: Menu ()
|
||||||
|
editPlayerYtdMenu = editMenu
|
||||||
|
"*** EDIT PLAYER YEAR-TO-DATE ***"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit YTD goals", EPYtdGoals )
|
||||||
|
, ( '2', "Edit YTD assists", EPYtdAssists )
|
||||||
|
, ( '3', "Edit YTD penalty mins", EPYtdPMin )
|
||||||
|
, ( 'R', "Return to player edit menu", EPMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | The 'Player' lifetime stats edit menu
|
||||||
|
editPlayerLtMenu :: Menu ()
|
||||||
|
editPlayerLtMenu = editMenu
|
||||||
|
"*** EDIT PLAYER LIFETIME ***"
|
||||||
|
-- key, label, value
|
||||||
|
[ ( '1', "Edit lifetime goals", EPLtGoals )
|
||||||
|
, ( '2', "Edit lifetime assits", EPLtAssists )
|
||||||
|
, ( '3', "Edit lifetime penalty mins", EPLtPMin )
|
||||||
|
, ( 'R', "Return to edit player menu", EPMenu )
|
||||||
|
]
|
||||||
|
|
||||||
|
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
||||||
|
editMenu title = Menu title () . map
|
||||||
|
(\(key, label, val) -> MenuItem key label $
|
||||||
|
modify $ progMode.editPlayerStateL.epsMode .~ val)
|
||||||
@@ -25,23 +25,25 @@ module Mtlstats.Prompt (
|
|||||||
-- * Prompt Functions
|
-- * Prompt Functions
|
||||||
drawPrompt,
|
drawPrompt,
|
||||||
promptHandler,
|
promptHandler,
|
||||||
|
promptControllerWith,
|
||||||
|
promptController,
|
||||||
strPrompt,
|
strPrompt,
|
||||||
|
ucStrPrompt,
|
||||||
numPrompt,
|
numPrompt,
|
||||||
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
gameYearPrompt,
|
|
||||||
gameDayPrompt,
|
|
||||||
otherTeamPrompt,
|
|
||||||
homeScorePrompt,
|
|
||||||
awayScorePrompt,
|
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
playerPosPrompt,
|
playerPosPrompt,
|
||||||
|
goalieNumPrompt,
|
||||||
|
goalieNamePrompt,
|
||||||
selectPlayerPrompt,
|
selectPlayerPrompt,
|
||||||
recordGoalPrompt,
|
selectGoaliePrompt,
|
||||||
recordAssistPrompt
|
playerToEditPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
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 (isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
@@ -52,7 +54,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
|
||||||
|
|
||||||
@@ -68,16 +69,39 @@ 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) =
|
||||||
promptSpecialKey p k
|
promptSpecialKey p k
|
||||||
promptHandler _ _ = return ()
|
promptHandler _ _ = return ()
|
||||||
|
|
||||||
|
-- | Builds a controller out of a prompt with a header
|
||||||
|
promptControllerWith
|
||||||
|
:: (ProgState -> C.Update ())
|
||||||
|
-- ^ The header
|
||||||
|
-> Prompt
|
||||||
|
-- ^ The prompt to use
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
promptControllerWith header prompt = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt prompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler prompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Builds a controller out of a prompt
|
||||||
|
promptController
|
||||||
|
:: Prompt
|
||||||
|
-- ^ The prompt to use
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
promptController = promptControllerWith (const $ return ())
|
||||||
|
|
||||||
-- | Builds a string prompt
|
-- | Builds a string prompt
|
||||||
strPrompt
|
strPrompt
|
||||||
:: String
|
:: String
|
||||||
@@ -87,11 +111,21 @@ strPrompt
|
|||||||
-> 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]) }
|
||||||
|
|
||||||
-- | Builds a numeric prompt
|
-- | Builds a numeric prompt
|
||||||
numPrompt
|
numPrompt
|
||||||
:: String
|
:: String
|
||||||
@@ -101,35 +135,49 @@ numPrompt
|
|||||||
-> Prompt
|
-> Prompt
|
||||||
numPrompt pStr act = Prompt
|
numPrompt pStr act = Prompt
|
||||||
{ promptDrawer = drawSimplePrompt pStr
|
{ promptDrawer = drawSimplePrompt pStr
|
||||||
, promptCharCheck = isDigit
|
, promptProcessChar = \ch str -> if isDigit ch
|
||||||
|
then str ++ [ch]
|
||||||
|
else str
|
||||||
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
, promptAction = \inStr -> forM_ (readMaybe inStr) act
|
||||||
, promptSpecialKey = const $ return ()
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the game year
|
-- | Builds a selection prompt
|
||||||
gameYearPrompt :: Prompt
|
selectPrompt :: SelectParams a -> Prompt
|
||||||
gameYearPrompt = numPrompt "Game year: " $
|
selectPrompt params = Prompt
|
||||||
modify . (progMode.gameStateL.gameYear ?~)
|
{ promptDrawer = \s -> do
|
||||||
|
let sStr = s^.inputBuffer
|
||||||
-- | Prompts for the day of the month the game took place
|
C.drawString $ spPrompt params ++ sStr
|
||||||
gameDayPrompt :: Prompt
|
(row, col) <- C.cursorPosition
|
||||||
gameDayPrompt = numPrompt "Day of month: " $
|
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
|
||||||
modify . (progMode.gameStateL.gameDay ?~)
|
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
|
||||||
|
C.drawString $ unlines $ map
|
||||||
-- | Prompts for the other team name
|
(\(n, (_, x)) -> let
|
||||||
otherTeamPrompt :: Prompt
|
desc = spElemDesc params x
|
||||||
otherTeamPrompt = strPrompt "Other team: " $
|
in "F" ++ show n ++ ") " ++ desc)
|
||||||
modify . (progMode.gameStateL.otherTeam .~)
|
results
|
||||||
|
C.moveCursor row col
|
||||||
-- | Prompts for the home score
|
, promptProcessChar = \ch -> (++[ch])
|
||||||
homeScorePrompt :: Prompt
|
, promptAction = \sStr -> if null sStr
|
||||||
homeScorePrompt = numPrompt "Home score: " $
|
then spCallback params Nothing
|
||||||
modify . (progMode.gameStateL.homeScore ?~)
|
else do
|
||||||
|
db <- gets (^.database)
|
||||||
-- | Prompts for the away score
|
case spSearchExact params sStr db of
|
||||||
awayScorePrompt :: Prompt
|
Nothing -> spNotFound params sStr
|
||||||
awayScorePrompt = numPrompt "Away score: " $
|
Just n -> spCallback params $ Just n
|
||||||
modify . (progMode.gameStateL.awayScore ?~)
|
, promptSpecialKey = \case
|
||||||
|
C.KeyFunction rawK -> do
|
||||||
|
sStr <- gets (^.inputBuffer)
|
||||||
|
db <- gets (^.database)
|
||||||
|
let
|
||||||
|
n = pred $ fromInteger rawK
|
||||||
|
results = spSearch params sStr db
|
||||||
|
when (n < maxFunKeys) $
|
||||||
|
whenJust (nth n results) $ \(sel, _) -> do
|
||||||
|
modify $ inputBuffer .~ ""
|
||||||
|
spCallback params $ Just sel
|
||||||
|
_ -> return ()
|
||||||
|
}
|
||||||
|
|
||||||
-- | Prompts for a new player's number
|
-- | Prompts for a new player's number
|
||||||
playerNumPrompt :: Prompt
|
playerNumPrompt :: Prompt
|
||||||
@@ -143,9 +191,19 @@ playerNamePrompt = strPrompt "Player name: " $
|
|||||||
|
|
||||||
-- | 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
|
||||||
|
goalieNumPrompt :: Prompt
|
||||||
|
goalieNumPrompt = numPrompt "Goalie number: " $
|
||||||
|
modify . (progMode.createGoalieStateL.cgsNumber ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the goalie's name
|
||||||
|
goalieNamePrompt :: Prompt
|
||||||
|
goalieNamePrompt = strPrompt "Goalie name: " $
|
||||||
|
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||||
|
|
||||||
-- | Selects a player (creating one if necessary)
|
-- | Selects a player (creating one if necessary)
|
||||||
selectPlayerPrompt
|
selectPlayerPrompt
|
||||||
:: String
|
:: String
|
||||||
@@ -154,85 +212,57 @@ selectPlayerPrompt
|
|||||||
-- ^ The callback to run (takes the index number of the payer as
|
-- ^ The callback to run (takes the index number of the payer as
|
||||||
-- input)
|
-- input)
|
||||||
-> Prompt
|
-> Prompt
|
||||||
selectPlayerPrompt pStr callback = Prompt
|
selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
||||||
{ promptDrawer = \s -> do
|
{ spPrompt = pStr
|
||||||
let sStr = s^.inputBuffer
|
, spSearchHeader = "Player select:"
|
||||||
C.drawString pStr
|
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
||||||
C.drawString sStr
|
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||||
(row, col) <- C.cursorPosition
|
, spElemDesc = playerSummary
|
||||||
C.drawString "\n\nPlayer select:\n"
|
, spCallback = callback
|
||||||
let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers
|
, spNotFound = \sStr -> do
|
||||||
mapM_
|
mode <- gets (^.progMode)
|
||||||
(\(n, (_, p)) -> C.drawString $
|
|
||||||
"F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
|
|
||||||
sel
|
|
||||||
C.moveCursor row col
|
|
||||||
, promptCharCheck = const True
|
|
||||||
, promptAction = \sStr -> if null sStr
|
|
||||||
then callback Nothing
|
|
||||||
else do
|
|
||||||
players <- gets $ view $ database.dbPlayers
|
|
||||||
case playerSearchExact sStr players of
|
|
||||||
Just (n, _) -> callback $ Just n
|
|
||||||
Nothing -> do
|
|
||||||
mode <- gets $ view progMode
|
|
||||||
let
|
let
|
||||||
cps
|
cps = newCreatePlayerState
|
||||||
= newCreatePlayerState
|
|
||||||
& cpsName .~ sStr
|
& cpsName .~ sStr
|
||||||
& cpsSuccessCallback .~ do
|
& cpsSuccessCallback .~ do
|
||||||
modify $ progMode .~ mode
|
modify $ progMode .~ mode
|
||||||
pIndex <- pred . length <$> gets (view $ database.dbPlayers)
|
index <- pred . length <$> gets (^.database.dbPlayers)
|
||||||
callback $ Just pIndex
|
callback $ Just index
|
||||||
& cpsFailureCallback .~ do
|
& cpsFailureCallback .~ modify (progMode .~ mode)
|
||||||
modify $ progMode .~ mode
|
|
||||||
callback Nothing
|
|
||||||
modify $ progMode .~ CreatePlayer cps
|
modify $ progMode .~ CreatePlayer cps
|
||||||
, promptSpecialKey = \case
|
|
||||||
C.KeyFunction n -> do
|
|
||||||
sStr <- gets $ view inputBuffer
|
|
||||||
players <- gets $ view $ database.dbPlayers
|
|
||||||
modify $ inputBuffer .~ ""
|
|
||||||
let
|
|
||||||
fKey = pred $ fromIntegral n
|
|
||||||
options = playerSearch sStr players
|
|
||||||
sel = fst <$> nth fKey options
|
|
||||||
callback sel
|
|
||||||
_ -> return ()
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the player who scored the goal
|
-- | Selects a goalie (creating one if necessary)
|
||||||
recordGoalPrompt
|
selectGoaliePrompt
|
||||||
:: Int
|
:: String
|
||||||
-- ^ The game number
|
-- ^ The prompt string
|
||||||
-> Int
|
-> (Maybe Int -> Action ())
|
||||||
-- ^ The goal number
|
-- ^ The callback to run (takes the index number of the goalie as
|
||||||
|
-- input)
|
||||||
-> Prompt
|
-> Prompt
|
||||||
recordGoalPrompt game goal = selectPlayerPrompt
|
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
{ spPrompt = pStr
|
||||||
++ "Who scored goal number " ++ show goal ++ "? "
|
, spSearchHeader = "Goalie select:"
|
||||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
||||||
|
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||||
|
, spElemDesc = goalieSummary
|
||||||
|
, spCallback = callback
|
||||||
|
, spNotFound = \sStr -> do
|
||||||
|
mode <- gets (^.progMode)
|
||||||
|
let
|
||||||
|
cgs = newCreateGoalieState
|
||||||
|
& cgsName .~ sStr
|
||||||
|
& cgsSuccessCallback .~ do
|
||||||
|
modify $ progMode .~ mode
|
||||||
|
index <- pred . length <$> gets (^.database.dbGoalies)
|
||||||
|
callback $ Just index
|
||||||
|
& cgsFailureCallback .~ modify (progMode .~ mode)
|
||||||
|
modify $ progMode .~ CreateGoalie cgs
|
||||||
|
}
|
||||||
|
|
||||||
-- | Prompts for a player who assisted the goal
|
playerToEditPrompt :: Prompt
|
||||||
recordAssistPrompt
|
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||||
:: Int
|
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||||
-- ^ 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
|
|
||||||
|
|
||||||
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
drawSimplePrompt :: String -> ProgState -> C.Update ()
|
||||||
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer
|
||||||
|
|||||||
120
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
120
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
@@ -0,0 +1,120 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Prompt.EditGoalie
|
||||||
|
( goalieToEditPrompt
|
||||||
|
, editGoalieNumberPrompt
|
||||||
|
, editGoalieNamePrompt
|
||||||
|
, editGoalieYtdGamesPrompt
|
||||||
|
, editGoalieYtdMinsPrompt
|
||||||
|
, editGoalieYtdGoalsPrompt
|
||||||
|
, editGoalieYtdWinsPrompt
|
||||||
|
, editGoalieYtdLossesPrompt
|
||||||
|
, editGoalieYtdTiesPrompt
|
||||||
|
, editGoalieLtGamesPrompt
|
||||||
|
, editGoalieLtMinsPrompt
|
||||||
|
, editGoalieLtGoalsPrompt
|
||||||
|
, editGoalieLtWinsPrompt
|
||||||
|
, editGoalieLtLossesPrompt
|
||||||
|
, editGoalieLtTiesPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((.~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions.EditGoalie
|
||||||
|
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 = numPrompt "Goalie number: " $
|
||||||
|
modify . editGoalieNumber
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's name
|
||||||
|
editGoalieNamePrompt :: Prompt
|
||||||
|
editGoalieNamePrompt = strPrompt "Goalie name: " $
|
||||||
|
modify . editGoalieName
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD games played
|
||||||
|
editGoalieYtdGamesPrompt :: Prompt
|
||||||
|
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
|
||||||
|
modify . editGoalieYtdGames
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD minutes played
|
||||||
|
editGoalieYtdMinsPrompt :: Prompt
|
||||||
|
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
|
||||||
|
modify . editGoalieYtdMins
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD goales allowed
|
||||||
|
editGoalieYtdGoalsPrompt :: Prompt
|
||||||
|
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
|
||||||
|
modify . editGoalieYtdGoals
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD wins
|
||||||
|
editGoalieYtdWinsPrompt :: Prompt
|
||||||
|
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
|
||||||
|
modify . editGoalieYtdWins
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD losses
|
||||||
|
editGoalieYtdLossesPrompt :: Prompt
|
||||||
|
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
|
||||||
|
modify . editGoalieYtdLosses
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's YTD ties
|
||||||
|
editGoalieYtdTiesPrompt :: Prompt
|
||||||
|
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
|
||||||
|
modify . editGoalieYtdTies
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime games played
|
||||||
|
editGoalieLtGamesPrompt :: Prompt
|
||||||
|
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
|
||||||
|
modify . editGoalieLtGames
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime minutes played
|
||||||
|
editGoalieLtMinsPrompt :: Prompt
|
||||||
|
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
|
||||||
|
modify . editGoalieLtMins
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||||
|
editGoalieLtGoalsPrompt :: Prompt
|
||||||
|
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
|
||||||
|
modify . editGoalieLtGoals
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime wins
|
||||||
|
editGoalieLtWinsPrompt :: Prompt
|
||||||
|
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
|
||||||
|
modify . editGoalieLtWins
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime losses
|
||||||
|
editGoalieLtLossesPrompt :: Prompt
|
||||||
|
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
|
||||||
|
modify . editGoalieLtLosses
|
||||||
|
|
||||||
|
-- | Prompt to edit a goalie's lifetime ties
|
||||||
|
editGoalieLtTiesPrompt :: Prompt
|
||||||
|
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
|
||||||
|
modify . editGoalieLtTies
|
||||||
92
src/Mtlstats/Prompt/EditPlayer.hs
Normal file
92
src/Mtlstats/Prompt/EditPlayer.hs
Normal file
@@ -0,0 +1,92 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Prompt.EditPlayer
|
||||||
|
( editPlayerNumPrompt
|
||||||
|
, editPlayerNamePrompt
|
||||||
|
, editPlayerPosPrompt
|
||||||
|
, editPlayerYtdGoalsPrompt
|
||||||
|
, editPlayerYtdAssistsPrompt
|
||||||
|
, editPlayerYtdPMinPrompt
|
||||||
|
, editPlayerLtGoalsPrompt
|
||||||
|
, editPlayerLtAssistsPrompt
|
||||||
|
, editPlayerLtPMinPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Extra (whenJustM)
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's number
|
||||||
|
editPlayerNumPrompt :: Prompt
|
||||||
|
editPlayerNumPrompt = numPrompt "Player number: " $
|
||||||
|
editPlayer . (pNumber .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's name
|
||||||
|
editPlayerNamePrompt :: Prompt
|
||||||
|
editPlayerNamePrompt = strPrompt "Player name: " $
|
||||||
|
editPlayer . (pName .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's position
|
||||||
|
editPlayerPosPrompt :: Prompt
|
||||||
|
editPlayerPosPrompt = ucStrPrompt "Player position: " $
|
||||||
|
editPlayer . (pPosition .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's year-to-date goals
|
||||||
|
editPlayerYtdGoalsPrompt :: Prompt
|
||||||
|
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
|
||||||
|
editPlayer . (pYtd.psGoals .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's year-to-date assists
|
||||||
|
editPlayerYtdAssistsPrompt :: Prompt
|
||||||
|
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
|
||||||
|
editPlayer . (pYtd.psAssists .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||||
|
editPlayerYtdPMinPrompt :: Prompt
|
||||||
|
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
|
||||||
|
editPlayer . (pYtd.psPMin .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's lifetime goals
|
||||||
|
editPlayerLtGoalsPrompt :: Prompt
|
||||||
|
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
|
||||||
|
editPlayer . (pLifetime.psGoals .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's lifetime assists
|
||||||
|
editPlayerLtAssistsPrompt :: Prompt
|
||||||
|
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
|
||||||
|
editPlayer . (pLifetime.psAssists .~)
|
||||||
|
|
||||||
|
-- | Prompt to edit a player's lifetime penalty minutes
|
||||||
|
editPlayerLtPMinPrompt :: Prompt
|
||||||
|
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
|
||||||
|
editPlayer . (pLifetime.psPMin .~)
|
||||||
|
|
||||||
|
editPlayer :: (Player -> Player) -> Action ()
|
||||||
|
editPlayer f =
|
||||||
|
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
|
||||||
|
modify
|
||||||
|
$ (database.dbPlayers %~ modifyNth pid f)
|
||||||
|
. (progMode.editPlayerStateL.epsMode .~ EPMenu)
|
||||||
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
@@ -0,0 +1,116 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# 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
|
||||||
53
src/Mtlstats/Prompt/NewGame/GoalieInput.hs
Normal file
53
src/Mtlstats/Prompt/NewGame/GoalieInput.hs
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
|
( selectGameGoaliePrompt
|
||||||
|
, goalieMinsPlayedPrompt
|
||||||
|
, goalsAllowedPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (modify)
|
||||||
|
import Lens.Micro ((?~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Prompts for a goalie who played in the game
|
||||||
|
selectGameGoaliePrompt :: Prompt
|
||||||
|
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
||||||
|
\case
|
||||||
|
Nothing -> modify finishGoalieEntry
|
||||||
|
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||||
|
|
||||||
|
-- | Prompts for the number of minutes the goalie has played
|
||||||
|
goalieMinsPlayedPrompt :: Prompt
|
||||||
|
goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
|
||||||
|
modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the number of goals the goalie allowed
|
||||||
|
goalsAllowedPrompt :: Prompt
|
||||||
|
goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
|
||||||
|
modify (progMode.gameStateL.gameGoalsAllowed ?~ n)
|
||||||
|
modify recordGoalieStats
|
||||||
@@ -22,7 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Report (report, gameDate) where
|
module Mtlstats.Report (report, gameDate) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
@@ -36,8 +36,18 @@ report
|
|||||||
-- ^ The number of columns for the report
|
-- ^ The number of columns for the report
|
||||||
-> ProgState
|
-> ProgState
|
||||||
-- ^ The program state
|
-- ^ The program state
|
||||||
-> String
|
-> [String]
|
||||||
report width s = unlines $ fromMaybe [] $ do
|
report width s
|
||||||
|
= standingsReport width s
|
||||||
|
++ [""]
|
||||||
|
++ gameStatsReport width s
|
||||||
|
++ [""]
|
||||||
|
++ yearToDateStatsReport width s
|
||||||
|
++ [""]
|
||||||
|
++ lifetimeStatsReport width s
|
||||||
|
|
||||||
|
standingsReport :: Int -> ProgState -> [String]
|
||||||
|
standingsReport width s = fromMaybe [] $ do
|
||||||
let
|
let
|
||||||
db = s^.database
|
db = s^.database
|
||||||
gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
@@ -48,15 +58,10 @@ report width s = unlines $ fromMaybe [] $ do
|
|||||||
hStats = db^.dbHomeGameStats
|
hStats = db^.dbHomeGameStats
|
||||||
aStats = db^.dbAwayGameStats
|
aStats = db^.dbAwayGameStats
|
||||||
tStats = addGameStats hStats aStats
|
tStats = addGameStats hStats aStats
|
||||||
players = db^.dbPlayers
|
|
||||||
hScore <- gs^.homeScore
|
hScore <- gs^.homeScore
|
||||||
aScore <- gs^.awayScore
|
aScore <- gs^.awayScore
|
||||||
pStats <- mapM
|
let
|
||||||
(\(n, stats) -> do
|
rHeader =
|
||||||
player <- nth n players
|
|
||||||
Just (player, stats))
|
|
||||||
(M.toList $ gs^.gamePlayerStats)
|
|
||||||
Just $
|
|
||||||
[ overlay
|
[ overlay
|
||||||
("GAME NUMBER " ++ padNum 2 gNum)
|
("GAME NUMBER " ++ padNum 2 gNum)
|
||||||
(centre width
|
(centre width
|
||||||
@@ -65,61 +70,223 @@ report width s = unlines $ fromMaybe [] $ do
|
|||||||
, date
|
, date
|
||||||
, centre width "STANDINGS"
|
, centre width "STANDINGS"
|
||||||
, ""
|
, ""
|
||||||
, centre width
|
]
|
||||||
$ left 11 myTeam
|
|
||||||
++ right 2 "G"
|
tHeader =
|
||||||
++ right 4 "W"
|
[ CellText myTeam
|
||||||
++ right 4 "L"
|
, CellText " G"
|
||||||
++ right 4 "OT"
|
, CellText " W"
|
||||||
++ right 4 "GF"
|
, CellText " L"
|
||||||
++ right 4 "GA"
|
, CellText " OT"
|
||||||
++ right 4 "P"
|
, CellText " GF"
|
||||||
, centre width
|
, CellText " GA"
|
||||||
$ left 11 "HOME"
|
, CellText " P"
|
||||||
++ showStats hStats
|
]
|
||||||
, centre width
|
|
||||||
$ left 11 "ROAD"
|
rowCells stats =
|
||||||
++ showStats aStats
|
[ CellText $ show $ gmsGames stats
|
||||||
, centre width
|
, CellText $ show $ stats^.gmsWins
|
||||||
$ replicate 11 ' '
|
, CellText $ show $ stats^.gmsLosses
|
||||||
++ replicate (2 + 4 * 6) '-'
|
, CellText $ show $ stats^.gmsOvertime
|
||||||
, centre width
|
, CellText $ show $ stats^.gmsGoalsFor
|
||||||
$ left 11 "TOTALS"
|
, CellText $ show $ stats^.gmsGoalsAgainst
|
||||||
++ showStats tStats
|
, CellText $ show $ gmsPoints stats
|
||||||
, ""
|
]
|
||||||
, centre width "GAME STATISTICS"
|
|
||||||
, ""
|
body =
|
||||||
, centre width
|
[ CellText "HOME" : rowCells hStats
|
||||||
$ "NO. "
|
, CellText "ROAD" : rowCells aStats
|
||||||
++ left 20 "PLAYER"
|
]
|
||||||
++ right 3 "G"
|
|
||||||
++ right 6 "A"
|
separator = CellText "" : replicate 7 (CellFill '-')
|
||||||
++ right 6 "P"
|
totals = CellText "TOTALS" : rowCells tStats
|
||||||
++ right 6 "PM"
|
|
||||||
] ++ map
|
table = map (centre width) $
|
||||||
(\(p, stats) -> centre width
|
complexTable
|
||||||
$ right 2 (show $ p^.pNumber)
|
(left : repeat right)
|
||||||
++ " "
|
(tHeader : body ++ [separator, totals])
|
||||||
++ left 20 (p^.pName)
|
|
||||||
++ right 3 (show $ stats^.psGoals)
|
Just $ rHeader ++ table
|
||||||
++ right 6 (show $ stats^.psAssists)
|
|
||||||
++ right 6 (show $ pPoints stats)
|
gameStatsReport :: Int -> ProgState -> [String]
|
||||||
++ right 6 (show $ stats^.psPMin))
|
gameStatsReport width s = let
|
||||||
pStats
|
gs = s^.progMode.gameStateL
|
||||||
|
db = s^.database
|
||||||
|
|
||||||
|
playerStats = mapMaybe
|
||||||
|
(\(pid, stats) -> do
|
||||||
|
p <- nth pid $ db^.dbPlayers
|
||||||
|
Just (p, stats))
|
||||||
|
(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 playerStats
|
||||||
|
++ [""]
|
||||||
|
++ gameGoalieReport width goalieStats
|
||||||
|
|
||||||
|
yearToDateStatsReport :: Int -> ProgState -> [String]
|
||||||
|
yearToDateStatsReport width s = let
|
||||||
|
db = s^.database
|
||||||
|
|
||||||
|
playerStats = 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" playerStats
|
||||||
|
++ [""]
|
||||||
|
++ goalieReport width goalieStats
|
||||||
|
|
||||||
|
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||||
|
lifetimeStatsReport width s = let
|
||||||
|
db = s^.database
|
||||||
|
|
||||||
|
playerStats = map (\p -> (p, p^.pYtd))
|
||||||
|
$ db^.dbPlayers
|
||||||
|
|
||||||
|
goalieStats = map (\g -> (g, g^.gYtd))
|
||||||
|
$ db^.dbGoalies
|
||||||
|
|
||||||
|
in playerReport width "LIFETIME" playerStats
|
||||||
|
++ [""]
|
||||||
|
++ goalieReport width 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
|
||||||
|
|
||||||
showStats :: GameStats -> String
|
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||||
showStats gs
|
playerReport width label ps =
|
||||||
= right 2 (show $ gmsGames gs)
|
filteredPlayerReport width label (const True) ps
|
||||||
++ right 4 (show $ gs^.gmsWins)
|
|
||||||
++ right 4 (show $ gs^.gmsLosses)
|
filteredPlayerReport
|
||||||
++ right 4 (show $ gs^.gmsOvertime)
|
:: Int
|
||||||
++ right 4 (show $ gs^.gmsGoalsFor)
|
-> String
|
||||||
++ right 4 (show $ gs^.gmsGoalsAgainst)
|
-> ((Player, PlayerStats) -> Bool)
|
||||||
++ right 4 (show $ gmsPoints gs)
|
-> [(Player, PlayerStats)]
|
||||||
|
-> [String]
|
||||||
|
filteredPlayerReport width label criteria ps = let
|
||||||
|
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||||
|
fps = filter criteria ps
|
||||||
|
|
||||||
|
rHeader =
|
||||||
|
[ centre width (label ++ " STATISTICS")
|
||||||
|
, ""
|
||||||
|
]
|
||||||
|
|
||||||
|
tHeader =
|
||||||
|
[ CellText "NO."
|
||||||
|
, CellText "Player"
|
||||||
|
, CellText " G"
|
||||||
|
, CellText " A"
|
||||||
|
, CellText " P"
|
||||||
|
, CellText " PM"
|
||||||
|
]
|
||||||
|
|
||||||
|
statsCells stats =
|
||||||
|
[ CellText $ show $ stats^.psGoals
|
||||||
|
, CellText $ show $ stats^.psAssists
|
||||||
|
, CellText $ show $ psPoints stats
|
||||||
|
, CellText $ show $ stats^.psPMin
|
||||||
|
]
|
||||||
|
|
||||||
|
body = map
|
||||||
|
(\(p, stats) ->
|
||||||
|
[ CellText $ show (p^.pNumber) ++ " "
|
||||||
|
, CellText $ p^.pName
|
||||||
|
] ++ statsCells stats)
|
||||||
|
fps
|
||||||
|
|
||||||
|
separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
|
||||||
|
|
||||||
|
totals =
|
||||||
|
[ CellText ""
|
||||||
|
, CellText ""
|
||||||
|
] ++ statsCells tStats
|
||||||
|
|
||||||
|
table = overlayLast (label ++ " TOTALS")
|
||||||
|
$ map (centre width)
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ tHeader : body ++ [separator, totals]
|
||||||
|
|
||||||
|
in rHeader ++ table
|
||||||
|
|
||||||
|
goalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||||
|
goalieReport width goalieData = let
|
||||||
|
olayText = "GOALTENDING TOTALS"
|
||||||
|
|
||||||
|
tData = foldl addGoalieStats newGoalieStats
|
||||||
|
$ map snd goalieData
|
||||||
|
|
||||||
|
header =
|
||||||
|
[ CellText "NO."
|
||||||
|
, CellText $ left (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 $ goalie^.gName
|
||||||
|
] ++ rowCells stats)
|
||||||
|
goalieData
|
||||||
|
|
||||||
|
separator
|
||||||
|
= replicate 2 (CellText "")
|
||||||
|
++ replicate 5 (CellFill '-')
|
||||||
|
|
||||||
|
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||||
|
|
||||||
|
in map (centre width)
|
||||||
|
$ overlayLast olayText
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ header : body ++ [separator, summary]
|
||||||
|
|
||||||
|
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 $ goalie^.gName
|
||||||
|
, CellText $ show $ stats^.gsMinsPlayed
|
||||||
|
, CellText $ show $ stats^.gsGoalsAllowed
|
||||||
|
, CellText $ showFloating $ gsAverage stats
|
||||||
|
])
|
||||||
|
goalieData
|
||||||
|
|
||||||
|
in map (centre width)
|
||||||
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
|
$ header : body
|
||||||
|
|||||||
@@ -30,6 +30,11 @@ module Mtlstats.Types (
|
|||||||
GameState (..),
|
GameState (..),
|
||||||
GameType (..),
|
GameType (..),
|
||||||
CreatePlayerState (..),
|
CreatePlayerState (..),
|
||||||
|
CreateGoalieState (..),
|
||||||
|
EditPlayerState (..),
|
||||||
|
EditPlayerMode (..),
|
||||||
|
EditGoalieState (..),
|
||||||
|
EditGoalieMode (..),
|
||||||
Database (..),
|
Database (..),
|
||||||
Player (..),
|
Player (..),
|
||||||
PlayerStats (..),
|
PlayerStats (..),
|
||||||
@@ -37,14 +42,20 @@ module Mtlstats.Types (
|
|||||||
GoalieStats (..),
|
GoalieStats (..),
|
||||||
GameStats (..),
|
GameStats (..),
|
||||||
Prompt (..),
|
Prompt (..),
|
||||||
|
SelectParams (..),
|
||||||
|
TableCell (..),
|
||||||
-- * Lenses
|
-- * Lenses
|
||||||
-- ** ProgState Lenses
|
-- ** ProgState Lenses
|
||||||
database,
|
database,
|
||||||
progMode,
|
progMode,
|
||||||
inputBuffer,
|
inputBuffer,
|
||||||
|
scrollOffset,
|
||||||
-- ** ProgMode Lenses
|
-- ** ProgMode Lenses
|
||||||
gameStateL,
|
gameStateL,
|
||||||
createPlayerStateL,
|
createPlayerStateL,
|
||||||
|
createGoalieStateL,
|
||||||
|
editPlayerStateL,
|
||||||
|
editGoalieStateL,
|
||||||
-- ** GameState Lenses
|
-- ** GameState Lenses
|
||||||
gameYear,
|
gameYear,
|
||||||
gameMonth,
|
gameMonth,
|
||||||
@@ -60,12 +71,31 @@ module Mtlstats.Types (
|
|||||||
assistsBy,
|
assistsBy,
|
||||||
gamePlayerStats,
|
gamePlayerStats,
|
||||||
confirmGoalDataFlag,
|
confirmGoalDataFlag,
|
||||||
|
gameSelectedPlayer,
|
||||||
|
gamePMinsRecorded,
|
||||||
|
gameGoalieStats,
|
||||||
|
gameSelectedGoalie,
|
||||||
|
gameGoalieMinsPlayed,
|
||||||
|
gameGoalsAllowed,
|
||||||
|
gameGoaliesRecorded,
|
||||||
|
gameGoalieAssigned,
|
||||||
-- ** CreatePlayerState Lenses
|
-- ** CreatePlayerState Lenses
|
||||||
cpsNumber,
|
cpsNumber,
|
||||||
cpsName,
|
cpsName,
|
||||||
cpsPosition,
|
cpsPosition,
|
||||||
cpsSuccessCallback,
|
cpsSuccessCallback,
|
||||||
cpsFailureCallback,
|
cpsFailureCallback,
|
||||||
|
-- ** CreateGoalieState Lenses
|
||||||
|
cgsNumber,
|
||||||
|
cgsName,
|
||||||
|
cgsSuccessCallback,
|
||||||
|
cgsFailureCallback,
|
||||||
|
-- ** EditPlayerState Lenses
|
||||||
|
epsSelectedPlayer,
|
||||||
|
epsMode,
|
||||||
|
-- ** EditGoalieState Lenses
|
||||||
|
egsSelectedGoalie,
|
||||||
|
egsMode,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
@@ -91,7 +121,7 @@ module Mtlstats.Types (
|
|||||||
gsGames,
|
gsGames,
|
||||||
gsMinsPlayed,
|
gsMinsPlayed,
|
||||||
gsGoalsAllowed,
|
gsGoalsAllowed,
|
||||||
gsGoalsAgainst,
|
gsShutouts,
|
||||||
gsWins,
|
gsWins,
|
||||||
gsLosses,
|
gsLosses,
|
||||||
gsTies,
|
gsTies,
|
||||||
@@ -105,6 +135,9 @@ module Mtlstats.Types (
|
|||||||
newProgState,
|
newProgState,
|
||||||
newGameState,
|
newGameState,
|
||||||
newCreatePlayerState,
|
newCreatePlayerState,
|
||||||
|
newCreateGoalieState,
|
||||||
|
newEditPlayerState,
|
||||||
|
newEditGoalieState,
|
||||||
newDatabase,
|
newDatabase,
|
||||||
newPlayer,
|
newPlayer,
|
||||||
newPlayerStats,
|
newPlayerStats,
|
||||||
@@ -126,11 +159,22 @@ module Mtlstats.Types (
|
|||||||
gmsPoints,
|
gmsPoints,
|
||||||
addGameStats,
|
addGameStats,
|
||||||
-- ** Player Helpers
|
-- ** Player Helpers
|
||||||
pPoints,
|
|
||||||
playerSearch,
|
playerSearch,
|
||||||
playerSearchExact,
|
playerSearchExact,
|
||||||
modifyPlayer,
|
modifyPlayer,
|
||||||
playerSummary
|
playerSummary,
|
||||||
|
playerIsActive,
|
||||||
|
-- ** PlayerStats Helpers
|
||||||
|
psPoints,
|
||||||
|
addPlayerStats,
|
||||||
|
-- ** Goalie Helpers
|
||||||
|
goalieSearch,
|
||||||
|
goalieSearchExact,
|
||||||
|
goalieSummary,
|
||||||
|
goalieIsActive,
|
||||||
|
-- ** GoalieStats Helpers
|
||||||
|
addGoalieStats,
|
||||||
|
gsAverage
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (StateT)
|
import Control.Monad.Trans.State (StateT)
|
||||||
@@ -144,8 +188,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)
|
||||||
@@ -174,6 +221,8 @@ data ProgState = ProgState
|
|||||||
-- ^ The program's mode
|
-- ^ The program's mode
|
||||||
, _inputBuffer :: String
|
, _inputBuffer :: String
|
||||||
-- ^ Buffer for user input
|
-- ^ Buffer for user input
|
||||||
|
, _scrollOffset :: Int
|
||||||
|
-- ^ The scrolling offset for the display
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | The program mode
|
-- | The program mode
|
||||||
@@ -182,12 +231,18 @@ data ProgMode
|
|||||||
| NewSeason
|
| NewSeason
|
||||||
| NewGame GameState
|
| NewGame GameState
|
||||||
| CreatePlayer CreatePlayerState
|
| CreatePlayer CreatePlayerState
|
||||||
|
| CreateGoalie CreateGoalieState
|
||||||
|
| EditPlayer EditPlayerState
|
||||||
|
| EditGoalie EditGoalieState
|
||||||
|
|
||||||
instance Show ProgMode where
|
instance Show ProgMode where
|
||||||
show MainMenu = "MainMenu"
|
show MainMenu = "MainMenu"
|
||||||
show NewSeason = "NewSeason"
|
show NewSeason = "NewSeason"
|
||||||
show (NewGame _) = "NewGame"
|
show (NewGame _) = "NewGame"
|
||||||
show (CreatePlayer _) = "CreatePlayer"
|
show (CreatePlayer _) = "CreatePlayer"
|
||||||
|
show (CreateGoalie _) = "CreateGoalie"
|
||||||
|
show (EditPlayer _) = "EditPlayer"
|
||||||
|
show (EditGoalie _) = "EditGoalie"
|
||||||
|
|
||||||
-- | The game state
|
-- | The game state
|
||||||
data GameState = GameState
|
data GameState = GameState
|
||||||
@@ -221,6 +276,25 @@ data GameState = GameState
|
|||||||
-- ^ The player stats accumulated over the game
|
-- ^ The player stats accumulated over the game
|
||||||
, _confirmGoalDataFlag :: Bool
|
, _confirmGoalDataFlag :: Bool
|
||||||
-- ^ Set when the user confirms the goal data
|
-- ^ Set when the user confirms the goal data
|
||||||
|
, _gameSelectedPlayer :: Maybe Int
|
||||||
|
-- ^ Index number of the selected 'Player'
|
||||||
|
, _gamePMinsRecorded :: Bool
|
||||||
|
-- ^ Set when the penalty mintes have been recorded
|
||||||
|
, _gameGoalieStats :: M.Map Int GoalieStats
|
||||||
|
-- ^ The goalie stats accumulated over the game
|
||||||
|
, _gameSelectedGoalie :: Maybe Int
|
||||||
|
-- ^ Index number of the selected 'Goalie'
|
||||||
|
, _gameGoalieMinsPlayed :: Maybe Int
|
||||||
|
-- ^ The number of minutes the currently selected goalie played in
|
||||||
|
-- the game
|
||||||
|
, _gameGoalsAllowed :: Maybe Int
|
||||||
|
-- ^ The number of goals the currently selected goalie allowed in
|
||||||
|
-- the game
|
||||||
|
, _gameGoaliesRecorded :: Bool
|
||||||
|
-- ^ Set when the user confirms that all goalie info has been entered
|
||||||
|
, _gameGoalieAssigned :: Bool
|
||||||
|
-- ^ Set to 'True' when the goalie has been selected who will be
|
||||||
|
-- given the win/loss/tie
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
-- | The type of game
|
-- | The type of game
|
||||||
@@ -243,6 +317,70 @@ data CreatePlayerState = CreatePlayerState
|
|||||||
-- ^ The function to call on failure
|
-- ^ The function to call on failure
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Goalie creation status
|
||||||
|
data CreateGoalieState = CreateGoalieState
|
||||||
|
{ _cgsNumber :: Maybe Int
|
||||||
|
-- ^ The goalie's number
|
||||||
|
, _cgsName :: String
|
||||||
|
-- ^ The goalie's name
|
||||||
|
, _cgsSuccessCallback :: Action ()
|
||||||
|
-- ^ The function to call on success
|
||||||
|
, _cgsFailureCallback :: Action ()
|
||||||
|
-- ^ The function to call on failure
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Player edit status
|
||||||
|
data EditPlayerState = EditPlayerState
|
||||||
|
{ _epsSelectedPlayer :: Maybe Int
|
||||||
|
-- ^ The index number of the player being edited
|
||||||
|
, _epsMode :: EditPlayerMode
|
||||||
|
-- ^ The editing mode
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Player editing mode
|
||||||
|
data EditPlayerMode
|
||||||
|
= EPMenu
|
||||||
|
| EPNumber
|
||||||
|
| EPName
|
||||||
|
| EPPosition
|
||||||
|
| EPYtd
|
||||||
|
| EPLifetime
|
||||||
|
| EPYtdGoals
|
||||||
|
| EPYtdAssists
|
||||||
|
| EPYtdPMin
|
||||||
|
| EPLtGoals
|
||||||
|
| EPLtAssists
|
||||||
|
| EPLtPMin
|
||||||
|
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
|
||||||
|
| EGYtdMins
|
||||||
|
| EGYtdGoals
|
||||||
|
| EGYtdWins
|
||||||
|
| EGYtdLosses
|
||||||
|
| EGYtdTies
|
||||||
|
| EGLtGames
|
||||||
|
| EGLtMins
|
||||||
|
| EGLtGoals
|
||||||
|
| EGLtWins
|
||||||
|
| EGLtLosses
|
||||||
|
| EGLtTies
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Represents the database
|
-- | Represents the database
|
||||||
data Database = Database
|
data Database = Database
|
||||||
{ _dbPlayers :: [Player]
|
{ _dbPlayers :: [Player]
|
||||||
@@ -384,8 +522,8 @@ data GoalieStats = GoalieStats
|
|||||||
-- ^ The number of minutes played
|
-- ^ The number of minutes played
|
||||||
, _gsGoalsAllowed :: Int
|
, _gsGoalsAllowed :: Int
|
||||||
-- ^ The number of goals allowed
|
-- ^ The number of goals allowed
|
||||||
, _gsGoalsAgainst :: Int
|
, _gsShutouts :: Int
|
||||||
-- ^ The number of goals against
|
-- ^ The number of shutouts the goalie has accumulated
|
||||||
, _gsWins :: Int
|
, _gsWins :: Int
|
||||||
-- ^ The number of wins
|
-- ^ The number of wins
|
||||||
, _gsLosses :: Int
|
, _gsLosses :: Int
|
||||||
@@ -396,29 +534,29 @@ data GoalieStats = GoalieStats
|
|||||||
|
|
||||||
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 .: "goals_against"
|
<*> v .:? "shutouts" .!= 0
|
||||||
<*> v .: "wins"
|
<*> v .:? "wins" .!= 0
|
||||||
<*> v .: "losses"
|
<*> v .:? "losses" .!= 0
|
||||||
<*> v .: "ties"
|
<*> v .:? "ties" .!= 0
|
||||||
|
|
||||||
instance ToJSON GoalieStats where
|
instance ToJSON GoalieStats where
|
||||||
toJSON (GoalieStats g m al ag 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" .= al
|
, "goals_allowed" .= a
|
||||||
, "goals_against" .= ag
|
, "shutouts" .= s
|
||||||
, "wins" .= w
|
, "wins" .= w
|
||||||
, "losses" .= l
|
, "losses" .= l
|
||||||
, "ties" .= t
|
, "ties" .= t
|
||||||
]
|
]
|
||||||
toEncoding (GoalieStats g m al ag 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" .= al <>
|
"goals_allowed" .= a <>
|
||||||
"goals_against" .= ag <>
|
"shutouts" .= s <>
|
||||||
"wins" .= w <>
|
"wins" .= w <>
|
||||||
"losses" .= l <>
|
"losses" .= l <>
|
||||||
"ties" .= t
|
"ties" .= t
|
||||||
@@ -463,18 +601,47 @@ instance ToJSON GameStats where
|
|||||||
-- | Defines a user prompt
|
-- | Defines a user prompt
|
||||||
data Prompt = Prompt
|
data Prompt = Prompt
|
||||||
{ promptDrawer :: ProgState -> C.Update ()
|
{ promptDrawer :: ProgState -> C.Update ()
|
||||||
-- ^ Draws the prompt to thr screen
|
-- ^ Draws the prompt to the screen
|
||||||
, promptCharCheck :: Char -> Bool
|
, promptProcessChar :: Char -> String -> String
|
||||||
-- ^ Determines whether or not the character is valid
|
-- ^ Modifies the string based on the character entered
|
||||||
, promptAction :: String -> Action ()
|
, promptAction :: String -> Action ()
|
||||||
-- ^ Action to perform when the value is entered
|
-- ^ Action to perform when the value is entered
|
||||||
, promptSpecialKey :: C.Key -> Action ()
|
, promptSpecialKey :: C.Key -> Action ()
|
||||||
-- ^ Action to perform when a special key is pressed
|
-- ^ 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
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | 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 ''ProgState
|
||||||
makeLenses ''GameState
|
makeLenses ''GameState
|
||||||
makeLenses ''CreatePlayerState
|
makeLenses ''CreatePlayerState
|
||||||
|
makeLenses ''CreateGoalieState
|
||||||
|
makeLenses ''EditPlayerState
|
||||||
|
makeLenses ''EditGoalieState
|
||||||
makeLenses ''Database
|
makeLenses ''Database
|
||||||
makeLenses ''Player
|
makeLenses ''Player
|
||||||
makeLenses ''PlayerStats
|
makeLenses ''PlayerStats
|
||||||
@@ -496,12 +663,34 @@ createPlayerStateL = lens
|
|||||||
_ -> newCreatePlayerState)
|
_ -> newCreatePlayerState)
|
||||||
(\_ cps -> CreatePlayer cps)
|
(\_ cps -> CreatePlayer cps)
|
||||||
|
|
||||||
|
createGoalieStateL :: Lens' ProgMode CreateGoalieState
|
||||||
|
createGoalieStateL = lens
|
||||||
|
(\case
|
||||||
|
CreateGoalie cgs -> cgs
|
||||||
|
_ -> newCreateGoalieState)
|
||||||
|
(\_ cgs -> CreateGoalie cgs)
|
||||||
|
|
||||||
|
editPlayerStateL :: Lens' ProgMode EditPlayerState
|
||||||
|
editPlayerStateL = lens
|
||||||
|
(\case
|
||||||
|
EditPlayer eps -> eps
|
||||||
|
_ -> newEditPlayerState)
|
||||||
|
(\_ eps -> EditPlayer eps)
|
||||||
|
|
||||||
|
editGoalieStateL :: Lens' ProgMode EditGoalieState
|
||||||
|
editGoalieStateL = lens
|
||||||
|
(\case
|
||||||
|
EditGoalie egs -> egs
|
||||||
|
_ -> newEditGoalieState)
|
||||||
|
(\_ egs -> EditGoalie egs)
|
||||||
|
|
||||||
-- | Constructor for a 'ProgState'
|
-- | Constructor for a 'ProgState'
|
||||||
newProgState :: ProgState
|
newProgState :: ProgState
|
||||||
newProgState = ProgState
|
newProgState = ProgState
|
||||||
{ _database = newDatabase
|
{ _database = newDatabase
|
||||||
, _progMode = MainMenu
|
, _progMode = MainMenu
|
||||||
, _inputBuffer = ""
|
, _inputBuffer = ""
|
||||||
|
, _scrollOffset = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'GameState'
|
-- | Constructor for a 'GameState'
|
||||||
@@ -521,6 +710,14 @@ newGameState = GameState
|
|||||||
, _assistsBy = []
|
, _assistsBy = []
|
||||||
, _gamePlayerStats = M.empty
|
, _gamePlayerStats = M.empty
|
||||||
, _confirmGoalDataFlag = False
|
, _confirmGoalDataFlag = False
|
||||||
|
, _gameSelectedPlayer = Nothing
|
||||||
|
, _gamePMinsRecorded = False
|
||||||
|
, _gameGoalieStats = M.empty
|
||||||
|
, _gameSelectedGoalie = Nothing
|
||||||
|
, _gameGoalieMinsPlayed = Nothing
|
||||||
|
, _gameGoalsAllowed = Nothing
|
||||||
|
, _gameGoaliesRecorded = False
|
||||||
|
, _gameGoalieAssigned = False
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'CreatePlayerState'
|
-- | Constructor for a 'CreatePlayerState'
|
||||||
@@ -533,6 +730,29 @@ newCreatePlayerState = CreatePlayerState
|
|||||||
, _cpsFailureCallback = return ()
|
, _cpsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Constructor for a 'CreateGoalieState'
|
||||||
|
newCreateGoalieState :: CreateGoalieState
|
||||||
|
newCreateGoalieState = CreateGoalieState
|
||||||
|
{ _cgsNumber = Nothing
|
||||||
|
, _cgsName = ""
|
||||||
|
, _cgsSuccessCallback = return ()
|
||||||
|
, _cgsFailureCallback = return ()
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Constructor for an 'EditPlayerState'
|
||||||
|
newEditPlayerState :: EditPlayerState
|
||||||
|
newEditPlayerState = EditPlayerState
|
||||||
|
{ _epsSelectedPlayer = Nothing
|
||||||
|
, _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
|
||||||
@@ -588,7 +808,7 @@ newGoalieStats = GoalieStats
|
|||||||
{ _gsGames = 0
|
{ _gsGames = 0
|
||||||
, _gsMinsPlayed = 0
|
, _gsMinsPlayed = 0
|
||||||
, _gsGoalsAllowed = 0
|
, _gsGoalsAllowed = 0
|
||||||
, _gsGoalsAgainst = 0
|
, _gsShutouts = 0
|
||||||
, _gsWins = 0
|
, _gsWins = 0
|
||||||
, _gsLosses = 0
|
, _gsLosses = 0
|
||||||
, _gsTies = 0
|
, _gsTies = 0
|
||||||
@@ -675,10 +895,6 @@ addGameStats s1 s2 = GameStats
|
|||||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Calculates a player's points
|
|
||||||
pPoints :: PlayerStats -> Int
|
|
||||||
pPoints s = s^.psGoals + s^.psAssists
|
|
||||||
|
|
||||||
-- | Searches through a list of players
|
-- | Searches through a list of players
|
||||||
playerSearch
|
playerSearch
|
||||||
:: String
|
:: String
|
||||||
@@ -688,9 +904,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
|
||||||
@@ -701,10 +916,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
|
||||||
@@ -725,3 +938,82 @@ modifyPlayer f n = map
|
|||||||
playerSummary :: Player -> String
|
playerSummary :: Player -> String
|
||||||
playerSummary p =
|
playerSummary p =
|
||||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||||
|
|
||||||
|
-- | Determines whether or not a player has been active in the current
|
||||||
|
-- season/year
|
||||||
|
playerIsActive :: Player -> Bool
|
||||||
|
playerIsActive = do
|
||||||
|
stats <- (^.pYtd)
|
||||||
|
return
|
||||||
|
$ stats^.psGoals /= 0
|
||||||
|
|| stats^.psAssists /= 0
|
||||||
|
|| stats^.psPMin /= 0
|
||||||
|
|
||||||
|
-- | Calculates a player's points
|
||||||
|
psPoints :: PlayerStats -> Int
|
||||||
|
psPoints s = s^.psGoals + s^.psAssists
|
||||||
|
|
||||||
|
-- | Adds two 'PlayerStats' together
|
||||||
|
addPlayerStats :: PlayerStats -> PlayerStats -> PlayerStats
|
||||||
|
addPlayerStats s1 s2 = newPlayerStats
|
||||||
|
& psGoals .~ s1^.psGoals + s2^.psGoals
|
||||||
|
& psAssists .~ s1^.psAssists + s2^.psAssists
|
||||||
|
& psPMin .~ s1^.psPMin + s2^.psPMin
|
||||||
|
|
||||||
|
-- | Searches a list of goalies
|
||||||
|
goalieSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Goalie]
|
||||||
|
-- ^ The list to search
|
||||||
|
-> [(Int, Goalie)]
|
||||||
|
-- ^ The search results with their corresponding index numbers
|
||||||
|
goalieSearch sStr =
|
||||||
|
filter match . zip [0..]
|
||||||
|
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||||
|
|
||||||
|
-- | Searches a list of goalies for an exact match
|
||||||
|
goalieSearchExact
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Goalie]
|
||||||
|
-- ^ The list to search
|
||||||
|
-> Maybe (Int, Goalie)
|
||||||
|
-- ^ The result with its index number
|
||||||
|
goalieSearchExact sStr goalies = let
|
||||||
|
results = filter (\(_, goalie) -> sStr == goalie^.gName) $
|
||||||
|
zip [0..] goalies
|
||||||
|
in case results of
|
||||||
|
[] -> Nothing
|
||||||
|
result:_ -> Just result
|
||||||
|
|
||||||
|
-- | Provides a description string for a 'Goalie'
|
||||||
|
goalieSummary :: Goalie -> String
|
||||||
|
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
||||||
|
|
||||||
|
-- | Determines whether or not a goalie has been active in the current
|
||||||
|
-- season
|
||||||
|
goalieIsActive :: Goalie -> Bool
|
||||||
|
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
|
||||||
|
|
||||||
|
-- | Adds two sets of 'GoalieStats'
|
||||||
|
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
|
||||||
|
addGoalieStats g1 g2 = GoalieStats
|
||||||
|
{ _gsGames = g1^.gsGames + g2^.gsGames
|
||||||
|
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
|
||||||
|
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
|
||||||
|
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
|
||||||
|
, _gsWins = g1^.gsWins + g2^.gsWins
|
||||||
|
, _gsLosses = g1^.gsLosses + g2^.gsLosses
|
||||||
|
, _gsTies = g1^.gsTies + g2^.gsTies
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Determines a goalie's average goals allowed per game.
|
||||||
|
gsAverage :: GoalieStats -> Rational
|
||||||
|
gsAverage gs = let
|
||||||
|
allowed = fromIntegral $ gs^.gsGoalsAllowed
|
||||||
|
mins = fromIntegral $ gs^.gsMinsPlayed
|
||||||
|
gLen = fromIntegral gameLength
|
||||||
|
in if mins == 0
|
||||||
|
then 0
|
||||||
|
else allowed / mins * gLen
|
||||||
|
|||||||
@@ -38,7 +38,6 @@ 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.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
|||||||
@@ -19,11 +19,59 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Util (nth) where
|
module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
|
||||||
|
|
||||||
nth :: Int -> [a] -> Maybe a
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
-- | Attempt to select the element from a list at a given index
|
||||||
|
nth
|
||||||
|
:: Int
|
||||||
|
-- ^ The index
|
||||||
|
-> [a]
|
||||||
|
-- ^ The list
|
||||||
|
-> Maybe a
|
||||||
nth _ [] = Nothing
|
nth _ [] = Nothing
|
||||||
nth n (x:xs)
|
nth n (x:xs)
|
||||||
| n == 0 = Just x
|
| n == 0 = Just x
|
||||||
| n < 0 = Nothing
|
| n < 0 = Nothing
|
||||||
| otherwise = nth (pred n) xs
|
| otherwise = nth (pred n) xs
|
||||||
|
|
||||||
|
-- | Attempt to modify the index at a given index in a list
|
||||||
|
modifyNth
|
||||||
|
:: Int
|
||||||
|
-- ^ The index
|
||||||
|
-> (a -> a)
|
||||||
|
-- ^ The modification function
|
||||||
|
-> [a]
|
||||||
|
-- ^ The list
|
||||||
|
-> [a]
|
||||||
|
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
||||||
|
. zip [0..]
|
||||||
|
|
||||||
|
-- | Modify a value indexed by a given key in a map using a default
|
||||||
|
-- initial value if not present
|
||||||
|
updateMap
|
||||||
|
:: Ord k
|
||||||
|
=> k
|
||||||
|
-- ^ The key
|
||||||
|
-> a
|
||||||
|
-- ^ The default initial value
|
||||||
|
-> (a -> a)
|
||||||
|
-- ^ The modification function
|
||||||
|
-> M.Map k a
|
||||||
|
-- ^ The map
|
||||||
|
-> M.Map k a
|
||||||
|
updateMap k def f m = let
|
||||||
|
x = M.findWithDefault def k m
|
||||||
|
in M.insert k (f x) m
|
||||||
|
|
||||||
|
-- | Selects a section of a list
|
||||||
|
slice
|
||||||
|
:: Int
|
||||||
|
-- ^ The index to start at
|
||||||
|
-> Int
|
||||||
|
-- ^ The number of elements to take
|
||||||
|
-> [a]
|
||||||
|
-- ^ The list to take a subset of
|
||||||
|
-> [a]
|
||||||
|
slice offset len = take len . drop offset
|
||||||
|
|||||||
537
test/Actions/EditGoalieSpec.hs
Normal file
537
test/Actions/EditGoalieSpec.hs
Normal file
@@ -0,0 +1,537 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Actions.EditGoalieSpec (spec) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Lens.Micro ((^.), (&), (.~))
|
||||||
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Actions.EditGoalie
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "EditGoalie" $ do
|
||||||
|
editGoalieNumberSpec
|
||||||
|
editGoalieNameSpec
|
||||||
|
editGoalieYtdGamesSpec
|
||||||
|
editGoalieYtdMinsSpec
|
||||||
|
editGoalieYtdGoalsSpec
|
||||||
|
editGoalieYtdWinsSpec
|
||||||
|
editGoalieYtdLossesSpec
|
||||||
|
editGoalieYtdTiesSpec
|
||||||
|
editGoalieLtGamesSpec
|
||||||
|
editGoalieLtMinsSpec
|
||||||
|
editGoalieLtGoalsSpec
|
||||||
|
editGoalieLtWinsSpec
|
||||||
|
editGoalieLtLossesSpec
|
||||||
|
editGoalieLtTiesSpec
|
||||||
|
|
||||||
|
editGoalieNumberSpec :: Spec
|
||||||
|
editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
|
||||||
|
(editGoalieNumber 5)
|
||||||
|
EGNumber
|
||||||
|
(uncurry newGoalie)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, (5, "Joe")
|
||||||
|
, (3, "Bob")
|
||||||
|
, EGMenu
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, (2, "Joe")
|
||||||
|
, (5, "Bob")
|
||||||
|
, EGMenu
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, (2, "Joe")
|
||||||
|
, (3, "Bob")
|
||||||
|
, EGNumber
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, (2, "Joe")
|
||||||
|
, (3, "Bob")
|
||||||
|
, EGNumber
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieNameSpec :: Spec
|
||||||
|
editGoalieNameSpec = describe "editGoalieName" $ editTest
|
||||||
|
(editGoalieName "foo")
|
||||||
|
EGName
|
||||||
|
(uncurry newGoalie)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "foo" )
|
||||||
|
, ( 3, "Bob" )
|
||||||
|
, EGMenu
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe" )
|
||||||
|
, ( 3, "foo" )
|
||||||
|
, EGMenu
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe" )
|
||||||
|
, ( 3, "Bob" )
|
||||||
|
, EGName
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe" )
|
||||||
|
, ( 3, "Bob" )
|
||||||
|
, EGName
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdGamesSpec :: Spec
|
||||||
|
editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
|
||||||
|
(editGoalieYtdGames 1)
|
||||||
|
EGYtdGames
|
||||||
|
(\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdGames
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdGames
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdMinsSpec :: Spec
|
||||||
|
editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
|
||||||
|
(editGoalieYtdMins 1)
|
||||||
|
EGYtdMins
|
||||||
|
(\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, (2, "Joe", 0 )
|
||||||
|
, (3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdMins
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdMins
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdGoalsSpec :: Spec
|
||||||
|
editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
|
||||||
|
(editGoalieYtdGoals 1)
|
||||||
|
EGYtdGoals
|
||||||
|
(\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdGoals
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdGoals
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdWinsSpec :: Spec
|
||||||
|
editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
|
||||||
|
(editGoalieYtdWins 1)
|
||||||
|
EGYtdWins
|
||||||
|
(\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdWins
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdWins
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdLossesSpec :: Spec
|
||||||
|
editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
|
||||||
|
(editGoalieYtdLosses 1)
|
||||||
|
EGYtdLosses
|
||||||
|
(\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdLosses
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdLosses
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieYtdTiesSpec :: Spec
|
||||||
|
editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
|
||||||
|
(editGoalieYtdTies 1)
|
||||||
|
EGYtdTies
|
||||||
|
(\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGYtd
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdTies
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGYtdTies
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtGamesSpec :: Spec
|
||||||
|
editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
|
||||||
|
(editGoalieLtGames 1)
|
||||||
|
EGLtGames
|
||||||
|
(\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtGames
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtGames
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtMinsSpec :: Spec
|
||||||
|
editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
|
||||||
|
(editGoalieLtMins 1)
|
||||||
|
EGLtMins
|
||||||
|
(\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtMins
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtMins
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtGoalsSpec :: Spec
|
||||||
|
editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
|
||||||
|
(editGoalieLtGoals 1)
|
||||||
|
EGLtGoals
|
||||||
|
(\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtGoals
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtGoals
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtWinsSpec :: Spec
|
||||||
|
editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
|
||||||
|
(editGoalieLtWins 1)
|
||||||
|
EGLtWins
|
||||||
|
(\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtWins
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtWins
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtLossesSpec :: Spec
|
||||||
|
editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
|
||||||
|
(editGoalieLtLosses 1)
|
||||||
|
EGLtLosses
|
||||||
|
(\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtLosses
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtLosses
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editGoalieLtTiesSpec :: Spec
|
||||||
|
editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
|
||||||
|
(editGoalieLtTies 1)
|
||||||
|
EGLtTies
|
||||||
|
(\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
|
||||||
|
[ ( "set Joe"
|
||||||
|
, Just 0
|
||||||
|
, ( 2, "Joe", 1 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "set Bob"
|
||||||
|
, Just 1
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 1 )
|
||||||
|
, EGLifetime
|
||||||
|
)
|
||||||
|
, ( "out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtTies
|
||||||
|
)
|
||||||
|
, ( "no goalie selected"
|
||||||
|
, Nothing
|
||||||
|
, ( 2, "Joe", 0 )
|
||||||
|
, ( 3, "Bob", 0 )
|
||||||
|
, EGLtTies
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
editTest
|
||||||
|
:: (ProgState -> ProgState)
|
||||||
|
-> EditGoalieMode
|
||||||
|
-> (a -> Goalie)
|
||||||
|
-> [(String, Maybe Int, a, a, EditGoalieMode)]
|
||||||
|
-> Spec
|
||||||
|
editTest func setMode mkGoalie params = do
|
||||||
|
mapM_
|
||||||
|
(\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
|
||||||
|
let
|
||||||
|
egs = newEditGoalieState
|
||||||
|
& egsSelectedGoalie .~ setGid
|
||||||
|
& egsMode .~ setMode
|
||||||
|
|
||||||
|
ps = func $ progState $ EditGoalie egs
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
|
||||||
|
actual = fromJust $ nth chkGid $ ps^.database.dbGoalies
|
||||||
|
expected = mkGoalie goalieData
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
actual `shouldBe` expected)
|
||||||
|
-- label, goalie ID, goalie data
|
||||||
|
[ ( "check Joe", 0, joeData )
|
||||||
|
, ( "check Bob", 1, bobData )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "check mode" $
|
||||||
|
it ("should be " ++ show expectMode) $
|
||||||
|
ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
|
||||||
|
|
||||||
|
params
|
||||||
|
|
||||||
|
context "wrong progMode" $ do
|
||||||
|
let ps = func $ progState MainMenu
|
||||||
|
|
||||||
|
it "should not change the database" $
|
||||||
|
ps^.database `shouldBe` db
|
||||||
|
|
||||||
|
it "should not change the progMode" $
|
||||||
|
show (ps^.progMode) `shouldBe` "MainMenu"
|
||||||
|
|
||||||
|
joe :: Goalie
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
|
||||||
|
bob :: Goalie
|
||||||
|
bob = newGoalie 3 "Bob"
|
||||||
|
|
||||||
|
db :: Database
|
||||||
|
db = newDatabase & dbGoalies .~ [joe, bob]
|
||||||
|
|
||||||
|
progState :: ProgMode -> ProgState
|
||||||
|
progState mode = newProgState
|
||||||
|
& progMode .~ mode
|
||||||
|
& database .~ db
|
||||||
291
test/Actions/NewGame/GoalieInputSpec.hs
Normal file
291
test/Actions/NewGame/GoalieInputSpec.hs
Normal file
@@ -0,0 +1,291 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Actions.NewGame.GoalieInputSpec (spec) where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Mtlstats.Actions.GoalieInput" $ do
|
||||||
|
finishGoalieEntrySpec
|
||||||
|
recordGoalieStatsSpec
|
||||||
|
setGameGoalieSpec
|
||||||
|
|
||||||
|
finishGoalieEntrySpec :: Spec
|
||||||
|
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
|
||||||
|
let
|
||||||
|
progState stats = newProgState
|
||||||
|
& progMode.gameStateL.gameGoalieStats .~ stats
|
||||||
|
& finishGoalieEntry
|
||||||
|
|
||||||
|
context "no goalie data" $
|
||||||
|
it "should not set goaliesRecorded" $ let
|
||||||
|
s = progState M.empty
|
||||||
|
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
|
||||||
|
|
||||||
|
context "goalie data" $
|
||||||
|
it "should set goaliesRecorded" $ let
|
||||||
|
s = progState $ M.fromList [(1, newGoalieStats)]
|
||||||
|
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
|
||||||
|
|
||||||
|
recordGoalieStatsSpec :: Spec
|
||||||
|
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||||
|
goalieStats games mins goals = newGoalieStats
|
||||||
|
& gsGames .~ games
|
||||||
|
& gsMinsPlayed .~ mins
|
||||||
|
& gsGoalsAllowed .~ goals
|
||||||
|
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
& gYtd .~ goalieStats 10 11 12
|
||||||
|
& gLifetime .~ goalieStats 20 21 22
|
||||||
|
|
||||||
|
bob = newGoalie 3 "Bob"
|
||||||
|
& gYtd .~ goalieStats 30 31 32
|
||||||
|
& gLifetime .~ goalieStats 40 41 42
|
||||||
|
|
||||||
|
gameState n mins goals = newGameState
|
||||||
|
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)]
|
||||||
|
& gameSelectedGoalie .~ n
|
||||||
|
& gameGoalieMinsPlayed .~ mins
|
||||||
|
& gameGoalsAllowed .~ goals
|
||||||
|
|
||||||
|
progState n mins goals = newProgState
|
||||||
|
& database.dbGoalies .~ [joe, bob]
|
||||||
|
& progMode.gameStateL .~ gameState n mins goals
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
|
||||||
|
s = recordGoalieStats $ progState setGid mins goals
|
||||||
|
in context setName $ do
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\( chkName
|
||||||
|
, chkGid
|
||||||
|
, ( gGames
|
||||||
|
, gMins
|
||||||
|
, gGoals
|
||||||
|
, ytdGames
|
||||||
|
, ytdMins
|
||||||
|
, ytdGoals
|
||||||
|
, ltGames
|
||||||
|
, ltMins
|
||||||
|
, ltGoals
|
||||||
|
)
|
||||||
|
) -> context chkName $ do
|
||||||
|
let
|
||||||
|
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||||
|
game = M.findWithDefault newGoalieStats chkGid gs
|
||||||
|
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
|
||||||
|
ytd = goalie^.gYtd
|
||||||
|
lt = goalie^.gLifetime
|
||||||
|
|
||||||
|
context "game" $
|
||||||
|
game `TS.compareTest` goalieStats gGames gMins gGoals
|
||||||
|
|
||||||
|
context "year-to-date" $
|
||||||
|
ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
|
||||||
|
|
||||||
|
context "lifetime" $
|
||||||
|
lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
|
||||||
|
|
||||||
|
[ ( "checking Joe", 0, joeData )
|
||||||
|
, ( "checking Bob", 1, bobData )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "selected goalie" $ let
|
||||||
|
expected = if reset then Nothing else setGid
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||||
|
|
||||||
|
context "minutes played" $ let
|
||||||
|
expected = if reset then Nothing else mins
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
(s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
|
||||||
|
|
||||||
|
context "goals allowed" $ let
|
||||||
|
expected = if reset then Nothing else goals
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
(s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
|
||||||
|
|
||||||
|
[ ( "updating Joe"
|
||||||
|
, Just 0
|
||||||
|
, Just 1
|
||||||
|
, Just 2
|
||||||
|
, (1, 1, 2, 11, 12, 14, 21, 22, 24)
|
||||||
|
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||||
|
, True
|
||||||
|
)
|
||||||
|
, ( "updating Bob"
|
||||||
|
, Just 1
|
||||||
|
, Just 1
|
||||||
|
, Just 2
|
||||||
|
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||||
|
, (1, 3, 5, 30, 32, 34, 40, 42, 44)
|
||||||
|
, True
|
||||||
|
)
|
||||||
|
, ( "goalie out of bounds"
|
||||||
|
, Just 2
|
||||||
|
, Just 1
|
||||||
|
, Just 2
|
||||||
|
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||||
|
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||||
|
, False
|
||||||
|
)
|
||||||
|
, ( "missing goalie"
|
||||||
|
, Nothing
|
||||||
|
, Just 1
|
||||||
|
, Just 2
|
||||||
|
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||||
|
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||||
|
, False
|
||||||
|
)
|
||||||
|
, ( "missing minutes"
|
||||||
|
, Just 0
|
||||||
|
, Nothing
|
||||||
|
, Just 1
|
||||||
|
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||||
|
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||||
|
, False
|
||||||
|
)
|
||||||
|
, ( "missing goals"
|
||||||
|
, Just 0
|
||||||
|
, Just 1
|
||||||
|
, Nothing
|
||||||
|
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
|
||||||
|
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
|
||||||
|
, False
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
setGameGoalieSpec :: Spec
|
||||||
|
setGameGoalieSpec = describe "setGameGoalie" $ let
|
||||||
|
|
||||||
|
goalieStats w l t = newGoalieStats
|
||||||
|
& gsWins .~ w
|
||||||
|
& gsLosses .~ l
|
||||||
|
& gsTies .~ t
|
||||||
|
|
||||||
|
bob = newGoalie 2 "Bob"
|
||||||
|
& gYtd .~ goalieStats 10 11 12
|
||||||
|
& gLifetime .~ goalieStats 20 21 22
|
||||||
|
|
||||||
|
joe = newGoalie 3 "Joe"
|
||||||
|
& gYtd .~ goalieStats 30 31 32
|
||||||
|
& gLifetime .~ goalieStats 40 41 42
|
||||||
|
|
||||||
|
gameState h a ot = newGameState
|
||||||
|
& gameType ?~ HomeGame
|
||||||
|
& homeScore ?~ h
|
||||||
|
& awayScore ?~ a
|
||||||
|
& overtimeFlag ?~ ot
|
||||||
|
|
||||||
|
winningGame = gameState 1 0 False
|
||||||
|
losingGame = gameState 0 1 False
|
||||||
|
tiedGame = gameState 0 1 True
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
||||||
|
|
||||||
|
progState = newProgState
|
||||||
|
& database.dbGoalies .~ [bob, joe]
|
||||||
|
& progMode.gameStateL .~ gs
|
||||||
|
& setGameGoalie setGid
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\( chkLabel
|
||||||
|
, chkGid
|
||||||
|
, ( gWins
|
||||||
|
, gLosses
|
||||||
|
, gTies
|
||||||
|
, ytdWins
|
||||||
|
, ytdLosses
|
||||||
|
, ytdTies
|
||||||
|
, ltWins
|
||||||
|
, ltLosses
|
||||||
|
, ltTies
|
||||||
|
)
|
||||||
|
) -> context chkLabel $ do
|
||||||
|
let
|
||||||
|
goalie = (progState^.database.dbGoalies) !! chkGid
|
||||||
|
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||||
|
game = M.findWithDefault newGoalieStats chkGid gameStats
|
||||||
|
ytd = goalie^.gYtd
|
||||||
|
lifetime = goalie^.gLifetime
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(label', expected, actual) -> context label' $
|
||||||
|
expected `TS.compareTest` actual)
|
||||||
|
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||||
|
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||||
|
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
|
||||||
|
]
|
||||||
|
|
||||||
|
it "should set the gameGoalieAssigned flag" $
|
||||||
|
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
|
||||||
|
[ ( "checking Bob", 0, bobData )
|
||||||
|
, ( "checking Joe", 1, joeData )
|
||||||
|
])
|
||||||
|
[ ( "Bob wins"
|
||||||
|
, winningGame
|
||||||
|
, 0
|
||||||
|
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
|
||||||
|
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||||
|
)
|
||||||
|
, ( "Bob loses"
|
||||||
|
, losingGame
|
||||||
|
, 0
|
||||||
|
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
|
||||||
|
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||||
|
)
|
||||||
|
, ( "Bob ties"
|
||||||
|
, tiedGame
|
||||||
|
, 0
|
||||||
|
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
|
||||||
|
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
||||||
|
)
|
||||||
|
, ( "Joe wins"
|
||||||
|
, winningGame
|
||||||
|
, 1
|
||||||
|
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||||
|
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
|
||||||
|
)
|
||||||
|
, ( "Joe loses"
|
||||||
|
, losingGame
|
||||||
|
, 1
|
||||||
|
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||||
|
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
|
||||||
|
)
|
||||||
|
, ( "Joe ties"
|
||||||
|
, tiedGame
|
||||||
|
, 1
|
||||||
|
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
||||||
|
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
|
||||||
|
)
|
||||||
|
]
|
||||||
526
test/Actions/NewGameSpec.hs
Normal file
526
test/Actions/NewGameSpec.hs
Normal file
@@ -0,0 +1,526 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Actions.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 )
|
||||||
|
]
|
||||||
@@ -19,33 +19,50 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module ActionsSpec (spec) where
|
module ActionsSpec (spec) where
|
||||||
|
|
||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import qualified Data.Map as M
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
import Test.Hspec
|
||||||
import System.Random (randomRIO)
|
( Spec
|
||||||
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe)
|
, context
|
||||||
|
, describe
|
||||||
|
, it
|
||||||
|
, shouldBe
|
||||||
|
, shouldNotBe
|
||||||
|
, shouldSatisfy
|
||||||
|
)
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
import qualified Actions.EditGoalieSpec as EditGoalie
|
||||||
|
import qualified Actions.NewGameSpec as NewGame
|
||||||
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Actions" $ do
|
spec = describe "Mtlstats.Actions" $ do
|
||||||
startNewSeasonSpec
|
startNewSeasonSpec
|
||||||
startNewGameSpec
|
startNewGameSpec
|
||||||
resetYtdSpec
|
resetYtdSpec
|
||||||
|
resetStandingsSpec
|
||||||
addCharSpec
|
addCharSpec
|
||||||
removeCharSpec
|
removeCharSpec
|
||||||
overtimeCheckSpec
|
|
||||||
updateGameStatsSpec
|
|
||||||
validateGameDateSpec
|
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
|
createGoalieSpec
|
||||||
|
editPlayerSpec
|
||||||
|
editGoalieSpec
|
||||||
addPlayerSpec
|
addPlayerSpec
|
||||||
recordGoalAssistsSpec
|
addGoalieSpec
|
||||||
awardGoalSpec
|
resetCreatePlayerStateSpec
|
||||||
awardAssistSpec
|
resetCreateGoalieStateSpec
|
||||||
resetGoalDataSpec
|
backHomeSpec
|
||||||
|
scrollUpSpec
|
||||||
|
scrollDownSpec
|
||||||
|
NewGame.spec
|
||||||
|
EditGoalie.spec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
@@ -73,8 +90,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
|
||||||
@@ -100,19 +117,52 @@ resetYtdSpec = describe "resetYtd" $
|
|||||||
ytd ^. gsGames `shouldBe` 0
|
ytd ^. gsGames `shouldBe` 0
|
||||||
ytd ^. gsMinsPlayed `shouldBe` 0
|
ytd ^. gsMinsPlayed `shouldBe` 0
|
||||||
ytd ^. gsGoalsAllowed `shouldBe` 0
|
ytd ^. gsGoalsAllowed `shouldBe` 0
|
||||||
ytd ^. gsGoalsAgainst `shouldBe` 0
|
|
||||||
ytd ^. gsWins `shouldBe` 0
|
ytd ^. gsWins `shouldBe` 0
|
||||||
ytd ^. gsLosses `shouldBe` 0
|
ytd ^. gsLosses `shouldBe` 0
|
||||||
ytd ^. gsTies `shouldBe` 0
|
ytd ^. gsTies `shouldBe` 0
|
||||||
lt ^. gsGames `shouldNotBe` 0
|
lt ^. gsGames `shouldNotBe` 0
|
||||||
lt ^. gsMinsPlayed `shouldNotBe` 0
|
lt ^. gsMinsPlayed `shouldNotBe` 0
|
||||||
lt ^. gsGoalsAllowed `shouldNotBe` 0
|
lt ^. gsGoalsAllowed `shouldNotBe` 0
|
||||||
lt ^. gsGoalsAgainst `shouldNotBe` 0
|
|
||||||
lt ^. gsWins `shouldNotBe` 0
|
lt ^. gsWins `shouldNotBe` 0
|
||||||
lt ^. gsLosses `shouldNotBe` 0
|
lt ^. gsLosses `shouldNotBe` 0
|
||||||
lt ^. gsTies `shouldNotBe` 0) $
|
lt ^. gsTies `shouldNotBe` 0) $
|
||||||
s ^. database . dbGoalies
|
s ^. 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
|
||||||
@@ -136,208 +186,30 @@ 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
|
||||||
s = createPlayer newProgState
|
s = createPlayer newProgState
|
||||||
in show (s^.progMode) `shouldBe` "CreatePlayer"
|
in show (s^.progMode) `shouldBe` "CreatePlayer"
|
||||||
|
|
||||||
|
createGoalieSpec :: Spec
|
||||||
|
createGoalieSpec = describe "createGoalie" $
|
||||||
|
it "should change the mode appropriately" $ let
|
||||||
|
s = createGoalie newProgState
|
||||||
|
in show (s^.progMode) `shouldBe` "CreateGoalie"
|
||||||
|
|
||||||
|
editPlayerSpec :: Spec
|
||||||
|
editPlayerSpec = describe "editPlayer" $
|
||||||
|
it "should change the mode appropriately" $ let
|
||||||
|
s = editPlayer newProgState
|
||||||
|
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||||
|
|
||||||
|
editGoalieSpec :: Spec
|
||||||
|
editGoalieSpec = describe "editGoalie" $
|
||||||
|
it "should change the mode appropriately" $ let
|
||||||
|
s = editGoalie newProgState
|
||||||
|
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
addPlayerSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
addPlayerSpec = describe "addPlayer" $ do
|
||||||
let
|
let
|
||||||
@@ -362,222 +234,91 @@ addPlayerSpec = describe "addPlayer" $ do
|
|||||||
s' = addPlayer $ s MainMenu
|
s' = addPlayer $ s MainMenu
|
||||||
in s'^.database.dbPlayers `shouldBe` [p1]
|
in s'^.database.dbPlayers `shouldBe` [p1]
|
||||||
|
|
||||||
recordGoalAssistsSpec :: Spec
|
addGoalieSpec :: Spec
|
||||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
addGoalieSpec = describe "addGoalie" $ do
|
||||||
let
|
let
|
||||||
joe = newPlayer 1 "Joe" "centre"
|
g1 = newGoalie 2 "Joe"
|
||||||
bob = newPlayer 2 "Bob" "defense"
|
g2 = newGoalie 3 "Bob"
|
||||||
steve = newPlayer 3 "Steve" "forward"
|
db = newDatabase
|
||||||
dave = newPlayer 4 "Dave" "somewhere"
|
& dbGoalies .~ [g1]
|
||||||
frank = newPlayer 5 "Frank" "elsewhere"
|
s pm = newProgState
|
||||||
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
|
& database .~ db
|
||||||
|
& progMode .~ pm
|
||||||
|
|
||||||
mapM_
|
context "data available" $
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
it "should create the goalie" $ let
|
||||||
context pName $ do
|
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
|
||||||
|
& cgsNumber ?~ 3
|
||||||
|
& cgsName .~ "Bob"
|
||||||
|
in s'^.database.dbGoalies `shouldBe` [g1, g2]
|
||||||
|
|
||||||
|
context "data unavailable" $
|
||||||
|
it "should not create the goalie" $ let
|
||||||
|
s' = addGoalie $ s MainMenu
|
||||||
|
in s'^.database.dbGoalies `shouldBe` [g1]
|
||||||
|
|
||||||
|
resetCreatePlayerStateSpec :: Spec
|
||||||
|
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
||||||
|
cps = newCreatePlayerState
|
||||||
|
& cpsNumber ?~ 1
|
||||||
|
& cpsName .~ "Joe"
|
||||||
|
& cpsPosition .~ "centre"
|
||||||
|
ps = resetCreatePlayerState $
|
||||||
|
newProgState & progMode.createPlayerStateL .~ cps
|
||||||
|
in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
|
||||||
|
|
||||||
|
resetCreateGoalieStateSpec :: Spec
|
||||||
|
resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
||||||
|
cgs = newCreateGoalieState
|
||||||
|
& cgsNumber ?~ 1
|
||||||
|
& cgsName .~ "Joe"
|
||||||
|
ps = resetCreateGoalieState $
|
||||||
|
newProgState & progMode.createGoalieStateL .~ cgs
|
||||||
|
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||||
|
|
||||||
|
backHomeSpec :: Spec
|
||||||
|
backHomeSpec = describe "backHome" $ do
|
||||||
let
|
let
|
||||||
ps' = awardGoal pid ps
|
input = newProgState
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
& progMode.gameStateL .~ newGameState
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
& inputBuffer .~ "foo"
|
||||||
|
& scrollOffset .~ 123
|
||||||
|
result = backHome input
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date goals") $
|
it "should set the program mode back to MainMenu" $
|
||||||
player^.pYtd.psGoals `shouldBe` ytd
|
result^.progMode `shouldSatisfy` \case
|
||||||
|
MainMenu -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s lifetime goals") $
|
it "should clear the input buffer" $
|
||||||
player^.pLifetime.psGoals `shouldBe` lt
|
result^.inputBuffer `shouldBe` ""
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s game goals") $
|
it "should reset the scroll offset" $
|
||||||
gStats^.psGoals `shouldBe` game)
|
result^.scrollOffset `shouldBe` 0
|
||||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
|
||||||
[ ( "Joe", 0, 2, 3, 2 )
|
|
||||||
, ( "Bob", 1, 4, 5, 1 )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "invalid index" $ let
|
scrollUpSpec :: Spec
|
||||||
ps' = awardGoal 2 ps
|
scrollUpSpec = describe "scrollUp" $ do
|
||||||
in it "should not change the database" $
|
|
||||||
ps'^.database `shouldBe` db
|
|
||||||
|
|
||||||
context "negative index" $ let
|
context "scrolled down" $
|
||||||
ps' = awardGoal (-1) ps
|
it "should decrease the scroll offset by one" $ let
|
||||||
in it "should not change the database" $
|
ps = newProgState & scrollOffset .~ 10
|
||||||
ps'^.database `shouldBe` db
|
ps' = scrollUp ps
|
||||||
|
in ps'^.scrollOffset `shouldBe` 9
|
||||||
|
|
||||||
awardAssistSpec :: Spec
|
context "at top" $
|
||||||
awardAssistSpec = describe "awardAssist" $ do
|
it "should keep the scroll offset at zero" $ let
|
||||||
let
|
ps = scrollUp newProgState
|
||||||
joe
|
in ps^.scrollOffset `shouldBe` 0
|
||||||
= 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_
|
context "above top" $
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
it "should return the scroll offset to zero" $ let
|
||||||
context pName $ do
|
ps = newProgState & scrollOffset .~ (-10)
|
||||||
let
|
ps' = scrollUp ps
|
||||||
ps' = awardAssist pid ps
|
in ps'^.scrollOffset `shouldBe` 0
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date assists") $
|
scrollDownSpec :: Spec
|
||||||
player^.pYtd.psAssists `shouldBe` ytd
|
scrollDownSpec = describe "scrollDown" $
|
||||||
|
it "should increase the scroll offset" $ let
|
||||||
it ("should increment " ++ pName ++ "'s lifetime assists") $
|
ps = newProgState & scrollOffset .~ 10
|
||||||
player^.pLifetime.psAssists `shouldBe` lt
|
ps' = scrollDown ps
|
||||||
|
in ps'^.scrollOffset `shouldBe` 11
|
||||||
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
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
makeNum :: IO Int
|
|
||||||
makeNum = randomRIO (1, 10)
|
|
||||||
|
|
||||||
makeName :: IO String
|
|
||||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -33,6 +35,12 @@ spec = describe "Mtlstats.Format" $ do
|
|||||||
centreSpec
|
centreSpec
|
||||||
overlaySpec
|
overlaySpec
|
||||||
monthSpec
|
monthSpec
|
||||||
|
labelTableSpec
|
||||||
|
numTableSpec
|
||||||
|
tableWithSpec
|
||||||
|
complexTableSpec
|
||||||
|
overlayLastSpec
|
||||||
|
showFloatingSpec
|
||||||
|
|
||||||
padNumSpec :: Spec
|
padNumSpec :: Spec
|
||||||
padNumSpec = describe "padNum" $ do
|
padNumSpec = describe "padNum" $ do
|
||||||
@@ -111,3 +119,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
|
||||||
|
|||||||
66
test/Helpers/GoalieSpec.hs
Normal file
66
test/Helpers/GoalieSpec.hs
Normal file
@@ -0,0 +1,66 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Helpers.GoalieSpec (spec) where
|
||||||
|
|
||||||
|
import Lens.Micro ((&), (.~), (%~))
|
||||||
|
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Goalie
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Goalie"
|
||||||
|
goalieDetailsSpec
|
||||||
|
|
||||||
|
goalieDetailsSpec :: Spec
|
||||||
|
goalieDetailsSpec = describe "goalieDetails" $ let
|
||||||
|
input = newGoalie 1 "Joe"
|
||||||
|
& gYtd
|
||||||
|
%~ ( gsGames .~ 2 )
|
||||||
|
. ( gsMinsPlayed .~ 3 )
|
||||||
|
. ( gsGoalsAllowed .~ 4 )
|
||||||
|
. ( gsWins .~ 5 )
|
||||||
|
. ( gsLosses .~ 6 )
|
||||||
|
. ( gsTies .~ 7 )
|
||||||
|
& gLifetime
|
||||||
|
%~ ( gsGames .~ 8 )
|
||||||
|
. ( gsMinsPlayed .~ 9 )
|
||||||
|
. ( gsGoalsAllowed .~ 10 )
|
||||||
|
. ( gsWins .~ 11 )
|
||||||
|
. ( gsLosses .~ 12 )
|
||||||
|
. ( gsTies .~ 13 )
|
||||||
|
|
||||||
|
expected = unlines
|
||||||
|
[ "Number: 1"
|
||||||
|
, " Name: Joe"
|
||||||
|
, ""
|
||||||
|
, " YTD Lifetime"
|
||||||
|
, " Games played 2 8"
|
||||||
|
, " Mins played 3 9"
|
||||||
|
, "Goals allowed 4 10"
|
||||||
|
, " Wins 5 11"
|
||||||
|
, " Losses 6 12"
|
||||||
|
, " Ties 7 13"
|
||||||
|
]
|
||||||
|
|
||||||
|
in it "should format the output correctly" $
|
||||||
|
goalieDetails input `shouldBe` expected
|
||||||
61
test/Helpers/PlayerSpec.hs
Normal file
61
test/Helpers/PlayerSpec.hs
Normal file
@@ -0,0 +1,61 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Helpers.PlayerSpec (spec) where
|
||||||
|
|
||||||
|
import Lens.Micro ((&), (.~))
|
||||||
|
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Player
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Player"
|
||||||
|
playerDetailsSpec
|
||||||
|
|
||||||
|
playerDetailsSpec :: Spec
|
||||||
|
playerDetailsSpec = describe "playerDetails" $
|
||||||
|
it "should give a detailed description" $ let
|
||||||
|
|
||||||
|
p = 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 Lifetime"
|
||||||
|
, " Goals 2 5"
|
||||||
|
, " Assists 3 6"
|
||||||
|
, "Penalty mins 4 7"
|
||||||
|
]
|
||||||
|
|
||||||
|
in playerDetails p `shouldBe` expected
|
||||||
32
test/HelpersSpec.hs
Normal file
32
test/HelpersSpec.hs
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module 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
|
||||||
@@ -21,7 +21,7 @@ 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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -21,13 +21,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||||
|
|
||||||
module TypesSpec (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 (randomRIO)
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
@@ -35,6 +44,9 @@ import Mtlstats.Types
|
|||||||
|
|
||||||
import qualified Types.MenuSpec as Menu
|
import qualified Types.MenuSpec as Menu
|
||||||
|
|
||||||
|
class Comparable a where
|
||||||
|
compareTest :: a -> a -> Spec
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Types" $ do
|
spec = describe "Mtlstats.Types" $ do
|
||||||
playerSpec
|
playerSpec
|
||||||
@@ -43,6 +55,9 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
databaseSpec
|
databaseSpec
|
||||||
gameStateLSpec
|
gameStateLSpec
|
||||||
createPlayerStateLSpec
|
createPlayerStateLSpec
|
||||||
|
createGoalieStateLSpec
|
||||||
|
editPlayerStateLSpec
|
||||||
|
editGoalieStateLSpec
|
||||||
teamScoreSpec
|
teamScoreSpec
|
||||||
otherScoreSpec
|
otherScoreSpec
|
||||||
homeTeamSpec
|
homeTeamSpec
|
||||||
@@ -54,11 +69,19 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
gmsGamesSpec
|
gmsGamesSpec
|
||||||
gmsPointsSpec
|
gmsPointsSpec
|
||||||
addGameStatsSpec
|
addGameStatsSpec
|
||||||
pPointsSpec
|
|
||||||
playerSearchSpec
|
playerSearchSpec
|
||||||
playerSearchExactSpec
|
playerSearchExactSpec
|
||||||
modifyPlayerSpec
|
modifyPlayerSpec
|
||||||
playerSummarySpec
|
playerSummarySpec
|
||||||
|
playerIsActiveSpec
|
||||||
|
psPointsSpec
|
||||||
|
addPlayerStatsSpec
|
||||||
|
goalieSearchSpec
|
||||||
|
goalieSearchExactSpec
|
||||||
|
goalieSummarySpec
|
||||||
|
goalieIsActiveSpec
|
||||||
|
addGoalieStatsSpec
|
||||||
|
gsAverageSpec
|
||||||
Menu.spec
|
Menu.spec
|
||||||
|
|
||||||
playerSpec :: Spec
|
playerSpec :: Spec
|
||||||
@@ -77,43 +100,96 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
|
|||||||
gameStateLSpec :: Spec
|
gameStateLSpec :: Spec
|
||||||
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
|
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
|
||||||
-- getters
|
-- getters
|
||||||
[ ( MainMenu, newGameState )
|
[ ( "missing state", MainMenu, newGameState )
|
||||||
, ( NewGame $ gs HomeGame, gs HomeGame )
|
, ( "home game", NewGame $ gs HomeGame, gs HomeGame )
|
||||||
|
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
|
||||||
]
|
]
|
||||||
-- setters
|
-- setters
|
||||||
[ ( MainMenu, gs HomeGame )
|
[ ( "set home", MainMenu, gs HomeGame )
|
||||||
, ( NewGame $ gs HomeGame, gs AwayGame )
|
, ( "home to away", NewGame $ gs HomeGame, gs AwayGame )
|
||||||
, ( NewGame $ gs HomeGame, newGameState )
|
, ( "away to home", NewGame $ gs AwayGame, gs HomeGame )
|
||||||
|
, ( "clear home", NewGame $ gs HomeGame, newGameState )
|
||||||
|
, ( "clear away", NewGame $ gs AwayGame, newGameState )
|
||||||
]
|
]
|
||||||
where gs t = newGameState & gameType ?~ t
|
where gs t = newGameState & gameType ?~ t
|
||||||
|
|
||||||
createPlayerStateLSpec :: Spec
|
createPlayerStateLSpec :: Spec
|
||||||
createPlayerStateLSpec = describe "createPlayerStateL" $ do
|
createPlayerStateLSpec = describe "createPlayerStateL" $
|
||||||
context "getters" $ do
|
lensSpec createPlayerStateL
|
||||||
context "state missing" $ let
|
-- getters
|
||||||
pm = MainMenu
|
[ ( "missing state", MainMenu, newCreatePlayerState )
|
||||||
cps = pm^.createPlayerStateL
|
, ( "with state", CreatePlayer cps1, cps1 )
|
||||||
in it "should not have a number" $
|
]
|
||||||
cps^.cpsNumber `shouldBe` Nothing
|
-- setters
|
||||||
|
[ ( "missing state", MainMenu, cps1 )
|
||||||
|
, ( "change state", CreatePlayer cps1, cps2 )
|
||||||
|
, ( "clear state", CreatePlayer cps1, newCreatePlayerState )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
cps1 = newCreatePlayerState
|
||||||
|
& cpsNumber ?~ 1
|
||||||
|
& cpsName .~ "Joe"
|
||||||
|
& cpsPosition .~ "centre"
|
||||||
|
cps2 = newCreatePlayerState
|
||||||
|
& cpsNumber ?~ 2
|
||||||
|
& cpsName .~ "Bob"
|
||||||
|
& cpsPosition .~ "defense"
|
||||||
|
|
||||||
context "existing state" $ let
|
createGoalieStateLSpec :: Spec
|
||||||
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
|
createGoalieStateLSpec = describe "createGoalieStateL" $
|
||||||
cps = pm^.createPlayerStateL
|
lensSpec createGoalieStateL
|
||||||
in it "should have a number of 1" $
|
-- getters
|
||||||
cps^.cpsNumber `shouldBe` Just 1
|
[ ( "missing state", MainMenu, newCreateGoalieState )
|
||||||
|
, ( "with state", CreateGoalie cgs1, cgs1 )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set state", MainMenu, cgs1 )
|
||||||
|
, ( "change state", CreateGoalie cgs1, cgs2 )
|
||||||
|
, ( "clear state", CreateGoalie cgs1, newCreateGoalieState )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
cgs1 = newCreateGoalieState
|
||||||
|
& cgsNumber ?~ 1
|
||||||
|
& cgsName .~ "Joe"
|
||||||
|
cgs2 = newCreateGoalieState
|
||||||
|
& cgsNumber ?~ 2
|
||||||
|
& cgsName .~ "Bob"
|
||||||
|
|
||||||
context "setters" $ do
|
editPlayerStateLSpec :: Spec
|
||||||
context "state missing" $ let
|
editPlayerStateLSpec = describe "editPlayerStateL" $
|
||||||
pm = MainMenu
|
lensSpec editPlayerStateL
|
||||||
pm' = pm & createPlayerStateL.cpsNumber ?~ 1
|
-- getters
|
||||||
in it "should set the player number to 1" $
|
[ ( "missing state", MainMenu, newEditPlayerState )
|
||||||
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1
|
, ( "withState", EditPlayer eps1, eps1 )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set state", MainMenu, eps1 )
|
||||||
|
, ( "change state", EditPlayer eps1, eps2 )
|
||||||
|
, ( "clear state", EditPlayer eps1, newEditPlayerState )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
eps1 = newEditPlayerState
|
||||||
|
& epsSelectedPlayer ?~ 1
|
||||||
|
eps2 = newEditPlayerState
|
||||||
|
& epsSelectedPlayer ?~ 2
|
||||||
|
|
||||||
context "existing state" $ let
|
editGoalieStateLSpec :: Spec
|
||||||
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1
|
editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||||
pm' = pm & createPlayerStateL.cpsNumber ?~ 2
|
lensSpec editGoalieStateL
|
||||||
in it "should set the player number to 2" $
|
-- getters
|
||||||
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2
|
[ ( "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
|
||||||
|
|
||||||
teamScoreSpec :: Spec
|
teamScoreSpec :: Spec
|
||||||
teamScoreSpec = describe "teamScore" $ do
|
teamScoreSpec = describe "teamScore" $ do
|
||||||
@@ -175,24 +251,23 @@ jsonSpec x j = do
|
|||||||
decode (encode x) `shouldBe` Just x
|
decode (encode x) `shouldBe` Just x
|
||||||
|
|
||||||
lensSpec
|
lensSpec
|
||||||
:: (Eq a, Show s, Show a)
|
:: Comparable a
|
||||||
=> Lens' s a
|
=> Lens' s a
|
||||||
-> [(s, a)]
|
-> [(String, s, a)]
|
||||||
-> [(s, a)]
|
-> [(String, s, a)]
|
||||||
-> Spec
|
-> Spec
|
||||||
lensSpec l gs ss = do
|
lensSpec lens getters setters = do
|
||||||
|
|
||||||
context "getters" $ mapM_
|
context "getters" $ mapM_
|
||||||
(\(s, x) -> context (show s) $
|
(\(label, s, x) -> context label $
|
||||||
it ("should be " ++ show x) $
|
compareTest (s^.lens) x)
|
||||||
s ^. l `shouldBe` x)
|
getters
|
||||||
gs
|
|
||||||
|
|
||||||
context "setters" $ mapM_
|
context "setters" $ mapM_
|
||||||
(\(s, x) -> context (show s) $
|
(\(label, s, x) -> context label $ let
|
||||||
it ("should set to " ++ show x) $
|
s' = s & lens .~ x
|
||||||
(s & l .~ x) ^. l `shouldBe` x)
|
in compareTest (s'^.lens) x)
|
||||||
ss
|
setters
|
||||||
|
|
||||||
player :: Player
|
player :: Player
|
||||||
player = newPlayer 1 "Joe" "centre"
|
player = newPlayer 1 "Joe" "centre"
|
||||||
@@ -239,7 +314,7 @@ goalieStats n = newGoalieStats
|
|||||||
& gsGames .~ n
|
& gsGames .~ n
|
||||||
& gsMinsPlayed .~ n + 1
|
& gsMinsPlayed .~ n + 1
|
||||||
& gsGoalsAllowed .~ n + 2
|
& gsGoalsAllowed .~ n + 2
|
||||||
& gsGoalsAgainst .~ n + 3
|
& gsShutouts .~ n + 3
|
||||||
& gsWins .~ n + 4
|
& gsWins .~ n + 4
|
||||||
& gsLosses .~ n + 5
|
& gsLosses .~ n + 5
|
||||||
& gsTies .~ n + 6
|
& gsTies .~ n + 6
|
||||||
@@ -249,7 +324,7 @@ 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 )
|
||||||
, ( "goals_against", toJSON $ n + 3 )
|
, ( "shutouts", toJSON $ n + 3 )
|
||||||
, ( "wins", toJSON $ n + 4 )
|
, ( "wins", toJSON $ n + 4 )
|
||||||
, ( "losses", toJSON $ n + 5 )
|
, ( "losses", toJSON $ n + 5 )
|
||||||
, ( "ties", toJSON $ n + 6 )
|
, ( "ties", toJSON $ n + 6 )
|
||||||
@@ -509,24 +584,6 @@ addGameStatsSpec = describe "addGameStats" $
|
|||||||
|
|
||||||
in addGameStats s1 s2 `shouldBe` expected
|
in addGameStats s1 s2 `shouldBe` expected
|
||||||
|
|
||||||
pPointsSpec :: Spec
|
|
||||||
pPointsSpec = describe "pPoints" $ mapM_
|
|
||||||
(\(goals, assists, points) -> let
|
|
||||||
desc = "goals: " ++ show goals ++
|
|
||||||
", assists: " ++ show assists
|
|
||||||
stats = newPlayerStats &
|
|
||||||
psGoals .~ goals &
|
|
||||||
psAssists .~ assists
|
|
||||||
in context desc $
|
|
||||||
it ("should be " ++ show points) $
|
|
||||||
pPoints stats `shouldBe` points)
|
|
||||||
-- goals, assists, points
|
|
||||||
[ ( 0, 0, 0 )
|
|
||||||
, ( 1, 0, 1 )
|
|
||||||
, ( 0, 1, 1 )
|
|
||||||
, ( 2, 3, 5 )
|
|
||||||
]
|
|
||||||
|
|
||||||
playerSearchSpec :: Spec
|
playerSearchSpec :: Spec
|
||||||
playerSearchSpec = describe "playerSearch" $ mapM_
|
playerSearchSpec = describe "playerSearch" $ mapM_
|
||||||
(\(sStr, expected) -> context sStr $
|
(\(sStr, expected) -> context sStr $
|
||||||
@@ -534,7 +591,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", [] )
|
||||||
@@ -556,10 +613,10 @@ 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) $
|
||||||
@@ -584,6 +641,193 @@ 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"
|
||||||
|
|
||||||
|
playerIsActiveSpec :: Spec
|
||||||
|
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||||
|
let
|
||||||
|
pStats = newPlayerStats
|
||||||
|
& psGoals .~ 10
|
||||||
|
& psAssists .~ 11
|
||||||
|
& psPMin .~ 12
|
||||||
|
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(label, p', expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
playerIsActive p' `shouldBe` expected)
|
||||||
|
-- label, player, expected
|
||||||
|
[ ( "not active", p, False )
|
||||||
|
, ( "has goal", p & pYtd.psGoals .~ 1, True )
|
||||||
|
, ( "has assist", p & pYtd.psAssists .~ 1, True )
|
||||||
|
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
|
||||||
|
]
|
||||||
|
|
||||||
|
psPointsSpec :: Spec
|
||||||
|
psPointsSpec = describe "psPoints" $ mapM_
|
||||||
|
(\(goals, assists, points) -> let
|
||||||
|
desc = "goals: " ++ show goals ++
|
||||||
|
", assists: " ++ show assists
|
||||||
|
stats = newPlayerStats &
|
||||||
|
psGoals .~ goals &
|
||||||
|
psAssists .~ assists
|
||||||
|
in context desc $
|
||||||
|
it ("should be " ++ show points) $
|
||||||
|
psPoints stats `shouldBe` points)
|
||||||
|
-- goals, assists, points
|
||||||
|
[ ( 0, 0, 0 )
|
||||||
|
, ( 1, 0, 1 )
|
||||||
|
, ( 0, 1, 1 )
|
||||||
|
, ( 2, 3, 5 )
|
||||||
|
]
|
||||||
|
|
||||||
|
addPlayerStatsSpec :: Spec
|
||||||
|
addPlayerStatsSpec = describe "addPlayerStats" $ do
|
||||||
|
let
|
||||||
|
s1
|
||||||
|
= newPlayerStats
|
||||||
|
& psGoals .~ 1
|
||||||
|
& psAssists .~ 2
|
||||||
|
& psPMin .~ 3
|
||||||
|
s2
|
||||||
|
= newPlayerStats
|
||||||
|
& psGoals .~ 4
|
||||||
|
& psAssists .~ 5
|
||||||
|
& psPMin .~ 6
|
||||||
|
s3 = addPlayerStats s1 s2
|
||||||
|
|
||||||
|
describe "psGoals" $
|
||||||
|
it "should be 5" $
|
||||||
|
s3^.psGoals `shouldBe` 5
|
||||||
|
|
||||||
|
describe "psAssists" $
|
||||||
|
it "should be 7" $
|
||||||
|
s3^.psAssists `shouldBe` 7
|
||||||
|
|
||||||
|
describe "psPMin" $
|
||||||
|
it "should be 9" $
|
||||||
|
s3^.psPMin `shouldBe` 9
|
||||||
|
|
||||||
|
goalieSearchSpec :: Spec
|
||||||
|
goalieSearchSpec = describe "goalieSearch" $ do
|
||||||
|
let
|
||||||
|
goalies =
|
||||||
|
[ newGoalie 2 "Joe"
|
||||||
|
, newGoalie 3 "Bob"
|
||||||
|
, newGoalie 5 "Steve"
|
||||||
|
]
|
||||||
|
result n = (n, goalies!!n)
|
||||||
|
|
||||||
|
context "partial match" $
|
||||||
|
it "should return Joe and Steve" $
|
||||||
|
goalieSearch "e" goalies `shouldBe` [result 0, result 2]
|
||||||
|
|
||||||
|
context "no match" $
|
||||||
|
it "should return an empty list" $
|
||||||
|
goalieSearch "x" goalies `shouldBe` []
|
||||||
|
|
||||||
|
context "exact match" $
|
||||||
|
it "should return Bob" $
|
||||||
|
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||||
|
|
||||||
|
goalieSearchExactSpec :: Spec
|
||||||
|
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||||
|
let
|
||||||
|
goalies =
|
||||||
|
[ newGoalie 2 "Joe"
|
||||||
|
, newGoalie 3 "Bob"
|
||||||
|
, newGoalie 5 "Steve"
|
||||||
|
]
|
||||||
|
result n = (n, goalies!!n)
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(name, num) -> context name $
|
||||||
|
it ("should return " ++ name) $
|
||||||
|
goalieSearchExact name goalies `shouldBe` Just (result num))
|
||||||
|
-- name, num
|
||||||
|
[ ( "Joe", 0 )
|
||||||
|
, ( "Bob", 1 )
|
||||||
|
, ( "Steve", 2 )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "Greg" $
|
||||||
|
it "should return Nothing" $
|
||||||
|
goalieSearchExact "Greg" goalies `shouldBe` Nothing
|
||||||
|
|
||||||
|
goalieSummarySpec :: Spec
|
||||||
|
goalieSummarySpec = describe "goalieSummary" $
|
||||||
|
it "should provide a summary string" $
|
||||||
|
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
||||||
|
|
||||||
|
goalieIsActiveSpec :: Spec
|
||||||
|
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
|
||||||
|
(\(label, input, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
goalieIsActive input `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, input, expected
|
||||||
|
[ ( "inactive", inactive, False )
|
||||||
|
, ( "active", active, True )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
inactive = newGoalie 1 "Joe"
|
||||||
|
& gLifetime.gsMinsPlayed .~ 1
|
||||||
|
|
||||||
|
active = inactive
|
||||||
|
& gYtd.gsMinsPlayed .~ 1
|
||||||
|
|
||||||
|
addGoalieStatsSpec :: Spec
|
||||||
|
addGoalieStatsSpec = describe "addGoalieStats" $ let
|
||||||
|
g1 = GoalieStats
|
||||||
|
{ _gsGames = 1
|
||||||
|
, _gsMinsPlayed = 2
|
||||||
|
, _gsGoalsAllowed = 3
|
||||||
|
, _gsShutouts = 4
|
||||||
|
, _gsWins = 5
|
||||||
|
, _gsLosses = 6
|
||||||
|
, _gsTies = 7
|
||||||
|
}
|
||||||
|
|
||||||
|
g2 = GoalieStats
|
||||||
|
{ _gsGames = 8
|
||||||
|
, _gsMinsPlayed = 9
|
||||||
|
, _gsGoalsAllowed = 10
|
||||||
|
, _gsShutouts = 11
|
||||||
|
, _gsWins = 12
|
||||||
|
, _gsLosses = 13
|
||||||
|
, _gsTies = 14
|
||||||
|
}
|
||||||
|
|
||||||
|
expected = GoalieStats
|
||||||
|
{ _gsGames = 9
|
||||||
|
, _gsMinsPlayed = 11
|
||||||
|
, _gsGoalsAllowed = 13
|
||||||
|
, _gsShutouts = 15
|
||||||
|
, _gsWins = 17
|
||||||
|
, _gsLosses = 19
|
||||||
|
, _gsTies = 21
|
||||||
|
}
|
||||||
|
|
||||||
|
actual = g1 `addGoalieStats` g2
|
||||||
|
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|
||||||
|
gsAverageSpec :: Spec
|
||||||
|
gsAverageSpec = describe "gsAverage" $ mapM_
|
||||||
|
(\(label, stats, expected) -> context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
gsAverage stats `shouldBe` expected)
|
||||||
|
|
||||||
|
-- label, stats, expected
|
||||||
|
[ ( "with minutes", gs, 3 % 2 )
|
||||||
|
, ( "no minutes", newGoalieStats , 0 )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
gs = newGoalieStats
|
||||||
|
& gsMinsPlayed .~ 2 * gameLength
|
||||||
|
& gsGoalsAllowed .~ 3
|
||||||
|
|
||||||
joe :: Player
|
joe :: Player
|
||||||
joe = newPlayer 2 "Joe" "center"
|
joe = newPlayer 2 "Joe" "center"
|
||||||
|
|
||||||
@@ -592,3 +836,111 @@ 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
|
||||||
|
<*> makePlayerStats
|
||||||
|
<*> makePlayerStats
|
||||||
|
|
||||||
|
-- | Creates a 'Goalie'
|
||||||
|
makeGoalie :: IO Goalie
|
||||||
|
makeGoalie = Goalie
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeName
|
||||||
|
<*> 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)
|
||||||
|
|
||||||
|
makeName :: IO String
|
||||||
|
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||||
|
|
||||||
|
instance Comparable GoalieStats where
|
||||||
|
compareTest actual expected = mapM_
|
||||||
|
(\(name, lens) -> describe name $
|
||||||
|
it ("should be " ++ show (expected^.lens)) $
|
||||||
|
actual^.lens `shouldBe` expected^.lens)
|
||||||
|
-- name, lens
|
||||||
|
[ ( "gsGames", gsGames )
|
||||||
|
, ( "gsMinsPlayed", gsMinsPlayed )
|
||||||
|
, ( "gsGoalsAllowed", gsGoalsAllowed )
|
||||||
|
, ( "gsWins", gsWins )
|
||||||
|
, ( "gsLosses", gsLosses )
|
||||||
|
, ( "gsTies", gsTies )
|
||||||
|
]
|
||||||
|
|
||||||
|
instance Comparable GameState where
|
||||||
|
compareTest actual expected =
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|
||||||
|
instance Comparable CreatePlayerState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "cpsNumber" $
|
||||||
|
it ("should be " ++ show (expected^.cpsNumber)) $
|
||||||
|
actual^.cpsNumber `shouldBe` expected^.cpsNumber
|
||||||
|
|
||||||
|
describe "cpsName" $
|
||||||
|
it ("should be " ++ expected^.cpsName) $
|
||||||
|
actual^.cpsName `shouldBe` expected^.cpsName
|
||||||
|
|
||||||
|
describe "cpsPosition" $
|
||||||
|
it ("should be " ++ expected^.cpsPosition) $
|
||||||
|
actual^.cpsPosition `shouldBe` expected^.cpsPosition
|
||||||
|
|
||||||
|
instance Comparable EditPlayerState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "epsSelectedPlayer" $
|
||||||
|
it ("should be " ++ show (expected^.epsSelectedPlayer)) $
|
||||||
|
actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
|
||||||
|
|
||||||
|
describe "epsMode" $
|
||||||
|
it ("should be " ++ show (expected^.epsMode)) $
|
||||||
|
actual^.epsMode `shouldBe` expected^.epsMode
|
||||||
|
|
||||||
|
instance Comparable EditGoalieState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "egsSelectedGoalie" $
|
||||||
|
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
|
||||||
|
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
|
||||||
|
|
||||||
|
describe "egsMode" $
|
||||||
|
it ("should be " ++ show (expected^.egsMode)) $
|
||||||
|
actual^.egsMode `shouldBe` expected^.egsMode
|
||||||
|
|
||||||
|
instance Comparable CreateGoalieState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "cgsNuber" $
|
||||||
|
it("should be " ++ show (expected^.cgsNumber)) $
|
||||||
|
actual^.cgsNumber `shouldBe` expected^.cgsNumber
|
||||||
|
|
||||||
|
describe "cgsName" $
|
||||||
|
it ("should be " ++ expected^.cgsName) $
|
||||||
|
actual^.cgsName `shouldBe` expected^.cgsName
|
||||||
|
|||||||
@@ -21,13 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module UtilSpec (spec) where
|
module UtilSpec (spec) where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Util"
|
spec = describe "Mtlstats.Util" $ do
|
||||||
nthSpec
|
nthSpec
|
||||||
|
modifyNthSpec
|
||||||
|
updateMapSpec
|
||||||
|
sliceSpec
|
||||||
|
|
||||||
nthSpec :: Spec
|
nthSpec :: Spec
|
||||||
nthSpec = describe "nth" $ mapM_
|
nthSpec = describe "nth" $ mapM_
|
||||||
@@ -42,3 +46,50 @@ nthSpec = describe "nth" $ mapM_
|
|||||||
, ( 3, Nothing )
|
, ( 3, Nothing )
|
||||||
, ( -1, Nothing )
|
, ( -1, Nothing )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
modifyNthSpec :: Spec
|
||||||
|
modifyNthSpec = describe "modifyNth" $ do
|
||||||
|
let list = [1, 2, 3] :: [Int]
|
||||||
|
|
||||||
|
context "in bounds" $
|
||||||
|
it "should modify the value" $
|
||||||
|
modifyNth 1 succ list `shouldBe` [1, 3, 3]
|
||||||
|
|
||||||
|
context "out of bounds" $
|
||||||
|
it "should not modify the value" $
|
||||||
|
modifyNth 3 succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
|
context "negative index" $
|
||||||
|
it "should not modify the value" $
|
||||||
|
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
|
updateMapSpec :: Spec
|
||||||
|
updateMapSpec = describe "updateMap" $ do
|
||||||
|
let
|
||||||
|
input = M.fromList [(1, 2), (3, 5)]
|
||||||
|
|
||||||
|
context "key found" $ let
|
||||||
|
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
|
||||||
|
in it "should update the value" $
|
||||||
|
updateMap 1 10 succ input `shouldBe` expected
|
||||||
|
|
||||||
|
context "key not found" $ let
|
||||||
|
expected = M.fromList [(1, 2), (3, 5), (10, 11)]
|
||||||
|
in it "should create a new value and update the default" $
|
||||||
|
updateMap 10 10 succ input `shouldBe` expected
|
||||||
|
|
||||||
|
sliceSpec :: Spec
|
||||||
|
sliceSpec = describe "slice" $ do
|
||||||
|
let list = [2, 4, 6, 8] :: [Int]
|
||||||
|
|
||||||
|
context "sublist" $
|
||||||
|
it "should return the sublist" $
|
||||||
|
slice 1 2 list `shouldBe` [4, 6]
|
||||||
|
|
||||||
|
context "too large" $
|
||||||
|
it "should return as much of the list as possible" $
|
||||||
|
slice 1 100 list `shouldBe` [4, 6, 8]
|
||||||
|
|
||||||
|
context "negative offset" $
|
||||||
|
it "should return the correct number of elements from the beginning" $
|
||||||
|
slice (-10) 2 list `shouldBe` [2, 4]
|
||||||
|
|||||||
Reference in New Issue
Block a user