Compare commits
77 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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,10 @@
|
|||||||
# Changelog for mtlstats
|
# Changelog for mtlstats
|
||||||
|
|
||||||
|
## 0.6.0
|
||||||
|
- Generate lifetime statistics report
|
||||||
|
- Implemented goalie editing
|
||||||
|
- Reset game standings on new season
|
||||||
|
|
||||||
## 0.5.0
|
## 0.5.0
|
||||||
|
|
||||||
- Fixed player creation bug
|
- Fixed player creation bug
|
||||||
|
|||||||
12
package.yaml
12
package.yaml
@@ -1,5 +1,5 @@
|
|||||||
name: mtlstats
|
name: mtlstats
|
||||||
version: 0.5.0
|
version: 0.6.0
|
||||||
github: "mtlstats/mtlstats"
|
github: "mtlstats/mtlstats"
|
||||||
license: GPL-3
|
license: GPL-3
|
||||||
author: "Jonathan Lamothe"
|
author: "Jonathan Lamothe"
|
||||||
@@ -11,13 +11,13 @@ extra-source-files:
|
|||||||
- ChangeLog.md
|
- ChangeLog.md
|
||||||
|
|
||||||
# Metadata used when publishing your package
|
# Metadata used when publishing your package
|
||||||
# synopsis: Short description of your package
|
synopsis: Hockey statistics tracker
|
||||||
# category: Web
|
category: Statistics
|
||||||
|
|
||||||
# To avoid duplicated efforts in documentation and dealing with the
|
# To avoid duplicated efforts in documentation and dealing with the
|
||||||
# complications of embedding Haddock markup inside cabal files, it is
|
# complications of embedding Haddock markup inside cabal files, it is
|
||||||
# common to point users to the README.md file.
|
# common to point users to the README.md file.
|
||||||
description: Please see the README on GitHub at <https://github.com/jlamothe/mtlstats#readme>
|
description: Please see the README on GitHub at <https://github.com/mtlstats/mtlstats#readme>
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
@@ -33,6 +33,10 @@ dependencies:
|
|||||||
- bytestring
|
- bytestring
|
||||||
- microlens
|
- microlens
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
- -Wall
|
||||||
|
- -Werror
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|
||||||
|
|||||||
@@ -24,37 +24,28 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Actions
|
module Mtlstats.Actions
|
||||||
( startNewSeason
|
( startNewSeason
|
||||||
, resetYtd
|
, resetYtd
|
||||||
|
, resetStandings
|
||||||
, startNewGame
|
, startNewGame
|
||||||
, addChar
|
, addChar
|
||||||
, removeChar
|
, removeChar
|
||||||
, overtimeCheck
|
|
||||||
, updateGameStats
|
|
||||||
, validateGameDate
|
|
||||||
, createPlayer
|
, createPlayer
|
||||||
, createGoalie
|
, createGoalie
|
||||||
, editPlayer
|
, editPlayer
|
||||||
|
, editGoalie
|
||||||
, addPlayer
|
, addPlayer
|
||||||
, addGoalie
|
, addGoalie
|
||||||
, resetCreatePlayerState
|
, resetCreatePlayerState
|
||||||
, resetCreateGoalieState
|
, resetCreateGoalieState
|
||||||
, recordGoalAssists
|
|
||||||
, awardGoal
|
|
||||||
, awardAssist
|
|
||||||
, resetGoalData
|
|
||||||
, assignPMins
|
|
||||||
, backHome
|
, backHome
|
||||||
, scrollUp
|
, scrollUp
|
||||||
, scrollDown
|
, scrollDown
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.Trans.State (modify)
|
||||||
import qualified Data.Map as M
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time.Calendar (fromGregorianValid)
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~))
|
|
||||||
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Starts a new season
|
-- | Starts a new season
|
||||||
startNewSeason :: ProgState -> ProgState
|
startNewSeason :: ProgState -> ProgState
|
||||||
@@ -66,6 +57,12 @@ resetYtd
|
|||||||
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
= (database . dbPlayers %~ map (pYtd .~ newPlayerStats))
|
||||||
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
. (database . dbGoalies %~ map (gYtd .~ newGoalieStats))
|
||||||
|
|
||||||
|
-- | Resets game standings
|
||||||
|
resetStandings :: ProgState -> ProgState
|
||||||
|
resetStandings = database
|
||||||
|
%~ ( dbHomeGameStats .~ newGameStats)
|
||||||
|
. ( dbAwayGameStats .~ newGameStats)
|
||||||
|
|
||||||
-- | Starts a new game
|
-- | Starts a new game
|
||||||
startNewGame :: ProgState -> ProgState
|
startNewGame :: ProgState -> ProgState
|
||||||
startNewGame
|
startNewGame
|
||||||
@@ -82,65 +79,6 @@ removeChar = inputBuffer %~ \case
|
|||||||
"" -> ""
|
"" -> ""
|
||||||
str -> init str
|
str -> init str
|
||||||
|
|
||||||
-- | Determines whether or not to perform a check for overtime
|
|
||||||
overtimeCheck :: ProgState -> ProgState
|
|
||||||
overtimeCheck s
|
|
||||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
|
||||||
s & progMode.gameStateL
|
|
||||||
%~ (homeScore .~ Nothing)
|
|
||||||
. (awayScore .~ Nothing)
|
|
||||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
|
||||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
|
||||||
| otherwise = s
|
|
||||||
|
|
||||||
-- | Adjusts the game stats based on the results of the current game
|
|
||||||
updateGameStats :: ProgState -> ProgState
|
|
||||||
updateGameStats s = fromMaybe s $ do
|
|
||||||
let gs = s^.progMode.gameStateL
|
|
||||||
gType <- gs^.gameType
|
|
||||||
won <- gameWon gs
|
|
||||||
lost <- gameLost gs
|
|
||||||
ot <- gs^.overtimeFlag
|
|
||||||
tScore <- teamScore gs
|
|
||||||
oScore <- otherScore gs
|
|
||||||
let
|
|
||||||
hw = if gType == HomeGame && won then 1 else 0
|
|
||||||
hl = if gType == HomeGame && lost then 1 else 0
|
|
||||||
hot = if gType == HomeGame && ot then 1 else 0
|
|
||||||
hgf = if gType == HomeGame then tScore else 0
|
|
||||||
hga = if gType == HomeGame then oScore else 0
|
|
||||||
aw = if gType == AwayGame && won then 1 else 0
|
|
||||||
al = if gType == AwayGame && lost then 1 else 0
|
|
||||||
aot = if gType == AwayGame && ot then 1 else 0
|
|
||||||
agf = if gType == AwayGame then tScore else 0
|
|
||||||
aga = if gType == AwayGame then oScore else 0
|
|
||||||
Just $ s
|
|
||||||
& database.dbHomeGameStats
|
|
||||||
%~ (gmsWins +~ hw)
|
|
||||||
. (gmsLosses +~ hl)
|
|
||||||
. (gmsOvertime +~ hot)
|
|
||||||
. (gmsGoalsFor +~ hgf)
|
|
||||||
. (gmsGoalsAgainst +~ hga)
|
|
||||||
& database.dbAwayGameStats
|
|
||||||
%~ (gmsWins +~ aw)
|
|
||||||
. (gmsLosses +~ al)
|
|
||||||
. (gmsOvertime +~ aot)
|
|
||||||
. (gmsGoalsFor +~ agf)
|
|
||||||
. (gmsGoalsAgainst +~ aga)
|
|
||||||
|
|
||||||
-- | Validates the game date
|
|
||||||
validateGameDate :: ProgState -> ProgState
|
|
||||||
validateGameDate s = fromMaybe s $ do
|
|
||||||
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
|
||||||
m <- s^.progMode.gameStateL.gameMonth
|
|
||||||
d <- s^.progMode.gameStateL.gameDay
|
|
||||||
Just $ if null $ fromGregorianValid y m d
|
|
||||||
then s & progMode.gameStateL
|
|
||||||
%~ (gameYear .~ Nothing)
|
|
||||||
. (gameMonth .~ Nothing)
|
|
||||||
. (gameDay .~ Nothing)
|
|
||||||
else s
|
|
||||||
|
|
||||||
-- | Starts player creation mode
|
-- | Starts player creation mode
|
||||||
createPlayer :: ProgState -> ProgState
|
createPlayer :: ProgState -> ProgState
|
||||||
createPlayer = let
|
createPlayer = let
|
||||||
@@ -163,6 +101,10 @@ createGoalie = let
|
|||||||
editPlayer :: ProgState -> ProgState
|
editPlayer :: ProgState -> ProgState
|
||||||
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
editPlayer = progMode .~ EditPlayer newEditPlayerState
|
||||||
|
|
||||||
|
-- | Starts the 'Goalie' editing process
|
||||||
|
editGoalie :: ProgState -> ProgState
|
||||||
|
editGoalie = progMode .~ EditGoalie newEditGoalieState
|
||||||
|
|
||||||
-- | Adds the entered player to the roster
|
-- | Adds the entered player to the roster
|
||||||
addPlayer :: ProgState -> ProgState
|
addPlayer :: ProgState -> ProgState
|
||||||
addPlayer s = fromMaybe s $ do
|
addPlayer s = fromMaybe s $ do
|
||||||
@@ -199,81 +141,6 @@ resetCreateGoalieState = progMode.createGoalieStateL
|
|||||||
%~ (cgsNumber .~ Nothing)
|
%~ (cgsNumber .~ Nothing)
|
||||||
. (cgsName .~ "")
|
. (cgsName .~ "")
|
||||||
|
|
||||||
-- | Awards the goal and assists to the players
|
|
||||||
recordGoalAssists :: ProgState -> ProgState
|
|
||||||
recordGoalAssists ps = fromMaybe ps $ do
|
|
||||||
let gs = ps^.progMode.gameStateL
|
|
||||||
goalId <- gs^.goalBy
|
|
||||||
let assistIds = gs^.assistsBy
|
|
||||||
Just $ ps
|
|
||||||
& awardGoal goalId
|
|
||||||
& (\s -> foldr awardAssist s assistIds)
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (goalBy .~ Nothing)
|
|
||||||
. (assistsBy .~ [])
|
|
||||||
. (pointsAccounted %~ succ)
|
|
||||||
. (confirmGoalDataFlag .~ False)
|
|
||||||
|
|
||||||
-- | Awards a goal to a player
|
|
||||||
awardGoal
|
|
||||||
:: Int
|
|
||||||
-- ^ The player's index number
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
awardGoal n ps = ps
|
|
||||||
& progMode.gameStateL.gamePlayerStats %~
|
|
||||||
(\m -> let
|
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
|
||||||
in M.insert n (stats & psGoals %~ succ) m)
|
|
||||||
& database.dbPlayers %~ map
|
|
||||||
(\(i, p) -> if i == n
|
|
||||||
then p
|
|
||||||
& pYtd.psGoals %~ succ
|
|
||||||
& pLifetime.psGoals %~ succ
|
|
||||||
else p) . zip [0..]
|
|
||||||
|
|
||||||
-- | Awards an assist to a player
|
|
||||||
awardAssist
|
|
||||||
:: Int
|
|
||||||
-- ^ The player's index number
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
awardAssist n ps = ps
|
|
||||||
& progMode.gameStateL.gamePlayerStats %~
|
|
||||||
(\m -> let
|
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
|
||||||
in M.insert n (stats & psAssists %~ succ) m)
|
|
||||||
& database.dbPlayers %~ map
|
|
||||||
(\(i, p) -> if i == n
|
|
||||||
then p
|
|
||||||
& pYtd.psAssists %~ succ
|
|
||||||
& pLifetime.psAssists %~ succ
|
|
||||||
else p) . zip [0..]
|
|
||||||
|
|
||||||
-- | Resets the entered data for the current goal
|
|
||||||
resetGoalData :: ProgState -> ProgState
|
|
||||||
resetGoalData ps = ps & progMode.gameStateL
|
|
||||||
%~ (goalBy .~ Nothing)
|
|
||||||
. (assistsBy .~ [])
|
|
||||||
. (confirmGoalDataFlag .~ False)
|
|
||||||
|
|
||||||
-- | Adds penalty minutes to a player
|
|
||||||
assignPMins
|
|
||||||
:: Int
|
|
||||||
-- ^ The number of minutes to add
|
|
||||||
-> ProgState
|
|
||||||
-> ProgState
|
|
||||||
assignPMins mins s = fromMaybe s $ do
|
|
||||||
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
|
||||||
Just $ s
|
|
||||||
& database.dbPlayers %~ modifyNth n
|
|
||||||
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
|
||||||
(psPMin +~ mins)
|
|
||||||
)
|
|
||||||
. (gameSelectedPlayer .~ Nothing)
|
|
||||||
|
|
||||||
-- | Resets the program state back to the main menu
|
-- | Resets the program state back to the main menu
|
||||||
backHome :: ProgState -> ProgState
|
backHome :: ProgState -> ProgState
|
||||||
backHome
|
backHome
|
||||||
|
|||||||
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
|
||||||
173
src/Mtlstats/Actions/NewGame.hs
Normal file
173
src/Mtlstats/Actions/NewGame.hs
Normal file
@@ -0,0 +1,173 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Actions.NewGame
|
||||||
|
( overtimeCheck
|
||||||
|
, updateGameStats
|
||||||
|
, validateGameDate
|
||||||
|
, recordGoalAssists
|
||||||
|
, awardGoal
|
||||||
|
, awardAssist
|
||||||
|
, resetGoalData
|
||||||
|
, assignPMins
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Time.Calendar (fromGregorianValid)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~), (+~))
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Determines whether or not to perform a check for overtime
|
||||||
|
overtimeCheck :: ProgState -> ProgState
|
||||||
|
overtimeCheck s
|
||||||
|
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||||
|
s & progMode.gameStateL
|
||||||
|
%~ (homeScore .~ Nothing)
|
||||||
|
. (awayScore .~ Nothing)
|
||||||
|
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||||
|
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||||
|
| otherwise = s
|
||||||
|
|
||||||
|
-- | Adjusts the game stats based on the results of the current game
|
||||||
|
updateGameStats :: ProgState -> ProgState
|
||||||
|
updateGameStats s = fromMaybe s $ do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
gType <- gs^.gameType
|
||||||
|
won <- gameWon gs
|
||||||
|
lost <- gameLost gs
|
||||||
|
ot <- gs^.overtimeFlag
|
||||||
|
tScore <- teamScore gs
|
||||||
|
oScore <- otherScore gs
|
||||||
|
let
|
||||||
|
hw = if gType == HomeGame && won then 1 else 0
|
||||||
|
hl = if gType == HomeGame && lost then 1 else 0
|
||||||
|
hot = if gType == HomeGame && ot then 1 else 0
|
||||||
|
hgf = if gType == HomeGame then tScore else 0
|
||||||
|
hga = if gType == HomeGame then oScore else 0
|
||||||
|
aw = if gType == AwayGame && won then 1 else 0
|
||||||
|
al = if gType == AwayGame && lost then 1 else 0
|
||||||
|
aot = if gType == AwayGame && ot then 1 else 0
|
||||||
|
agf = if gType == AwayGame then tScore else 0
|
||||||
|
aga = if gType == AwayGame then oScore else 0
|
||||||
|
Just $ s
|
||||||
|
& database.dbHomeGameStats
|
||||||
|
%~ (gmsWins +~ hw)
|
||||||
|
. (gmsLosses +~ hl)
|
||||||
|
. (gmsOvertime +~ hot)
|
||||||
|
. (gmsGoalsFor +~ hgf)
|
||||||
|
. (gmsGoalsAgainst +~ hga)
|
||||||
|
& database.dbAwayGameStats
|
||||||
|
%~ (gmsWins +~ aw)
|
||||||
|
. (gmsLosses +~ al)
|
||||||
|
. (gmsOvertime +~ aot)
|
||||||
|
. (gmsGoalsFor +~ agf)
|
||||||
|
. (gmsGoalsAgainst +~ aga)
|
||||||
|
|
||||||
|
-- | Validates the game date
|
||||||
|
validateGameDate :: ProgState -> ProgState
|
||||||
|
validateGameDate s = fromMaybe s $ do
|
||||||
|
y <- toInteger <$> s^.progMode.gameStateL.gameYear
|
||||||
|
m <- s^.progMode.gameStateL.gameMonth
|
||||||
|
d <- s^.progMode.gameStateL.gameDay
|
||||||
|
Just $ if null $ fromGregorianValid y m d
|
||||||
|
then s & progMode.gameStateL
|
||||||
|
%~ (gameYear .~ Nothing)
|
||||||
|
. (gameMonth .~ Nothing)
|
||||||
|
. (gameDay .~ Nothing)
|
||||||
|
else s
|
||||||
|
|
||||||
|
-- | Awards the goal and assists to the players
|
||||||
|
recordGoalAssists :: ProgState -> ProgState
|
||||||
|
recordGoalAssists ps = fromMaybe ps $ do
|
||||||
|
let gs = ps^.progMode.gameStateL
|
||||||
|
goalId <- gs^.goalBy
|
||||||
|
let assistIds = gs^.assistsBy
|
||||||
|
Just $ ps
|
||||||
|
& awardGoal goalId
|
||||||
|
& (\s -> foldr awardAssist s assistIds)
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (goalBy .~ Nothing)
|
||||||
|
. (assistsBy .~ [])
|
||||||
|
. (pointsAccounted %~ succ)
|
||||||
|
. (confirmGoalDataFlag .~ False)
|
||||||
|
|
||||||
|
-- | Awards a goal to a player
|
||||||
|
awardGoal
|
||||||
|
:: Int
|
||||||
|
-- ^ The player's index number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
awardGoal n ps = ps
|
||||||
|
& progMode.gameStateL.gamePlayerStats %~
|
||||||
|
(\m -> let
|
||||||
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
|
in M.insert n (stats & psGoals %~ succ) m)
|
||||||
|
& database.dbPlayers %~ map
|
||||||
|
(\(i, p) -> if i == n
|
||||||
|
then p
|
||||||
|
& pYtd.psGoals %~ succ
|
||||||
|
& pLifetime.psGoals %~ succ
|
||||||
|
else p) . zip [0..]
|
||||||
|
|
||||||
|
-- | Awards an assist to a player
|
||||||
|
awardAssist
|
||||||
|
:: Int
|
||||||
|
-- ^ The player's index number
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
awardAssist n ps = ps
|
||||||
|
& progMode.gameStateL.gamePlayerStats %~
|
||||||
|
(\m -> let
|
||||||
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
|
in M.insert n (stats & psAssists %~ succ) m)
|
||||||
|
& database.dbPlayers %~ map
|
||||||
|
(\(i, p) -> if i == n
|
||||||
|
then p
|
||||||
|
& pYtd.psAssists %~ succ
|
||||||
|
& pLifetime.psAssists %~ succ
|
||||||
|
else p) . zip [0..]
|
||||||
|
|
||||||
|
-- | Resets the entered data for the current goal
|
||||||
|
resetGoalData :: ProgState -> ProgState
|
||||||
|
resetGoalData ps = ps & progMode.gameStateL
|
||||||
|
%~ (goalBy .~ Nothing)
|
||||||
|
. (assistsBy .~ [])
|
||||||
|
. (confirmGoalDataFlag .~ False)
|
||||||
|
|
||||||
|
-- | Adds penalty minutes to a player
|
||||||
|
assignPMins
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of minutes to add
|
||||||
|
-> ProgState
|
||||||
|
-> ProgState
|
||||||
|
assignPMins mins s = fromMaybe s $ do
|
||||||
|
n <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||||
|
Just $ s
|
||||||
|
& database.dbPlayers %~ modifyNth n
|
||||||
|
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
|
||||||
|
(psPMin +~ mins)
|
||||||
|
)
|
||||||
|
. (gameSelectedPlayer .~ Nothing)
|
||||||
@@ -19,12 +19,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Actions.GoalieInput
|
module Mtlstats.Actions.NewGame.GoalieInput
|
||||||
( finishGoalieEntry
|
( finishGoalieEntry
|
||||||
, recordGoalieStats
|
, recordGoalieStats
|
||||||
, setGameGoalie
|
, setGameGoalie
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
|
||||||
@@ -43,9 +44,9 @@ recordGoalieStats :: ProgState -> ProgState
|
|||||||
recordGoalieStats s = fromMaybe s $ do
|
recordGoalieStats s = fromMaybe s $ do
|
||||||
let gs = s^.progMode.gameStateL
|
let gs = s^.progMode.gameStateL
|
||||||
gid <- gs^.gameSelectedGoalie
|
gid <- gs^.gameSelectedGoalie
|
||||||
goalie <- nth gid $ s^.database.dbGoalies
|
|
||||||
mins <- gs^.gameGoalieMinsPlayed
|
mins <- gs^.gameGoalieMinsPlayed
|
||||||
goals <- gs^.gameGoalsAllowed
|
goals <- gs^.gameGoalsAllowed
|
||||||
|
void $ nth gid $ s^.database.dbGoalies
|
||||||
|
|
||||||
let
|
let
|
||||||
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
|
||||||
@@ -53,10 +54,10 @@ recordGoalieStats s = fromMaybe s $ do
|
|||||||
then 1
|
then 1
|
||||||
else 0
|
else 0
|
||||||
|
|
||||||
bumpStats gs = gs
|
bumpStats
|
||||||
& gsGames +~ bumpVal
|
= (gsGames +~ bumpVal)
|
||||||
& gsMinsPlayed +~ mins
|
. (gsMinsPlayed +~ mins)
|
||||||
& gsGoalsAllowed +~ goals
|
. (gsGoalsAllowed +~ goals)
|
||||||
|
|
||||||
tryFinish = if mins >= gameLength
|
tryFinish = if mins >= gameLength
|
||||||
then finishGoalieEntry
|
then finishGoalieEntry
|
||||||
@@ -90,18 +91,18 @@ setGameGoalie gid s = fromMaybe s $ do
|
|||||||
l = if lost then 1 else 0
|
l = if lost then 1 else 0
|
||||||
t = if tied then 1 else 0
|
t = if tied then 1 else 0
|
||||||
|
|
||||||
updateStats gs = gs
|
updateStats
|
||||||
& gsWins +~ w
|
= (gsWins +~ w)
|
||||||
& gsLosses +~ l
|
. (gsLosses +~ l)
|
||||||
& gsTies +~ t
|
. (gsTies +~ t)
|
||||||
|
|
||||||
updateGoalie g = g
|
updateGoalie
|
||||||
& gYtd %~ updateStats
|
= (gYtd %~ updateStats)
|
||||||
& gLifetime %~ updateStats
|
. (gLifetime %~ updateStats)
|
||||||
|
|
||||||
updateGameState gs = gs
|
updateGameState
|
||||||
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
|
= (gameGoalieStats %~ updateMap gid newGoalieStats updateStats)
|
||||||
& gameGoalieAssigned .~ True
|
. (gameGoalieAssigned .~ True)
|
||||||
|
|
||||||
Just $ s
|
Just $ s
|
||||||
& database.dbGoalies %~ modifyNth gid updateGoalie
|
& database.dbGoalies %~ modifyNth gid updateGoalie
|
||||||
@@ -21,25 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control (dispatch) where
|
module Mtlstats.Control (dispatch) where
|
||||||
|
|
||||||
import Control.Monad (join, when)
|
import Control.Monad (join)
|
||||||
import Control.Monad.Extra (ifM)
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (toUpper)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro ((^.), (.~), (%~))
|
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Control.EditGoalie
|
||||||
import Mtlstats.Control.EditPlayer
|
import Mtlstats.Control.EditPlayer
|
||||||
import Mtlstats.Control.GoalieInput
|
import Mtlstats.Control.NewGame
|
||||||
import Mtlstats.Format
|
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Report
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
-- | Reads the program state and returs the apropriate controller to
|
-- | Reads the program state and returs the apropriate controller to
|
||||||
-- run
|
-- run
|
||||||
@@ -47,21 +43,7 @@ dispatch :: ProgState -> Controller
|
|||||||
dispatch s = case s^.progMode of
|
dispatch s = case s^.progMode of
|
||||||
MainMenu -> mainMenuC
|
MainMenu -> mainMenuC
|
||||||
NewSeason -> newSeasonC
|
NewSeason -> newSeasonC
|
||||||
NewGame gs
|
NewGame _ -> newGameC s
|
||||||
| null $ gs^.gameYear -> gameYearC
|
|
||||||
| null $ gs^.gameMonth -> gameMonthC
|
|
||||||
| null $ gs^.gameDay -> gameDayC
|
|
||||||
| null $ gs^.gameType -> gameTypeC
|
|
||||||
| null $ gs^.otherTeam -> otherTeamC
|
|
||||||
| null $ gs^.homeScore -> homeScoreC
|
|
||||||
| null $ gs^.awayScore -> awayScoreC
|
|
||||||
| null $ gs^.overtimeFlag -> overtimeFlagC
|
|
||||||
| not $ gs^.dataVerified -> verifyDataC
|
|
||||||
| fromJust (unaccountedPoints gs) -> goalInput gs
|
|
||||||
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
|
|
||||||
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
|
|
||||||
| not $ gs^.gameGoalieAssigned -> goalieInput s
|
|
||||||
| otherwise -> reportC
|
|
||||||
CreatePlayer cps
|
CreatePlayer cps
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
| null $ cps^.cpsNumber -> getPlayerNumC
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
| null $ cps^.cpsName -> getPlayerNameC
|
||||||
@@ -72,6 +54,7 @@ dispatch s = case s^.progMode of
|
|||||||
| null $ cgs^.cgsName -> getGoalieNameC
|
| null $ cgs^.cgsName -> getGoalieNameC
|
||||||
| otherwise -> confirmCreateGoalieC
|
| otherwise -> confirmCreateGoalieC
|
||||||
EditPlayer eps -> editPlayerC eps
|
EditPlayer eps -> editPlayerC eps
|
||||||
|
EditGoalie egs -> editGoalieC egs
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: Controller
|
||||||
mainMenuC = Controller
|
mainMenuC = Controller
|
||||||
@@ -87,219 +70,6 @@ newSeasonC = Controller
|
|||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
gameYearC :: Controller
|
|
||||||
gameYearC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameYearPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameYearPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameMonthC :: Controller
|
|
||||||
gameMonthC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameMonthMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameMonthMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameDayC :: Controller
|
|
||||||
gameDayC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt gameDayPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler gameDayPrompt e
|
|
||||||
modify validateGameDate
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
gameTypeC :: Controller
|
|
||||||
gameTypeC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawMenu gameTypeMenu
|
|
||||||
, handleController = \e -> do
|
|
||||||
menuHandler gameTypeMenu e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
otherTeamC :: Controller
|
|
||||||
otherTeamC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt otherTeamPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler otherTeamPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
homeScoreC :: Controller
|
|
||||||
homeScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt homeScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler homeScorePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
awayScoreC :: Controller
|
|
||||||
awayScoreC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt awayScorePrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler awayScorePrompt e
|
|
||||||
modify overtimeCheck
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
overtimeFlagC :: Controller
|
|
||||||
overtimeFlagC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
C.drawString "Did the game go into overtime? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
verifyDataC :: Controller
|
|
||||||
verifyDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let gs = s^.progMode.gameStateL
|
|
||||||
header s
|
|
||||||
C.drawString "\n"
|
|
||||||
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
|
||||||
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
|
||||||
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
|
||||||
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
|
||||||
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
|
||||||
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
|
||||||
C.drawString "Is the above information correct? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify $ progMode.gameStateL.dataVerified .~ True
|
|
||||||
modify updateGameStats
|
|
||||||
Just False -> modify $ progMode.gameStateL .~ newGameState
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
goalInput :: GameState -> Controller
|
|
||||||
goalInput gs
|
|
||||||
| null (gs^.goalBy ) = recordGoalC
|
|
||||||
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
|
||||||
| otherwise = confirmGoalDataC
|
|
||||||
|
|
||||||
recordGoalC :: Controller
|
|
||||||
recordGoalC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
in drawPrompt (recordGoalPrompt game goal) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal) <- gets gameGoal
|
|
||||||
promptHandler (recordGoalPrompt game goal) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
recordAssistC :: Controller
|
|
||||||
recordAssistC = Controller
|
|
||||||
{ drawController = \s -> let
|
|
||||||
(game, goal, assist) = gameGoalAssist s
|
|
||||||
in drawPrompt (recordAssistPrompt game goal assist) s
|
|
||||||
, handleController = \e -> do
|
|
||||||
(game, goal, assist) <- gets gameGoalAssist
|
|
||||||
promptHandler (recordAssistPrompt game goal assist) e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmGoalDataC :: Controller
|
|
||||||
confirmGoalDataC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
gs = s^.progMode.gameStateL
|
|
||||||
players = s^.database.dbPlayers
|
|
||||||
msg = unlines $
|
|
||||||
[ " Game: " ++ padNum 2 game
|
|
||||||
, " Goal: " ++ show goal
|
|
||||||
, "Goal scored by: " ++
|
|
||||||
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
|
||||||
] ++
|
|
||||||
map
|
|
||||||
(\pid -> " Assisted by: " ++
|
|
||||||
playerSummary (fromJust $ nth pid players))
|
|
||||||
(gs^.assistsBy) ++
|
|
||||||
[ ""
|
|
||||||
, "Is the above information correct? (Y/N)"
|
|
||||||
]
|
|
||||||
C.drawString msg
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> modify recordGoalAssists
|
|
||||||
Just False -> modify resetGoalData
|
|
||||||
Nothing -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
pMinPlayerC :: Controller
|
|
||||||
pMinPlayerC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
drawPrompt pMinPlayerPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler pMinPlayerPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPMinsC :: Controller
|
|
||||||
getPMinsC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
header s
|
|
||||||
C.drawString $ fromMaybe "" $ do
|
|
||||||
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
|
||||||
player <- nth pid $ s^.database.dbPlayers
|
|
||||||
Just $ playerSummary player ++ "\n"
|
|
||||||
drawPrompt assignPMinsPrompt s
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler assignPMinsPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
reportC :: Controller
|
|
||||||
reportC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
(rows, cols) <- C.windowSize
|
|
||||||
C.drawString $ unlines $ slice
|
|
||||||
(s^.scrollOffset)
|
|
||||||
(fromInteger $ pred rows)
|
|
||||||
(report (fromInteger $ pred cols) s)
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case e of
|
|
||||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
|
||||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
|
||||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
|
||||||
C.EventSpecialKey _ -> modify backHome
|
|
||||||
C.EventCharacter _ -> modify backHome
|
|
||||||
_ -> return ()
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
|
||||||
header s = C.drawString $
|
|
||||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
|
||||||
|
|
||||||
getPlayerNumC :: Controller
|
getPlayerNumC :: Controller
|
||||||
getPlayerNumC = Controller
|
getPlayerNumC = Controller
|
||||||
{ drawController = drawPrompt playerNumPrompt
|
{ drawController = drawPrompt playerNumPrompt
|
||||||
@@ -381,15 +151,3 @@ confirmCreateGoalieC = Controller
|
|||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
gameGoal :: ProgState -> (Int, Int)
|
|
||||||
gameGoal s =
|
|
||||||
( s^.database.dbGames
|
|
||||||
, succ $ s^.progMode.gameStateL.pointsAccounted
|
|
||||||
)
|
|
||||||
|
|
||||||
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
|
||||||
gameGoalAssist s = let
|
|
||||||
(game, goal) = gameGoal s
|
|
||||||
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
|
||||||
in (game, goal, assist)
|
|
||||||
|
|||||||
137
src/Mtlstats/Control/EditGoalie.hs
Normal file
137
src/Mtlstats/Control/EditGoalie.hs
Normal file
@@ -0,0 +1,137 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Lens.Micro ((^.))
|
||||||
|
import UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Menu.EditGoalie
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.EditGoalie
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Controller/dispatcher for editing a 'Goalie'
|
||||||
|
editGoalieC :: EditGoalieState -> Controller
|
||||||
|
editGoalieC egs
|
||||||
|
| null $ egs^.egsSelectedGoalie = selectC
|
||||||
|
| otherwise = editC $ egs^.egsMode
|
||||||
|
|
||||||
|
selectC :: Controller
|
||||||
|
selectC = promptController goalieToEditPrompt
|
||||||
|
|
||||||
|
editC :: EditGoalieMode -> Controller
|
||||||
|
editC = \case
|
||||||
|
EGMenu -> menuC
|
||||||
|
EGNumber -> numberC
|
||||||
|
EGName -> nameC
|
||||||
|
EGYtd -> ytdMenuC
|
||||||
|
EGLifetime -> lifetimeMenuC
|
||||||
|
EGYtdGames -> ytdGamesC
|
||||||
|
EGYtdMins -> ytdMinsC
|
||||||
|
EGYtdGoals -> ytdGoalsC
|
||||||
|
EGYtdWins -> ytdWinsC
|
||||||
|
EGYtdLosses -> ytdLossesC
|
||||||
|
EGYtdTies -> ytdTiesC
|
||||||
|
EGLtGames -> ltGamesC
|
||||||
|
EGLtMins -> ltMinsC
|
||||||
|
EGLtGoals -> ltGoalsC
|
||||||
|
EGLtWins -> ltWinsC
|
||||||
|
EGLtLosses -> ltLossesC
|
||||||
|
EGLtTies -> ltTiesC
|
||||||
|
|
||||||
|
menuC :: Controller
|
||||||
|
menuC = menuControllerWith header editGoalieMenu
|
||||||
|
|
||||||
|
numberC :: Controller
|
||||||
|
numberC = promptController editGoalieNumberPrompt
|
||||||
|
|
||||||
|
nameC :: Controller
|
||||||
|
nameC = promptController editGoalieNamePrompt
|
||||||
|
|
||||||
|
ytdMenuC :: Controller
|
||||||
|
ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
||||||
|
|
||||||
|
lifetimeMenuC :: Controller
|
||||||
|
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
||||||
|
|
||||||
|
ytdGamesC :: Controller
|
||||||
|
ytdGamesC = promptController editGoalieYtdGamesPrompt
|
||||||
|
|
||||||
|
ytdMinsC :: Controller
|
||||||
|
ytdMinsC = promptController editGoalieYtdMinsPrompt
|
||||||
|
|
||||||
|
ytdGoalsC :: Controller
|
||||||
|
ytdGoalsC = promptController editGoalieYtdGoalsPrompt
|
||||||
|
|
||||||
|
ytdWinsC :: Controller
|
||||||
|
ytdWinsC = promptController editGoalieYtdWinsPrompt
|
||||||
|
|
||||||
|
ytdLossesC :: Controller
|
||||||
|
ytdLossesC = promptController editGoalieYtdLossesPrompt
|
||||||
|
|
||||||
|
ytdTiesC :: Controller
|
||||||
|
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
||||||
|
|
||||||
|
ltGamesC :: Controller
|
||||||
|
ltGamesC = promptController editGoalieLtGamesPrompt
|
||||||
|
|
||||||
|
ltMinsC :: Controller
|
||||||
|
ltMinsC = promptController editGoalieLtMinsPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Controller
|
||||||
|
ltGoalsC = promptController editGoalieLtGoalsPrompt
|
||||||
|
|
||||||
|
ltWinsC :: Controller
|
||||||
|
ltWinsC = promptController editGoalieLtWinsPrompt
|
||||||
|
|
||||||
|
ltLossesC :: Controller
|
||||||
|
ltLossesC = promptController editGoalieLtLossesPrompt
|
||||||
|
|
||||||
|
ltTiesC :: Controller
|
||||||
|
ltTiesC = promptController editGoalieLtTiesPrompt
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
g <- nth gid $ s^.database.dbGoalies
|
||||||
|
Just $ unlines
|
||||||
|
[ " Goalie number: " ++ show (g^.gNumber)
|
||||||
|
, " Goalie name: " ++ g^.gName
|
||||||
|
, " YTD games played: " ++ show (g^.gYtd.gsGames)
|
||||||
|
, " YTD mins played: " ++ show (g^.gYtd.gsMinsPlayed)
|
||||||
|
, " YTD goals allowed: " ++ show (g^.gYtd.gsGoalsAllowed)
|
||||||
|
, " YTD wins: " ++ show (g^.gYtd.gsWins)
|
||||||
|
, " YTD losses: " ++ show (g^.gYtd.gsLosses)
|
||||||
|
, " YTD ties: " ++ show (g^.gYtd.gsTies)
|
||||||
|
, " Lifetime games played: " ++ show (g^.gLifetime.gsGames)
|
||||||
|
, " Lifetime mins played: " ++ show (g^.gLifetime.gsMinsPlayed)
|
||||||
|
, "Lifetime goals allowed: " ++ show (g^.gLifetime.gsGoalsAllowed)
|
||||||
|
, " Lifetime wins: " ++ show (g^.gLifetime.gsWins)
|
||||||
|
, " Lifetime losses: " ++ show (g^.gLifetime.gsLosses)
|
||||||
|
, " Lifetime ties: " ++ show (g^.gLifetime.gsTies)
|
||||||
|
, ""
|
||||||
|
]
|
||||||
283
src/Mtlstats/Control/NewGame.hs
Normal file
283
src/Mtlstats/Control/NewGame.hs
Normal file
@@ -0,0 +1,283 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Mtlstats.Control.NewGame (newGameC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||||
|
import Lens.Micro ((^.), (.~))
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Control.NewGame.GoalieInput
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Handlers
|
||||||
|
import Mtlstats.Menu
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Prompt.NewGame
|
||||||
|
import Mtlstats.Report
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Dispatcher for a new game
|
||||||
|
newGameC :: ProgState -> Controller
|
||||||
|
newGameC s = let
|
||||||
|
gs = s^.progMode.gameStateL
|
||||||
|
in if null $ gs^.gameYear then gameYearC
|
||||||
|
else if null $ gs^.gameMonth then gameMonthC
|
||||||
|
else if null $ gs^.gameDay then gameDayC
|
||||||
|
else if null $ gs^.gameType then gameTypeC
|
||||||
|
else if null $ gs^.otherTeam then otherTeamC
|
||||||
|
else if null $ gs^.homeScore then homeScoreC
|
||||||
|
else if null $ gs^.awayScore then awayScoreC
|
||||||
|
else if null $ gs^.overtimeFlag then overtimeFlagC
|
||||||
|
else if not $ gs^.dataVerified then verifyDataC
|
||||||
|
else if fromJust (unaccountedPoints gs) then goalInput gs
|
||||||
|
else if isJust $ gs^.gameSelectedPlayer then getPMinsC
|
||||||
|
else if not $ gs^.gamePMinsRecorded then pMinPlayerC
|
||||||
|
else if not $ gs^.gameGoalieAssigned then goalieInputC s
|
||||||
|
else reportC
|
||||||
|
|
||||||
|
gameYearC :: Controller
|
||||||
|
gameYearC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt gameYearPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler gameYearPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
gameMonthC :: Controller
|
||||||
|
gameMonthC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawMenu gameMonthMenu
|
||||||
|
, handleController = \e -> do
|
||||||
|
menuHandler gameMonthMenu e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
gameDayC :: Controller
|
||||||
|
gameDayC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt gameDayPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler gameDayPrompt e
|
||||||
|
modify validateGameDate
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
gameTypeC :: Controller
|
||||||
|
gameTypeC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawMenu gameTypeMenu
|
||||||
|
, handleController = \e -> do
|
||||||
|
menuHandler gameTypeMenu e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
otherTeamC :: Controller
|
||||||
|
otherTeamC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt otherTeamPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler otherTeamPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
homeScoreC :: Controller
|
||||||
|
homeScoreC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt homeScorePrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler homeScorePrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
awayScoreC :: Controller
|
||||||
|
awayScoreC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt awayScorePrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler awayScorePrompt e
|
||||||
|
modify overtimeCheck
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
overtimeFlagC :: Controller
|
||||||
|
overtimeFlagC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
C.drawString "Did the game go into overtime? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ progMode.gameStateL.overtimeFlag .~ ynHandler e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
verifyDataC :: Controller
|
||||||
|
verifyDataC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let gs = s^.progMode.gameStateL
|
||||||
|
header s
|
||||||
|
C.drawString "\n"
|
||||||
|
C.drawString $ " Date: " ++ gameDate gs ++ "\n"
|
||||||
|
C.drawString $ " Game type: " ++ show (fromJust $ gs^.gameType) ++ "\n"
|
||||||
|
C.drawString $ "Other team: " ++ gs^.otherTeam ++ "\n"
|
||||||
|
C.drawString $ "Home score: " ++ show (fromJust $ gs^.homeScore) ++ "\n"
|
||||||
|
C.drawString $ "Away score: " ++ show (fromJust $ gs^.awayScore) ++ "\n"
|
||||||
|
C.drawString $ " Overtime: " ++ show (fromJust $ gs^.overtimeFlag) ++ "\n\n"
|
||||||
|
C.drawString "Is the above information correct? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
modify $ progMode.gameStateL.dataVerified .~ True
|
||||||
|
modify updateGameStats
|
||||||
|
Just False -> modify $ progMode.gameStateL .~ newGameState
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
goalInput :: GameState -> Controller
|
||||||
|
goalInput gs
|
||||||
|
| null (gs^.goalBy ) = recordGoalC
|
||||||
|
| not (gs^.confirmGoalDataFlag) = recordAssistC
|
||||||
|
| otherwise = confirmGoalDataC
|
||||||
|
|
||||||
|
recordGoalC :: Controller
|
||||||
|
recordGoalC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
in drawPrompt (recordGoalPrompt game goal) s
|
||||||
|
, handleController = \e -> do
|
||||||
|
(game, goal) <- gets gameGoal
|
||||||
|
promptHandler (recordGoalPrompt game goal) e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
recordAssistC :: Controller
|
||||||
|
recordAssistC = Controller
|
||||||
|
{ drawController = \s -> let
|
||||||
|
(game, goal, assist) = gameGoalAssist s
|
||||||
|
in drawPrompt (recordAssistPrompt game goal assist) s
|
||||||
|
, handleController = \e -> do
|
||||||
|
(game, goal, assist) <- gets gameGoalAssist
|
||||||
|
promptHandler (recordAssistPrompt game goal assist) e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmGoalDataC :: Controller
|
||||||
|
confirmGoalDataC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
gs = s^.progMode.gameStateL
|
||||||
|
players = s^.database.dbPlayers
|
||||||
|
msg = unlines $
|
||||||
|
[ " Game: " ++ padNum 2 game
|
||||||
|
, " Goal: " ++ show goal
|
||||||
|
, "Goal scored by: " ++
|
||||||
|
playerSummary (fromJust $ gs^.goalBy >>= flip nth players)
|
||||||
|
] ++
|
||||||
|
map
|
||||||
|
(\pid -> " Assisted by: " ++
|
||||||
|
playerSummary (fromJust $ nth pid players))
|
||||||
|
(gs^.assistsBy) ++
|
||||||
|
[ ""
|
||||||
|
, "Is the above information correct? (Y/N)"
|
||||||
|
]
|
||||||
|
C.drawString msg
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> modify recordGoalAssists
|
||||||
|
Just False -> modify resetGoalData
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
pMinPlayerC :: Controller
|
||||||
|
pMinPlayerC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawPrompt pMinPlayerPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler pMinPlayerPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
getPMinsC :: Controller
|
||||||
|
getPMinsC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
C.drawString $ fromMaybe "" $ do
|
||||||
|
pid <- s^.progMode.gameStateL.gameSelectedPlayer
|
||||||
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
|
Just $ playerSummary player ++ "\n"
|
||||||
|
drawPrompt assignPMinsPrompt s
|
||||||
|
, handleController = \e -> do
|
||||||
|
promptHandler assignPMinsPrompt e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
reportC :: Controller
|
||||||
|
reportC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
(rows, cols) <- C.windowSize
|
||||||
|
C.drawString $ unlines $ slice
|
||||||
|
(s^.scrollOffset)
|
||||||
|
(fromInteger $ pred rows)
|
||||||
|
(report (fromInteger $ pred cols) s)
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
case e of
|
||||||
|
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||||
|
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||||
|
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||||
|
C.EventSpecialKey _ -> modify backHome
|
||||||
|
C.EventCharacter _ -> modify backHome
|
||||||
|
_ -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
header :: ProgState -> C.Update ()
|
||||||
|
header s = C.drawString $
|
||||||
|
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||||
|
|
||||||
|
gameGoal :: ProgState -> (Int, Int)
|
||||||
|
gameGoal s =
|
||||||
|
( s^.database.dbGames
|
||||||
|
, succ $ s^.progMode.gameStateL.pointsAccounted
|
||||||
|
)
|
||||||
|
|
||||||
|
gameGoalAssist :: ProgState -> (Int, Int, Int)
|
||||||
|
gameGoalAssist s = let
|
||||||
|
(game, goal) = gameGoal s
|
||||||
|
assist = succ $ length $ s^.progMode.gameStateL.assistsBy
|
||||||
|
in (game, goal, assist)
|
||||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Control.GoalieInput (goalieInput) where
|
module Mtlstats.Control.NewGame.GoalieInput (goalieInputC) where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
@@ -28,13 +28,13 @@ import qualified UI.NCurses as C
|
|||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Prompt.GoalieInput
|
import Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | The dispatcher for handling goalie input
|
-- | The dispatcher for handling goalie input
|
||||||
goalieInput :: ProgState -> Controller
|
goalieInputC :: ProgState -> Controller
|
||||||
goalieInput s = let
|
goalieInputC s = let
|
||||||
gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
in if gs^.gameGoaliesRecorded
|
in if gs^.gameGoaliesRecorded
|
||||||
then selectGameGoalieC s
|
then selectGameGoalieC s
|
||||||
@@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Menu (
|
module Mtlstats.Menu (
|
||||||
-- * Menu Functions
|
-- * Menu Functions
|
||||||
menuController,
|
menuController,
|
||||||
|
menuControllerWith,
|
||||||
drawMenu,
|
drawMenu,
|
||||||
menuHandler,
|
menuHandler,
|
||||||
-- * Menus
|
-- * Menus
|
||||||
@@ -49,7 +50,7 @@ import System.EasyFile
|
|||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import qualified Mtlstats.Actions.GoalieInput as GI
|
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
@@ -57,8 +58,20 @@ import Mtlstats.Util
|
|||||||
|
|
||||||
-- | Generates a simple 'Controller' for a Menu
|
-- | Generates a simple 'Controller' for a Menu
|
||||||
menuController :: Menu () -> Controller
|
menuController :: Menu () -> Controller
|
||||||
menuController menu = Controller
|
menuController = menuControllerWith $ const $ return ()
|
||||||
{ drawController = const $ drawMenu menu
|
|
||||||
|
-- | Generate a simple 'Controller' for a 'Menu' with a header
|
||||||
|
menuControllerWith
|
||||||
|
:: (ProgState -> C.Update ())
|
||||||
|
-- ^ Generates the header
|
||||||
|
-> Menu ()
|
||||||
|
-- ^ The menu
|
||||||
|
-> Controller
|
||||||
|
-- ^ The resulting controller
|
||||||
|
menuControllerWith header menu = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
header s
|
||||||
|
drawMenu menu
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
menuHandler menu e
|
menuHandler menu e
|
||||||
return True
|
return True
|
||||||
@@ -91,7 +104,9 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
|||||||
modify createGoalie >> return True
|
modify createGoalie >> return True
|
||||||
, MenuItem '5' "Edit Player" $
|
, MenuItem '5' "Edit Player" $
|
||||||
modify editPlayer >> return True
|
modify editPlayer >> return True
|
||||||
, MenuItem '6' "Exit" $ do
|
, MenuItem '6' "Edit Goalie" $
|
||||||
|
modify editGoalie >> return True
|
||||||
|
, MenuItem 'X' "Exit" $ do
|
||||||
db <- gets $ view database
|
db <- gets $ view database
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
dir <- getAppUserDataDirectory appName
|
dir <- getAppUserDataDirectory appName
|
||||||
@@ -104,11 +119,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
|||||||
-- | The new season menu
|
-- | The new season menu
|
||||||
newSeasonMenu :: Menu ()
|
newSeasonMenu :: Menu ()
|
||||||
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
newSeasonMenu = Menu "*** SEASON TYPE ***" ()
|
||||||
[ MenuItem '1' "Regular Season" $ do
|
[ MenuItem 'R' "Regular Season" $ modify
|
||||||
modify resetYtd
|
$ resetYtd
|
||||||
modify startNewGame
|
. resetStandings
|
||||||
, MenuItem '2' "Playoffs" $
|
. startNewGame
|
||||||
modify startNewGame
|
, MenuItem 'P' "Playoffs" $ modify
|
||||||
|
$ resetStandings
|
||||||
|
. startNewGame
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Requests the month in which the game took place
|
-- | Requests the month in which the game took place
|
||||||
|
|||||||
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)
|
||||||
@@ -31,11 +31,6 @@ module Mtlstats.Prompt (
|
|||||||
numPrompt,
|
numPrompt,
|
||||||
selectPrompt,
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
gameYearPrompt,
|
|
||||||
gameDayPrompt,
|
|
||||||
otherTeamPrompt,
|
|
||||||
homeScorePrompt,
|
|
||||||
awayScorePrompt,
|
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
playerPosPrompt,
|
playerPosPrompt,
|
||||||
@@ -43,10 +38,6 @@ module Mtlstats.Prompt (
|
|||||||
goalieNamePrompt,
|
goalieNamePrompt,
|
||||||
selectPlayerPrompt,
|
selectPlayerPrompt,
|
||||||
selectGoaliePrompt,
|
selectGoaliePrompt,
|
||||||
recordGoalPrompt,
|
|
||||||
recordAssistPrompt,
|
|
||||||
pMinPlayerPrompt,
|
|
||||||
assignPMinsPrompt,
|
|
||||||
playerToEditPrompt
|
playerToEditPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -55,15 +46,13 @@ import Control.Monad.Extra (whenJust)
|
|||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Char (isDigit, toUpper)
|
import Data.Char (isDigit, toUpper)
|
||||||
import Data.Foldable (forM_)
|
import Data.Foldable (forM_)
|
||||||
import Data.Maybe (fromMaybe)
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
|
||||||
import Lens.Micro.Extras (view)
|
import Lens.Micro.Extras (view)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
import Mtlstats.Format
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -173,37 +162,12 @@ selectPrompt params = Prompt
|
|||||||
n = pred $ fromInteger rawK
|
n = pred $ fromInteger rawK
|
||||||
results = spSearch params sStr db
|
results = spSearch params sStr db
|
||||||
when (n < maxFunKeys) $
|
when (n < maxFunKeys) $
|
||||||
whenJust (nth n results) $ \(n, _) -> do
|
whenJust (nth n results) $ \(sel, _) -> do
|
||||||
modify $ inputBuffer .~ ""
|
modify $ inputBuffer .~ ""
|
||||||
spCallback params $ Just n
|
spCallback params $ Just sel
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the game year
|
|
||||||
gameYearPrompt :: Prompt
|
|
||||||
gameYearPrompt = numPrompt "Game year: " $
|
|
||||||
modify . (progMode.gameStateL.gameYear ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the day of the month the game took place
|
|
||||||
gameDayPrompt :: Prompt
|
|
||||||
gameDayPrompt = numPrompt "Day of month: " $
|
|
||||||
modify . (progMode.gameStateL.gameDay ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the other team name
|
|
||||||
otherTeamPrompt :: Prompt
|
|
||||||
otherTeamPrompt = strPrompt "Other team: " $
|
|
||||||
modify . (progMode.gameStateL.otherTeam .~)
|
|
||||||
|
|
||||||
-- | Prompts for the home score
|
|
||||||
homeScorePrompt :: Prompt
|
|
||||||
homeScorePrompt = numPrompt "Home score: " $
|
|
||||||
modify . (progMode.gameStateL.homeScore ?~)
|
|
||||||
|
|
||||||
-- | Prompts for the away score
|
|
||||||
awayScorePrompt :: Prompt
|
|
||||||
awayScorePrompt = numPrompt "Away score: " $
|
|
||||||
modify . (progMode.gameStateL.awayScore ?~)
|
|
||||||
|
|
||||||
-- | Prompts for a new player's number
|
-- | Prompts for a new player's number
|
||||||
playerNumPrompt :: Prompt
|
playerNumPrompt :: Prompt
|
||||||
playerNumPrompt = numPrompt "Player number: " $
|
playerNumPrompt = numPrompt "Player number: " $
|
||||||
@@ -285,52 +249,6 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreateGoalie cgs
|
modify $ progMode .~ CreateGoalie cgs
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Prompts for the player who scored the goal
|
|
||||||
recordGoalPrompt
|
|
||||||
:: Int
|
|
||||||
-- ^ The game number
|
|
||||||
-> Int
|
|
||||||
-- ^ The goal number
|
|
||||||
-> Prompt
|
|
||||||
recordGoalPrompt game goal = selectPlayerPrompt
|
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
|
||||||
++ "Who scored goal number " ++ show goal ++ "? "
|
|
||||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
|
||||||
|
|
||||||
-- | Prompts for a player who assisted the goal
|
|
||||||
recordAssistPrompt
|
|
||||||
:: Int
|
|
||||||
-- ^ The game number
|
|
||||||
-> Int
|
|
||||||
-- ^ The goal nuber
|
|
||||||
-> Int
|
|
||||||
-- ^ The assist number
|
|
||||||
-> Prompt
|
|
||||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
|
||||||
++ "Goal: " ++ show goal ++ "\n"
|
|
||||||
++ "Assist #" ++ show assist ++ ": "
|
|
||||||
) $ \case
|
|
||||||
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
|
||||||
Just n -> do
|
|
||||||
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
|
||||||
nAssists <- length <$> gets (view $ progMode.gameStateL.assistsBy)
|
|
||||||
when (nAssists >= maxAssists) $
|
|
||||||
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
|
||||||
|
|
||||||
-- | Prompts for the player to assign penalty minutes to
|
|
||||||
pMinPlayerPrompt :: Prompt
|
|
||||||
pMinPlayerPrompt = selectPlayerPrompt
|
|
||||||
"Assign penalty minutes to: " $
|
|
||||||
\case
|
|
||||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
|
||||||
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
|
||||||
|
|
||||||
-- | Prompts for the number of penalty mintues to assign to the player
|
|
||||||
assignPMinsPrompt :: Prompt
|
|
||||||
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
|
||||||
modify . assignPMins
|
|
||||||
|
|
||||||
playerToEditPrompt :: Prompt
|
playerToEditPrompt :: Prompt
|
||||||
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||||
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||||
|
|||||||
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
|
||||||
115
src/Mtlstats/Prompt/NewGame.hs
Normal file
115
src/Mtlstats/Prompt/NewGame.hs
Normal file
@@ -0,0 +1,115 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
module Mtlstats.Prompt.NewGame
|
||||||
|
( gameYearPrompt
|
||||||
|
, gameDayPrompt
|
||||||
|
, otherTeamPrompt
|
||||||
|
, homeScorePrompt
|
||||||
|
, awayScorePrompt
|
||||||
|
, recordGoalPrompt
|
||||||
|
, recordAssistPrompt
|
||||||
|
, pMinPlayerPrompt
|
||||||
|
, assignPMinsPrompt
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (?~), (%~))
|
||||||
|
|
||||||
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Prompts for the game year
|
||||||
|
gameYearPrompt :: Prompt
|
||||||
|
gameYearPrompt = numPrompt "Game year: " $
|
||||||
|
modify . (progMode.gameStateL.gameYear ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the day of the month the game took place
|
||||||
|
gameDayPrompt :: Prompt
|
||||||
|
gameDayPrompt = numPrompt "Day of month: " $
|
||||||
|
modify . (progMode.gameStateL.gameDay ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the other team name
|
||||||
|
otherTeamPrompt :: Prompt
|
||||||
|
otherTeamPrompt = strPrompt "Other team: " $
|
||||||
|
modify . (progMode.gameStateL.otherTeam .~)
|
||||||
|
|
||||||
|
-- | Prompts for the home score
|
||||||
|
homeScorePrompt :: Prompt
|
||||||
|
homeScorePrompt = numPrompt "Home score: " $
|
||||||
|
modify . (progMode.gameStateL.homeScore ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the away score
|
||||||
|
awayScorePrompt :: Prompt
|
||||||
|
awayScorePrompt = numPrompt "Away score: " $
|
||||||
|
modify . (progMode.gameStateL.awayScore ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the player who scored the goal
|
||||||
|
recordGoalPrompt
|
||||||
|
:: Int
|
||||||
|
-- ^ The game number
|
||||||
|
-> Int
|
||||||
|
-- ^ The goal number
|
||||||
|
-> Prompt
|
||||||
|
recordGoalPrompt game goal = selectPlayerPrompt
|
||||||
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
|
++ "Who scored goal number " ++ show goal ++ "? "
|
||||||
|
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||||
|
|
||||||
|
-- | Prompts for a player who assisted the goal
|
||||||
|
recordAssistPrompt
|
||||||
|
:: Int
|
||||||
|
-- ^ The game number
|
||||||
|
-> Int
|
||||||
|
-- ^ The goal nuber
|
||||||
|
-> Int
|
||||||
|
-- ^ The assist number
|
||||||
|
-> Prompt
|
||||||
|
recordAssistPrompt game goal assist = selectPlayerPrompt
|
||||||
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
|
++ "Goal: " ++ show goal ++ "\n"
|
||||||
|
++ "Assist #" ++ show assist ++ ": "
|
||||||
|
) $ \case
|
||||||
|
Nothing -> modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||||
|
Just n -> do
|
||||||
|
modify $ progMode.gameStateL.assistsBy %~ (++[n])
|
||||||
|
nAssists <- length <$> gets (^.progMode.gameStateL.assistsBy)
|
||||||
|
when (nAssists >= maxAssists) $
|
||||||
|
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
|
||||||
|
|
||||||
|
-- | Prompts for the player to assign penalty minutes to
|
||||||
|
pMinPlayerPrompt :: Prompt
|
||||||
|
pMinPlayerPrompt = selectPlayerPrompt
|
||||||
|
"Assign penalty minutes to: " $
|
||||||
|
\case
|
||||||
|
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||||
|
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
|
||||||
|
|
||||||
|
-- | Prompts for the number of penalty mintues to assign to the player
|
||||||
|
assignPMinsPrompt :: Prompt
|
||||||
|
assignPMinsPrompt = numPrompt "Penalty minutes: " $
|
||||||
|
modify . assignPMins
|
||||||
@@ -21,19 +21,16 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Mtlstats.Prompt.GoalieInput
|
module Mtlstats.Prompt.NewGame.GoalieInput
|
||||||
( selectGameGoaliePrompt
|
( selectGameGoaliePrompt
|
||||||
, goalieMinsPlayedPrompt
|
, goalieMinsPlayedPrompt
|
||||||
, goalsAllowedPrompt
|
, goalsAllowedPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad.Trans.State (modify)
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Lens.Micro ((?~))
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
|
||||||
|
|
||||||
import Mtlstats.Actions.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
import Mtlstats.Config
|
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
@@ -43,6 +43,8 @@ report width s
|
|||||||
++ gameStatsReport width s
|
++ gameStatsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ yearToDateStatsReport width s
|
++ yearToDateStatsReport width s
|
||||||
|
++ [""]
|
||||||
|
++ lifetimeStatsReport width s
|
||||||
|
|
||||||
standingsReport :: Int -> ProgState -> [String]
|
standingsReport :: Int -> ProgState -> [String]
|
||||||
standingsReport width s = fromMaybe [] $ do
|
standingsReport width s = fromMaybe [] $ do
|
||||||
@@ -103,12 +105,16 @@ yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
|
|||||||
map (\p -> (p, p^.pYtd)) $
|
map (\p -> (p, p^.pYtd)) $
|
||||||
filter playerIsActive $ s^.database.dbPlayers
|
filter playerIsActive $ s^.database.dbPlayers
|
||||||
|
|
||||||
|
lifetimeStatsReport :: Int -> ProgState -> [String]
|
||||||
|
lifetimeStatsReport width s = playerReport width "LIFETIME" $
|
||||||
|
map (\p -> (p, p^.pLifetime)) $ s^.database.dbPlayers
|
||||||
|
|
||||||
gameDate :: GameState -> String
|
gameDate :: GameState -> String
|
||||||
gameDate gs = fromMaybe "" $ do
|
gameDate gs = fromMaybe "" $ do
|
||||||
year <- show <$> gs^.gameYear
|
y <- show <$> gs^.gameYear
|
||||||
month <- month <$> gs^.gameMonth
|
m <- month <$> gs^.gameMonth
|
||||||
day <- padNum 2 <$> gs^.gameDay
|
d <- padNum 2 <$> gs^.gameDay
|
||||||
Just $ month ++ " " ++ day ++ " " ++ year
|
Just $ m ++ " " ++ d ++ " " ++ y
|
||||||
|
|
||||||
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
|
||||||
playerReport width label ps = let
|
playerReport width label ps = let
|
||||||
|
|||||||
@@ -33,6 +33,8 @@ module Mtlstats.Types (
|
|||||||
CreateGoalieState (..),
|
CreateGoalieState (..),
|
||||||
EditPlayerState (..),
|
EditPlayerState (..),
|
||||||
EditPlayerMode (..),
|
EditPlayerMode (..),
|
||||||
|
EditGoalieState (..),
|
||||||
|
EditGoalieMode (..),
|
||||||
Database (..),
|
Database (..),
|
||||||
Player (..),
|
Player (..),
|
||||||
PlayerStats (..),
|
PlayerStats (..),
|
||||||
@@ -52,6 +54,7 @@ module Mtlstats.Types (
|
|||||||
createPlayerStateL,
|
createPlayerStateL,
|
||||||
createGoalieStateL,
|
createGoalieStateL,
|
||||||
editPlayerStateL,
|
editPlayerStateL,
|
||||||
|
editGoalieStateL,
|
||||||
-- ** GameState Lenses
|
-- ** GameState Lenses
|
||||||
gameYear,
|
gameYear,
|
||||||
gameMonth,
|
gameMonth,
|
||||||
@@ -89,6 +92,9 @@ module Mtlstats.Types (
|
|||||||
-- ** EditPlayerState Lenses
|
-- ** EditPlayerState Lenses
|
||||||
epsSelectedPlayer,
|
epsSelectedPlayer,
|
||||||
epsMode,
|
epsMode,
|
||||||
|
-- ** EditGoalieState Lenses
|
||||||
|
egsSelectedGoalie,
|
||||||
|
egsMode,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
@@ -129,6 +135,7 @@ module Mtlstats.Types (
|
|||||||
newCreatePlayerState,
|
newCreatePlayerState,
|
||||||
newCreateGoalieState,
|
newCreateGoalieState,
|
||||||
newEditPlayerState,
|
newEditPlayerState,
|
||||||
|
newEditGoalieState,
|
||||||
newDatabase,
|
newDatabase,
|
||||||
newPlayer,
|
newPlayer,
|
||||||
newPlayerStats,
|
newPlayerStats,
|
||||||
@@ -218,6 +225,7 @@ data ProgMode
|
|||||||
| CreatePlayer CreatePlayerState
|
| CreatePlayer CreatePlayerState
|
||||||
| CreateGoalie CreateGoalieState
|
| CreateGoalie CreateGoalieState
|
||||||
| EditPlayer EditPlayerState
|
| EditPlayer EditPlayerState
|
||||||
|
| EditGoalie EditGoalieState
|
||||||
|
|
||||||
instance Show ProgMode where
|
instance Show ProgMode where
|
||||||
show MainMenu = "MainMenu"
|
show MainMenu = "MainMenu"
|
||||||
@@ -226,6 +234,7 @@ instance Show ProgMode where
|
|||||||
show (CreatePlayer _) = "CreatePlayer"
|
show (CreatePlayer _) = "CreatePlayer"
|
||||||
show (CreateGoalie _) = "CreateGoalie"
|
show (CreateGoalie _) = "CreateGoalie"
|
||||||
show (EditPlayer _) = "EditPlayer"
|
show (EditPlayer _) = "EditPlayer"
|
||||||
|
show (EditGoalie _) = "EditGoalie"
|
||||||
|
|
||||||
-- | The game state
|
-- | The game state
|
||||||
data GameState = GameState
|
data GameState = GameState
|
||||||
@@ -334,6 +343,34 @@ data EditPlayerMode
|
|||||||
| EPLtPMin
|
| EPLtPMin
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | 'Goalie' edit status
|
||||||
|
data EditGoalieState = EditGoalieState
|
||||||
|
{ _egsSelectedGoalie :: Maybe Int
|
||||||
|
-- ^ The index number of the 'Goalie' being edited
|
||||||
|
, _egsMode :: EditGoalieMode
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | 'Goalie' editing mode
|
||||||
|
data EditGoalieMode
|
||||||
|
= EGMenu
|
||||||
|
| EGNumber
|
||||||
|
| EGName
|
||||||
|
| EGYtd
|
||||||
|
| EGLifetime
|
||||||
|
| EGYtdGames
|
||||||
|
| EGYtdMins
|
||||||
|
| EGYtdGoals
|
||||||
|
| EGYtdWins
|
||||||
|
| EGYtdLosses
|
||||||
|
| EGYtdTies
|
||||||
|
| EGLtGames
|
||||||
|
| EGLtMins
|
||||||
|
| EGLtGoals
|
||||||
|
| EGLtWins
|
||||||
|
| EGLtLosses
|
||||||
|
| EGLtTies
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Represents the database
|
-- | Represents the database
|
||||||
data Database = Database
|
data Database = Database
|
||||||
{ _dbPlayers :: [Player]
|
{ _dbPlayers :: [Player]
|
||||||
@@ -581,6 +618,7 @@ makeLenses ''GameState
|
|||||||
makeLenses ''CreatePlayerState
|
makeLenses ''CreatePlayerState
|
||||||
makeLenses ''CreateGoalieState
|
makeLenses ''CreateGoalieState
|
||||||
makeLenses ''EditPlayerState
|
makeLenses ''EditPlayerState
|
||||||
|
makeLenses ''EditGoalieState
|
||||||
makeLenses ''Database
|
makeLenses ''Database
|
||||||
makeLenses ''Player
|
makeLenses ''Player
|
||||||
makeLenses ''PlayerStats
|
makeLenses ''PlayerStats
|
||||||
@@ -616,6 +654,13 @@ editPlayerStateL = lens
|
|||||||
_ -> newEditPlayerState)
|
_ -> newEditPlayerState)
|
||||||
(\_ eps -> EditPlayer eps)
|
(\_ eps -> EditPlayer eps)
|
||||||
|
|
||||||
|
editGoalieStateL :: Lens' ProgMode EditGoalieState
|
||||||
|
editGoalieStateL = lens
|
||||||
|
(\case
|
||||||
|
EditGoalie egs -> egs
|
||||||
|
_ -> newEditGoalieState)
|
||||||
|
(\_ egs -> EditGoalie egs)
|
||||||
|
|
||||||
-- | Constructor for a 'ProgState'
|
-- | Constructor for a 'ProgState'
|
||||||
newProgState :: ProgState
|
newProgState :: ProgState
|
||||||
newProgState = ProgState
|
newProgState = ProgState
|
||||||
@@ -678,6 +723,13 @@ newEditPlayerState = EditPlayerState
|
|||||||
, _epsMode = EPMenu
|
, _epsMode = EPMenu
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Constructor for an 'EditGoalieState' value
|
||||||
|
newEditGoalieState :: EditGoalieState
|
||||||
|
newEditGoalieState = EditGoalieState
|
||||||
|
{ _egsSelectedGoalie = Nothing
|
||||||
|
, _egsMode = EGMenu
|
||||||
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'Database'
|
-- | Constructor for a 'Database'
|
||||||
newDatabase :: Database
|
newDatabase :: Database
|
||||||
newDatabase = Database
|
newDatabase = Database
|
||||||
@@ -828,9 +880,8 @@ playerSearch
|
|||||||
-> [(Int, Player)]
|
-> [(Int, Player)]
|
||||||
-- ^ The matching players with their index numbers
|
-- ^ The matching players with their index numbers
|
||||||
playerSearch sStr =
|
playerSearch sStr =
|
||||||
filter (match sStr) .
|
filter match . zip [0..]
|
||||||
zip [0..]
|
where match (_, p) = sStr `isInfixOf` (p^.pName)
|
||||||
where match sStr (_, p) = sStr `isInfixOf` (p^.pName)
|
|
||||||
|
|
||||||
-- | Searches for a player by exact match on name
|
-- | Searches for a player by exact match on name
|
||||||
playerSearchExact
|
playerSearchExact
|
||||||
@@ -841,10 +892,8 @@ playerSearchExact
|
|||||||
-> Maybe (Int, Player)
|
-> Maybe (Int, Player)
|
||||||
-- ^ The player's index and value
|
-- ^ The player's index and value
|
||||||
playerSearchExact sStr =
|
playerSearchExact sStr =
|
||||||
listToMaybe .
|
listToMaybe . filter match . zip [0..]
|
||||||
filter (match sStr) .
|
where match (_, p) = p^.pName == sStr
|
||||||
zip [0..]
|
|
||||||
where match sStr (_, p) = p^.pName == sStr
|
|
||||||
|
|
||||||
-- | Modifies a player with a given name
|
-- | Modifies a player with a given name
|
||||||
modifyPlayer
|
modifyPlayer
|
||||||
|
|||||||
@@ -38,7 +38,6 @@ module Mtlstats.Types.Menu (
|
|||||||
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
|||||||
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 qualified Data.Map as M
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Actions.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -81,13 +81,13 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
& progMode.gameStateL .~ gameState n mins goals
|
& progMode.gameStateL .~ gameState n mins goals
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
|
(\(setName, setGid, mins, goals, joeData, bobData, reset) -> let
|
||||||
s = recordGoalieStats $ progState gid mins goals
|
s = recordGoalieStats $ progState setGid mins goals
|
||||||
in context name $ do
|
in context setName $ do
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\( name
|
(\( chkName
|
||||||
, gid
|
, chkGid
|
||||||
, ( gGames
|
, ( gGames
|
||||||
, gMins
|
, gMins
|
||||||
, gGoals
|
, gGoals
|
||||||
@@ -98,11 +98,11 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
, ltMins
|
, ltMins
|
||||||
, ltGoals
|
, ltGoals
|
||||||
)
|
)
|
||||||
) -> context name $ do
|
) -> context chkName $ do
|
||||||
let
|
let
|
||||||
gs = s^.progMode.gameStateL.gameGoalieStats
|
gs = s^.progMode.gameStateL.gameGoalieStats
|
||||||
game = M.findWithDefault newGoalieStats gid gs
|
game = M.findWithDefault newGoalieStats chkGid gs
|
||||||
goalie = fromJust $ nth gid $ s^.database.dbGoalies
|
goalie = fromJust $ nth chkGid $ s^.database.dbGoalies
|
||||||
ytd = goalie^.gYtd
|
ytd = goalie^.gYtd
|
||||||
lt = goalie^.gLifetime
|
lt = goalie^.gLifetime
|
||||||
|
|
||||||
@@ -120,7 +120,7 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
]
|
]
|
||||||
|
|
||||||
context "selected goalie" $ let
|
context "selected goalie" $ let
|
||||||
expected = if reset then Nothing else gid
|
expected = if reset then Nothing else setGid
|
||||||
in it ("should be " ++ show expected) $
|
in it ("should be " ++ show expected) $
|
||||||
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
|
||||||
|
|
||||||
@@ -211,16 +211,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
|||||||
tiedGame = gameState 0 1 True
|
tiedGame = gameState 0 1 True
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\(label, gameState, gid, bobData, joeData) -> context label $ let
|
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
||||||
|
|
||||||
progState = newProgState
|
progState = newProgState
|
||||||
& database.dbGoalies .~ [bob, joe]
|
& database.dbGoalies .~ [bob, joe]
|
||||||
& progMode.gameStateL .~ gameState
|
& progMode.gameStateL .~ gs
|
||||||
& setGameGoalie gid
|
& setGameGoalie setGid
|
||||||
|
|
||||||
in mapM_
|
in mapM_
|
||||||
(\( label
|
(\( chkLabel
|
||||||
, gid
|
, chkGid
|
||||||
, ( gWins
|
, ( gWins
|
||||||
, gLosses
|
, gLosses
|
||||||
, gTies
|
, gTies
|
||||||
@@ -231,16 +231,16 @@ setGameGoalieSpec = describe "setGameGoalie" $ let
|
|||||||
, ltLosses
|
, ltLosses
|
||||||
, ltTies
|
, ltTies
|
||||||
)
|
)
|
||||||
) -> context label $ do
|
) -> context chkLabel $ do
|
||||||
let
|
let
|
||||||
goalie = (progState^.database.dbGoalies) !! gid
|
goalie = (progState^.database.dbGoalies) !! chkGid
|
||||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
||||||
game = M.findWithDefault newGoalieStats gid gameStats
|
game = M.findWithDefault newGoalieStats chkGid gameStats
|
||||||
ytd = goalie^.gYtd
|
ytd = goalie^.gYtd
|
||||||
lifetime = goalie^.gLifetime
|
lifetime = goalie^.gLifetime
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\(label, expected, actual) -> context label $
|
(\(label', expected, actual) -> context label' $
|
||||||
expected `TS.compareTest` actual)
|
expected `TS.compareTest` actual)
|
||||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
||||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
||||||
483
test/Actions/NewGameSpec.hs
Normal file
483
test/Actions/NewGameSpec.hs
Normal file
@@ -0,0 +1,483 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Actions.NewGameSpec (spec) where
|
||||||
|
|
||||||
|
import Control.Monad (replicateM)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
|
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
import qualified Actions.NewGame.GoalieInputSpec as GoalieInput
|
||||||
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "NewGame" $ do
|
||||||
|
overtimeCheckSpec
|
||||||
|
updateGameStatsSpec
|
||||||
|
validateGameDateSpec
|
||||||
|
recordGoalAssistsSpec
|
||||||
|
awardGoalSpec
|
||||||
|
awardAssistSpec
|
||||||
|
resetGoalDataSpec
|
||||||
|
assignPMinsSpec
|
||||||
|
GoalieInput.spec
|
||||||
|
|
||||||
|
overtimeCheckSpec :: Spec
|
||||||
|
overtimeCheckSpec = describe "overtimeCheck" $ do
|
||||||
|
|
||||||
|
context "tie game" $ do
|
||||||
|
let
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameType ?~ HomeGame)
|
||||||
|
. (homeScore ?~ 1)
|
||||||
|
. (awayScore ?~ 1)
|
||||||
|
& overtimeCheck
|
||||||
|
|
||||||
|
it "should clear the home score" $
|
||||||
|
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
||||||
|
|
||||||
|
it "should clear the away score" $
|
||||||
|
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
||||||
|
|
||||||
|
it "should leave the overtimeFlag blank" $
|
||||||
|
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||||
|
|
||||||
|
context "game won" $ do
|
||||||
|
let
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameType ?~ HomeGame)
|
||||||
|
. (homeScore ?~ 2)
|
||||||
|
. (awayScore ?~ 1)
|
||||||
|
& overtimeCheck
|
||||||
|
|
||||||
|
it "should not change the home score" $
|
||||||
|
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
||||||
|
|
||||||
|
it "should not change the away score" $
|
||||||
|
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
||||||
|
|
||||||
|
it "should set the overtimeCheck flag to False" $
|
||||||
|
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
||||||
|
|
||||||
|
context "game lost" $ do
|
||||||
|
let
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameType ?~ HomeGame)
|
||||||
|
. (homeScore ?~ 1)
|
||||||
|
. (awayScore ?~ 2)
|
||||||
|
& overtimeCheck
|
||||||
|
|
||||||
|
it "should not change the home score" $
|
||||||
|
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
||||||
|
|
||||||
|
it "should not change the away score" $
|
||||||
|
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
||||||
|
|
||||||
|
it "should leave the overtimeCheck flag blank" $
|
||||||
|
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
||||||
|
|
||||||
|
updateGameStatsSpec :: Spec
|
||||||
|
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||||
|
let
|
||||||
|
|
||||||
|
baseStats = newGameStats
|
||||||
|
& gmsWins .~ 1
|
||||||
|
& gmsLosses .~ 1
|
||||||
|
& gmsOvertime .~ 1
|
||||||
|
& gmsGoalsFor .~ 1
|
||||||
|
& gmsGoalsAgainst .~ 1
|
||||||
|
|
||||||
|
s t h a o = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameType .~ t)
|
||||||
|
. (homeScore .~ h)
|
||||||
|
. (awayScore .~ a)
|
||||||
|
. (overtimeFlag .~ o)
|
||||||
|
& database
|
||||||
|
%~ (dbHomeGameStats .~ baseStats)
|
||||||
|
. (dbAwayGameStats .~ baseStats)
|
||||||
|
|
||||||
|
db hw hl ho hf ha aw al ao af aa = newDatabase
|
||||||
|
& dbHomeGameStats
|
||||||
|
%~ (gmsWins .~ hw)
|
||||||
|
. (gmsLosses .~ hl)
|
||||||
|
. (gmsOvertime .~ ho)
|
||||||
|
. (gmsGoalsFor .~ hf)
|
||||||
|
. (gmsGoalsAgainst .~ ha)
|
||||||
|
& dbAwayGameStats
|
||||||
|
%~ (gmsWins .~ aw)
|
||||||
|
. (gmsLosses .~ al)
|
||||||
|
. (gmsOvertime .~ ao)
|
||||||
|
. (gmsGoalsFor .~ af)
|
||||||
|
. (gmsGoalsAgainst .~ aa)
|
||||||
|
|
||||||
|
context "home win" $
|
||||||
|
it "should record a home win" $ let
|
||||||
|
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
||||||
|
|
||||||
|
context "home loss" $
|
||||||
|
it "should record a home loss" $ let
|
||||||
|
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
||||||
|
|
||||||
|
context "home overtime loss" $
|
||||||
|
it "should record a home overtime" $ let
|
||||||
|
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
||||||
|
|
||||||
|
context "away win" $
|
||||||
|
it "should record an away win" $ let
|
||||||
|
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
||||||
|
|
||||||
|
context "away loss" $
|
||||||
|
it "should record an away loss" $ let
|
||||||
|
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
||||||
|
|
||||||
|
context "away overtime loss" $
|
||||||
|
it "should record an away overtime" $ let
|
||||||
|
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
||||||
|
|
||||||
|
context "missing game type" $
|
||||||
|
it "should not change anything" $ let
|
||||||
|
s' = s Nothing (Just 1) (Just 2) (Just True)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||||
|
|
||||||
|
context "missing home score" $
|
||||||
|
it "should not change anything" $ let
|
||||||
|
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||||
|
|
||||||
|
context "missing away score" $
|
||||||
|
it "should not change anything" $ let
|
||||||
|
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||||
|
|
||||||
|
context "missing overtime flag" $
|
||||||
|
it "should not change anything" $ let
|
||||||
|
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
||||||
|
db' = updateGameStats s' ^. database
|
||||||
|
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
||||||
|
|
||||||
|
validateGameDateSpec :: Spec
|
||||||
|
validateGameDateSpec = describe "validateGameDate" $ do
|
||||||
|
|
||||||
|
context "valid date" $
|
||||||
|
it "should leave the date unchanged" $ do
|
||||||
|
let
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameYear ?~ 2019)
|
||||||
|
. (gameMonth ?~ 6)
|
||||||
|
. (gameDay ?~ 25)
|
||||||
|
& validateGameDate
|
||||||
|
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||||
|
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||||
|
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
||||||
|
|
||||||
|
context "invalid date" $
|
||||||
|
it "should clear the date" $ do
|
||||||
|
let
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gameYear ?~ 2019)
|
||||||
|
. (gameMonth ?~ 2)
|
||||||
|
. (gameDay ?~ 30)
|
||||||
|
& validateGameDate
|
||||||
|
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
||||||
|
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
||||||
|
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||||
|
|
||||||
|
context "missing day" $
|
||||||
|
it "should not change anything" $ do
|
||||||
|
let
|
||||||
|
|
||||||
|
gs = newGameState
|
||||||
|
& gameYear ?~ 2019
|
||||||
|
& gameMonth ?~ 6
|
||||||
|
|
||||||
|
s = newProgState
|
||||||
|
& progMode.gameStateL .~ gs
|
||||||
|
& validateGameDate
|
||||||
|
|
||||||
|
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
||||||
|
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
||||||
|
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
||||||
|
|
||||||
|
recordGoalAssistsSpec :: Spec
|
||||||
|
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
||||||
|
let
|
||||||
|
joe = newPlayer 1 "Joe" "centre"
|
||||||
|
bob = newPlayer 2 "Bob" "defense"
|
||||||
|
steve = newPlayer 3 "Steve" "forward"
|
||||||
|
dave = newPlayer 4 "Dave" "somewhere"
|
||||||
|
frank = newPlayer 5 "Frank" "elsewhere"
|
||||||
|
ps
|
||||||
|
= newProgState
|
||||||
|
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (goalBy ?~ 0)
|
||||||
|
. (assistsBy .~ [1, 2])
|
||||||
|
. (confirmGoalDataFlag .~ True)
|
||||||
|
& recordGoalAssists
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(name, n, goals, assists) -> context name $ do
|
||||||
|
let
|
||||||
|
player = (ps^.database.dbPlayers) !! n
|
||||||
|
stats = M.findWithDefault newPlayerStats n $
|
||||||
|
ps^.progMode.gameStateL.gamePlayerStats
|
||||||
|
|
||||||
|
it ("should set the year-to-date goals to " ++ show goals) $
|
||||||
|
player^.pYtd.psGoals `shouldBe` goals
|
||||||
|
|
||||||
|
it ("should set the lifetime goals to " ++ show goals) $
|
||||||
|
player^.pLifetime.psGoals `shouldBe` goals
|
||||||
|
|
||||||
|
it ("should set the game goals to " ++ show goals) $
|
||||||
|
stats^.psAssists `shouldBe` assists
|
||||||
|
|
||||||
|
it ("should set the year-to-date assists to " ++ show assists) $
|
||||||
|
player^.pYtd.psAssists `shouldBe` assists
|
||||||
|
|
||||||
|
it ("should set the lifetime assists to " ++ show assists) $
|
||||||
|
player^.pLifetime.psAssists `shouldBe` assists
|
||||||
|
|
||||||
|
it ("should set the game assists to " ++ show assists) $
|
||||||
|
stats^.psAssists `shouldBe` assists)
|
||||||
|
|
||||||
|
-- name, index, goals, assists
|
||||||
|
[ ( "Joe", 0, 1, 0 )
|
||||||
|
, ( "Bob", 1, 0, 1 )
|
||||||
|
, ( "Steve", 2, 0, 1 )
|
||||||
|
, ( "Dave", 3, 0, 0 )
|
||||||
|
]
|
||||||
|
|
||||||
|
it "should clear the goalBy value" $
|
||||||
|
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||||
|
|
||||||
|
it "should clear the assistsBy list" $
|
||||||
|
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||||
|
|
||||||
|
it "should increment the pointsAccounted counter" $
|
||||||
|
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
||||||
|
|
||||||
|
it "should clear the confirmGoalDataFlag" $
|
||||||
|
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||||
|
|
||||||
|
awardGoalSpec :: Spec
|
||||||
|
awardGoalSpec = describe "awardGoal" $ do
|
||||||
|
let
|
||||||
|
joe
|
||||||
|
= newPlayer 2 "Joe" "centre"
|
||||||
|
& pYtd.psGoals .~ 1
|
||||||
|
& pLifetime.psGoals .~ 2
|
||||||
|
bob
|
||||||
|
= newPlayer 3 "Bob" "defense"
|
||||||
|
& pYtd.psGoals .~ 3
|
||||||
|
& pLifetime.psGoals .~ 4
|
||||||
|
db
|
||||||
|
= newDatabase
|
||||||
|
& dbPlayers .~ [joe, bob]
|
||||||
|
joeStats
|
||||||
|
= newPlayerStats
|
||||||
|
& psGoals .~ 1
|
||||||
|
ps
|
||||||
|
= newProgState
|
||||||
|
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||||
|
& database .~ db
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(name, pid, ytd, lt, game) ->
|
||||||
|
context name $ do
|
||||||
|
let
|
||||||
|
ps' = awardGoal pid ps
|
||||||
|
player = (ps'^.database.dbPlayers) !! pid
|
||||||
|
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s year-to-date goals") $
|
||||||
|
player^.pYtd.psGoals `shouldBe` ytd
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s lifetime goals") $
|
||||||
|
player^.pLifetime.psGoals `shouldBe` lt
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s game goals") $
|
||||||
|
gStats^.psGoals `shouldBe` game)
|
||||||
|
-- player name, player id, ytd goals, lifetime goals, game goals
|
||||||
|
[ ( "Joe", 0, 2, 3, 2 )
|
||||||
|
, ( "Bob", 1, 4, 5, 1 )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "invalid index" $ let
|
||||||
|
ps' = awardGoal 2 ps
|
||||||
|
in it "should not change the database" $
|
||||||
|
ps'^.database `shouldBe` db
|
||||||
|
|
||||||
|
context "negative index" $ let
|
||||||
|
ps' = awardGoal (-1) ps
|
||||||
|
in it "should not change the database" $
|
||||||
|
ps'^.database `shouldBe` db
|
||||||
|
|
||||||
|
awardAssistSpec :: Spec
|
||||||
|
awardAssistSpec = describe "awardAssist" $ do
|
||||||
|
let
|
||||||
|
joe
|
||||||
|
= newPlayer 1 "Joe" "centre"
|
||||||
|
& pYtd.psAssists .~ 1
|
||||||
|
& pLifetime.psAssists .~ 2
|
||||||
|
bob
|
||||||
|
= newPlayer 2 "Bob" "defense"
|
||||||
|
& pYtd.psAssists .~ 3
|
||||||
|
& pLifetime.psAssists .~ 4
|
||||||
|
joeStats
|
||||||
|
= newPlayerStats
|
||||||
|
& psAssists .~ 1
|
||||||
|
ps
|
||||||
|
= newProgState
|
||||||
|
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
||||||
|
& database.dbPlayers .~ [joe, bob]
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(name, pid, ytd, lt, game) ->
|
||||||
|
context name $ do
|
||||||
|
let
|
||||||
|
ps' = awardAssist pid ps
|
||||||
|
player = (ps'^.database.dbPlayers) !! pid
|
||||||
|
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s year-to-date assists") $
|
||||||
|
player^.pYtd.psAssists `shouldBe` ytd
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s lifetime assists") $
|
||||||
|
player^.pLifetime.psAssists `shouldBe` lt
|
||||||
|
|
||||||
|
it ("should increment " ++ name ++ "'s game assists") $
|
||||||
|
gStats^.psAssists `shouldBe` game)
|
||||||
|
-- player name, player id, ytd assists, lifetime assists, game assists
|
||||||
|
[ ( "Joe", 0, 2, 3, 2 )
|
||||||
|
, ( "Bob", 1, 4, 5, 1 )
|
||||||
|
]
|
||||||
|
|
||||||
|
context "invalid index" $ let
|
||||||
|
ps' = awardAssist (-1) ps
|
||||||
|
in it "should not change anything" $
|
||||||
|
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
||||||
|
|
||||||
|
resetGoalDataSpec :: Spec
|
||||||
|
resetGoalDataSpec = describe "resetGoalData" $ do
|
||||||
|
players <- runIO $ replicateM 5 TS.makePlayer
|
||||||
|
let
|
||||||
|
gs
|
||||||
|
= newGameState
|
||||||
|
& goalBy ?~ 1
|
||||||
|
& assistsBy .~ [2, 3]
|
||||||
|
& confirmGoalDataFlag .~ True
|
||||||
|
ps
|
||||||
|
= newProgState
|
||||||
|
& database.dbPlayers .~ players
|
||||||
|
& progMode.gameStateL .~ gs
|
||||||
|
& resetGoalData
|
||||||
|
|
||||||
|
it "should clear the goalBy value" $
|
||||||
|
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
||||||
|
|
||||||
|
it "should clear the assists by list" $
|
||||||
|
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
||||||
|
|
||||||
|
it "should clear confirmGoalDataFlag" $
|
||||||
|
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
||||||
|
|
||||||
|
assignPMinsSpec :: Spec
|
||||||
|
assignPMinsSpec = describe "assignPMins" $ let
|
||||||
|
|
||||||
|
bob = newPlayer 2 "Bob" "centre"
|
||||||
|
& pYtd.psPMin .~ 3
|
||||||
|
& pLifetime.psPMin .~ 4
|
||||||
|
|
||||||
|
joe = newPlayer 3 "Joe" "defense"
|
||||||
|
& pYtd.psPMin .~ 5
|
||||||
|
& pLifetime.psPMin .~ 6
|
||||||
|
|
||||||
|
ps pid = newProgState
|
||||||
|
& database.dbPlayers .~ [bob, joe]
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
||||||
|
. (gameSelectedPlayer .~ pid)
|
||||||
|
|
||||||
|
in mapM_
|
||||||
|
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
||||||
|
context ("selectedPlayer = " ++ show pid) $ do
|
||||||
|
let ps' = assignPMins 2 $ ps pid
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(name, pid', lt, ytd, game) -> context name $ do
|
||||||
|
let
|
||||||
|
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
||||||
|
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
||||||
|
pStats = M.findWithDefault newPlayerStats pid' gStats
|
||||||
|
|
||||||
|
context "lifetime penalty minutes" $
|
||||||
|
it ("should be " ++ show lt) $
|
||||||
|
player^.pLifetime.psPMin `shouldBe` lt
|
||||||
|
|
||||||
|
context "year-to-date penalty minutes" $
|
||||||
|
it ("should be " ++ show ytd) $
|
||||||
|
player^.pYtd.psPMin `shouldBe` ytd
|
||||||
|
|
||||||
|
context "game penalty minutes" $
|
||||||
|
it ("should be " ++ show game) $
|
||||||
|
pStats^.psPMin `shouldBe` game)
|
||||||
|
|
||||||
|
-- name, index, lifetime, ytd, game
|
||||||
|
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
||||||
|
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
||||||
|
]
|
||||||
|
|
||||||
|
it "should set selectedPlayer to Nothing" $
|
||||||
|
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
||||||
|
|
||||||
|
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
||||||
|
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
||||||
|
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
||||||
|
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
||||||
|
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
||||||
|
]
|
||||||
@@ -24,16 +24,12 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module ActionsSpec (spec) where
|
module ActionsSpec (spec) where
|
||||||
|
|
||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import qualified Data.Map as M
|
import Lens.Micro ((^.), (&), (.~), (?~))
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
|
||||||
import System.Random (randomRIO)
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
( Spec
|
( Spec
|
||||||
, context
|
, context
|
||||||
, describe
|
, describe
|
||||||
, it
|
, it
|
||||||
, runIO
|
|
||||||
, shouldBe
|
, shouldBe
|
||||||
, shouldNotBe
|
, shouldNotBe
|
||||||
, shouldSatisfy
|
, shouldSatisfy
|
||||||
@@ -41,9 +37,9 @@ import Test.Hspec
|
|||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
|
||||||
|
|
||||||
import qualified Actions.GoalieInputSpec as GoalieInput
|
import qualified Actions.EditGoalieSpec as EditGoalie
|
||||||
|
import qualified Actions.NewGameSpec as NewGame
|
||||||
import qualified TypesSpec as TS
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
@@ -51,27 +47,22 @@ spec = describe "Mtlstats.Actions" $ do
|
|||||||
startNewSeasonSpec
|
startNewSeasonSpec
|
||||||
startNewGameSpec
|
startNewGameSpec
|
||||||
resetYtdSpec
|
resetYtdSpec
|
||||||
|
resetStandingsSpec
|
||||||
addCharSpec
|
addCharSpec
|
||||||
removeCharSpec
|
removeCharSpec
|
||||||
overtimeCheckSpec
|
|
||||||
updateGameStatsSpec
|
|
||||||
validateGameDateSpec
|
|
||||||
createPlayerSpec
|
createPlayerSpec
|
||||||
createGoalieSpec
|
createGoalieSpec
|
||||||
editPlayerSpec
|
editPlayerSpec
|
||||||
|
editGoalieSpec
|
||||||
addPlayerSpec
|
addPlayerSpec
|
||||||
addGoalieSpec
|
addGoalieSpec
|
||||||
resetCreatePlayerStateSpec
|
resetCreatePlayerStateSpec
|
||||||
resetCreateGoalieStateSpec
|
resetCreateGoalieStateSpec
|
||||||
recordGoalAssistsSpec
|
|
||||||
awardGoalSpec
|
|
||||||
awardAssistSpec
|
|
||||||
resetGoalDataSpec
|
|
||||||
assignPMinsSpec
|
|
||||||
backHomeSpec
|
backHomeSpec
|
||||||
scrollUpSpec
|
scrollUpSpec
|
||||||
scrollDownSpec
|
scrollDownSpec
|
||||||
GoalieInput.spec
|
NewGame.spec
|
||||||
|
EditGoalie.spec
|
||||||
|
|
||||||
startNewSeasonSpec :: Spec
|
startNewSeasonSpec :: Spec
|
||||||
startNewSeasonSpec = describe "startNewSeason" $ do
|
startNewSeasonSpec = describe "startNewSeason" $ do
|
||||||
@@ -99,8 +90,8 @@ startNewGameSpec = describe "startNewGame" $ do
|
|||||||
resetYtdSpec :: Spec
|
resetYtdSpec :: Spec
|
||||||
resetYtdSpec = describe "resetYtd" $
|
resetYtdSpec = describe "resetYtd" $
|
||||||
it "should reset the year-to-date stats for all players" $ do
|
it "should reset the year-to-date stats for all players" $ do
|
||||||
ps <- replicateM 2 makePlayer
|
ps <- replicateM 2 TS.makePlayer
|
||||||
gs <- replicateM 2 makeGoalie
|
gs <- replicateM 2 TS.makeGoalie
|
||||||
let
|
let
|
||||||
s = newProgState
|
s = newProgState
|
||||||
& database . dbPlayers .~ ps
|
& database . dbPlayers .~ ps
|
||||||
@@ -137,6 +128,41 @@ resetYtdSpec = describe "resetYtd" $
|
|||||||
lt ^. gsTies `shouldNotBe` 0) $
|
lt ^. gsTies `shouldNotBe` 0) $
|
||||||
s ^. database . dbGoalies
|
s ^. database . dbGoalies
|
||||||
|
|
||||||
|
resetStandingsSpec :: Spec
|
||||||
|
resetStandingsSpec = describe "resetStandings" $ do
|
||||||
|
let
|
||||||
|
home = GameStats
|
||||||
|
{ _gmsWins = 1
|
||||||
|
, _gmsLosses = 2
|
||||||
|
, _gmsOvertime = 3
|
||||||
|
, _gmsGoalsFor = 4
|
||||||
|
, _gmsGoalsAgainst = 5
|
||||||
|
}
|
||||||
|
|
||||||
|
away = GameStats
|
||||||
|
{ _gmsWins = 6
|
||||||
|
, _gmsLosses = 7
|
||||||
|
, _gmsOvertime = 8
|
||||||
|
, _gmsGoalsFor = 9
|
||||||
|
, _gmsGoalsAgainst = 10
|
||||||
|
}
|
||||||
|
|
||||||
|
db = newDatabase
|
||||||
|
& dbHomeGameStats .~ home
|
||||||
|
& dbAwayGameStats .~ away
|
||||||
|
|
||||||
|
ps = newProgState
|
||||||
|
& database .~ db
|
||||||
|
& resetStandings
|
||||||
|
|
||||||
|
context "home standings" $
|
||||||
|
it "should be reset" $
|
||||||
|
ps^.database.dbHomeGameStats `shouldBe` newGameStats
|
||||||
|
|
||||||
|
context "away standings" $
|
||||||
|
it "should be reset" $
|
||||||
|
ps^.database.dbAwayGameStats `shouldBe` newGameStats
|
||||||
|
|
||||||
addCharSpec :: Spec
|
addCharSpec :: Spec
|
||||||
addCharSpec = describe "addChar" $
|
addCharSpec = describe "addChar" $
|
||||||
it "should add the character to the input buffer" $ let
|
it "should add the character to the input buffer" $ let
|
||||||
@@ -160,202 +186,6 @@ removeCharSpec = describe "removeChar" $ do
|
|||||||
& removeChar
|
& removeChar
|
||||||
in s ^. inputBuffer `shouldBe` "fo"
|
in s ^. inputBuffer `shouldBe` "fo"
|
||||||
|
|
||||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
|
||||||
|
|
||||||
context "tie game" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should clear the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should leave the overtimeFlag blank" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
context "game won" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 2)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should set the overtimeCheck flag to False" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
|
||||||
|
|
||||||
context "game lost" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 2)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should leave the overtimeCheck flag blank" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
updateGameStatsSpec :: Spec
|
|
||||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
|
||||||
let
|
|
||||||
|
|
||||||
baseStats = newGameStats
|
|
||||||
& gmsWins .~ 1
|
|
||||||
& gmsLosses .~ 1
|
|
||||||
& gmsOvertime .~ 1
|
|
||||||
& gmsGoalsFor .~ 1
|
|
||||||
& gmsGoalsAgainst .~ 1
|
|
||||||
|
|
||||||
s t h a o = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType .~ t)
|
|
||||||
. (homeScore .~ h)
|
|
||||||
. (awayScore .~ a)
|
|
||||||
. (overtimeFlag .~ o)
|
|
||||||
& database
|
|
||||||
%~ (dbHomeGameStats .~ baseStats)
|
|
||||||
. (dbAwayGameStats .~ baseStats)
|
|
||||||
|
|
||||||
db hw hl ho hf ha aw al ao af aa = newDatabase
|
|
||||||
& dbHomeGameStats
|
|
||||||
%~ (gmsWins .~ hw)
|
|
||||||
. (gmsLosses .~ hl)
|
|
||||||
. (gmsOvertime .~ ho)
|
|
||||||
. (gmsGoalsFor .~ hf)
|
|
||||||
. (gmsGoalsAgainst .~ ha)
|
|
||||||
& dbAwayGameStats
|
|
||||||
%~ (gmsWins .~ aw)
|
|
||||||
. (gmsLosses .~ al)
|
|
||||||
. (gmsOvertime .~ ao)
|
|
||||||
. (gmsGoalsFor .~ af)
|
|
||||||
. (gmsGoalsAgainst .~ aa)
|
|
||||||
|
|
||||||
context "home win" $
|
|
||||||
it "should record a home win" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 2) (Just 1) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 2 1 1 3 2 1 1 1 1 1
|
|
||||||
|
|
||||||
context "home loss" $
|
|
||||||
it "should record a home loss" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 2 1 2 3 1 1 1 1 1
|
|
||||||
|
|
||||||
context "home overtime loss" $
|
|
||||||
it "should record a home overtime" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 2 2 3 1 1 1 1 1
|
|
||||||
|
|
||||||
context "away win" $
|
|
||||||
it "should record an away win" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 1) (Just 2) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 2 1 1 3 2
|
|
||||||
|
|
||||||
context "away loss" $
|
|
||||||
it "should record an away loss" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just False)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 2 1 2 3
|
|
||||||
|
|
||||||
context "away overtime loss" $
|
|
||||||
it "should record an away overtime" $ let
|
|
||||||
s' = s (Just AwayGame) (Just 2) (Just 1) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 2 2 3
|
|
||||||
|
|
||||||
context "missing game type" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s Nothing (Just 1) (Just 2) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing home score" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) Nothing (Just 1) (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing away score" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) Nothing (Just True)
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
context "missing overtime flag" $
|
|
||||||
it "should not change anything" $ let
|
|
||||||
s' = s (Just HomeGame) (Just 1) (Just 2) Nothing
|
|
||||||
db' = updateGameStats s' ^. database
|
|
||||||
in db' `shouldBe` db 1 1 1 1 1 1 1 1 1 1
|
|
||||||
|
|
||||||
validateGameDateSpec :: Spec
|
|
||||||
validateGameDateSpec = describe "validateGameDate" $ do
|
|
||||||
|
|
||||||
context "valid date" $
|
|
||||||
it "should leave the date unchanged" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameYear ?~ 2019)
|
|
||||||
. (gameMonth ?~ 6)
|
|
||||||
. (gameDay ?~ 25)
|
|
||||||
& validateGameDate
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Just 25
|
|
||||||
|
|
||||||
context "invalid date" $
|
|
||||||
it "should clear the date" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameYear ?~ 2019)
|
|
||||||
. (gameMonth ?~ 2)
|
|
||||||
. (gameDay ?~ 30)
|
|
||||||
& validateGameDate
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Nothing
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Nothing
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
|
||||||
|
|
||||||
context "missing day" $
|
|
||||||
it "should not change anything" $ do
|
|
||||||
let
|
|
||||||
|
|
||||||
gs = newGameState
|
|
||||||
& gameYear ?~ 2019
|
|
||||||
& gameMonth ?~ 6
|
|
||||||
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL .~ gs
|
|
||||||
& validateGameDate
|
|
||||||
|
|
||||||
s^.progMode.gameStateL.gameYear `shouldBe` Just 2019
|
|
||||||
s^.progMode.gameStateL.gameMonth `shouldBe` Just 6
|
|
||||||
s^.progMode.gameStateL.gameDay `shouldBe` Nothing
|
|
||||||
|
|
||||||
createPlayerSpec :: Spec
|
createPlayerSpec :: Spec
|
||||||
createPlayerSpec = describe "createPlayer" $
|
createPlayerSpec = describe "createPlayer" $
|
||||||
it "should change the mode appropriately" $ let
|
it "should change the mode appropriately" $ let
|
||||||
@@ -374,6 +204,12 @@ editPlayerSpec = describe "editPlayer" $
|
|||||||
s = editPlayer newProgState
|
s = editPlayer newProgState
|
||||||
in show (s^.progMode) `shouldBe` "EditPlayer"
|
in show (s^.progMode) `shouldBe` "EditPlayer"
|
||||||
|
|
||||||
|
editGoalieSpec :: Spec
|
||||||
|
editGoalieSpec = describe "editGoalie" $
|
||||||
|
it "should change the mode appropriately" $ let
|
||||||
|
s = editGoalie newProgState
|
||||||
|
in show (s^.progMode) `shouldBe` "EditGoalie"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
addPlayerSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
addPlayerSpec = describe "addPlayer" $ do
|
||||||
let
|
let
|
||||||
@@ -440,281 +276,6 @@ resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
|
|||||||
newProgState & progMode.createGoalieStateL .~ cgs
|
newProgState & progMode.createGoalieStateL .~ cgs
|
||||||
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
|
||||||
|
|
||||||
recordGoalAssistsSpec :: Spec
|
|
||||||
recordGoalAssistsSpec = describe "recordGoalAssists" $ do
|
|
||||||
let
|
|
||||||
joe = newPlayer 1 "Joe" "centre"
|
|
||||||
bob = newPlayer 2 "Bob" "defense"
|
|
||||||
steve = newPlayer 3 "Steve" "forward"
|
|
||||||
dave = newPlayer 4 "Dave" "somewhere"
|
|
||||||
frank = newPlayer 5 "Frank" "elsewhere"
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& database.dbPlayers .~ [joe, bob, steve, dave, frank]
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (goalBy ?~ 0)
|
|
||||||
. (assistsBy .~ [1, 2])
|
|
||||||
. (confirmGoalDataFlag .~ True)
|
|
||||||
& recordGoalAssists
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(name, n, goals, assists) -> context name $ do
|
|
||||||
let
|
|
||||||
player = (ps^.database.dbPlayers) !! n
|
|
||||||
stats = M.findWithDefault newPlayerStats n $
|
|
||||||
ps^.progMode.gameStateL.gamePlayerStats
|
|
||||||
|
|
||||||
it ("should set the year-to-date goals to " ++ show goals) $
|
|
||||||
player^.pYtd.psGoals `shouldBe` goals
|
|
||||||
|
|
||||||
it ("should set the lifetime goals to " ++ show goals) $
|
|
||||||
player^.pLifetime.psGoals `shouldBe` goals
|
|
||||||
|
|
||||||
it ("should set the game goals to " ++ show goals) $
|
|
||||||
stats^.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the year-to-date assists to " ++ show assists) $
|
|
||||||
player^.pYtd.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the lifetime assists to " ++ show assists) $
|
|
||||||
player^.pLifetime.psAssists `shouldBe` assists
|
|
||||||
|
|
||||||
it ("should set the game assists to " ++ show assists) $
|
|
||||||
stats^.psAssists `shouldBe` assists)
|
|
||||||
|
|
||||||
-- name, index, goals, assists
|
|
||||||
[ ( "Joe", 0, 1, 0 )
|
|
||||||
, ( "Bob", 1, 0, 1 )
|
|
||||||
, ( "Steve", 2, 0, 1 )
|
|
||||||
, ( "Dave", 3, 0, 0 )
|
|
||||||
]
|
|
||||||
|
|
||||||
it "should clear the goalBy value" $
|
|
||||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the assistsBy list" $
|
|
||||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
|
||||||
|
|
||||||
it "should increment the pointsAccounted counter" $
|
|
||||||
ps^.progMode.gameStateL.pointsAccounted `shouldBe` 1
|
|
||||||
|
|
||||||
it "should clear the confirmGoalDataFlag" $
|
|
||||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
|
||||||
|
|
||||||
awardGoalSpec :: Spec
|
|
||||||
awardGoalSpec = describe "awardGoal" $ do
|
|
||||||
let
|
|
||||||
joe
|
|
||||||
= newPlayer 2 "Joe" "centre"
|
|
||||||
& pYtd.psGoals .~ 1
|
|
||||||
& pLifetime.psGoals .~ 2
|
|
||||||
bob
|
|
||||||
= newPlayer 3 "Bob" "defense"
|
|
||||||
& pYtd.psGoals .~ 3
|
|
||||||
& pLifetime.psGoals .~ 4
|
|
||||||
db
|
|
||||||
= newDatabase
|
|
||||||
& dbPlayers .~ [joe, bob]
|
|
||||||
joeStats
|
|
||||||
= newPlayerStats
|
|
||||||
& psGoals .~ 1
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
|
||||||
context pName $ do
|
|
||||||
let
|
|
||||||
ps' = awardGoal pid ps
|
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date goals") $
|
|
||||||
player^.pYtd.psGoals `shouldBe` ytd
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s lifetime goals") $
|
|
||||||
player^.pLifetime.psGoals `shouldBe` lt
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s game goals") $
|
|
||||||
gStats^.psGoals `shouldBe` game)
|
|
||||||
-- player name, player id, ytd goals, lifetime goals, game goals
|
|
||||||
[ ( "Joe", 0, 2, 3, 2 )
|
|
||||||
, ( "Bob", 1, 4, 5, 1 )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "invalid index" $ let
|
|
||||||
ps' = awardGoal 2 ps
|
|
||||||
in it "should not change the database" $
|
|
||||||
ps'^.database `shouldBe` db
|
|
||||||
|
|
||||||
context "negative index" $ let
|
|
||||||
ps' = awardGoal (-1) ps
|
|
||||||
in it "should not change the database" $
|
|
||||||
ps'^.database `shouldBe` db
|
|
||||||
|
|
||||||
awardAssistSpec :: Spec
|
|
||||||
awardAssistSpec = describe "awardAssist" $ do
|
|
||||||
let
|
|
||||||
joe
|
|
||||||
= newPlayer 1 "Joe" "centre"
|
|
||||||
& pYtd.psAssists .~ 1
|
|
||||||
& pLifetime.psAssists .~ 2
|
|
||||||
bob
|
|
||||||
= newPlayer 2 "Bob" "defense"
|
|
||||||
& pYtd.psAssists .~ 3
|
|
||||||
& pLifetime.psAssists .~ 4
|
|
||||||
joeStats
|
|
||||||
= newPlayerStats
|
|
||||||
& psAssists .~ 1
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& progMode.gameStateL.gamePlayerStats .~ M.singleton 0 joeStats
|
|
||||||
& database.dbPlayers .~ [joe, bob]
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(pName, pid, ytd, lt, game) ->
|
|
||||||
context pName $ do
|
|
||||||
let
|
|
||||||
ps' = awardAssist pid ps
|
|
||||||
player = (ps'^.database.dbPlayers) !! pid
|
|
||||||
gStats = (ps'^.progMode.gameStateL.gamePlayerStats) M.! pid
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s year-to-date assists") $
|
|
||||||
player^.pYtd.psAssists `shouldBe` ytd
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s lifetime assists") $
|
|
||||||
player^.pLifetime.psAssists `shouldBe` lt
|
|
||||||
|
|
||||||
it ("should increment " ++ pName ++ "'s game assists") $
|
|
||||||
gStats^.psAssists `shouldBe` game)
|
|
||||||
-- player name, player id, ytd assists, lifetime assists, game assists
|
|
||||||
[ ( "Joe", 0, 2, 3, 2 )
|
|
||||||
, ( "Bob", 1, 4, 5, 1 )
|
|
||||||
]
|
|
||||||
|
|
||||||
context "invalid index" $ let
|
|
||||||
ps' = awardAssist (-1) ps
|
|
||||||
in it "should not change anything" $
|
|
||||||
ps'^.database.dbPlayers `shouldBe` ps^.database.dbPlayers
|
|
||||||
|
|
||||||
resetGoalDataSpec :: Spec
|
|
||||||
resetGoalDataSpec = describe "resetGoalData" $ do
|
|
||||||
players <- runIO $ replicateM 5 makePlayer
|
|
||||||
let
|
|
||||||
gs
|
|
||||||
= newGameState
|
|
||||||
& goalBy ?~ 1
|
|
||||||
& assistsBy .~ [2, 3]
|
|
||||||
& confirmGoalDataFlag .~ True
|
|
||||||
ps
|
|
||||||
= newProgState
|
|
||||||
& database.dbPlayers .~ players
|
|
||||||
& progMode.gameStateL .~ gs
|
|
||||||
& resetGoalData
|
|
||||||
|
|
||||||
it "should clear the goalBy value" $
|
|
||||||
ps^.progMode.gameStateL.goalBy `shouldBe` Nothing
|
|
||||||
|
|
||||||
it "should clear the assists by list" $
|
|
||||||
ps^.progMode.gameStateL.assistsBy `shouldBe` []
|
|
||||||
|
|
||||||
it "should clear confirmGoalDataFlag" $
|
|
||||||
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False
|
|
||||||
|
|
||||||
assignPMinsSpec :: Spec
|
|
||||||
assignPMinsSpec = describe "assignPMins" $ let
|
|
||||||
|
|
||||||
bob = newPlayer 2 "Bob" "centre"
|
|
||||||
& pYtd.psPMin .~ 3
|
|
||||||
& pLifetime.psPMin .~ 4
|
|
||||||
|
|
||||||
joe = newPlayer 3 "Joe" "defense"
|
|
||||||
& pYtd.psPMin .~ 5
|
|
||||||
& pLifetime.psPMin .~ 6
|
|
||||||
|
|
||||||
ps pid = newProgState
|
|
||||||
& database.dbPlayers .~ [bob, joe]
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
|
|
||||||
. (gameSelectedPlayer .~ pid)
|
|
||||||
|
|
||||||
in mapM_
|
|
||||||
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
|
|
||||||
context ("selectedPlayer = " ++ show pid) $ do
|
|
||||||
let ps' = assignPMins 2 $ ps pid
|
|
||||||
|
|
||||||
mapM_
|
|
||||||
(\(name, pid', lt, ytd, game) -> context name $ do
|
|
||||||
let
|
|
||||||
player = fromJust $ nth pid' $ ps'^.database.dbPlayers
|
|
||||||
gStats = ps'^.progMode.gameStateL.gamePlayerStats
|
|
||||||
pStats = M.findWithDefault newPlayerStats pid' gStats
|
|
||||||
|
|
||||||
context "lifetime penalty minutes" $
|
|
||||||
it ("should be " ++ show lt) $
|
|
||||||
player^.pLifetime.psPMin `shouldBe` lt
|
|
||||||
|
|
||||||
context "year-to-date penalty minutes" $
|
|
||||||
it ("should be " ++ show ytd) $
|
|
||||||
player^.pYtd.psPMin `shouldBe` ytd
|
|
||||||
|
|
||||||
context "game penalty minutes" $
|
|
||||||
it ("should be " ++ show game) $
|
|
||||||
pStats^.psPMin `shouldBe` game)
|
|
||||||
|
|
||||||
-- name, index, lifetime, ytd, game
|
|
||||||
[ ( "Bob", 0, bobLt, bobYtd, bobGame )
|
|
||||||
, ( "Joe", 1, joeLt, joeYtd, joeGame )
|
|
||||||
]
|
|
||||||
|
|
||||||
it "should set selectedPlayer to Nothing" $
|
|
||||||
ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
|
|
||||||
|
|
||||||
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
|
|
||||||
[ ( Just 0, 6, 5, 4, 6, 5, 0 )
|
|
||||||
, ( Just 1, 4, 3, 2, 8, 7, 2 )
|
|
||||||
, ( Just 2, 4, 3, 2, 6, 5, 0 )
|
|
||||||
, ( Nothing, 4, 3, 2, 6, 5, 0 )
|
|
||||||
]
|
|
||||||
|
|
||||||
makePlayer :: IO Player
|
|
||||||
makePlayer = Player
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeName
|
|
||||||
<*> makeName
|
|
||||||
<*> makePlayerStats
|
|
||||||
<*> makePlayerStats
|
|
||||||
|
|
||||||
makeGoalie :: IO Goalie
|
|
||||||
makeGoalie = Goalie
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeName
|
|
||||||
<*> makeGoalieStats
|
|
||||||
<*> makeGoalieStats
|
|
||||||
|
|
||||||
makePlayerStats :: IO PlayerStats
|
|
||||||
makePlayerStats = PlayerStats
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
|
|
||||||
makeGoalieStats :: IO GoalieStats
|
|
||||||
makeGoalieStats = GoalieStats
|
|
||||||
<$> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
<*> makeNum
|
|
||||||
|
|
||||||
makeNum :: IO Int
|
|
||||||
makeNum = randomRIO (1, 10)
|
|
||||||
|
|
||||||
makeName :: IO String
|
|
||||||
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
|
||||||
|
|
||||||
backHomeSpec :: Spec
|
backHomeSpec :: Spec
|
||||||
backHomeSpec = describe "backHome" $ do
|
backHomeSpec = describe "backHome" $ do
|
||||||
let
|
let
|
||||||
@@ -755,6 +316,7 @@ scrollUpSpec = describe "scrollUp" $ do
|
|||||||
ps' = scrollUp ps
|
ps' = scrollUp ps
|
||||||
in ps'^.scrollOffset `shouldBe` 0
|
in ps'^.scrollOffset `shouldBe` 0
|
||||||
|
|
||||||
|
scrollDownSpec :: Spec
|
||||||
scrollDownSpec = describe "scrollDown" $
|
scrollDownSpec = describe "scrollDown" $
|
||||||
it "should increase the scroll offset" $ let
|
it "should increase the scroll offset" $ let
|
||||||
ps = newProgState & scrollOffset .~ 10
|
ps = newProgState & scrollOffset .~ 10
|
||||||
|
|||||||
@@ -21,7 +21,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module ReportSpec (spec) where
|
module ReportSpec (spec) where
|
||||||
|
|
||||||
import Lens.Micro ((&), (?~), (%~))
|
import Lens.Micro ((&), (?~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Report
|
import Mtlstats.Report
|
||||||
|
|||||||
@@ -21,13 +21,21 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
||||||
|
|
||||||
module TypesSpec (Comparable (..), spec) where
|
module TypesSpec
|
||||||
|
( Comparable (..)
|
||||||
|
, spec
|
||||||
|
, makePlayer
|
||||||
|
, makeGoalie
|
||||||
|
, makePlayerStats
|
||||||
|
, makeGoalieStats
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (replicateM)
|
||||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||||
import Data.Aeson.Types (Value (Object))
|
import Data.Aeson.Types (Value (Object))
|
||||||
import Data.ByteString.Lazy (ByteString)
|
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||||
|
import System.Random (randomRIO)
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
@@ -48,6 +56,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
createPlayerStateLSpec
|
createPlayerStateLSpec
|
||||||
createGoalieStateLSpec
|
createGoalieStateLSpec
|
||||||
editPlayerStateLSpec
|
editPlayerStateLSpec
|
||||||
|
editGoalieStateLSpec
|
||||||
teamScoreSpec
|
teamScoreSpec
|
||||||
otherScoreSpec
|
otherScoreSpec
|
||||||
homeTeamSpec
|
homeTeamSpec
|
||||||
@@ -161,6 +170,24 @@ editPlayerStateLSpec = describe "editPlayerStateL" $
|
|||||||
eps2 = newEditPlayerState
|
eps2 = newEditPlayerState
|
||||||
& epsSelectedPlayer ?~ 2
|
& epsSelectedPlayer ?~ 2
|
||||||
|
|
||||||
|
editGoalieStateLSpec :: Spec
|
||||||
|
editGoalieStateLSpec = describe "editGoalieStateL" $
|
||||||
|
lensSpec editGoalieStateL
|
||||||
|
-- getters
|
||||||
|
[ ( "missing state", MainMenu, newEditGoalieState )
|
||||||
|
, ( "with state", EditGoalie egs1, egs1 )
|
||||||
|
]
|
||||||
|
-- setters
|
||||||
|
[ ( "set state", MainMenu, egs1 )
|
||||||
|
, ( "change state", EditGoalie egs1, egs2 )
|
||||||
|
, ( "clear state", EditGoalie egs1, newEditGoalieState )
|
||||||
|
]
|
||||||
|
where
|
||||||
|
egs1 = newEditGoalieState
|
||||||
|
& egsSelectedGoalie ?~ 1
|
||||||
|
egs2 = newEditGoalieState
|
||||||
|
& egsSelectedGoalie ?~ 2
|
||||||
|
|
||||||
teamScoreSpec :: Spec
|
teamScoreSpec :: Spec
|
||||||
teamScoreSpec = describe "teamScore" $ do
|
teamScoreSpec = describe "teamScore" $ do
|
||||||
let
|
let
|
||||||
@@ -581,10 +608,10 @@ playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
|||||||
|
|
||||||
modifyPlayerSpec :: Spec
|
modifyPlayerSpec :: Spec
|
||||||
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
modifyPlayerSpec = describe "modifyPlayer" $ mapM_
|
||||||
(\(pName, j, b, s) -> let
|
(\(name, j, b, s) -> let
|
||||||
modifier = pLifetime.psGoals .~ 1
|
modifier = pLifetime.psGoals .~ 1
|
||||||
players = modifyPlayer modifier pName [joe, bob, steve]
|
players = modifyPlayer modifier name [joe, bob, steve]
|
||||||
in context ("modify " ++ pName) $ do
|
in context ("modify " ++ name) $ do
|
||||||
|
|
||||||
context "Joe's lifetime goals" $
|
context "Joe's lifetime goals" $
|
||||||
it ("should be " ++ show j) $
|
it ("should be " ++ show j) $
|
||||||
@@ -613,7 +640,7 @@ playerDetailsSpec :: Spec
|
|||||||
playerDetailsSpec = describe "playerDetails" $
|
playerDetailsSpec = describe "playerDetails" $
|
||||||
it "should give a detailed description" $ let
|
it "should give a detailed description" $ let
|
||||||
|
|
||||||
player = newPlayer 1 "Joe" "centre"
|
p = newPlayer 1 "Joe" "centre"
|
||||||
& pYtd .~ PlayerStats
|
& pYtd .~ PlayerStats
|
||||||
{ _psGoals = 2
|
{ _psGoals = 2
|
||||||
, _psAssists = 3
|
, _psAssists = 3
|
||||||
@@ -637,26 +664,26 @@ playerDetailsSpec = describe "playerDetails" $
|
|||||||
, "Lifetime penalty mins: 7"
|
, "Lifetime penalty mins: 7"
|
||||||
]
|
]
|
||||||
|
|
||||||
in playerDetails player `shouldBe` expected
|
in playerDetails p `shouldBe` expected
|
||||||
|
|
||||||
playerIsActiveSpec :: Spec
|
playerIsActiveSpec :: Spec
|
||||||
playerIsActiveSpec = describe "playerIsActive" $ do
|
playerIsActiveSpec = describe "playerIsActive" $ do
|
||||||
let
|
let
|
||||||
pState = newPlayerStats
|
pStats = newPlayerStats
|
||||||
& psGoals .~ 10
|
& psGoals .~ 10
|
||||||
& psAssists .~ 11
|
& psAssists .~ 11
|
||||||
& psPMin .~ 12
|
& psPMin .~ 12
|
||||||
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
|
p = newPlayer 1 "Joe" "centre" & pLifetime .~ pStats
|
||||||
|
|
||||||
mapM_
|
mapM_
|
||||||
(\(label, player', expected) -> context label $
|
(\(label, p', expected) -> context label $
|
||||||
it ("should be " ++ show expected) $
|
it ("should be " ++ show expected) $
|
||||||
playerIsActive player' `shouldBe` expected)
|
playerIsActive p' `shouldBe` expected)
|
||||||
-- label, player, expected
|
-- label, player, expected
|
||||||
[ ( "not active", player, False )
|
[ ( "not active", p, False )
|
||||||
, ( "has goal", player & pYtd.psGoals .~ 1, True )
|
, ( "has goal", p & pYtd.psGoals .~ 1, True )
|
||||||
, ( "has assist", player & pYtd.psAssists .~ 1, True )
|
, ( "has assist", p & pYtd.psAssists .~ 1, True )
|
||||||
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
|
, ( "has penalty minute", p & pYtd.psPMin .~ 1, True )
|
||||||
]
|
]
|
||||||
|
|
||||||
psPointsSpec :: Spec
|
psPointsSpec :: Spec
|
||||||
@@ -764,6 +791,47 @@ bob = newPlayer 3 "Bob" "defense"
|
|||||||
steve :: Player
|
steve :: Player
|
||||||
steve = newPlayer 5 "Steve" "forward"
|
steve = newPlayer 5 "Steve" "forward"
|
||||||
|
|
||||||
|
-- | Creates a 'Player'
|
||||||
|
makePlayer :: IO Player
|
||||||
|
makePlayer = Player
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeName
|
||||||
|
<*> makeName
|
||||||
|
<*> makePlayerStats
|
||||||
|
<*> makePlayerStats
|
||||||
|
|
||||||
|
-- | Creates a 'Goalie'
|
||||||
|
makeGoalie :: IO Goalie
|
||||||
|
makeGoalie = Goalie
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeName
|
||||||
|
<*> makeGoalieStats
|
||||||
|
<*> makeGoalieStats
|
||||||
|
|
||||||
|
-- | Creates a 'PlayerStats' value
|
||||||
|
makePlayerStats :: IO PlayerStats
|
||||||
|
makePlayerStats = PlayerStats
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
|
||||||
|
-- | Creates a 'GoalieStats' value
|
||||||
|
makeGoalieStats :: IO GoalieStats
|
||||||
|
makeGoalieStats = GoalieStats
|
||||||
|
<$> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
<*> makeNum
|
||||||
|
|
||||||
|
|
||||||
|
makeNum :: IO Int
|
||||||
|
makeNum = randomRIO (1, 10)
|
||||||
|
|
||||||
|
makeName :: IO String
|
||||||
|
makeName = replicateM 10 $ randomRIO ('A', 'Z')
|
||||||
|
|
||||||
instance Comparable GoalieStats where
|
instance Comparable GoalieStats where
|
||||||
compareTest actual expected = mapM_
|
compareTest actual expected = mapM_
|
||||||
(\(name, lens) -> describe name $
|
(\(name, lens) -> describe name $
|
||||||
@@ -809,6 +877,17 @@ instance Comparable EditPlayerState where
|
|||||||
it ("should be " ++ show (expected^.epsMode)) $
|
it ("should be " ++ show (expected^.epsMode)) $
|
||||||
actual^.epsMode `shouldBe` expected^.epsMode
|
actual^.epsMode `shouldBe` expected^.epsMode
|
||||||
|
|
||||||
|
instance Comparable EditGoalieState where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "egsSelectedGoalie" $
|
||||||
|
it ("should be " ++ show (expected^.egsSelectedGoalie)) $
|
||||||
|
actual^.egsSelectedGoalie `shouldBe` expected^.egsSelectedGoalie
|
||||||
|
|
||||||
|
describe "egsMode" $
|
||||||
|
it ("should be " ++ show (expected^.egsMode)) $
|
||||||
|
actual^.egsMode `shouldBe` expected^.egsMode
|
||||||
|
|
||||||
instance Comparable CreateGoalieState where
|
instance Comparable CreateGoalieState where
|
||||||
compareTest actual expected = do
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
|||||||
@@ -49,18 +49,19 @@ nthSpec = describe "nth" $ mapM_
|
|||||||
|
|
||||||
modifyNthSpec :: Spec
|
modifyNthSpec :: Spec
|
||||||
modifyNthSpec = describe "modifyNth" $ do
|
modifyNthSpec = describe "modifyNth" $ do
|
||||||
|
let list = [1, 2, 3] :: [Int]
|
||||||
|
|
||||||
context "in bounds" $
|
context "in bounds" $
|
||||||
it "should modify the value" $
|
it "should modify the value" $
|
||||||
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
|
modifyNth 1 succ list `shouldBe` [1, 3, 3]
|
||||||
|
|
||||||
context "out of bounds" $
|
context "out of bounds" $
|
||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
modifyNth 3 succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
context "negative index" $
|
context "negative index" $
|
||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
|
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
updateMapSpec :: Spec
|
updateMapSpec :: Spec
|
||||||
updateMapSpec = describe "updateMap" $ do
|
updateMapSpec = describe "updateMap" $ do
|
||||||
@@ -68,7 +69,7 @@ updateMapSpec = describe "updateMap" $ do
|
|||||||
input = M.fromList [(1, 2), (3, 5)]
|
input = M.fromList [(1, 2), (3, 5)]
|
||||||
|
|
||||||
context "key found" $ let
|
context "key found" $ let
|
||||||
expected = M.fromList [(1, 3), (3, 5)]
|
expected = M.fromList [(1, 3), (3, 5)] :: M.Map Int Int
|
||||||
in it "should update the value" $
|
in it "should update the value" $
|
||||||
updateMap 1 10 succ input `shouldBe` expected
|
updateMap 1 10 succ input `shouldBe` expected
|
||||||
|
|
||||||
@@ -79,7 +80,7 @@ updateMapSpec = describe "updateMap" $ do
|
|||||||
|
|
||||||
sliceSpec :: Spec
|
sliceSpec :: Spec
|
||||||
sliceSpec = describe "slice" $ do
|
sliceSpec = describe "slice" $ do
|
||||||
let list = [2, 4, 6, 8]
|
let list = [2, 4, 6, 8] :: [Int]
|
||||||
|
|
||||||
context "sublist" $
|
context "sublist" $
|
||||||
it "should return the sublist" $
|
it "should return the sublist" $
|
||||||
|
|||||||
Reference in New Issue
Block a user