Compare commits
103 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a9e12d11a9 | ||
|
|
08be4154b3 | ||
|
|
4e25db12f1 | ||
|
|
50389b4f4c | ||
|
|
dcbb809ae1 | ||
|
|
be54198960 | ||
|
|
e3d5af5f88 | ||
|
|
de67628df0 | ||
|
|
4848e54d81 | ||
|
|
3b6f77ba21 | ||
|
|
e7606c8a5e | ||
|
|
3560aa7595 | ||
|
|
5979856578 | ||
|
|
4941e0e64f | ||
|
|
eedeaed8fc | ||
|
|
d0f237e707 | ||
|
|
8795cb46a9 | ||
|
|
f1f7077c8c | ||
|
|
a407a01339 | ||
|
|
3e1218f6ff | ||
|
|
7ff16b8ac2 | ||
|
|
d7879a92af | ||
|
|
9b9feefa4f | ||
|
|
26a90a5ed9 | ||
|
|
e8b850c23a | ||
|
|
0efac07a33 | ||
|
|
fba5f1b96c | ||
|
|
95853f8bd7 | ||
|
|
01a4141ff4 | ||
|
|
4d6c3faf5e | ||
|
|
7824d56d68 | ||
|
|
e6e28618a3 | ||
|
|
b830947d6c | ||
|
|
29ae55a01e | ||
|
|
5b9c18730c | ||
|
|
61d788cb4e | ||
|
|
aac2752e95 | ||
|
|
9456102935 | ||
|
|
3ba3875752 | ||
|
|
ac3b8e9522 | ||
|
|
2860309fc5 | ||
|
|
dd34429f59 | ||
|
|
13acbbdf35 | ||
|
|
954fe98998 | ||
|
|
c0386fa0b9 | ||
|
|
846d034435 | ||
|
|
3a1480115d | ||
|
|
30cfea0503 | ||
|
|
52d412942a | ||
|
|
afdb7653cd | ||
|
|
6b1aa85010 | ||
|
|
8c482ae785 | ||
|
|
f97db477dd | ||
|
|
101f436424 | ||
|
|
b8aa00aa81 | ||
|
|
4655cb37b9 | ||
|
|
01859634a1 | ||
|
|
e50861613d | ||
|
|
14da1096cd | ||
|
|
a8a5d6a305 | ||
|
|
4f5b4ff5f9 | ||
|
|
cb5aa63469 | ||
|
|
817c3c3fed | ||
|
|
5dcd140280 | ||
|
|
023430d737 | ||
|
|
0961f14c5f | ||
|
|
1b9c072a76 | ||
|
|
203650397e | ||
|
|
f739db4203 | ||
|
|
06348fe928 | ||
|
|
3839d6dd32 | ||
|
|
0234abec4c | ||
|
|
9682aa0af3 | ||
|
|
35eda4a309 | ||
|
|
61ba781c5d | ||
|
|
fceba7eed1 | ||
|
|
895f090f17 | ||
|
|
6c4b08bfcd | ||
|
|
0b3d70e7c3 | ||
|
|
0202ddadab | ||
|
|
75abf0ade8 | ||
|
|
c24016210c | ||
|
|
d1773324d5 | ||
|
|
758dc868ec | ||
|
|
3c9b7dd989 | ||
|
|
f1f0ffef99 | ||
|
|
d14abdb248 | ||
|
|
e1f92ce92e | ||
|
|
3dfbfe7090 | ||
|
|
f9849023bc | ||
|
|
8aa8d39f70 | ||
|
|
cadbd6354b | ||
|
|
dde0291321 | ||
|
|
9a179ed166 | ||
|
|
858da7ab5c | ||
|
|
030cafb571 | ||
|
|
c99a39b2b9 | ||
|
|
9288d885cd | ||
|
|
9f206ede72 | ||
|
|
e802fff7c5 | ||
|
|
04140df812 | ||
|
|
5339c57d5c | ||
|
|
ca2dd92bfe |
@@ -1,5 +1,14 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## 0.7.0
|
||||
- Shortened views to fit within 25 lines
|
||||
- Implemented goalie reports
|
||||
|
||||
## 0.6.0
|
||||
- Generate lifetime statistics report
|
||||
- Implemented goalie editing
|
||||
- Reset game standings on new season
|
||||
|
||||
## 0.5.0
|
||||
|
||||
- Fixed player creation bug
|
||||
|
||||
12
package.yaml
12
package.yaml
@@ -1,5 +1,5 @@
|
||||
name: mtlstats
|
||||
version: 0.5.0
|
||||
version: 0.7.0
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
author: "Jonathan Lamothe"
|
||||
@@ -11,13 +11,13 @@ extra-source-files:
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
synopsis: Hockey statistics tracker
|
||||
category: Statistics
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
|
||||
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
|
||||
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
@@ -33,6 +33,10 @@ dependencies:
|
||||
- bytestring
|
||||
- microlens
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
- -Werror
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
|
||||
@@ -24,37 +24,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Actions
|
||||
( startNewSeason
|
||||
, resetYtd
|
||||
, resetStandings
|
||||
, startNewGame
|
||||
, addChar
|
||||
, removeChar
|
||||
, overtimeCheck
|
||||
, updateGameStats
|
||||
, validateGameDate
|
||||
, createPlayer
|
||||
, createGoalie
|
||||
, editPlayer
|
||||
, editGoalie
|
||||
, addPlayer
|
||||
, addGoalie
|
||||
, resetCreatePlayerState
|
||||
, resetCreateGoalieState
|
||||
, recordGoalAssists
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, backHome
|
||||
, scrollUp
|
||||
, scrollDown
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Calendar (fromGregorianValid)
|
||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Starts a new season
|
||||
startNewSeason :: ProgState -> ProgState
|
||||
@@ -66,6 +57,12 @@ resetYtd
|
||||
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
||||
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
||||
|
||||
-- | Resets game standings
|
||||
resetStandings :: ProgState -> ProgState
|
||||
resetStandings = database
|
||||
%~ ( dbHomeGameStats .~ newGameStats)
|
||||
. ( dbAwayGameStats .~ newGameStats)
|
||||
|
||||
-- | Starts a new game
|
||||
startNewGame :: ProgState -> ProgState
|
||||
startNewGame
|
||||
@@ -82,65 +79,6 @@ removeChar = inputBuffer %~ \case
|
||||
"" -> ""
|
||||
str -> init str
|
||||
|
||||
-- | Determines whether or not to perform a check for overtime
|
||||
overtimeCheck :: ProgState -> ProgState
|
||||
overtimeCheck s
|
||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL
|
||||
%~ (homeScore .~ Nothing)
|
||||
. (awayScore .~ Nothing)
|
||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||
| otherwise = s
|
||||
|
||||
-- | Adjusts the game stats based on the results of the current game
|
||||
updateGameStats :: ProgState -> ProgState
|
||||
updateGameStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gType <- gs^.gameType
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
ot <- gs^.overtimeFlag
|
||||
tScore <- teamScore gs
|
||||
oScore <- otherScore gs
|
||||
let
|
||||
hw = if gType == HomeGame && won then 1 else 0
|
||||
hl = if gType == HomeGame && lost then 1 else 0
|
||||
hot = if gType == HomeGame && ot then 1 else 0
|
||||
hgf = if gType == HomeGame then tScore else 0
|
||||
hga = if gType == HomeGame then oScore else 0
|
||||
aw = if gType == AwayGame && won then 1 else 0
|
||||
al = if gType == AwayGame && lost then 1 else 0
|
||||
aot = if gType == AwayGame && ot then 1 else 0
|
||||
agf = if gType == AwayGame then tScore else 0
|
||||
aga = if gType == AwayGame then oScore else 0
|
||||
Just $ s
|
||||
& database.dbHomeGameStats
|
||||
%~ (gmsWins +~ hw)
|
||||
. (gmsLosses +~ hl)
|
||||
. (gmsOvertime +~ hot)
|
||||
. (gmsGoalsFor +~ hgf)
|
||||
. (gmsGoalsAgainst +~ hga)
|
||||
& database.dbAwayGameStats
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
. (gmsGoalsFor +~ agf)
|
||||
. (gmsGoalsAgainst +~ aga)
|
||||
|
||||
-- | Validates the game date
|
||||
validateGameDate :: ProgState -> ProgState
|
||||
validateGameDate s = fromMaybe s $ do
|
||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||
m <- s^.progMode.gameStateL.gameMonth
|
||||
d <- s^.progMode.gameStateL.gameDay
|
||||
Just $ if null $ fromGregorianValid y m d
|
||||
then s & progMode.gameStateL
|
||||
%~ (gameYear .~ Nothing)
|
||||
. (gameMonth .~ Nothing)
|
||||
. (gameDay .~ Nothing)
|
||||
else s
|
||||
|
||||
-- | Starts player creation mode
|
||||
createPlayer :: ProgState -> ProgState
|
||||
createPlayer = let
|
||||
@@ -163,6 +101,10 @@ createGoalie = let
|
||||
editPlayer :: ProgState -> ProgState
|
||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||
|
||||
-- | Starts the 'Goalie' editing process
|
||||
editGoalie :: ProgState -> ProgState
|
||||
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||
|
||||
-- | Adds the entered player to the roster
|
||||
addPlayer :: ProgState -> ProgState
|
||||
addPlayer s = fromMaybe s $ do
|
||||
@@ -199,81 +141,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
|
||||
%~ (cgsNumber .~ Nothing)
|
||||
. (cgsName .~ "")
|
||||
|
||||
-- | Awards the goal and assists to the players
|
||||
recordGoalAssists :: ProgState -> ProgState
|
||||
recordGoalAssists ps = fromMaybe ps $ do
|
||||
let gs = ps^.progMode.gameStateL
|
||||
goalId <- gs^.goalBy
|
||||
let assistIds = gs^.assistsBy
|
||||
Just $ ps
|
||||
& awardGoal goalId
|
||||
& (\s -> foldr awardAssist s assistIds)
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (pointsAccounted %~ succ)
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Awards a goal to a player
|
||||
awardGoal
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardGoal n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psGoals %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psGoals %~ succ
|
||||
& pLifetime.psGoals %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Awards an assist to a player
|
||||
awardAssist
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardAssist n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psAssists %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psAssists %~ succ
|
||||
& pLifetime.psAssists %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Resets the entered data for the current goal
|
||||
resetGoalData :: ProgState -> ProgState
|
||||
resetGoalData ps = ps & progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Adds penalty minutes to a player
|
||||
assignPMins
|
||||
:: Int
|
||||
-- ^ The number of minutes to add
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
assignPMins mins s = fromMaybe s $ do
|
||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
Just $ s
|
||||
& database.dbPlayers %~ modifyNth n
|
||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||
& progMode.gameStateL
|
||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||
(psPMin +~ mins)
|
||||
)
|
||||
. (gameSelectedPlayer .~ Nothing)
|
||||
|
||||
-- | Resets the program state back to the main menu
|
||||
backHome :: ProgState -> ProgState
|
||||
backHome
|
||||
|
||||
164
src/Mtlstats/Actions/EditGoalie.hs
Normal file
164
src/Mtlstats/Actions/EditGoalie.hs
Normal file
@@ -0,0 +1,164 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.EditGoalie
|
||||
( editGoalieNumber
|
||||
, editGoalieName
|
||||
, editGoalieYtdGames
|
||||
, editGoalieYtdMins
|
||||
, editGoalieYtdGoals
|
||||
, editGoalieYtdWins
|
||||
, editGoalieYtdLosses
|
||||
, editGoalieYtdTies
|
||||
, editGoalieLtGames
|
||||
, editGoalieLtMins
|
||||
, editGoalieLtGoals
|
||||
, editGoalieLtWins
|
||||
, editGoalieLtLosses
|
||||
, editGoalieLtTies
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Edits a goalie's number
|
||||
editGoalieNumber
|
||||
:: Int
|
||||
-- ^ New goalie number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieNumber num = editGoalie (gNumber .~ num) EGMenu
|
||||
|
||||
-- | Edits a goalie's name
|
||||
editGoalieName
|
||||
:: String
|
||||
-- ^ The new name
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieName name = editGoalie (gName .~ name) EGMenu
|
||||
|
||||
-- | Edits a goalie's YTD games
|
||||
editGoalieYtdGames
|
||||
:: Int
|
||||
-- ^ The number of games played
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdGames games = editGoalie (gYtd.gsGames .~ games) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD minutes
|
||||
editGoalieYtdMins
|
||||
:: Int
|
||||
-- ^ The number of minutes played
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdMins mins = editGoalie (gYtd.gsMinsPlayed .~ mins) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD goals allowed
|
||||
editGoalieYtdGoals
|
||||
:: Int
|
||||
-- ^ The number of goals
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdGoals goals = editGoalie (gYtd.gsGoalsAllowed .~ goals) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD wins
|
||||
editGoalieYtdWins
|
||||
:: Int
|
||||
-- ^ The number of wins
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdWins wins = editGoalie (gYtd.gsWins .~ wins) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD losses
|
||||
editGoalieYtdLosses
|
||||
:: Int
|
||||
-- ^ The number of losses
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdLosses losses = editGoalie (gYtd.gsLosses .~ losses) EGYtd
|
||||
|
||||
-- | Edits a goalie's YTD ties
|
||||
editGoalieYtdTies
|
||||
:: Int
|
||||
-- ^ The number of ties
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieYtdTies ties = editGoalie (gYtd.gsTies .~ ties) EGYtd
|
||||
|
||||
-- | Edits a goalie's lifetime games played
|
||||
editGoalieLtGames
|
||||
:: Int
|
||||
-- ^ The number of games
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtGames games = editGoalie (gLifetime.gsGames .~ games) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime minutes played
|
||||
editGoalieLtMins
|
||||
:: Int
|
||||
-- ^ The number of minutes
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtMins mins = editGoalie (gLifetime.gsMinsPlayed .~ mins) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime goals allowed
|
||||
editGoalieLtGoals
|
||||
:: Int
|
||||
-- ^ The number of goals
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtGoals goals = editGoalie (gLifetime.gsGoalsAllowed .~ goals) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime wins
|
||||
editGoalieLtWins
|
||||
:: Int
|
||||
-- ^ The number of wins
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtWins wins = editGoalie (gLifetime.gsWins .~ wins) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime losses
|
||||
editGoalieLtLosses
|
||||
:: Int
|
||||
-- ^ The number of losses
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtLosses losses = editGoalie (gLifetime.gsLosses .~ losses) EGLifetime
|
||||
|
||||
-- | Edits a goalie's lifetime ties
|
||||
editGoalieLtTies
|
||||
:: Int
|
||||
-- ^ The number of ties
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
editGoalieLtTies ties = editGoalie (gLifetime.gsTies .~ ties) EGLifetime
|
||||
|
||||
editGoalie :: (Goalie -> Goalie) -> EditGoalieMode -> ProgState -> ProgState
|
||||
editGoalie f mode s = fromMaybe s $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
void $ nth gid $ s^.database.dbGoalies
|
||||
Just $ s
|
||||
& database.dbGoalies %~ modifyNth gid f
|
||||
& progMode.editGoalieStateL.egsMode .~ mode
|
||||
191
src/Mtlstats/Actions/NewGame.hs
Normal file
191
src/Mtlstats/Actions/NewGame.hs
Normal file
@@ -0,0 +1,191 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.NewGame
|
||||
( overtimeCheck
|
||||
, updateGameStats
|
||||
, validateGameDate
|
||||
, recordGoalAssists
|
||||
, awardGoal
|
||||
, awardAssist
|
||||
, resetGoalData
|
||||
, assignPMins
|
||||
, awardShutouts
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Calendar (fromGregorianValid)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Determines whether or not to perform a check for overtime
|
||||
overtimeCheck :: ProgState -> ProgState
|
||||
overtimeCheck s
|
||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL
|
||||
%~ (homeScore .~ Nothing)
|
||||
. (awayScore .~ Nothing)
|
||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||
| otherwise = s
|
||||
|
||||
-- | Adjusts the game stats based on the results of the current game
|
||||
updateGameStats :: ProgState -> ProgState
|
||||
updateGameStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gType <- gs^.gameType
|
||||
won <- gameWon gs
|
||||
lost <- gameLost gs
|
||||
ot <- gs^.overtimeFlag
|
||||
tScore <- teamScore gs
|
||||
oScore <- otherScore gs
|
||||
let
|
||||
hw = if gType == HomeGame && won then 1 else 0
|
||||
hl = if gType == HomeGame && lost then 1 else 0
|
||||
hot = if gType == HomeGame && ot then 1 else 0
|
||||
hgf = if gType == HomeGame then tScore else 0
|
||||
hga = if gType == HomeGame then oScore else 0
|
||||
aw = if gType == AwayGame && won then 1 else 0
|
||||
al = if gType == AwayGame && lost then 1 else 0
|
||||
aot = if gType == AwayGame && ot then 1 else 0
|
||||
agf = if gType == AwayGame then tScore else 0
|
||||
aga = if gType == AwayGame then oScore else 0
|
||||
Just $ s
|
||||
& database.dbHomeGameStats
|
||||
%~ (gmsWins +~ hw)
|
||||
. (gmsLosses +~ hl)
|
||||
. (gmsOvertime +~ hot)
|
||||
. (gmsGoalsFor +~ hgf)
|
||||
. (gmsGoalsAgainst +~ hga)
|
||||
& database.dbAwayGameStats
|
||||
%~ (gmsWins +~ aw)
|
||||
. (gmsLosses +~ al)
|
||||
. (gmsOvertime +~ aot)
|
||||
. (gmsGoalsFor +~ agf)
|
||||
. (gmsGoalsAgainst +~ aga)
|
||||
|
||||
-- | Validates the game date
|
||||
validateGameDate :: ProgState -> ProgState
|
||||
validateGameDate s = fromMaybe s $ do
|
||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||
m <- s^.progMode.gameStateL.gameMonth
|
||||
d <- s^.progMode.gameStateL.gameDay
|
||||
Just $ if null $ fromGregorianValid y m d
|
||||
then s & progMode.gameStateL
|
||||
%~ (gameYear .~ Nothing)
|
||||
. (gameMonth .~ Nothing)
|
||||
. (gameDay .~ Nothing)
|
||||
else s
|
||||
|
||||
-- | Awards the goal and assists to the players
|
||||
recordGoalAssists :: ProgState -> ProgState
|
||||
recordGoalAssists ps = fromMaybe ps $ do
|
||||
let gs = ps^.progMode.gameStateL
|
||||
goalId <- gs^.goalBy
|
||||
let assistIds = gs^.assistsBy
|
||||
Just $ ps
|
||||
& awardGoal goalId
|
||||
& (\s -> foldr awardAssist s assistIds)
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (pointsAccounted %~ succ)
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Awards a goal to a player
|
||||
awardGoal
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardGoal n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psGoals %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psGoals %~ succ
|
||||
& pLifetime.psGoals %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Awards an assist to a player
|
||||
awardAssist
|
||||
:: Int
|
||||
-- ^ The player's index number
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
awardAssist n ps = ps
|
||||
& progMode.gameStateL.gamePlayerStats %~
|
||||
(\m -> let
|
||||
stats = M.findWithDefault newPlayerStats n m
|
||||
in M.insert n (stats & psAssists %~ succ) m)
|
||||
& database.dbPlayers %~ map
|
||||
(\(i, p) -> if i == n
|
||||
then p
|
||||
& pYtd.psAssists %~ succ
|
||||
& pLifetime.psAssists %~ succ
|
||||
else p) . zip [0..]
|
||||
|
||||
-- | Resets the entered data for the current goal
|
||||
resetGoalData :: ProgState -> ProgState
|
||||
resetGoalData ps = ps & progMode.gameStateL
|
||||
%~ (goalBy .~ Nothing)
|
||||
. (assistsBy .~ [])
|
||||
. (confirmGoalDataFlag .~ False)
|
||||
|
||||
-- | Adds penalty minutes to a player
|
||||
assignPMins
|
||||
:: Int
|
||||
-- ^ The number of minutes to add
|
||||
-> ProgState
|
||||
-> ProgState
|
||||
assignPMins mins s = fromMaybe s $ do
|
||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
Just $ s
|
||||
& database.dbPlayers %~ modifyNth n
|
||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||
& progMode.gameStateL
|
||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||
(psPMin +~ mins)
|
||||
)
|
||||
. (gameSelectedPlayer .~ Nothing)
|
||||
|
||||
-- | Awards a shutout to any 'Goalie' who played and didn't allow any
|
||||
-- goals
|
||||
awardShutouts :: ProgState -> ProgState
|
||||
awardShutouts s = foldl
|
||||
(\s' (gid, stats) -> if stats^.gsGoalsAllowed == 0
|
||||
then s'
|
||||
& database.dbGoalies %~ modifyNth gid
|
||||
( ( gYtd.gsShutouts %~ succ )
|
||||
. ( gLifetime.gsShutouts %~ succ )
|
||||
)
|
||||
& progMode.gameStateL.gameGoalieStats %~ M.adjust
|
||||
(gsShutouts %~ succ)
|
||||
gid
|
||||
else s')
|
||||
s
|
||||
(M.toList $ s^.progMode.gameStateL.gameGoalieStats)
|
||||
@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Actions.GoalieInput
|
||||
module Mtlstats.Actions.NewGame.GoalieInput
|
||||
( finishGoalieEntry
|
||||
, recordGoalieStats
|
||||
, setGameGoalie
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
||||
@@ -43,9 +44,9 @@ recordGoalieStats :: ProgState -> ProgState
|
||||
recordGoalieStats s = fromMaybe s $ do
|
||||
let gs = s^.progMode.gameStateL
|
||||
gid <- gs^.gameSelectedGoalie
|
||||
goalie <- nth gid $ s^.database.dbGoalies
|
||||
mins <- gs^.gameGoalieMinsPlayed
|
||||
goals <- gs^.gameGoalsAllowed
|
||||
void $ nth gid $ s^.database.dbGoalies
|
||||
|
||||
let
|
||||
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
||||
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
|
||||
then 1
|
||||
else 0
|
||||
|
||||
bumpStats gs = gs
|
||||
& gsGames +~ bumpVal
|
||||
& gsMinsPlayed +~ mins
|
||||
& gsGoalsAllowed +~ goals
|
||||
bumpStats
|
||||
= (gsGames +~ bumpVal)
|
||||
. (gsMinsPlayed +~ mins)
|
||||
. (gsGoalsAllowed +~ goals)
|
||||
|
||||
tryFinish = if mins >= gameLength
|
||||
then finishGoalieEntry
|
||||
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
|
||||
l = if lost then 1 else 0
|
||||
t = if tied then 1 else 0
|
||||
|
||||
updateStats gs = gs
|
||||
& gsWins +~ w
|
||||
& gsLosses +~ l
|
||||
& gsTies +~ t
|
||||
updateStats
|
||||
= (gsWins +~ w)
|
||||
. (gsLosses +~ l)
|
||||
. (gsTies +~ t)
|
||||
|
||||
updateGoalie g = g
|
||||
& gYtd %~ updateStats
|
||||
& gLifetime %~ updateStats
|
||||
updateGoalie
|
||||
= (gYtd %~ updateStats)
|
||||
. (gLifetime %~ updateStats)
|
||||
|
||||
updateGameState gs = gs
|
||||
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
|
||||
& gameGoalieAssigned .~ True
|
||||
updateGameState
|
||||
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
|
||||
. (gameGoalieAssigned .~ True)
|
||||
|
||||
Just $ s
|
||||
& database.dbGoalies %~ modifyNth gid updateGoalie
|
||||
@@ -21,25 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control (dispatch) where
|
||||
|
||||
import Control.Monad (join, when)
|
||||
import Control.Monad.Extra (ifM)
|
||||
import Control.Monad (join)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (toUpper)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro.Extras (view)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Control.EditGoalie
|
||||
import Mtlstats.Control.EditPlayer
|
||||
import Mtlstats.Control.GoalieInput
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Control.NewGame
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Reads the program state and returs the apropriate controller to
|
||||
-- run
|
||||
@@ -47,21 +43,7 @@ dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
MainMenu -> mainMenuC
|
||||
NewSeason -> newSeasonC
|
||||
NewGame gs
|
||||
| null $ gs^.gameYear -> gameYearC
|
||||
| null $ gs^.gameMonth -> gameMonthC
|
||||
| null $ gs^.gameDay -> gameDayC
|
||||
| null $ gs^.gameType -> gameTypeC
|
||||
| null $ gs^.otherTeam -> otherTeamC
|
||||
| null $ gs^.homeScore -> homeScoreC
|
||||
| null $ gs^.awayScore -> awayScoreC
|
||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
||||
| not $ gs^.dataVerified -> verifyDataC
|
||||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
||||
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
|
||||
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
|
||||
| not $ gs^.gameGoalieAssigned -> goalieInput s
|
||||
| otherwise -> reportC
|
||||
NewGame gs -> newGameC gs
|
||||
CreatePlayer cps
|
||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||
| null $ cps^.cpsName -> getPlayerNameC
|
||||
@@ -72,6 +54,7 @@ dispatch s = case s^.progMode of
|
||||
| null $ cgs^.cgsName -> getGoalieNameC
|
||||
| otherwise -> confirmCreateGoalieC
|
||||
EditPlayer eps -> editPlayerC eps
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
@@ -87,219 +70,6 @@ newSeasonC = Controller
|
||||
return True
|
||||
}
|
||||
|
||||
gameYearC :: Controller
|
||||
gameYearC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameYearPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameYearPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameMonthMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameMonthMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
gameDayC :: Controller
|
||||
gameDayC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt gameDayPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler gameDayPrompt e
|
||||
modify validateGameDate
|
||||
return True
|
||||
}
|
||||
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu gameTypeMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler gameTypeMenu e
|
||||
return True
|
||||
}
|
||||
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt otherTeamPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler otherTeamPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt homeScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler homeScorePrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt awayScorePrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler awayScorePrompt e
|
||||
modify overtimeCheck
|
||||
return True
|
||||
}
|
||||
|
||||
overtimeFlagC :: Controller
|
||||
overtimeFlagC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
||||
C.drawString "Is the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> do
|
||||
modify $ progMode.gameStateL.dataVerified .~ True
|
||||
modify updateGameStats
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
goalInput gs
|
||||
| null (gs^.goalBy ) = recordGoalC
|
||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||
| otherwise = confirmGoalDataC
|
||||
|
||||
recordGoalC :: Controller
|
||||
recordGoalC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal) = gameGoal s
|
||||
in drawPrompt (recordGoalPrompt game goal) s
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
recordAssistC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal, assist) = gameGoalAssist s
|
||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||
, handleController = \e -> do
|
||||
(game, goal, assist) <- gets gameGoalAssist
|
||||
promptHandler (recordAssistPrompt game goal assist) e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmGoalDataC :: Controller
|
||||
confirmGoalDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
(game, goal) = gameGoal s
|
||||
gs = s^.progMode.gameStateL
|
||||
players = s^.database.dbPlayers
|
||||
msg = unlines $
|
||||
[ " Game: " ++ padNum 2 game
|
||||
, " Goal: " ++ show goal
|
||||
, "Goal scored by: " ++
|
||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||
] ++
|
||||
map
|
||||
(\pid -> " Assisted by: " ++
|
||||
playerSummary (fromJust $ nth pid players))
|
||||
(gs^.assistsBy) ++
|
||||
[ ""
|
||||
, "Is the above information correct? (Y/N)"
|
||||
]
|
||||
C.drawString msg
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify recordGoalAssists
|
||||
Just False -> modify resetGoalData
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(report (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
C.EventSpecialKey _ -> modify backHome
|
||||
C.EventCharacter _ -> modify backHome
|
||||
_ -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
|
||||
getPlayerNumC :: Controller
|
||||
getPlayerNumC = Controller
|
||||
{ drawController = drawPrompt playerNumPrompt
|
||||
@@ -381,15 +151,3 @@ confirmCreateGoalieC = Controller
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
gameGoal :: ProgState -> (Int, Int)
|
||||
gameGoal s =
|
||||
( s^.database.dbGames
|
||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||
)
|
||||
|
||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||
gameGoalAssist s = let
|
||||
(game, goal) = gameGoal s
|
||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||
in (game, goal, assist)
|
||||
|
||||
122
src/Mtlstats/Control/EditGoalie.hs
Normal file
122
src/Mtlstats/Control/EditGoalie.hs
Normal file
@@ -0,0 +1,122 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import UI.NCurses as C
|
||||
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditGoalie
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.EditGoalie
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Controller/dispatcher for editing a 'Goalie'
|
||||
editGoalieC :: EditGoalieState -> Controller
|
||||
editGoalieC egs
|
||||
| null $ egs^.egsSelectedGoalie = selectC
|
||||
| otherwise = editC $ egs^.egsMode
|
||||
|
||||
selectC :: Controller
|
||||
selectC = promptController goalieToEditPrompt
|
||||
|
||||
editC :: EditGoalieMode -> Controller
|
||||
editC = \case
|
||||
EGMenu -> menuC
|
||||
EGNumber -> numberC
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGYtdGames -> ytdGamesC
|
||||
EGYtdMins -> ytdMinsC
|
||||
EGYtdGoals -> ytdGoalsC
|
||||
EGYtdWins -> ytdWinsC
|
||||
EGYtdLosses -> ytdLossesC
|
||||
EGYtdTies -> ytdTiesC
|
||||
EGLtGames -> ltGamesC
|
||||
EGLtMins -> ltMinsC
|
||||
EGLtGoals -> ltGoalsC
|
||||
EGLtWins -> ltWinsC
|
||||
EGLtLosses -> ltLossesC
|
||||
EGLtTies -> ltTiesC
|
||||
|
||||
menuC :: Controller
|
||||
menuC = menuControllerWith header editGoalieMenu
|
||||
|
||||
numberC :: Controller
|
||||
numberC = promptController editGoalieNumberPrompt
|
||||
|
||||
nameC :: Controller
|
||||
nameC = promptController editGoalieNamePrompt
|
||||
|
||||
ytdMenuC :: Controller
|
||||
ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
||||
|
||||
lifetimeMenuC :: Controller
|
||||
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
||||
|
||||
ytdGamesC :: Controller
|
||||
ytdGamesC = promptController editGoalieYtdGamesPrompt
|
||||
|
||||
ytdMinsC :: Controller
|
||||
ytdMinsC = promptController editGoalieYtdMinsPrompt
|
||||
|
||||
ytdGoalsC :: Controller
|
||||
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
|
||||
|
||||
ytdWinsC :: Controller
|
||||
ytdWinsC = promptController editGoalieYtdWinsPrompt
|
||||
|
||||
ytdLossesC :: Controller
|
||||
ytdLossesC = promptController editGoalieYtdLossesPrompt
|
||||
|
||||
ytdTiesC :: Controller
|
||||
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
||||
|
||||
ltGamesC :: Controller
|
||||
ltGamesC = promptController editGoalieLtGamesPrompt
|
||||
|
||||
ltMinsC :: Controller
|
||||
ltMinsC = promptController editGoalieLtMinsPrompt
|
||||
|
||||
ltGoalsC :: Controller
|
||||
ltGoalsC = promptController editGoalieLtGoalsPrompt
|
||||
|
||||
ltWinsC :: Controller
|
||||
ltWinsC = promptController editGoalieLtWinsPrompt
|
||||
|
||||
ltLossesC :: Controller
|
||||
ltLossesC = promptController editGoalieLtLossesPrompt
|
||||
|
||||
ltTiesC :: Controller
|
||||
ltTiesC = promptController editGoalieLtTiesPrompt
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||
g <- nth gid $ s^.database.dbGoalies
|
||||
Just $ goalieDetails g ++ "\n"
|
||||
@@ -25,7 +25,9 @@ import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditPlayer
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.EditPlayer
|
||||
import Mtlstats.Types
|
||||
@@ -40,6 +42,8 @@ editPlayerC eps
|
||||
EPNumber -> numberC
|
||||
EPName -> nameC
|
||||
EPPosition -> positionC
|
||||
EPYtd -> ytdC
|
||||
EPLifetime -> lifetimeC
|
||||
EPYtdGoals -> ytdGoalsC
|
||||
EPYtdAssists -> ytdAssistsC
|
||||
EPYtdPMin -> ytdPMinC
|
||||
@@ -48,96 +52,46 @@ editPlayerC eps
|
||||
EPLtPMin -> ltPMinC
|
||||
|
||||
selectPlayerC :: Controller
|
||||
selectPlayerC = Controller
|
||||
{ drawController = drawPrompt playerToEditPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler playerToEditPrompt e
|
||||
return True
|
||||
}
|
||||
selectPlayerC = promptController playerToEditPrompt
|
||||
|
||||
menuC :: Controller
|
||||
menuC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
header = fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails p ++ "\n"
|
||||
C.drawString header
|
||||
drawMenu editPlayerMenu
|
||||
, handleController = \e -> do
|
||||
menuHandler editPlayerMenu e
|
||||
return True
|
||||
}
|
||||
menuC = menuControllerWith header editPlayerMenu
|
||||
|
||||
numberC :: Controller
|
||||
numberC = Controller
|
||||
{ drawController = drawPrompt editPlayerNumPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNumPrompt e
|
||||
return True
|
||||
}
|
||||
numberC = promptController editPlayerNumPrompt
|
||||
|
||||
nameC :: Controller
|
||||
nameC = Controller
|
||||
{ drawController = drawPrompt editPlayerNamePrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerNamePrompt e
|
||||
return True
|
||||
}
|
||||
nameC = promptController editPlayerNamePrompt
|
||||
|
||||
positionC :: Controller
|
||||
positionC = Controller
|
||||
{ drawController = drawPrompt editPlayerPosPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerPosPrompt e
|
||||
return True
|
||||
}
|
||||
positionC = promptController editPlayerPosPrompt
|
||||
|
||||
ytdC :: Controller
|
||||
ytdC = menuControllerWith header editPlayerYtdMenu
|
||||
|
||||
lifetimeC :: Controller
|
||||
lifetimeC = menuControllerWith header editPlayerLtMenu
|
||||
|
||||
ytdGoalsC :: Controller
|
||||
ytdGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
ytdGoalsC = promptController editPlayerYtdGoalsPrompt
|
||||
|
||||
ytdAssistsC :: Controller
|
||||
ytdAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
ytdAssistsC = promptController editPlayerYtdAssistsPrompt
|
||||
|
||||
ytdPMinC :: Controller
|
||||
ytdPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerYtdPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerYtdPMinPrompt e
|
||||
return True
|
||||
}
|
||||
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
||||
|
||||
ltGoalsC :: Controller
|
||||
ltGoalsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtGoalsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtGoalsPrompt e
|
||||
return True
|
||||
}
|
||||
ltGoalsC = promptController editPlayerLtGoalsPrompt
|
||||
|
||||
ltAssistsC :: Controller
|
||||
ltAssistsC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtAssistsPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtAssistsPrompt e
|
||||
return True
|
||||
}
|
||||
ltAssistsC = promptController editPlayerLtAssistsPrompt
|
||||
|
||||
ltPMinC :: Controller
|
||||
ltPMinC = Controller
|
||||
{ drawController = drawPrompt editPlayerLtPMinPrompt
|
||||
, handleController = \e -> do
|
||||
promptHandler editPlayerLtPMinPrompt e
|
||||
return True
|
||||
}
|
||||
ltPMinC = promptController editPlayerLtPMinPrompt
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerDetails player ++ "\n"
|
||||
|
||||
234
src/Mtlstats/Control/NewGame.hs
Normal file
234
src/Mtlstats/Control/NewGame.hs
Normal file
@@ -0,0 +1,234 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Control.NewGame (newGameC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||
import Lens.Micro ((^.), (.~))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Actions.NewGame
|
||||
import Mtlstats.Control.NewGame.GoalieInput
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.NewGame
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Dispatcher for a new game
|
||||
newGameC :: GameState -> Controller
|
||||
newGameC gs
|
||||
| null $ gs^.gameYear = gameYearC
|
||||
| null $ gs^.gameMonth = gameMonthC
|
||||
| null $ gs^.gameDay = gameDayC
|
||||
| null $ gs^.gameType = gameTypeC
|
||||
| null $ gs^.otherTeam = otherTeamC
|
||||
| null $ gs^.homeScore = homeScoreC
|
||||
| null $ gs^.awayScore = awayScoreC
|
||||
| null $ gs^.overtimeFlag = overtimeFlagC
|
||||
| not $ gs^.dataVerified = verifyDataC
|
||||
| fromJust (unaccountedPoints gs) = goalInput gs
|
||||
| isJust $ gs^.gameSelectedPlayer = getPMinsC
|
||||
| not $ gs^.gamePMinsRecorded = pMinPlayerC
|
||||
| not $ gs^.gameGoalieAssigned = goalieInputC gs
|
||||
| otherwise = reportC
|
||||
|
||||
gameYearC :: Controller
|
||||
gameYearC = promptControllerWith header gameYearPrompt
|
||||
|
||||
gameMonthC :: Controller
|
||||
gameMonthC = menuControllerWith header gameMonthMenu
|
||||
|
||||
gameDayC :: Controller
|
||||
gameDayC = promptControllerWith header gameDayPrompt
|
||||
|
||||
gameTypeC :: Controller
|
||||
gameTypeC = menuControllerWith header gameTypeMenu
|
||||
|
||||
otherTeamC :: Controller
|
||||
otherTeamC = promptControllerWith header otherTeamPrompt
|
||||
|
||||
homeScoreC :: Controller
|
||||
homeScoreC = promptControllerWith header homeScorePrompt
|
||||
|
||||
awayScoreC :: Controller
|
||||
awayScoreC = promptControllerWith header awayScorePrompt
|
||||
|
||||
overtimeFlagC :: Controller
|
||||
overtimeFlagC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString "Did the game go into overtime? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||
return True
|
||||
}
|
||||
|
||||
verifyDataC :: Controller
|
||||
verifyDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let gs = s^.progMode.gameStateL
|
||||
header s
|
||||
C.drawString "\n"
|
||||
C.drawString $ unlines $ labelTable
|
||||
[ ( "Date", gameDate gs )
|
||||
, ( "Game type", show $ fromJust $ gs^.gameType )
|
||||
, ( "Other team", gs^.otherTeam )
|
||||
, ( "Home score", show $ fromJust $ gs^.homeScore )
|
||||
, ( "Away score", show $ fromJust $ gs^.awayScore )
|
||||
, ( "Overtime", show $ fromJust $ gs^.overtimeFlag )
|
||||
]
|
||||
C.drawString "\nIs the above information correct? (Y/N)"
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify
|
||||
$ (progMode.gameStateL.dataVerified .~ True)
|
||||
. updateGameStats
|
||||
. awardShutouts
|
||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
goalInput :: GameState -> Controller
|
||||
goalInput gs
|
||||
| null (gs^.goalBy ) = recordGoalC
|
||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||
| otherwise = confirmGoalDataC
|
||||
|
||||
recordGoalC :: Controller
|
||||
recordGoalC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal) = gameGoal s
|
||||
in drawPrompt (recordGoalPrompt game goal) s
|
||||
, handleController = \e -> do
|
||||
(game, goal) <- gets gameGoal
|
||||
promptHandler (recordGoalPrompt game goal) e
|
||||
return True
|
||||
}
|
||||
|
||||
recordAssistC :: Controller
|
||||
recordAssistC = Controller
|
||||
{ drawController = \s -> let
|
||||
(game, goal, assist) = gameGoalAssist s
|
||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||
, handleController = \e -> do
|
||||
(game, goal, assist) <- gets gameGoalAssist
|
||||
promptHandler (recordAssistPrompt game goal assist) e
|
||||
return True
|
||||
}
|
||||
|
||||
confirmGoalDataC :: Controller
|
||||
confirmGoalDataC = Controller
|
||||
{ drawController = \s -> do
|
||||
let
|
||||
(game, goal) = gameGoal s
|
||||
gs = s^.progMode.gameStateL
|
||||
players = s^.database.dbPlayers
|
||||
msg = unlines $
|
||||
[ " Game: " ++ padNum 2 game
|
||||
, " Goal: " ++ show goal
|
||||
, "Goal scored by: " ++
|
||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||
] ++
|
||||
map
|
||||
(\pid -> " Assisted by: " ++
|
||||
playerSummary (fromJust $ nth pid players))
|
||||
(gs^.assistsBy) ++
|
||||
[ ""
|
||||
, "Is the above information correct? (Y/N)"
|
||||
]
|
||||
C.drawString msg
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case ynHandler e of
|
||||
Just True -> modify recordGoalAssists
|
||||
Just False -> modify resetGoalData
|
||||
Nothing -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
pMinPlayerC :: Controller
|
||||
pMinPlayerC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawPrompt pMinPlayerPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler pMinPlayerPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
getPMinsC :: Controller
|
||||
getPMinsC = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
C.drawString $ fromMaybe "" $ do
|
||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||
player <- nth pid $ s^.database.dbPlayers
|
||||
Just $ playerSummary player ++ "\n"
|
||||
drawPrompt assignPMinsPrompt s
|
||||
, handleController = \e -> do
|
||||
promptHandler assignPMinsPrompt e
|
||||
return True
|
||||
}
|
||||
|
||||
reportC :: Controller
|
||||
reportC = Controller
|
||||
{ drawController = \s -> do
|
||||
(rows, cols) <- C.windowSize
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(report (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case e of
|
||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
C.EventSpecialKey _ -> modify backHome
|
||||
C.EventCharacter _ -> modify backHome
|
||||
_ -> return ()
|
||||
return True
|
||||
}
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $
|
||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||
|
||||
gameGoal :: ProgState -> (Int, Int)
|
||||
gameGoal s =
|
||||
( s^.database.dbGames
|
||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||
)
|
||||
|
||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||
gameGoalAssist s = let
|
||||
(game, goal) = gameGoal s
|
||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||
in (game, goal, assist)
|
||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Control.GoalieInput (goalieInput) where
|
||||
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
@@ -28,21 +28,17 @@ import qualified UI.NCurses as C
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Prompt.GoalieInput
|
||||
import Mtlstats.Prompt.NewGame.GoalieInput
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | The dispatcher for handling goalie input
|
||||
goalieInput :: ProgState -> Controller
|
||||
goalieInput s = let
|
||||
gs = s^.progMode.gameStateL
|
||||
in if gs^.gameGoaliesRecorded
|
||||
then selectGameGoalieC s
|
||||
else if null $ gs^.gameSelectedGoalie
|
||||
then selectGoalieC
|
||||
else if null $ gs^.gameGoalieMinsPlayed
|
||||
then minsPlayedC
|
||||
else goalsAllowedC
|
||||
goalieInputC :: GameState -> Controller
|
||||
goalieInputC gs
|
||||
| gs^.gameGoaliesRecorded = selectGameGoalieC
|
||||
| null $ gs^.gameSelectedGoalie = selectGoalieC
|
||||
| null $ gs^.gameGoalieMinsPlayed = minsPlayedC
|
||||
| otherwise = goalsAllowedC
|
||||
|
||||
selectGoalieC :: Controller
|
||||
selectGoalieC = promptController selectGameGoaliePrompt
|
||||
@@ -53,8 +49,8 @@ minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
|
||||
goalsAllowedC :: Controller
|
||||
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
|
||||
|
||||
selectGameGoalieC :: ProgState -> Controller
|
||||
selectGameGoalieC = menuController . gameGoalieMenu
|
||||
selectGameGoalieC :: Controller
|
||||
selectGameGoalieC = menuStateController gameGoalieMenu
|
||||
|
||||
header :: ProgState -> C.Update ()
|
||||
header s = C.drawString $ unlines
|
||||
@@ -19,6 +19,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Format
|
||||
( padNum
|
||||
, left
|
||||
@@ -26,8 +28,18 @@ module Mtlstats.Format
|
||||
, centre
|
||||
, overlay
|
||||
, month
|
||||
, labelTable
|
||||
, numTable
|
||||
, tableWith
|
||||
, complexTable
|
||||
, overlayLast
|
||||
, showFloating
|
||||
) where
|
||||
|
||||
import Data.List (transpose)
|
||||
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Pad an 'Int' with leading zeroes to fit a certain character width
|
||||
padNum
|
||||
:: Int
|
||||
@@ -101,3 +113,84 @@ month 10 = "OCT"
|
||||
month 11 = "NOV"
|
||||
month 12 = "DEC"
|
||||
month _ = ""
|
||||
|
||||
-- | Creates a two-column table with labels
|
||||
labelTable :: [(String, String)] -> [String]
|
||||
labelTable xs = let
|
||||
labelWidth = maximum $ map (length . fst) xs
|
||||
in map
|
||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
||||
xs
|
||||
|
||||
-- | Creates a variable column table of numbers with two axes
|
||||
numTable
|
||||
:: [String]
|
||||
-- ^ The top column labels
|
||||
-> [(String, [Int])]
|
||||
-- ^ The rows with their labels
|
||||
-> [String]
|
||||
numTable headers rows = tableWith right $ header : body
|
||||
where
|
||||
header = "" : headers
|
||||
body = map
|
||||
(\(label, row) ->
|
||||
label : map show row)
|
||||
rows
|
||||
|
||||
-- | Creates a table from a two-dimensional list with a specified
|
||||
-- padding function
|
||||
tableWith
|
||||
:: (Int -> String -> String)
|
||||
-- ^ The padding function
|
||||
-> [[String]]
|
||||
-- ^ The cells
|
||||
-> [String]
|
||||
tableWith pFunc tData = complexTable
|
||||
(repeat pFunc)
|
||||
(map (map CellText) tData)
|
||||
|
||||
-- | Creates a complex table
|
||||
complexTable
|
||||
:: [Int -> String -> String]
|
||||
-- ^ The padding function for each column
|
||||
-> [[TableCell]]
|
||||
-- ^ The table cells (an array of rows)
|
||||
-> [String]
|
||||
complexTable pFuncs tData = let
|
||||
widths = map
|
||||
(map $ \case
|
||||
CellText str -> length str
|
||||
CellFill _ -> 0)
|
||||
tData
|
||||
colWidths = map maximum $ transpose widths
|
||||
|
||||
bFunc = \case
|
||||
[] -> ""
|
||||
[(f, len, CellText str)] -> f len str
|
||||
[(_, len, CellFill ch)] -> replicate len ch
|
||||
(f, len, CellText str) : cells -> f len str ++ " " ++ bFunc cells
|
||||
(_, len, CellFill ch) : cells -> replicate (succ len) ch ++ bFunc cells
|
||||
|
||||
in map
|
||||
(bFunc . zip3 pFuncs colWidths)
|
||||
tData
|
||||
|
||||
-- | Places an overlay on the last line of an report
|
||||
overlayLast
|
||||
:: String
|
||||
-- ^ The text to overlay
|
||||
-> [String]
|
||||
-- ^ The report to modify
|
||||
-> [String]
|
||||
-- ^ The resulting report
|
||||
overlayLast _ [] = []
|
||||
overlayLast str [l] = [overlay str l]
|
||||
overlayLast str (l:ls) = l : overlayLast str ls
|
||||
|
||||
-- | Converts a non-integer into a string
|
||||
showFloating :: RealFrac n => n -> String
|
||||
showFloating n = let
|
||||
i = round $ n * 100
|
||||
whole = i `div` 100
|
||||
fraction = i `mod` 100
|
||||
in show whole ++ "." ++ padNum 2 fraction
|
||||
|
||||
47
src/Mtlstats/Helpers/Goalie.hs
Normal file
47
src/Mtlstats/Helpers/Goalie.hs
Normal file
@@ -0,0 +1,47 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Goalie (goalieDetails) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed 'String' describing a 'Goalie'
|
||||
goalieDetails :: Goalie -> String
|
||||
goalieDetails g = let
|
||||
header = unlines $ labelTable
|
||||
[ ( "Number", show $ g^.gNumber )
|
||||
, ( "Name", g^.gName )
|
||||
]
|
||||
|
||||
body = unlines $ numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) -> (label, [g^.gYtd.lens, g^.gLifetime.lens]))
|
||||
[ ( "Games played", gsGames )
|
||||
, ( "Mins played", gsMinsPlayed )
|
||||
, ( "Goals allowed", gsGoalsAllowed )
|
||||
, ( "Wins", gsWins )
|
||||
, ( "Losses", gsLosses )
|
||||
, ( "Ties", gsTies )
|
||||
]
|
||||
|
||||
in header ++ "\n" ++ body
|
||||
45
src/Mtlstats/Helpers/Player.hs
Normal file
45
src/Mtlstats/Helpers/Player.hs
Normal file
@@ -0,0 +1,45 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Helpers.Player (playerDetails) where
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines $ top ++ [""] ++ table
|
||||
where
|
||||
top = labelTable
|
||||
[ ( "Number", show $ p^.pNumber )
|
||||
, ( "Name", p^.pName )
|
||||
, ( "Position", p^.pPosition )
|
||||
]
|
||||
|
||||
table = numTable ["YTD", "Lifetime"] $ map
|
||||
(\(label, lens) ->
|
||||
(label, [p^.pYtd.lens, p^.pLifetime.lens]))
|
||||
[ ( "Goals", psGoals )
|
||||
, ( "Assists", psAssists )
|
||||
, ( "Penalty mins", psPMin )
|
||||
]
|
||||
@@ -22,6 +22,8 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Menu (
|
||||
-- * Menu Functions
|
||||
menuController,
|
||||
menuControllerWith,
|
||||
menuStateController,
|
||||
drawMenu,
|
||||
menuHandler,
|
||||
-- * Menus
|
||||
@@ -29,7 +31,6 @@ module Mtlstats.Menu (
|
||||
newSeasonMenu,
|
||||
gameMonthMenu,
|
||||
gameTypeMenu,
|
||||
editPlayerMenu,
|
||||
gameGoalieMenu
|
||||
) where
|
||||
|
||||
@@ -39,7 +40,7 @@ import Data.Aeson (encodeFile)
|
||||
import Data.Char (toUpper)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Lens.Micro ((^.), (.~), (?~))
|
||||
import Lens.Micro ((^.), (?~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import System.EasyFile
|
||||
( createDirectoryIfMissing
|
||||
@@ -49,7 +50,7 @@ import System.EasyFile
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import qualified Mtlstats.Actions.GoalieInput as GI
|
||||
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
@@ -57,13 +58,40 @@ import Mtlstats.Util
|
||||
|
||||
-- | Generates a simple 'Controller' for a Menu
|
||||
menuController :: Menu () -> Controller
|
||||
menuController menu = Controller
|
||||
{ drawController = const $ drawMenu menu
|
||||
menuController = menuControllerWith $ const $ return ()
|
||||
|
||||
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||
menuControllerWith
|
||||
:: (ProgState -> C.Update ())
|
||||
-- ^ Generates the header
|
||||
-> Menu ()
|
||||
-- ^ The menu
|
||||
-> Controller
|
||||
-- ^ The resulting controller
|
||||
menuControllerWith header menu = Controller
|
||||
{ drawController = \s -> do
|
||||
header s
|
||||
drawMenu menu
|
||||
, handleController = \e -> do
|
||||
menuHandler menu e
|
||||
return True
|
||||
}
|
||||
|
||||
-- | Generate and create a controller for a menu based on the current
|
||||
-- 'ProgState'
|
||||
menuStateController
|
||||
:: (ProgState -> Menu ())
|
||||
-- ^ The function to generate the menu
|
||||
-> Controller
|
||||
-- ^ The resulting controller
|
||||
menuStateController menuFunc = Controller
|
||||
{ drawController = drawMenu . menuFunc
|
||||
, handleController = \e -> do
|
||||
menu <- gets menuFunc
|
||||
menuHandler menu e
|
||||
return True
|
||||
}
|
||||
|
||||
-- | The draw function for a 'Menu'
|
||||
drawMenu :: Menu a -> C.Update C.CursorMode
|
||||
drawMenu m = do
|
||||
@@ -91,7 +119,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
||||
modify createGoalie >> return True
|
||||
, MenuItem '5' "Edit Player" $
|
||||
modify editPlayer >> return True
|
||||
, MenuItem '6' "Exit" $ do
|
||||
, MenuItem '6' "Edit Goalie" $
|
||||
modify editGoalie >> return True
|
||||
, MenuItem 'X' "Exit" $ do
|
||||
db <- gets $ view database
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
@@ -104,11 +134,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
||||
-- | The new season menu
|
||||
newSeasonMenu :: Menu ()
|
||||
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
||||
[ MenuItem '1' "Regular Season" $ do
|
||||
modify resetYtd
|
||||
modify startNewGame
|
||||
, MenuItem '2' "Playoffs" $
|
||||
modify startNewGame
|
||||
[ MenuItem 'R' "Regular Season" $ modify
|
||||
$ resetYtd
|
||||
. resetStandings
|
||||
. startNewGame
|
||||
, MenuItem 'P' "Playoffs" $ modify
|
||||
$ resetStandings
|
||||
. startNewGame
|
||||
]
|
||||
|
||||
-- | Requests the month in which the game took place
|
||||
@@ -140,24 +172,6 @@ gameTypeMenu = Menu "Game type:" ()
|
||||
modify $ progMode.gameStateL.gameType ?~ AwayGame
|
||||
]
|
||||
|
||||
-- | The player edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
||||
Nothing -> modify $ progMode .~ MainMenu
|
||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
||||
[ ( '1', "Change number", Just EPNumber )
|
||||
, ( '2', "Change name", Just EPName )
|
||||
, ( '3', "Change position", Just EPPosition )
|
||||
, ( '4', "YTD goals", Just EPYtdGoals )
|
||||
, ( '5', "YTD assists", Just EPYtdAssists )
|
||||
, ( '6', "YTD penalty mins", Just EPYtdPMin )
|
||||
, ( '7', "Lifetime goals", Just EPLtGoals )
|
||||
, ( '8', "Lifetime assists", Just EPLtAssists )
|
||||
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
|
||||
, ( '0', "Finished editing", Nothing )
|
||||
]
|
||||
|
||||
-- | Game goalie selection menu
|
||||
gameGoalieMenu :: ProgState -> Menu ()
|
||||
gameGoalieMenu s = let
|
||||
|
||||
80
src/Mtlstats/Menu/EditGoalie.hs
Normal file
80
src/Mtlstats/Menu/EditGoalie.hs
Normal file
@@ -0,0 +1,80 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Menu.EditGoalie
|
||||
( editGoalieMenu
|
||||
, editGoalieYtdMenu
|
||||
, editGoalieLtMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Data.Maybe (maybe)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Goalie' edit menu
|
||||
editGoalieMenu :: Menu ()
|
||||
editGoalieMenu = Menu "*** EDIT GOALTENDER ***" () $ map
|
||||
(\(key, label, val) -> MenuItem key label $ modify $ maybe
|
||||
(progMode .~ MainMenu)
|
||||
(progMode.editGoalieStateL.egsMode .~)
|
||||
val)
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit number", Just EGNumber )
|
||||
, ( '2', "Edit name", Just EGName )
|
||||
, ( '3', "Edit YTD stats", Just EGYtd )
|
||||
, ( '4', "Edit Lifetime stats", Just EGLifetime )
|
||||
, ( 'R', "Return to Main Menu", Nothing )
|
||||
]
|
||||
|
||||
-- | The 'Goalie' YTD edit menu
|
||||
editGoalieYtdMenu :: Menu ()
|
||||
editGoalieYtdMenu = editMenu "*** EDIT GOALTENDER YEAR-TO-DATE ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit YTD games", EGYtdGames )
|
||||
, ( '2', "Edit YTD minutes", EGYtdMins )
|
||||
, ( '3', "Edit YTD goals", EGYtdGoals )
|
||||
, ( '4', "Edit YTD wins", EGYtdWins )
|
||||
, ( '5', "Edit YTD losses", EGYtdLosses )
|
||||
, ( '6', "Edit YTD ties", EGYtdTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
]
|
||||
|
||||
-- | The 'Goalie' lifetime edit menu
|
||||
editGoalieLtMenu :: Menu ()
|
||||
editGoalieLtMenu = editMenu
|
||||
"*** EDIT GOALTENDER LIFETIME ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit lifetime games", EGLtGames )
|
||||
, ( '2', "Edit lifetime minutes", EGLtMins )
|
||||
, ( '3', "Edit lifetime goals", EGLtGoals )
|
||||
, ( '4', "Edit lifetime wins", EGLtWins )
|
||||
, ( '5', "Edit lifetime losses", EGLtLosses )
|
||||
, ( '6', "Edit lifetime ties", EGLtTies )
|
||||
, ( 'R', "Return to edit menu", EGMenu )
|
||||
]
|
||||
|
||||
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||
editMenu title = Menu title () . map
|
||||
(\(key, label, val) -> MenuItem key label $
|
||||
modify $ progMode.editGoalieStateL.egsMode .~ val)
|
||||
74
src/Mtlstats/Menu/EditPlayer.hs
Normal file
74
src/Mtlstats/Menu/EditPlayer.hs
Normal file
@@ -0,0 +1,74 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Menu.EditPlayer
|
||||
( editPlayerMenu
|
||||
, editPlayerYtdMenu
|
||||
, editPlayerLtMenu
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
|
||||
-- | The 'Player' edit menu
|
||||
editPlayerMenu :: Menu ()
|
||||
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
|
||||
(\(ch, label, mode) -> MenuItem ch label $ case mode of
|
||||
Nothing -> modify $ progMode .~ MainMenu
|
||||
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit number", Just EPNumber )
|
||||
, ( '2', "Edit name", Just EPName )
|
||||
, ( '3', "Edit position", Just EPPosition )
|
||||
, ( '4', "Edit YTD stats", Just EPYtd )
|
||||
, ( '5', "Edit lifetime stats", Just EPLifetime )
|
||||
, ( 'R', "Finished editing", Nothing )
|
||||
]
|
||||
|
||||
-- | The 'Player' YTD stats edit menu
|
||||
editPlayerYtdMenu :: Menu ()
|
||||
editPlayerYtdMenu = editMenu
|
||||
"*** EDIT PLAYER YEAR-TO-DATE ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit YTD goals", EPYtdGoals )
|
||||
, ( '2', "Edit YTD assists", EPYtdAssists )
|
||||
, ( '3', "Edit YTD penalty mins", EPYtdPMin )
|
||||
, ( 'R', "Return to player edit menu", EPMenu )
|
||||
]
|
||||
|
||||
-- | The 'Player' lifetime stats edit menu
|
||||
editPlayerLtMenu :: Menu ()
|
||||
editPlayerLtMenu = editMenu
|
||||
"*** EDIT PLAYER LIFETIME ***"
|
||||
-- key, label, value
|
||||
[ ( '1', "Edit lifetime goals", EPLtGoals )
|
||||
, ( '2', "Edit lifetime assits", EPLtAssists )
|
||||
, ( '3', "Edit lifetime penalty mins", EPLtPMin )
|
||||
, ( 'R', "Return to edit player menu", EPMenu )
|
||||
]
|
||||
|
||||
editMenu :: String -> [(Char, String, EditPlayerMode)] -> Menu ()
|
||||
editMenu title = Menu title () . map
|
||||
(\(key, label, val) -> MenuItem key label $
|
||||
modify $ progMode.editPlayerStateL.epsMode .~ val)
|
||||
@@ -31,11 +31,6 @@ module Mtlstats.Prompt (
|
||||
numPrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
gameYearPrompt,
|
||||
gameDayPrompt,
|
||||
otherTeamPrompt,
|
||||
homeScorePrompt,
|
||||
awayScorePrompt,
|
||||
playerNumPrompt,
|
||||
playerNamePrompt,
|
||||
playerPosPrompt,
|
||||
@@ -43,10 +38,6 @@ module Mtlstats.Prompt (
|
||||
goalieNamePrompt,
|
||||
selectPlayerPrompt,
|
||||
selectGoaliePrompt,
|
||||
recordGoalPrompt,
|
||||
recordAssistPrompt,
|
||||
pMinPlayerPrompt,
|
||||
assignPMinsPrompt,
|
||||
playerToEditPrompt
|
||||
) where
|
||||
|
||||
@@ -55,15 +46,13 @@ import Control.Monad.Extra (whenJust)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Char (isDigit, toUpper)
|
||||
import Data.Foldable (forM_)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||
import Lens.Micro.Extras (view)
|
||||
import Text.Read (readMaybe)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
@@ -173,37 +162,12 @@ selectPrompt params = Prompt
|
||||
n = pred $ fromInteger rawK
|
||||
results = spSearch params sStr db
|
||||
when (n < maxFunKeys) $
|
||||
whenJust (nth n results) $ \(n, _) -> do
|
||||
whenJust (nth n results) $ \(sel, _) -> do
|
||||
modify $ inputBuffer .~ ""
|
||||
spCallback params $ Just n
|
||||
spCallback params $ Just sel
|
||||
_ -> return ()
|
||||
}
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
modify . (progMode.gameStateL.gameYear ?~)
|
||||
|
||||
-- | Prompts for the day of the month the game took place
|
||||
gameDayPrompt :: Prompt
|
||||
gameDayPrompt = numPrompt "Day of month: " $
|
||||
modify . (progMode.gameStateL.gameDay ?~)
|
||||
|
||||
-- | Prompts for the other team name
|
||||
otherTeamPrompt :: Prompt
|
||||
otherTeamPrompt = strPrompt "Other team: " $
|
||||
modify . (progMode.gameStateL.otherTeam .~)
|
||||
|
||||
-- | Prompts for the home score
|
||||
homeScorePrompt :: Prompt
|
||||
homeScorePrompt = numPrompt "Home score: " $
|
||||
modify . (progMode.gameStateL.homeScore ?~)
|
||||
|
||||
-- | Prompts for the away score
|
||||
awayScorePrompt :: Prompt
|
||||
awayScorePrompt = numPrompt "Away score: " $
|
||||
modify . (progMode.gameStateL.awayScore ?~)
|
||||
|
||||
-- | Prompts for a new player's number
|
||||
playerNumPrompt :: Prompt
|
||||
playerNumPrompt = numPrompt "Player number: " $
|
||||
@@ -285,52 +249,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
||||
modify $ progMode .~ CreateGoalie cgs
|
||||
}
|
||||
|
||||
-- | Prompts for the player who scored the goal
|
||||
recordGoalPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal number
|
||||
-> Prompt
|
||||
recordGoalPrompt game goal = selectPlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Who scored goal number " ++ show goal ++ "? "
|
||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||
|
||||
-- | Prompts for a player who assisted the goal
|
||||
recordAssistPrompt
|
||||
:: Int
|
||||
-- ^ The game number
|
||||
-> Int
|
||||
-- ^ The goal nuber
|
||||
-> Int
|
||||
-- ^ The assist number
|
||||
-> Prompt
|
||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||
++ "Goal: " ++ show goal ++ "\n"
|
||||
++ "Assist #" ++ show assist ++ ": "
|
||||
) $ \case
|
||||
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
Just n -> do
|
||||
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
||||
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
|
||||
when (nAssists >= maxAssists) $
|
||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||
|
||||
-- | Prompts for the player to assign penalty minutes to
|
||||
pMinPlayerPrompt :: Prompt
|
||||
pMinPlayerPrompt = selectPlayerPrompt
|
||||
"Assign penalty minutes to: " $
|
||||
\case
|
||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
||||
|
||||
-- | Prompts for the number of penalty mintues to assign to the player
|
||||
assignPMinsPrompt :: Prompt
|
||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||
modify . assignPMins
|
||||
|
||||
playerToEditPrompt :: Prompt
|
||||
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||
|
||||
120
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
120
src/Mtlstats/Prompt/EditGoalie.hs
Normal file
@@ -0,0 +1,120 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Prompt.EditGoalie
|
||||
( goalieToEditPrompt
|
||||
, editGoalieNumberPrompt
|
||||
, editGoalieNamePrompt
|
||||
, editGoalieYtdGamesPrompt
|
||||
, editGoalieYtdMinsPrompt
|
||||
, editGoalieYtdGoalsPrompt
|
||||
, editGoalieYtdWinsPrompt
|
||||
, editGoalieYtdLossesPrompt
|
||||
, editGoalieYtdTiesPrompt
|
||||
, editGoalieLtGamesPrompt
|
||||
, editGoalieLtMinsPrompt
|
||||
, editGoalieLtGoalsPrompt
|
||||
, editGoalieLtWinsPrompt
|
||||
, editGoalieLtLossesPrompt
|
||||
, editGoalieLtTiesPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((.~))
|
||||
|
||||
import Mtlstats.Actions.EditGoalie
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Prompt to select a 'Goalie' for editing
|
||||
goalieToEditPrompt :: Prompt
|
||||
goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
||||
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
||||
|
||||
-- | Prompt to edit a goalie's number
|
||||
editGoalieNumberPrompt :: Prompt
|
||||
editGoalieNumberPrompt = numPrompt "Goalie number: " $
|
||||
modify . editGoalieNumber
|
||||
|
||||
-- | Prompt to edit a goalie's name
|
||||
editGoalieNamePrompt :: Prompt
|
||||
editGoalieNamePrompt = strPrompt "Goalie name: " $
|
||||
modify . editGoalieName
|
||||
|
||||
-- | Prompt to edit a goalie's YTD games played
|
||||
editGoalieYtdGamesPrompt :: Prompt
|
||||
editGoalieYtdGamesPrompt = numPrompt "Year-to-date games played: " $
|
||||
modify . editGoalieYtdGames
|
||||
|
||||
-- | Prompt to edit a goalie's YTD minutes played
|
||||
editGoalieYtdMinsPrompt :: Prompt
|
||||
editGoalieYtdMinsPrompt = numPrompt "Year-to-date minutes played: " $
|
||||
modify . editGoalieYtdMins
|
||||
|
||||
-- | Prompt to edit a goalie's YTD goales allowed
|
||||
editGoalieYtdGoalsPrompt :: Prompt
|
||||
editGoalieYtdGoalsPrompt = numPrompt "Year-to-date goals allowed: " $
|
||||
modify . editGoalieYtdGoals
|
||||
|
||||
-- | Prompt to edit a goalie's YTD wins
|
||||
editGoalieYtdWinsPrompt :: Prompt
|
||||
editGoalieYtdWinsPrompt = numPrompt "Year-to-date wins: " $
|
||||
modify . editGoalieYtdWins
|
||||
|
||||
-- | Prompt to edit a goalie's YTD losses
|
||||
editGoalieYtdLossesPrompt :: Prompt
|
||||
editGoalieYtdLossesPrompt = numPrompt "Year-to-date losses: " $
|
||||
modify . editGoalieYtdLosses
|
||||
|
||||
-- | Prompt to edit a goalie's YTD ties
|
||||
editGoalieYtdTiesPrompt :: Prompt
|
||||
editGoalieYtdTiesPrompt = numPrompt "Year-to-date ties: " $
|
||||
modify . editGoalieYtdTies
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime games played
|
||||
editGoalieLtGamesPrompt :: Prompt
|
||||
editGoalieLtGamesPrompt = numPrompt "Lifetime games played: " $
|
||||
modify . editGoalieLtGames
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime minutes played
|
||||
editGoalieLtMinsPrompt :: Prompt
|
||||
editGoalieLtMinsPrompt = numPrompt "Lifetime minutes played: " $
|
||||
modify . editGoalieLtMins
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||
editGoalieLtGoalsPrompt :: Prompt
|
||||
editGoalieLtGoalsPrompt = numPrompt "Lifetime goals allowed: " $
|
||||
modify . editGoalieLtGoals
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime wins
|
||||
editGoalieLtWinsPrompt :: Prompt
|
||||
editGoalieLtWinsPrompt = numPrompt "Lifetime wins: " $
|
||||
modify . editGoalieLtWins
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime losses
|
||||
editGoalieLtLossesPrompt :: Prompt
|
||||
editGoalieLtLossesPrompt = numPrompt "Lifetime losses: " $
|
||||
modify . editGoalieLtLosses
|
||||
|
||||
-- | Prompt to edit a goalie's lifetime ties
|
||||
editGoalieLtTiesPrompt :: Prompt
|
||||
editGoalieLtTiesPrompt = numPrompt "Lifetime ties: " $
|
||||
modify . editGoalieLtTies
|
||||
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
116
src/Mtlstats/Prompt/NewGame.hs
Normal file
@@ -0,0 +1,116 @@
|
||||
{- |
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Prompt.NewGame
|
||||
( gameYearPrompt
|
||||
, gameDayPrompt
|
||||
, otherTeamPrompt
|
||||
, homeScorePrompt
|
||||
, awayScorePrompt
|
||||
, recordGoalPrompt
|
||||
, recordAssistPrompt
|
||||
, pMinPlayerPrompt
|
||||
, assignPMinsPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Lens.Micro ((^.), (.~), (?~), (%~))
|
||||
|
||||
import Mtlstats.Actions.NewGame
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
-- | Prompts for the game year
|
||||
gameYearPrompt :: Prompt
|
||||
gameYearPrompt = numPrompt "Game year: " $
|
||||
modify . (progMode.gameStateL.gameYear ?~)
|
||||
|
||||
-- | Prompts for the day of the month the game took place
|
||||
gameDayPrompt :: Prompt
|
||||
gameDayPrompt = numPrompt "Day of month: " $
|
||||
modify . (progMode.gameStateL.gameDay ?~)
|
||||
|
||||
-- | Prompts for the other team name
|
||||
otherTeamPrompt :: Prompt
|
||||
otherTeamPrompt = 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
|
||||
@@ -21,19 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Mtlstats.Prompt.GoalieInput
|
||||
module Mtlstats.Prompt.NewGame.GoalieInput
|
||||
( selectGameGoaliePrompt
|
||||
, goalieMinsPlayedPrompt
|
||||
, goalsAllowedPrompt
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (.~), (?~))
|
||||
import Control.Monad.Trans.State (modify)
|
||||
import Lens.Micro ((?~))
|
||||
|
||||
import Mtlstats.Actions.GoalieInput
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Actions.NewGame.GoalieInput
|
||||
import Mtlstats.Prompt
|
||||
import Mtlstats.Types
|
||||
|
||||
@@ -19,10 +19,10 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Mtlstats.Report (report, gameDate, playerNameColWidth) where
|
||||
module Mtlstats.Report (report, gameDate) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
|
||||
import Mtlstats.Config
|
||||
@@ -43,6 +43,8 @@ report width s
|
||||
++ gameStatsReport width s
|
||||
++ [""]
|
||||
++ yearToDateStatsReport width s
|
||||
++ [""]
|
||||
++ lifetimeStatsReport width s
|
||||
|
||||
standingsReport :: Int -> ProgState -> [String]
|
||||
standingsReport width s = fromMaybe [] $ do
|
||||
@@ -58,7 +60,8 @@ standingsReport width s = fromMaybe [] $ do
|
||||
tStats = addGameStats hStats aStats
|
||||
hScore <- gs^.homeScore
|
||||
aScore <- gs^.awayScore
|
||||
Just
|
||||
let
|
||||
rHeader =
|
||||
[ overlay
|
||||
("GAME NUMBER " ++ padNum 2 gNum)
|
||||
(centre width
|
||||
@@ -67,98 +70,187 @@ standingsReport width s = fromMaybe [] $ do
|
||||
, date
|
||||
, centre width "STANDINGS"
|
||||
, ""
|
||||
, centre width
|
||||
$ left 11 myTeam
|
||||
++ right 2 "G"
|
||||
++ right 4 "W"
|
||||
++ right 4 "L"
|
||||
++ right 4 "OT"
|
||||
++ right 4 "GF"
|
||||
++ right 4 "GA"
|
||||
++ right 4 "P"
|
||||
, centre width
|
||||
$ left 11 "HOME"
|
||||
++ showStats hStats
|
||||
, centre width
|
||||
$ left 11 "ROAD"
|
||||
++ showStats aStats
|
||||
, centre width
|
||||
$ replicate 11 ' '
|
||||
++ replicate (2 + 4 * 6) '-'
|
||||
, centre width
|
||||
$ left 11 "TOTALS"
|
||||
++ showStats tStats
|
||||
]
|
||||
|
||||
tHeader =
|
||||
[ CellText myTeam
|
||||
, CellText " G"
|
||||
, CellText " W"
|
||||
, CellText " L"
|
||||
, CellText " OT"
|
||||
, CellText " GF"
|
||||
, CellText " GA"
|
||||
, CellText " P"
|
||||
]
|
||||
|
||||
rowCells stats =
|
||||
[ CellText $ show $ gmsGames stats
|
||||
, CellText $ show $ stats^.gmsWins
|
||||
, CellText $ show $ stats^.gmsLosses
|
||||
, CellText $ show $ stats^.gmsOvertime
|
||||
, CellText $ show $ stats^.gmsGoalsFor
|
||||
, CellText $ show $ stats^.gmsGoalsAgainst
|
||||
, CellText $ show $ gmsPoints stats
|
||||
]
|
||||
|
||||
body =
|
||||
[ CellText "HOME" : rowCells hStats
|
||||
, CellText "ROAD" : rowCells aStats
|
||||
]
|
||||
|
||||
separator = CellText "" : replicate 7 (CellFill '-')
|
||||
totals = CellText "TOTALS" : rowCells tStats
|
||||
|
||||
table = map (centre width) $
|
||||
complexTable
|
||||
(left : repeat right)
|
||||
(tHeader : body ++ [separator, totals])
|
||||
|
||||
Just $ rHeader ++ table
|
||||
|
||||
gameStatsReport :: Int -> ProgState -> [String]
|
||||
gameStatsReport width s = playerReport width "GAME" $
|
||||
fromMaybe [] $ mapM
|
||||
gameStatsReport width s = let
|
||||
gs = s^.progMode.gameStateL
|
||||
db = s^.database
|
||||
|
||||
playerStats = mapMaybe
|
||||
(\(pid, stats) -> do
|
||||
p <- nth pid $ s^.database.dbPlayers
|
||||
p <- nth pid $ db^.dbPlayers
|
||||
Just (p, stats))
|
||||
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
|
||||
(M.toList $ gs^.gamePlayerStats)
|
||||
|
||||
goalieStats = mapMaybe
|
||||
(\(gid, stats) -> do
|
||||
g <- nth gid $ db^.dbGoalies
|
||||
Just (g, stats))
|
||||
(M.toList $ gs^.gameGoalieStats)
|
||||
|
||||
in playerReport width "GAME" playerStats
|
||||
++ [""]
|
||||
++ goalieReport width goalieStats
|
||||
|
||||
yearToDateStatsReport :: Int -> ProgState -> [String]
|
||||
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
|
||||
map (\p -> (p, p^.pYtd)) $
|
||||
filter playerIsActive $ s^.database.dbPlayers
|
||||
yearToDateStatsReport width s = let
|
||||
db = s^.database
|
||||
|
||||
playerStats = map (\p -> (p, p^.pYtd))
|
||||
$ filter playerIsActive
|
||||
$ db^.dbPlayers
|
||||
|
||||
goalieStats = map (\g -> (g, g^.gYtd))
|
||||
$ filter goalieIsActive
|
||||
$ db^.dbGoalies
|
||||
|
||||
in playerReport width "YEAR TO DATE" playerStats
|
||||
++ [""]
|
||||
++ goalieReport width goalieStats
|
||||
|
||||
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||
lifetimeStatsReport width s = let
|
||||
db = s^.database
|
||||
|
||||
playerStats = map (\p -> (p, p^.pYtd))
|
||||
$ db^.dbPlayers
|
||||
|
||||
goalieStats = map (\g -> (g, g^.gYtd))
|
||||
$ db^.dbGoalies
|
||||
|
||||
in playerReport width "LIFETIME" playerStats
|
||||
++ [""]
|
||||
++ goalieReport width goalieStats
|
||||
|
||||
gameDate :: GameState -> String
|
||||
gameDate gs = fromMaybe "" $ do
|
||||
year <- show <$> gs^.gameYear
|
||||
month <- month <$> gs^.gameMonth
|
||||
day <- padNum 2 <$> gs^.gameDay
|
||||
Just $ month ++ " " ++ day ++ " " ++ year
|
||||
y <- show <$> gs^.gameYear
|
||||
m <- month <$> gs^.gameMonth
|
||||
d <- padNum 2 <$> gs^.gameDay
|
||||
Just $ m ++ " " ++ d ++ " " ++ y
|
||||
|
||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||
playerReport width label ps = let
|
||||
nameWidth = playerNameColWidth $ map fst ps
|
||||
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
|
||||
in
|
||||
tStats = foldl addPlayerStats newPlayerStats $ map snd ps
|
||||
|
||||
rHeader =
|
||||
[ centre width (label ++ " STATISTICS")
|
||||
, ""
|
||||
, centre width
|
||||
$ "NO. "
|
||||
++ left nameWidth "PLAYER"
|
||||
++ right 3 "G"
|
||||
++ right 6 "A"
|
||||
++ right 6 "P"
|
||||
++ right 6 "PM"
|
||||
] ++ map
|
||||
(\(p, stats) -> centre width
|
||||
$ right 2 (show $ p^.pNumber)
|
||||
++ " "
|
||||
++ left nameWidth (p^.pName)
|
||||
++ right 3 (show $ stats^.psGoals)
|
||||
++ right 6 (show $ stats^.psAssists)
|
||||
++ right 6 (show $ psPoints stats)
|
||||
++ right 6 (show $ stats^.psPMin))
|
||||
ps ++
|
||||
[ centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ replicate (3 + 3 * 6) '-'
|
||||
, overlay
|
||||
(label ++ " TOTALS")
|
||||
( centre width
|
||||
$ replicate (4 + nameWidth) ' '
|
||||
++ right 3 (show $ tStats^.psGoals)
|
||||
++ right 6 (show $ tStats^.psAssists)
|
||||
++ right 6 (show $ psPoints tStats)
|
||||
++ right 6 (show $ tStats^.psPMin)
|
||||
)
|
||||
]
|
||||
|
||||
playerNameColWidth :: [Player] -> Int
|
||||
playerNameColWidth = foldr
|
||||
(\player current -> max current $ succ $ length $ player^.pName)
|
||||
10
|
||||
tHeader =
|
||||
[ CellText "NO."
|
||||
, CellText "Player"
|
||||
, CellText " G"
|
||||
, CellText " A"
|
||||
, CellText " P"
|
||||
, CellText " PM"
|
||||
]
|
||||
|
||||
showStats :: GameStats -> String
|
||||
showStats gs
|
||||
= right 2 (show $ gmsGames gs)
|
||||
++ right 4 (show $ gs^.gmsWins)
|
||||
++ right 4 (show $ gs^.gmsLosses)
|
||||
++ right 4 (show $ gs^.gmsOvertime)
|
||||
++ right 4 (show $ gs^.gmsGoalsFor)
|
||||
++ right 4 (show $ gs^.gmsGoalsAgainst)
|
||||
++ right 4 (show $ gmsPoints gs)
|
||||
statsCells stats =
|
||||
[ CellText $ show $ stats^.psGoals
|
||||
, CellText $ show $ stats^.psAssists
|
||||
, CellText $ show $ psPoints stats
|
||||
, CellText $ show $ stats^.psPMin
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(p, stats) ->
|
||||
[ CellText $ show (p^.pNumber) ++ " "
|
||||
, CellText $ p^.pName
|
||||
] ++ statsCells stats)
|
||||
ps
|
||||
|
||||
separator = replicate 2 (CellText "") ++ replicate 4 (CellFill '-')
|
||||
|
||||
totals =
|
||||
[ CellText ""
|
||||
, CellText ""
|
||||
] ++ statsCells tStats
|
||||
|
||||
table = overlayLast (label ++ " TOTALS")
|
||||
$ map (centre width)
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ tHeader : body ++ [separator, totals]
|
||||
|
||||
in rHeader ++ table
|
||||
|
||||
goalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||
goalieReport width goalieData = let
|
||||
olayText = "GOALTENDING TOTALS"
|
||||
|
||||
tData = foldl addGoalieStats newGoalieStats
|
||||
$ map snd goalieData
|
||||
|
||||
header =
|
||||
[ CellText "NO."
|
||||
, CellText $ left (length olayText) "GOALTENDER"
|
||||
, CellText "GP"
|
||||
, CellText " MIN"
|
||||
, CellText " GA"
|
||||
, CellText " SO"
|
||||
, CellText "AVE"
|
||||
]
|
||||
|
||||
rowCells stats =
|
||||
[ CellText $ show $ stats^.gsGames
|
||||
, CellText $ show $ stats^.gsMinsPlayed
|
||||
, CellText $ show $ stats^.gsGoalsAllowed
|
||||
, CellText $ show $ stats^.gsShutouts
|
||||
, CellText $ showFloating $ gsAverage stats
|
||||
]
|
||||
|
||||
body = map
|
||||
(\(goalie, stats) ->
|
||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||
, CellText $ show $ goalie^.gName
|
||||
] ++ rowCells stats)
|
||||
goalieData
|
||||
|
||||
separator
|
||||
= replicate 2 (CellText "")
|
||||
++ replicate 5 (CellFill '-')
|
||||
|
||||
summary = replicate 2 (CellText "") ++ rowCells tData
|
||||
|
||||
in map (centre width)
|
||||
$ overlayLast olayText
|
||||
$ complexTable ([right, left] ++ repeat right)
|
||||
$ header : body ++ [separator, summary]
|
||||
|
||||
@@ -33,6 +33,8 @@ module Mtlstats.Types (
|
||||
CreateGoalieState (..),
|
||||
EditPlayerState (..),
|
||||
EditPlayerMode (..),
|
||||
EditGoalieState (..),
|
||||
EditGoalieMode (..),
|
||||
Database (..),
|
||||
Player (..),
|
||||
PlayerStats (..),
|
||||
@@ -41,6 +43,7 @@ module Mtlstats.Types (
|
||||
GameStats (..),
|
||||
Prompt (..),
|
||||
SelectParams (..),
|
||||
TableCell (..),
|
||||
-- * Lenses
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
@@ -52,6 +55,7 @@ module Mtlstats.Types (
|
||||
createPlayerStateL,
|
||||
createGoalieStateL,
|
||||
editPlayerStateL,
|
||||
editGoalieStateL,
|
||||
-- ** GameState Lenses
|
||||
gameYear,
|
||||
gameMonth,
|
||||
@@ -89,6 +93,9 @@ module Mtlstats.Types (
|
||||
-- ** EditPlayerState Lenses
|
||||
epsSelectedPlayer,
|
||||
epsMode,
|
||||
-- ** EditGoalieState Lenses
|
||||
egsSelectedGoalie,
|
||||
egsMode,
|
||||
-- ** Database Lenses
|
||||
dbPlayers,
|
||||
dbGoalies,
|
||||
@@ -114,6 +121,7 @@ module Mtlstats.Types (
|
||||
gsGames,
|
||||
gsMinsPlayed,
|
||||
gsGoalsAllowed,
|
||||
gsShutouts,
|
||||
gsWins,
|
||||
gsLosses,
|
||||
gsTies,
|
||||
@@ -129,6 +137,7 @@ module Mtlstats.Types (
|
||||
newCreatePlayerState,
|
||||
newCreateGoalieState,
|
||||
newEditPlayerState,
|
||||
newEditGoalieState,
|
||||
newDatabase,
|
||||
newPlayer,
|
||||
newPlayerStats,
|
||||
@@ -154,7 +163,6 @@ module Mtlstats.Types (
|
||||
playerSearchExact,
|
||||
modifyPlayer,
|
||||
playerSummary,
|
||||
playerDetails,
|
||||
playerIsActive,
|
||||
-- ** PlayerStats Helpers
|
||||
psPoints,
|
||||
@@ -162,7 +170,11 @@ module Mtlstats.Types (
|
||||
-- ** Goalie Helpers
|
||||
goalieSearch,
|
||||
goalieSearchExact,
|
||||
goalieSummary
|
||||
goalieSummary,
|
||||
goalieIsActive,
|
||||
-- ** GoalieStats Helpers
|
||||
addGoalieStats,
|
||||
gsAverage
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (StateT)
|
||||
@@ -176,6 +188,8 @@ import Data.Aeson
|
||||
, toJSON
|
||||
, withObject
|
||||
, (.:)
|
||||
, (.:?)
|
||||
, (.!=)
|
||||
, (.=)
|
||||
)
|
||||
import Data.List (isInfixOf)
|
||||
@@ -218,6 +232,7 @@ data ProgMode
|
||||
| CreatePlayer CreatePlayerState
|
||||
| CreateGoalie CreateGoalieState
|
||||
| EditPlayer EditPlayerState
|
||||
| EditGoalie EditGoalieState
|
||||
|
||||
instance Show ProgMode where
|
||||
show MainMenu = "MainMenu"
|
||||
@@ -226,6 +241,7 @@ instance Show ProgMode where
|
||||
show (CreatePlayer _) = "CreatePlayer"
|
||||
show (CreateGoalie _) = "CreateGoalie"
|
||||
show (EditPlayer _) = "EditPlayer"
|
||||
show (EditGoalie _) = "EditGoalie"
|
||||
|
||||
-- | The game state
|
||||
data GameState = GameState
|
||||
@@ -326,6 +342,8 @@ data EditPlayerMode
|
||||
| EPNumber
|
||||
| EPName
|
||||
| EPPosition
|
||||
| EPYtd
|
||||
| EPLifetime
|
||||
| EPYtdGoals
|
||||
| EPYtdAssists
|
||||
| EPYtdPMin
|
||||
@@ -334,6 +352,34 @@ data EditPlayerMode
|
||||
| EPLtPMin
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | 'Goalie' edit status
|
||||
data EditGoalieState = EditGoalieState
|
||||
{ _egsSelectedGoalie :: Maybe Int
|
||||
-- ^ The index number of the 'Goalie' being edited
|
||||
, _egsMode :: EditGoalieMode
|
||||
}
|
||||
|
||||
-- | 'Goalie' editing mode
|
||||
data EditGoalieMode
|
||||
= EGMenu
|
||||
| EGNumber
|
||||
| EGName
|
||||
| EGYtd
|
||||
| EGLifetime
|
||||
| EGYtdGames
|
||||
| EGYtdMins
|
||||
| EGYtdGoals
|
||||
| EGYtdWins
|
||||
| EGYtdLosses
|
||||
| EGYtdTies
|
||||
| EGLtGames
|
||||
| EGLtMins
|
||||
| EGLtGoals
|
||||
| EGLtWins
|
||||
| EGLtLosses
|
||||
| EGLtTies
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents the database
|
||||
data Database = Database
|
||||
{ _dbPlayers :: [Player]
|
||||
@@ -475,6 +521,8 @@ data GoalieStats = GoalieStats
|
||||
-- ^ The number of minutes played
|
||||
, _gsGoalsAllowed :: Int
|
||||
-- ^ The number of goals allowed
|
||||
, _gsShutouts :: Int
|
||||
-- ^ The number of shutouts the goalie has accumulated
|
||||
, _gsWins :: Int
|
||||
-- ^ The number of wins
|
||||
, _gsLosses :: Int
|
||||
@@ -485,26 +533,29 @@ data GoalieStats = GoalieStats
|
||||
|
||||
instance FromJSON GoalieStats where
|
||||
parseJSON = withObject "GoalieStats" $ \v -> GoalieStats
|
||||
<$> v .: "games"
|
||||
<*> v .: "mins_played"
|
||||
<*> v .: "goals_allowed"
|
||||
<*> v .: "wins"
|
||||
<*> v .: "losses"
|
||||
<*> v .: "ties"
|
||||
<$> v .:? "games" .!= 0
|
||||
<*> v .:? "mins_played" .!= 0
|
||||
<*> v .:? "goals_allowed" .!= 0
|
||||
<*> v .:? "shutouts" .!= 0
|
||||
<*> v .:? "wins" .!= 0
|
||||
<*> v .:? "losses" .!= 0
|
||||
<*> v .:? "ties" .!= 0
|
||||
|
||||
instance ToJSON GoalieStats where
|
||||
toJSON (GoalieStats g m a w l t) = object
|
||||
toJSON (GoalieStats g m a s w l t) = object
|
||||
[ "games" .= g
|
||||
, "mins_played" .= m
|
||||
, "goals_allowed" .= a
|
||||
, "shutouts" .= s
|
||||
, "wins" .= w
|
||||
, "losses" .= l
|
||||
, "ties" .= t
|
||||
]
|
||||
toEncoding (GoalieStats g m a w l t) = pairs $
|
||||
toEncoding (GoalieStats g m a s w l t) = pairs $
|
||||
"games" .= g <>
|
||||
"mins_played" .= m <>
|
||||
"goals_allowed" .= a <>
|
||||
"shutouts" .= s <>
|
||||
"wins" .= w <>
|
||||
"losses" .= l <>
|
||||
"ties" .= t
|
||||
@@ -576,11 +627,20 @@ data SelectParams a = SelectParams
|
||||
-- ^ The function to call when the selection doesn't exist
|
||||
}
|
||||
|
||||
-- | Describes a table cell
|
||||
data TableCell
|
||||
= CellText String
|
||||
-- ^ A cell with text
|
||||
| CellFill Char
|
||||
-- ^ A cell filled with the given character
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''ProgState
|
||||
makeLenses ''GameState
|
||||
makeLenses ''CreatePlayerState
|
||||
makeLenses ''CreateGoalieState
|
||||
makeLenses ''EditPlayerState
|
||||
makeLenses ''EditGoalieState
|
||||
makeLenses ''Database
|
||||
makeLenses ''Player
|
||||
makeLenses ''PlayerStats
|
||||
@@ -616,6 +676,13 @@ editPlayerStateL = lens
|
||||
_ -> newEditPlayerState)
|
||||
(\_ eps -> EditPlayer eps)
|
||||
|
||||
editGoalieStateL :: Lens' ProgMode EditGoalieState
|
||||
editGoalieStateL = lens
|
||||
(\case
|
||||
EditGoalie egs -> egs
|
||||
_ -> newEditGoalieState)
|
||||
(\_ egs -> EditGoalie egs)
|
||||
|
||||
-- | Constructor for a 'ProgState'
|
||||
newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
@@ -678,6 +745,13 @@ newEditPlayerState = EditPlayerState
|
||||
, _epsMode = EPMenu
|
||||
}
|
||||
|
||||
-- | Constructor for an 'EditGoalieState' value
|
||||
newEditGoalieState :: EditGoalieState
|
||||
newEditGoalieState = EditGoalieState
|
||||
{ _egsSelectedGoalie = Nothing
|
||||
, _egsMode = EGMenu
|
||||
}
|
||||
|
||||
-- | Constructor for a 'Database'
|
||||
newDatabase :: Database
|
||||
newDatabase = Database
|
||||
@@ -733,6 +807,7 @@ newGoalieStats = GoalieStats
|
||||
{ _gsGames = 0
|
||||
, _gsMinsPlayed = 0
|
||||
, _gsGoalsAllowed = 0
|
||||
, _gsShutouts = 0
|
||||
, _gsWins = 0
|
||||
, _gsLosses = 0
|
||||
, _gsTies = 0
|
||||
@@ -828,9 +903,8 @@ playerSearch
|
||||
-> [(Int, Player)]
|
||||
-- ^ The matching players with their index numbers
|
||||
playerSearch sStr =
|
||||
filter (match sStr) .
|
||||
zip [0..]
|
||||
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
|
||||
filter match . zip [0..]
|
||||
where match (_, p) = sStr `isInfixOf` (p^.pName)
|
||||
|
||||
-- | Searches for a player by exact match on name
|
||||
playerSearchExact
|
||||
@@ -841,10 +915,8 @@ playerSearchExact
|
||||
-> Maybe (Int, Player)
|
||||
-- ^ The player's index and value
|
||||
playerSearchExact sStr =
|
||||
listToMaybe .
|
||||
filter (match sStr) .
|
||||
zip [0..]
|
||||
where match sStr (_, p) = p^.pName == sStr
|
||||
listToMaybe . filter match . zip [0..]
|
||||
where match (_, p) = p^.pName == sStr
|
||||
|
||||
-- | Modifies a player with a given name
|
||||
modifyPlayer
|
||||
@@ -866,20 +938,6 @@ playerSummary :: Player -> String
|
||||
playerSummary p =
|
||||
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
|
||||
|
||||
-- | Provides a detailed string describing a 'Player'
|
||||
playerDetails :: Player -> String
|
||||
playerDetails p = unlines
|
||||
[ " Number: " ++ show (p^.pNumber)
|
||||
, " Name: " ++ p^.pName
|
||||
, " Position: " ++ p^.pPosition
|
||||
, " YTD goals: " ++ show (p^.pYtd.psGoals)
|
||||
, " YTD assists: " ++ show (p^.pYtd.psAssists)
|
||||
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
|
||||
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
|
||||
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
|
||||
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
|
||||
]
|
||||
|
||||
-- | Determines whether or not a player has been active in the current
|
||||
-- season/year
|
||||
playerIsActive :: Player -> Bool
|
||||
@@ -930,3 +988,24 @@ goalieSearchExact sStr goalies = let
|
||||
-- | Provides a description string for a 'Goalie'
|
||||
goalieSummary :: Goalie -> String
|
||||
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"
|
||||
|
||||
-- | Determines whether or not a goalie has been active in the current
|
||||
-- season
|
||||
goalieIsActive :: Goalie -> Bool
|
||||
goalieIsActive g = g^.gYtd.gsMinsPlayed /= 0
|
||||
|
||||
-- | Adds two sets of 'GoalieStats'
|
||||
addGoalieStats :: GoalieStats -> GoalieStats -> GoalieStats
|
||||
addGoalieStats g1 g2 = GoalieStats
|
||||
{ _gsGames = g1^.gsGames + g2^.gsGames
|
||||
, _gsMinsPlayed = g1^.gsMinsPlayed + g2^.gsMinsPlayed
|
||||
, _gsGoalsAllowed = g1^.gsGoalsAllowed + g2^.gsGoalsAllowed
|
||||
, _gsShutouts = g1^.gsShutouts + g2^.gsShutouts
|
||||
, _gsWins = g1^.gsWins + g2^.gsWins
|
||||
, _gsLosses = g1^.gsLosses + g2^.gsLosses
|
||||
, _gsTies = g1^.gsTies + g2^.gsTies
|
||||
}
|
||||
|
||||
-- | Determines a goalie's average goals allowed per game.
|
||||
gsAverage :: GoalieStats -> Rational
|
||||
gsAverage gs = fromIntegral (gs^.gsGoalsAllowed) / fromIntegral (gs^.gsGames)
|
||||
|
||||
@@ -38,7 +38,6 @@ module Mtlstats.Types.Menu (
|
||||
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro.TH (makeLenses)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Types
|
||||
|
||||
|
||||
537
test/Actions/EditGoalieSpec.hs
Normal file
537
test/Actions/EditGoalieSpec.hs
Normal file
@@ -0,0 +1,537 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.EditGoalieSpec (spec) where
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.EditGoalie
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "EditGoalie" $ do
|
||||
editGoalieNumberSpec
|
||||
editGoalieNameSpec
|
||||
editGoalieYtdGamesSpec
|
||||
editGoalieYtdMinsSpec
|
||||
editGoalieYtdGoalsSpec
|
||||
editGoalieYtdWinsSpec
|
||||
editGoalieYtdLossesSpec
|
||||
editGoalieYtdTiesSpec
|
||||
editGoalieLtGamesSpec
|
||||
editGoalieLtMinsSpec
|
||||
editGoalieLtGoalsSpec
|
||||
editGoalieLtWinsSpec
|
||||
editGoalieLtLossesSpec
|
||||
editGoalieLtTiesSpec
|
||||
|
||||
editGoalieNumberSpec :: Spec
|
||||
editGoalieNumberSpec = describe "editGoalieNumber" $ editTest
|
||||
(editGoalieNumber 5)
|
||||
EGNumber
|
||||
(uncurry newGoalie)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, (5, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGMenu
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, (2, "Joe")
|
||||
, (5, "Bob")
|
||||
, EGMenu
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, (2, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGNumber
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, (2, "Joe")
|
||||
, (3, "Bob")
|
||||
, EGNumber
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieNameSpec :: Spec
|
||||
editGoalieNameSpec = describe "editGoalieName" $ editTest
|
||||
(editGoalieName "foo")
|
||||
EGName
|
||||
(uncurry newGoalie)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "foo" )
|
||||
, ( 3, "Bob" )
|
||||
, EGMenu
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "foo" )
|
||||
, EGMenu
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "Bob" )
|
||||
, EGName
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe" )
|
||||
, ( 3, "Bob" )
|
||||
, EGName
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdGamesSpec :: Spec
|
||||
editGoalieYtdGamesSpec = describe "editGoalieYtdGames" $ editTest
|
||||
(editGoalieYtdGames 1)
|
||||
EGYtdGames
|
||||
(\(num, name, games) -> newGoalie num name & gYtd.gsGames .~ games)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGames
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGames
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdMinsSpec :: Spec
|
||||
editGoalieYtdMinsSpec = describe "editGoalieYtdMins" $ editTest
|
||||
(editGoalieYtdMins 1)
|
||||
EGYtdMins
|
||||
(\(num, name, mins) -> newGoalie num name & gYtd.gsMinsPlayed .~ mins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, (2, "Joe", 0 )
|
||||
, (3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdMins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdMins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdGoalsSpec :: Spec
|
||||
editGoalieYtdGoalsSpec = describe "editGoalieYtdGoals" $ editTest
|
||||
(editGoalieYtdGoals 1)
|
||||
EGYtdGoals
|
||||
(\(num, name, goals) -> newGoalie num name & gYtd.gsGoalsAllowed .~ goals)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGoals
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdGoals
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdWinsSpec :: Spec
|
||||
editGoalieYtdWinsSpec = describe "editGoalieYtdWins" $ editTest
|
||||
(editGoalieYtdWins 1)
|
||||
EGYtdWins
|
||||
(\(num, name, wins) -> newGoalie num name & gYtd.gsWins .~ wins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdWins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdWins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdLossesSpec :: Spec
|
||||
editGoalieYtdLossesSpec = describe "editGoalieYtdLosses" $ editTest
|
||||
(editGoalieYtdLosses 1)
|
||||
EGYtdLosses
|
||||
(\(num, name, losses) -> newGoalie num name & gYtd.gsLosses .~ losses)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdLosses
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdLosses
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieYtdTiesSpec :: Spec
|
||||
editGoalieYtdTiesSpec = describe "editGoalieYtdTies" $ editTest
|
||||
(editGoalieYtdTies 1)
|
||||
EGYtdTies
|
||||
(\(num, name, ties) -> newGoalie num name & gYtd.gsTies .~ ties)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGYtd
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdTies
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGYtdTies
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtGamesSpec :: Spec
|
||||
editGoalieLtGamesSpec = describe "editGoalieLtGames" $ editTest
|
||||
(editGoalieLtGames 1)
|
||||
EGLtGames
|
||||
(\(num, name, games) -> newGoalie num name & gLifetime.gsGames .~ games)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGames
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGames
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtMinsSpec :: Spec
|
||||
editGoalieLtMinsSpec = describe "editGoalieLtMins" $ editTest
|
||||
(editGoalieLtMins 1)
|
||||
EGLtMins
|
||||
(\(num, name, mins) -> newGoalie num name & gLifetime.gsMinsPlayed .~ mins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtMins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtMins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtGoalsSpec :: Spec
|
||||
editGoalieLtGoalsSpec = describe "editGoalieLtGoals" $ editTest
|
||||
(editGoalieLtGoals 1)
|
||||
EGLtGoals
|
||||
(\(num, name, goals) -> newGoalie num name & gLifetime.gsGoalsAllowed .~ goals)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGoals
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtGoals
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtWinsSpec :: Spec
|
||||
editGoalieLtWinsSpec = describe "editGoalieLtWins" $ editTest
|
||||
(editGoalieLtWins 1)
|
||||
EGLtWins
|
||||
(\(num, name, wins) -> newGoalie num name & gLifetime.gsWins .~ wins)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtWins
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtWins
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtLossesSpec :: Spec
|
||||
editGoalieLtLossesSpec = describe "editGoalieLtLosses" $ editTest
|
||||
(editGoalieLtLosses 1)
|
||||
EGLtLosses
|
||||
(\(num, name, losses) -> newGoalie num name & gLifetime.gsLosses .~ losses)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtLosses
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtLosses
|
||||
)
|
||||
]
|
||||
|
||||
editGoalieLtTiesSpec :: Spec
|
||||
editGoalieLtTiesSpec = describe "editGoalieLtTies" $ editTest
|
||||
(editGoalieLtTies 1)
|
||||
EGLtTies
|
||||
(\(num, name, ties) -> newGoalie num name & gLifetime.gsTies .~ ties)
|
||||
[ ( "set Joe"
|
||||
, Just 0
|
||||
, ( 2, "Joe", 1 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "set Bob"
|
||||
, Just 1
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 1 )
|
||||
, EGLifetime
|
||||
)
|
||||
, ( "out of bounds"
|
||||
, Just 2
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtTies
|
||||
)
|
||||
, ( "no goalie selected"
|
||||
, Nothing
|
||||
, ( 2, "Joe", 0 )
|
||||
, ( 3, "Bob", 0 )
|
||||
, EGLtTies
|
||||
)
|
||||
]
|
||||
|
||||
editTest
|
||||
:: (ProgState -> ProgState)
|
||||
-> EditGoalieMode
|
||||
-> (a -> Goalie)
|
||||
-> [(String, Maybe Int, a, a, EditGoalieMode)]
|
||||
-> Spec
|
||||
editTest func setMode mkGoalie params = do
|
||||
mapM_
|
||||
(\(setLabel, setGid, joeData, bobData, expectMode) -> context setLabel $ do
|
||||
let
|
||||
egs = newEditGoalieState
|
||||
& egsSelectedGoalie .~ setGid
|
||||
& egsMode .~ setMode
|
||||
|
||||
ps = func $ progState $ EditGoalie egs
|
||||
|
||||
mapM_
|
||||
(\(chkLabel, chkGid, goalieData) -> context chkLabel $ let
|
||||
actual = fromJust $ nth chkGid $ ps^.database.dbGoalies
|
||||
expected = mkGoalie goalieData
|
||||
in it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected)
|
||||
-- label, goalie ID, goalie data
|
||||
[ ( "check Joe", 0, joeData )
|
||||
, ( "check Bob", 1, bobData )
|
||||
]
|
||||
|
||||
context "check mode" $
|
||||
it ("should be " ++ show expectMode) $
|
||||
ps^.progMode.editGoalieStateL.egsMode `shouldBe` expectMode)
|
||||
|
||||
params
|
||||
|
||||
context "wrong progMode" $ do
|
||||
let ps = func $ progState MainMenu
|
||||
|
||||
it "should not change the database" $
|
||||
ps^.database `shouldBe` db
|
||||
|
||||
it "should not change the progMode" $
|
||||
show (ps^.progMode) `shouldBe` "MainMenu"
|
||||
|
||||
joe :: Goalie
|
||||
joe = newGoalie 2 "Joe"
|
||||
|
||||
bob :: Goalie
|
||||
bob = newGoalie 3 "Bob"
|
||||
|
||||
db :: Database
|
||||
db = newDatabase & dbGoalies .~ [joe, bob]
|
||||
|
||||
progState :: ProgMode -> ProgState
|
||||
progState mode = newProgState
|
||||
& progMode .~ mode
|
||||
& database .~ db
|
||||
@@ -19,14 +19,14 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.GoalieInputSpec (spec) where
|
||||
module Actions.NewGame.GoalieInputSpec (spec) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.GoalieInput
|
||||
import Mtlstats.Actions.NewGame.GoalieInput
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
& progMode.gameStateL .~ gameState n mins goals
|
||||
|
||||
in mapM_
|
||||
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
|
||||
s = recordGoalieStats $ progState gid mins goals
|
||||
in context name $ do
|
||||
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
|
||||
s = recordGoalieStats $ progState setGid mins goals
|
||||
in context setName $ do
|
||||
|
||||
mapM_
|
||||
(\( name
|
||||
, gid
|
||||
(\( chkName
|
||||
, chkGid
|
||||
, ( gGames
|
||||
, gMins
|
||||
, gGoals
|
||||
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
, ltMins
|
||||
, ltGoals
|
||||
)
|
||||
) -> context name $ do
|
||||
) -> context chkName $ do
|
||||
let
|
||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats gid gs
|
||||
goalie = fromJust $ nth gid $ s^.database.dbGoalies
|
||||
game = M.findWithDefault newGoalieStats chkGid gs
|
||||
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
|
||||
ytd = goalie^.gYtd
|
||||
lt = goalie^.gLifetime
|
||||
|
||||
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||
]
|
||||
|
||||
context "selected goalie" $ let
|
||||
expected = if reset then Nothing else gid
|
||||
expected = if reset then Nothing else setGid
|
||||
in it ("should be " ++ show expected) $
|
||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||
|
||||
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
||||
tiedGame = gameState 0 1 True
|
||||
|
||||
in mapM_
|
||||
(\(label, gameState, gid, bobData, joeData) -> context label $ let
|
||||
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
||||
|
||||
progState = newProgState
|
||||
& database.dbGoalies .~ [bob, joe]
|
||||
& progMode.gameStateL .~ gameState
|
||||
& setGameGoalie gid
|
||||
& progMode.gameStateL .~ gs
|
||||
& setGameGoalie setGid
|
||||
|
||||
in mapM_
|
||||
(\( label
|
||||
, gid
|
||||
(\( chkLabel
|
||||
, chkGid
|
||||
, ( gWins
|
||||
, gLosses
|
||||
, gTies
|
||||
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
||||
, ltLosses
|
||||
, ltTies
|
||||
)
|
||||
) -> context label $ do
|
||||
) -> context chkLabel $ do
|
||||
let
|
||||
goalie = (progState^.database.dbGoalies) !! gid
|
||||
goalie = (progState^.database.dbGoalies) !! chkGid
|
||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||
game = M.findWithDefault newGoalieStats gid gameStats
|
||||
game = M.findWithDefault newGoalieStats chkGid gameStats
|
||||
ytd = goalie^.gYtd
|
||||
lifetime = goalie^.gLifetime
|
||||
|
||||
mapM_
|
||||
(\(label, expected, actual) -> context label $
|
||||
(\(label', expected, actual) -> context label' $
|
||||
expected `TS.compareTest` actual)
|
||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||
526
test/Actions/NewGameSpec.hs
Normal file
526
test/Actions/NewGameSpec.hs
Normal file
@@ -0,0 +1,526 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Actions.NewGameSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
|
||||
|
||||
import Mtlstats.Actions.NewGame
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "NewGame" $ do
|
||||
overtimeCheckSpec
|
||||
updateGameStatsSpec
|
||||
validateGameDateSpec
|
||||
recordGoalAssistsSpec
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
awardShutoutsSpec
|
||||
GoalieInput.spec
|
||||
|
||||
overtimeCheckSpec :: Spec
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||
|
||||
context "tie game" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should clear the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||
|
||||
it "should clear the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||
|
||||
it "should leave the overtimeFlag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
context "game won" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||
|
||||
it "should set the overtimeCheck flag to False" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||
|
||||
context "game lost" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 2)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||
|
||||
it "should leave the overtimeCheck flag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
updateGameStatsSpec :: Spec
|
||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||
let
|
||||
|
||||
baseStats = newGameStats
|
||||
& gmsWins .~ 1
|
||||
& gmsLosses .~ 1
|
||||
& gmsOvertime .~ 1
|
||||
& gmsGoalsFor .~ 1
|
||||
& gmsGoalsAgainst .~ 1
|
||||
|
||||
s t h a o = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType .~ t)
|
||||
. (homeScore .~ h)
|
||||
. (awayScore .~ a)
|
||||
. (overtimeFlag .~ o)
|
||||
& database
|
||||
%~ (dbHomeGameStats .~ baseStats)
|
||||
. (dbAwayGameStats .~ baseStats)
|
||||
|
||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
||||
& dbHomeGameStats
|
||||
%~ (gmsWins .~ hw)
|
||||
. (gmsLosses .~ hl)
|
||||
. (gmsOvertime .~ ho)
|
||||
. (gmsGoalsFor .~ hf)
|
||||
. (gmsGoalsAgainst .~ ha)
|
||||
& dbAwayGameStats
|
||||
%~ (gmsWins .~ aw)
|
||||
. (gmsLosses .~ al)
|
||||
. (gmsOvertime .~ ao)
|
||||
. (gmsGoalsFor .~ af)
|
||||
. (gmsGoalsAgainst .~ aa)
|
||||
|
||||
context "home win" $
|
||||
it "should record a home win" $ let
|
||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
||||
|
||||
context "home loss" $
|
||||
it "should record a home loss" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
||||
|
||||
context "home overtime loss" $
|
||||
it "should record a home overtime" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
||||
|
||||
context "away win" $
|
||||
it "should record an away win" $ let
|
||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
||||
|
||||
context "away loss" $
|
||||
it "should record an away loss" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
||||
|
||||
context "away overtime loss" $
|
||||
it "should record an away overtime" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
||||
|
||||
context "missing game type" $
|
||||
it "should not change anything" $ let
|
||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing home score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing away score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing overtime flag" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
validateGameDateSpec :: Spec
|
||||
validateGameDateSpec = describe "validateGameDate" $ do
|
||||
|
||||
context "valid date" $
|
||||
it "should leave the date unchanged" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 6)
|
||||
. (gameDay ?~ 25)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
||||
|
||||
context "invalid date" $
|
||||
it "should clear the date" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 2)
|
||||
. (gameDay ?~ 30)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
context "missing day" $
|
||||
it "should not change anything" $ do
|
||||
let
|
||||
|
||||
gs = newGameState
|
||||
& gameYear ?~ 2019
|
||||
& gameMonth ?~ 6
|
||||
|
||||
s = newProgState
|
||||
& progMode.gameStateL .~ gs
|
||||
& validateGameDate
|
||||
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
recordGoalAssistsSpec :: Spec
|
||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||
let
|
||||
joe = newPlayer 1 "Joe" "centre"
|
||||
bob = newPlayer 2 "Bob" "defense"
|
||||
steve = newPlayer 3 "Steve" "forward"
|
||||
dave = newPlayer 4 "Dave" "somewhere"
|
||||
frank = newPlayer 5 "Frank" "elsewhere"
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy ?~ 0)
|
||||
. (assistsBy .~ [1, 2])
|
||||
. (confirmGoalDataFlag .~ True)
|
||||
& recordGoalAssists
|
||||
|
||||
mapM_
|
||||
(\(name, n, goals, assists) -> context name $ do
|
||||
let
|
||||
player = (ps^.database.dbPlayers) !! n
|
||||
stats = M.findWithDefault newPlayerStats n $
|
||||
ps^.progMode.gameStateL.gamePlayerStats
|
||||
|
||||
it ("should set the year-to-date goals to " ++ show goals) $
|
||||
player^.pYtd.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the lifetime goals to " ++ show goals) $
|
||||
player^.pLifetime.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the game goals to " ++ show goals) $
|
||||
stats^.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the year-to-date assists to " ++ show assists) $
|
||||
player^.pYtd.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the lifetime assists to " ++ show assists) $
|
||||
player^.pLifetime.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the game assists to " ++ show assists) $
|
||||
stats^.psAssists `shouldBe` assists)
|
||||
|
||||
-- name, index, goals, assists
|
||||
[ ( "Joe", 0, 1, 0 )
|
||||
, ( "Bob", 1, 0, 1 )
|
||||
, ( "Steve", 2, 0, 1 )
|
||||
, ( "Dave", 3, 0, 0 )
|
||||
]
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assistsBy list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should increment the pointsAccounted counter" $
|
||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
||||
|
||||
it "should clear the confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
awardGoalSpec :: Spec
|
||||
awardGoalSpec = describe "awardGoal" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 2 "Joe" "centre"
|
||||
& pYtd.psGoals .~ 1
|
||||
& pLifetime.psGoals .~ 2
|
||||
bob
|
||||
= newPlayer 3 "Bob" "defense"
|
||||
& pYtd.psGoals .~ 3
|
||||
& pLifetime.psGoals .~ 4
|
||||
db
|
||||
= newDatabase
|
||||
& dbPlayers .~ [joe, bob]
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psGoals .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database .~ db
|
||||
|
||||
mapM_
|
||||
(\(name, pid, ytd, lt, game) ->
|
||||
context name $ do
|
||||
let
|
||||
ps' = awardGoal pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ name ++ "'s year-to-date goals") $
|
||||
player^.pYtd.psGoals `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ name ++ "'s lifetime goals") $
|
||||
player^.pLifetime.psGoals `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ name ++ "'s game goals") $
|
||||
gStats^.psGoals `shouldBe` game)
|
||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardGoal 2 ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
context "negative index" $ let
|
||||
ps' = awardGoal (-1) ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
awardAssistSpec :: Spec
|
||||
awardAssistSpec = describe "awardAssist" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 1 "Joe" "centre"
|
||||
& pYtd.psAssists .~ 1
|
||||
& pLifetime.psAssists .~ 2
|
||||
bob
|
||||
= newPlayer 2 "Bob" "defense"
|
||||
& pYtd.psAssists .~ 3
|
||||
& pLifetime.psAssists .~ 4
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psAssists .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database.dbPlayers .~ [joe, bob]
|
||||
|
||||
mapM_
|
||||
(\(name, pid, ytd, lt, game) ->
|
||||
context name $ do
|
||||
let
|
||||
ps' = awardAssist pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ name ++ "'s year-to-date assists") $
|
||||
player^.pYtd.psAssists `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ name ++ "'s lifetime assists") $
|
||||
player^.pLifetime.psAssists `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ name ++ "'s game assists") $
|
||||
gStats^.psAssists `shouldBe` game)
|
||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardAssist (-1) ps
|
||||
in it "should not change anything" $
|
||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
||||
|
||||
resetGoalDataSpec :: Spec
|
||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
||||
players <- runIO $ replicateM 5 TS.makePlayer
|
||||
let
|
||||
gs
|
||||
= newGameState
|
||||
& goalBy ?~ 1
|
||||
& assistsBy .~ [2, 3]
|
||||
& confirmGoalDataFlag .~ True
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ players
|
||||
& progMode.gameStateL .~ gs
|
||||
& resetGoalData
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assists by list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should clear confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
assignPMinsSpec :: Spec
|
||||
assignPMinsSpec = describe "assignPMins" $ let
|
||||
|
||||
bob = newPlayer 2 "Bob" "centre"
|
||||
& pYtd.psPMin .~ 3
|
||||
& pLifetime.psPMin .~ 4
|
||||
|
||||
joe = newPlayer 3 "Joe" "defense"
|
||||
& pYtd.psPMin .~ 5
|
||||
& pLifetime.psPMin .~ 6
|
||||
|
||||
ps pid = newProgState
|
||||
& database.dbPlayers .~ [bob, joe]
|
||||
& progMode.gameStateL
|
||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||
. (gameSelectedPlayer .~ pid)
|
||||
|
||||
in mapM_
|
||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||
context ("selectedPlayer = " ++ show pid) $ do
|
||||
let ps' = assignPMins 2 $ ps pid
|
||||
|
||||
mapM_
|
||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||
let
|
||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||
|
||||
context "lifetime penalty minutes" $
|
||||
it ("should be " ++ show lt) $
|
||||
player^.pLifetime.psPMin `shouldBe` lt
|
||||
|
||||
context "year-to-date penalty minutes" $
|
||||
it ("should be " ++ show ytd) $
|
||||
player^.pYtd.psPMin `shouldBe` ytd
|
||||
|
||||
context "game penalty minutes" $
|
||||
it ("should be " ++ show game) $
|
||||
pStats^.psPMin `shouldBe` game)
|
||||
|
||||
-- name, index, lifetime, ytd, game
|
||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||
]
|
||||
|
||||
it "should set selectedPlayer to Nothing" $
|
||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
||||
|
||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
awardShutoutsSpec :: Spec
|
||||
awardShutoutsSpec = describe "awardShutouts" $ let
|
||||
joe = newGoalie 2 "Joe"
|
||||
& gYtd.gsShutouts .~ 1
|
||||
& gLifetime.gsShutouts .~ 2
|
||||
|
||||
bob = newGoalie 3 "Bob"
|
||||
& gYtd.gsShutouts .~ 3
|
||||
& gLifetime.gsShutouts .~ 4
|
||||
|
||||
steve = newGoalie 5 "Steve"
|
||||
& gYtd.gsShutouts .~ 5
|
||||
& gLifetime.gsShutouts .~ 6
|
||||
|
||||
ps = newProgState
|
||||
& database.dbGoalies .~ [joe, bob, steve]
|
||||
& progMode.gameStateL.gameGoalieStats .~ M.fromList
|
||||
[ ( 0, newGoalieStats & gsGoalsAllowed .~ 1 )
|
||||
, ( 1, newGoalieStats )
|
||||
]
|
||||
& awardShutouts
|
||||
|
||||
in mapM_
|
||||
(\(name, gid, expectedGame, expectedYtd, expectedLt) -> context name $ let
|
||||
game = M.findWithDefault newGoalieStats gid $
|
||||
ps^.progMode.gameStateL.gameGoalieStats
|
||||
goalie = (ps^.database.dbGoalies) !! gid
|
||||
in mapM_
|
||||
(\(label, actual, expected) -> context label $
|
||||
it ("should be " ++ show actual) $
|
||||
actual `shouldBe` expected)
|
||||
-- label, actual, expected
|
||||
[ ( "Game", game^.gsShutouts, expectedGame )
|
||||
, ( "YTD", goalie^.gYtd.gsShutouts, expectedYtd )
|
||||
, ( "lifetime", goalie^.gLifetime.gsShutouts, expectedLt )
|
||||
])
|
||||
-- goalie, goalie ID, Game, YTD, lifetime
|
||||
[ ( "Joe", 0, 0, 1, 2 )
|
||||
, ( "Bob", 1, 1, 4, 5 )
|
||||
, ( "Steve", 2, 0, 5, 6 )
|
||||
]
|
||||
@@ -24,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module ActionsSpec (spec) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||
import System.Random (randomRIO)
|
||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, context
|
||||
, describe
|
||||
, it
|
||||
, runIO
|
||||
, shouldBe
|
||||
, shouldNotBe
|
||||
, shouldSatisfy
|
||||
@@ -41,9 +37,9 @@ import Test.Hspec
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
import qualified Actions.GoalieInputSpec as GoalieInput
|
||||
import qualified Actions.EditGoalieSpec as EditGoalie
|
||||
import qualified Actions.NewGameSpec as NewGame
|
||||
import qualified TypesSpec as TS
|
||||
|
||||
spec :: Spec
|
||||
@@ -51,27 +47,22 @@ spec = describe "Mtlstats.Actions" $ do
|
||||
startNewSeasonSpec
|
||||
startNewGameSpec
|
||||
resetYtdSpec
|
||||
resetStandingsSpec
|
||||
addCharSpec
|
||||
removeCharSpec
|
||||
overtimeCheckSpec
|
||||
updateGameStatsSpec
|
||||
validateGameDateSpec
|
||||
createPlayerSpec
|
||||
createGoalieSpec
|
||||
editPlayerSpec
|
||||
editGoalieSpec
|
||||
addPlayerSpec
|
||||
addGoalieSpec
|
||||
resetCreatePlayerStateSpec
|
||||
resetCreateGoalieStateSpec
|
||||
recordGoalAssistsSpec
|
||||
awardGoalSpec
|
||||
awardAssistSpec
|
||||
resetGoalDataSpec
|
||||
assignPMinsSpec
|
||||
backHomeSpec
|
||||
scrollUpSpec
|
||||
scrollDownSpec
|
||||
GoalieInput.spec
|
||||
NewGame.spec
|
||||
EditGoalie.spec
|
||||
|
||||
startNewSeasonSpec :: Spec
|
||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||
@@ -99,8 +90,8 @@ startNewGameSpec = describe "startNewGame" $ do
|
||||
resetYtdSpec :: Spec
|
||||
resetYtdSpec = describe "resetYtd" $
|
||||
it "should reset the year-to-date stats for all players" $ do
|
||||
ps <- replicateM 2 makePlayer
|
||||
gs <- replicateM 2 makeGoalie
|
||||
ps <- replicateM 2 TS.makePlayer
|
||||
gs <- replicateM 2 TS.makeGoalie
|
||||
let
|
||||
s = newProgState
|
||||
& database . dbPlayers .~ ps
|
||||
@@ -137,6 +128,41 @@ resetYtdSpec = describe "resetYtd" $
|
||||
lt ^. gsTies `shouldNotBe` 0) $
|
||||
s ^. database . dbGoalies
|
||||
|
||||
resetStandingsSpec :: Spec
|
||||
resetStandingsSpec = describe "resetStandings" $ do
|
||||
let
|
||||
home = GameStats
|
||||
{ _gmsWins = 1
|
||||
, _gmsLosses = 2
|
||||
, _gmsOvertime = 3
|
||||
, _gmsGoalsFor = 4
|
||||
, _gmsGoalsAgainst = 5
|
||||
}
|
||||
|
||||
away = GameStats
|
||||
{ _gmsWins = 6
|
||||
, _gmsLosses = 7
|
||||
, _gmsOvertime = 8
|
||||
, _gmsGoalsFor = 9
|
||||
, _gmsGoalsAgainst = 10
|
||||
}
|
||||
|
||||
db = newDatabase
|
||||
& dbHomeGameStats .~ home
|
||||
& dbAwayGameStats .~ away
|
||||
|
||||
ps = newProgState
|
||||
& database .~ db
|
||||
& resetStandings
|
||||
|
||||
context "home standings" $
|
||||
it "should be reset" $
|
||||
ps^.database.dbHomeGameStats `shouldBe` newGameStats
|
||||
|
||||
context "away standings" $
|
||||
it "should be reset" $
|
||||
ps^.database.dbAwayGameStats `shouldBe` newGameStats
|
||||
|
||||
addCharSpec :: Spec
|
||||
addCharSpec = describe "addChar" $
|
||||
it "should add the character to the input buffer" $ let
|
||||
@@ -160,202 +186,6 @@ removeCharSpec = describe "removeChar" $ do
|
||||
& removeChar
|
||||
in s ^. inputBuffer `shouldBe` "fo"
|
||||
|
||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||
|
||||
context "tie game" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should clear the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||
|
||||
it "should clear the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||
|
||||
it "should leave the overtimeFlag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
context "game won" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 2)
|
||||
. (awayScore ?~ 1)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||
|
||||
it "should set the overtimeCheck flag to False" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||
|
||||
context "game lost" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType ?~ HomeGame)
|
||||
. (homeScore ?~ 1)
|
||||
. (awayScore ?~ 2)
|
||||
& overtimeCheck
|
||||
|
||||
it "should not change the home score" $
|
||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||
|
||||
it "should not change the away score" $
|
||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||
|
||||
it "should leave the overtimeCheck flag blank" $
|
||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||
|
||||
updateGameStatsSpec :: Spec
|
||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||
let
|
||||
|
||||
baseStats = newGameStats
|
||||
& gmsWins .~ 1
|
||||
& gmsLosses .~ 1
|
||||
& gmsOvertime .~ 1
|
||||
& gmsGoalsFor .~ 1
|
||||
& gmsGoalsAgainst .~ 1
|
||||
|
||||
s t h a o = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameType .~ t)
|
||||
. (homeScore .~ h)
|
||||
. (awayScore .~ a)
|
||||
. (overtimeFlag .~ o)
|
||||
& database
|
||||
%~ (dbHomeGameStats .~ baseStats)
|
||||
. (dbAwayGameStats .~ baseStats)
|
||||
|
||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
||||
& dbHomeGameStats
|
||||
%~ (gmsWins .~ hw)
|
||||
. (gmsLosses .~ hl)
|
||||
. (gmsOvertime .~ ho)
|
||||
. (gmsGoalsFor .~ hf)
|
||||
. (gmsGoalsAgainst .~ ha)
|
||||
& dbAwayGameStats
|
||||
%~ (gmsWins .~ aw)
|
||||
. (gmsLosses .~ al)
|
||||
. (gmsOvertime .~ ao)
|
||||
. (gmsGoalsFor .~ af)
|
||||
. (gmsGoalsAgainst .~ aa)
|
||||
|
||||
context "home win" $
|
||||
it "should record a home win" $ let
|
||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
||||
|
||||
context "home loss" $
|
||||
it "should record a home loss" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
||||
|
||||
context "home overtime loss" $
|
||||
it "should record a home overtime" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
||||
|
||||
context "away win" $
|
||||
it "should record an away win" $ let
|
||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
||||
|
||||
context "away loss" $
|
||||
it "should record an away loss" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
||||
|
||||
context "away overtime loss" $
|
||||
it "should record an away overtime" $ let
|
||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
||||
|
||||
context "missing game type" $
|
||||
it "should not change anything" $ let
|
||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing home score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing away score" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
context "missing overtime flag" $
|
||||
it "should not change anything" $ let
|
||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||
db' = updateGameStats s' ^. database
|
||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||
|
||||
validateGameDateSpec :: Spec
|
||||
validateGameDateSpec = describe "validateGameDate" $ do
|
||||
|
||||
context "valid date" $
|
||||
it "should leave the date unchanged" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 6)
|
||||
. (gameDay ?~ 25)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
||||
|
||||
context "invalid date" $
|
||||
it "should clear the date" $ do
|
||||
let
|
||||
s = newProgState
|
||||
& progMode.gameStateL
|
||||
%~ (gameYear ?~ 2019)
|
||||
. (gameMonth ?~ 2)
|
||||
. (gameDay ?~ 30)
|
||||
& validateGameDate
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
context "missing day" $
|
||||
it "should not change anything" $ do
|
||||
let
|
||||
|
||||
gs = newGameState
|
||||
& gameYear ?~ 2019
|
||||
& gameMonth ?~ 6
|
||||
|
||||
s = newProgState
|
||||
& progMode.gameStateL .~ gs
|
||||
& validateGameDate
|
||||
|
||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||
|
||||
createPlayerSpec :: Spec
|
||||
createPlayerSpec = describe "createPlayer" $
|
||||
it "should change the mode appropriately" $ let
|
||||
@@ -374,6 +204,12 @@ editPlayerSpec = describe "editPlayer" $
|
||||
s = editPlayer newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||
|
||||
editGoalieSpec :: Spec
|
||||
editGoalieSpec = describe "editGoalie" $
|
||||
it "should change the mode appropriately" $ let
|
||||
s = editGoalie newProgState
|
||||
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||
|
||||
addPlayerSpec :: Spec
|
||||
addPlayerSpec = describe "addPlayer" $ do
|
||||
let
|
||||
@@ -440,281 +276,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
||||
newProgState & progMode.createGoalieStateL .~ cgs
|
||||
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||
|
||||
recordGoalAssistsSpec :: Spec
|
||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||
let
|
||||
joe = newPlayer 1 "Joe" "centre"
|
||||
bob = newPlayer 2 "Bob" "defense"
|
||||
steve = newPlayer 3 "Steve" "forward"
|
||||
dave = newPlayer 4 "Dave" "somewhere"
|
||||
frank = newPlayer 5 "Frank" "elsewhere"
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
||||
& progMode.gameStateL
|
||||
%~ (goalBy ?~ 0)
|
||||
. (assistsBy .~ [1, 2])
|
||||
. (confirmGoalDataFlag .~ True)
|
||||
& recordGoalAssists
|
||||
|
||||
mapM_
|
||||
(\(name, n, goals, assists) -> context name $ do
|
||||
let
|
||||
player = (ps^.database.dbPlayers) !! n
|
||||
stats = M.findWithDefault newPlayerStats n $
|
||||
ps^.progMode.gameStateL.gamePlayerStats
|
||||
|
||||
it ("should set the year-to-date goals to " ++ show goals) $
|
||||
player^.pYtd.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the lifetime goals to " ++ show goals) $
|
||||
player^.pLifetime.psGoals `shouldBe` goals
|
||||
|
||||
it ("should set the game goals to " ++ show goals) $
|
||||
stats^.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the year-to-date assists to " ++ show assists) $
|
||||
player^.pYtd.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the lifetime assists to " ++ show assists) $
|
||||
player^.pLifetime.psAssists `shouldBe` assists
|
||||
|
||||
it ("should set the game assists to " ++ show assists) $
|
||||
stats^.psAssists `shouldBe` assists)
|
||||
|
||||
-- name, index, goals, assists
|
||||
[ ( "Joe", 0, 1, 0 )
|
||||
, ( "Bob", 1, 0, 1 )
|
||||
, ( "Steve", 2, 0, 1 )
|
||||
, ( "Dave", 3, 0, 0 )
|
||||
]
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assistsBy list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should increment the pointsAccounted counter" $
|
||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
||||
|
||||
it "should clear the confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
awardGoalSpec :: Spec
|
||||
awardGoalSpec = describe "awardGoal" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 2 "Joe" "centre"
|
||||
& pYtd.psGoals .~ 1
|
||||
& pLifetime.psGoals .~ 2
|
||||
bob
|
||||
= newPlayer 3 "Bob" "defense"
|
||||
& pYtd.psGoals .~ 3
|
||||
& pLifetime.psGoals .~ 4
|
||||
db
|
||||
= newDatabase
|
||||
& dbPlayers .~ [joe, bob]
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psGoals .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database .~ db
|
||||
|
||||
mapM_
|
||||
(\(pName, pid, ytd, lt, game) ->
|
||||
context pName $ do
|
||||
let
|
||||
ps' = awardGoal pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ pName ++ "'s year-to-date goals") $
|
||||
player^.pYtd.psGoals `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ pName ++ "'s lifetime goals") $
|
||||
player^.pLifetime.psGoals `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ pName ++ "'s game goals") $
|
||||
gStats^.psGoals `shouldBe` game)
|
||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardGoal 2 ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
context "negative index" $ let
|
||||
ps' = awardGoal (-1) ps
|
||||
in it "should not change the database" $
|
||||
ps'^.database `shouldBe` db
|
||||
|
||||
awardAssistSpec :: Spec
|
||||
awardAssistSpec = describe "awardAssist" $ do
|
||||
let
|
||||
joe
|
||||
= newPlayer 1 "Joe" "centre"
|
||||
& pYtd.psAssists .~ 1
|
||||
& pLifetime.psAssists .~ 2
|
||||
bob
|
||||
= newPlayer 2 "Bob" "defense"
|
||||
& pYtd.psAssists .~ 3
|
||||
& pLifetime.psAssists .~ 4
|
||||
joeStats
|
||||
= newPlayerStats
|
||||
& psAssists .~ 1
|
||||
ps
|
||||
= newProgState
|
||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||
& database.dbPlayers .~ [joe, bob]
|
||||
|
||||
mapM_
|
||||
(\(pName, pid, ytd, lt, game) ->
|
||||
context pName $ do
|
||||
let
|
||||
ps' = awardAssist pid ps
|
||||
player = (ps'^.database.dbPlayers) !! pid
|
||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||
|
||||
it ("should increment " ++ pName ++ "'s year-to-date assists") $
|
||||
player^.pYtd.psAssists `shouldBe` ytd
|
||||
|
||||
it ("should increment " ++ pName ++ "'s lifetime assists") $
|
||||
player^.pLifetime.psAssists `shouldBe` lt
|
||||
|
||||
it ("should increment " ++ pName ++ "'s game assists") $
|
||||
gStats^.psAssists `shouldBe` game)
|
||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
||||
[ ( "Joe", 0, 2, 3, 2 )
|
||||
, ( "Bob", 1, 4, 5, 1 )
|
||||
]
|
||||
|
||||
context "invalid index" $ let
|
||||
ps' = awardAssist (-1) ps
|
||||
in it "should not change anything" $
|
||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
||||
|
||||
resetGoalDataSpec :: Spec
|
||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
||||
players <- runIO $ replicateM 5 makePlayer
|
||||
let
|
||||
gs
|
||||
= newGameState
|
||||
& goalBy ?~ 1
|
||||
& assistsBy .~ [2, 3]
|
||||
& confirmGoalDataFlag .~ True
|
||||
ps
|
||||
= newProgState
|
||||
& database.dbPlayers .~ players
|
||||
& progMode.gameStateL .~ gs
|
||||
& resetGoalData
|
||||
|
||||
it "should clear the goalBy value" $
|
||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||
|
||||
it "should clear the assists by list" $
|
||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||
|
||||
it "should clear confirmGoalDataFlag" $
|
||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||
|
||||
assignPMinsSpec :: Spec
|
||||
assignPMinsSpec = describe "assignPMins" $ let
|
||||
|
||||
bob = newPlayer 2 "Bob" "centre"
|
||||
& pYtd.psPMin .~ 3
|
||||
& pLifetime.psPMin .~ 4
|
||||
|
||||
joe = newPlayer 3 "Joe" "defense"
|
||||
& pYtd.psPMin .~ 5
|
||||
& pLifetime.psPMin .~ 6
|
||||
|
||||
ps pid = newProgState
|
||||
& database.dbPlayers .~ [bob, joe]
|
||||
& progMode.gameStateL
|
||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||
. (gameSelectedPlayer .~ pid)
|
||||
|
||||
in mapM_
|
||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||
context ("selectedPlayer = " ++ show pid) $ do
|
||||
let ps' = assignPMins 2 $ ps pid
|
||||
|
||||
mapM_
|
||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||
let
|
||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||
|
||||
context "lifetime penalty minutes" $
|
||||
it ("should be " ++ show lt) $
|
||||
player^.pLifetime.psPMin `shouldBe` lt
|
||||
|
||||
context "year-to-date penalty minutes" $
|
||||
it ("should be " ++ show ytd) $
|
||||
player^.pYtd.psPMin `shouldBe` ytd
|
||||
|
||||
context "game penalty minutes" $
|
||||
it ("should be " ++ show game) $
|
||||
pStats^.psPMin `shouldBe` game)
|
||||
|
||||
-- name, index, lifetime, ytd, game
|
||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||
]
|
||||
|
||||
it "should set selectedPlayer to Nothing" $
|
||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
||||
|
||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||
]
|
||||
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeName
|
||||
<*> makePlayerStats
|
||||
<*> makePlayerStats
|
||||
|
||||
makeGoalie :: IO Goalie
|
||||
makeGoalie = Goalie
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeGoalieStats
|
||||
<*> makeGoalieStats
|
||||
|
||||
makePlayerStats :: IO PlayerStats
|
||||
makePlayerStats = PlayerStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeGoalieStats :: IO GoalieStats
|
||||
makeGoalieStats = GoalieStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
backHomeSpec :: Spec
|
||||
backHomeSpec = describe "backHome" $ do
|
||||
let
|
||||
@@ -755,6 +316,7 @@ scrollUpSpec = describe "scrollUp" $ do
|
||||
ps' = scrollUp ps
|
||||
in ps'^.scrollOffset `shouldBe` 0
|
||||
|
||||
scrollDownSpec :: Spec
|
||||
scrollDownSpec = describe "scrollDown" $
|
||||
it "should increase the scroll offset" $ let
|
||||
ps = newProgState & scrollOffset .~ 10
|
||||
|
||||
@@ -21,9 +21,11 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module FormatSpec (spec) where
|
||||
|
||||
import Data.Ratio ((%))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Format" $ do
|
||||
@@ -33,6 +35,12 @@ spec = describe "Mtlstats.Format" $ do
|
||||
centreSpec
|
||||
overlaySpec
|
||||
monthSpec
|
||||
labelTableSpec
|
||||
numTableSpec
|
||||
tableWithSpec
|
||||
complexTableSpec
|
||||
overlayLastSpec
|
||||
showFloatingSpec
|
||||
|
||||
padNumSpec :: Spec
|
||||
padNumSpec = describe "padNum" $ do
|
||||
@@ -111,3 +119,120 @@ monthSpec = describe "month" $ do
|
||||
context "invalid" $
|
||||
it "should return an empty string" $
|
||||
month 0 `shouldBe` ""
|
||||
|
||||
labelTableSpec :: Spec
|
||||
labelTableSpec = describe "labelTable" $
|
||||
it "should format the table" $ let
|
||||
input =
|
||||
[ ( "foo", "bar" )
|
||||
, ( "baz", "quux" )
|
||||
, ( "longer", "x" )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo: bar"
|
||||
, " baz: quux"
|
||||
, "longer: x"
|
||||
]
|
||||
|
||||
in labelTable input `shouldBe` expected
|
||||
|
||||
numTableSpec :: Spec
|
||||
numTableSpec = describe "numTable" $
|
||||
it "should format the table" $ let
|
||||
headers = ["foo", "bar", "baz"]
|
||||
|
||||
rows =
|
||||
[ ( "quux", [ 1, 2, 3 ] )
|
||||
, ( "xyzzy", [ 9, 99, 999 ] )
|
||||
]
|
||||
|
||||
expected =
|
||||
[ " foo bar baz"
|
||||
, " quux 1 2 3"
|
||||
, "xyzzy 9 99 999"
|
||||
]
|
||||
|
||||
in numTable headers rows `shouldBe` expected
|
||||
|
||||
tableWithSpec :: Spec
|
||||
tableWithSpec = describe "tableWith" $ let
|
||||
vals =
|
||||
[ [ "foo", "bar", "baz" ]
|
||||
, [ "quux", "xyzzy", "x" ]
|
||||
]
|
||||
|
||||
in mapM_
|
||||
(\(label, func, expected) -> context label $
|
||||
it "should format the table" $
|
||||
tableWith func vals `shouldBe` expected)
|
||||
[ ( "align left"
|
||||
, left
|
||||
, [ "foo bar baz"
|
||||
, "quux xyzzy x "
|
||||
]
|
||||
)
|
||||
, ( "align right"
|
||||
, right
|
||||
, [ " foo bar baz"
|
||||
, "quux xyzzy x"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
complexTableSpec :: Spec
|
||||
complexTableSpec = describe "complexTable" $ mapM_
|
||||
(\(label, pFuncs, cells, expected) -> context label $
|
||||
it "should format correctly" $
|
||||
complexTable pFuncs cells `shouldBe` expected)
|
||||
[ ( "no fill"
|
||||
, [left, right]
|
||||
, [ [ CellText "foo", CellText "bar" ]
|
||||
, [ CellText "baaz", CellText "quux" ]
|
||||
]
|
||||
, [ "foo bar"
|
||||
, "baaz quux"
|
||||
]
|
||||
)
|
||||
, ( "with fill"
|
||||
, [left, left, left]
|
||||
, [ [ CellText "foo", CellText "bar", CellText "baz" ]
|
||||
, [ CellText "quux", CellFill '-', CellFill '@' ]
|
||||
]
|
||||
, [ "foo bar baz"
|
||||
, "quux ----@@@"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
overlayLastSpec :: Spec
|
||||
overlayLastSpec = describe "overlayLast" $ let
|
||||
text = "foo"
|
||||
|
||||
sample =
|
||||
[ "line 1"
|
||||
, "line 2"
|
||||
]
|
||||
|
||||
edited =
|
||||
[ "line 1"
|
||||
, "fooe 2"
|
||||
]
|
||||
|
||||
in mapM_
|
||||
(\(label, input, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
overlayLast text input `shouldBe` expected)
|
||||
|
||||
-- label, input, expected
|
||||
[ ( "empty list", [], [] )
|
||||
, ( "non-empty list", sample, edited )
|
||||
]
|
||||
|
||||
showFloatingSpec :: Spec
|
||||
showFloatingSpec = describe "showFloating" $ let
|
||||
input = 3 % 2 :: Rational
|
||||
expected = "1.50"
|
||||
|
||||
in it ("should be " ++ expected) $
|
||||
showFloating input `shouldBe` expected
|
||||
|
||||
66
test/Helpers/GoalieSpec.hs
Normal file
66
test/Helpers/GoalieSpec.hs
Normal file
@@ -0,0 +1,66 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.GoalieSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~), (%~))
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Goalie"
|
||||
goalieDetailsSpec
|
||||
|
||||
goalieDetailsSpec :: Spec
|
||||
goalieDetailsSpec = describe "goalieDetails" $ let
|
||||
input = newGoalie 1 "Joe"
|
||||
& gYtd
|
||||
%~ ( gsGames .~ 2 )
|
||||
. ( gsMinsPlayed .~ 3 )
|
||||
. ( gsGoalsAllowed .~ 4 )
|
||||
. ( gsWins .~ 5 )
|
||||
. ( gsLosses .~ 6 )
|
||||
. ( gsTies .~ 7 )
|
||||
& gLifetime
|
||||
%~ ( gsGames .~ 8 )
|
||||
. ( gsMinsPlayed .~ 9 )
|
||||
. ( gsGoalsAllowed .~ 10 )
|
||||
. ( gsWins .~ 11 )
|
||||
. ( gsLosses .~ 12 )
|
||||
. ( gsTies .~ 13 )
|
||||
|
||||
expected = unlines
|
||||
[ "Number: 1"
|
||||
, " Name: Joe"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Games played 2 8"
|
||||
, " Mins played 3 9"
|
||||
, "Goals allowed 4 10"
|
||||
, " Wins 5 11"
|
||||
, " Losses 6 12"
|
||||
, " Ties 7 13"
|
||||
]
|
||||
|
||||
in it "should format the output correctly" $
|
||||
goalieDetails input `shouldBe` expected
|
||||
61
test/Helpers/PlayerSpec.hs
Normal file
61
test/Helpers/PlayerSpec.hs
Normal file
@@ -0,0 +1,61 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Helpers.PlayerSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (.~))
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Player"
|
||||
playerDetailsSpec
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
p = newPlayer 1 "Joe" "centre"
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe"
|
||||
, "Position: centre"
|
||||
, ""
|
||||
, " YTD Lifetime"
|
||||
, " Goals 2 5"
|
||||
, " Assists 3 6"
|
||||
, "Penalty mins 4 7"
|
||||
]
|
||||
|
||||
in playerDetails p `shouldBe` expected
|
||||
32
test/HelpersSpec.hs
Normal file
32
test/HelpersSpec.hs
Normal file
@@ -0,0 +1,32 @@
|
||||
{-
|
||||
|
||||
mtlstats
|
||||
Copyright (C) 2019 Rhéal Lamothe
|
||||
<rheal.lamothe@gmail.com>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module HelpersSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, describe)
|
||||
|
||||
import qualified Helpers.GoalieSpec as Goalie
|
||||
import qualified Helpers.PlayerSpec as Player
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Helper" $ do
|
||||
Player.spec
|
||||
Goalie.spec
|
||||
@@ -21,16 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module ReportSpec (spec) where
|
||||
|
||||
import Lens.Micro ((&), (?~), (%~))
|
||||
import Lens.Micro ((&), (?~))
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Report
|
||||
import Mtlstats.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Mtlstats.Report" $ do
|
||||
spec = describe "Mtlstats.Report"
|
||||
gameDateSpec
|
||||
playerNameColWidthSpec
|
||||
|
||||
gameDateSpec :: Spec
|
||||
gameDateSpec = describe "gameDate" $ do
|
||||
@@ -46,20 +45,3 @@ gameDateSpec = describe "gameDate" $ do
|
||||
context "invalid date" $
|
||||
it "should return an empty string" $
|
||||
gameDate newGameState `shouldBe` ""
|
||||
|
||||
playerNameColWidthSpec :: Spec
|
||||
playerNameColWidthSpec = describe "playerNameColWidth" $ do
|
||||
let
|
||||
short1 = newPlayer 1 "short" "foo"
|
||||
short2 = newPlayer 2 "shorty" "bar"
|
||||
long = newPlayer 3 "123456789012345" "baz"
|
||||
|
||||
mapM_
|
||||
(\(label, players, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerNameColWidth players `shouldBe` expected)
|
||||
-- label, players, expected
|
||||
[ ( "empty list", [], 10 )
|
||||
, ( "short names", [short1, short2], 10 )
|
||||
, ( "long name", [short1, long], 16 )
|
||||
]
|
||||
|
||||
@@ -24,6 +24,7 @@ import Test.Hspec (hspec)
|
||||
import qualified ActionsSpec as Actions
|
||||
import qualified FormatSpec as Format
|
||||
import qualified HandlersSpec as Handlers
|
||||
import qualified HelpersSpec as Helpers
|
||||
import qualified ReportSpec as Report
|
||||
import qualified TypesSpec as Types
|
||||
import qualified UtilSpec as Util
|
||||
@@ -31,6 +32,7 @@ import qualified UtilSpec as Util
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
Types.spec
|
||||
Helpers.spec
|
||||
Actions.spec
|
||||
Format.spec
|
||||
Handlers.spec
|
||||
|
||||
@@ -21,13 +21,22 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||
|
||||
module TypesSpec (Comparable (..), spec) where
|
||||
module TypesSpec
|
||||
( Comparable (..)
|
||||
, spec
|
||||
, makePlayer
|
||||
, makeGoalie
|
||||
, makePlayerStats
|
||||
, makeGoalieStats
|
||||
) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||
import Data.Aeson.Types (Value (Object))
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Ratio ((%))
|
||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||
import System.Random (randomRIO)
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Mtlstats.Config
|
||||
@@ -48,6 +57,7 @@ spec = describe "Mtlstats.Types" $ do
|
||||
createPlayerStateLSpec
|
||||
createGoalieStateLSpec
|
||||
editPlayerStateLSpec
|
||||
editGoalieStateLSpec
|
||||
teamScoreSpec
|
||||
otherScoreSpec
|
||||
homeTeamSpec
|
||||
@@ -63,13 +73,15 @@ spec = describe "Mtlstats.Types" $ do
|
||||
playerSearchExactSpec
|
||||
modifyPlayerSpec
|
||||
playerSummarySpec
|
||||
playerDetailsSpec
|
||||
playerIsActiveSpec
|
||||
psPointsSpec
|
||||
addPlayerStatsSpec
|
||||
goalieSearchSpec
|
||||
goalieSearchExactSpec
|
||||
goalieSummarySpec
|
||||
goalieIsActiveSpec
|
||||
addGoalieStatsSpec
|
||||
gsAverageSpec
|
||||
Menu.spec
|
||||
|
||||
playerSpec :: Spec
|
||||
@@ -161,6 +173,24 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
|
||||
eps2 = newEditPlayerState
|
||||
& epsSelectedPlayer ?~ 2
|
||||
|
||||
editGoalieStateLSpec :: Spec
|
||||
editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||
lensSpec editGoalieStateL
|
||||
-- getters
|
||||
[ ( "missing state", MainMenu, newEditGoalieState )
|
||||
, ( "with state", EditGoalie egs1, egs1 )
|
||||
]
|
||||
-- setters
|
||||
[ ( "set state", MainMenu, egs1 )
|
||||
, ( "change state", EditGoalie egs1, egs2 )
|
||||
, ( "clear state", EditGoalie egs1, newEditGoalieState )
|
||||
]
|
||||
where
|
||||
egs1 = newEditGoalieState
|
||||
& egsSelectedGoalie ?~ 1
|
||||
egs2 = newEditGoalieState
|
||||
& egsSelectedGoalie ?~ 2
|
||||
|
||||
teamScoreSpec :: Spec
|
||||
teamScoreSpec = describe "teamScore" $ do
|
||||
let
|
||||
@@ -284,18 +314,20 @@ goalieStats n = newGoalieStats
|
||||
& gsGames .~ n
|
||||
& gsMinsPlayed .~ n + 1
|
||||
& gsGoalsAllowed .~ n + 2
|
||||
& gsWins .~ n + 3
|
||||
& gsLosses .~ n + 4
|
||||
& gsTies .~ n + 5
|
||||
& gsShutouts .~ n + 3
|
||||
& gsWins .~ n + 4
|
||||
& gsLosses .~ n + 5
|
||||
& gsTies .~ n + 6
|
||||
|
||||
goalieStatsJSON :: Int -> Value
|
||||
goalieStatsJSON n = Object $ HM.fromList
|
||||
[ ( "games", toJSON n )
|
||||
, ( "mins_played", toJSON $ n + 1 )
|
||||
, ( "goals_allowed", toJSON $ n + 2 )
|
||||
, ( "wins", toJSON $ n + 3 )
|
||||
, ( "losses", toJSON $ n + 4 )
|
||||
, ( "ties", toJSON $ n + 5 )
|
||||
, ( "shutouts", toJSON $ n + 3 )
|
||||
, ( "wins", toJSON $ n + 4 )
|
||||
, ( "losses", toJSON $ n + 5 )
|
||||
, ( "ties", toJSON $ n + 6 )
|
||||
]
|
||||
|
||||
gameStats :: Int -> GameStats
|
||||
@@ -581,10 +613,10 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||
|
||||
modifyPlayerSpec :: Spec
|
||||
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
||||
(\(pName, j, b, s) -> let
|
||||
(\(name, j, b, s) -> let
|
||||
modifier = pLifetime.psGoals .~ 1
|
||||
players = modifyPlayer modifier pName [joe, bob, steve]
|
||||
in context ("modify " ++ pName) $ do
|
||||
players = modifyPlayer modifier name [joe, bob, steve]
|
||||
in context ("modify " ++ name) $ do
|
||||
|
||||
context "Joe's lifetime goals" $
|
||||
it ("should be " ++ show j) $
|
||||
@@ -609,54 +641,24 @@ playerSummarySpec = describe "playerSummary" $
|
||||
it "should be \"Joe (2) center\"" $
|
||||
playerSummary joe `shouldBe` "Joe (2) center"
|
||||
|
||||
playerDetailsSpec :: Spec
|
||||
playerDetailsSpec = describe "playerDetails" $
|
||||
it "should give a detailed description" $ let
|
||||
|
||||
player = newPlayer 1 "Joe" "centre"
|
||||
& pYtd .~ PlayerStats
|
||||
{ _psGoals = 2
|
||||
, _psAssists = 3
|
||||
, _psPMin = 4
|
||||
}
|
||||
& pLifetime .~ PlayerStats
|
||||
{ _psGoals = 5
|
||||
, _psAssists = 6
|
||||
, _psPMin = 7
|
||||
}
|
||||
|
||||
expected = unlines
|
||||
[ " Number: 1"
|
||||
, " Name: Joe"
|
||||
, " Position: centre"
|
||||
, " YTD goals: 2"
|
||||
, " YTD assists: 3"
|
||||
, " YTD penalty mins: 4"
|
||||
, " Lifetime goals: 5"
|
||||
, " Lifetime assists: 6"
|
||||
, "Lifetime penalty mins: 7"
|
||||
]
|
||||
|
||||
in playerDetails player `shouldBe` expected
|
||||
|
||||
playerIsActiveSpec :: Spec
|
||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||
let
|
||||
pState = newPlayerStats
|
||||
pStats = newPlayerStats
|
||||
& psGoals .~ 10
|
||||
& psAssists .~ 11
|
||||
& psPMin .~ 12
|
||||
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
|
||||
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
|
||||
|
||||
mapM_
|
||||
(\(label, player', expected) -> context label $
|
||||
(\(label, p', expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
playerIsActive player' `shouldBe` expected)
|
||||
playerIsActive p' `shouldBe` expected)
|
||||
-- label, player, expected
|
||||
[ ( "not active", player, False )
|
||||
, ( "has goal", player & pYtd.psGoals .~ 1, True )
|
||||
, ( "has assist", player & pYtd.psAssists .~ 1, True )
|
||||
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
|
||||
[ ( "not active", p, False )
|
||||
, ( "has goal", p & pYtd.psGoals .~ 1, True )
|
||||
, ( "has assist", p & pYtd.psAssists .~ 1, True )
|
||||
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
|
||||
]
|
||||
|
||||
psPointsSpec :: Spec
|
||||
@@ -755,6 +757,72 @@ goalieSummarySpec = describe "goalieSummary" $
|
||||
it "should provide a summary string" $
|
||||
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
|
||||
|
||||
goalieIsActiveSpec :: Spec
|
||||
goalieIsActiveSpec = describe "goalieIsActive" $ mapM_
|
||||
(\(label, input, expected) -> context label $
|
||||
it ("should be " ++ show expected) $
|
||||
goalieIsActive input `shouldBe` expected)
|
||||
|
||||
-- label, input, expected
|
||||
[ ( "inactive", inactive, False )
|
||||
, ( "active", active, True )
|
||||
]
|
||||
|
||||
where
|
||||
inactive = newGoalie 1 "Joe"
|
||||
& gLifetime.gsMinsPlayed .~ 1
|
||||
|
||||
active = inactive
|
||||
& gYtd.gsMinsPlayed .~ 1
|
||||
|
||||
addGoalieStatsSpec :: Spec
|
||||
addGoalieStatsSpec = describe "addGoalieStats" $ let
|
||||
g1 = GoalieStats
|
||||
{ _gsGames = 1
|
||||
, _gsMinsPlayed = 2
|
||||
, _gsGoalsAllowed = 3
|
||||
, _gsShutouts = 4
|
||||
, _gsWins = 5
|
||||
, _gsLosses = 6
|
||||
, _gsTies = 7
|
||||
}
|
||||
|
||||
g2 = GoalieStats
|
||||
{ _gsGames = 8
|
||||
, _gsMinsPlayed = 9
|
||||
, _gsGoalsAllowed = 10
|
||||
, _gsShutouts = 11
|
||||
, _gsWins = 12
|
||||
, _gsLosses = 13
|
||||
, _gsTies = 14
|
||||
}
|
||||
|
||||
expected = GoalieStats
|
||||
{ _gsGames = 9
|
||||
, _gsMinsPlayed = 11
|
||||
, _gsGoalsAllowed = 13
|
||||
, _gsShutouts = 15
|
||||
, _gsWins = 17
|
||||
, _gsLosses = 19
|
||||
, _gsTies = 21
|
||||
}
|
||||
|
||||
actual = g1 `addGoalieStats` g2
|
||||
|
||||
in it ("should be " ++ show expected) $
|
||||
actual `shouldBe` expected
|
||||
|
||||
gsAverageSpec :: Spec
|
||||
gsAverageSpec = describe "gsAverage" $ let
|
||||
gs = newGoalieStats
|
||||
& gsGames .~ 2
|
||||
& gsGoalsAllowed .~ 3
|
||||
|
||||
expected = 3 % 2
|
||||
|
||||
in it ("should be " ++ show expected) $
|
||||
gsAverage gs `shouldBe` expected
|
||||
|
||||
joe :: Player
|
||||
joe = newPlayer 2 "Joe" "center"
|
||||
|
||||
@@ -764,6 +832,47 @@ bob = newPlayer 3 "Bob" "defense"
|
||||
steve :: Player
|
||||
steve = newPlayer 5 "Steve" "forward"
|
||||
|
||||
-- | Creates a 'Player'
|
||||
makePlayer :: IO Player
|
||||
makePlayer = Player
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeName
|
||||
<*> makePlayerStats
|
||||
<*> makePlayerStats
|
||||
|
||||
-- | Creates a 'Goalie'
|
||||
makeGoalie :: IO Goalie
|
||||
makeGoalie = Goalie
|
||||
<$> makeNum
|
||||
<*> makeName
|
||||
<*> makeGoalieStats
|
||||
<*> makeGoalieStats
|
||||
|
||||
-- | Creates a 'PlayerStats' value
|
||||
makePlayerStats :: IO PlayerStats
|
||||
makePlayerStats = PlayerStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
-- | Creates a 'GoalieStats' value
|
||||
makeGoalieStats :: IO GoalieStats
|
||||
makeGoalieStats = GoalieStats
|
||||
<$> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
<*> makeNum
|
||||
|
||||
makeNum :: IO Int
|
||||
makeNum = randomRIO (1, 10)
|
||||
|
||||
makeName :: IO String
|
||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||
|
||||
instance Comparable GoalieStats where
|
||||
compareTest actual expected = mapM_
|
||||
(\(name, lens) -> describe name $
|
||||
@@ -809,6 +918,17 @@ instance Comparable EditPlayerState where
|
||||
it ("should be " ++ show (expected^.epsMode)) $
|
||||
actual^.epsMode `shouldBe` expected^.epsMode
|
||||
|
||||
instance Comparable EditGoalieState where
|
||||
compareTest actual expected = do
|
||||
|
||||
describe "egsSelectedGoalie" $
|
||||
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
|
||||
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
|
||||
|
||||
describe "egsMode" $
|
||||
it ("should be " ++ show (expected^.egsMode)) $
|
||||
actual^.egsMode `shouldBe` expected^.egsMode
|
||||
|
||||
instance Comparable CreateGoalieState where
|
||||
compareTest actual expected = do
|
||||
|
||||
|
||||
@@ -49,18 +49,19 @@ nthSpec = describe "nth" $ mapM_
|
||||
|
||||
modifyNthSpec :: Spec
|
||||
modifyNthSpec = describe "modifyNth" $ do
|
||||
let list = [1, 2, 3] :: [Int]
|
||||
|
||||
context "in bounds" $
|
||||
it "should modify the value" $
|
||||
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
|
||||
modifyNth 1 succ list `shouldBe` [1, 3, 3]
|
||||
|
||||
context "out of bounds" $
|
||||
it "should not modify the value" $
|
||||
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
modifyNth 3 succ list `shouldBe` [1, 2, 3]
|
||||
|
||||
context "negative index" $
|
||||
it "should not modify the value" $
|
||||
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
||||
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||
|
||||
updateMapSpec :: Spec
|
||||
updateMapSpec = describe "updateMap" $ do
|
||||
@@ -68,7 +69,7 @@ updateMapSpec = describe "updateMap" $ do
|
||||
input = M.fromList [(1, 2), (3, 5)]
|
||||
|
||||
context "key found" $ let
|
||||
expected = M.fromList [(1, 3), (3, 5)]
|
||||
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
|
||||
in it "should update the value" $
|
||||
updateMap 1 10 succ input `shouldBe` expected
|
||||
|
||||
@@ -79,7 +80,7 @@ updateMapSpec = describe "updateMap" $ do
|
||||
|
||||
sliceSpec :: Spec
|
||||
sliceSpec = describe "slice" $ do
|
||||
let list = [2, 4, 6, 8]
|
||||
let list = [2, 4, 6, 8] :: [Int]
|
||||
|
||||
context "sublist" $
|
||||
it "should return the sublist" $
|
||||
|
||||
Reference in New Issue
Block a user