103 Commits
0.5.0 ... 0.7.0

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

View File

@@ -1,5 +1,14 @@
# Changelog for mtlstats # Changelog for mtlstats
## 0.7.0
- Shortened views to fit within 25 lines
- Implemented goalie reports
## 0.6.0
- Generate lifetime statistics report
- Implemented goalie editing
- Reset game standings on new season
## 0.5.0 ## 0.5.0
- Fixed player creation bug - Fixed player creation bug

View File

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

View File

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

View File

@@ -0,0 +1,164 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Actions.EditGoalie
( editGoalieNumber
, editGoalieName
, editGoalieYtdGames
, editGoalieYtdMins
, editGoalieYtdGoals
, editGoalieYtdWins
, editGoalieYtdLosses
, editGoalieYtdTies
, editGoalieLtGames
, editGoalieLtMins
, editGoalieLtGoals
, editGoalieLtWins
, editGoalieLtLosses
, editGoalieLtTies
) where
import Control.Monad (void)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~))
import Mtlstats.Types
import Mtlstats.Util
-- | Edits a goalie's number
editGoalieNumber
:: Int
-- ^ New goalie number
-> ProgState
-> ProgState
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
-- | Edits a goalie's name
editGoalieName
:: String
-- ^ The new name
-> ProgState
-> ProgState
editGoalieName name = editGoalie (gName .~ name) EGMenu
-- | Edits a goalie's YTD games
editGoalieYtdGames
:: Int
-- ^ The number of games played
-> ProgState
-> ProgState
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
-- | Edits a goalie's YTD minutes
editGoalieYtdMins
:: Int
-- ^ The number of minutes played
-> ProgState
-> ProgState
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
-- | Edits a goalie's YTD goals allowed
editGoalieYtdGoals
:: Int
-- ^ The number of goals
-> ProgState
-> ProgState
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
-- | Edits a goalie's YTD wins
editGoalieYtdWins
:: Int
-- ^ The number of wins
-> ProgState
-> ProgState
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
-- | Edits a goalie's YTD losses
editGoalieYtdLosses
:: Int
-- ^ The number of losses
-> ProgState
-> ProgState
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
-- | Edits a goalie's YTD ties
editGoalieYtdTies
:: Int
-- ^ The number of ties
-> ProgState
-> ProgState
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
-- | Edits a goalie's lifetime games played
editGoalieLtGames
:: Int
-- ^ The number of games
-> ProgState
-> ProgState
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
-- | Edits a goalie's lifetime minutes played
editGoalieLtMins
:: Int
-- ^ The number of minutes
-> ProgState
-> ProgState
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
-- | Edits a goalie's lifetime goals allowed
editGoalieLtGoals
:: Int
-- ^ The number of goals
-> ProgState
-> ProgState
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
-- | Edits a goalie's lifetime wins
editGoalieLtWins
:: Int
-- ^ The number of wins
-> ProgState
-> ProgState
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
-- | Edits a goalie's lifetime losses
editGoalieLtLosses
:: Int
-- ^ The number of losses
-> ProgState
-> ProgState
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
-- | Edits a goalie's lifetime ties
editGoalieLtTies
:: Int
-- ^ The number of ties
-> ProgState
-> ProgState
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
editGoalie f mode s = fromMaybe s $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
void $ nth gid $ s^.database.dbGoalies
Just $ s
& database.dbGoalies %~ modifyNth gid f
& progMode.editGoalieStateL.egsMode .~ mode

View File

@@ -0,0 +1,191 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Actions.NewGame
( overtimeCheck
, updateGameStats
, validateGameDate
, recordGoalAssists
, awardGoal
, awardAssist
, resetGoalData
, assignPMins
, awardShutouts
) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
import Mtlstats.Types
import Mtlstats.Util
-- | Determines whether or not to perform a check for overtime
overtimeCheck :: ProgState -> ProgState
overtimeCheck s
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
s & progMode.gameStateL
%~ (homeScore .~ Nothing)
. (awayScore .~ Nothing)
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
s & progMode.gameStateL.overtimeFlag ?~ False
| otherwise = s
-- | Adjusts the game stats based on the results of the current game
updateGameStats :: ProgState -> ProgState
updateGameStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gType <- gs^.gameType
won <- gameWon gs
lost <- gameLost gs
ot <- gs^.overtimeFlag
tScore <- teamScore gs
oScore <- otherScore gs
let
hw = if gType == HomeGame && won then 1 else 0
hl = if gType == HomeGame && lost then 1 else 0
hot = if gType == HomeGame && ot then 1 else 0
hgf = if gType == HomeGame then tScore else 0
hga = if gType == HomeGame then oScore else 0
aw = if gType == AwayGame && won then 1 else 0
al = if gType == AwayGame && lost then 1 else 0
aot = if gType == AwayGame && ot then 1 else 0
agf = if gType == AwayGame then tScore else 0
aga = if gType == AwayGame then oScore else 0
Just $ s
& database.dbHomeGameStats
%~ (gmsWins +~ hw)
. (gmsLosses +~ hl)
. (gmsOvertime +~ hot)
. (gmsGoalsFor +~ hgf)
. (gmsGoalsAgainst +~ hga)
& database.dbAwayGameStats
%~ (gmsWins +~ aw)
. (gmsLosses +~ al)
. (gmsOvertime +~ aot)
. (gmsGoalsFor +~ agf)
. (gmsGoalsAgainst +~ aga)
-- | Validates the game date
validateGameDate :: ProgState -> ProgState
validateGameDate s = fromMaybe s $ do
y <- toInteger <$> s^.progMode.gameStateL.gameYear
m <- s^.progMode.gameStateL.gameMonth
d <- s^.progMode.gameStateL.gameDay
Just $ if null $ fromGregorianValid y m d
then s & progMode.gameStateL
%~ (gameYear .~ Nothing)
. (gameMonth .~ Nothing)
. (gameDay .~ Nothing)
else s
-- | Awards the goal and assists to the players
recordGoalAssists :: ProgState -> ProgState
recordGoalAssists ps = fromMaybe ps $ do
let gs = ps^.progMode.gameStateL
goalId <- gs^.goalBy
let assistIds = gs^.assistsBy
Just $ ps
& awardGoal goalId
& (\s -> foldr awardAssist s assistIds)
& progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (pointsAccounted %~ succ)
. (confirmGoalDataFlag .~ False)
-- | Awards a goal to a player
awardGoal
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardGoal n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psGoals %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psGoals %~ succ
& pLifetime.psGoals %~ succ
else p) . zip [0..]
-- | Awards an assist to a player
awardAssist
:: Int
-- ^ The player's index number
-> ProgState
-> ProgState
awardAssist n ps = ps
& progMode.gameStateL.gamePlayerStats %~
(\m -> let
stats = M.findWithDefault newPlayerStats n m
in M.insert n (stats & psAssists %~ succ) m)
& database.dbPlayers %~ map
(\(i, p) -> if i == n
then p
& pYtd.psAssists %~ succ
& pLifetime.psAssists %~ succ
else p) . zip [0..]
-- | Resets the entered data for the current goal
resetGoalData :: ProgState -> ProgState
resetGoalData ps = ps & progMode.gameStateL
%~ (goalBy .~ Nothing)
. (assistsBy .~ [])
. (confirmGoalDataFlag .~ False)
-- | Adds penalty minutes to a player
assignPMins
:: Int
-- ^ The number of minutes to add
-> ProgState
-> ProgState
assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.gameSelectedPlayer
Just $ s
& database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
& progMode.gameStateL
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
(psPMin +~ mins)
)
. (gameSelectedPlayer .~ Nothing)
-- | Awards a shutout to any 'Goalie' who played and didn't allow any
-- goals
awardShutouts :: ProgState -> ProgState
awardShutouts s = foldl
(\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0
then s'
& database.dbGoalies %~ modifyNth gid
( ( gYtd.gsShutouts %~ succ )
. ( gLifetime.gsShutouts %~ succ )
)
& progMode.gameStateL.gameGoalieStats %~ M.adjust
(gsShutouts %~ succ)
gid
else s')
s
(M.toList $ s^.progMode.gameStateL.gameGoalieStats)

View File

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

View File

@@ -21,25 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Control (dispatch) where module Mtlstats.Control (dispatch) where
import Control.Monad (join, when) import Control.Monad (join)
import Control.Monad.Extra (ifM)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Char (toUpper) import Data.Maybe (fromJust)
import Data.Maybe (fromJust, fromMaybe, isJust) import Lens.Micro ((^.))
import Lens.Micro ((^.), (.~), (%~))
import Lens.Micro.Extras (view) import Lens.Micro.Extras (view)
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Control.EditGoalie
import Mtlstats.Control.EditPlayer import Mtlstats.Control.EditPlayer
import Mtlstats.Control.GoalieInput import Mtlstats.Control.NewGame
import Mtlstats.Format
import Mtlstats.Handlers import Mtlstats.Handlers
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Report
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
-- | Reads the program state and returs the apropriate controller to -- | Reads the program state and returs the apropriate controller to
-- run -- run
@@ -47,21 +43,7 @@ dispatch :: ProgState -> Controller
dispatch s = case s^.progMode of dispatch s = case s^.progMode of
MainMenu -> mainMenuC MainMenu -> mainMenuC
NewSeason -> newSeasonC NewSeason -> newSeasonC
NewGame gs NewGame gs -> newGameC gs
| null $ gs^.gameYear -> gameYearC
| null $ gs^.gameMonth -> gameMonthC
| null $ gs^.gameDay -> gameDayC
| null $ gs^.gameType -> gameTypeC
| null $ gs^.otherTeam -> otherTeamC
| null $ gs^.homeScore -> homeScoreC
| null $ gs^.awayScore -> awayScoreC
| null $ gs^.overtimeFlag -> overtimeFlagC
| not $ gs^.dataVerified -> verifyDataC
| fromJust (unaccountedPoints gs) -> goalInput gs
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
| not $ gs^.gameGoalieAssigned -> goalieInput s
| otherwise -> reportC
CreatePlayer cps CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC | null $ cps^.cpsName -> getPlayerNameC
@@ -72,6 +54,7 @@ dispatch s = case s^.progMode of
| null $ cgs^.cgsName -> getGoalieNameC | null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC | otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps EditPlayer eps -> editPlayerC eps
EditGoalie egs -> editGoalieC egs
mainMenuC :: Controller mainMenuC :: Controller
mainMenuC = Controller mainMenuC = Controller
@@ -87,219 +70,6 @@ newSeasonC = Controller
return True return True
} }
gameYearC :: Controller
gameYearC = Controller
{ drawController = \s -> do
header s
drawPrompt gameYearPrompt s
, handleController = \e -> do
promptHandler gameYearPrompt e
return True
}
gameMonthC :: Controller
gameMonthC = Controller
{ drawController = \s -> do
header s
drawMenu gameMonthMenu
, handleController = \e -> do
menuHandler gameMonthMenu e
return True
}
gameDayC :: Controller
gameDayC = Controller
{ drawController = \s -> do
header s
drawPrompt gameDayPrompt s
, handleController = \e -> do
promptHandler gameDayPrompt e
modify validateGameDate
return True
}
gameTypeC :: Controller
gameTypeC = Controller
{ drawController = \s -> do
header s
drawMenu gameTypeMenu
, handleController = \e -> do
menuHandler gameTypeMenu e
return True
}
otherTeamC :: Controller
otherTeamC = Controller
{ drawController = \s -> do
header s
drawPrompt otherTeamPrompt s
, handleController = \e -> do
promptHandler otherTeamPrompt e
return True
}
homeScoreC :: Controller
homeScoreC = Controller
{ drawController = \s -> do
header s
drawPrompt homeScorePrompt s
, handleController = \e -> do
promptHandler homeScorePrompt e
return True
}
awayScoreC :: Controller
awayScoreC = Controller
{ drawController = \s -> do
header s
drawPrompt awayScorePrompt s
, handleController = \e -> do
promptHandler awayScorePrompt e
modify overtimeCheck
return True
}
overtimeFlagC :: Controller
overtimeFlagC = Controller
{ drawController = \s -> do
header s
C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
return True
}
verifyDataC :: Controller
verifyDataC = Controller
{ drawController = \s -> do
let gs = s^.progMode.gameStateL
header s
C.drawString "\n"
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
C.drawString "Is the above information correct? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify $ progMode.gameStateL.dataVerified .~ True
modify updateGameStats
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
goalInput :: GameState -> Controller
goalInput gs
| null (gs^.goalBy ) = recordGoalC
| not (gs^.confirmGoalDataFlag) = recordAssistC
| otherwise = confirmGoalDataC
recordGoalC :: Controller
recordGoalC = Controller
{ drawController = \s -> let
(game, goal) = gameGoal s
in drawPrompt (recordGoalPrompt game goal) s
, handleController = \e -> do
(game, goal) <- gets gameGoal
promptHandler (recordGoalPrompt game goal) e
return True
}
recordAssistC :: Controller
recordAssistC = Controller
{ drawController = \s -> let
(game, goal, assist) = gameGoalAssist s
in drawPrompt (recordAssistPrompt game goal assist) s
, handleController = \e -> do
(game, goal, assist) <- gets gameGoalAssist
promptHandler (recordAssistPrompt game goal assist) e
return True
}
confirmGoalDataC :: Controller
confirmGoalDataC = Controller
{ drawController = \s -> do
let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg = unlines $
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
(\pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players))
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
C.drawString msg
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> modify recordGoalAssists
Just False -> modify resetGoalData
Nothing -> return ()
return True
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible
, handleController = \e -> do
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
getPlayerNumC :: Controller getPlayerNumC :: Controller
getPlayerNumC = Controller getPlayerNumC = Controller
{ drawController = drawPrompt playerNumPrompt { drawController = drawPrompt playerNumPrompt
@@ -381,15 +151,3 @@ confirmCreateGoalieC = Controller
Nothing -> return () Nothing -> return ()
return True return True
} }
gameGoal :: ProgState -> (Int, Int)
gameGoal s =
( s^.database.dbGames
, succ $ s^.progMode.gameStateL.pointsAccounted
)
gameGoalAssist :: ProgState -> (Int, Int, Int)
gameGoalAssist s = let
(game, goal) = gameGoal s
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
in (game, goal, assist)

View File

@@ -0,0 +1,122 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Control.EditGoalie (editGoalieC) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import UI.NCurses as C
import Mtlstats.Helpers.Goalie
import Mtlstats.Menu
import Mtlstats.Menu.EditGoalie
import Mtlstats.Prompt
import Mtlstats.Prompt.EditGoalie
import Mtlstats.Types
import Mtlstats.Util
-- | Controller/dispatcher for editing a 'Goalie'
editGoalieC :: EditGoalieState -> Controller
editGoalieC egs
| null $ egs^.egsSelectedGoalie = selectC
| otherwise = editC $ egs^.egsMode
selectC :: Controller
selectC = promptController goalieToEditPrompt
editC :: EditGoalieMode -> Controller
editC = \case
EGMenu -> menuC
EGNumber -> numberC
EGName -> nameC
EGYtd -> ytdMenuC
EGLifetime -> lifetimeMenuC
EGYtdGames -> ytdGamesC
EGYtdMins -> ytdMinsC
EGYtdGoals -> ytdGoalsC
EGYtdWins -> ytdWinsC
EGYtdLosses -> ytdLossesC
EGYtdTies -> ytdTiesC
EGLtGames -> ltGamesC
EGLtMins -> ltMinsC
EGLtGoals -> ltGoalsC
EGLtWins -> ltWinsC
EGLtLosses -> ltLossesC
EGLtTies -> ltTiesC
menuC :: Controller
menuC = menuControllerWith header editGoalieMenu
numberC :: Controller
numberC = promptController editGoalieNumberPrompt
nameC :: Controller
nameC = promptController editGoalieNamePrompt
ytdMenuC :: Controller
ytdMenuC = menuControllerWith header editGoalieYtdMenu
lifetimeMenuC :: Controller
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
ytdGamesC :: Controller
ytdGamesC = promptController editGoalieYtdGamesPrompt
ytdMinsC :: Controller
ytdMinsC = promptController editGoalieYtdMinsPrompt
ytdGoalsC :: Controller
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
ytdWinsC :: Controller
ytdWinsC = promptController editGoalieYtdWinsPrompt
ytdLossesC :: Controller
ytdLossesC = promptController editGoalieYtdLossesPrompt
ytdTiesC :: Controller
ytdTiesC = promptController editGoalieYtdTiesPrompt
ltGamesC :: Controller
ltGamesC = promptController editGoalieLtGamesPrompt
ltMinsC :: Controller
ltMinsC = promptController editGoalieLtMinsPrompt
ltGoalsC :: Controller
ltGoalsC = promptController editGoalieLtGoalsPrompt
ltWinsC :: Controller
ltWinsC = promptController editGoalieLtWinsPrompt
ltLossesC :: Controller
ltLossesC = promptController editGoalieLtLossesPrompt
ltTiesC :: Controller
ltTiesC = promptController editGoalieLtTiesPrompt
header :: ProgState -> C.Update ()
header s = C.drawString $ fromMaybe "" $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
g <- nth gid $ s^.database.dbGoalies
Just $ goalieDetails g ++ "\n"

View File

@@ -25,7 +25,9 @@ import Data.Maybe (fromMaybe)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Helpers.Player
import Mtlstats.Menu import Mtlstats.Menu
import Mtlstats.Menu.EditPlayer
import Mtlstats.Prompt import Mtlstats.Prompt
import Mtlstats.Prompt.EditPlayer import Mtlstats.Prompt.EditPlayer
import Mtlstats.Types import Mtlstats.Types
@@ -40,6 +42,8 @@ editPlayerC eps
EPNumber -> numberC EPNumber -> numberC
EPName -> nameC EPName -> nameC
EPPosition -> positionC EPPosition -> positionC
EPYtd -> ytdC
EPLifetime -> lifetimeC
EPYtdGoals -> ytdGoalsC EPYtdGoals -> ytdGoalsC
EPYtdAssists -> ytdAssistsC EPYtdAssists -> ytdAssistsC
EPYtdPMin -> ytdPMinC EPYtdPMin -> ytdPMinC
@@ -48,96 +52,46 @@ editPlayerC eps
EPLtPMin -> ltPMinC EPLtPMin -> ltPMinC
selectPlayerC :: Controller selectPlayerC :: Controller
selectPlayerC = Controller selectPlayerC = promptController playerToEditPrompt
{ drawController = drawPrompt playerToEditPrompt
, handleController = \e -> do
promptHandler playerToEditPrompt e
return True
}
menuC :: Controller menuC :: Controller
menuC = Controller menuC = menuControllerWith header editPlayerMenu
{ drawController = \s -> do
let
header = fromMaybe "" $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
p <- nth pid $ s^.database.dbPlayers
Just $ playerDetails p ++ "\n"
C.drawString header
drawMenu editPlayerMenu
, handleController = \e -> do
menuHandler editPlayerMenu e
return True
}
numberC :: Controller numberC :: Controller
numberC = Controller numberC = promptController editPlayerNumPrompt
{ drawController = drawPrompt editPlayerNumPrompt
, handleController = \e -> do
promptHandler editPlayerNumPrompt e
return True
}
nameC :: Controller nameC :: Controller
nameC = Controller nameC = promptController editPlayerNamePrompt
{ drawController = drawPrompt editPlayerNamePrompt
, handleController = \e -> do
promptHandler editPlayerNamePrompt e
return True
}
positionC :: Controller positionC :: Controller
positionC = Controller positionC = promptController editPlayerPosPrompt
{ drawController = drawPrompt editPlayerPosPrompt
, handleController = \e -> do ytdC :: Controller
promptHandler editPlayerPosPrompt e ytdC = menuControllerWith header editPlayerYtdMenu
return True
} lifetimeC :: Controller
lifetimeC = menuControllerWith header editPlayerLtMenu
ytdGoalsC :: Controller ytdGoalsC :: Controller
ytdGoalsC = Controller ytdGoalsC = promptController editPlayerYtdGoalsPrompt
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdGoalsPrompt e
return True
}
ytdAssistsC :: Controller ytdAssistsC :: Controller
ytdAssistsC = Controller ytdAssistsC = promptController editPlayerYtdAssistsPrompt
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdAssistsPrompt e
return True
}
ytdPMinC :: Controller ytdPMinC :: Controller
ytdPMinC = Controller ytdPMinC = promptController editPlayerYtdPMinPrompt
{ drawController = drawPrompt editPlayerYtdPMinPrompt
, handleController = \e -> do
promptHandler editPlayerYtdPMinPrompt e
return True
}
ltGoalsC :: Controller ltGoalsC :: Controller
ltGoalsC = Controller ltGoalsC = promptController editPlayerLtGoalsPrompt
{ drawController = drawPrompt editPlayerLtGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerLtGoalsPrompt e
return True
}
ltAssistsC :: Controller ltAssistsC :: Controller
ltAssistsC = Controller ltAssistsC = promptController editPlayerLtAssistsPrompt
{ drawController = drawPrompt editPlayerLtAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerLtAssistsPrompt e
return True
}
ltPMinC :: Controller ltPMinC :: Controller
ltPMinC = Controller ltPMinC = promptController editPlayerLtPMinPrompt
{ drawController = drawPrompt editPlayerLtPMinPrompt
, handleController = \e -> do header :: ProgState -> C.Update ()
promptHandler editPlayerLtPMinPrompt e header s = C.drawString $ fromMaybe "" $ do
return True pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
} player <- nth pid $ s^.database.dbPlayers
Just $ playerDetails player ++ "\n"

View File

@@ -0,0 +1,234 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Control.NewGame (newGameC) where
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Lens.Micro ((^.), (.~))
import qualified UI.NCurses as C
import Mtlstats.Actions
import Mtlstats.Actions.NewGame
import Mtlstats.Control.NewGame.GoalieInput
import Mtlstats.Format
import Mtlstats.Handlers
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.NewGame
import Mtlstats.Report
import Mtlstats.Types
import Mtlstats.Util
-- | Dispatcher for a new game
newGameC :: GameState -> Controller
newGameC gs
| null $ gs^.gameYear = gameYearC
| null $ gs^.gameMonth = gameMonthC
| null $ gs^.gameDay = gameDayC
| null $ gs^.gameType = gameTypeC
| null $ gs^.otherTeam = otherTeamC
| null $ gs^.homeScore = homeScoreC
| null $ gs^.awayScore = awayScoreC
| null $ gs^.overtimeFlag = overtimeFlagC
| not $ gs^.dataVerified = verifyDataC
| fromJust (unaccountedPoints gs) = goalInput gs
| isJust $ gs^.gameSelectedPlayer = getPMinsC
| not $ gs^.gamePMinsRecorded = pMinPlayerC
| not $ gs^.gameGoalieAssigned = goalieInputC gs
| otherwise = reportC
gameYearC :: Controller
gameYearC = promptControllerWith header gameYearPrompt
gameMonthC :: Controller
gameMonthC = menuControllerWith header gameMonthMenu
gameDayC :: Controller
gameDayC = promptControllerWith header gameDayPrompt
gameTypeC :: Controller
gameTypeC = menuControllerWith header gameTypeMenu
otherTeamC :: Controller
otherTeamC = promptControllerWith header otherTeamPrompt
homeScoreC :: Controller
homeScoreC = promptControllerWith header homeScorePrompt
awayScoreC :: Controller
awayScoreC = promptControllerWith header awayScorePrompt
overtimeFlagC :: Controller
overtimeFlagC = Controller
{ drawController = \s -> do
header s
C.drawString "Did the game go into overtime? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
return True
}
verifyDataC :: Controller
verifyDataC = Controller
{ drawController = \s -> do
let gs = s^.progMode.gameStateL
header s
C.drawString "\n"
C.drawString $ unlines $ labelTable
[ ( "Date", gameDate gs )
, ( "Game type", show $ fromJust $ gs^.gameType )
, ( "Other team", gs^.otherTeam )
, ( "Home score", show $ fromJust $ gs^.homeScore )
, ( "Away score", show $ fromJust $ gs^.awayScore )
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
]
C.drawString "\nIs the above information correct? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> modify
$ (progMode.gameStateL.dataVerified .~ True)
. updateGameStats
. awardShutouts
Just False -> modify $ progMode.gameStateL .~ newGameState
Nothing -> return ()
return True
}
goalInput :: GameState -> Controller
goalInput gs
| null (gs^.goalBy ) = recordGoalC
| not (gs^.confirmGoalDataFlag) = recordAssistC
| otherwise = confirmGoalDataC
recordGoalC :: Controller
recordGoalC = Controller
{ drawController = \s -> let
(game, goal) = gameGoal s
in drawPrompt (recordGoalPrompt game goal) s
, handleController = \e -> do
(game, goal) <- gets gameGoal
promptHandler (recordGoalPrompt game goal) e
return True
}
recordAssistC :: Controller
recordAssistC = Controller
{ drawController = \s -> let
(game, goal, assist) = gameGoalAssist s
in drawPrompt (recordAssistPrompt game goal assist) s
, handleController = \e -> do
(game, goal, assist) <- gets gameGoalAssist
promptHandler (recordAssistPrompt game goal assist) e
return True
}
confirmGoalDataC :: Controller
confirmGoalDataC = Controller
{ drawController = \s -> do
let
(game, goal) = gameGoal s
gs = s^.progMode.gameStateL
players = s^.database.dbPlayers
msg = unlines $
[ " Game: " ++ padNum 2 game
, " Goal: " ++ show goal
, "Goal scored by: " ++
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
] ++
map
(\pid -> " Assisted by: " ++
playerSummary (fromJust $ nth pid players))
(gs^.assistsBy) ++
[ ""
, "Is the above information correct? (Y/N)"
]
C.drawString msg
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> modify recordGoalAssists
Just False -> modify resetGoalData
Nothing -> return ()
return True
}
pMinPlayerC :: Controller
pMinPlayerC = Controller
{ drawController = \s -> do
header s
drawPrompt pMinPlayerPrompt s
, handleController = \e -> do
promptHandler pMinPlayerPrompt e
return True
}
getPMinsC :: Controller
getPMinsC = Controller
{ drawController = \s -> do
header s
C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s
, handleController = \e -> do
promptHandler assignPMinsPrompt e
return True
}
reportC :: Controller
reportC = Controller
{ drawController = \s -> do
(rows, cols) <- C.windowSize
C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible
, handleController = \e -> do
case e of
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
C.EventSpecialKey _ -> modify backHome
C.EventCharacter _ -> modify backHome
_ -> return ()
return True
}
header :: ProgState -> C.Update ()
header s = C.drawString $
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
gameGoal :: ProgState -> (Int, Int)
gameGoal s =
( s^.database.dbGames
, succ $ s^.progMode.gameStateL.pointsAccounted
)
gameGoalAssist :: ProgState -> (Int, Int, Int)
gameGoalAssist s = let
(game, goal) = gameGoal s
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
in (game, goal, assist)

View File

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

View File

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

View File

@@ -0,0 +1,47 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Helpers.Goalie (goalieDetails) where
import Lens.Micro ((^.))
import Mtlstats.Format
import Mtlstats.Types
-- | Provides a detailed 'String' describing a 'Goalie'
goalieDetails :: Goalie -> String
goalieDetails g = let
header = unlines $ labelTable
[ ( "Number", show $ g^.gNumber )
, ( "Name", g^.gName )
]
body = unlines $ numTable ["YTD", "Lifetime"] $ map
(\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
[ ( "Games played", gsGames )
, ( "Mins played", gsMinsPlayed )
, ( "Goals allowed", gsGoalsAllowed )
, ( "Wins", gsWins )
, ( "Losses", gsLosses )
, ( "Ties", gsTies )
]
in header ++ "\n" ++ body

View File

@@ -0,0 +1,45 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Helpers.Player (playerDetails) where
import Lens.Micro ((^.))
import Mtlstats.Format
import Mtlstats.Types
-- | Provides a detailed string describing a 'Player'
playerDetails :: Player -> String
playerDetails p = unlines $ top ++ [""] ++ table
where
top = labelTable
[ ( "Number", show $ p^.pNumber )
, ( "Name", p^.pName )
, ( "Position", p^.pPosition )
]
table = numTable ["YTD", "Lifetime"] $ map
(\(label, lens) ->
(label, [p^.pYtd.lens, p^.pLifetime.lens]))
[ ( "Goals", psGoals )
, ( "Assists", psAssists )
, ( "Penalty mins", psPMin )
]

View File

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

View File

@@ -0,0 +1,80 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Menu.EditGoalie
( editGoalieMenu
, editGoalieYtdMenu
, editGoalieLtMenu
) where
import Control.Monad.Trans.State (modify)
import Data.Maybe (maybe)
import Lens.Micro ((.~))
import Mtlstats.Types
import Mtlstats.Types.Menu
-- | The 'Goalie' edit menu
editGoalieMenu :: Menu ()
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
(\(key, label, val) -> MenuItem key label $ modify $ maybe
(progMode .~ MainMenu)
(progMode.editGoalieStateL.egsMode .~)
val)
-- key, label, value
[ ( '1', "Edit number", Just EGNumber )
, ( '2', "Edit name", Just EGName )
, ( '3', "Edit YTD stats", Just EGYtd )
, ( '4', "Edit Lifetime stats", Just EGLifetime )
, ( 'R', "Return to Main Menu", Nothing )
]
-- | The 'Goalie' YTD edit menu
editGoalieYtdMenu :: Menu ()
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
-- key, label, value
[ ( '1', "Edit YTD games", EGYtdGames )
, ( '2', "Edit YTD minutes", EGYtdMins )
, ( '3', "Edit YTD goals", EGYtdGoals )
, ( '4', "Edit YTD wins", EGYtdWins )
, ( '5', "Edit YTD losses", EGYtdLosses )
, ( '6', "Edit YTD ties", EGYtdTies )
, ( 'R', "Return to edit menu", EGMenu )
]
-- | The 'Goalie' lifetime edit menu
editGoalieLtMenu :: Menu ()
editGoalieLtMenu = editMenu
"*** EDIT GOALTENDER LIFETIME ***"
-- key, label, value
[ ( '1', "Edit lifetime games", EGLtGames )
, ( '2', "Edit lifetime minutes", EGLtMins )
, ( '3', "Edit lifetime goals", EGLtGoals )
, ( '4', "Edit lifetime wins", EGLtWins )
, ( '5', "Edit lifetime losses", EGLtLosses )
, ( '6', "Edit lifetime ties", EGLtTies )
, ( 'R', "Return to edit menu", EGMenu )
]
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
editMenu title = Menu title () . map
(\(key, label, val) -> MenuItem key label $
modify $ progMode.editGoalieStateL.egsMode .~ val)

View File

@@ -0,0 +1,74 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Menu.EditPlayer
( editPlayerMenu
, editPlayerYtdMenu
, editPlayerLtMenu
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Types
import Mtlstats.Types.Menu
-- | The 'Player' edit menu
editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $ case mode of
Nothing -> modify $ progMode .~ MainMenu
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
-- key, label, value
[ ( '1', "Edit number", Just EPNumber )
, ( '2', "Edit name", Just EPName )
, ( '3', "Edit position", Just EPPosition )
, ( '4', "Edit YTD stats", Just EPYtd )
, ( '5', "Edit lifetime stats", Just EPLifetime )
, ( 'R', "Finished editing", Nothing )
]
-- | The 'Player' YTD stats edit menu
editPlayerYtdMenu :: Menu ()
editPlayerYtdMenu = editMenu
"*** EDIT PLAYER YEAR-TO-DATE ***"
-- key, label, value
[ ( '1', "Edit YTD goals", EPYtdGoals )
, ( '2', "Edit YTD assists", EPYtdAssists )
, ( '3', "Edit YTD penalty mins", EPYtdPMin )
, ( 'R', "Return to player edit menu", EPMenu )
]
-- | The 'Player' lifetime stats edit menu
editPlayerLtMenu :: Menu ()
editPlayerLtMenu = editMenu
"*** EDIT PLAYER LIFETIME ***"
-- key, label, value
[ ( '1', "Edit lifetime goals", EPLtGoals )
, ( '2', "Edit lifetime assits", EPLtAssists )
, ( '3', "Edit lifetime penalty mins", EPLtPMin )
, ( 'R', "Return to edit player menu", EPMenu )
]
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
editMenu title = Menu title () . map
(\(key, label, val) -> MenuItem key label $
modify $ progMode.editPlayerStateL.epsMode .~ val)

View File

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

View File

@@ -0,0 +1,120 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Prompt.EditGoalie
( goalieToEditPrompt
, editGoalieNumberPrompt
, editGoalieNamePrompt
, editGoalieYtdGamesPrompt
, editGoalieYtdMinsPrompt
, editGoalieYtdGoalsPrompt
, editGoalieYtdWinsPrompt
, editGoalieYtdLossesPrompt
, editGoalieYtdTiesPrompt
, editGoalieLtGamesPrompt
, editGoalieLtMinsPrompt
, editGoalieLtGoalsPrompt
, editGoalieLtWinsPrompt
, editGoalieLtLossesPrompt
, editGoalieLtTiesPrompt
) where
import Control.Monad.Trans.State (modify)
import Lens.Micro ((.~))
import Mtlstats.Actions.EditGoalie
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompt to select a 'Goalie' for editing
goalieToEditPrompt :: Prompt
goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
-- | Prompt to edit a goalie's number
editGoalieNumberPrompt :: Prompt
editGoalieNumberPrompt = numPrompt "Goalie number: " $
modify . editGoalieNumber
-- | Prompt to edit a goalie's name
editGoalieNamePrompt :: Prompt
editGoalieNamePrompt = strPrompt "Goalie name: " $
modify . editGoalieName
-- | Prompt to edit a goalie's YTD games played
editGoalieYtdGamesPrompt :: Prompt
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
modify . editGoalieYtdGames
-- | Prompt to edit a goalie's YTD minutes played
editGoalieYtdMinsPrompt :: Prompt
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
modify . editGoalieYtdMins
-- | Prompt to edit a goalie's YTD goales allowed
editGoalieYtdGoalsPrompt :: Prompt
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
modify . editGoalieYtdGoals
-- | Prompt to edit a goalie's YTD wins
editGoalieYtdWinsPrompt :: Prompt
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
modify . editGoalieYtdWins
-- | Prompt to edit a goalie's YTD losses
editGoalieYtdLossesPrompt :: Prompt
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
modify . editGoalieYtdLosses
-- | Prompt to edit a goalie's YTD ties
editGoalieYtdTiesPrompt :: Prompt
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
modify . editGoalieYtdTies
-- | Prompt to edit a goalie's lifetime games played
editGoalieLtGamesPrompt :: Prompt
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
modify . editGoalieLtGames
-- | Prompt to edit a goalie's lifetime minutes played
editGoalieLtMinsPrompt :: Prompt
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
modify . editGoalieLtMins
-- | Prompt to edit a goalie's lifetime goals allowed
editGoalieLtGoalsPrompt :: Prompt
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
modify . editGoalieLtGoals
-- | Prompt to edit a goalie's lifetime wins
editGoalieLtWinsPrompt :: Prompt
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
modify . editGoalieLtWins
-- | Prompt to edit a goalie's lifetime losses
editGoalieLtLossesPrompt :: Prompt
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
modify . editGoalieLtLosses
-- | Prompt to edit a goalie's lifetime ties
editGoalieLtTiesPrompt :: Prompt
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
modify . editGoalieLtTies

View File

@@ -0,0 +1,116 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE LambdaCase #-}
module Mtlstats.Prompt.NewGame
( gameYearPrompt
, gameDayPrompt
, otherTeamPrompt
, homeScorePrompt
, awayScorePrompt
, recordGoalPrompt
, recordAssistPrompt
, pMinPlayerPrompt
, assignPMinsPrompt
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (?~), (%~))
import Mtlstats.Actions.NewGame
import Mtlstats.Config
import Mtlstats.Format
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompts for the game year
gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $
modify . (progMode.gameStateL.gameYear ?~)
-- | Prompts for the day of the month the game took place
gameDayPrompt :: Prompt
gameDayPrompt = numPrompt "Day of month: " $
modify . (progMode.gameStateL.gameDay ?~)
-- | Prompts for the other team name
otherTeamPrompt :: Prompt
otherTeamPrompt = strPrompt "Other team: " $
modify . (progMode.gameStateL.otherTeam .~)
-- | Prompts for the home score
homeScorePrompt :: Prompt
homeScorePrompt = numPrompt "Home score: " $
modify . (progMode.gameStateL.homeScore ?~)
-- | Prompts for the away score
awayScorePrompt :: Prompt
awayScorePrompt = numPrompt "Away score: " $ \score -> modify
$ overtimeCheck
. (progMode.gameStateL.awayScore ?~ score)
-- | Prompts for the player who scored the goal
recordGoalPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal number
-> Prompt
recordGoalPrompt game goal = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Who scored goal number " ++ show goal ++ "? "
) $ modify . (progMode.gameStateL.goalBy .~)
-- | Prompts for a player who assisted the goal
recordAssistPrompt
:: Int
-- ^ The game number
-> Int
-- ^ The goal nuber
-> Int
-- ^ The assist number
-> Prompt
recordAssistPrompt game goal assist = selectPlayerPrompt
( "*** GAME " ++ padNum 2 game ++ " ***\n"
++ "Goal: " ++ show goal ++ "\n"
++ "Assist #" ++ show assist ++ ": "
) $ \case
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
Just n -> do
modify $ progMode.gameStateL.assistsBy %~ (++[n])
nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-- | Prompts for the player to assign penalty minutes to
pMinPlayerPrompt :: Prompt
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-- | Prompts for the number of penalty mintues to assign to the player
assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins

View File

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

View File

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

View File

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

View File

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

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

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

@@ -0,0 +1,526 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Actions.NewGameSpec (spec) where
import Control.Monad (replicateM)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
import Mtlstats.Actions.NewGame
import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
import qualified TypesSpec as TS
spec :: Spec
spec = describe "NewGame" $ do
overtimeCheckSpec
updateGameStatsSpec
validateGameDateSpec
recordGoalAssistsSpec
awardGoalSpec
awardAssistSpec
resetGoalDataSpec
assignPMinsSpec
awardShutoutsSpec
GoalieInput.spec
overtimeCheckSpec :: Spec
overtimeCheckSpec = describe "overtimeCheck" $ do
context "tie game" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 1)
& overtimeCheck
it "should clear the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
it "should clear the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
it "should leave the overtimeFlag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
context "game won" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 2)
. (awayScore ?~ 1)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
it "should set the overtimeCheck flag to False" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
context "game lost" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameType ?~ HomeGame)
. (homeScore ?~ 1)
. (awayScore ?~ 2)
& overtimeCheck
it "should not change the home score" $
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
it "should not change the away score" $
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
it "should leave the overtimeCheck flag blank" $
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
updateGameStatsSpec :: Spec
updateGameStatsSpec = describe "updateGameStats" $ do
let
baseStats = newGameStats
& gmsWins .~ 1
& gmsLosses .~ 1
& gmsOvertime .~ 1
& gmsGoalsFor .~ 1
& gmsGoalsAgainst .~ 1
s t h a o = newProgState
& progMode.gameStateL
%~ (gameType .~ t)
. (homeScore .~ h)
. (awayScore .~ a)
. (overtimeFlag .~ o)
& database
%~ (dbHomeGameStats .~ baseStats)
. (dbAwayGameStats .~ baseStats)
db hw hl ho hf ha aw al ao af aa = newDatabase
& dbHomeGameStats
%~ (gmsWins .~ hw)
. (gmsLosses .~ hl)
. (gmsOvertime .~ ho)
. (gmsGoalsFor .~ hf)
. (gmsGoalsAgainst .~ ha)
& dbAwayGameStats
%~ (gmsWins .~ aw)
. (gmsLosses .~ al)
. (gmsOvertime .~ ao)
. (gmsGoalsFor .~ af)
. (gmsGoalsAgainst .~ aa)
context "home win" $
it "should record a home win" $ let
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
context "home loss" $
it "should record a home loss" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
context "home overtime loss" $
it "should record a home overtime" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
context "away win" $
it "should record an away win" $ let
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
context "away loss" $
it "should record an away loss" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
context "away overtime loss" $
it "should record an away overtime" $ let
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
context "missing game type" $
it "should not change anything" $ let
s' = s Nothing (Just 1) (Just 2) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing home score" $
it "should not change anything" $ let
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing away score" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
context "missing overtime flag" $
it "should not change anything" $ let
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
db' = updateGameStats s' ^. database
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
validateGameDateSpec :: Spec
validateGameDateSpec = describe "validateGameDate" $ do
context "valid date" $
it "should leave the date unchanged" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 6)
. (gameDay ?~ 25)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
context "invalid date" $
it "should clear the date" $ do
let
s = newProgState
& progMode.gameStateL
%~ (gameYear ?~ 2019)
. (gameMonth ?~ 2)
. (gameDay ?~ 30)
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
context "missing day" $
it "should not change anything" $ do
let
gs = newGameState
& gameYear ?~ 2019
& gameMonth ?~ 6
s = newProgState
& progMode.gameStateL .~ gs
& validateGameDate
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
recordGoalAssistsSpec :: Spec
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
let
joe = newPlayer 1 "Joe" "centre"
bob = newPlayer 2 "Bob" "defense"
steve = newPlayer 3 "Steve" "forward"
dave = newPlayer 4 "Dave" "somewhere"
frank = newPlayer 5 "Frank" "elsewhere"
ps
= newProgState
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
& progMode.gameStateL
%~ (goalBy ?~ 0)
. (assistsBy .~ [1, 2])
. (confirmGoalDataFlag .~ True)
& recordGoalAssists
mapM_
(\(name, n, goals, assists) -> context name $ do
let
player = (ps^.database.dbPlayers) !! n
stats = M.findWithDefault newPlayerStats n $
ps^.progMode.gameStateL.gamePlayerStats
it ("should set the year-to-date goals to " ++ show goals) $
player^.pYtd.psGoals `shouldBe` goals
it ("should set the lifetime goals to " ++ show goals) $
player^.pLifetime.psGoals `shouldBe` goals
it ("should set the game goals to " ++ show goals) $
stats^.psAssists `shouldBe` assists
it ("should set the year-to-date assists to " ++ show assists) $
player^.pYtd.psAssists `shouldBe` assists
it ("should set the lifetime assists to " ++ show assists) $
player^.pLifetime.psAssists `shouldBe` assists
it ("should set the game assists to " ++ show assists) $
stats^.psAssists `shouldBe` assists)
-- name, index, goals, assists
[ ( "Joe", 0, 1, 0 )
, ( "Bob", 1, 0, 1 )
, ( "Steve", 2, 0, 1 )
, ( "Dave", 3, 0, 0 )
]
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assistsBy list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should increment the pointsAccounted counter" $
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
it "should clear the confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
awardGoalSpec :: Spec
awardGoalSpec = describe "awardGoal" $ do
let
joe
= newPlayer 2 "Joe" "centre"
& pYtd.psGoals .~ 1
& pLifetime.psGoals .~ 2
bob
= newPlayer 3 "Bob" "defense"
& pYtd.psGoals .~ 3
& pLifetime.psGoals .~ 4
db
= newDatabase
& dbPlayers .~ [joe, bob]
joeStats
= newPlayerStats
& psGoals .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database .~ db
mapM_
(\(name, pid, ytd, lt, game) ->
context name $ do
let
ps' = awardGoal pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ name ++ "'s year-to-date goals") $
player^.pYtd.psGoals `shouldBe` ytd
it ("should increment " ++ name ++ "'s lifetime goals") $
player^.pLifetime.psGoals `shouldBe` lt
it ("should increment " ++ name ++ "'s game goals") $
gStats^.psGoals `shouldBe` game)
-- player name, player id, ytd goals, lifetime goals, game goals
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardGoal 2 ps
in it "should not change the database" $
ps'^.database `shouldBe` db
context "negative index" $ let
ps' = awardGoal (-1) ps
in it "should not change the database" $
ps'^.database `shouldBe` db
awardAssistSpec :: Spec
awardAssistSpec = describe "awardAssist" $ do
let
joe
= newPlayer 1 "Joe" "centre"
& pYtd.psAssists .~ 1
& pLifetime.psAssists .~ 2
bob
= newPlayer 2 "Bob" "defense"
& pYtd.psAssists .~ 3
& pLifetime.psAssists .~ 4
joeStats
= newPlayerStats
& psAssists .~ 1
ps
= newProgState
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
& database.dbPlayers .~ [joe, bob]
mapM_
(\(name, pid, ytd, lt, game) ->
context name $ do
let
ps' = awardAssist pid ps
player = (ps'^.database.dbPlayers) !! pid
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
it ("should increment " ++ name ++ "'s year-to-date assists") $
player^.pYtd.psAssists `shouldBe` ytd
it ("should increment " ++ name ++ "'s lifetime assists") $
player^.pLifetime.psAssists `shouldBe` lt
it ("should increment " ++ name ++ "'s game assists") $
gStats^.psAssists `shouldBe` game)
-- player name, player id, ytd assists, lifetime assists, game assists
[ ( "Joe", 0, 2, 3, 2 )
, ( "Bob", 1, 4, 5, 1 )
]
context "invalid index" $ let
ps' = awardAssist (-1) ps
in it "should not change anything" $
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
resetGoalDataSpec :: Spec
resetGoalDataSpec = describe "resetGoalData" $ do
players <- runIO $ replicateM 5 TS.makePlayer
let
gs
= newGameState
& goalBy ?~ 1
& assistsBy .~ [2, 3]
& confirmGoalDataFlag .~ True
ps
= newProgState
& database.dbPlayers .~ players
& progMode.gameStateL .~ gs
& resetGoalData
it "should clear the goalBy value" $
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
it "should clear the assists by list" $
ps^.progMode.gameStateL.assistsBy `shouldBe` []
it "should clear confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
assignPMinsSpec :: Spec
assignPMinsSpec = describe "assignPMins" $ let
bob = newPlayer 2 "Bob" "centre"
& pYtd.psPMin .~ 3
& pLifetime.psPMin .~ 4
joe = newPlayer 3 "Joe" "defense"
& pYtd.psPMin .~ 5
& pLifetime.psPMin .~ 6
ps pid = newProgState
& database.dbPlayers .~ [bob, joe]
& progMode.gameStateL
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
. (gameSelectedPlayer .~ pid)
in mapM_
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
context ("selectedPlayer = " ++ show pid) $ do
let ps' = assignPMins 2 $ ps pid
mapM_
(\(name, pid', lt, ytd, game) -> context name $ do
let
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
gStats = ps'^.progMode.gameStateL.gamePlayerStats
pStats = M.findWithDefault newPlayerStats pid' gStats
context "lifetime penalty minutes" $
it ("should be " ++ show lt) $
player^.pLifetime.psPMin `shouldBe` lt
context "year-to-date penalty minutes" $
it ("should be " ++ show ytd) $
player^.pYtd.psPMin `shouldBe` ytd
context "game penalty minutes" $
it ("should be " ++ show game) $
pStats^.psPMin `shouldBe` game)
-- name, index, lifetime, ytd, game
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
, ( "Joe", 1, joeLt, joeYtd, joeGame )
]
it "should set selectedPlayer to Nothing" $
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
, ( Just 1, 4, 3, 2, 8, 7, 2 )
, ( Just 2, 4, 3, 2, 6, 5, 0 )
, ( Nothing, 4, 3, 2, 6, 5, 0 )
]
awardShutoutsSpec :: Spec
awardShutoutsSpec = describe "awardShutouts" $ let
joe = newGoalie 2 "Joe"
& gYtd.gsShutouts .~ 1
& gLifetime.gsShutouts .~ 2
bob = newGoalie 3 "Bob"
& gYtd.gsShutouts .~ 3
& gLifetime.gsShutouts .~ 4
steve = newGoalie 5 "Steve"
& gYtd.gsShutouts .~ 5
& gLifetime.gsShutouts .~ 6
ps = newProgState
& database.dbGoalies .~ [joe, bob, steve]
& progMode.gameStateL.gameGoalieStats .~ M.fromList
[ ( 0, newGoalieStats & gsGoalsAllowed .~ 1 )
, ( 1, newGoalieStats )
]
& awardShutouts
in mapM_
(\(name, gid, expectedGame, expectedYtd, expectedLt) -> context name $ let
game = M.findWithDefault newGoalieStats gid $
ps^.progMode.gameStateL.gameGoalieStats
goalie = (ps^.database.dbGoalies) !! gid
in mapM_
(\(label, actual, expected) -> context label $
it ("should be " ++ show actual) $
actual `shouldBe` expected)
-- label, actual, expected
[ ( "Game", game^.gsShutouts, expectedGame )
, ( "YTD", goalie^.gYtd.gsShutouts, expectedYtd )
, ( "lifetime", goalie^.gLifetime.gsShutouts, expectedLt )
])
-- goalie, goalie ID, Game, YTD, lifetime
[ ( "Joe", 0, 0, 1, 2 )
, ( "Bob", 1, 1, 4, 5 )
, ( "Steve", 2, 0, 5, 6 )
]

View File

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

View File

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

View File

@@ -0,0 +1,66 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Helpers.GoalieSpec (spec) where
import Lens.Micro ((&), (.~), (%~))
import Test.Hspec (Spec, describe, it, shouldBe)
import Mtlstats.Helpers.Goalie
import Mtlstats.Types
spec :: Spec
spec = describe "Goalie"
goalieDetailsSpec
goalieDetailsSpec :: Spec
goalieDetailsSpec = describe "goalieDetails" $ let
input = newGoalie 1 "Joe"
& gYtd
%~ ( gsGames .~ 2 )
. ( gsMinsPlayed .~ 3 )
. ( gsGoalsAllowed .~ 4 )
. ( gsWins .~ 5 )
. ( gsLosses .~ 6 )
. ( gsTies .~ 7 )
& gLifetime
%~ ( gsGames .~ 8 )
. ( gsMinsPlayed .~ 9 )
. ( gsGoalsAllowed .~ 10 )
. ( gsWins .~ 11 )
. ( gsLosses .~ 12 )
. ( gsTies .~ 13 )
expected = unlines
[ "Number: 1"
, " Name: Joe"
, ""
, " YTD Lifetime"
, " Games played 2 8"
, " Mins played 3 9"
, "Goals allowed 4 10"
, " Wins 5 11"
, " Losses 6 12"
, " Ties 7 13"
]
in it "should format the output correctly" $
goalieDetails input `shouldBe` expected

View File

@@ -0,0 +1,61 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Helpers.PlayerSpec (spec) where
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, describe, it, shouldBe)
import Mtlstats.Helpers.Player
import Mtlstats.Types
spec :: Spec
spec = describe "Player"
playerDetailsSpec
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
p = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, "Position: centre"
, ""
, " YTD Lifetime"
, " Goals 2 5"
, " Assists 3 6"
, "Penalty mins 4 7"
]
in playerDetails p `shouldBe` expected

32
test/HelpersSpec.hs Normal file
View File

@@ -0,0 +1,32 @@
{-
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module HelpersSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Helpers.GoalieSpec as Goalie
import qualified Helpers.PlayerSpec as Player
spec :: Spec
spec = describe "Helper" $ do
Player.spec
Goalie.spec

View File

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

View File

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

View File

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

View File

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