106 Commits
0.3.0 ... 0.5.0

Author SHA1 Message Date
Jonathan Lamothe
90d1dfb581 version 0.5.0 2019-11-04 06:08:30 -05:00
Jonathan Lamothe
f48de6d53a Merge pull request #32 from mtlstats/game-goalie
Assign wins/losses/ties to goalies
2019-11-04 06:07:34 -05:00
Jonathan Lamothe
405ca1c5c7 don't hang on goalie selection 2019-11-04 05:58:39 -05:00
Jonathan Lamothe
c6c461f584 implemented win/loss/tie tallying 2019-11-04 05:44:08 -05:00
Jonathan Lamothe
4910200c96 implemented selectGameGoalieC 2019-11-04 04:12:20 -05:00
Jonathan Lamothe
d708bed77d simplified goalsAllowedPrompt 2019-11-04 03:07:39 -05:00
Jonathan Lamothe
7fd837863b call selectGameGoalieC when goalie info entered for game 2019-11-04 02:50:10 -05:00
Jonathan Lamothe
2a9ff93642 use proptController and promptControllerWith in goalie input controller 2019-11-04 02:47:11 -05:00
Jonathan Lamothe
76c0a85a50 don't show game report until a game goalie has been assigned 2019-11-04 02:41:50 -05:00
Jonathan Lamothe
2f767209bb broke goalie input functions for game off into separate modules 2019-11-04 02:38:48 -05:00
Jonathan Lamothe
43f3d9eb08 renamed GameState fields to prevent name collisions 2019-11-04 01:48:47 -05:00
Jonathan Lamothe
3f38160abd don't mark goalies recorded unless at least one has been entered 2019-11-04 01:30:09 -05:00
Jonathan Lamothe
b0cf9a83a1 added gameGoalieAssigned field to GameState 2019-11-04 01:30:09 -05:00
Jonathan Lamothe
8e74764cab implemented promptController and promptControllerWith 2019-11-04 00:51:50 -05:00
Jonathan Lamothe
b2226c0ca4 Merge pull request #31 from mtlstats/game-count
recordGoalieStats should bump a goalie's game count only once per game
2019-11-01 17:32:00 -04:00
Jonathan Lamothe
4fab3ec285 recordGoalieStats should bump a goalie's game count only once per game 2019-11-01 17:23:57 -04:00
Jonathan Lamothe
a63d822f02 Merge pull request #30 from mtlstats/edit-player
Implemented player editing
2019-11-01 06:58:19 -04:00
Jonathan Lamothe
bf78062455 updated change log 2019-11-01 06:51:49 -04:00
Jonathan Lamothe
b57f12310b implemented lifetime penalty minutes editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
a07c8a0242 implemented lifetime assists editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
9840e5a90e implemented lifetime goals editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
c9b198d106 implemented year-to-date penalty minute editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
24b304047c implemented year-to-date assist editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
4e9b3f635d implemented year-to-date goal editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
fc31794ef4 implemented player position editing 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5bf5a605aa implemented editPlayerNamePrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
911a61ba57 implemented nameC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
ece289d68d implemented editPlayerNumPrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b2362d2f5f implemented Mtlstats.Control.EditPlayer.numberC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b3af06b53d implemented playerDetails 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
0194f68996 implement player edit menu 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5bb4e509b8 implemented control flow for player edit mode 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
c26c0f54d1 added EditPlayerMode 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
5fd67f3802 added "Edit Player" to main menu 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
cb4fc77dd6 renamed editPlayer to editPlayerC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
20ee194035 implemented playerToEditPrompt 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
8b1e93386a implemented editPlayerStateL 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
e754d887c5 implemented Mtlstats.Control.EditPlayer.selectPlayerC 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
b19f1386ec player selection branch 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
43c2f6191d added player edit control flow branch 2019-11-01 06:50:08 -04:00
Jonathan Lamothe
6ec7566b2c updated change log 2019-11-01 06:49:46 -04:00
Jonathan Lamothe
db105d4348 Merge pull request #29 from mtlstats/goalie-data
Record goalie data
2019-10-31 03:53:21 -04:00
Jonathan Lamothe
eb96ce6152 implemented recordGoalieStats 2019-10-31 03:42:07 -04:00
Jonathan Lamothe
ff541c2385 implemented goalsAllowedPrompt 2019-10-31 01:21:21 -04:00
Jonathan Lamothe
cb0b4f9d0b implemented goalsAllowedC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
4fa707bc0f implemented goalieMinsPlayedPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
a6395ada9c implemented minsPlayedC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
1c692a21f0 implemented goalieSummary 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
12c8d0bdd6 implemented goalieSearchExact 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
7e19ee072f implemented goalieSearch 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
2926e28e34 implemented selectGoaliePrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
d215f27f4f make selectPlayerPrompt call selectPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
1e78ca6f40 implemented selectPrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
faa214bf6d implemented selectGameGoaliePrompt 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
6c634cd366 implemented Mtlstats.Control.GoalieInput.selectGoalieC 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
8ef1c6917a implemented goalieInput dispatcher 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
28a29e2f64 control flow branch for goalie input 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
c65bcbbca4 added goalie-related fields to GameState 2019-10-31 00:46:12 -04:00
Jonathan Lamothe
66a2a70bbe implemented addGoalie 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
667cf34475 implemented resetCreatePlayerState and resetCreateGoalieState 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
2d2ee61aae implemented confirmCreateGoalieC 2019-10-30 23:50:13 -04:00
Jonathan Lamothe
ed31ce5b1d added missing documentation comments 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
0812ae3ddd implemented goalie name prompt 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
ec914a38b1 implemented goalieNumPrompt 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
a9b5ada114 implemented getGoalieNumC 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
67bb12920c added goalie creation to main menu 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
e94bf59c81 implemented createGoalieStateL 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
ceb8132a13 broke long line 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
09c63da8bf refactored createPlayerStateLSpec to use lensSpec 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
4519ba4732 made lensSpec more generic 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
24c1673fc9 made GameState, CreatePlayerState and CreateGoalieState instances of Comparable 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
2f0989fb35 created Comparable typeclass 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
2a94e99371 allow ProgMode to handle goalie creation 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
1782c0bc48 implemented CreateGoalieState type 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
a234d8e802 removed (redundant) gsGoalsAgainst 2019-10-30 01:29:16 -04:00
Jonathan Lamothe
6b30e27836 typo fix 2019-10-30 01:28:54 -04:00
Jonathan Lamothe
5677263750 Merge pull request #28 from mtlstats/bugfix-selection-abort
bugfix: don't abort player selection
2019-10-30 00:53:50 -04:00
Jonathan Lamothe
4a113d06e1 bugfix: don't abort player selection
...upon cancellation of player creation
2019-10-30 00:45:16 -04:00
Jonathan Lamothe
121f79a8a2 updated change log 2019-10-25 00:49:45 -04:00
Jonathan Lamothe
ba968657d9 Merge pull request #27 from mtlstats/bugfix-create-user
don't abort creating new player on selection
2019-10-19 00:49:59 -04:00
Jonathan Lamothe
ef8f7f3fee don't abort creating new player on selection 2019-10-19 00:41:56 -04:00
Jonathan Lamothe
c7849d3558 version 0.4.0 2019-10-17 09:59:20 -04:00
Jonathan Lamothe
756d0997a8 updated change log 2019-10-16 02:40:09 -04:00
Jonathan Lamothe
569f009dcd Merge pull request #26 from mtlstats/ytd-stats
year-to-date statistics
2019-10-16 02:37:50 -04:00
Jonathan Lamothe
cfe2969106 generate empty game stats report on failure 2019-10-16 02:32:57 -04:00
Jonathan Lamothe
19e0242135 fixed name column spacing 2019-10-16 02:26:42 -04:00
Jonathan Lamothe
32f61ccc89 implemented year-to-date report 2019-10-16 02:23:52 -04:00
Jonathan Lamothe
bfe568492d implemented playerReport
a private function in the Mtlstats.Report module
2019-10-16 02:23:52 -04:00
Jonathan Lamothe
277ba9a9dd implemented playerNameColWidth 2019-10-15 01:03:32 -04:00
Jonathan Lamothe
d338930800 implemented playerIsActive 2019-10-15 00:51:42 -04:00
Jonathan Lamothe
363d0cb2d3 don't scroll past top of page 2019-10-15 00:16:44 -04:00
Jonathan Lamothe
a91ed5afb3 enable scrolling of report 2019-10-11 23:13:00 -04:00
Jonathan Lamothe
db8bbd9786 added scrollOffset field to ProgState 2019-10-11 22:24:27 -04:00
Jonathan Lamothe
c4f68bb29c Merge pull request #25 from mtlstats/pmin-prompt
Prompt user for penalty minutes and assign
2019-10-11 01:17:43 -04:00
Jonathan Lamothe
e2c3b57749 implemented assignPMins 2019-10-11 01:10:50 -04:00
Jonathan Lamothe
3d1f6170f6 implemented assignPMinsPrompt 2019-10-09 22:33:48 -04:00
Jonathan Lamothe
1a481ab49d implemented getPMinsC 2019-10-09 22:24:30 -04:00
Jonathan Lamothe
afd2bac7b5 implemented pMinPlayerPrompt 2019-10-09 21:54:55 -04:00
Jonathan Lamothe
ffe9b7f87f implemented pMinPlayerC 2019-10-09 01:24:55 -04:00
Jonathan Lamothe
e1a48afc5c penalty minutes control framework 2019-10-09 00:58:49 -04:00
Jonathan Lamothe
1810434716 added selectedPlayer and pMinsRecorded fields to GameState 2019-10-09 00:50:10 -04:00
Jonathan Lamothe
146e2e42a1 Merge pull request #24 from mtlstats/gs-totals
Calculate and display total player stats for game
2019-10-09 00:39:58 -04:00
Jonathan Lamothe
a9c036f876 renamed pPoints to psPoints 2019-10-09 00:35:35 -04:00
Jonathan Lamothe
0b249bcdae calculate and display total game stats 2019-10-09 00:30:03 -04:00
Jonathan Lamothe
74fd4fe2fb implemented addPlayerStats 2019-10-09 00:24:34 -04:00
Jonathan Lamothe
5f53413ef7 split report into standings and game stats 2019-10-09 00:01:12 -04:00
20 changed files with 2064 additions and 217 deletions

View File

@@ -1,5 +1,17 @@
# Changelog for mtlstats # Changelog for mtlstats
## 0.5.0
- Fixed player creation bug
- Prompt for goalie informaiton on game data entry
- Implemented player editing
## v0.4.0
- Record penalty minutes
- Calculate total game statistics
- Generate year-to-date statistics report
## v0.3.0 ## v0.3.0
- Record goals and assists - Record goals and assists

View File

@@ -1,5 +1,5 @@
name: mtlstats name: mtlstats
version: 0.3.0 version: 0.5.0
github: "mtlstats/mtlstats" github: "mtlstats/mtlstats"
license: GPL-3 license: GPL-3
author: "Jonathan Lamothe" author: "Jonathan Lamothe"

View File

@@ -31,11 +31,20 @@ module Mtlstats.Actions
, updateGameStats , updateGameStats
, validateGameDate , validateGameDate
, createPlayer , createPlayer
, createGoalie
, editPlayer
, addPlayer , addPlayer
, addGoalie
, resetCreatePlayerState
, resetCreateGoalieState
, recordGoalAssists , recordGoalAssists
, awardGoal , awardGoal
, awardAssist , awardAssist
, resetGoalData , resetGoalData
, assignPMins
, backHome
, scrollUp
, scrollDown
) where ) where
import Control.Monad.Trans.State (modify) import Control.Monad.Trans.State (modify)
@@ -45,6 +54,7 @@ import Data.Time.Calendar (fromGregorianValid)
import Lens.Micro (over, (^.), (&), (.~), (?~), (%~), (+~)) 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
@@ -134,13 +144,25 @@ validateGameDate s = fromMaybe s $ do
-- | Starts player creation mode -- | Starts player creation mode
createPlayer :: ProgState -> ProgState createPlayer :: ProgState -> ProgState
createPlayer = let createPlayer = let
cb = modify $ progMode .~ MainMenu callback = modify $ progMode .~ MainMenu
cps cps = newCreatePlayerState
= newCreatePlayerState & cpsSuccessCallback .~ callback
& cpsSuccessCallback .~ cb & cpsFailureCallback .~ callback
& cpsFailureCallback .~ cb
in progMode .~ CreatePlayer cps in progMode .~ CreatePlayer cps
-- | Starts goalie creation mode
createGoalie :: ProgState -> ProgState
createGoalie = let
callback = modify $ progMode .~ MainMenu
cgs = newCreateGoalieState
& cgsSuccessCallback .~ callback
& cgsFailureCallback .~ callback
in progMode .~ CreateGoalie cgs
-- | Starts the player editing process
editPlayer :: ProgState -> ProgState
editPlayer = progMode .~ EditPlayer newEditPlayerState
-- | 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
@@ -153,6 +175,30 @@ addPlayer s = fromMaybe s $ do
Just $ s & database.dbPlayers Just $ s & database.dbPlayers
%~ (++[player]) %~ (++[player])
-- | Adds the entered goalie to the roster
addGoalie :: ProgState -> ProgState
addGoalie s = fromMaybe s $ do
let cgs = s^.progMode.createGoalieStateL
num <- cgs^.cgsNumber
let
name = cgs^.cgsName
goalie = newGoalie num name
Just $ s & database.dbGoalies
%~ (++[goalie])
-- | Resets the 'CreatePlayerState' value
resetCreatePlayerState :: ProgState -> ProgState
resetCreatePlayerState = progMode.createPlayerStateL
%~ (cpsNumber .~ Nothing)
. (cpsName .~ "")
. (cpsPosition .~ "")
-- | Resets the 'CreateGoalieState' value
resetCreateGoalieState :: ProgState -> ProgState
resetCreateGoalieState = progMode.createGoalieStateL
%~ (cgsNumber .~ Nothing)
. (cgsName .~ "")
-- | Awards the goal and assists to the players -- | Awards the goal and assists to the players
recordGoalAssists :: ProgState -> ProgState recordGoalAssists :: ProgState -> ProgState
recordGoalAssists ps = fromMaybe ps $ do recordGoalAssists ps = fromMaybe ps $ do
@@ -210,3 +256,35 @@ resetGoalData ps = ps & progMode.gameStateL
%~ (goalBy .~ Nothing) %~ (goalBy .~ Nothing)
. (assistsBy .~ []) . (assistsBy .~ [])
. (confirmGoalDataFlag .~ False) . (confirmGoalDataFlag .~ False)
-- | Adds penalty minutes to a player
assignPMins
:: Int
-- ^ The number of minutes to add
-> ProgState
-> ProgState
assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.gameSelectedPlayer
Just $ s
& database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
& progMode.gameStateL
%~ ( gamePlayerStats %~ updateMap n newPlayerStats
(psPMin +~ mins)
)
. (gameSelectedPlayer .~ Nothing)
-- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState
backHome
= (progMode .~ MainMenu)
. (inputBuffer .~ "")
. (scrollOffset .~ 0)
-- | Scrolls the display up
scrollUp :: ProgState -> ProgState
scrollUp = scrollOffset %~ max 0 . pred
-- | Scrolls the display down
scrollDown :: ProgState -> ProgState
scrollDown = scrollOffset %~ succ

View File

@@ -0,0 +1,108 @@
{- |
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.GoalieInput
( finishGoalieEntry
, recordGoalieStats
, setGameGoalie
) where
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (&), (.~), (%~), (+~))
import Mtlstats.Config
import Mtlstats.Types
import Mtlstats.Util
-- | Attempts to finish game goalie entry
finishGoalieEntry :: ProgState -> ProgState
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
-- | Records the goalie's game stats
recordGoalieStats :: ProgState -> ProgState
recordGoalieStats s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
gid <- gs^.gameSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
mins <- gs^.gameGoalieMinsPlayed
goals <- gs^.gameGoalsAllowed
let
gameStats = M.findWithDefault newGoalieStats gid $ gs^.gameGoalieStats
bumpVal = if gameStats^.gsGames == 0
then 1
else 0
bumpStats gs = gs
& gsGames +~ bumpVal
& gsMinsPlayed +~ mins
& gsGoalsAllowed +~ goals
tryFinish = if mins >= gameLength
then finishGoalieEntry
else id
Just $ s
& progMode.gameStateL
%~ (gameGoalieStats %~ updateMap gid newGoalieStats bumpStats)
. (gameSelectedGoalie .~ Nothing)
. (gameGoalieMinsPlayed .~ Nothing)
. (gameGoalsAllowed .~ Nothing)
& database.dbGoalies
%~ modifyNth gid (\goalie -> goalie
& gYtd %~ bumpStats
& gLifetime %~ bumpStats)
& tryFinish
-- | Records the win, loss, or tie to a specific 'Goalie'
setGameGoalie
:: Int
-- ^ The goalie's index
-> ProgState
-> ProgState
setGameGoalie gid s = fromMaybe s $ do
let gs = s^.progMode.gameStateL
won <- gameWon gs
lost <- gameLost gs
tied <- gs^.overtimeFlag
let
w = if won then 1 else 0
l = if lost then 1 else 0
t = if tied then 1 else 0
updateStats gs = gs
& gsWins +~ w
& gsLosses +~ l
& gsTies +~ t
updateGoalie g = g
& gYtd %~ updateStats
& gLifetime %~ updateStats
updateGameState gs = gs
& gameGoalieStats %~ updateMap gid newGoalieStats updateStats
& gameGoalieAssigned .~ True
Just $ s
& database.dbGoalies %~ modifyNth gid updateGoalie
& progMode.gameStateL %~ updateGameState

View File

@@ -40,3 +40,7 @@ dbFname = "database.json"
-- | The maximum number of assists -- | The maximum number of assists
maxAssists :: Int maxAssists :: Int
maxAssists = 2 maxAssists = 2
-- | The length of a typical game (in minutes)
gameLength :: Int
gameLength = 60

View File

@@ -22,14 +22,17 @@ 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, when)
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.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.EditPlayer
import Mtlstats.Control.GoalieInput
import Mtlstats.Format import Mtlstats.Format
import Mtlstats.Handlers import Mtlstats.Handlers
import Mtlstats.Menu import Mtlstats.Menu
@@ -55,12 +58,20 @@ dispatch s = case s^.progMode of
| null $ gs^.overtimeFlag -> overtimeFlagC | null $ gs^.overtimeFlag -> overtimeFlagC
| not $ gs^.dataVerified -> verifyDataC | not $ gs^.dataVerified -> verifyDataC
| fromJust (unaccountedPoints gs) -> goalInput gs | fromJust (unaccountedPoints gs) -> goalInput gs
| isJust $ gs^.gameSelectedPlayer -> getPMinsC
| not $ gs^.gamePMinsRecorded -> pMinPlayerC
| not $ gs^.gameGoalieAssigned -> goalieInput s
| otherwise -> reportC | otherwise -> reportC
CreatePlayer cps CreatePlayer cps
| null $ cps^.cpsNumber -> getPlayerNumC | null $ cps^.cpsNumber -> getPlayerNumC
| null $ cps^.cpsName -> getPlayerNameC | null $ cps^.cpsName -> getPlayerNameC
| null $ cps^.cpsPosition -> getPlayerPosC | null $ cps^.cpsPosition -> getPlayerPosC
| otherwise -> confirmCreatePlayerC | otherwise -> confirmCreatePlayerC
CreateGoalie cgs
| null $ cgs^.cgsNumber -> getGoalieNumC
| null $ cgs^.cgsName -> getGoalieNameC
| otherwise -> confirmCreateGoalieC
EditPlayer eps -> editPlayerC eps
mainMenuC :: Controller mainMenuC :: Controller
mainMenuC = Controller mainMenuC = Controller
@@ -241,19 +252,47 @@ confirmGoalDataC = Controller
return True 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
reportC = Controller reportC = Controller
{ drawController = \s -> do { drawController = \s -> do
(_, cols) <- C.windowSize (rows, cols) <- C.windowSize
C.drawString $ report (fromInteger $ pred cols) s C.drawString $ unlines $ slice
(s^.scrollOffset)
(fromInteger $ pred rows)
(report (fromInteger $ pred cols) s)
return C.CursorInvisible return C.CursorInvisible
, handleController = \e -> do , handleController = \e -> do
when case e of
(case e of C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
C.EventCharacter _ -> True C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
C.EventSpecialKey _ -> True C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
_ -> False) $ C.EventSpecialKey _ -> modify backHome
modify $ progMode .~ MainMenu C.EventCharacter _ -> modify backHome
_ -> return ()
return True return True
} }
@@ -305,6 +344,44 @@ confirmCreatePlayerC = Controller
return True return True
} }
getGoalieNumC :: Controller
getGoalieNumC = Controller
{ drawController = drawPrompt goalieNumPrompt
, handleController = \e -> do
promptHandler goalieNumPrompt e
return True
}
getGoalieNameC :: Controller
getGoalieNameC = Controller
{ drawController = drawPrompt goalieNamePrompt
, handleController = \e -> do
promptHandler goalieNamePrompt e
return True
}
confirmCreateGoalieC :: Controller
confirmCreateGoalieC = Controller
{ drawController = \s -> do
let cgs = s^.progMode.createGoalieStateL
C.drawString $ unlines
[ "Goalie number: " ++ show (fromJust $ cgs^.cgsNumber)
, " Goalie name: " ++ cgs^.cgsName
, ""
, "Create goalie: are you sure? (Y/N)"
]
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
modify addGoalie
join $ gets (^.progMode.createGoalieStateL.cgsSuccessCallback)
Just False ->
join $ gets (^.progMode.createGoalieStateL.cgsFailureCallback)
Nothing -> return ()
return True
}
gameGoal :: ProgState -> (Int, Int) gameGoal :: ProgState -> (Int, Int)
gameGoal s = gameGoal s =
( s^.database.dbGames ( s^.database.dbGames

View File

@@ -0,0 +1,143 @@
{- |
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.EditPlayer (editPlayerC) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.EditPlayer
import Mtlstats.Types
import Mtlstats.Util
-- | Dispatcher/controller for the player edit mode
editPlayerC :: EditPlayerState -> Controller
editPlayerC eps
| null $ eps^.epsSelectedPlayer = selectPlayerC
| otherwise = case eps^.epsMode of
EPMenu -> menuC
EPNumber -> numberC
EPName -> nameC
EPPosition -> positionC
EPYtdGoals -> ytdGoalsC
EPYtdAssists -> ytdAssistsC
EPYtdPMin -> ytdPMinC
EPLtGoals -> ltGoalsC
EPLtAssists -> ltAssistsC
EPLtPMin -> ltPMinC
selectPlayerC :: Controller
selectPlayerC = Controller
{ drawController = drawPrompt playerToEditPrompt
, handleController = \e -> do
promptHandler playerToEditPrompt e
return True
}
menuC :: Controller
menuC = Controller
{ drawController = \s -> do
let
header = fromMaybe "" $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
p <- nth pid $ s^.database.dbPlayers
Just $ playerDetails p ++ "\n"
C.drawString header
drawMenu editPlayerMenu
, handleController = \e -> do
menuHandler editPlayerMenu e
return True
}
numberC :: Controller
numberC = Controller
{ drawController = drawPrompt editPlayerNumPrompt
, handleController = \e -> do
promptHandler editPlayerNumPrompt e
return True
}
nameC :: Controller
nameC = Controller
{ drawController = drawPrompt editPlayerNamePrompt
, handleController = \e -> do
promptHandler editPlayerNamePrompt e
return True
}
positionC :: Controller
positionC = Controller
{ drawController = drawPrompt editPlayerPosPrompt
, handleController = \e -> do
promptHandler editPlayerPosPrompt e
return True
}
ytdGoalsC :: Controller
ytdGoalsC = Controller
{ drawController = drawPrompt editPlayerYtdGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdGoalsPrompt e
return True
}
ytdAssistsC :: Controller
ytdAssistsC = Controller
{ drawController = drawPrompt editPlayerYtdAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerYtdAssistsPrompt e
return True
}
ytdPMinC :: Controller
ytdPMinC = Controller
{ drawController = drawPrompt editPlayerYtdPMinPrompt
, handleController = \e -> do
promptHandler editPlayerYtdPMinPrompt e
return True
}
ltGoalsC :: Controller
ltGoalsC = Controller
{ drawController = drawPrompt editPlayerLtGoalsPrompt
, handleController = \e -> do
promptHandler editPlayerLtGoalsPrompt e
return True
}
ltAssistsC :: Controller
ltAssistsC = Controller
{ drawController = drawPrompt editPlayerLtAssistsPrompt
, handleController = \e -> do
promptHandler editPlayerLtAssistsPrompt e
return True
}
ltPMinC :: Controller
ltPMinC = Controller
{ drawController = drawPrompt editPlayerLtPMinPrompt
, handleController = \e -> do
promptHandler editPlayerLtPMinPrompt e
return True
}

View File

@@ -0,0 +1,66 @@
{- |
mtlstats
Copyright (C) 2019 Rhéal Lamothe
<rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module Mtlstats.Control.GoalieInput (goalieInput) where
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.))
import qualified UI.NCurses as C
import Mtlstats.Format
import Mtlstats.Menu
import Mtlstats.Prompt
import Mtlstats.Prompt.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
-- | The dispatcher for handling goalie input
goalieInput :: ProgState -> Controller
goalieInput s = let
gs = s^.progMode.gameStateL
in if gs^.gameGoaliesRecorded
then selectGameGoalieC s
else if null $ gs^.gameSelectedGoalie
then selectGoalieC
else if null $ gs^.gameGoalieMinsPlayed
then minsPlayedC
else goalsAllowedC
selectGoalieC :: Controller
selectGoalieC = promptController selectGameGoaliePrompt
minsPlayedC :: Controller
minsPlayedC = promptControllerWith header goalieMinsPlayedPrompt
goalsAllowedC :: Controller
goalsAllowedC = promptControllerWith header goalsAllowedPrompt
selectGameGoalieC :: ProgState -> Controller
selectGameGoalieC = menuController . gameGoalieMenu
header :: ProgState -> C.Update ()
header s = C.drawString $ unlines
[ "*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***"
, fromMaybe "" $ do
n <- s^.progMode.gameStateL.gameSelectedGoalie
g <- nth n $ s^.database.dbGoalies
Just $ goalieSummary g
]

View File

@@ -21,19 +21,24 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module Mtlstats.Menu ( module Mtlstats.Menu (
-- * Menu Functions -- * Menu Functions
menuController,
drawMenu, drawMenu,
menuHandler, menuHandler,
-- * Menus -- * Menus
mainMenu, mainMenu,
newSeasonMenu, newSeasonMenu,
gameMonthMenu, gameMonthMenu,
gameTypeMenu gameTypeMenu,
editPlayerMenu,
gameGoalieMenu
) where ) where
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (gets, modify) import Control.Monad.Trans.State (gets, modify)
import Data.Aeson (encodeFile) import Data.Aeson (encodeFile)
import Data.Char (toUpper) import Data.Char (toUpper)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import Lens.Micro ((^.), (.~), (?~)) import Lens.Micro ((^.), (.~), (?~))
import Lens.Micro.Extras (view) import Lens.Micro.Extras (view)
import System.EasyFile import System.EasyFile
@@ -44,9 +49,20 @@ 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 Mtlstats.Config import Mtlstats.Config
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Types.Menu import Mtlstats.Types.Menu
import Mtlstats.Util
-- | Generates a simple 'Controller' for a Menu
menuController :: Menu () -> Controller
menuController menu = Controller
{ drawController = const $ drawMenu menu
, handleController = \e -> do
menuHandler menu e
return True
}
-- | The draw function for a 'Menu' -- | The draw function for a 'Menu'
drawMenu :: Menu a -> C.Update C.CursorMode drawMenu :: Menu a -> C.Update C.CursorMode
@@ -71,7 +87,11 @@ mainMenu = Menu "*** MAIN MENU ***" True
modify startNewGame >> return True modify startNewGame >> return True
, MenuItem '3' "Create Player" $ , MenuItem '3' "Create Player" $
modify createPlayer >> return True modify createPlayer >> return True
, MenuItem '4' "Exit" $ do , MenuItem '4' "Create Goalie" $
modify createGoalie >> return True
, MenuItem '5' "Edit Player" $
modify editPlayer >> return True
, MenuItem '6' "Exit" $ do
db <- gets $ view database db <- gets $ view database
liftIO $ do liftIO $ do
dir <- getAppUserDataDirectory appName dir <- getAppUserDataDirectory appName
@@ -119,3 +139,36 @@ gameTypeMenu = Menu "Game type:" ()
, MenuItem '2' "Away Game" $ , MenuItem '2' "Away Game" $
modify $ progMode.gameStateL.gameType ?~ AwayGame modify $ progMode.gameStateL.gameType ?~ AwayGame
] ]
-- | The player edit menu
editPlayerMenu :: Menu ()
editPlayerMenu = Menu "*** EDIT PLAYER ***" () $ map
(\(ch, label, mode) -> MenuItem ch label $ case mode of
Nothing -> modify $ progMode .~ MainMenu
Just m -> modify $ progMode.editPlayerStateL.epsMode .~ m)
[ ( '1', "Change number", Just EPNumber )
, ( '2', "Change name", Just EPName )
, ( '3', "Change position", Just EPPosition )
, ( '4', "YTD goals", Just EPYtdGoals )
, ( '5', "YTD assists", Just EPYtdAssists )
, ( '6', "YTD penalty mins", Just EPYtdPMin )
, ( '7', "Lifetime goals", Just EPLtGoals )
, ( '8', "Lifetime assists", Just EPLtAssists )
, ( '9', "Lifetime penalty mins", Just EPLtPMin )
, ( '0', "Finished editing", Nothing )
]
-- | Game goalie selection menu
gameGoalieMenu :: ProgState -> Menu ()
gameGoalieMenu s = let
title = "Which goalie should get credit for the game?"
gids = map fst $ M.toList $ s^.progMode.gameStateL.gameGoalieStats
goalies = mapMaybe
(\n -> do
goalie <- nth n $ s^.database.dbGoalies
Just (n, goalie))
gids
in Menu title () $ map
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
modify $ GI.setGameGoalie gid) $
zip ['1'..] goalies

View File

@@ -25,8 +25,11 @@ module Mtlstats.Prompt (
-- * Prompt Functions -- * Prompt Functions
drawPrompt, drawPrompt,
promptHandler, promptHandler,
promptControllerWith,
promptController,
strPrompt, strPrompt,
numPrompt, numPrompt,
selectPrompt,
-- * Individual prompts -- * Individual prompts
gameYearPrompt, gameYearPrompt,
gameDayPrompt, gameDayPrompt,
@@ -36,15 +39,23 @@ module Mtlstats.Prompt (
playerNumPrompt, playerNumPrompt,
playerNamePrompt, playerNamePrompt,
playerPosPrompt, playerPosPrompt,
goalieNumPrompt,
goalieNamePrompt,
selectPlayerPrompt, selectPlayerPrompt,
selectGoaliePrompt,
recordGoalPrompt, recordGoalPrompt,
recordAssistPrompt recordAssistPrompt,
pMinPlayerPrompt,
assignPMinsPrompt,
playerToEditPrompt
) where ) where
import Control.Monad (when) import Control.Monad (when)
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)
@@ -78,6 +89,31 @@ promptHandler p (C.EventSpecialKey k) =
promptSpecialKey p k promptSpecialKey p k
promptHandler _ _ = return () promptHandler _ _ = return ()
-- | Builds a controller out of a prompt with a header
promptControllerWith
:: (ProgState -> C.Update ())
-- ^ The header
-> Prompt
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptControllerWith header prompt = Controller
{ drawController = \s -> do
header s
drawPrompt prompt s
, handleController = \e -> do
promptHandler prompt e
return True
}
-- | Builds a controller out of a prompt
promptController
:: Prompt
-- ^ The prompt to use
-> Controller
-- ^ The resulting controller
promptController = promptControllerWith (const $ return ())
-- | Builds a string prompt -- | Builds a string prompt
strPrompt strPrompt
:: String :: String
@@ -106,6 +142,43 @@ numPrompt pStr act = Prompt
, promptSpecialKey = const $ return () , promptSpecialKey = const $ return ()
} }
-- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt
selectPrompt params = Prompt
{ promptDrawer = \s -> do
let sStr = s^.inputBuffer
C.drawString $ spPrompt params ++ sStr
(row, col) <- C.cursorPosition
C.drawString $ "\n\n" ++ spSearchHeader params ++ "\n"
let results = zip [1..maxFunKeys] $ spSearch params sStr (s^.database)
C.drawString $ unlines $ map
(\(n, (_, x)) -> let
desc = spElemDesc params x
in "F" ++ show n ++ ") " ++ desc)
results
C.moveCursor row col
, promptCharCheck = const True
, promptAction = \sStr -> if null sStr
then spCallback params Nothing
else do
db <- gets (^.database)
case spSearchExact params sStr db of
Nothing -> spNotFound params sStr
Just n -> spCallback params $ Just n
, promptSpecialKey = \case
C.KeyFunction rawK -> do
sStr <- gets (^.inputBuffer)
db <- gets (^.database)
let
n = pred $ fromInteger rawK
results = spSearch params sStr db
when (n < maxFunKeys) $
whenJust (nth n results) $ \(n, _) -> do
modify $ inputBuffer .~ ""
spCallback params $ Just n
_ -> return ()
}
-- | Prompts for the game year -- | Prompts for the game year
gameYearPrompt :: Prompt gameYearPrompt :: Prompt
gameYearPrompt = numPrompt "Game year: " $ gameYearPrompt = numPrompt "Game year: " $
@@ -146,6 +219,16 @@ playerPosPrompt :: Prompt
playerPosPrompt = strPrompt "Player position: " $ playerPosPrompt = strPrompt "Player position: " $
modify . (progMode.createPlayerStateL.cpsPosition .~) modify . (progMode.createPlayerStateL.cpsPosition .~)
-- | Prompts tor the goalie's number
goalieNumPrompt :: Prompt
goalieNumPrompt = numPrompt "Goalie number: " $
modify . (progMode.createGoalieStateL.cgsNumber ?~)
-- | Prompts for the goalie's name
goalieNamePrompt :: Prompt
goalieNamePrompt = strPrompt "Goalie name: " $
modify . (progMode.createGoalieStateL.cgsName .~)
-- | Selects a player (creating one if necessary) -- | Selects a player (creating one if necessary)
selectPlayerPrompt selectPlayerPrompt
:: String :: String
@@ -154,51 +237,52 @@ selectPlayerPrompt
-- ^ The callback to run (takes the index number of the payer as -- ^ The callback to run (takes the index number of the payer as
-- input) -- input)
-> Prompt -> Prompt
selectPlayerPrompt pStr callback = Prompt selectPlayerPrompt pStr callback = selectPrompt SelectParams
{ promptDrawer = \s -> do { spPrompt = pStr
let sStr = s^.inputBuffer , spSearchHeader = "Player select:"
C.drawString pStr , spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
C.drawString sStr , spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
(row, col) <- C.cursorPosition , spElemDesc = playerSummary
C.drawString "\n\nPlayer select:\n" , spCallback = callback
let sel = zip [1..maxFunKeys] $ playerSearch sStr $ s^.database.dbPlayers , spNotFound = \sStr -> do
mapM_ mode <- gets (^.progMode)
(\(n, (_, p)) -> C.drawString $
"F" ++ show n ++ ") " ++ p^.pName ++ " (" ++ show (p^.pNumber) ++ ")\n")
sel
C.moveCursor row col
, promptCharCheck = const True
, promptAction = \sStr -> if null sStr
then callback Nothing
else do
players <- gets $ view $ database.dbPlayers
case playerSearchExact sStr players of
Just (n, _) -> callback $ Just n
Nothing -> do
mode <- gets $ view progMode
let let
cps cps = newCreatePlayerState
= newCreatePlayerState
& cpsName .~ sStr & cpsName .~ sStr
& cpsSuccessCallback .~ do & cpsSuccessCallback .~ do
modify $ progMode .~ mode modify $ progMode .~ mode
pIndex <- pred . length <$> gets (view $ database.dbPlayers) index <- pred . length <$> gets (^.database.dbPlayers)
callback $ Just pIndex callback $ Just index
& cpsFailureCallback .~ do & cpsFailureCallback .~ modify (progMode .~ mode)
modify $ progMode .~ mode
callback Nothing
modify $ progMode .~ CreatePlayer cps modify $ progMode .~ CreatePlayer cps
, promptSpecialKey = \case }
C.KeyFunction n -> do
sStr <- gets $ view inputBuffer -- | Selects a goalie (creating one if necessary)
players <- gets $ view $ database.dbPlayers selectGoaliePrompt
modify $ inputBuffer .~ "" :: String
-- ^ The prompt string
-> (Maybe Int -> Action ())
-- ^ The callback to run (takes the index number of the goalie as
-- input)
-> Prompt
selectGoaliePrompt pStr callback = selectPrompt SelectParams
{ spPrompt = pStr
, spSearchHeader = "Goalie select:"
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
, spElemDesc = goalieSummary
, spCallback = callback
, spNotFound = \sStr -> do
mode <- gets (^.progMode)
let let
fKey = pred $ fromIntegral n cgs = newCreateGoalieState
options = playerSearch sStr players & cgsName .~ sStr
sel = fst <$> nth fKey options & cgsSuccessCallback .~ do
callback sel modify $ progMode .~ mode
_ -> return () index <- pred . length <$> gets (^.database.dbGoalies)
callback $ Just index
& cgsFailureCallback .~ modify (progMode .~ mode)
modify $ progMode .~ CreateGoalie cgs
} }
-- | Prompts for the player who scored the goal -- | Prompts for the player who scored the goal
@@ -234,5 +318,22 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
when (nAssists >= maxAssists) $ when (nAssists >= maxAssists) $
modify $ progMode.gameStateL.confirmGoalDataFlag .~ True modify $ progMode.gameStateL.confirmGoalDataFlag .~ True
-- | Prompts for the player to assign penalty minutes to
pMinPlayerPrompt :: Prompt
pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $
\case
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-- | Prompts for the number of penalty mintues to assign to the player
assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins
playerToEditPrompt :: Prompt
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
drawSimplePrompt :: String -> ProgState -> C.Update () drawSimplePrompt :: String -> ProgState -> C.Update ()
drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer drawSimplePrompt pStr s = C.drawString $ pStr ++ s^.inputBuffer

View File

@@ -0,0 +1,92 @@
{- |
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.EditPlayer
( editPlayerNumPrompt
, editPlayerNamePrompt
, editPlayerPosPrompt
, editPlayerYtdGoalsPrompt
, editPlayerYtdAssistsPrompt
, editPlayerYtdPMinPrompt
, editPlayerLtGoalsPrompt
, editPlayerLtAssistsPrompt
, editPlayerLtPMinPrompt
) where
import Control.Monad.Extra (whenJustM)
import Control.Monad.Trans.State (gets, modify)
import Lens.Micro ((^.), (.~), (%~))
import Mtlstats.Prompt
import Mtlstats.Types
import Mtlstats.Util
-- | Prompt to edit a player's number
editPlayerNumPrompt :: Prompt
editPlayerNumPrompt = numPrompt "Player number: " $
editPlayer . (pNumber .~)
-- | Prompt to edit a player's name
editPlayerNamePrompt :: Prompt
editPlayerNamePrompt = strPrompt "Player name: " $
editPlayer . (pName .~)
-- | Prompt to edit a player's position
editPlayerPosPrompt :: Prompt
editPlayerPosPrompt = strPrompt "Player position: " $
editPlayer . (pPosition .~)
-- | Prompt to edit a player's year-to-date goals
editPlayerYtdGoalsPrompt :: Prompt
editPlayerYtdGoalsPrompt = numPrompt "Year-to-date goals: " $
editPlayer . (pYtd.psGoals .~)
-- | Prompt to edit a player's year-to-date assists
editPlayerYtdAssistsPrompt :: Prompt
editPlayerYtdAssistsPrompt = numPrompt "Year-to-date assists: " $
editPlayer . (pYtd.psAssists .~)
-- | Prompt to edit a player's year-to-date penalty minutes
editPlayerYtdPMinPrompt :: Prompt
editPlayerYtdPMinPrompt = numPrompt "Year-to-date penalty minutes: " $
editPlayer . (pYtd.psPMin .~)
-- | Prompt to edit a player's lifetime goals
editPlayerLtGoalsPrompt :: Prompt
editPlayerLtGoalsPrompt = numPrompt "Lifetime goals: " $
editPlayer . (pLifetime.psGoals .~)
-- | Prompt to edit a player's lifetime assists
editPlayerLtAssistsPrompt :: Prompt
editPlayerLtAssistsPrompt = numPrompt "Lifetime assists: " $
editPlayer . (pLifetime.psAssists .~)
-- | Prompt to edit a player's lifetime penalty minutes
editPlayerLtPMinPrompt :: Prompt
editPlayerLtPMinPrompt = numPrompt "Lifetime penalty minutes: " $
editPlayer . (pLifetime.psPMin .~)
editPlayer :: (Player -> Player) -> Action ()
editPlayer f =
whenJustM (gets (^.progMode.editPlayerStateL.epsSelectedPlayer)) $ \pid ->
modify
$ (database.dbPlayers %~ modifyNth pid f)
. (progMode.editPlayerStateL.epsMode .~ EPMenu)

View File

@@ -0,0 +1,56 @@
{- |
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.GoalieInput
( selectGameGoaliePrompt
, goalieMinsPlayedPrompt
, goalsAllowedPrompt
) where
import Control.Monad (when)
import Control.Monad.Trans.State (gets, modify)
import Data.Maybe (fromMaybe)
import Lens.Micro ((^.), (.~), (?~))
import Mtlstats.Actions.GoalieInput
import Mtlstats.Config
import Mtlstats.Prompt
import Mtlstats.Types
-- | Prompts for a goalie who played in the game
selectGameGoaliePrompt :: Prompt
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
\case
Nothing -> modify finishGoalieEntry
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
-- | Prompts for the number of minutes the goalie has played
goalieMinsPlayedPrompt :: Prompt
goalieMinsPlayedPrompt = numPrompt "Minutes played: " $
modify . (progMode.gameStateL.gameGoalieMinsPlayed ?~)
-- | Prompts for the number of goals the goalie allowed
goalsAllowedPrompt :: Prompt
goalsAllowedPrompt = numPrompt "Goals allowed: " $ \n -> do
modify (progMode.gameStateL.gameGoalsAllowed ?~ n)
modify recordGoalieStats

View File

@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Report (report, gameDate) where module Mtlstats.Report (report, gameDate, playerNameColWidth) where
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@@ -36,8 +36,16 @@ report
-- ^ The number of columns for the report -- ^ The number of columns for the report
-> ProgState -> ProgState
-- ^ The program state -- ^ The program state
-> String -> [String]
report width s = unlines $ fromMaybe [] $ do report width s
= standingsReport width s
++ [""]
++ gameStatsReport width s
++ [""]
++ yearToDateStatsReport width s
standingsReport :: Int -> ProgState -> [String]
standingsReport width s = fromMaybe [] $ do
let let
db = s^.database db = s^.database
gs = s^.progMode.gameStateL gs = s^.progMode.gameStateL
@@ -48,15 +56,9 @@ report width s = unlines $ fromMaybe [] $ do
hStats = db^.dbHomeGameStats hStats = db^.dbHomeGameStats
aStats = db^.dbAwayGameStats aStats = db^.dbAwayGameStats
tStats = addGameStats hStats aStats tStats = addGameStats hStats aStats
players = db^.dbPlayers
hScore <- gs^.homeScore hScore <- gs^.homeScore
aScore <- gs^.awayScore aScore <- gs^.awayScore
pStats <- mapM Just
(\(n, stats) -> do
player <- nth n players
Just (player, stats))
(M.toList $ gs^.gamePlayerStats)
Just $
[ overlay [ overlay
("GAME NUMBER " ++ padNum 2 gNum) ("GAME NUMBER " ++ padNum 2 gNum)
(centre width (centre width
@@ -86,12 +88,38 @@ report width s = unlines $ fromMaybe [] $ do
, centre width , centre width
$ left 11 "TOTALS" $ left 11 "TOTALS"
++ showStats tStats ++ showStats tStats
, "" ]
, centre width "GAME STATISTICS"
gameStatsReport :: Int -> ProgState -> [String]
gameStatsReport width s = playerReport width "GAME" $
fromMaybe [] $ mapM
(\(pid, stats) -> do
p <- nth pid $ s^.database.dbPlayers
Just (p, stats))
(M.toList $ s^.progMode.gameStateL.gamePlayerStats)
yearToDateStatsReport :: Int -> ProgState -> [String]
yearToDateStatsReport width s = playerReport width "YEAR TO DATE" $
map (\p -> (p, p^.pYtd)) $
filter playerIsActive $ s^.database.dbPlayers
gameDate :: GameState -> String
gameDate gs = fromMaybe "" $ do
year <- show <$> gs^.gameYear
month <- month <$> gs^.gameMonth
day <- padNum 2 <$> gs^.gameDay
Just $ month ++ " " ++ day ++ " " ++ year
playerReport :: Int -> String -> [(Player, PlayerStats)] -> [String]
playerReport width label ps = let
nameWidth = playerNameColWidth $ map fst ps
tStats = foldr (addPlayerStats . snd) newPlayerStats ps
in
[ centre width (label ++ " STATISTICS")
, "" , ""
, centre width , centre width
$ "NO. " $ "NO. "
++ left 20 "PLAYER" ++ left nameWidth "PLAYER"
++ right 3 "G" ++ right 3 "G"
++ right 6 "A" ++ right 6 "A"
++ right 6 "P" ++ right 6 "P"
@@ -100,19 +128,30 @@ report width s = unlines $ fromMaybe [] $ do
(\(p, stats) -> centre width (\(p, stats) -> centre width
$ right 2 (show $ p^.pNumber) $ right 2 (show $ p^.pNumber)
++ " " ++ " "
++ left 20 (p^.pName) ++ left nameWidth (p^.pName)
++ right 3 (show $ stats^.psGoals) ++ right 3 (show $ stats^.psGoals)
++ right 6 (show $ stats^.psAssists) ++ right 6 (show $ stats^.psAssists)
++ right 6 (show $ pPoints stats) ++ right 6 (show $ psPoints stats)
++ right 6 (show $ stats^.psPMin)) ++ right 6 (show $ stats^.psPMin))
pStats ps ++
[ centre width
$ replicate (4 + nameWidth) ' '
++ replicate (3 + 3 * 6) '-'
, overlay
(label ++ " TOTALS")
( centre width
$ replicate (4 + nameWidth) ' '
++ right 3 (show $ tStats^.psGoals)
++ right 6 (show $ tStats^.psAssists)
++ right 6 (show $ psPoints tStats)
++ right 6 (show $ tStats^.psPMin)
)
]
gameDate :: GameState -> String playerNameColWidth :: [Player] -> Int
gameDate gs = fromMaybe "" $ do playerNameColWidth = foldr
year <- show <$> gs^.gameYear (\player current -> max current $ succ $ length $ player^.pName)
month <- month <$> gs^.gameMonth 10
day <- padNum 2 <$> gs^.gameDay
Just $ month ++ " " ++ day ++ " " ++ year
showStats :: GameStats -> String showStats :: GameStats -> String
showStats gs showStats gs

View File

@@ -30,6 +30,9 @@ module Mtlstats.Types (
GameState (..), GameState (..),
GameType (..), GameType (..),
CreatePlayerState (..), CreatePlayerState (..),
CreateGoalieState (..),
EditPlayerState (..),
EditPlayerMode (..),
Database (..), Database (..),
Player (..), Player (..),
PlayerStats (..), PlayerStats (..),
@@ -37,14 +40,18 @@ module Mtlstats.Types (
GoalieStats (..), GoalieStats (..),
GameStats (..), GameStats (..),
Prompt (..), Prompt (..),
SelectParams (..),
-- * Lenses -- * Lenses
-- ** ProgState Lenses -- ** ProgState Lenses
database, database,
progMode, progMode,
inputBuffer, inputBuffer,
scrollOffset,
-- ** ProgMode Lenses -- ** ProgMode Lenses
gameStateL, gameStateL,
createPlayerStateL, createPlayerStateL,
createGoalieStateL,
editPlayerStateL,
-- ** GameState Lenses -- ** GameState Lenses
gameYear, gameYear,
gameMonth, gameMonth,
@@ -60,12 +67,28 @@ module Mtlstats.Types (
assistsBy, assistsBy,
gamePlayerStats, gamePlayerStats,
confirmGoalDataFlag, confirmGoalDataFlag,
gameSelectedPlayer,
gamePMinsRecorded,
gameGoalieStats,
gameSelectedGoalie,
gameGoalieMinsPlayed,
gameGoalsAllowed,
gameGoaliesRecorded,
gameGoalieAssigned,
-- ** CreatePlayerState Lenses -- ** CreatePlayerState Lenses
cpsNumber, cpsNumber,
cpsName, cpsName,
cpsPosition, cpsPosition,
cpsSuccessCallback, cpsSuccessCallback,
cpsFailureCallback, cpsFailureCallback,
-- ** CreateGoalieState Lenses
cgsNumber,
cgsName,
cgsSuccessCallback,
cgsFailureCallback,
-- ** EditPlayerState Lenses
epsSelectedPlayer,
epsMode,
-- ** Database Lenses -- ** Database Lenses
dbPlayers, dbPlayers,
dbGoalies, dbGoalies,
@@ -91,7 +114,6 @@ module Mtlstats.Types (
gsGames, gsGames,
gsMinsPlayed, gsMinsPlayed,
gsGoalsAllowed, gsGoalsAllowed,
gsGoalsAgainst,
gsWins, gsWins,
gsLosses, gsLosses,
gsTies, gsTies,
@@ -105,6 +127,8 @@ module Mtlstats.Types (
newProgState, newProgState,
newGameState, newGameState,
newCreatePlayerState, newCreatePlayerState,
newCreateGoalieState,
newEditPlayerState,
newDatabase, newDatabase,
newPlayer, newPlayer,
newPlayerStats, newPlayerStats,
@@ -126,11 +150,19 @@ module Mtlstats.Types (
gmsPoints, gmsPoints,
addGameStats, addGameStats,
-- ** Player Helpers -- ** Player Helpers
pPoints,
playerSearch, playerSearch,
playerSearchExact, playerSearchExact,
modifyPlayer, modifyPlayer,
playerSummary playerSummary,
playerDetails,
playerIsActive,
-- ** PlayerStats Helpers
psPoints,
addPlayerStats,
-- ** Goalie Helpers
goalieSearch,
goalieSearchExact,
goalieSummary
) where ) where
import Control.Monad.Trans.State (StateT) import Control.Monad.Trans.State (StateT)
@@ -174,6 +206,8 @@ data ProgState = ProgState
-- ^ The program's mode -- ^ The program's mode
, _inputBuffer :: String , _inputBuffer :: String
-- ^ Buffer for user input -- ^ Buffer for user input
, _scrollOffset :: Int
-- ^ The scrolling offset for the display
} }
-- | The program mode -- | The program mode
@@ -182,12 +216,16 @@ data ProgMode
| NewSeason | NewSeason
| NewGame GameState | NewGame GameState
| CreatePlayer CreatePlayerState | CreatePlayer CreatePlayerState
| CreateGoalie CreateGoalieState
| EditPlayer EditPlayerState
instance Show ProgMode where instance Show ProgMode where
show MainMenu = "MainMenu" show MainMenu = "MainMenu"
show NewSeason = "NewSeason" show NewSeason = "NewSeason"
show (NewGame _) = "NewGame" show (NewGame _) = "NewGame"
show (CreatePlayer _) = "CreatePlayer" show (CreatePlayer _) = "CreatePlayer"
show (CreateGoalie _) = "CreateGoalie"
show (EditPlayer _) = "EditPlayer"
-- | The game state -- | The game state
data GameState = GameState data GameState = GameState
@@ -221,6 +259,25 @@ data GameState = GameState
-- ^ The player stats accumulated over the game -- ^ The player stats accumulated over the game
, _confirmGoalDataFlag :: Bool , _confirmGoalDataFlag :: Bool
-- ^ Set when the user confirms the goal data -- ^ Set when the user confirms the goal data
, _gameSelectedPlayer :: Maybe Int
-- ^ Index number of the selected 'Player'
, _gamePMinsRecorded :: Bool
-- ^ Set when the penalty mintes have been recorded
, _gameGoalieStats :: M.Map Int GoalieStats
-- ^ The goalie stats accumulated over the game
, _gameSelectedGoalie :: Maybe Int
-- ^ Index number of the selected 'Goalie'
, _gameGoalieMinsPlayed :: Maybe Int
-- ^ The number of minutes the currently selected goalie played in
-- the game
, _gameGoalsAllowed :: Maybe Int
-- ^ The number of goals the currently selected goalie allowed in
-- the game
, _gameGoaliesRecorded :: Bool
-- ^ Set when the user confirms that all goalie info has been entered
, _gameGoalieAssigned :: Bool
-- ^ Set to 'True' when the goalie has been selected who will be
-- given the win/loss/tie
} deriving (Eq, Show) } deriving (Eq, Show)
-- | The type of game -- | The type of game
@@ -243,6 +300,40 @@ data CreatePlayerState = CreatePlayerState
-- ^ The function to call on failure -- ^ The function to call on failure
} }
-- | Goalie creation status
data CreateGoalieState = CreateGoalieState
{ _cgsNumber :: Maybe Int
-- ^ The goalie's number
, _cgsName :: String
-- ^ The goalie's name
, _cgsSuccessCallback :: Action ()
-- ^ The function to call on success
, _cgsFailureCallback :: Action ()
-- ^ The function to call on failure
}
-- | Player edit status
data EditPlayerState = EditPlayerState
{ _epsSelectedPlayer :: Maybe Int
-- ^ The index number of the player being edited
, _epsMode :: EditPlayerMode
-- ^ The editing mode
}
-- | Player editing mode
data EditPlayerMode
= EPMenu
| EPNumber
| EPName
| EPPosition
| EPYtdGoals
| EPYtdAssists
| EPYtdPMin
| EPLtGoals
| EPLtAssists
| EPLtPMin
deriving (Eq, Show)
-- | Represents the database -- | Represents the database
data Database = Database data Database = Database
{ _dbPlayers :: [Player] { _dbPlayers :: [Player]
@@ -384,8 +475,6 @@ data GoalieStats = GoalieStats
-- ^ The number of minutes played -- ^ The number of minutes played
, _gsGoalsAllowed :: Int , _gsGoalsAllowed :: Int
-- ^ The number of goals allowed -- ^ The number of goals allowed
, _gsGoalsAgainst :: Int
-- ^ The number of goals against
, _gsWins :: Int , _gsWins :: Int
-- ^ The number of wins -- ^ The number of wins
, _gsLosses :: Int , _gsLosses :: Int
@@ -399,26 +488,23 @@ instance FromJSON GoalieStats where
<$> v .: "games" <$> v .: "games"
<*> v .: "mins_played" <*> v .: "mins_played"
<*> v .: "goals_allowed" <*> v .: "goals_allowed"
<*> v .: "goals_against"
<*> v .: "wins" <*> v .: "wins"
<*> v .: "losses" <*> v .: "losses"
<*> v .: "ties" <*> v .: "ties"
instance ToJSON GoalieStats where instance ToJSON GoalieStats where
toJSON (GoalieStats g m al ag w l t) = object toJSON (GoalieStats g m a w l t) = object
[ "games" .= g [ "games" .= g
, "mins_played" .= m , "mins_played" .= m
, "goals_allowed" .= al , "goals_allowed" .= a
, "goals_against" .= ag
, "wins" .= w , "wins" .= w
, "losses" .= l , "losses" .= l
, "ties" .= t , "ties" .= t
] ]
toEncoding (GoalieStats g m al ag w l t) = pairs $ toEncoding (GoalieStats g m a w l t) = pairs $
"games" .= g <> "games" .= g <>
"mins_played" .= m <> "mins_played" .= m <>
"goals_allowed" .= al <> "goals_allowed" .= a <>
"goals_against" .= ag <>
"wins" .= w <> "wins" .= w <>
"losses" .= l <> "losses" .= l <>
"ties" .= t "ties" .= t
@@ -463,7 +549,7 @@ instance ToJSON GameStats where
-- | Defines a user prompt -- | Defines a user prompt
data Prompt = Prompt data Prompt = Prompt
{ promptDrawer :: ProgState -> C.Update () { promptDrawer :: ProgState -> C.Update ()
-- ^ Draws the prompt to thr screen -- ^ Draws the prompt to the screen
, promptCharCheck :: Char -> Bool , promptCharCheck :: Char -> Bool
-- ^ Determines whether or not the character is valid -- ^ Determines whether or not the character is valid
, promptAction :: String -> Action () , promptAction :: String -> Action ()
@@ -472,9 +558,29 @@ data Prompt = Prompt
-- ^ Action to perform when a special key is pressed -- ^ Action to perform when a special key is pressed
} }
-- | Parameters for a search prompt
data SelectParams a = SelectParams
{ spPrompt :: String
-- ^ The search prompt
, spSearchHeader :: String
-- ^ The header to display at the top of the search list
, spSearch :: String -> Database -> [(Int, a)]
-- ^ The search function
, spSearchExact :: String -> Database -> Maybe Int
-- ^ Search function looking for an exact match
, spElemDesc :: a -> String
-- ^ Provides a string description of an element
, spCallback :: Maybe Int -> Action ()
-- ^ The function when the selection is made
, spNotFound :: String -> Action ()
-- ^ The function to call when the selection doesn't exist
}
makeLenses ''ProgState makeLenses ''ProgState
makeLenses ''GameState makeLenses ''GameState
makeLenses ''CreatePlayerState makeLenses ''CreatePlayerState
makeLenses ''CreateGoalieState
makeLenses ''EditPlayerState
makeLenses ''Database makeLenses ''Database
makeLenses ''Player makeLenses ''Player
makeLenses ''PlayerStats makeLenses ''PlayerStats
@@ -496,12 +602,27 @@ createPlayerStateL = lens
_ -> newCreatePlayerState) _ -> newCreatePlayerState)
(\_ cps -> CreatePlayer cps) (\_ cps -> CreatePlayer cps)
createGoalieStateL :: Lens' ProgMode CreateGoalieState
createGoalieStateL = lens
(\case
CreateGoalie cgs -> cgs
_ -> newCreateGoalieState)
(\_ cgs -> CreateGoalie cgs)
editPlayerStateL :: Lens' ProgMode EditPlayerState
editPlayerStateL = lens
(\case
EditPlayer eps -> eps
_ -> newEditPlayerState)
(\_ eps -> EditPlayer eps)
-- | Constructor for a 'ProgState' -- | Constructor for a 'ProgState'
newProgState :: ProgState newProgState :: ProgState
newProgState = ProgState newProgState = ProgState
{ _database = newDatabase { _database = newDatabase
, _progMode = MainMenu , _progMode = MainMenu
, _inputBuffer = "" , _inputBuffer = ""
, _scrollOffset = 0
} }
-- | Constructor for a 'GameState' -- | Constructor for a 'GameState'
@@ -521,6 +642,14 @@ newGameState = GameState
, _assistsBy = [] , _assistsBy = []
, _gamePlayerStats = M.empty , _gamePlayerStats = M.empty
, _confirmGoalDataFlag = False , _confirmGoalDataFlag = False
, _gameSelectedPlayer = Nothing
, _gamePMinsRecorded = False
, _gameGoalieStats = M.empty
, _gameSelectedGoalie = Nothing
, _gameGoalieMinsPlayed = Nothing
, _gameGoalsAllowed = Nothing
, _gameGoaliesRecorded = False
, _gameGoalieAssigned = False
} }
-- | Constructor for a 'CreatePlayerState' -- | Constructor for a 'CreatePlayerState'
@@ -533,6 +662,22 @@ newCreatePlayerState = CreatePlayerState
, _cpsFailureCallback = return () , _cpsFailureCallback = return ()
} }
-- | Constructor for a 'CreateGoalieState'
newCreateGoalieState :: CreateGoalieState
newCreateGoalieState = CreateGoalieState
{ _cgsNumber = Nothing
, _cgsName = ""
, _cgsSuccessCallback = return ()
, _cgsFailureCallback = return ()
}
-- | Constructor for an 'EditPlayerState'
newEditPlayerState :: EditPlayerState
newEditPlayerState = EditPlayerState
{ _epsSelectedPlayer = Nothing
, _epsMode = EPMenu
}
-- | Constructor for a 'Database' -- | Constructor for a 'Database'
newDatabase :: Database newDatabase :: Database
newDatabase = Database newDatabase = Database
@@ -588,7 +733,6 @@ newGoalieStats = GoalieStats
{ _gsGames = 0 { _gsGames = 0
, _gsMinsPlayed = 0 , _gsMinsPlayed = 0
, _gsGoalsAllowed = 0 , _gsGoalsAllowed = 0
, _gsGoalsAgainst = 0
, _gsWins = 0 , _gsWins = 0
, _gsLosses = 0 , _gsLosses = 0
, _gsTies = 0 , _gsTies = 0
@@ -675,10 +819,6 @@ addGameStats s1 s2 = GameStats
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst , _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
} }
-- | Calculates a player's points
pPoints :: PlayerStats -> Int
pPoints s = s^.psGoals + s^.psAssists
-- | Searches through a list of players -- | Searches through a list of players
playerSearch playerSearch
:: String :: String
@@ -725,3 +865,68 @@ modifyPlayer f n = map
playerSummary :: Player -> String playerSummary :: Player -> String
playerSummary p = playerSummary p =
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
-- | Provides a detailed string describing a 'Player'
playerDetails :: Player -> String
playerDetails p = unlines
[ " Number: " ++ show (p^.pNumber)
, " Name: " ++ p^.pName
, " Position: " ++ p^.pPosition
, " YTD goals: " ++ show (p^.pYtd.psGoals)
, " YTD assists: " ++ show (p^.pYtd.psAssists)
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
]
-- | Determines whether or not a player has been active in the current
-- season/year
playerIsActive :: Player -> Bool
playerIsActive = do
stats <- (^.pYtd)
return
$ stats^.psGoals /= 0
|| stats^.psAssists /= 0
|| stats^.psPMin /= 0
-- | Calculates a player's points
psPoints :: PlayerStats -> Int
psPoints s = s^.psGoals + s^.psAssists
-- | Adds two 'PlayerStats' together
addPlayerStats :: PlayerStats -> PlayerStats -> PlayerStats
addPlayerStats s1 s2 = newPlayerStats
& psGoals .~ s1^.psGoals + s2^.psGoals
& psAssists .~ s1^.psAssists + s2^.psAssists
& psPMin .~ s1^.psPMin + s2^.psPMin
-- | Searches a list of goalies
goalieSearch
:: String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> [(Int, Goalie)]
-- ^ The search results with their corresponding index numbers
goalieSearch sStr = filter (\(_, goalie) -> sStr `isInfixOf` (goalie^.gName)) .
zip [0..]
-- | Searches a list of goalies for an exact match
goalieSearchExact
:: String
-- ^ The search string
-> [Goalie]
-- ^ The list to search
-> Maybe (Int, Goalie)
-- ^ The result with its index number
goalieSearchExact sStr goalies = let
results = filter (\(_, goalie) -> sStr == goalie^.gName) $
zip [0..] goalies
in case results of
[] -> Nothing
result:_ -> Just result
-- | Provides a description string for a 'Goalie'
goalieSummary :: Goalie -> String
goalieSummary g = g^.gName ++ " (" ++ show (g^.gNumber) ++ ")"

View File

@@ -19,11 +19,59 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
module Mtlstats.Util (nth) where module Mtlstats.Util (nth, modifyNth, updateMap, slice) where
nth :: Int -> [a] -> Maybe a import qualified Data.Map as M
-- | Attempt to select the element from a list at a given index
nth
:: Int
-- ^ The index
-> [a]
-- ^ The list
-> Maybe a
nth _ [] = Nothing nth _ [] = Nothing
nth n (x:xs) nth n (x:xs)
| n == 0 = Just x | n == 0 = Just x
| n < 0 = Nothing | n < 0 = Nothing
| otherwise = nth (pred n) xs | otherwise = nth (pred n) xs
-- | Attempt to modify the index at a given index in a list
modifyNth
:: Int
-- ^ The index
-> (a -> a)
-- ^ The modification function
-> [a]
-- ^ The list
-> [a]
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
. zip [0..]
-- | Modify a value indexed by a given key in a map using a default
-- initial value if not present
updateMap
:: Ord k
=> k
-- ^ The key
-> a
-- ^ The default initial value
-> (a -> a)
-- ^ The modification function
-> M.Map k a
-- ^ The map
-> M.Map k a
updateMap k def f m = let
x = M.findWithDefault def k m
in M.insert k (f x) m
-- | Selects a section of a list
slice
:: Int
-- ^ The index to start at
-> Int
-- ^ The number of elements to take
-> [a]
-- ^ The list to take a subset of
-> [a]
slice offset len = take len . drop offset

View File

@@ -0,0 +1,291 @@
{-
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.GoalieInputSpec (spec) where
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Actions.GoalieInput
import Mtlstats.Types
import Mtlstats.Util
import qualified TypesSpec as TS
spec :: Spec
spec = describe "Mtlstats.Actions.GoalieInput" $ do
finishGoalieEntrySpec
recordGoalieStatsSpec
setGameGoalieSpec
finishGoalieEntrySpec :: Spec
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
let
progState stats = newProgState
& progMode.gameStateL.gameGoalieStats .~ stats
& finishGoalieEntry
context "no goalie data" $
it "should not set goaliesRecorded" $ let
s = progState M.empty
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
context "goalie data" $
it "should set goaliesRecorded" $ let
s = progState $ M.fromList [(1, newGoalieStats)]
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
recordGoalieStatsSpec :: Spec
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
goalieStats games mins goals = newGoalieStats
& gsGames .~ games
& gsMinsPlayed .~ mins
& gsGoalsAllowed .~ goals
joe = newGoalie 2 "Joe"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
bob = newGoalie 3 "Bob"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
gameState n mins goals = newGameState
& gameGoalieStats .~ M.fromList [(1, goalieStats 1 2 3)]
& gameSelectedGoalie .~ n
& gameGoalieMinsPlayed .~ mins
& gameGoalsAllowed .~ goals
progState n mins goals = newProgState
& database.dbGoalies .~ [joe, bob]
& progMode.gameStateL .~ gameState n mins goals
in mapM_
(\(name, gid, mins, goals, joeData, bobData, reset) -> let
s = recordGoalieStats $ progState gid mins goals
in context name $ do
mapM_
(\( name
, gid
, ( gGames
, gMins
, gGoals
, ytdGames
, ytdMins
, ytdGoals
, ltGames
, ltMins
, ltGoals
)
) -> context name $ do
let
gs = s^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gs
goalie = fromJust $ nth gid $ s^.database.dbGoalies
ytd = goalie^.gYtd
lt = goalie^.gLifetime
context "game" $
game `TS.compareTest` goalieStats gGames gMins gGoals
context "year-to-date" $
ytd `TS.compareTest` goalieStats ytdGames ytdMins ytdGoals
context "lifetime" $
lt `TS.compareTest` goalieStats ltGames ltMins ltGoals)
[ ( "checking Joe", 0, joeData )
, ( "checking Bob", 1, bobData )
]
context "selected goalie" $ let
expected = if reset then Nothing else gid
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameSelectedGoalie) `shouldBe` expected
context "minutes played" $ let
expected = if reset then Nothing else mins
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameGoalieMinsPlayed) `shouldBe` expected
context "goals allowed" $ let
expected = if reset then Nothing else goals
in it ("should be " ++ show expected) $
(s^.progMode.gameStateL.gameGoalsAllowed) `shouldBe` expected)
[ ( "updating Joe"
, Just 0
, Just 1
, Just 2
, (1, 1, 2, 11, 12, 14, 21, 22, 24)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, True
)
, ( "updating Bob"
, Just 1
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 3, 5, 30, 32, 34, 40, 42, 44)
, True
)
, ( "goalie out of bounds"
, Just 2
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing goalie"
, Nothing
, Just 1
, Just 2
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing minutes"
, Just 0
, Nothing
, Just 1
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
, ( "missing goals"
, Just 0
, Just 1
, Nothing
, (0, 0, 0, 10, 11, 12, 20, 21, 22)
, (1, 2, 3, 30, 31, 32, 40, 41, 42)
, False
)
]
setGameGoalieSpec :: Spec
setGameGoalieSpec = describe "setGameGoalie" $ let
goalieStats w l t = newGoalieStats
& gsWins .~ w
& gsLosses .~ l
& gsTies .~ t
bob = newGoalie 2 "Bob"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
joe = newGoalie 3 "Joe"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
gameState h a ot = newGameState
& gameType ?~ HomeGame
& homeScore ?~ h
& awayScore ?~ a
& overtimeFlag ?~ ot
winningGame = gameState 1 0 False
losingGame = gameState 0 1 False
tiedGame = gameState 0 1 True
in mapM_
(\(label, gameState, gid, bobData, joeData) -> context label $ let
progState = newProgState
& database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gameState
& setGameGoalie gid
in mapM_
(\( label
, gid
, ( gWins
, gLosses
, gTies
, ytdWins
, ytdLosses
, ytdTies
, ltWins
, ltLosses
, ltTies
)
) -> context label $ do
let
goalie = (progState^.database.dbGoalies) !! gid
gameStats = progState^.progMode.gameStateL.gameGoalieStats
game = M.findWithDefault newGoalieStats gid gameStats
ytd = goalie^.gYtd
lifetime = goalie^.gLifetime
mapM_
(\(label, expected, actual) -> context label $
expected `TS.compareTest` actual)
[ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
]
it "should set the gameGoalieAssigned flag" $
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
[ ( "checking Bob", 0, bobData )
, ( "checking Joe", 1, joeData )
])
[ ( "Bob wins"
, winningGame
, 0
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob loses"
, losingGame
, 0
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob ties"
, tiedGame
, 0
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Joe wins"
, winningGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
)
, ( "Joe loses"
, losingGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
)
, ( "Joe ties"
, tiedGame
, 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
)
]

View File

@@ -19,16 +19,32 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE LambdaCase #-}
module ActionsSpec (spec) where module ActionsSpec (spec) where
import Control.Monad (replicateM) import Control.Monad (replicateM)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromJust)
import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro ((^.), (&), (.~), (?~), (%~))
import System.Random (randomRIO) import System.Random (randomRIO)
import Test.Hspec (Spec, context, describe, it, runIO, shouldBe, shouldNotBe) import Test.Hspec
( Spec
, context
, describe
, it
, runIO
, shouldBe
, shouldNotBe
, shouldSatisfy
)
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util
import qualified Actions.GoalieInputSpec as GoalieInput
import qualified TypesSpec as TS
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Actions" $ do spec = describe "Mtlstats.Actions" $ do
@@ -41,11 +57,21 @@ spec = describe "Mtlstats.Actions" $ do
updateGameStatsSpec updateGameStatsSpec
validateGameDateSpec validateGameDateSpec
createPlayerSpec createPlayerSpec
createGoalieSpec
editPlayerSpec
addPlayerSpec addPlayerSpec
addGoalieSpec
resetCreatePlayerStateSpec
resetCreateGoalieStateSpec
recordGoalAssistsSpec recordGoalAssistsSpec
awardGoalSpec awardGoalSpec
awardAssistSpec awardAssistSpec
resetGoalDataSpec resetGoalDataSpec
assignPMinsSpec
backHomeSpec
scrollUpSpec
scrollDownSpec
GoalieInput.spec
startNewSeasonSpec :: Spec startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do startNewSeasonSpec = describe "startNewSeason" $ do
@@ -100,14 +126,12 @@ resetYtdSpec = describe "resetYtd" $
ytd ^. gsGames `shouldBe` 0 ytd ^. gsGames `shouldBe` 0
ytd ^. gsMinsPlayed `shouldBe` 0 ytd ^. gsMinsPlayed `shouldBe` 0
ytd ^. gsGoalsAllowed `shouldBe` 0 ytd ^. gsGoalsAllowed `shouldBe` 0
ytd ^. gsGoalsAgainst `shouldBe` 0
ytd ^. gsWins `shouldBe` 0 ytd ^. gsWins `shouldBe` 0
ytd ^. gsLosses `shouldBe` 0 ytd ^. gsLosses `shouldBe` 0
ytd ^. gsTies `shouldBe` 0 ytd ^. gsTies `shouldBe` 0
lt ^. gsGames `shouldNotBe` 0 lt ^. gsGames `shouldNotBe` 0
lt ^. gsMinsPlayed `shouldNotBe` 0 lt ^. gsMinsPlayed `shouldNotBe` 0
lt ^. gsGoalsAllowed `shouldNotBe` 0 lt ^. gsGoalsAllowed `shouldNotBe` 0
lt ^. gsGoalsAgainst `shouldNotBe` 0
lt ^. gsWins `shouldNotBe` 0 lt ^. gsWins `shouldNotBe` 0
lt ^. gsLosses `shouldNotBe` 0 lt ^. gsLosses `shouldNotBe` 0
lt ^. gsTies `shouldNotBe` 0) $ lt ^. gsTies `shouldNotBe` 0) $
@@ -338,6 +362,18 @@ createPlayerSpec = describe "createPlayer" $
s = createPlayer newProgState s = createPlayer newProgState
in show (s^.progMode) `shouldBe` "CreatePlayer" in show (s^.progMode) `shouldBe` "CreatePlayer"
createGoalieSpec :: Spec
createGoalieSpec = describe "createGoalie" $
it "should change the mode appropriately" $ let
s = createGoalie newProgState
in show (s^.progMode) `shouldBe` "CreateGoalie"
editPlayerSpec :: Spec
editPlayerSpec = describe "editPlayer" $
it "should change the mode appropriately" $ let
s = editPlayer newProgState
in show (s^.progMode) `shouldBe` "EditPlayer"
addPlayerSpec :: Spec addPlayerSpec :: Spec
addPlayerSpec = describe "addPlayer" $ do addPlayerSpec = describe "addPlayer" $ do
let let
@@ -362,6 +398,48 @@ addPlayerSpec = describe "addPlayer" $ do
s' = addPlayer $ s MainMenu s' = addPlayer $ s MainMenu
in s'^.database.dbPlayers `shouldBe` [p1] in s'^.database.dbPlayers `shouldBe` [p1]
addGoalieSpec :: Spec
addGoalieSpec = describe "addGoalie" $ do
let
g1 = newGoalie 2 "Joe"
g2 = newGoalie 3 "Bob"
db = newDatabase
& dbGoalies .~ [g1]
s pm = newProgState
& database .~ db
& progMode .~ pm
context "data available" $
it "should create the goalie" $ let
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
& cgsNumber ?~ 3
& cgsName .~ "Bob"
in s'^.database.dbGoalies `shouldBe` [g1, g2]
context "data unavailable" $
it "should not create the goalie" $ let
s' = addGoalie $ s MainMenu
in s'^.database.dbGoalies `shouldBe` [g1]
resetCreatePlayerStateSpec :: Spec
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
cps = newCreatePlayerState
& cpsNumber ?~ 1
& cpsName .~ "Joe"
& cpsPosition .~ "centre"
ps = resetCreatePlayerState $
newProgState & progMode.createPlayerStateL .~ cps
in TS.compareTest (ps^.progMode.createPlayerStateL) newCreatePlayerState
resetCreateGoalieStateSpec :: Spec
resetCreateGoalieStateSpec = describe "resetCreateGoalieState" $ let
cgs = newCreateGoalieState
& cgsNumber ?~ 1
& cgsName .~ "Joe"
ps = resetCreateGoalieState $
newProgState & progMode.createGoalieStateL .~ cgs
in TS.compareTest (ps^.progMode.createGoalieStateL) newCreateGoalieState
recordGoalAssistsSpec :: Spec recordGoalAssistsSpec :: Spec
recordGoalAssistsSpec = describe "recordGoalAssists" $ do recordGoalAssistsSpec = describe "recordGoalAssists" $ do
let let
@@ -545,6 +623,62 @@ resetGoalDataSpec = describe "resetGoalData" $ do
it "should clear confirmGoalDataFlag" $ it "should clear confirmGoalDataFlag" $
ps^.progMode.gameStateL.confirmGoalDataFlag `shouldBe` False 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 :: IO Player
makePlayer = Player makePlayer = Player
<$> makeNum <$> makeNum
@@ -574,10 +708,55 @@ makeGoalieStats = GoalieStats
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum
makeNum :: IO Int makeNum :: IO Int
makeNum = randomRIO (1, 10) makeNum = randomRIO (1, 10)
makeName :: IO String makeName :: IO String
makeName = replicateM 10 $ randomRIO ('A', 'Z') makeName = replicateM 10 $ randomRIO ('A', 'Z')
backHomeSpec :: Spec
backHomeSpec = describe "backHome" $ do
let
input = newProgState
& progMode.gameStateL .~ newGameState
& inputBuffer .~ "foo"
& scrollOffset .~ 123
result = backHome input
it "should set the program mode back to MainMenu" $
result^.progMode `shouldSatisfy` \case
MainMenu -> True
_ -> False
it "should clear the input buffer" $
result^.inputBuffer `shouldBe` ""
it "should reset the scroll offset" $
result^.scrollOffset `shouldBe` 0
scrollUpSpec :: Spec
scrollUpSpec = describe "scrollUp" $ do
context "scrolled down" $
it "should decrease the scroll offset by one" $ let
ps = newProgState & scrollOffset .~ 10
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 9
context "at top" $
it "should keep the scroll offset at zero" $ let
ps = scrollUp newProgState
in ps^.scrollOffset `shouldBe` 0
context "above top" $
it "should return the scroll offset to zero" $ let
ps = newProgState & scrollOffset .~ (-10)
ps' = scrollUp ps
in ps'^.scrollOffset `shouldBe` 0
scrollDownSpec = describe "scrollDown" $
it "should increase the scroll offset" $ let
ps = newProgState & scrollOffset .~ 10
ps' = scrollDown ps
in ps'^.scrollOffset `shouldBe` 11

View File

@@ -28,8 +28,9 @@ import Mtlstats.Report
import Mtlstats.Types import Mtlstats.Types
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Report" spec = describe "Mtlstats.Report" $ do
gameDateSpec gameDateSpec
playerNameColWidthSpec
gameDateSpec :: Spec gameDateSpec :: Spec
gameDateSpec = describe "gameDate" $ do gameDateSpec = describe "gameDate" $ do
@@ -45,3 +46,20 @@ gameDateSpec = describe "gameDate" $ do
context "invalid date" $ context "invalid date" $
it "should return an empty string" $ it "should return an empty string" $
gameDate newGameState `shouldBe` "" gameDate newGameState `shouldBe` ""
playerNameColWidthSpec :: Spec
playerNameColWidthSpec = describe "playerNameColWidth" $ do
let
short1 = newPlayer 1 "short" "foo"
short2 = newPlayer 2 "shorty" "bar"
long = newPlayer 3 "123456789012345" "baz"
mapM_
(\(label, players, expected) -> context label $
it ("should be " ++ show expected) $
playerNameColWidth players `shouldBe` expected)
-- label, players, expected
[ ( "empty list", [], 10 )
, ( "short names", [short1, short2], 10 )
, ( "long name", [short1, long], 16 )
]

View File

@@ -21,7 +21,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings, RankNTypes #-} {-# LANGUAGE OverloadedStrings, RankNTypes #-}
module TypesSpec (spec) where module TypesSpec (Comparable (..), spec) where
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))
@@ -35,6 +35,9 @@ import Mtlstats.Types
import qualified Types.MenuSpec as Menu import qualified Types.MenuSpec as Menu
class Comparable a where
compareTest :: a -> a -> Spec
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Types" $ do spec = describe "Mtlstats.Types" $ do
playerSpec playerSpec
@@ -43,6 +46,8 @@ spec = describe "Mtlstats.Types" $ do
databaseSpec databaseSpec
gameStateLSpec gameStateLSpec
createPlayerStateLSpec createPlayerStateLSpec
createGoalieStateLSpec
editPlayerStateLSpec
teamScoreSpec teamScoreSpec
otherScoreSpec otherScoreSpec
homeTeamSpec homeTeamSpec
@@ -54,11 +59,17 @@ spec = describe "Mtlstats.Types" $ do
gmsGamesSpec gmsGamesSpec
gmsPointsSpec gmsPointsSpec
addGameStatsSpec addGameStatsSpec
pPointsSpec
playerSearchSpec playerSearchSpec
playerSearchExactSpec playerSearchExactSpec
modifyPlayerSpec modifyPlayerSpec
playerSummarySpec playerSummarySpec
playerDetailsSpec
playerIsActiveSpec
psPointsSpec
addPlayerStatsSpec
goalieSearchSpec
goalieSearchExactSpec
goalieSummarySpec
Menu.spec Menu.spec
playerSpec :: Spec playerSpec :: Spec
@@ -77,43 +88,78 @@ databaseSpec = describe "Database" $ jsonSpec db dbJSON
gameStateLSpec :: Spec gameStateLSpec :: Spec
gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL gameStateLSpec = describe "gameStateL" $ lensSpec gameStateL
-- getters -- getters
[ ( MainMenu, newGameState ) [ ( "missing state", MainMenu, newGameState )
, ( NewGame $ gs HomeGame, gs HomeGame ) , ( "home game", NewGame $ gs HomeGame, gs HomeGame )
, ( "away game", NewGame $ gs AwayGame, gs AwayGame )
] ]
-- setters -- setters
[ ( MainMenu, gs HomeGame ) [ ( "set home", MainMenu, gs HomeGame )
, ( NewGame $ gs HomeGame, gs AwayGame ) , ( "home to away", NewGame $ gs HomeGame, gs AwayGame )
, ( NewGame $ gs HomeGame, newGameState ) , ( "away to home", NewGame $ gs AwayGame, gs HomeGame )
, ( "clear home", NewGame $ gs HomeGame, newGameState )
, ( "clear away", NewGame $ gs AwayGame, newGameState )
] ]
where gs t = newGameState & gameType ?~ t where gs t = newGameState & gameType ?~ t
createPlayerStateLSpec :: Spec createPlayerStateLSpec :: Spec
createPlayerStateLSpec = describe "createPlayerStateL" $ do createPlayerStateLSpec = describe "createPlayerStateL" $
context "getters" $ do lensSpec createPlayerStateL
context "state missing" $ let -- getters
pm = MainMenu [ ( "missing state", MainMenu, newCreatePlayerState )
cps = pm^.createPlayerStateL , ( "with state", CreatePlayer cps1, cps1 )
in it "should not have a number" $ ]
cps^.cpsNumber `shouldBe` Nothing -- setters
[ ( "missing state", MainMenu, cps1 )
, ( "change state", CreatePlayer cps1, cps2 )
, ( "clear state", CreatePlayer cps1, newCreatePlayerState )
]
where
cps1 = newCreatePlayerState
& cpsNumber ?~ 1
& cpsName .~ "Joe"
& cpsPosition .~ "centre"
cps2 = newCreatePlayerState
& cpsNumber ?~ 2
& cpsName .~ "Bob"
& cpsPosition .~ "defense"
context "existing state" $ let createGoalieStateLSpec :: Spec
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 createGoalieStateLSpec = describe "createGoalieStateL" $
cps = pm^.createPlayerStateL lensSpec createGoalieStateL
in it "should have a number of 1" $ -- getters
cps^.cpsNumber `shouldBe` Just 1 [ ( "missing state", MainMenu, newCreateGoalieState )
, ( "with state", CreateGoalie cgs1, cgs1 )
]
-- setters
[ ( "set state", MainMenu, cgs1 )
, ( "change state", CreateGoalie cgs1, cgs2 )
, ( "clear state", CreateGoalie cgs1, newCreateGoalieState )
]
where
cgs1 = newCreateGoalieState
& cgsNumber ?~ 1
& cgsName .~ "Joe"
cgs2 = newCreateGoalieState
& cgsNumber ?~ 2
& cgsName .~ "Bob"
context "setters" $ do editPlayerStateLSpec :: Spec
context "state missing" $ let editPlayerStateLSpec = describe "editPlayerStateL" $
pm = MainMenu lensSpec editPlayerStateL
pm' = pm & createPlayerStateL.cpsNumber ?~ 1 -- getters
in it "should set the player number to 1" $ [ ( "missing state", MainMenu, newEditPlayerState )
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 1 , ( "withState", EditPlayer eps1, eps1 )
]
context "existing state" $ let -- setters
pm = CreatePlayer $ newCreatePlayerState & cpsNumber ?~ 1 [ ( "set state", MainMenu, eps1 )
pm' = pm & createPlayerStateL.cpsNumber ?~ 2 , ( "change state", EditPlayer eps1, eps2 )
in it "should set the player number to 2" $ , ( "clear state", EditPlayer eps1, newEditPlayerState )
pm'^.createPlayerStateL.cpsNumber `shouldBe` Just 2 ]
where
eps1 = newEditPlayerState
& epsSelectedPlayer ?~ 1
eps2 = newEditPlayerState
& epsSelectedPlayer ?~ 2
teamScoreSpec :: Spec teamScoreSpec :: Spec
teamScoreSpec = describe "teamScore" $ do teamScoreSpec = describe "teamScore" $ do
@@ -175,24 +221,23 @@ jsonSpec x j = do
decode (encode x) `shouldBe` Just x decode (encode x) `shouldBe` Just x
lensSpec lensSpec
:: (Eq a, Show s, Show a) :: Comparable a
=> Lens' s a => Lens' s a
-> [(s, a)] -> [(String, s, a)]
-> [(s, a)] -> [(String, s, a)]
-> Spec -> Spec
lensSpec l gs ss = do lensSpec lens getters setters = do
context "getters" $ mapM_ context "getters" $ mapM_
(\(s, x) -> context (show s) $ (\(label, s, x) -> context label $
it ("should be " ++ show x) $ compareTest (s^.lens) x)
s ^. l `shouldBe` x) getters
gs
context "setters" $ mapM_ context "setters" $ mapM_
(\(s, x) -> context (show s) $ (\(label, s, x) -> context label $ let
it ("should set to " ++ show x) $ s' = s & lens .~ x
(s & l .~ x) ^. l `shouldBe` x) in compareTest (s'^.lens) x)
ss setters
player :: Player player :: Player
player = newPlayer 1 "Joe" "centre" player = newPlayer 1 "Joe" "centre"
@@ -239,20 +284,18 @@ goalieStats n = newGoalieStats
& gsGames .~ n & gsGames .~ n
& gsMinsPlayed .~ n + 1 & gsMinsPlayed .~ n + 1
& gsGoalsAllowed .~ n + 2 & gsGoalsAllowed .~ n + 2
& gsGoalsAgainst .~ n + 3 & gsWins .~ n + 3
& gsWins .~ n + 4 & gsLosses .~ n + 4
& gsLosses .~ n + 5 & gsTies .~ n + 5
& gsTies .~ n + 6
goalieStatsJSON :: Int -> Value goalieStatsJSON :: Int -> Value
goalieStatsJSON n = Object $ HM.fromList goalieStatsJSON n = Object $ HM.fromList
[ ( "games", toJSON n ) [ ( "games", toJSON n )
, ( "mins_played", toJSON $ n + 1 ) , ( "mins_played", toJSON $ n + 1 )
, ( "goals_allowed", toJSON $ n + 2 ) , ( "goals_allowed", toJSON $ n + 2 )
, ( "goals_against", toJSON $ n + 3 ) , ( "wins", toJSON $ n + 3 )
, ( "wins", toJSON $ n + 4 ) , ( "losses", toJSON $ n + 4 )
, ( "losses", toJSON $ n + 5 ) , ( "ties", toJSON $ n + 5 )
, ( "ties", toJSON $ n + 6 )
] ]
gameStats :: Int -> GameStats gameStats :: Int -> GameStats
@@ -509,24 +552,6 @@ addGameStatsSpec = describe "addGameStats" $
in addGameStats s1 s2 `shouldBe` expected in addGameStats s1 s2 `shouldBe` expected
pPointsSpec :: Spec
pPointsSpec = describe "pPoints" $ mapM_
(\(goals, assists, points) -> let
desc = "goals: " ++ show goals ++
", assists: " ++ show assists
stats = newPlayerStats &
psGoals .~ goals &
psAssists .~ assists
in context desc $
it ("should be " ++ show points) $
pPoints stats `shouldBe` points)
-- goals, assists, points
[ ( 0, 0, 0 )
, ( 1, 0, 1 )
, ( 0, 1, 1 )
, ( 2, 3, 5 )
]
playerSearchSpec :: Spec playerSearchSpec :: Spec
playerSearchSpec = describe "playerSearch" $ mapM_ playerSearchSpec = describe "playerSearch" $ mapM_
(\(sStr, expected) -> context sStr $ (\(sStr, expected) -> context sStr $
@@ -584,6 +609,152 @@ playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $ it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center" playerSummary joe `shouldBe` "Joe (2) center"
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
player = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Position: centre"
, " YTD goals: 2"
, " YTD assists: 3"
, " YTD penalty mins: 4"
, " Lifetime goals: 5"
, " Lifetime assists: 6"
, "Lifetime penalty mins: 7"
]
in playerDetails player `shouldBe` expected
playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do
let
pState = newPlayerStats
& psGoals .~ 10
& psAssists .~ 11
& psPMin .~ 12
player = newPlayer 1 "Joe" "centre" & pLifetime .~ pState
mapM_
(\(label, player', expected) -> context label $
it ("should be " ++ show expected) $
playerIsActive player' `shouldBe` expected)
-- label, player, expected
[ ( "not active", player, False )
, ( "has goal", player & pYtd.psGoals .~ 1, True )
, ( "has assist", player & pYtd.psAssists .~ 1, True )
, ( "has penalty minute", player & pYtd.psPMin .~ 1, True )
]
psPointsSpec :: Spec
psPointsSpec = describe "psPoints" $ mapM_
(\(goals, assists, points) -> let
desc = "goals: " ++ show goals ++
", assists: " ++ show assists
stats = newPlayerStats &
psGoals .~ goals &
psAssists .~ assists
in context desc $
it ("should be " ++ show points) $
psPoints stats `shouldBe` points)
-- goals, assists, points
[ ( 0, 0, 0 )
, ( 1, 0, 1 )
, ( 0, 1, 1 )
, ( 2, 3, 5 )
]
addPlayerStatsSpec :: Spec
addPlayerStatsSpec = describe "addPlayerStats" $ do
let
s1
= newPlayerStats
& psGoals .~ 1
& psAssists .~ 2
& psPMin .~ 3
s2
= newPlayerStats
& psGoals .~ 4
& psAssists .~ 5
& psPMin .~ 6
s3 = addPlayerStats s1 s2
describe "psGoals" $
it "should be 5" $
s3^.psGoals `shouldBe` 5
describe "psAssists" $
it "should be 7" $
s3^.psAssists `shouldBe` 7
describe "psPMin" $
it "should be 9" $
s3^.psPMin `shouldBe` 9
goalieSearchSpec :: Spec
goalieSearchSpec = describe "goalieSearch" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
context "partial match" $
it "should return Joe and Steve" $
goalieSearch "e" goalies `shouldBe` [result 0, result 2]
context "no match" $
it "should return an empty list" $
goalieSearch "x" goalies `shouldBe` []
context "exact match" $
it "should return Steve" $
goalieSearch "Bob" goalies `shouldBe` [result 1]
goalieSearchExactSpec :: Spec
goalieSearchExactSpec = describe "goalieSearchExact" $ do
let
goalies =
[ newGoalie 2 "Joe"
, newGoalie 3 "Bob"
, newGoalie 5 "Steve"
]
result n = (n, goalies!!n)
mapM_
(\(name, num) -> context name $
it ("should return " ++ name) $
goalieSearchExact name goalies `shouldBe` Just (result num))
-- name, num
[ ( "Joe", 0 )
, ( "Bob", 1 )
, ( "Steve", 2 )
]
context "Greg" $
it "should return Nothing" $
goalieSearchExact "Greg" goalies `shouldBe` Nothing
goalieSummarySpec :: Spec
goalieSummarySpec = describe "goalieSummary" $
it "should provide a summary string" $
goalieSummary (newGoalie 2 "Joe") `shouldBe` "Joe (2)"
joe :: Player joe :: Player
joe = newPlayer 2 "Joe" "center" joe = newPlayer 2 "Joe" "center"
@@ -592,3 +763,59 @@ bob = newPlayer 3 "Bob" "defense"
steve :: Player steve :: Player
steve = newPlayer 5 "Steve" "forward" steve = newPlayer 5 "Steve" "forward"
instance Comparable GoalieStats where
compareTest actual expected = mapM_
(\(name, lens) -> describe name $
it ("should be " ++ show (expected^.lens)) $
actual^.lens `shouldBe` expected^.lens)
-- name, lens
[ ( "gsGames", gsGames )
, ( "gsMinsPlayed", gsMinsPlayed )
, ( "gsGoalsAllowed", gsGoalsAllowed )
, ( "gsWins", gsWins )
, ( "gsLosses", gsLosses )
, ( "gsTies", gsTies )
]
instance Comparable GameState where
compareTest actual expected =
it ("should be " ++ show expected) $
actual `shouldBe` expected
instance Comparable CreatePlayerState where
compareTest actual expected = do
describe "cpsNumber" $
it ("should be " ++ show (expected^.cpsNumber)) $
actual^.cpsNumber `shouldBe` expected^.cpsNumber
describe "cpsName" $
it ("should be " ++ expected^.cpsName) $
actual^.cpsName `shouldBe` expected^.cpsName
describe "cpsPosition" $
it ("should be " ++ expected^.cpsPosition) $
actual^.cpsPosition `shouldBe` expected^.cpsPosition
instance Comparable EditPlayerState where
compareTest actual expected = do
describe "epsSelectedPlayer" $
it ("should be " ++ show (expected^.epsSelectedPlayer)) $
actual^.epsSelectedPlayer `shouldBe` expected^.epsSelectedPlayer
describe "epsMode" $
it ("should be " ++ show (expected^.epsMode)) $
actual^.epsMode `shouldBe` expected^.epsMode
instance Comparable CreateGoalieState where
compareTest actual expected = do
describe "cgsNuber" $
it("should be " ++ show (expected^.cgsNumber)) $
actual^.cgsNumber `shouldBe` expected^.cgsNumber
describe "cgsName" $
it ("should be " ++ expected^.cgsName) $
actual^.cgsName `shouldBe` expected^.cgsName

View File

@@ -21,13 +21,17 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
module UtilSpec (spec) where module UtilSpec (spec) where
import qualified Data.Map as M
import Test.Hspec (Spec, context, describe, it, shouldBe) import Test.Hspec (Spec, context, describe, it, shouldBe)
import Mtlstats.Util import Mtlstats.Util
spec :: Spec spec :: Spec
spec = describe "Mtlstats.Util" spec = describe "Mtlstats.Util" $ do
nthSpec nthSpec
modifyNthSpec
updateMapSpec
sliceSpec
nthSpec :: Spec nthSpec :: Spec
nthSpec = describe "nth" $ mapM_ nthSpec = describe "nth" $ mapM_
@@ -42,3 +46,49 @@ nthSpec = describe "nth" $ mapM_
, ( 3, Nothing ) , ( 3, Nothing )
, ( -1, Nothing ) , ( -1, Nothing )
] ]
modifyNthSpec :: Spec
modifyNthSpec = describe "modifyNth" $ do
context "in bounds" $
it "should modify the value" $
modifyNth 1 succ [1, 2, 3] `shouldBe` [1, 3, 3]
context "out of bounds" $
it "should not modify the value" $
modifyNth 3 succ [1, 2, 3] `shouldBe` [1, 2, 3]
context "negative index" $
it "should not modify the value" $
modifyNth (-1) succ [1, 2, 3] `shouldBe` [1, 2, 3]
updateMapSpec :: Spec
updateMapSpec = describe "updateMap" $ do
let
input = M.fromList [(1, 2), (3, 5)]
context "key found" $ let
expected = M.fromList [(1, 3), (3, 5)]
in it "should update the value" $
updateMap 1 10 succ input `shouldBe` expected
context "key not found" $ let
expected = M.fromList [(1, 2), (3, 5), (10, 11)]
in it "should create a new value and update the default" $
updateMap 10 10 succ input `shouldBe` expected
sliceSpec :: Spec
sliceSpec = describe "slice" $ do
let list = [2, 4, 6, 8]
context "sublist" $
it "should return the sublist" $
slice 1 2 list `shouldBe` [4, 6]
context "too large" $
it "should return as much of the list as possible" $
slice 1 100 list `shouldBe` [4, 6, 8]
context "negative offset" $
it "should return the correct number of elements from the beginning" $
slice (-10) 2 list `shouldBe` [2, 4]