81 Commits
0.4.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
16 changed files with 1562 additions and 156 deletions

View File

@@ -1,5 +1,11 @@
# 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 ## v0.4.0
- Record penalty minutes - Record penalty minutes

View File

@@ -1,5 +1,5 @@
name: mtlstats name: mtlstats
version: 0.4.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,7 +31,12 @@ module Mtlstats.Actions
, updateGameStats , updateGameStats
, validateGameDate , validateGameDate
, createPlayer , createPlayer
, createGoalie
, editPlayer
, addPlayer , addPlayer
, addGoalie
, resetCreatePlayerState
, resetCreateGoalieState
, recordGoalAssists , recordGoalAssists
, awardGoal , awardGoal
, awardAssist , awardAssist
@@ -139,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
@@ -158,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
@@ -223,7 +264,7 @@ assignPMins
-> ProgState -> ProgState
-> ProgState -> ProgState
assignPMins mins s = fromMaybe s $ do assignPMins mins s = fromMaybe s $ do
n <- s^.progMode.gameStateL.selectedPlayer n <- s^.progMode.gameStateL.gameSelectedPlayer
Just $ s Just $ s
& database.dbPlayers %~ modifyNth n & database.dbPlayers %~ modifyNth n
(((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins)) (((pYtd.psPMin) +~ mins) . ((pLifetime.psPMin) +~ mins))
@@ -231,7 +272,7 @@ assignPMins mins s = fromMaybe s $ do
%~ ( gamePlayerStats %~ updateMap n newPlayerStats %~ ( gamePlayerStats %~ updateMap n newPlayerStats
(psPMin +~ mins) (psPMin +~ mins)
) )
. (selectedPlayer .~ Nothing) . (gameSelectedPlayer .~ Nothing)
-- | Resets the program state back to the main menu -- | Resets the program state back to the main menu
backHome :: ProgState -> ProgState backHome :: ProgState -> ProgState

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,6 +22,7 @@ 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, fromMaybe, isJust) import Data.Maybe (fromJust, fromMaybe, isJust)
@@ -30,6 +31,8 @@ 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,14 +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^.selectedPlayer -> getPMinsC | isJust $ gs^.gameSelectedPlayer -> getPMinsC
| not $ gs^.pMinsRecorded -> pMinPlayerC | 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
@@ -258,7 +267,7 @@ getPMinsC = Controller
{ drawController = \s -> do { drawController = \s -> do
header s header s
C.drawString $ fromMaybe "" $ do C.drawString $ fromMaybe "" $ do
pid <- s^.progMode.gameStateL.selectedPlayer pid <- s^.progMode.gameStateL.gameSelectedPlayer
player <- nth pid $ s^.database.dbPlayers player <- nth pid $ s^.database.dbPlayers
Just $ playerSummary player ++ "\n" Just $ playerSummary player ++ "\n"
drawPrompt assignPMinsPrompt s drawPrompt assignPMinsPrompt s
@@ -335,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,17 +39,23 @@ module Mtlstats.Prompt (
playerNumPrompt, playerNumPrompt,
playerNamePrompt, playerNamePrompt,
playerPosPrompt, playerPosPrompt,
goalieNumPrompt,
goalieNamePrompt,
selectPlayerPrompt, selectPlayerPrompt,
selectGoaliePrompt,
recordGoalPrompt, recordGoalPrompt,
recordAssistPrompt, recordAssistPrompt,
pMinPlayerPrompt, pMinPlayerPrompt,
assignPMinsPrompt 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)
@@ -80,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
@@ -108,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: " $
@@ -148,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
@@ -156,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
@@ -236,16 +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 :: Prompt
pMinPlayerPrompt = selectPlayerPrompt pMinPlayerPrompt = selectPlayerPrompt
"Assign penalty minutes to: " $ "Assign penalty minutes to: " $
\case \case
Nothing -> modify $ progMode.gameStateL.pMinsRecorded .~ True Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
Just n -> modify $ progMode.gameStateL.selectedPlayer ?~ n Just n -> modify $ progMode.gameStateL.gameSelectedPlayer ?~ n
-- | Prompts for the number of penalty mintues to assign to the player
assignPMinsPrompt :: Prompt assignPMinsPrompt :: Prompt
assignPMinsPrompt = numPrompt "Penalty minutes: " $ assignPMinsPrompt = numPrompt "Penalty minutes: " $
modify . assignPMins 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

@@ -30,6 +30,9 @@ module Mtlstats.Types (
GameState (..), GameState (..),
GameType (..), GameType (..),
CreatePlayerState (..), CreatePlayerState (..),
CreateGoalieState (..),
EditPlayerState (..),
EditPlayerMode (..),
Database (..), Database (..),
Player (..), Player (..),
PlayerStats (..), PlayerStats (..),
@@ -37,6 +40,7 @@ module Mtlstats.Types (
GoalieStats (..), GoalieStats (..),
GameStats (..), GameStats (..),
Prompt (..), Prompt (..),
SelectParams (..),
-- * Lenses -- * Lenses
-- ** ProgState Lenses -- ** ProgState Lenses
database, database,
@@ -46,6 +50,8 @@ module Mtlstats.Types (
-- ** ProgMode Lenses -- ** ProgMode Lenses
gameStateL, gameStateL,
createPlayerStateL, createPlayerStateL,
createGoalieStateL,
editPlayerStateL,
-- ** GameState Lenses -- ** GameState Lenses
gameYear, gameYear,
gameMonth, gameMonth,
@@ -61,14 +67,28 @@ module Mtlstats.Types (
assistsBy, assistsBy,
gamePlayerStats, gamePlayerStats,
confirmGoalDataFlag, confirmGoalDataFlag,
selectedPlayer, gameSelectedPlayer,
pMinsRecorded, 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,
@@ -94,7 +114,6 @@ module Mtlstats.Types (
gsGames, gsGames,
gsMinsPlayed, gsMinsPlayed,
gsGoalsAllowed, gsGoalsAllowed,
gsGoalsAgainst,
gsWins, gsWins,
gsLosses, gsLosses,
gsTies, gsTies,
@@ -108,6 +127,8 @@ module Mtlstats.Types (
newProgState, newProgState,
newGameState, newGameState,
newCreatePlayerState, newCreatePlayerState,
newCreateGoalieState,
newEditPlayerState,
newDatabase, newDatabase,
newPlayer, newPlayer,
newPlayerStats, newPlayerStats,
@@ -133,10 +154,15 @@ module Mtlstats.Types (
playerSearchExact, playerSearchExact,
modifyPlayer, modifyPlayer,
playerSummary, playerSummary,
playerDetails,
playerIsActive, playerIsActive,
-- ** PlayerStats Helpers -- ** PlayerStats Helpers
psPoints, psPoints,
addPlayerStats addPlayerStats,
-- ** Goalie Helpers
goalieSearch,
goalieSearchExact,
goalieSummary
) where ) where
import Control.Monad.Trans.State (StateT) import Control.Monad.Trans.State (StateT)
@@ -190,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
@@ -229,10 +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
, _selectedPlayer :: Maybe Int , _gameSelectedPlayer :: Maybe Int
-- ^ Index number of the selected 'Player' -- ^ Index number of the selected 'Player'
, _pMinsRecorded :: Bool , _gamePMinsRecorded :: Bool
-- ^ Set when the penalty mintes have been recorded -- ^ 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
@@ -255,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]
@@ -396,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
@@ -411,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
@@ -475,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 ()
@@ -484,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
@@ -508,6 +602,20 @@ 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
@@ -534,8 +642,14 @@ newGameState = GameState
, _assistsBy = [] , _assistsBy = []
, _gamePlayerStats = M.empty , _gamePlayerStats = M.empty
, _confirmGoalDataFlag = False , _confirmGoalDataFlag = False
, _selectedPlayer = Nothing , _gameSelectedPlayer = Nothing
, _pMinsRecorded = False , _gamePMinsRecorded = False
, _gameGoalieStats = M.empty
, _gameSelectedGoalie = Nothing
, _gameGoalieMinsPlayed = Nothing
, _gameGoalsAllowed = Nothing
, _gameGoaliesRecorded = False
, _gameGoalieAssigned = False
} }
-- | Constructor for a 'CreatePlayerState' -- | Constructor for a 'CreatePlayerState'
@@ -548,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
@@ -603,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
@@ -737,6 +866,20 @@ playerSummary :: Player -> String
playerSummary p = playerSummary p =
p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition p^.pName ++ " (" ++ show (p^.pNumber) ++ ") " ++ p^.pPosition
-- | Provides a detailed string describing a 'Player'
playerDetails :: Player -> String
playerDetails p = unlines
[ " Number: " ++ show (p^.pNumber)
, " Name: " ++ p^.pName
, " Position: " ++ p^.pPosition
, " YTD goals: " ++ show (p^.pYtd.psGoals)
, " YTD assists: " ++ show (p^.pYtd.psAssists)
, " YTD penalty mins: " ++ show (p^.pYtd.psPMin)
, " Lifetime goals: " ++ show (p^.pLifetime.psGoals)
, " Lifetime assists: " ++ show (p^.pLifetime.psAssists)
, "Lifetime penalty mins: " ++ show (p^.pLifetime.psPMin)
]
-- | Determines whether or not a player has been active in the current -- | Determines whether or not a player has been active in the current
-- season/year -- season/year
playerIsActive :: Player -> Bool playerIsActive :: Player -> Bool
@@ -757,3 +900,33 @@ addPlayerStats s1 s2 = newPlayerStats
& psGoals .~ s1^.psGoals + s2^.psGoals & psGoals .~ s1^.psGoals + s2^.psGoals
& psAssists .~ s1^.psAssists + s2^.psAssists & psAssists .~ s1^.psAssists + s2^.psAssists
& psPMin .~ s1^.psPMin + s2^.psPMin & 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

@@ -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

@@ -43,6 +43,9 @@ import Mtlstats.Actions
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Util 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
startNewSeasonSpec startNewSeasonSpec
@@ -54,7 +57,12 @@ spec = describe "Mtlstats.Actions" $ do
updateGameStatsSpec updateGameStatsSpec
validateGameDateSpec validateGameDateSpec
createPlayerSpec createPlayerSpec
createGoalieSpec
editPlayerSpec
addPlayerSpec addPlayerSpec
addGoalieSpec
resetCreatePlayerStateSpec
resetCreateGoalieStateSpec
recordGoalAssistsSpec recordGoalAssistsSpec
awardGoalSpec awardGoalSpec
awardAssistSpec awardAssistSpec
@@ -63,6 +71,7 @@ spec = describe "Mtlstats.Actions" $ do
backHomeSpec backHomeSpec
scrollUpSpec scrollUpSpec
scrollDownSpec scrollDownSpec
GoalieInput.spec
startNewSeasonSpec :: Spec startNewSeasonSpec :: Spec
startNewSeasonSpec = describe "startNewSeason" $ do startNewSeasonSpec = describe "startNewSeason" $ do
@@ -117,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) $
@@ -355,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
@@ -379,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
@@ -577,7 +638,7 @@ assignPMinsSpec = describe "assignPMins" $ let
& database.dbPlayers .~ [bob, joe] & database.dbPlayers .~ [bob, joe]
& progMode.gameStateL & progMode.gameStateL
%~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)]) %~ (gamePlayerStats .~ M.fromList [(0, newPlayerStats & psPMin .~ 2)])
. (selectedPlayer .~ pid) . (gameSelectedPlayer .~ pid)
in mapM_ in mapM_
(\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) -> (\(pid, bobLt, bobYtd, bobGame, joeLt, joeYtd, joeGame) ->
@@ -609,7 +670,7 @@ assignPMinsSpec = describe "assignPMins" $ let
] ]
it "should set selectedPlayer to Nothing" $ it "should set selectedPlayer to Nothing" $
ps'^.progMode.gameStateL.selectedPlayer `shouldBe` Nothing) ps'^.progMode.gameStateL.gameSelectedPlayer `shouldBe` Nothing)
-- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game -- index, bob lt, bob ytd, bob game, joe lt, joe ytd, joe game
[ ( Just 0, 6, 5, 4, 6, 5, 0 ) [ ( Just 0, 6, 5, 4, 6, 5, 0 )
@@ -647,7 +708,6 @@ makeGoalieStats = GoalieStats
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum <*> makeNum
<*> makeNum
makeNum :: IO Int makeNum :: IO Int
makeNum = randomRIO (1, 10) makeNum = randomRIO (1, 10)

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
@@ -58,9 +63,13 @@ spec = describe "Mtlstats.Types" $ do
playerSearchExactSpec playerSearchExactSpec
modifyPlayerSpec modifyPlayerSpec
playerSummarySpec playerSummarySpec
playerDetailsSpec
playerIsActiveSpec playerIsActiveSpec
psPointsSpec psPointsSpec
addPlayerStatsSpec addPlayerStatsSpec
goalieSearchSpec
goalieSearchExactSpec
goalieSummarySpec
Menu.spec Menu.spec
playerSpec :: Spec playerSpec :: Spec
@@ -79,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
@@ -177,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"
@@ -241,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
@@ -568,6 +609,36 @@ playerSummarySpec = describe "playerSummary" $
it "should be \"Joe (2) center\"" $ it "should be \"Joe (2) center\"" $
playerSummary joe `shouldBe` "Joe (2) center" playerSummary joe `shouldBe` "Joe (2) center"
playerDetailsSpec :: Spec
playerDetailsSpec = describe "playerDetails" $
it "should give a detailed description" $ let
player = newPlayer 1 "Joe" "centre"
& pYtd .~ PlayerStats
{ _psGoals = 2
, _psAssists = 3
, _psPMin = 4
}
& pLifetime .~ PlayerStats
{ _psGoals = 5
, _psAssists = 6
, _psPMin = 7
}
expected = unlines
[ " Number: 1"
, " Name: Joe"
, " Position: centre"
, " YTD goals: 2"
, " YTD assists: 3"
, " YTD penalty mins: 4"
, " Lifetime goals: 5"
, " Lifetime assists: 6"
, "Lifetime penalty mins: 7"
]
in playerDetails player `shouldBe` expected
playerIsActiveSpec :: Spec playerIsActiveSpec :: Spec
playerIsActiveSpec = describe "playerIsActive" $ do playerIsActiveSpec = describe "playerIsActive" $ do
let let
@@ -633,6 +704,57 @@ addPlayerStatsSpec = describe "addPlayerStats" $ do
it "should be 9" $ it "should be 9" $
s3^.psPMin `shouldBe` 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"
@@ -641,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