103 Commits
0.5.0 ... 0.7.0

Author SHA1 Message Date
Jonathan Lamothe
a9e12d11a9 version 0.7.0 2019-11-28 12:09:09 -05:00
Jonathan Lamothe
08be4154b3 updated change log 2019-11-28 12:04:48 -05:00
Jonathan Lamothe
4e25db12f1 Merge pull request #40 from mtlstats/goalie-stats
Goalie stats
2019-11-28 12:00:25 -05:00
Jonathan Lamothe
50389b4f4c renamed variable 2019-11-28 11:41:47 -05:00
Jonathan Lamothe
dcbb809ae1 implemented showFloating 2019-11-28 06:20:14 -05:00
Jonathan Lamothe
be54198960 implemented gsAverage 2019-11-28 06:05:42 -05:00
Jonathan Lamothe
e3d5af5f88 implemented addGoalieStats 2019-11-28 05:59:06 -05:00
Jonathan Lamothe
de67628df0 defined the structure of a goalie report 2019-11-28 05:47:45 -05:00
Jonathan Lamothe
4848e54d81 implemented goalieIsActive 2019-11-28 05:12:59 -05:00
Jonathan Lamothe
3b6f77ba21 implemented basic logic for generating goalie reports 2019-11-28 05:05:52 -05:00
Jonathan Lamothe
e7606c8a5e removed playerNameColumnWidth (no longer necessary) 2019-11-28 04:50:19 -05:00
Jonathan Lamothe
3560aa7595 refactored standingsReport 2019-11-28 04:33:03 -05:00
Jonathan Lamothe
5979856578 refactored playerReport 2019-11-28 04:32:12 -05:00
Jonathan Lamothe
4941e0e64f award shutouts 2019-11-28 02:30:12 -05:00
Jonathan Lamothe
eedeaed8fc implemented complexTable 2019-11-26 01:33:33 -05:00
Jonathan Lamothe
d0f237e707 implemented TableCell type 2019-11-26 00:34:01 -05:00
Jonathan Lamothe
8795cb46a9 refactored game entry control flow 2019-11-25 23:58:11 -05:00
Jonathan Lamothe
f1f7077c8c added gsShutouts field to GoalieStats 2019-11-22 03:00:42 -05:00
Jonathan Lamothe
a407a01339 Merge pull request #39 from mtlstats/shorten
Shorten
2019-11-20 22:09:59 -05:00
Jonathan Lamothe
3e1218f6ff updated change log 2019-11-20 22:02:25 -05:00
Jonathan Lamothe
7ff16b8ac2 shortened goalie edit header 2019-11-20 22:00:58 -05:00
Jonathan Lamothe
d7879a92af broke YTD and lifetime menus off from player edit menu 2019-11-18 22:11:17 -05:00
Jonathan Lamothe
9b9feefa4f broke Mtlstats.Menu.EditPlayer off from Mtlstats.Menu 2019-11-18 21:52:54 -05:00
Jonathan Lamothe
26a90a5ed9 shortened describePlayer output 2019-11-18 21:43:18 -05:00
Jonathan Lamothe
e8b850c23a refactored Mtlstats.Control.EditPlayer 2019-11-16 11:37:41 -05:00
Jonathan Lamothe
0efac07a33 added year-to-date and lifetime player edit modes 2019-11-16 11:01:29 -05:00
Jonathan Lamothe
fba5f1b96c version 0.6.0 2019-11-15 11:11:20 -05:00
Jonathan Lamothe
95853f8bd7 Merge pull request #38 from mtlstats/season-menu
fixed new season menu
2019-11-14 12:06:06 -05:00
Jonathan Lamothe
01a4141ff4 fixed new season menu
- use 'R' and 'P' instead of '1' and '2'
2019-11-14 11:54:59 -05:00
Jonathan Lamothe
4d6c3faf5e updated change log 2019-11-14 11:48:04 -05:00
Jonathan Lamothe
7824d56d68 Merge pull request #37 from mtlstats/reset-standings
reset game standings on new season
2019-11-14 11:35:26 -05:00
Jonathan Lamothe
e6e28618a3 reset game standings on new season 2019-11-14 11:21:52 -05:00
Jonathan Lamothe
b830947d6c Merge pull request #36 from mtlstats/goalie-edit
implemented goalie editing
2019-11-14 10:13:35 -05:00
Jonathan Lamothe
29ae55a01e updated change log 2019-11-14 03:08:04 -05:00
Jonathan Lamothe
5b9c18730c implemented editGoalieLtTies 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
61d788cb4e implemented editGoalieLtTiesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
aac2752e95 implemented Mtlstats.Control.EditGoalie.ltTiesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9456102935 implemented editGoalieLtLosses 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3ba3875752 implemented editGoalieLtLossesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
ac3b8e9522 implemented Mtlstats.Control.EditGoalie.ltLossesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
2860309fc5 implemented editGoalieLtWins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
dd34429f59 implemented editGoalieLtWinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
13acbbdf35 implemented Mtlstats.Control.EditGoalie.ltWinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
954fe98998 implemented editGoalieLtGoals 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
c0386fa0b9 implemented editGoalieLtGoalsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
846d034435 implemented Mtlstats.Control.EditGoalie.ltGoalsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3a1480115d implemented editGoalieLtMins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
30cfea0503 implemented editGoalieLtMinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
52d412942a implemented Mtlstats.Control.EditGoalie.ltMinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
afdb7653cd implemented editGoalieLtGames 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
6b1aa85010 implemented editGoalieLtGamesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
8c482ae785 implemented Mtlstats.Control.EditGoalie.ltGamesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f97db477dd implemented editGoalieYtdTies 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
101f436424 implemented editGoalieYtdTiesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
b8aa00aa81 implemented Mtlstats.Control.EditGoalie.ytdTiesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
4655cb37b9 implemented editGoalieYtdLosses 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
01859634a1 implemented editGoalieYtdLossesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
e50861613d implemented Mtlstats.Control.EditGoalie.ytdLossesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
14da1096cd implemented editGoalieYtdWins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
a8a5d6a305 implemented editGoalieYtdWinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
4f5b4ff5f9 implemented Mtlstats.Control.EditGoalie.ytdWinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
cb5aa63469 implemented editGoalieYtdGoals 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
817c3c3fed implemented editGoalieYtdGoalsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
5dcd140280 implemented Mtlstats.Control.EditGoalie.ytdGoalsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
023430d737 implemented editGoalieYtdMins 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0961f14c5f implemented editGoalieYtdMinsPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
1b9c072a76 implemented Mtlstats.Control.EditGoalie.ytdMinsC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
203650397e implemented editGoalieYtdGames 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f739db4203 implemented editGoalieYtdGamesPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
06348fe928 implemented Mtlstats.Control.EditGoalie.ytdGamesC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3839d6dd32 implemented editGoalieLtMenu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0234abec4c implemented Mtlstats.Control.EditGoalie.lifetimeMenuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9682aa0af3 implemented editGoalieYtdMenu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
35eda4a309 implemented Mtlstats.Control.EditGoalie.ytdMenuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
61ba781c5d implemented editGoalieName 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
fceba7eed1 implemented editGoalieNamePrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
895f090f17 implenented Mtlstats.Control.EditGoalie.nameC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
6c4b08bfcd renaned setGoalieNumber to editGoalieNumber 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0b3d70e7c3 implemented setGoalieNumber 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
0202ddadab implemented editGoalieNumberPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
75abf0ade8 implemented Mtlstats.Control.EditGoalie.numberC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
c24016210c implemented editGoalie 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
d1773324d5 added "Edit Goalie" to main menu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
758dc868ec implemented Mtlstats.Control.EditGoalie.header 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3c9b7dd989 broke Mtlstats.Menu.EditGoalie module off from Mtlstats.Menu 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f1f0ffef99 added control branches for goalie YTD and lifetime edit menus 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
d14abdb248 implemented menuControllerWith 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
e1f92ce92e implemented Mtlstats.Control.EditGoalie.menuC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
3dfbfe7090 implemented Mtlstats.Control.EditGoalie.editC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
f9849023bc implemented editGoalieStateL 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
8aa8d39f70 implemented goalieToEditPrompt 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
cadbd6354b implemented Mtlstats.Control.EditGoalie.selectC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
dde0291321 implemented editGoalieC 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
9a179ed166 added EditGoalieState and EditGoalieMode types 2019-11-14 03:07:26 -05:00
Jonathan Lamothe
858da7ab5c updated change log 2019-11-14 03:06:42 -05:00
Jonathan Lamothe
030cafb571 Merge pull request #35 from mtlstats/pedantic
be pedantic
2019-11-12 17:07:27 -05:00
Jonathan Lamothe
c99a39b2b9 be pedantic 2019-11-12 17:01:08 -05:00
Jonathan Lamothe
9288d885cd Merge pull request #34 from mtlstats/lifetime-report
generate lifetime report
2019-11-09 00:40:24 -05:00
Jonathan Lamothe
9f206ede72 generate lifetime report 2019-11-09 00:31:12 -05:00
Jonathan Lamothe
e802fff7c5 Merge pull request #33 from mtlstats/refactor
Refactor
2019-11-07 23:45:46 -05:00
Jonathan Lamothe
04140df812 removed redundant code (mostly imports) 2019-11-07 23:37:46 -05:00
Jonathan Lamothe
5339c57d5c fixed package.yaml
- added missing data
- fixed URL to readme
2019-11-07 22:56:56 -05:00
Jonathan Lamothe
ca2dd92bfe broke Actions Prompt and Control modules off into NewGame submodules 2019-11-07 22:36:08 -05:00
36 changed files with 3323 additions and 1335 deletions

View File

@@ -1,5 +1,14 @@
# Changelog for mtlstats
## 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

View File

@@ -1,5 +1,5 @@
name: mtlstats
version: 0.5.0
version: 0.7.0
github: "mtlstats/mtlstats"
license: GPL-3
author: "Jonathan Lamothe"
@@ -11,13 +11,13 @@ extra-source-files:
- ChangeLog.md
# Metadata used when publishing your package
# synopsis: Short description of your package
# category: Web
synopsis: Hockey statistics tracker
category: Statistics
# To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file.
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
dependencies:
- base >= 4.7 && < 5
@@ -33,6 +33,10 @@ dependencies:
- bytestring
- microlens
ghc-options:
- -Wall
- -Werror
library:
source-dirs: src

View File

@@ -24,37 +24,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Actions
( startNewSeason
, resetYtd
, resetStandings
, startNewGame
, addChar
, removeChar
, overtimeCheck
, updateGameStats
, validateGameDate
, createPlayer
, createGoalie
, editPlayer
, editGoalie
, addPlayer
, addGoalie
, resetCreatePlayerState
, resetCreateGoalieState
, recordGoalAssists
, awardGoal
, awardAssist
, resetGoalData
, assignPMins
, backHome
, scrollUp
, scrollDown
) where
import Control.Monad.Trans.State (modify)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
import Lens.Micro ((^.), (&), (.~), (%~))
import Mtlstats.Types
import Mtlstats.Util
-- | Starts a new season
startNewSeason :: ProgState -> ProgState
@@ -66,6 +57,12 @@ resetYtd
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
-- | Resets game standings
resetStandings :: ProgState -> ProgState
resetStandings = database
%~ ( dbHomeGameStats .~ newGameStats)
. ( dbAwayGameStats .~ newGameStats)
-- | Starts a new game
startNewGame :: ProgState -> ProgState
startNewGame
@@ -82,65 +79,6 @@ removeChar = inputBuffer %~ \case
"" -> ""
str -> init str
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gType <- gs^.gameType
won <- gameWon gs
lost <- gameLost gs
ot <- gs^.overtimeFlag
tScore <- teamScore gs
oScore <- otherScore gs
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
hgf = if gType == HomeGame then tScore else 0
hga = if gType == HomeGame then oScore else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
agf = if gType == AwayGame then tScore else 0
aga = if gType == AwayGame then oScore else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
. (gmsGoalsFor +~ hgf)
. (gmsGoalsAgainst +~ hga)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
. (gmsGoalsFor +~ agf)
. (gmsGoalsAgainst +~ aga)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState
validateGameDate s = fromMaybe s $ do
y <- toInteger <$> s^.progMode.gameStateL.gameYear
m <- s^.progMode.gameStateL.gameMonth
d <- s^.progMode.gameStateL.gameDay
Just $ if null $ fromGregorianValid y m d
then s & progMode.gameStateL
%~ (gameYear .~ Nothing)
. (gameMonth .~ Nothing)
. (gameDay .~ Nothing)
else s
-- | Starts player creation mode
createPlayer :: ProgState -> ProgState
createPlayer = let
@@ -163,6 +101,10 @@ createGoalie = let
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
addPlayer :: ProgState -> ProgState
addPlayer s = fromMaybe s $ do
@@ -199,81 +141,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
%~ (cgsNumber .~ Nothing)
. (cgsName .~ "")
-- | Awards the goal and assists to the players
recordGoalAssists :: ProgState -> ProgState
recordGoalAssists ps = fromMaybe ps $ do
let gs = ps^.progMode.gameStateL
goalId <- gs^.goalBy
let assistIds = gs^.assistsBy
Just $ ps
& awardGoal goalId
& (\s -> foldr awardAssist s assistIds)
& progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (pointsAccounted %~ succ)
. (confirmGoalDataFlag .~ False)
-- | Awards a goal to a player
awardGoal
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardGoal n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
-- | Awards an assist to a player
awardAssist
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardAssist n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState
resetGoalData ps = ps & progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (confirmGoalDataFlag .~ False)
-- | Adds penalty minutes to a player
assignPMins
:: Int
-- ^ The number of minutes to add
-> ProgState
-> ProgState
assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.gameSelectedPlayer
Just $ s
& database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
& progMode.gameStateL
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
(psPMin +~ mins)
)
. (gameSelectedPlayer .~ Nothing)
-- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState
backHome

View 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

View 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)

View File

@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Actions.GoalieInput
module Mtlstats.Actions.NewGame.GoalieInput
( finishGoalieEntry
, recordGoalieStats
, setGameGoalie
) where
import Control.Monad (void)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
@@ -43,9 +44,9 @@ recordGoalieStats :: ProgState -> ProgState
recordGoalieStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gid <- gs^.gameSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
mins <- gs^.gameGoalieMinsPlayed
goals <- gs^.gameGoalsAllowed
void $ nth gid $ s^.database.dbGoalies
let
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
then 1
else 0
bumpStats gs = gs
& gsGames +~ bumpVal
& gsMinsPlayed +~ mins
& gsGoalsAllowed +~ goals
bumpStats
= (gsGames +~ bumpVal)
. (gsMinsPlayed +~ mins)
. (gsGoalsAllowed +~ goals)
tryFinish = if mins >= gameLength
then finishGoalieEntry
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
l = if lost then 1 else 0
t = if tied then 1 else 0
updateStats gs = gs
& gsWins +~ w
& gsLosses +~ l
& gsTies +~ t
updateStats
= (gsWins +~ w)
. (gsLosses +~ l)
. (gsTies +~ t)
updateGoalie g = g
& gYtd %~ updateStats
& gLifetime %~ updateStats
updateGoalie
= (gYtd %~ updateStats)
. (gLifetime %~ updateStats)
updateGameState gs = gs
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
& gameGoalieAssigned .~ True
updateGameState
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
. (gameGoalieAssigned .~ True)
Just $ s
& database.dbGoalies %~ modifyNth gid updateGoalie

View File

@@ -21,25 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where
import Control.Monad (join, when)
import Control.Monad.Extra (ifM)
import Control.Monad (join)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Lens.Micro ((^.), (.~), (%~))
import Data.Maybe (fromJust)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Control.EditGoalie
import Mtlstats.Control.EditPlayer
import Mtlstats.Control.GoalieInput
import Mtlstats.Format
import Mtlstats.Control.NewGame
import Mtlstats.Handlers
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Report
import Mtlstats.Types
import Mtlstats.Util
-- | Reads the program state and returs the apropriate controller to
-- run
@@ -47,21 +43,7 @@ dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of
MainMenu -> mainMenuC
NewSeason -> newSeasonC
NewGame gs
| null $ gs^.gameYear -> gameYearC
| null $ gs^.gameMonth -> gameMonthC
| null $ gs^.gameDay -> gameDayC
| null $ gs^.gameType -> gameTypeC
| null $ gs^.otherTeam -> otherTeamC
| null $ gs^.homeScore -> homeScoreC
| null $ gs^.awayScore -> awayScoreC
| null $ gs^.overtimeFlag -> overtimeFlagC
| not $ gs^.dataVerified -> verifyDataC
| fromJust (unaccountedPoints gs) -> goalInput gs
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
| not $ gs^.gameGoalieAssigned -> goalieInput s
| otherwise -> reportC
NewGame gs -> newGameC gs
CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC
@@ -72,6 +54,7 @@ dispatch s = case s^.progMode of
| null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
mainMenuC :: Controller
mainMenuC = Controller
@@ -87,219 +70,6 @@ newSeasonC = Controller
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
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible
, handleController = \e -> do
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
getPlayerNumC :: Controller
getPlayerNumC = Controller
{ drawController = drawPrompt playerNumPrompt
@@ -381,15 +151,3 @@ confirmCreateGoalieC = Controller
Nothing -> return ()
return True
}
gameGoal :: ProgState -> (Int, Int)
gameGoal s =
( s^.database.dbGames
, succ $ s^.progMode.gameStateL.pointsAccounted
)
gameGoalAssist :: ProgState -> (Int, Int, Int)
gameGoalAssist s = let
(game, goal) = gameGoal s
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
in (game, goal, assist)

View 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"

View File

@@ -25,7 +25,9 @@ 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
@@ -40,6 +42,8 @@ editPlayerC eps
EPNumber -> numberC
EPName -> nameC
EPPosition -> positionC
EPYtd -> ytdC
EPLifetime -> lifetimeC
EPYtdGoals -> ytdGoalsC
EPYtdAssists -> ytdAssistsC
EPYtdPMin -> ytdPMinC
@@ -48,96 +52,46 @@ editPlayerC eps
EPLtPMin -> ltPMinC
selectPlayerC :: Controller
selectPlayerC = Controller
{ drawController = drawPrompt playerToEditPrompt
, handleController = \e -> do
promptHandler playerToEditPrompt e
return True
}
selectPlayerC = promptController playerToEditPrompt
menuC :: Controller
menuC = Controller
{ drawController = \s -> do
let
header = fromMaybe "" $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
p <- nth pid $ s^.database.dbPlayers
Just $ playerDetails p ++ "\n"
C.drawString header
drawMenu editPlayerMenu
, handleController = \e -> do
menuHandler editPlayerMenu e
return True
}
menuC = menuControllerWith header editPlayerMenu
numberC :: Controller
numberC = Controller
{ drawController = drawPrompt editPlayerNumPrompt
, handleController = \e -> do
promptHandler editPlayerNumPrompt e
return True
}
numberC = promptController editPlayerNumPrompt
nameC :: Controller
nameC = Controller
{ drawController = drawPrompt editPlayerNamePrompt
, handleController = \e -> do
promptHandler editPlayerNamePrompt e
return True
}
nameC = promptController editPlayerNamePrompt
positionC :: Controller
positionC = Controller
{ drawController = drawPrompt editPlayerPosPrompt
, handleController = \e -> do
promptHandler editPlayerPosPrompt e
return True
}
positionC = promptController editPlayerPosPrompt
ytdC :: Controller
ytdC = menuControllerWith header editPlayerYtdMenu
lifetimeC :: Controller
lifetimeC = menuControllerWith header editPlayerLtMenu
ytdGoalsC :: Controller
ytdGoalsC = Controller
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdGoalsPrompt e
return True
}
ytdGoalsC = promptController editPlayerYtdGoalsPrompt
ytdAssistsC :: Controller
ytdAssistsC = Controller
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdAssistsPrompt e
return True
}
ytdAssistsC = promptController editPlayerYtdAssistsPrompt
ytdPMinC :: Controller
ytdPMinC = Controller
{ drawController = drawPrompt editPlayerYtdPMinPrompt
, handleController = \e -> do
promptHandler editPlayerYtdPMinPrompt e
return True
}
ytdPMinC = promptController editPlayerYtdPMinPrompt
ltGoalsC :: Controller
ltGoalsC = Controller
{ drawController = drawPrompt editPlayerLtGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerLtGoalsPrompt e
return True
}
ltGoalsC = promptController editPlayerLtGoalsPrompt
ltAssistsC :: Controller
ltAssistsC = Controller
{ drawController = drawPrompt editPlayerLtAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerLtAssistsPrompt e
return True
}
ltAssistsC = promptController editPlayerLtAssistsPrompt
ltPMinC :: Controller
ltPMinC = Controller
{ drawController = drawPrompt editPlayerLtPMinPrompt
, handleController = \e -> do
promptHandler editPlayerLtPMinPrompt e
return True
}
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"

View 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)

View File

@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Control.GoalieInput (goalieInput) where
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
@@ -28,21 +28,17 @@ import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.GoalieInput
import Mtlstats.Prompt.NewGame.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
-- | The dispatcher for handling goalie input
goalieInput :: ProgState -> Controller
goalieInput s = let
gs = s^.progMode.gameStateL
in if gs^.gameGoaliesRecorded
then selectGameGoalieC s
else if null $ gs^.gameSelectedGoalie
then selectGoalieC
else if null $ gs^.gameGoalieMinsPlayed
then minsPlayedC
else goalsAllowedC
goalieInputC :: GameState -> Controller
goalieInputC gs
| gs^.gameGoaliesRecorded = selectGameGoalieC
| null $ gs^.gameSelectedGoalie = selectGoalieC
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
| otherwise = goalsAllowedC
selectGoalieC :: Controller
selectGoalieC = promptController selectGameGoaliePrompt
@@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
goalsAllowedC :: Controller
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: ProgState -> Controller
selectGameGoalieC = menuController . gameGoalieMenu
selectGameGoalieC :: Controller
selectGameGoalieC = menuStateController gameGoalieMenu
header :: ProgState -> C.Update ()
header s = C.drawString $ unlines

View File

@@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Format
( padNum
, left
@@ -26,8 +28,18 @@ module Mtlstats.Format
, centre
, overlay
, month
, labelTable
, numTable
, tableWith
, complexTable
, overlayLast
, showFloating
) where
import Data.List (transpose)
import Mtlstats.Types
-- | Pad an 'Int' with leading zeroes to fit a certain character width
padNum
:: Int
@@ -101,3 +113,84 @@ month 10 = "OCT"
month 11 = "NOV"
month 12 = "DEC"
month _ = ""
-- | Creates a two-column table with labels
labelTable :: [(String, String)] -> [String]
labelTable xs = let
labelWidth = maximum $ map (length . fst) xs
in map
(\(label, val) -> right labelWidth label ++ ": " ++ val)
xs
-- | Creates a variable column table of numbers with two axes
numTable
:: [String]
-- ^ The top column labels
-> [(String, [Int])]
-- ^ The rows with their labels
-> [String]
numTable headers rows = tableWith right $ header : body
where
header = "" : headers
body = map
(\(label, row) ->
label : map show row)
rows
-- | Creates a table from a two-dimensional list with a specified
-- padding function
tableWith
:: (Int -> String -> String)
-- ^ The padding function
-> [[String]]
-- ^ The cells
-> [String]
tableWith pFunc tData = complexTable
(repeat pFunc)
(map (map CellText) tData)
-- | Creates a complex table
complexTable
:: [Int -> String -> String]
-- ^ The padding function for each column
-> [[TableCell]]
-- ^ The table cells (an array of rows)
-> [String]
complexTable pFuncs tData = let
widths = map
(map $ \case
CellText str -> length str
CellFill _ -> 0)
tData
colWidths = map maximum $ transpose widths
bFunc = \case
[] -> ""
[(f, len, CellText str)] -> f len str
[(_, len, CellFill ch)] -> replicate len ch
(f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
(_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells
in map
(bFunc . zip3 pFuncs colWidths)
tData
-- | Places an overlay on the last line of an report
overlayLast
:: String
-- ^ The text to overlay
-> [String]
-- ^ The report to modify
-> [String]
-- ^ The resulting report
overlayLast _ [] = []
overlayLast str [l] = [overlay str l]
overlayLast str (l:ls) = l : overlayLast str ls
-- | Converts a non-integer into a string
showFloating :: RealFrac n => n -> String
showFloating n = let
i = round $ n * 100
whole = i `div` 100
fraction = i `mod` 100
in show whole ++ "." ++ padNum 2 fraction

View 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

View 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 )
]

View File

@@ -22,6 +22,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Menu (
-- * Menu Functions
menuController,
menuControllerWith,
menuStateController,
drawMenu,
menuHandler,
-- * Menus
@@ -29,7 +31,6 @@ module Mtlstats.Menu (
newSeasonMenu,
gameMonthMenu,
gameTypeMenu,
editPlayerMenu,
gameGoalieMenu
) where
@@ -39,7 +40,7 @@ import Data.Aeson (encodeFile)
import Data.Char (toUpper)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Lens.Micro ((^.), (.~), (?~))
import Lens.Micro ((^.), (?~))
import Lens.Micro.Extras (view)
import System.EasyFile
( createDirectoryIfMissing
@@ -49,7 +50,7 @@ import System.EasyFile
import qualified UI.NCurses as C
import Mtlstats.Actions
import qualified Mtlstats.Actions.GoalieInput as GI
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Types.Menu
@@ -57,13 +58,40 @@ import Mtlstats.Util
-- | Generates a simple 'Controller' for a Menu
menuController :: Menu () -> Controller
menuController menu = Controller
{ drawController = const $ drawMenu menu
menuController = menuControllerWith $ const $ return ()
-- | Generate a simple 'Controller' for a 'Menu' with a header
menuControllerWith
:: (ProgState -> C.Update ())
-- ^ Generates the header
-> Menu ()
-- ^ The menu
-> Controller
-- ^ The resulting controller
menuControllerWith header menu = Controller
{ drawController = \s -> do
header s
drawMenu menu
, handleController = \e -> do
menuHandler menu e
return True
}
-- | Generate and create a controller for a menu based on the current
-- 'ProgState'
menuStateController
:: (ProgState -> Menu ())
-- ^ The function to generate the menu
-> Controller
-- ^ The resulting controller
menuStateController menuFunc = Controller
{ drawController = drawMenu . menuFunc
, handleController = \e -> do
menu <- gets menuFunc
menuHandler menu e
return True
}
-- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode
drawMenu m = do
@@ -91,7 +119,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
modify createGoalie >> return True
, MenuItem '5' "Edit Player" $
modify editPlayer >> return True
, MenuItem '6' "Exit" $ do
, MenuItem '6' "Edit Goalie" $
modify editGoalie >> return True
, MenuItem 'X' "Exit" $ do
db <- gets $ view database
liftIO $ do
dir <- getAppUserDataDirectory appName
@@ -104,11 +134,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
-- | The new season menu
newSeasonMenu :: Menu ()
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
[ MenuItem '1' "Regular Season" $ do
modify resetYtd
modify startNewGame
, MenuItem '2' "Playoffs" $
modify startNewGame
[ MenuItem 'R' "Regular Season" $ modify
$ resetYtd
. resetStandings
. startNewGame
, MenuItem 'P' "Playoffs" $ modify
$ resetStandings
. startNewGame
]
-- | Requests the month in which the game took place
@@ -140,24 +172,6 @@ gameTypeMenu = Menu "Game type:" ()
modify $ progMode.gameStateL.gameType ?~ AwayGame
]
-- | The player edit menu
editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $ case mode of
Nothing -> modify $ progMode .~ MainMenu
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
[ ( '1', "Change number", Just EPNumber )
, ( '2', "Change name", Just EPName )
, ( '3', "Change position", Just EPPosition )
, ( '4', "YTD goals", Just EPYtdGoals )
, ( '5', "YTD assists", Just EPYtdAssists )
, ( '6', "YTD penalty mins", Just EPYtdPMin )
, ( '7', "Lifetime goals", Just EPLtGoals )
, ( '8', "Lifetime assists", Just EPLtAssists )
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
, ( '0', "Finished editing", Nothing )
]
-- | Game goalie selection menu
gameGoalieMenu :: ProgState -> Menu ()
gameGoalieMenu s = let

View 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)

View 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)

View File

@@ -31,11 +31,6 @@ module Mtlstats.Prompt (
numPrompt,
selectPrompt,
-- * Individual prompts
gameYearPrompt,
gameDayPrompt,
otherTeamPrompt,
homeScorePrompt,
awayScorePrompt,
playerNumPrompt,
playerNamePrompt,
playerPosPrompt,
@@ -43,10 +38,6 @@ module Mtlstats.Prompt (
goalieNamePrompt,
selectPlayerPrompt,
selectGoaliePrompt,
recordGoalPrompt,
recordAssistPrompt,
pMinPlayerPrompt,
assignPMinsPrompt,
playerToEditPrompt
) where
@@ -55,15 +46,13 @@ import Control.Monad.Extra (whenJust)
import Control.Monad.Trans.State (gets, modify)
import Data.Char (isDigit, toUpper)
import Data.Foldable (forM_)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Lens.Micro ((^.), (&), (.~), (?~))
import Lens.Micro.Extras (view)
import Text.Read (readMaybe)
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Types
import Mtlstats.Util
@@ -173,37 +162,12 @@ selectPrompt params = Prompt
n = pred $ fromInteger rawK
results = spSearch params sStr db
when (n < maxFunKeys) $
whenJust (nth n results) $ \(n, _) -> do
whenJust (nth n results) $ \(sel, _) -> do
modify $ inputBuffer .~ ""
spCallback params $ Just n
spCallback params $ Just sel
_ -> return ()
}
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
-- | Prompts for the other team name
otherTeamPrompt :: Prompt
otherTeamPrompt = strPrompt "Other team: " $
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $
modify . (progMode.gameStateL.awayScore ?~)
-- | Prompts for a new player's number
playerNumPrompt :: Prompt
playerNumPrompt = numPrompt "Player number: " $
@@ -285,52 +249,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
modify $ progMode .~ CreateGoalie cgs
}
-- | Prompts for the player who scored the goal
recordGoalPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal number
-> Prompt
recordGoalPrompt game goal = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Who scored goal number " ++ show goal ++ "? "
) $ modify . (progMode.gameStateL.goalBy .~)
-- | Prompts for a player who assisted the goal
recordAssistPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal nuber
-> Int
-- ^ The assist number
-> Prompt
recordAssistPrompt game goal assist = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Goal: " ++ show goal ++ "\n"
++ "Assist #" ++ show assist ++ ": "
) $ \case
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
Just n -> do
modify $ progMode.gameStateL.assistsBy %~ (++[n])
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-- | Prompts for the player to assign penalty minutes to
pMinPlayerPrompt :: Prompt
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-- | Prompts for the number of penalty mintues to assign to the player
assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins
playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)

View 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

View 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 = strPrompt "Other team: " $
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $ \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

View File

@@ -21,19 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt.GoalieInput
module Mtlstats.Prompt.NewGame.GoalieInput
( selectGameGoaliePrompt
, goalieMinsPlayedPrompt
, goalsAllowedPrompt
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (.~), (?~))
import Control.Monad.Trans.State (modify)
import Lens.Micro ((?~))
import Mtlstats.Actions.GoalieInput
import Mtlstats.Config
import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Prompt
import Mtlstats.Types

View File

@@ -19,10 +19,10 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Report (report, gameDate, playerNameColWidth) where
module Mtlstats.Report (report, gameDate) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, mapMaybe)
import Lens.Micro ((^.))
import Mtlstats.Config
@@ -43,6 +43,8 @@ report width s
++ gameStatsReport width s
++ [""]
++ yearToDateStatsReport width s
++ [""]
++ lifetimeStatsReport width s
standingsReport :: Int -> ProgState -> [String]
standingsReport width s = fromMaybe [] $ do
@@ -58,7 +60,8 @@ standingsReport width s = fromMaybe [] $ do
tStats = addGameStats hStats aStats
hScore <- gs^.homeScore
aScore <- gs^.awayScore
Just
let
rHeader =
[ overlay
("GAME NUMBER " ++ padNum 2 gNum)
(centre width
@@ -67,98 +70,187 @@ standingsReport width s = fromMaybe [] $ do
, date
, centre width "STANDINGS"
, ""
, centre width
$ left 11 myTeam
++ right 2 "G"
++ right 4 "W"
++ right 4 "L"
++ right 4 "OT"
++ right 4 "GF"
++ right 4 "GA"
++ right 4 "P"
, centre width
$ left 11 "HOME"
++ showStats hStats
, centre width
$ left 11 "ROAD"
++ showStats aStats
, centre width
$ replicate 11 ' '
++ replicate (2 + 4 * 6) '-'
, centre width
$ left 11 "TOTALS"
++ showStats tStats
]
tHeader =
[ CellText myTeam
, CellText " G"
, CellText " W"
, CellText " L"
, CellText " OT"
, CellText " GF"
, CellText " GA"
, CellText " P"
]
rowCells stats =
[ CellText $ show $ gmsGames stats
, CellText $ show $ stats^.gmsWins
, CellText $ show $ stats^.gmsLosses
, CellText $ show $ stats^.gmsOvertime
, CellText $ show $ stats^.gmsGoalsFor
, CellText $ show $ stats^.gmsGoalsAgainst
, CellText $ show $ gmsPoints stats
]
body =
[ CellText "HOME" : rowCells hStats
, CellText "ROAD" : rowCells aStats
]
separator = CellText "" : replicate 7 (CellFill '-')
totals = CellText "TOTALS" : rowCells tStats
table = map (centre width) $
complexTable
(left : repeat right)
(tHeader : body ++ [separator, totals])
Just $ rHeader ++ table
gameStatsReport :: Int -> ProgState -> [String]
gameStatsReport width s = playerReport width "GAME" $
fromMaybe [] $ mapM
gameStatsReport width s = let
gs = s^.progMode.gameStateL
db = s^.database
playerStats = mapMaybe
(\(pid, stats) -> do
p <- nth pid $ s^.database.dbPlayers
p <- nth pid $ db^.dbPlayers
Just (p, stats))
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
(M.toList $ gs^.gamePlayerStats)
goalieStats = mapMaybe
(\(gid, stats) -> do
g <- nth gid $ db^.dbGoalies
Just (g, stats))
(M.toList $ gs^.gameGoalieStats)
in playerReport width "GAME" playerStats
++ [""]
++ goalieReport width goalieStats
yearToDateStatsReport :: Int -> ProgState -> [String]
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
map (\p -> (p, p^.pYtd)) $
filter playerIsActive $ s^.database.dbPlayers
yearToDateStatsReport width s = let
db = s^.database
playerStats = 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 gs = fromMaybe "" $ do
year <- show <$> gs^.gameYear
month <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay
Just $ month ++ " " ++ day ++ " " ++ year
y <- show <$> gs^.gameYear
m <- month <$> gs^.gameMonth
d <- padNum 2 <$> gs^.gameDay
Just $ m ++ " " ++ d ++ " " ++ y
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
playerReport width label ps = let
nameWidth = playerNameColWidth $ map fst ps
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
in
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
rHeader =
[ centre width (label ++ " STATISTICS")
, ""
, centre width
$ "NO. "
++ left nameWidth "PLAYER"
++ right 3 "G"
++ right 6 "A"
++ right 6 "P"
++ right 6 "PM"
] ++ map
(\(p, stats) -> centre width
$ right 2 (show $ p^.pNumber)
++ " "
++ left nameWidth (p^.pName)
++ right 3 (show $ stats^.psGoals)
++ right 6 (show $ stats^.psAssists)
++ right 6 (show $ psPoints stats)
++ right 6 (show $ stats^.psPMin))
ps ++
[ centre width
$ replicate (4 + nameWidth) ' '
++ replicate (3 + 3 * 6) '-'
, overlay
(label ++ " TOTALS")
( centre width
$ replicate (4 + nameWidth) ' '
++ right 3 (show $ tStats^.psGoals)
++ right 6 (show $ tStats^.psAssists)
++ right 6 (show $ psPoints tStats)
++ right 6 (show $ tStats^.psPMin)
)
]
playerNameColWidth :: [Player] -> Int
playerNameColWidth = foldr
(\player current -> max current $ succ $ length $ player^.pName)
10
tHeader =
[ CellText "NO."
, CellText "Player"
, CellText " G"
, CellText " A"
, CellText " P"
, CellText " PM"
]
showStats :: GameStats -> String
showStats gs
= right 2 (show $ gmsGames gs)
++ right 4 (show $ gs^.gmsWins)
++ right 4 (show $ gs^.gmsLosses)
++ right 4 (show $ gs^.gmsOvertime)
++ right 4 (show $ gs^.gmsGoalsFor)
++ right 4 (show $ gs^.gmsGoalsAgainst)
++ right 4 (show $ gmsPoints gs)
statsCells stats =
[ CellText $ show $ stats^.psGoals
, CellText $ show $ stats^.psAssists
, CellText $ show $ psPoints stats
, CellText $ show $ stats^.psPMin
]
body = map
(\(p, stats) ->
[ CellText $ show (p^.pNumber) ++ " "
, CellText $ p^.pName
] ++ statsCells stats)
ps
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 $ show $ 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]

View File

@@ -33,6 +33,8 @@ module Mtlstats.Types (
CreateGoalieState (..),
EditPlayerState (..),
EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
Database (..),
Player (..),
PlayerStats (..),
@@ -41,6 +43,7 @@ module Mtlstats.Types (
GameStats (..),
Prompt (..),
SelectParams (..),
TableCell (..),
-- * Lenses
-- ** ProgState Lenses
database,
@@ -52,6 +55,7 @@ module Mtlstats.Types (
createPlayerStateL,
createGoalieStateL,
editPlayerStateL,
editGoalieStateL,
-- ** GameState Lenses
gameYear,
gameMonth,
@@ -89,6 +93,9 @@ module Mtlstats.Types (
-- ** EditPlayerState Lenses
epsSelectedPlayer,
epsMode,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
-- ** Database Lenses
dbPlayers,
dbGoalies,
@@ -114,6 +121,7 @@ module Mtlstats.Types (
gsGames,
gsMinsPlayed,
gsGoalsAllowed,
gsShutouts,
gsWins,
gsLosses,
gsTies,
@@ -129,6 +137,7 @@ module Mtlstats.Types (
newCreatePlayerState,
newCreateGoalieState,
newEditPlayerState,
newEditGoalieState,
newDatabase,
newPlayer,
newPlayerStats,
@@ -154,7 +163,6 @@ module Mtlstats.Types (
playerSearchExact,
modifyPlayer,
playerSummary,
playerDetails,
playerIsActive,
-- ** PlayerStats Helpers
psPoints,
@@ -162,7 +170,11 @@ module Mtlstats.Types (
-- ** Goalie Helpers
goalieSearch,
goalieSearchExact,
goalieSummary
goalieSummary,
goalieIsActive,
-- ** GoalieStats Helpers
addGoalieStats,
gsAverage
) where
import Control.Monad.Trans.State (StateT)
@@ -176,6 +188,8 @@ import Data.Aeson
, toJSON
, withObject
, (.:)
, (.:?)
, (.!=)
, (.=)
)
import Data.List (isInfixOf)
@@ -218,6 +232,7 @@ data ProgMode
| CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState
| EditGoalie EditGoalieState
instance Show ProgMode where
show MainMenu = "MainMenu"
@@ -226,6 +241,7 @@ instance Show ProgMode where
show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
-- | The game state
data GameState = GameState
@@ -326,6 +342,8 @@ data EditPlayerMode
| EPNumber
| EPName
| EPPosition
| EPYtd
| EPLifetime
| EPYtdGoals
| EPYtdAssists
| EPYtdPMin
@@ -334,6 +352,34 @@ data EditPlayerMode
| 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
data Database = Database
{ _dbPlayers :: [Player]
@@ -475,6 +521,8 @@ data GoalieStats = GoalieStats
-- ^ The number of minutes played
, _gsGoalsAllowed :: Int
-- ^ The number of goals allowed
, _gsShutouts :: Int
-- ^ The number of shutouts the goalie has accumulated
, _gsWins :: Int
-- ^ The number of wins
, _gsLosses :: Int
@@ -485,26 +533,29 @@ data GoalieStats = GoalieStats
instance FromJSON GoalieStats where
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
<$> v .: "games"
<*> v .: "mins_played"
<*> v .: "goals_allowed"
<*> v .: "wins"
<*> v .: "losses"
<*> v .: "ties"
<$> v .:? "games" .!= 0
<*> v .:? "mins_played" .!= 0
<*> v .:? "goals_allowed" .!= 0
<*> v .:? "shutouts" .!= 0
<*> v .:? "wins" .!= 0
<*> v .:? "losses" .!= 0
<*> v .:? "ties" .!= 0
instance ToJSON GoalieStats where
toJSON (GoalieStats g m a w l t) = object
toJSON (GoalieStats g m a s w l t) = object
[ "games" .= g
, "mins_played" .= m
, "goals_allowed" .= a
, "shutouts" .= s
, "wins" .= w
, "losses" .= l
, "ties" .= t
]
toEncoding (GoalieStats g m a w l t) = pairs $
toEncoding (GoalieStats g m a s w l t) = pairs $
"games" .= g <>
"mins_played" .= m <>
"goals_allowed" .= a <>
"shutouts" .= s <>
"wins" .= w <>
"losses" .= l <>
"ties" .= t
@@ -576,11 +627,20 @@ data SelectParams a = SelectParams
-- ^ The function to call when the selection doesn't exist
}
-- | Describes a table cell
data TableCell
= CellText String
-- ^ A cell with text
| CellFill Char
-- ^ A cell filled with the given character
deriving (Eq, Show)
makeLenses ''ProgState
makeLenses ''GameState
makeLenses ''CreatePlayerState
makeLenses ''CreateGoalieState
makeLenses ''EditPlayerState
makeLenses ''EditGoalieState
makeLenses ''Database
makeLenses ''Player
makeLenses ''PlayerStats
@@ -616,6 +676,13 @@ editPlayerStateL = lens
_ -> newEditPlayerState)
(\_ eps -> EditPlayer eps)
editGoalieStateL :: Lens' ProgMode EditGoalieState
editGoalieStateL = lens
(\case
EditGoalie egs -> egs
_ -> newEditGoalieState)
(\_ egs -> EditGoalie egs)
-- | Constructor for a 'ProgState'
newProgState :: ProgState
newProgState = ProgState
@@ -678,6 +745,13 @@ newEditPlayerState = EditPlayerState
, _epsMode = EPMenu
}
-- | Constructor for an 'EditGoalieState' value
newEditGoalieState :: EditGoalieState
newEditGoalieState = EditGoalieState
{ _egsSelectedGoalie = Nothing
, _egsMode = EGMenu
}
-- | Constructor for a 'Database'
newDatabase :: Database
newDatabase = Database
@@ -733,6 +807,7 @@ newGoalieStats = GoalieStats
{ _gsGames = 0
, _gsMinsPlayed = 0
, _gsGoalsAllowed = 0
, _gsShutouts = 0
, _gsWins = 0
, _gsLosses = 0
, _gsTies = 0
@@ -828,9 +903,8 @@ playerSearch
-> [(Int, Player)]
-- ^ The matching players with their index numbers
playerSearch sStr =
filter (match sStr) .
zip [0..]
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
filter match . zip [0..]
where match (_, p) = sStr `isInfixOf` (p^.pName)
-- | Searches for a player by exact match on name
playerSearchExact
@@ -841,10 +915,8 @@ playerSearchExact
-> Maybe (Int, Player)
-- ^ The player's index and value
playerSearchExact sStr =
listToMaybe .
filter (match sStr) .
zip [0..]
where match sStr (_, p) = p^.pName == sStr
listToMaybe . filter match . zip [0..]
where match (_, p) = p^.pName == sStr
-- | Modifies a player with a given name
modifyPlayer
@@ -866,20 +938,6 @@ playerSummary :: Player -> String
playerSummary p =
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
-- | Provides a detailed string describing a 'Player'
playerDetails :: Player -> String
playerDetails p = unlines
[ " Number: " ++ show (p^.pNumber)
, " Name: " ++ p^.pName
, " Position: " ++ p^.pPosition
, " YTD goals: " ++ show (p^.pYtd.psGoals)
, " YTD assists: " ++ show (p^.pYtd.psAssists)
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
]
-- | Determines whether or not a player has been active in the current
-- season/year
playerIsActive :: Player -> Bool
@@ -930,3 +988,24 @@ goalieSearchExact sStr goalies = let
-- | Provides a description string for a 'Goalie'
goalieSummary :: Goalie -> String
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
-- | Determines whether or not a goalie has been active in the current
-- season
goalieIsActive :: Goalie -> Bool
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
-- | Adds two sets of 'GoalieStats'
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
addGoalieStats g1 g2 = GoalieStats
{ _gsGames = g1^.gsGames + g2^.gsGames
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
, _gsWins = g1^.gsWins + g2^.gsWins
, _gsLosses = g1^.gsLosses + g2^.gsLosses
, _gsTies = g1^.gsTies + g2^.gsTies
}
-- | Determines a goalie's average goals allowed per game.
gsAverage :: GoalieStats -> Rational
gsAverage gs = fromIntegral (gs^.gsGoalsAllowed) / fromIntegral (gs^.gsGames)

View File

@@ -38,7 +38,6 @@ module Mtlstats.Types.Menu (
import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses)
import qualified UI.NCurses as C
import Mtlstats.Types

View 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

View File

@@ -19,14 +19,14 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Actions.GoalieInputSpec (spec) where
module Actions.NewGame.GoalieInputSpec (spec) where
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.GoalieInput
import Mtlstats.Actions.NewGame.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
& progMode.gameStateL .~ gameState n mins goals
in mapM_
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
s = recordGoalieStats $ progState gid mins goals
in context name $ do
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
s = recordGoalieStats $ progState setGid mins goals
in context setName $ do
mapM_
(\( name
, gid
(\( chkName
, chkGid
, ( gGames
, gMins
, gGoals
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
, ltMins
, ltGoals
)
) -> context name $ do
) -> context chkName $ do
let
gs = s^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gs
goalie = fromJust $ nth gid $ s^.database.dbGoalies
game = M.findWithDefault newGoalieStats chkGid gs
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
ytd = goalie^.gYtd
lt = goalie^.gLifetime
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
]
context "selected goalie" $ let
expected = if reset then Nothing else gid
expected = if reset then Nothing else setGid
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
tiedGame = gameState 0 1 True
in mapM_
(\(label, gameState, gid, bobData, joeData) -> context label $ let
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
progState = newProgState
& database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gameState
& setGameGoalie gid
& progMode.gameStateL .~ gs
& setGameGoalie setGid
in mapM_
(\( label
, gid
(\( chkLabel
, chkGid
, ( gWins
, gLosses
, gTies
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
, ltLosses
, ltTies
)
) -> context label $ do
) -> context chkLabel $ do
let
goalie = (progState^.database.dbGoalies) !! gid
goalie = (progState^.database.dbGoalies) !! chkGid
gameStats = progState^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gameStats
game = M.findWithDefault newGoalieStats chkGid gameStats
ytd = goalie^.gYtd
lifetime = goalie^.gLifetime
mapM_
(\(label, expected, actual) -> context label $
(\(label', expected, actual) -> context label' $
expected `TS.compareTest` actual)
[ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )

526
test/Actions/NewGameSpec.hs Normal file
View 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 )
]

View File

@@ -24,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ActionsSpec (spec) where
import Control.Monad (replicateM)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO)
import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec
( Spec
, context
, describe
, it
, runIO
, shouldBe
, shouldNotBe
, shouldSatisfy
@@ -41,9 +37,9 @@ import Test.Hspec
import Mtlstats.Actions
import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.GoalieInputSpec as GoalieInput
import qualified Actions.EditGoalieSpec as EditGoalie
import qualified Actions.NewGameSpec as NewGame
import qualified TypesSpec as TS
spec :: Spec
@@ -51,27 +47,22 @@ spec = describe "Mtlstats.Actions" $ do
startNewSeasonSpec
startNewGameSpec
resetYtdSpec
resetStandingsSpec
addCharSpec
removeCharSpec
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
createPlayerSpec
createGoalieSpec
editPlayerSpec
editGoalieSpec
addPlayerSpec
addGoalieSpec
resetCreatePlayerStateSpec
resetCreateGoalieStateSpec
recordGoalAssistsSpec
awardGoalSpec
awardAssistSpec
resetGoalDataSpec
assignPMinsSpec
backHomeSpec
scrollUpSpec
scrollDownSpec
GoalieInput.spec
NewGame.spec
EditGoalie.spec
startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do
@@ -99,8 +90,8 @@ startNewGameSpec = describe "startNewGame" $ do
resetYtdSpec :: Spec
resetYtdSpec = describe "resetYtd" $
it "should reset the year-to-date stats for all players" $ do
ps <- replicateM 2 makePlayer
gs <- replicateM 2 makeGoalie
ps <- replicateM 2 TS.makePlayer
gs <- replicateM 2 TS.makeGoalie
let
s = newProgState
& database . dbPlayers .~ ps
@@ -137,6 +128,41 @@ resetYtdSpec = describe "resetYtd" $
lt ^. gsTies `shouldNotBe` 0) $
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 = describe "addChar" $
it "should add the character to the input buffer" $ let
@@ -160,202 +186,6 @@ removeCharSpec = describe "removeChar" $ do
& removeChar
in s ^. inputBuffer `shouldBe` "fo"
overtimeCheckSpec = describe "overtimeCheck" $ do
context "tie game" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 1)
& overtimeCheck
it "should clear the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
it "should clear the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
it "should leave the overtimeFlag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
context "game won" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 2)
. (awayScore ?~ 1)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
it "should set the overtimeCheck flag to False" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
context "game lost" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 2)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
it "should leave the overtimeCheck flag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
updateGameStatsSpec :: Spec
updateGameStatsSpec = describe "updateGameStats" $ do
let
baseStats = newGameStats
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
& gmsGoalsFor .~ 1
& gmsGoalsAgainst .~ 1
s t h a o = newProgState
& progMode.gameStateL
%~ (gameType .~ t)
. (homeScore .~ h)
. (awayScore .~ a)
. (overtimeFlag .~ o)
& database
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho hf ha aw al ao af aa = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
. (gmsGoalsFor .~ hf)
. (gmsGoalsAgainst .~ ha)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
. (gmsGoalsFor .~ af)
. (gmsGoalsAgainst .~ aa)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
context "home overtime loss" $
it "should record a home overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
context "away overtime loss" $
it "should record an away overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do
context "valid date" $
it "should leave the date unchanged" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 6)
. (gameDay ?~ 25)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
context "invalid date" $
it "should clear the date" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 2)
. (gameDay ?~ 30)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
context "missing day" $
it "should not change anything" $ do
let
gs = newGameState
& gameYear ?~ 2019
& gameMonth ?~ 6
s = newProgState
& progMode.gameStateL .~ gs
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
createPlayerSpec :: Spec
createPlayerSpec = describe "createPlayer" $
it "should change the mode appropriately" $ let
@@ -374,6 +204,12 @@ editPlayerSpec = describe "editPlayer" $
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 = describe "addPlayer" $ do
let
@@ -440,281 +276,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
newProgState & progMode.createGoalieStateL .~ cgs
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
recordGoalAssistsSpec :: Spec
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
let
joe = newPlayer 1 "Joe" "centre"
bob = newPlayer 2 "Bob" "defense"
steve = newPlayer 3 "Steve" "forward"
dave = newPlayer 4 "Dave" "somewhere"
frank = newPlayer 5 "Frank" "elsewhere"
ps
= newProgState
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
& progMode.gameStateL
%~ (goalBy ?~ 0)
. (assistsBy .~ [1, 2])
. (confirmGoalDataFlag .~ True)
& recordGoalAssists
mapM_
(\(name, n, goals, assists) -> context name $ do
let
player = (ps^.database.dbPlayers) !! n
stats = M.findWithDefault newPlayerStats n $
ps^.progMode.gameStateL.gamePlayerStats
it ("should set the year-to-date goals to " ++ show goals) $
player^.pYtd.psGoals `shouldBe` goals
it ("should set the lifetime goals to " ++ show goals) $
player^.pLifetime.psGoals `shouldBe` goals
it ("should set the game goals to " ++ show goals) $
stats^.psAssists `shouldBe` assists
it ("should set the year-to-date assists to " ++ show assists) $
player^.pYtd.psAssists `shouldBe` assists
it ("should set the lifetime assists to " ++ show assists) $
player^.pLifetime.psAssists `shouldBe` assists
it ("should set the game assists to " ++ show assists) $
stats^.psAssists `shouldBe` assists)
-- name, index, goals, assists
[ ( "Joe", 0, 1, 0 )
, ( "Bob", 1, 0, 1 )
, ( "Steve", 2, 0, 1 )
, ( "Dave", 3, 0, 0 )
]
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assistsBy list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should increment the pointsAccounted counter" $
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
it "should clear the confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
awardGoalSpec :: Spec
awardGoalSpec = describe "awardGoal" $ do
let
joe
= newPlayer 2 "Joe" "centre"
& pYtd.psGoals .~ 1
& pLifetime.psGoals .~ 2
bob
= newPlayer 3 "Bob" "defense"
& pYtd.psGoals .~ 3
& pLifetime.psGoals .~ 4
db
= newDatabase
& dbPlayers .~ [joe, bob]
joeStats
= newPlayerStats
& psGoals .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database .~ db
mapM_
(\(pName, pid, ytd, lt, game) ->
context pName $ do
let
ps' = awardGoal pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ pName ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` ytd
it ("should increment " ++ pName ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` lt
it ("should increment " ++ pName ++ "'s game goals") $
gStats^.psGoals `shouldBe` game)
-- player name, player id, ytd goals, lifetime goals, game goals
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardGoal 2 ps
in it "should not change the database" $
ps'^.database `shouldBe` db
context "negative index" $ let
ps' = awardGoal (-1) ps
in it "should not change the database" $
ps'^.database `shouldBe` db
awardAssistSpec :: Spec
awardAssistSpec = describe "awardAssist" $ do
let
joe
= newPlayer 1 "Joe" "centre"
& pYtd.psAssists .~ 1
& pLifetime.psAssists .~ 2
bob
= newPlayer 2 "Bob" "defense"
& pYtd.psAssists .~ 3
& pLifetime.psAssists .~ 4
joeStats
= newPlayerStats
& psAssists .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database.dbPlayers .~ [joe, bob]
mapM_
(\(pName, pid, ytd, lt, game) ->
context pName $ do
let
ps' = awardAssist pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ pName ++ "'s year-to-date assists") $
player^.pYtd.psAssists `shouldBe` ytd
it ("should increment " ++ pName ++ "'s lifetime assists") $
player^.pLifetime.psAssists `shouldBe` lt
it ("should increment " ++ pName ++ "'s game assists") $
gStats^.psAssists `shouldBe` game)
-- player name, player id, ytd assists, lifetime assists, game assists
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardAssist (-1) ps
in it "should not change anything" $
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
resetGoalDataSpec :: Spec
resetGoalDataSpec = describe "resetGoalData" $ do
players <- runIO $ replicateM 5 makePlayer
let
gs
= newGameState
& goalBy ?~ 1
& assistsBy .~ [2, 3]
& confirmGoalDataFlag .~ True
ps
= newProgState
& database.dbPlayers .~ players
& progMode.gameStateL .~ gs
& resetGoalData
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assists by list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should clear confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
assignPMinsSpec :: Spec
assignPMinsSpec = describe "assignPMins" $ let
bob = newPlayer 2 "Bob" "centre"
& pYtd.psPMin .~ 3
& pLifetime.psPMin .~ 4
joe = newPlayer 3 "Joe" "defense"
& pYtd.psPMin .~ 5
& pLifetime.psPMin .~ 6
ps pid = newProgState
& database.dbPlayers .~ [bob, joe]
& progMode.gameStateL
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
. (gameSelectedPlayer .~ pid)
in mapM_
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
context ("selectedPlayer = " ++ show pid) $ do
let ps' = assignPMins 2 $ ps pid
mapM_
(\(name, pid', lt, ytd, game) -> context name $ do
let
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
gStats = ps'^.progMode.gameStateL.gamePlayerStats
pStats = M.findWithDefault newPlayerStats pid' gStats
context "lifetime penalty minutes" $
it ("should be " ++ show lt) $
player^.pLifetime.psPMin `shouldBe` lt
context "year-to-date penalty minutes" $
it ("should be " ++ show ytd) $
player^.pYtd.psPMin `shouldBe` ytd
context "game penalty minutes" $
it ("should be " ++ show game) $
pStats^.psPMin `shouldBe` game)
-- name, index, lifetime, ytd, game
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
, ( "Joe", 1, joeLt, joeYtd, joeGame )
]
it "should set selectedPlayer to Nothing" $
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
, ( Just 1, 4, 3, 2, 8, 7, 2 )
, ( Just 2, 4, 3, 2, 6, 5, 0 )
, ( Nothing, 4, 3, 2, 6, 5, 0 )
]
makePlayer :: IO Player
makePlayer = Player
<$> makeNum
<*> makeName
<*> makeName
<*> makePlayerStats
<*> makePlayerStats
makeGoalie :: IO Goalie
makeGoalie = Goalie
<$> makeNum
<*> makeName
<*> makeGoalieStats
<*> makeGoalieStats
makePlayerStats :: IO PlayerStats
makePlayerStats = PlayerStats
<$> makeNum
<*> makeNum
<*> makeNum
makeGoalieStats :: IO GoalieStats
makeGoalieStats = GoalieStats
<$> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
<*> makeNum
makeNum :: IO Int
makeNum = randomRIO (1, 10)
makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z')
backHomeSpec :: Spec
backHomeSpec = describe "backHome" $ do
let
@@ -755,6 +316,7 @@ scrollUpSpec = describe "scrollUp" $ do
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 0
scrollDownSpec :: Spec
scrollDownSpec = describe "scrollDown" $
it "should increase the scroll offset" $ let
ps = newProgState & scrollOffset .~ 10

View File

@@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module FormatSpec (spec) where
import Data.Ratio ((%))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Format
import Mtlstats.Types
spec :: Spec
spec = describe "Mtlstats.Format" $ do
@@ -33,6 +35,12 @@ spec = describe "Mtlstats.Format" $ do
centreSpec
overlaySpec
monthSpec
labelTableSpec
numTableSpec
tableWithSpec
complexTableSpec
overlayLastSpec
showFloatingSpec
padNumSpec :: Spec
padNumSpec = describe "padNum" $ do
@@ -111,3 +119,120 @@ monthSpec = describe "month" $ do
context "invalid" $
it "should return an empty string" $
month 0 `shouldBe` ""
labelTableSpec :: Spec
labelTableSpec = describe "labelTable" $
it "should format the table" $ let
input =
[ ( "foo", "bar" )
, ( "baz", "quux" )
, ( "longer", "x" )
]
expected =
[ " foo: bar"
, " baz: quux"
, "longer: x"
]
in labelTable input `shouldBe` expected
numTableSpec :: Spec
numTableSpec = describe "numTable" $
it "should format the table" $ let
headers = ["foo", "bar", "baz"]
rows =
[ ( "quux", [ 1, 2, 3 ] )
, ( "xyzzy", [ 9, 99, 999 ] )
]
expected =
[ " foo bar baz"
, " quux 1 2 3"
, "xyzzy 9 99 999"
]
in numTable headers rows `shouldBe` expected
tableWithSpec :: Spec
tableWithSpec = describe "tableWith" $ let
vals =
[ [ "foo", "bar", "baz" ]
, [ "quux", "xyzzy", "x" ]
]
in mapM_
(\(label, func, expected) -> context label $
it "should format the table" $
tableWith func vals `shouldBe` expected)
[ ( "align left"
, left
, [ "foo bar baz"
, "quux xyzzy x "
]
)
, ( "align right"
, right
, [ " foo bar baz"
, "quux xyzzy x"
]
)
]
complexTableSpec :: Spec
complexTableSpec = describe "complexTable" $ mapM_
(\(label, pFuncs, cells, expected) -> context label $
it "should format correctly" $
complexTable pFuncs cells `shouldBe` expected)
[ ( "no fill"
, [left, right]
, [ [ CellText "foo", CellText "bar" ]
, [ CellText "baaz", CellText "quux" ]
]
, [ "foo bar"
, "baaz quux"
]
)
, ( "with fill"
, [left, left, left]
, [ [ CellText "foo", CellText "bar", CellText "baz" ]
, [ CellText "quux", CellFill '-', CellFill '@' ]
]
, [ "foo bar baz"
, "quux ----@@@"
]
)
]
overlayLastSpec :: Spec
overlayLastSpec = describe "overlayLast" $ let
text = "foo"
sample =
[ "line 1"
, "line 2"
]
edited =
[ "line 1"
, "fooe 2"
]
in mapM_
(\(label, input, expected) -> context label $
it ("should be " ++ show expected) $
overlayLast text input `shouldBe` expected)
-- label, input, expected
[ ( "empty list", [], [] )
, ( "non-empty list", sample, edited )
]
showFloatingSpec :: Spec
showFloatingSpec = describe "showFloating" $ let
input = 3 % 2 :: Rational
expected = "1.50"
in it ("should be " ++ expected) $
showFloating input `shouldBe` expected

View 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

View 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
View 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

View File

@@ -21,16 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module ReportSpec (spec) where
import Lens.Micro ((&), (?~), (%~))
import Lens.Micro ((&), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Report
import Mtlstats.Types
spec :: Spec
spec = describe "Mtlstats.Report" $ do
spec = describe "Mtlstats.Report"
gameDateSpec
playerNameColWidthSpec
gameDateSpec :: Spec
gameDateSpec = describe "gameDate" $ do
@@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
context "invalid date" $
it "should return an empty string" $
gameDate newGameState `shouldBe` ""
playerNameColWidthSpec :: Spec
playerNameColWidthSpec = describe "playerNameColWidth" $ do
let
short1 = newPlayer 1 "short" "foo"
short2 = newPlayer 2 "shorty" "bar"
long = newPlayer 3 "123456789012345" "baz"
mapM_
(\(label, players, expected) -> context label $
it ("should be " ++ show expected) $
playerNameColWidth players `shouldBe` expected)
-- label, players, expected
[ ( "empty list", [], 10 )
, ( "short names", [short1, short2], 10 )
, ( "long name", [short1, long], 16 )
]

View File

@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
import qualified ActionsSpec as Actions
import qualified FormatSpec as Format
import qualified HandlersSpec as Handlers
import qualified HelpersSpec as Helpers
import qualified ReportSpec as Report
import qualified TypesSpec as Types
import qualified UtilSpec as Util
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
main :: IO ()
main = hspec $ do
Types.spec
Helpers.spec
Actions.spec
Format.spec
Handlers.spec

View File

@@ -21,13 +21,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec (Comparable (..), spec) where
module TypesSpec
( Comparable (..)
, spec
, makePlayer
, makeGoalie
, makePlayerStats
, makeGoalieStats
) where
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
import Data.Aeson.Types (Value (Object))
import Data.ByteString.Lazy (ByteString)
import qualified Data.HashMap.Strict as HM
import Data.Ratio ((%))
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config
@@ -48,6 +57,7 @@ spec = describe "Mtlstats.Types" $ do
createPlayerStateLSpec
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
@@ -63,13 +73,15 @@ spec = describe "Mtlstats.Types" $ do
playerSearchExactSpec
modifyPlayerSpec
playerSummarySpec
playerDetailsSpec
playerIsActiveSpec
psPointsSpec
addPlayerStatsSpec
goalieSearchSpec
goalieSearchExactSpec
goalieSummarySpec
goalieIsActiveSpec
addGoalieStatsSpec
gsAverageSpec
Menu.spec
playerSpec :: Spec
@@ -161,6 +173,24 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
eps2 = newEditPlayerState
& epsSelectedPlayer ?~ 2
editGoalieStateLSpec :: Spec
editGoalieStateLSpec = describe "editGoalieStateL" $
lensSpec editGoalieStateL
-- getters
[ ( "missing state", MainMenu, newEditGoalieState )
, ( "with state", EditGoalie egs1, egs1 )
]
-- setters
[ ( "set state", MainMenu, egs1 )
, ( "change state", EditGoalie egs1, egs2 )
, ( "clear state", EditGoalie egs1, newEditGoalieState )
]
where
egs1 = newEditGoalieState
& egsSelectedGoalie ?~ 1
egs2 = newEditGoalieState
& egsSelectedGoalie ?~ 2
teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do
let
@@ -284,18 +314,20 @@ goalieStats n = newGoalieStats
& gsGames .~ n
& gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2
& gsWins .~ n + 3
& gsLosses .~ n + 4
& gsTies .~ n + 5
& gsShutouts .~ n + 3
& gsWins .~ n + 4
& gsLosses .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 )
, ( "wins", toJSON $ n + 3 )
, ( "losses", toJSON $ n + 4 )
, ( "ties", toJSON $ n + 5 )
, ( "shutouts", toJSON $ n + 3 )
, ( "wins", toJSON $ n + 4 )
, ( "losses", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
]
gameStats :: Int -> GameStats
@@ -581,22 +613,22 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
modifyPlayerSpec :: Spec
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
(\(pName, j, b, s) -> let
(\(name, j, b, s) -> let
modifier = pLifetime.psGoals .~ 1
players = modifyPlayer modifier pName [joe, bob, steve]
in context ("modify " ++ pName) $ do
players = modifyPlayer modifier name [joe, bob, steve]
in context ("modify " ++ name) $ do
context "Joe's lifetime goals" $
it ("should be " ++ show j) $
head players ^. pLifetime.psGoals `shouldBe` j
head players^.pLifetime.psGoals `shouldBe` j
context "Bob's lifetime goals" $
it ("should be " ++ show b) $
(players !! 1) ^. pLifetime.psGoals `shouldBe` b
(players !! 1)^.pLifetime.psGoals `shouldBe` b
context "Steve's lifetime goals" $
it ("should be " ++ show s) $
last players ^. pLifetime.psGoals `shouldBe` s)
last players^.pLifetime.psGoals `shouldBe` s)
-- player name, Joe's goals, Bob's goals, Steve's goals
[ ( "Joe", 1, 0, 0 )
, ( "Bob", 0, 1, 0 )
@@ -609,54 +641,24 @@ playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center"
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
player = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Position: centre"
, " YTD goals: 2"
, " YTD assists: 3"
, " YTD penalty mins: 4"
, " Lifetime goals: 5"
, " Lifetime assists: 6"
, "Lifetime penalty mins: 7"
]
in playerDetails player `shouldBe` expected
playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do
let
pState = newPlayerStats
pStats = newPlayerStats
& psGoals .~ 10
& psAssists .~ 11
& psPMin .~ 12
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
mapM_
(\(label, player', expected) -> context label $
(\(label, p', expected) -> context label $
it ("should be " ++ show expected) $
playerIsActive player' `shouldBe` expected)
playerIsActive p' `shouldBe` expected)
-- label, player, expected
[ ( "not active", player, False )
, ( "has goal", player & pYtd.psGoals .~ 1, True )
, ( "has assist", player & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
[ ( "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
@@ -755,6 +757,72 @@ 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" $ let
gs = newGoalieStats
& gsGames .~ 2
& gsGoalsAllowed .~ 3
expected = 3 % 2
in it ("should be " ++ show expected) $
gsAverage gs `shouldBe` expected
joe :: Player
joe = newPlayer 2 "Joe" "center"
@@ -764,6 +832,47 @@ bob = newPlayer 3 "Bob" "defense"
steve :: Player
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 $
@@ -809,6 +918,17 @@ instance Comparable EditPlayerState where
it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` expected^.epsMode
instance Comparable EditGoalieState where
compareTest actual expected = do
describe "egsSelectedGoalie" $
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
describe "egsMode" $
it ("should be " ++ show (expected^.egsMode)) $
actual^.egsMode `shouldBe` expected^.egsMode
instance Comparable CreateGoalieState where
compareTest actual expected = do

View File

@@ -49,18 +49,19 @@ nthSpec = describe "nth" $ mapM_
modifyNthSpec :: Spec
modifyNthSpec = describe "modifyNth" $ do
let list = [1, 2, 3] :: [Int]
context "in bounds" $
it "should modify the value" $
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
modifyNth 1 succ list `shouldBe` [1, 3, 3]
context "out of bounds" $
it "should not modify the value" $
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
modifyNth 3 succ list `shouldBe` [1, 2, 3]
context "negative index" $
it "should not modify the value" $
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
updateMapSpec :: Spec
updateMapSpec = describe "updateMap" $ do
@@ -68,7 +69,7 @@ updateMapSpec = describe "updateMap" $ do
input = M.fromList [(1, 2), (3, 5)]
context "key found" $ let
expected = M.fromList [(1, 3), (3, 5)]
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
in it "should update the value" $
updateMap 1 10 succ input `shouldBe` expected
@@ -79,7 +80,7 @@ updateMapSpec = describe "updateMap" $ do
sliceSpec :: Spec
sliceSpec = describe "slice" $ do
let list = [2, 4, 6, 8]
let list = [2, 4, 6, 8] :: [Int]
context "sublist" $
it "should return the sublist" $