77 Commits
0.5.0 ... 0.6.0

Author SHA1 Message Date
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
26 changed files with 2424 additions and 1069 deletions

View File

@@ -1,5 +1,10 @@
# Changelog for mtlstats
## 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.6.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,173 @@
{- |
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
) 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)

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 _ -> newGameC s
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,137 @@
{- |
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.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 $ unlines
[ " Goalie number: " ++ show (g^.gNumber)
, " Goalie name: " ++ g^.gName
, " YTD games played: " ++ show (g^.gYtd.gsGames)
, " YTD mins played: " ++ show (g^.gYtd.gsMinsPlayed)
, " YTD goals allowed: " ++ show (g^.gYtd.gsGoalsAllowed)
, " YTD wins: " ++ show (g^.gYtd.gsWins)
, " YTD losses: " ++ show (g^.gYtd.gsLosses)
, " YTD ties: " ++ show (g^.gYtd.gsTies)
, " Lifetime games played: " ++ show (g^.gLifetime.gsGames)
, " Lifetime mins played: " ++ show (g^.gLifetime.gsMinsPlayed)
, "Lifetime goals allowed: " ++ show (g^.gLifetime.gsGoalsAllowed)
, " Lifetime wins: " ++ show (g^.gLifetime.gsWins)
, " Lifetime losses: " ++ show (g^.gLifetime.gsLosses)
, " Lifetime ties: " ++ show (g^.gLifetime.gsTies)
, ""
]

View File

@@ -0,0 +1,283 @@
{- |
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 :: ProgState -> Controller
newGameC s = let
gs = s^.progMode.gameStateL
in if null $ gs^.gameYear then gameYearC
else if null $ gs^.gameMonth then gameMonthC
else if null $ gs^.gameDay then gameDayC
else if null $ gs^.gameType then gameTypeC
else if null $ gs^.otherTeam then otherTeamC
else if null $ gs^.homeScore then homeScoreC
else if null $ gs^.awayScore then awayScoreC
else if null $ gs^.overtimeFlag then overtimeFlagC
else if not $ gs^.dataVerified then verifyDataC
else if fromJust (unaccountedPoints gs) then goalInput gs
else if isJust $ gs^.gameSelectedPlayer then getPMinsC
else if not $ gs^.gamePMinsRecorded then pMinPlayerC
else if not $ gs^.gameGoalieAssigned then goalieInputC s
else reportC
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"
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,13 +28,13 @@ 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
goalieInputC :: ProgState -> Controller
goalieInputC s = let
gs = s^.progMode.gameStateL
in if gs^.gameGoaliesRecorded
then selectGameGoalieC s

View File

@@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Menu (
-- * Menu Functions
menuController,
menuControllerWith,
drawMenu,
menuHandler,
-- * Menus
@@ -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,8 +58,20 @@ 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
@@ -91,7 +104,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 +119,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

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

@@ -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,115 @@
{- |
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: " $
modify . (progMode.gameStateL.awayScore ?~)
-- | 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

@@ -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
@@ -103,12 +105,16 @@ yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
map (\p -> (p, p^.pYtd)) $
filter playerIsActive $ s^.database.dbPlayers
lifetimeStatsReport :: Int -> ProgState -> [String]
lifetimeStatsReport width s = playerReport width "LIFETIME" $
map (\p -> (p, p^.pLifetime)) $ s^.database.dbPlayers
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

View File

@@ -33,6 +33,8 @@ module Mtlstats.Types (
CreateGoalieState (..),
EditPlayerState (..),
EditPlayerMode (..),
EditGoalieState (..),
EditGoalieMode (..),
Database (..),
Player (..),
PlayerStats (..),
@@ -52,6 +54,7 @@ module Mtlstats.Types (
createPlayerStateL,
createGoalieStateL,
editPlayerStateL,
editGoalieStateL,
-- ** GameState Lenses
gameYear,
gameMonth,
@@ -89,6 +92,9 @@ module Mtlstats.Types (
-- ** EditPlayerState Lenses
epsSelectedPlayer,
epsMode,
-- ** EditGoalieState Lenses
egsSelectedGoalie,
egsMode,
-- ** Database Lenses
dbPlayers,
dbGoalies,
@@ -129,6 +135,7 @@ module Mtlstats.Types (
newCreatePlayerState,
newCreateGoalieState,
newEditPlayerState,
newEditGoalieState,
newDatabase,
newPlayer,
newPlayerStats,
@@ -218,6 +225,7 @@ data ProgMode
| CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState
| EditGoalie EditGoalieState
instance Show ProgMode where
show MainMenu = "MainMenu"
@@ -226,6 +234,7 @@ instance Show ProgMode where
show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
show (EditGoalie _) = "EditGoalie"
-- | The game state
data GameState = GameState
@@ -334,6 +343,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]
@@ -581,6 +618,7 @@ makeLenses ''GameState
makeLenses ''CreatePlayerState
makeLenses ''CreateGoalieState
makeLenses ''EditPlayerState
makeLenses ''EditGoalieState
makeLenses ''Database
makeLenses ''Player
makeLenses ''PlayerStats
@@ -616,6 +654,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 +723,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
@@ -828,9 +880,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 +892,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

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 )

483
test/Actions/NewGameSpec.hs Normal file
View File

@@ -0,0 +1,483 @@
{-
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
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 )
]

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,7 +21,7 @@ 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

View File

@@ -21,13 +21,21 @@ 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 Lens.Micro (Lens', (&), (^.), (.~), (?~))
import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Config
@@ -48,6 +56,7 @@ spec = describe "Mtlstats.Types" $ do
createPlayerStateLSpec
createGoalieStateLSpec
editPlayerStateLSpec
editGoalieStateLSpec
teamScoreSpec
otherScoreSpec
homeTeamSpec
@@ -161,6 +170,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
@@ -581,22 +608,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 )
@@ -613,7 +640,7 @@ playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
player = newPlayer 1 "Joe" "centre"
p = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
@@ -637,26 +664,26 @@ playerDetailsSpec = describe "playerDetails" $
, "Lifetime penalty mins: 7"
]
in playerDetails player `shouldBe` expected
in playerDetails p `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
@@ -764,6 +791,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 :: 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 +877,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" $