Compare commits
81 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
90d1dfb581 | ||
|
|
f48de6d53a | ||
|
|
405ca1c5c7 | ||
|
|
c6c461f584 | ||
|
|
4910200c96 | ||
|
|
d708bed77d | ||
|
|
7fd837863b | ||
|
|
2a9ff93642 | ||
|
|
76c0a85a50 | ||
|
|
2f767209bb | ||
|
|
43f3d9eb08 | ||
|
|
3f38160abd | ||
|
|
b0cf9a83a1 | ||
|
|
8e74764cab | ||
|
|
b2226c0ca4 | ||
|
|
4fab3ec285 | ||
|
|
a63d822f02 | ||
|
|
bf78062455 | ||
|
|
b57f12310b | ||
|
|
a07c8a0242 | ||
|
|
9840e5a90e | ||
|
|
c9b198d106 | ||
|
|
24b304047c | ||
|
|
4e9b3f635d | ||
|
|
fc31794ef4 | ||
|
|
5bf5a605aa | ||
|
|
911a61ba57 | ||
|
|
ece289d68d | ||
|
|
b2362d2f5f | ||
|
|
b3af06b53d | ||
|
|
0194f68996 | ||
|
|
5bb4e509b8 | ||
|
|
c26c0f54d1 | ||
|
|
5fd67f3802 | ||
|
|
cb4fc77dd6 | ||
|
|
20ee194035 | ||
|
|
8b1e93386a | ||
|
|
e754d887c5 | ||
|
|
b19f1386ec | ||
|
|
43c2f6191d | ||
|
|
6ec7566b2c | ||
|
|
db105d4348 | ||
|
|
eb96ce6152 | ||
|
|
ff541c2385 | ||
|
|
cb0b4f9d0b | ||
|
|
4fa707bc0f | ||
|
|
a6395ada9c | ||
|
|
1c692a21f0 | ||
|
|
12c8d0bdd6 | ||
|
|
7e19ee072f | ||
|
|
2926e28e34 | ||
|
|
d215f27f4f | ||
|
|
1e78ca6f40 | ||
|
|
faa214bf6d | ||
|
|
6c634cd366 | ||
|
|
8ef1c6917a | ||
|
|
28a29e2f64 | ||
|
|
c65bcbbca4 | ||
|
|
66a2a70bbe | ||
|
|
667cf34475 | ||
|
|
2d2ee61aae | ||
|
|
ed31ce5b1d | ||
|
|
0812ae3ddd | ||
|
|
ec914a38b1 | ||
|
|
a9b5ada114 | ||
|
|
67bb12920c | ||
|
|
e94bf59c81 | ||
|
|
ceb8132a13 | ||
|
|
09c63da8bf | ||
|
|
4519ba4732 | ||
|
|
24c1673fc9 | ||
|
|
2f0989fb35 | ||
|
|
2a94e99371 | ||
|
|
1782c0bc48 | ||
|
|
a234d8e802 | ||
|
|
6b30e27836 | ||
|
|
5677263750 | ||
|
|
4a113d06e1 | ||
|
|
121f79a8a2 | ||
|
|
ba968657d9 | ||
|
|
ef8f7f3fee |
@@ -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
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
108
src/Mtlstats/Actions/GoalieInput.hs
Normal file
108
src/Mtlstats/Actions/GoalieInput.hs
Normal 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
|
||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
143
src/Mtlstats/Control/EditPlayer.hs
Normal file
143
src/Mtlstats/Control/EditPlayer.hs
Normal 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
|
||||||
|
}
|
||||||
66
src/Mtlstats/Control/GoalieInput.hs
Normal file
66
src/Mtlstats/Control/GoalieInput.hs
Normal file
@@ -0,0 +1,66 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 2019 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module 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
|
||||||
|
]
|
||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
92
src/Mtlstats/Prompt/EditPlayer.hs
Normal file
92
src/Mtlstats/Prompt/EditPlayer.hs
Normal 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)
|
||||||
56
src/Mtlstats/Prompt/GoalieInput.hs
Normal file
56
src/Mtlstats/Prompt/GoalieInput.hs
Normal 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
|
||||||
@@ -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) ++ ")"
|
||||||
|
|||||||
291
test/Actions/GoalieInputSpec.hs
Normal file
291
test/Actions/GoalieInputSpec.hs
Normal 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 )
|
||||||
|
)
|
||||||
|
]
|
||||||
@@ -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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user