Compare commits
95 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1e0b72fc40 | ||
|
|
2c5b4a0791 | ||
|
|
bce31d059b | ||
|
|
99baebe144 | ||
|
|
eb3714c40a | ||
|
|
1bd3ae9564 | ||
|
|
2adfe9b016 | ||
|
|
85a8e3baf1 | ||
|
|
393a2c6dc4 | ||
|
|
ed240c6a38 | ||
|
|
4f147cd5a4 | ||
|
|
9b6dfc4be9 | ||
|
|
c20fb30f5b | ||
|
|
3c0e690ed3 | ||
|
|
f37e231623 | ||
|
|
fbaf2a1e60 | ||
|
|
65979329bd | ||
|
|
ded019faac | ||
|
|
1322004d38 | ||
|
|
2cb279e7e7 | ||
|
|
7ca66ad801 | ||
|
|
82544046ce | ||
|
|
95c97d722e | ||
|
|
0eb46cacce | ||
|
|
25f887a5e8 | ||
|
|
7ba670948b | ||
|
|
ca06b0570e | ||
|
|
1e8473538a | ||
|
|
87336dcd1d | ||
|
|
ffa241c1f7 | ||
|
|
f9085832f4 | ||
|
|
e15623bde3 | ||
|
|
db62fbb542 | ||
|
|
4a8515b862 | ||
|
|
e4c668d1e4 | ||
|
|
9ee33cbd03 | ||
|
|
53c49492cb | ||
|
|
4d1eaa1523 | ||
|
|
29fae81513 | ||
|
|
8a8a550854 | ||
|
|
6227df8e01 | ||
|
|
0676bf4067 | ||
|
|
119032ca80 | ||
|
|
2607fc5ce8 | ||
|
|
d18cb7dd59 | ||
|
|
dff11a8316 | ||
|
|
747bdf8f32 | ||
|
|
9b07c6d249 | ||
|
|
e28ef1ff0e | ||
|
|
960fbb3443 | ||
|
|
439aab99d3 | ||
|
|
8d7a7997b1 | ||
|
|
7e409fdbd4 | ||
|
|
28b1fa0e06 | ||
|
|
7c4b7331e8 | ||
|
|
214710661a | ||
|
|
6bb4601e6b | ||
|
|
e51953650c | ||
|
|
14386f9c7d | ||
|
|
ec10aa7998 | ||
|
|
fe28e96145 | ||
|
|
2941998058 | ||
|
|
c22849bb3b | ||
|
|
4315b40732 | ||
|
|
fefa217df1 | ||
|
|
6d77caaa14 | ||
|
|
a69853858d | ||
|
|
045f2915e1 | ||
|
|
dfd226c7bd | ||
|
|
b9d8b263df | ||
|
|
a2968595d8 | ||
|
|
25e4929f0b | ||
|
|
457298e565 | ||
|
|
a80eaa2a40 | ||
|
|
8a6cf10ad3 | ||
|
|
bd5bc21661 | ||
|
|
accc831bc5 | ||
|
|
2c78a591ca | ||
|
|
77dc89c76d | ||
|
|
607a78ccea | ||
|
|
d7c5f24c26 | ||
|
|
d94c6a588e | ||
|
|
bdbe0131d7 | ||
|
|
b0638b95b8 | ||
|
|
ce2d32407e | ||
|
|
5771091f18 | ||
|
|
13a1949446 | ||
|
|
835cb9582b | ||
|
|
8bc9b48aa2 | ||
|
|
378efea24e | ||
|
|
6418ab0eea | ||
|
|
95e74accd4 | ||
|
|
ffc1390755 | ||
|
|
2f0a3a5c57 | ||
|
|
79d527866f |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -1,3 +1,6 @@
|
|||||||
.stack-work/
|
.stack-work/
|
||||||
mtlstats.cabal
|
mtlstats.cabal
|
||||||
|
.vagrant
|
||||||
|
data
|
||||||
|
*.log
|
||||||
*~
|
*~
|
||||||
30
ChangeLog.md
30
ChangeLog.md
@@ -1,5 +1,35 @@
|
|||||||
# Changelog for mtlstats
|
# Changelog for mtlstats
|
||||||
|
|
||||||
|
## 0.16.0
|
||||||
|
- enter months by number
|
||||||
|
|
||||||
|
## 0.15.2
|
||||||
|
- allow ties
|
||||||
|
|
||||||
|
## 0.15.1
|
||||||
|
- only search for active players/goalies on game data input
|
||||||
|
|
||||||
|
## 0.15.0
|
||||||
|
- Ask for database to load on start-up
|
||||||
|
- Add page break to report file
|
||||||
|
- Implemented player/goalie deletion
|
||||||
|
|
||||||
|
## 0.14.0
|
||||||
|
- Fixed a bug that was causing shutouts to not be recorded
|
||||||
|
- Output report to a text file (report.txt)
|
||||||
|
|
||||||
|
## 0.13.0
|
||||||
|
- Added autocomplete to player position prompt
|
||||||
|
- Don't prompt for lifetime stats on rookie player/goalie creation
|
||||||
|
- Ask whether a player/goalie is active on creation
|
||||||
|
- Don't ask which goalie to assign the game to when there's only one
|
||||||
|
|
||||||
|
## 0.12.0
|
||||||
|
- Edit lifetime stats on new player/goalie creation
|
||||||
|
- Sort goalies by minutes played
|
||||||
|
- Subsort players by lifetime points
|
||||||
|
- Changed wording on edit menus
|
||||||
|
|
||||||
## 0.11.0
|
## 0.11.0
|
||||||
- Added active flag to players/goalies
|
- Added active flag to players/goalies
|
||||||
- Clear rookie flag on new (regular) season
|
- Clear rookie flag on new (regular) season
|
||||||
|
|||||||
10
Vagrantfile
vendored
Normal file
10
Vagrantfile
vendored
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
# -*- mode: ruby -*-
|
||||||
|
# vi: set ft=ruby :
|
||||||
|
|
||||||
|
Vagrant.configure("2") do |config|
|
||||||
|
config.vm.box = "ubuntu/xenial64"
|
||||||
|
config.vm.provision "shell", path: "vagrant/provision.sh"
|
||||||
|
config.vm.provider :virtualbox do |v|
|
||||||
|
v.customize ["modifyvm", :id, "--memory", 4096]
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
name: mtlstats
|
name: mtlstats
|
||||||
version: 0.11.0
|
version: 0.16.0
|
||||||
github: "mtlstats/mtlstats"
|
github: "mtlstats/mtlstats"
|
||||||
license: GPL-3
|
license: GPL-3
|
||||||
author: "Jonathan Lamothe"
|
author: "Jonathan Lamothe"
|
||||||
|
|||||||
@@ -19,23 +19,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
|
|
||||||
module Mtlstats (initState, mainLoop) where
|
module Mtlstats (initState, mainLoop) where
|
||||||
|
|
||||||
import Control.Exception (IOException, catch)
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.Extra (whenM)
|
import Control.Monad.Extra (whenM)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.Trans.State (get, gets)
|
import Control.Monad.Trans.State (get, gets)
|
||||||
import Data.Aeson (decodeFileStrict)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Maybe (fromJust, fromMaybe)
|
|
||||||
import Lens.Micro ((&), (.~))
|
|
||||||
import System.EasyFile (getAppUserDataDirectory, (</>))
|
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Config
|
|
||||||
import Mtlstats.Control
|
import Mtlstats.Control
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
@@ -44,15 +36,7 @@ initState :: C.Curses ProgState
|
|||||||
initState = do
|
initState = do
|
||||||
C.setEcho False
|
C.setEcho False
|
||||||
void $ C.setCursorMode C.CursorInvisible
|
void $ C.setCursorMode C.CursorInvisible
|
||||||
db <- liftIO $ do
|
return newProgState
|
||||||
dir <- getAppUserDataDirectory appName
|
|
||||||
let dbFile = dir </> dbFname
|
|
||||||
fromMaybe newDatabase <$> catch
|
|
||||||
(decodeFileStrict dbFile)
|
|
||||||
(\(_ :: IOException) -> return Nothing)
|
|
||||||
return
|
|
||||||
$ newProgState
|
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
-- | Main program loop
|
-- | Main program loop
|
||||||
mainLoop :: Action ()
|
mainLoop :: Action ()
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Mtlstats.Actions
|
module Mtlstats.Actions
|
||||||
( startNewSeason
|
( startNewSeason
|
||||||
@@ -43,12 +43,14 @@ module Mtlstats.Actions
|
|||||||
, backHome
|
, backHome
|
||||||
, scrollUp
|
, scrollUp
|
||||||
, scrollDown
|
, scrollDown
|
||||||
|
, loadDatabase
|
||||||
, saveDatabase
|
, saveDatabase
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Exception (IOException, catch)
|
||||||
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 (decodeFileStrict, encodeFile)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||||
import System.EasyFile
|
import System.EasyFile
|
||||||
@@ -161,11 +163,15 @@ editSelectedGoalie f s = fromMaybe s $ do
|
|||||||
addPlayer :: ProgState -> ProgState
|
addPlayer :: ProgState -> ProgState
|
||||||
addPlayer s = fromMaybe s $ do
|
addPlayer s = fromMaybe s $ do
|
||||||
let cps = s^.progMode.createPlayerStateL
|
let cps = s^.progMode.createPlayerStateL
|
||||||
num <- cps^.cpsNumber
|
num <- cps^.cpsNumber
|
||||||
|
rFlag <- cps^.cpsRookieFlag
|
||||||
|
aFlag <- cps^.cpsActiveFlag
|
||||||
let
|
let
|
||||||
name = cps^.cpsName
|
name = cps^.cpsName
|
||||||
pos = cps^.cpsPosition
|
pos = cps^.cpsPosition
|
||||||
player = newPlayer num name pos
|
player = newPlayer num name pos
|
||||||
|
& pRookie .~ rFlag
|
||||||
|
& pActive .~ aFlag
|
||||||
Just $ s & database.dbPlayers
|
Just $ s & database.dbPlayers
|
||||||
%~ (++[player])
|
%~ (++[player])
|
||||||
|
|
||||||
@@ -173,10 +179,14 @@ addPlayer s = fromMaybe s $ do
|
|||||||
addGoalie :: ProgState -> ProgState
|
addGoalie :: ProgState -> ProgState
|
||||||
addGoalie s = fromMaybe s $ do
|
addGoalie s = fromMaybe s $ do
|
||||||
let cgs = s^.progMode.createGoalieStateL
|
let cgs = s^.progMode.createGoalieStateL
|
||||||
num <- cgs^.cgsNumber
|
num <- cgs^.cgsNumber
|
||||||
|
rFlag <- cgs^.cgsRookieFlag
|
||||||
|
aFlag <- cgs^.cgsActiveFlag
|
||||||
let
|
let
|
||||||
name = cgs^.cgsName
|
name = cgs^.cgsName
|
||||||
goalie = newGoalie num name
|
goalie = newGoalie num name
|
||||||
|
& gRookie .~ rFlag
|
||||||
|
& gActive .~ aFlag
|
||||||
Just $ s & database.dbGoalies
|
Just $ s & database.dbGoalies
|
||||||
%~ (++[goalie])
|
%~ (++[goalie])
|
||||||
|
|
||||||
@@ -208,12 +218,27 @@ scrollUp = scrollOffset %~ max 0 . pred
|
|||||||
scrollDown :: ProgState -> ProgState
|
scrollDown :: ProgState -> ProgState
|
||||||
scrollDown = scrollOffset %~ succ
|
scrollDown = scrollOffset %~ succ
|
||||||
|
|
||||||
|
-- | Loads the database
|
||||||
|
loadDatabase :: Action ()
|
||||||
|
loadDatabase = do
|
||||||
|
dbFile <- dbSetup
|
||||||
|
liftIO
|
||||||
|
(catch
|
||||||
|
(decodeFileStrict dbFile)
|
||||||
|
(\(_ :: IOException) -> return Nothing))
|
||||||
|
>>= mapM_ (modify . (database .~))
|
||||||
|
|
||||||
-- | Saves the database
|
-- | Saves the database
|
||||||
saveDatabase :: String -> Action ()
|
saveDatabase :: Action ()
|
||||||
saveDatabase fn = do
|
saveDatabase = do
|
||||||
db <- gets (^.database)
|
db <- gets (^.database)
|
||||||
|
dbFile <- dbSetup
|
||||||
|
liftIO $ encodeFile dbFile db
|
||||||
|
|
||||||
|
dbSetup :: Action String
|
||||||
|
dbSetup = do
|
||||||
|
fn <- gets (^.dbName)
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
dir <- getAppUserDataDirectory appName
|
dir <- getAppUserDataDirectory appName
|
||||||
let dbFile = dir </> fn
|
|
||||||
createDirectoryIfMissing True dir
|
createDirectoryIfMissing True dir
|
||||||
encodeFile dbFile db
|
return $ dir </> fn ++ ".json"
|
||||||
|
|||||||
@@ -43,9 +43,7 @@ import Mtlstats.Util
|
|||||||
overtimeCheck :: ProgState -> ProgState
|
overtimeCheck :: ProgState -> ProgState
|
||||||
overtimeCheck s
|
overtimeCheck s
|
||||||
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
| fromMaybe False $ gameTied $ s^.progMode.gameStateL =
|
||||||
s & progMode.gameStateL
|
s & progMode.gameStateL.overtimeFlag ?~ True
|
||||||
%~ (homeScore .~ Nothing)
|
|
||||||
. (awayScore .~ Nothing)
|
|
||||||
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
| fromMaybe False $ gameWon $ s^.progMode.gameStateL =
|
||||||
s & progMode.gameStateL.overtimeFlag ?~ False
|
s & progMode.gameStateL.overtimeFlag ?~ False
|
||||||
| otherwise = s
|
| otherwise = s
|
||||||
@@ -124,12 +122,13 @@ awardGoal n ps = ps
|
|||||||
(\m -> let
|
(\m -> let
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
in M.insert n (stats & psGoals %~ succ) m)
|
in M.insert n (stats & psGoals %~ succ) m)
|
||||||
& database.dbPlayers %~ map
|
& database.dbPlayers %~ zipWith
|
||||||
(\(i, p) -> if i == n
|
(\i p -> if i == n
|
||||||
then p
|
then p
|
||||||
& pYtd.psGoals %~ succ
|
& pYtd.psGoals %~ succ
|
||||||
& pLifetime.psGoals %~ succ
|
& pLifetime.psGoals %~ succ
|
||||||
else p) . zip [0..]
|
else p)
|
||||||
|
[0..]
|
||||||
|
|
||||||
-- | Awards an assist to a player
|
-- | Awards an assist to a player
|
||||||
awardAssist
|
awardAssist
|
||||||
@@ -142,12 +141,13 @@ awardAssist n ps = ps
|
|||||||
(\m -> let
|
(\m -> let
|
||||||
stats = M.findWithDefault newPlayerStats n m
|
stats = M.findWithDefault newPlayerStats n m
|
||||||
in M.insert n (stats & psAssists %~ succ) m)
|
in M.insert n (stats & psAssists %~ succ) m)
|
||||||
& database.dbPlayers %~ map
|
& database.dbPlayers %~ zipWith
|
||||||
(\(i, p) -> if i == n
|
(\i p -> if i == n
|
||||||
then p
|
then p
|
||||||
& pYtd.psAssists %~ succ
|
& pYtd.psAssists %~ succ
|
||||||
& pLifetime.psAssists %~ succ
|
& pLifetime.psAssists %~ succ
|
||||||
else p) . zip [0..]
|
else p)
|
||||||
|
[0..]
|
||||||
|
|
||||||
-- | Resets the entered data for the current goal
|
-- | Resets the entered data for the current goal
|
||||||
resetGoalData :: ProgState -> ProgState
|
resetGoalData :: ProgState -> ProgState
|
||||||
|
|||||||
@@ -36,8 +36,12 @@ import Mtlstats.Util
|
|||||||
|
|
||||||
-- | Attempts to finish game goalie entry
|
-- | Attempts to finish game goalie entry
|
||||||
finishGoalieEntry :: ProgState -> ProgState
|
finishGoalieEntry :: ProgState -> ProgState
|
||||||
finishGoalieEntry s = s & progMode.gameStateL.gameGoaliesRecorded
|
finishGoalieEntry s = case M.toList $ s^.progMode.gameStateL.gameGoalieStats of
|
||||||
.~ not (null $ s^.progMode.gameStateL.gameGoalieStats)
|
[] -> s
|
||||||
|
[(gid, _)] -> setGameGoalie gid s'
|
||||||
|
_ -> s'
|
||||||
|
where
|
||||||
|
s' = s & progMode.gameStateL.gameGoaliesRecorded .~ True
|
||||||
|
|
||||||
-- | Records the goalie's game stats
|
-- | Records the goalie's game stats
|
||||||
recordGoalieStats :: ProgState -> ProgState
|
recordGoalieStats :: ProgState -> ProgState
|
||||||
@@ -83,18 +87,22 @@ setGameGoalie
|
|||||||
-> ProgState
|
-> ProgState
|
||||||
setGameGoalie gid s = fromMaybe s $ do
|
setGameGoalie gid s = fromMaybe s $ do
|
||||||
let gs = s^.progMode.gameStateL
|
let gs = s^.progMode.gameStateL
|
||||||
won <- gameWon gs
|
won <- gameWon gs
|
||||||
lost <- gameLost gs
|
lost <- gameLost gs
|
||||||
tied <- gs^.overtimeFlag
|
tied <- gs^.overtimeFlag
|
||||||
|
shutout <- (==0) <$> otherScore gs
|
||||||
|
|
||||||
let
|
let
|
||||||
w = if won then 1 else 0
|
w = if won then 1 else 0
|
||||||
l = if lost then 1 else 0
|
l = if lost then 1 else 0
|
||||||
t = if tied then 1 else 0
|
t = if tied then 1 else 0
|
||||||
|
so = if shutout then 1 else 0
|
||||||
|
|
||||||
updateStats
|
updateStats
|
||||||
= (gsWins +~ w)
|
= (gsWins +~ w)
|
||||||
. (gsLosses +~ l)
|
. (gsLosses +~ l)
|
||||||
. (gsTies +~ t)
|
. (gsTies +~ t)
|
||||||
|
. (gsShutouts +~ so)
|
||||||
|
|
||||||
updateGoalie
|
updateGoalie
|
||||||
= (gYtd %~ updateStats)
|
= (gYtd %~ updateStats)
|
||||||
|
|||||||
@@ -33,10 +33,6 @@ maxFunKeys = 9
|
|||||||
appName :: String
|
appName :: String
|
||||||
appName = "mtlstats"
|
appName = "mtlstats"
|
||||||
|
|
||||||
-- | The database filename
|
|
||||||
dbFname :: String
|
|
||||||
dbFname = "database.json"
|
|
||||||
|
|
||||||
-- | The maximum number of assists
|
-- | The maximum number of assists
|
||||||
maxAssists :: Int
|
maxAssists :: Int
|
||||||
maxAssists = 2
|
maxAssists = 2
|
||||||
@@ -44,3 +40,11 @@ maxAssists = 2
|
|||||||
-- | The length of a typical game (in minutes)
|
-- | The length of a typical game (in minutes)
|
||||||
gameLength :: Int
|
gameLength :: Int
|
||||||
gameLength = 60
|
gameLength = 60
|
||||||
|
|
||||||
|
-- | Report output filename
|
||||||
|
reportFilename :: FilePath
|
||||||
|
reportFilename = "report.txt"
|
||||||
|
|
||||||
|
-- | Number of columns in report file
|
||||||
|
reportCols :: Int
|
||||||
|
reportCols = 79
|
||||||
|
|||||||
@@ -21,20 +21,15 @@ 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)
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.))
|
||||||
import Lens.Micro.Extras (view)
|
|
||||||
import qualified UI.NCurses as C
|
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Control.CreateGoalie
|
||||||
import Mtlstats.Control.TitleScreen
|
import Mtlstats.Control.CreatePlayer
|
||||||
import Mtlstats.Control.EditGoalie
|
import Mtlstats.Control.EditGoalie
|
||||||
import Mtlstats.Control.EditPlayer
|
import Mtlstats.Control.EditPlayer
|
||||||
import Mtlstats.Control.EditStandings
|
import Mtlstats.Control.EditStandings
|
||||||
import Mtlstats.Control.NewGame
|
import Mtlstats.Control.NewGame
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Control.TitleScreen
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Prompt
|
import Mtlstats.Prompt
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
@@ -43,29 +38,24 @@ import Mtlstats.Types
|
|||||||
-- run
|
-- run
|
||||||
dispatch :: ProgState -> Controller
|
dispatch :: ProgState -> Controller
|
||||||
dispatch s = case s^.progMode of
|
dispatch s = case s^.progMode of
|
||||||
TitleScreen -> titleScreenC
|
TitleScreen -> titleScreenC
|
||||||
MainMenu -> mainMenuC
|
MainMenu -> mainMenuC s
|
||||||
NewSeason flag -> newSeasonC flag
|
NewSeason flag -> newSeasonC flag
|
||||||
NewGame gs -> newGameC gs
|
NewGame gs -> newGameC gs
|
||||||
EditMenu -> editMenuC
|
EditMenu -> editMenuC
|
||||||
CreatePlayer cps
|
CreatePlayer cps -> createPlayerC cps
|
||||||
| null $ cps^.cpsNumber -> getPlayerNumC
|
CreateGoalie cgs -> createGoalieC cgs
|
||||||
| null $ cps^.cpsName -> getPlayerNameC
|
|
||||||
| null $ cps^.cpsPosition -> getPlayerPosC
|
|
||||||
| otherwise -> confirmCreatePlayerC
|
|
||||||
CreateGoalie cgs
|
|
||||||
| null $ cgs^.cgsNumber -> getGoalieNumC
|
|
||||||
| null $ cgs^.cgsName -> getGoalieNameC
|
|
||||||
| otherwise -> confirmCreateGoalieC
|
|
||||||
EditPlayer eps -> editPlayerC eps
|
EditPlayer eps -> editPlayerC eps
|
||||||
EditGoalie egs -> editGoalieC egs
|
EditGoalie egs -> editGoalieC egs
|
||||||
(EditStandings esm) -> editStandingsC esm
|
(EditStandings esm) -> editStandingsC esm
|
||||||
|
|
||||||
mainMenuC :: Controller
|
mainMenuC :: ProgState -> Controller
|
||||||
mainMenuC = Controller
|
mainMenuC s = if null $ s^.dbName
|
||||||
{ drawController = const $ drawMenu mainMenu
|
then promptController getDBPrompt
|
||||||
, handleController = menuHandler mainMenu
|
else Controller
|
||||||
}
|
{ drawController = const $ drawMenu mainMenu
|
||||||
|
, handleController = menuHandler mainMenu
|
||||||
|
}
|
||||||
|
|
||||||
newSeasonC :: Bool -> Controller
|
newSeasonC :: Bool -> Controller
|
||||||
newSeasonC False = promptController newSeasonPrompt
|
newSeasonC False = promptController newSeasonPrompt
|
||||||
@@ -73,85 +63,3 @@ newSeasonC True = menuController newSeasonMenu
|
|||||||
|
|
||||||
editMenuC :: Controller
|
editMenuC :: Controller
|
||||||
editMenuC = menuController editMenu
|
editMenuC = menuController editMenu
|
||||||
|
|
||||||
getPlayerNumC :: Controller
|
|
||||||
getPlayerNumC = Controller
|
|
||||||
{ drawController = drawPrompt playerNumPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerNumPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPlayerNameC :: Controller
|
|
||||||
getPlayerNameC = Controller
|
|
||||||
{ drawController = drawPrompt playerNamePrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerNamePrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
getPlayerPosC :: Controller
|
|
||||||
getPlayerPosC = Controller
|
|
||||||
{ drawController = drawPrompt playerPosPrompt
|
|
||||||
, handleController = \e -> do
|
|
||||||
promptHandler playerPosPrompt e
|
|
||||||
return True
|
|
||||||
}
|
|
||||||
|
|
||||||
confirmCreatePlayerC :: Controller
|
|
||||||
confirmCreatePlayerC = Controller
|
|
||||||
{ drawController = \s -> do
|
|
||||||
let cps = s^.progMode.createPlayerStateL
|
|
||||||
C.drawString $ " Player number: " ++ show (fromJust $ cps^.cpsNumber) ++ "\n"
|
|
||||||
C.drawString $ " Player name: " ++ cps^.cpsName ++ "\n"
|
|
||||||
C.drawString $ "Player position: " ++ cps^.cpsPosition ++ "\n\n"
|
|
||||||
C.drawString "Create player: are you sure? (Y/N)"
|
|
||||||
return C.CursorInvisible
|
|
||||||
, handleController = \e -> do
|
|
||||||
case ynHandler e of
|
|
||||||
Just True -> do
|
|
||||||
modify addPlayer
|
|
||||||
join $ gets $ view $ progMode.createPlayerStateL.cpsSuccessCallback
|
|
||||||
Just False ->
|
|
||||||
join $ gets $ view $ progMode.createPlayerStateL.cpsFailureCallback
|
|
||||||
Nothing -> return ()
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|||||||
107
src/Mtlstats/Control/CreateGoalie.hs
Normal file
107
src/Mtlstats/Control/CreateGoalie.hs
Normal file
@@ -0,0 +1,107 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 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.CreateGoalie (createGoalieC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (?~), (%~), to)
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Handlers
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Handles goalie creation
|
||||||
|
createGoalieC :: CreateGoalieState -> Controller
|
||||||
|
createGoalieC cgs
|
||||||
|
| null $ cgs^.cgsNumber = getGoalieNumC
|
||||||
|
| null $ cgs^.cgsName = getGoalieNameC
|
||||||
|
| null $ cgs^.cgsRookieFlag = getRookieFlagC
|
||||||
|
| null $ cgs^.cgsActiveFlag = getActiveFlagC
|
||||||
|
| otherwise = confirmCreateGoalieC
|
||||||
|
|
||||||
|
getGoalieNumC :: Controller
|
||||||
|
getGoalieNumC = promptController goalieNumPrompt
|
||||||
|
|
||||||
|
getGoalieNameC :: Controller
|
||||||
|
getGoalieNameC = promptController goalieNamePrompt
|
||||||
|
|
||||||
|
getRookieFlagC :: Controller
|
||||||
|
getRookieFlagC = Controller
|
||||||
|
{ drawController = const $ do
|
||||||
|
C.drawString "Is this goalie a rookie? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ case ynHandler e of
|
||||||
|
Just True -> progMode.createGoalieStateL
|
||||||
|
%~ (cgsRookieFlag ?~ True)
|
||||||
|
. (cgsActiveFlag ?~ True)
|
||||||
|
rf -> progMode.createGoalieStateL.cgsRookieFlag .~ rf
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
getActiveFlagC :: Controller
|
||||||
|
getActiveFlagC = Controller
|
||||||
|
{ drawController = const $ do
|
||||||
|
C.drawString "Is this goalie active? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ progMode.createGoalieStateL.cgsActiveFlag .~ ynHandler e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmCreateGoalieC :: Controller
|
||||||
|
confirmCreateGoalieC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let cgs = s^.progMode.createGoalieStateL
|
||||||
|
C.drawString $ unlines
|
||||||
|
$ labelTable
|
||||||
|
[ ( "Goalie number", maybe "?" show $ cgs^.cgsNumber )
|
||||||
|
, ( "Goalie name", cgs^.cgsName )
|
||||||
|
, ( "Rookie", maybe "?" show $ cgs^.cgsRookieFlag )
|
||||||
|
, ( "Active", maybe "?" show $ cgs^.cgsActiveFlag )
|
||||||
|
]
|
||||||
|
++ [ ""
|
||||||
|
, "Create goalie: are you sure? (Y/N)"
|
||||||
|
]
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
cgs <- gets (^.progMode.createGoalieStateL)
|
||||||
|
let
|
||||||
|
success = cgs^.cgsSuccessCallback
|
||||||
|
failure = cgs^.cgsFailureCallback
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
gid <- gets (^.database.dbGoalies.to length)
|
||||||
|
let rookie = cgs^.cgsRookieFlag == Just True
|
||||||
|
modify addGoalie
|
||||||
|
if rookie
|
||||||
|
then success
|
||||||
|
else modify $ progMode.editGoalieStateL
|
||||||
|
%~ (egsSelectedGoalie ?~ gid)
|
||||||
|
. (egsMode .~ EGLtGames True)
|
||||||
|
. (egsCallback .~ success)
|
||||||
|
Just False -> failure
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
112
src/Mtlstats/Control/CreatePlayer.hs
Normal file
112
src/Mtlstats/Control/CreatePlayer.hs
Normal file
@@ -0,0 +1,112 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 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.CreatePlayer (createPlayerC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Lens.Micro ((^.), (.~), (?~), (%~), to)
|
||||||
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Format
|
||||||
|
import Mtlstats.Handlers
|
||||||
|
import Mtlstats.Prompt
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
-- | Handles player creation
|
||||||
|
createPlayerC :: CreatePlayerState -> Controller
|
||||||
|
createPlayerC cps
|
||||||
|
| null $ cps^.cpsNumber = getPlayerNumC
|
||||||
|
| null $ cps^.cpsName = getPlayerNameC
|
||||||
|
| null $ cps^.cpsPosition = getPlayerPosC
|
||||||
|
| null $ cps^.cpsRookieFlag = getRookieFlagC
|
||||||
|
| null $ cps^.cpsActiveFlag = getActiveFlagC
|
||||||
|
| otherwise = confirmCreatePlayerC
|
||||||
|
|
||||||
|
getPlayerNumC :: Controller
|
||||||
|
getPlayerNumC = promptController playerNumPrompt
|
||||||
|
|
||||||
|
getPlayerNameC :: Controller
|
||||||
|
getPlayerNameC = promptController playerNamePrompt
|
||||||
|
|
||||||
|
getPlayerPosC :: Controller
|
||||||
|
getPlayerPosC = promptController playerPosPrompt
|
||||||
|
|
||||||
|
getRookieFlagC :: Controller
|
||||||
|
getRookieFlagC = Controller
|
||||||
|
{ drawController = const $ do
|
||||||
|
C.drawString "Is this player a rookie? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ case ynHandler e of
|
||||||
|
Just True -> progMode.createPlayerStateL
|
||||||
|
%~ (cpsRookieFlag ?~ True)
|
||||||
|
. (cpsActiveFlag ?~ True)
|
||||||
|
rf -> progMode.createPlayerStateL.cpsRookieFlag .~ rf
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
getActiveFlagC :: Controller
|
||||||
|
getActiveFlagC = Controller
|
||||||
|
{ drawController = const $ do
|
||||||
|
C.drawString "Is the player active? (Y/N)"
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
modify $ progMode.createPlayerStateL.cpsActiveFlag .~ ynHandler e
|
||||||
|
return True
|
||||||
|
}
|
||||||
|
|
||||||
|
confirmCreatePlayerC :: Controller
|
||||||
|
confirmCreatePlayerC = Controller
|
||||||
|
{ drawController = \s -> do
|
||||||
|
let cps = s^.progMode.createPlayerStateL
|
||||||
|
C.drawString $ unlines
|
||||||
|
$ labelTable
|
||||||
|
[ ( "Player number", maybe "?" show $ cps^.cpsNumber )
|
||||||
|
, ( "Player name", cps^.cpsName )
|
||||||
|
, ( "Player position", cps^.cpsPosition )
|
||||||
|
, ( "Rookie", maybe "?" show $ cps^.cpsRookieFlag )
|
||||||
|
, ( "Active", maybe "?" show $ cps^.cpsActiveFlag )
|
||||||
|
]
|
||||||
|
++ [ ""
|
||||||
|
, "Create player: are you sure? (Y/N)"
|
||||||
|
]
|
||||||
|
return C.CursorInvisible
|
||||||
|
, handleController = \e -> do
|
||||||
|
cps <- gets (^.progMode.createPlayerStateL)
|
||||||
|
let
|
||||||
|
success = cps^.cpsSuccessCallback
|
||||||
|
failure = cps^.cpsFailureCallback
|
||||||
|
case ynHandler e of
|
||||||
|
Just True -> do
|
||||||
|
pid <- gets (^.database.dbPlayers.to length)
|
||||||
|
let rookie = cps^.cpsRookieFlag == Just True
|
||||||
|
modify addPlayer
|
||||||
|
if rookie
|
||||||
|
then success
|
||||||
|
else modify $ progMode.editPlayerStateL
|
||||||
|
%~ (epsSelectedPlayer ?~ pid)
|
||||||
|
. (epsMode .~ EPLtGoals True)
|
||||||
|
. (epsCallback .~ success)
|
||||||
|
Just False -> failure
|
||||||
|
Nothing -> return ()
|
||||||
|
return True
|
||||||
|
}
|
||||||
@@ -23,10 +23,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.), (.~), (%~))
|
||||||
import UI.NCurses as C
|
import UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Handlers
|
||||||
import Mtlstats.Helpers.Goalie
|
import Mtlstats.Helpers.Goalie
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Menu.EditGoalie
|
import Mtlstats.Menu.EditGoalie
|
||||||
@@ -39,89 +42,136 @@ import Mtlstats.Util
|
|||||||
editGoalieC :: EditGoalieState -> Controller
|
editGoalieC :: EditGoalieState -> Controller
|
||||||
editGoalieC egs
|
editGoalieC egs
|
||||||
| null $ egs^.egsSelectedGoalie = selectC
|
| null $ egs^.egsSelectedGoalie = selectC
|
||||||
| otherwise = editC $ egs^.egsMode
|
| otherwise = editC (egs^.egsCallback) (egs^.egsMode)
|
||||||
|
|
||||||
selectC :: Controller
|
selectC :: Controller
|
||||||
selectC = promptController goalieToEditPrompt
|
selectC = promptController goalieToEditPrompt
|
||||||
|
|
||||||
editC :: EditGoalieMode -> Controller
|
editC :: Action () -> EditGoalieMode -> Controller
|
||||||
editC = \case
|
editC cb =
|
||||||
EGMenu -> menuC
|
( \case
|
||||||
EGNumber -> numberC
|
EGMenu -> menuC
|
||||||
EGName -> nameC
|
EGNumber -> numberC
|
||||||
EGYtd -> ytdMenuC
|
EGName -> nameC
|
||||||
EGLifetime -> lifetimeMenuC
|
EGYtd -> ytdMenuC
|
||||||
EGYtdGames b -> ytdGamesC b
|
EGLifetime -> lifetimeMenuC
|
||||||
EGYtdMins b -> ytdMinsC b
|
EGDelete -> deleteC
|
||||||
EGYtdGoals b -> ytdGoalsC b
|
EGYtdGames b -> ytdGamesC b
|
||||||
EGYtdShutouts b -> ytdShutoutsC b
|
EGYtdMins b -> ytdMinsC b
|
||||||
EGYtdWins b -> ytdWinsC b
|
EGYtdGoals b -> ytdGoalsC b
|
||||||
EGYtdLosses b -> ytdLossesC b
|
EGYtdShutouts b -> ytdShutoutsC b
|
||||||
EGYtdTies -> ytdTiesC
|
EGYtdWins b -> ytdWinsC b
|
||||||
EGLtGames b -> ltGamesC b
|
EGYtdLosses b -> ytdLossesC b
|
||||||
EGLtMins b -> ltMinsC b
|
EGYtdTies -> ytdTiesC
|
||||||
EGLtGoals b -> ltGoalsC b
|
EGLtGames b -> ltGamesC b
|
||||||
EGLtShutouts b -> ltShutoutsC b
|
EGLtMins b -> ltMinsC b
|
||||||
EGLtWins b -> ltWinsC b
|
EGLtGoals b -> ltGoalsC b
|
||||||
EGLtLosses b -> ltLossesC b
|
EGLtShutouts b -> ltShutoutsC b
|
||||||
EGLtTies -> ltTiesC
|
EGLtWins b -> ltWinsC b
|
||||||
|
EGLtLosses b -> ltLossesC b
|
||||||
|
EGLtTies -> ltTiesC
|
||||||
|
) <*> return cb
|
||||||
|
|
||||||
menuC :: Controller
|
menuC :: Action () -> Controller
|
||||||
menuC = menuControllerWith header editGoalieMenu
|
menuC _ = menuControllerWith header editGoalieMenu
|
||||||
|
|
||||||
numberC :: Controller
|
numberC :: Action () -> Controller
|
||||||
numberC = promptController editGoalieNumberPrompt
|
numberC = promptController . editGoalieNumberPrompt
|
||||||
|
|
||||||
nameC :: Controller
|
nameC :: Action () -> Controller
|
||||||
nameC = promptController editGoalieNamePrompt
|
nameC = promptController . editGoalieNamePrompt
|
||||||
|
|
||||||
ytdMenuC :: Controller
|
ytdMenuC :: Action () -> Controller
|
||||||
ytdMenuC = menuControllerWith header editGoalieYtdMenu
|
ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
|
||||||
|
|
||||||
lifetimeMenuC :: Controller
|
lifetimeMenuC :: Action () -> Controller
|
||||||
lifetimeMenuC = menuControllerWith header editGoalieLtMenu
|
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
|
||||||
|
|
||||||
ytdGamesC :: Bool -> Controller
|
deleteC :: Action () -> Controller
|
||||||
ytdGamesC = promptController . editGoalieYtdGamesPrompt
|
deleteC _ = Controller
|
||||||
|
|
||||||
ytdMinsC :: Bool -> Controller
|
{ drawController = \s -> do
|
||||||
ytdMinsC = promptController . editGoalieYtdMinsPrompt
|
|
||||||
|
|
||||||
ytdGoalsC :: Bool -> Controller
|
C.drawString $ let
|
||||||
ytdGoalsC = promptController . editGoalieYtdGoalsPrompt
|
|
||||||
|
|
||||||
ytdShutoutsC :: Bool -> Controller
|
hdr = fromMaybe [] $ do
|
||||||
ytdShutoutsC = promptController . editGoalieYtdShutoutsPrompt
|
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
|
||||||
|
goalie <- nth gid $ s^.database.dbGoalies
|
||||||
|
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
|
||||||
|
|
||||||
ytdWinsC :: Bool -> Controller
|
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
|
||||||
ytdWinsC = promptController . editGoalieYtdWinsPrompt
|
|
||||||
|
|
||||||
ytdLossesC :: Bool -> Controller
|
return C.CursorInvisible
|
||||||
ytdLossesC = promptController . editGoalieYtdLossesPrompt
|
|
||||||
|
|
||||||
ytdTiesC :: Controller
|
, handleController = \e -> do
|
||||||
ytdTiesC = promptController editGoalieYtdTiesPrompt
|
|
||||||
|
|
||||||
ltGamesC :: Bool -> Controller
|
case ynHandler e of
|
||||||
ltGamesC = promptController . editGoalieLtGamesPrompt
|
|
||||||
|
|
||||||
ltMinsC :: Bool -> Controller
|
Just True -> do
|
||||||
ltMinsC = promptController . editGoalieLtMinsPrompt
|
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
|
||||||
|
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
|
||||||
|
modify edit
|
||||||
|
|
||||||
ltGoalsC :: Bool -> Controller
|
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
|
||||||
ltGoalsC = promptController . editGoalieLtGoalsPrompt
|
Nothing -> return ()
|
||||||
|
|
||||||
ltShutoutsC :: Bool -> Controller
|
return True
|
||||||
ltShutoutsC = promptController . editGoalieLtShutoutsPrompt
|
|
||||||
|
|
||||||
ltWinsC :: Bool -> Controller
|
}
|
||||||
ltWinsC = promptController . editGoalieLtWinsPrompt
|
|
||||||
|
|
||||||
ltLossesC :: Bool -> Controller
|
ytdGamesC :: Bool -> Action () -> Controller
|
||||||
ltLossesC = promptController . editGoalieLtLossesPrompt
|
ytdGamesC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdGamesPrompt
|
||||||
|
|
||||||
ltTiesC :: Controller
|
ytdMinsC :: Bool -> Action () -> Controller
|
||||||
ltTiesC = promptController editGoalieLtTiesPrompt
|
ytdMinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdMinsPrompt
|
||||||
|
|
||||||
|
ytdGoalsC :: Bool -> Action () -> Controller
|
||||||
|
ytdGoalsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdGoalsPrompt
|
||||||
|
|
||||||
|
ytdShutoutsC :: Bool -> Action () -> Controller
|
||||||
|
ytdShutoutsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdShutoutsPrompt
|
||||||
|
|
||||||
|
ytdWinsC :: Bool -> Action () -> Controller
|
||||||
|
ytdWinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdWinsPrompt
|
||||||
|
|
||||||
|
ytdLossesC :: Bool -> Action () -> Controller
|
||||||
|
ytdLossesC = curry $ promptController .
|
||||||
|
uncurry editGoalieYtdLossesPrompt
|
||||||
|
|
||||||
|
ytdTiesC :: Action () -> Controller
|
||||||
|
ytdTiesC = promptController . editGoalieYtdTiesPrompt
|
||||||
|
|
||||||
|
ltGamesC :: Bool -> Action () -> Controller
|
||||||
|
ltGamesC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtGamesPrompt
|
||||||
|
|
||||||
|
ltMinsC :: Bool -> Action () -> Controller
|
||||||
|
ltMinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtMinsPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Bool -> Action() -> Controller
|
||||||
|
ltGoalsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtGoalsPrompt
|
||||||
|
|
||||||
|
ltShutoutsC :: Bool -> Action () -> Controller
|
||||||
|
ltShutoutsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtShutoutsPrompt
|
||||||
|
|
||||||
|
ltWinsC :: Bool -> Action () -> Controller
|
||||||
|
ltWinsC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtWinsPrompt
|
||||||
|
|
||||||
|
ltLossesC :: Bool -> Action () -> Controller
|
||||||
|
ltLossesC = curry $ promptController .
|
||||||
|
uncurry editGoalieLtLossesPrompt
|
||||||
|
|
||||||
|
ltTiesC :: Action () -> Controller
|
||||||
|
ltTiesC = promptController . editGoalieLtTiesPrompt
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
header :: ProgState -> C.Update ()
|
||||||
header s = C.drawString $ fromMaybe "" $ do
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
|
|||||||
@@ -21,10 +21,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((^.), (.~), (%~))
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Handlers
|
||||||
import Mtlstats.Helpers.Player
|
import Mtlstats.Helpers.Player
|
||||||
import Mtlstats.Menu
|
import Mtlstats.Menu
|
||||||
import Mtlstats.Menu.EditPlayer
|
import Mtlstats.Menu.EditPlayer
|
||||||
@@ -37,58 +40,97 @@ import Mtlstats.Util
|
|||||||
editPlayerC :: EditPlayerState -> Controller
|
editPlayerC :: EditPlayerState -> Controller
|
||||||
editPlayerC eps
|
editPlayerC eps
|
||||||
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
| null $ eps^.epsSelectedPlayer = selectPlayerC
|
||||||
| otherwise = case eps^.epsMode of
|
| otherwise =
|
||||||
EPMenu -> menuC
|
( case eps^.epsMode of
|
||||||
EPNumber -> numberC
|
EPMenu -> menuC
|
||||||
EPName -> nameC
|
EPNumber -> numberC
|
||||||
EPPosition -> positionC
|
EPName -> nameC
|
||||||
EPYtd -> ytdC
|
EPPosition -> positionC
|
||||||
EPLifetime -> lifetimeC
|
EPYtd -> ytdC
|
||||||
EPYtdGoals b -> ytdGoalsC b
|
EPLifetime -> lifetimeC
|
||||||
EPYtdAssists b -> ytdAssistsC b
|
EPDelete -> deleteC
|
||||||
EPYtdPMin -> ytdPMinC
|
EPYtdGoals b -> ytdGoalsC b
|
||||||
EPLtGoals b -> ltGoalsC b
|
EPYtdAssists b -> ytdAssistsC b
|
||||||
EPLtAssists b -> ltAssistsC b
|
EPYtdPMin -> ytdPMinC
|
||||||
EPLtPMin -> ltPMinC
|
EPLtGoals b -> ltGoalsC b
|
||||||
|
EPLtAssists b -> ltAssistsC b
|
||||||
|
EPLtPMin -> ltPMinC
|
||||||
|
) $ eps^.epsCallback
|
||||||
|
|
||||||
selectPlayerC :: Controller
|
selectPlayerC :: Controller
|
||||||
selectPlayerC = promptController playerToEditPrompt
|
selectPlayerC = promptController playerToEditPrompt
|
||||||
|
|
||||||
menuC :: Controller
|
menuC :: Action () -> Controller
|
||||||
menuC = menuControllerWith header editPlayerMenu
|
menuC _ = menuControllerWith header editPlayerMenu
|
||||||
|
|
||||||
numberC :: Controller
|
numberC :: Action () -> Controller
|
||||||
numberC = promptController editPlayerNumPrompt
|
numberC = promptController . editPlayerNumPrompt
|
||||||
|
|
||||||
nameC :: Controller
|
nameC :: Action () -> Controller
|
||||||
nameC = promptController editPlayerNamePrompt
|
nameC = promptController . editPlayerNamePrompt
|
||||||
|
|
||||||
positionC :: Controller
|
positionC :: Action () -> Controller
|
||||||
positionC = promptController editPlayerPosPrompt
|
positionC = promptController . editPlayerPosPrompt
|
||||||
|
|
||||||
ytdC :: Controller
|
ytdC :: Action () -> Controller
|
||||||
ytdC = menuControllerWith header editPlayerYtdMenu
|
ytdC _ = menuControllerWith header editPlayerYtdMenu
|
||||||
|
|
||||||
lifetimeC :: Controller
|
lifetimeC :: Action () -> Controller
|
||||||
lifetimeC = menuControllerWith header editPlayerLtMenu
|
lifetimeC _ = menuControllerWith header editPlayerLtMenu
|
||||||
|
|
||||||
ytdGoalsC :: Bool -> Controller
|
deleteC :: Action () -> Controller
|
||||||
ytdGoalsC = promptController . editPlayerYtdGoalsPrompt
|
deleteC _ = Controller
|
||||||
|
|
||||||
ytdAssistsC :: Bool -> Controller
|
{ drawController = \s -> do
|
||||||
ytdAssistsC = promptController . editPlayerYtdAssistsPrompt
|
|
||||||
|
|
||||||
ytdPMinC :: Controller
|
C.drawString $ let
|
||||||
ytdPMinC = promptController editPlayerYtdPMinPrompt
|
|
||||||
|
|
||||||
ltGoalsC :: Bool -> Controller
|
hdr = fromMaybe [] $ do
|
||||||
ltGoalsC = promptController . editPlayerLtGoalsPrompt
|
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
|
||||||
|
player <- nth pid $ s^.database.dbPlayers
|
||||||
|
Just $ "Player: " ++ playerDetails player ++ "\n\n"
|
||||||
|
|
||||||
ltAssistsC :: Bool -> Controller
|
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
|
||||||
ltAssistsC = promptController . editPlayerLtAssistsPrompt
|
|
||||||
|
|
||||||
ltPMinC :: Controller
|
return C.CursorInvisible
|
||||||
ltPMinC = promptController editPlayerLtPMinPrompt
|
|
||||||
|
, handleController = \e -> do
|
||||||
|
|
||||||
|
case ynHandler e of
|
||||||
|
|
||||||
|
Just True -> do
|
||||||
|
gets (^.progMode.editPlayerStateL.epsSelectedPlayer) >>= mapM_
|
||||||
|
(\pid -> modify $ database.dbPlayers %~ dropNth pid)
|
||||||
|
modify edit
|
||||||
|
|
||||||
|
Just False -> modify $ progMode.editPlayerStateL.epsMode .~ EPMenu
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
|
return True
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
ytdGoalsC :: Bool -> Action () -> Controller
|
||||||
|
ytdGoalsC batchMode callback = promptController $
|
||||||
|
editPlayerYtdGoalsPrompt batchMode callback
|
||||||
|
|
||||||
|
ytdAssistsC :: Bool -> Action () -> Controller
|
||||||
|
ytdAssistsC batchMode callback = promptController $
|
||||||
|
editPlayerYtdAssistsPrompt batchMode callback
|
||||||
|
|
||||||
|
ytdPMinC :: Action () -> Controller
|
||||||
|
ytdPMinC = promptController . editPlayerYtdPMinPrompt
|
||||||
|
|
||||||
|
ltGoalsC :: Bool -> Action () -> Controller
|
||||||
|
ltGoalsC batchMode callback = promptController $
|
||||||
|
editPlayerLtGoalsPrompt batchMode callback
|
||||||
|
|
||||||
|
ltAssistsC :: Bool -> Action () -> Controller
|
||||||
|
ltAssistsC batchMode callback = promptController $
|
||||||
|
editPlayerLtAssistsPrompt batchMode callback
|
||||||
|
|
||||||
|
ltPMinC :: Action () -> Controller
|
||||||
|
ltPMinC = promptController . editPlayerLtPMinPrompt
|
||||||
|
|
||||||
header :: ProgState -> C.Update ()
|
header :: ProgState -> C.Update ()
|
||||||
header s = C.drawString $ fromMaybe "" $ do
|
header s = C.drawString $ fromMaybe "" $ do
|
||||||
|
|||||||
@@ -21,13 +21,15 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Control.NewGame (newGameC) where
|
module Mtlstats.Control.NewGame (newGameC) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (gets, modify)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.Trans.State (get, gets, modify)
|
||||||
import Data.Maybe (fromJust, fromMaybe, isJust)
|
import Data.Maybe (fromJust, fromMaybe, isJust)
|
||||||
import Lens.Micro ((^.), (.~))
|
import Lens.Micro ((^.), (.~))
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Actions.NewGame
|
import Mtlstats.Actions.NewGame
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Control.NewGame.GoalieInput
|
import Mtlstats.Control.NewGame.GoalieInput
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Handlers
|
import Mtlstats.Handlers
|
||||||
@@ -60,7 +62,7 @@ gameYearC :: Controller
|
|||||||
gameYearC = promptControllerWith header gameYearPrompt
|
gameYearC = promptControllerWith header gameYearPrompt
|
||||||
|
|
||||||
gameMonthC :: Controller
|
gameMonthC :: Controller
|
||||||
gameMonthC = menuControllerWith header gameMonthMenu
|
gameMonthC = promptControllerWith monthHeader gameMonthPrompt
|
||||||
|
|
||||||
gameDayC :: Controller
|
gameDayC :: Controller
|
||||||
gameDayC = promptControllerWith header gameDayPrompt
|
gameDayC = promptControllerWith header gameDayPrompt
|
||||||
@@ -204,16 +206,19 @@ reportC = Controller
|
|||||||
C.drawString $ unlines $ slice
|
C.drawString $ unlines $ slice
|
||||||
(s^.scrollOffset)
|
(s^.scrollOffset)
|
||||||
(fromInteger $ pred rows)
|
(fromInteger $ pred rows)
|
||||||
(report (fromInteger $ pred cols) s)
|
(displayReport (fromInteger $ pred cols) s)
|
||||||
return C.CursorInvisible
|
return C.CursorInvisible
|
||||||
, handleController = \e -> do
|
, handleController = \e -> do
|
||||||
case e of
|
case e of
|
||||||
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
C.EventSpecialKey C.KeyUpArrow -> modify scrollUp
|
||||||
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
C.EventSpecialKey C.KeyDownArrow -> modify scrollDown
|
||||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||||
C.EventSpecialKey _ -> modify backHome
|
|
||||||
C.EventCharacter _ -> modify backHome
|
C.EventCharacter '\n' -> do
|
||||||
_ -> return ()
|
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
||||||
|
modify backHome
|
||||||
|
|
||||||
|
_ -> return ()
|
||||||
return True
|
return True
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -221,6 +226,31 @@ header :: ProgState -> C.Update ()
|
|||||||
header s = C.drawString $
|
header s = C.drawString $
|
||||||
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
"*** GAME " ++ padNum 2 (s^.database.dbGames) ++ " ***\n"
|
||||||
|
|
||||||
|
monthHeader :: ProgState -> C.Update ()
|
||||||
|
monthHeader s = do
|
||||||
|
(_, cols) <- C.windowSize
|
||||||
|
header s
|
||||||
|
|
||||||
|
let
|
||||||
|
table = labelTable $ zip (map show ([1..] :: [Int]))
|
||||||
|
[ "JANUARY"
|
||||||
|
, "FEBRUARY"
|
||||||
|
, "MARCH"
|
||||||
|
, "APRIL"
|
||||||
|
, "MAY"
|
||||||
|
, "JUNE"
|
||||||
|
, "JULY"
|
||||||
|
, "AUGUST"
|
||||||
|
, "SEPTEMBER"
|
||||||
|
, "OCTOBER"
|
||||||
|
, "NOVEMBER"
|
||||||
|
, "DECEMBER"
|
||||||
|
]
|
||||||
|
|
||||||
|
C.drawString $ unlines $
|
||||||
|
map (centre $ fromIntegral $ pred cols) $
|
||||||
|
["MONTH:", ""] ++ table ++ [""]
|
||||||
|
|
||||||
gameGoal :: ProgState -> (Int, Int)
|
gameGoal :: ProgState -> (Int, Int)
|
||||||
gameGoal s =
|
gameGoal s =
|
||||||
( s^.database.dbGames
|
( s^.database.dbGames
|
||||||
|
|||||||
@@ -129,9 +129,14 @@ month _ = ""
|
|||||||
labelTable :: [(String, String)] -> [String]
|
labelTable :: [(String, String)] -> [String]
|
||||||
labelTable xs = let
|
labelTable xs = let
|
||||||
labelWidth = maximum $ map (length . fst) xs
|
labelWidth = maximum $ map (length . fst) xs
|
||||||
|
valWidth = maximum $ map (length . snd) xs
|
||||||
|
|
||||||
in map
|
in map
|
||||||
(\(label, val) -> right labelWidth label ++ ": " ++ val)
|
( \(label, val)
|
||||||
xs
|
-> right labelWidth label
|
||||||
|
++ ": "
|
||||||
|
++ left valWidth val
|
||||||
|
) xs
|
||||||
|
|
||||||
-- | Creates a variable column table of numbers with two axes
|
-- | Creates a variable column table of numbers with two axes
|
||||||
numTable
|
numTable
|
||||||
|
|||||||
89
src/Mtlstats/Helpers/Position.hs
Normal file
89
src/Mtlstats/Helpers/Position.hs
Normal file
@@ -0,0 +1,89 @@
|
|||||||
|
{- |
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 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.Helpers.Position
|
||||||
|
( posSearch
|
||||||
|
, posSearchExact
|
||||||
|
, posCallback
|
||||||
|
, getPositions
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.State (gets)
|
||||||
|
import Data.Char (toUpper)
|
||||||
|
import Data.List (isInfixOf)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import qualified Data.Set as S
|
||||||
|
import Lens.Micro ((^.), to)
|
||||||
|
|
||||||
|
import Mtlstats.Types
|
||||||
|
import Mtlstats.Util
|
||||||
|
|
||||||
|
-- | Searches the 'Database' for all the positions used
|
||||||
|
posSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> Database
|
||||||
|
-- ^ The database
|
||||||
|
-> [(Int, String)]
|
||||||
|
-- ^ A list of result indices and their values
|
||||||
|
posSearch sStr db = filter sFunc $ zip [0..] ps
|
||||||
|
where
|
||||||
|
sFunc (_, pos) = map toUpper sStr `isInfixOf` map toUpper pos
|
||||||
|
ps = getPositions db
|
||||||
|
|
||||||
|
-- | Searches the 'Database' for an exact position
|
||||||
|
posSearchExact
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> Database
|
||||||
|
-- ^ The database
|
||||||
|
-> Maybe Int
|
||||||
|
-- ^ The index of the result (or 'Nothing' if not found)
|
||||||
|
posSearchExact sStr db = case filter sFunc $ zip [0..] ps of
|
||||||
|
[] -> Nothing
|
||||||
|
(n,_):_ -> Just n
|
||||||
|
where
|
||||||
|
sFunc (_, pos) = sStr == pos
|
||||||
|
ps = getPositions db
|
||||||
|
|
||||||
|
-- | Builds a callback function for when a 'Player' position is
|
||||||
|
-- selected
|
||||||
|
posCallback
|
||||||
|
:: (String -> Action ())
|
||||||
|
-- ^ The raw callback function
|
||||||
|
-> Maybe Int
|
||||||
|
-- ^ The index number of the position selected or 'Nothing' if blank
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to perform
|
||||||
|
posCallback callback = \case
|
||||||
|
Nothing -> callback ""
|
||||||
|
Just n -> do
|
||||||
|
ps <- gets (^.database.to getPositions)
|
||||||
|
let pos = fromMaybe "" $ nth n ps
|
||||||
|
callback pos
|
||||||
|
|
||||||
|
-- | Extracts a list of positions from a 'Database'
|
||||||
|
getPositions :: Database -> [String]
|
||||||
|
getPositions = do
|
||||||
|
raw <- map (^.pPosition) . (^.dbPlayers)
|
||||||
|
return $ S.toList $ S.fromList raw
|
||||||
@@ -29,7 +29,6 @@ module Mtlstats.Menu (
|
|||||||
-- * Menus
|
-- * Menus
|
||||||
mainMenu,
|
mainMenu,
|
||||||
newSeasonMenu,
|
newSeasonMenu,
|
||||||
gameMonthMenu,
|
|
||||||
gameTypeMenu,
|
gameTypeMenu,
|
||||||
gameGoalieMenu,
|
gameGoalieMenu,
|
||||||
editMenu
|
editMenu
|
||||||
@@ -45,7 +44,6 @@ import qualified UI.NCurses as C
|
|||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||||
import Mtlstats.Actions.EditStandings
|
import Mtlstats.Actions.EditStandings
|
||||||
import Mtlstats.Config
|
|
||||||
import Mtlstats.Format
|
import Mtlstats.Format
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
@@ -115,7 +113,7 @@ mainMenu = Menu "MASTER MENU" True
|
|||||||
, MenuItem 'C' "EDIT MENU" $
|
, MenuItem 'C' "EDIT MENU" $
|
||||||
modify edit >> return True
|
modify edit >> return True
|
||||||
, MenuItem 'E' "EXIT" $
|
, MenuItem 'E' "EXIT" $
|
||||||
saveDatabase dbFname >> return False
|
saveDatabase >> return False
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The new season menu
|
-- | The new season menu
|
||||||
@@ -131,26 +129,6 @@ newSeasonMenu = Menu "SEASON TYPE" ()
|
|||||||
. startNewGame
|
. startNewGame
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Requests the month in which the game took place
|
|
||||||
gameMonthMenu :: Menu ()
|
|
||||||
gameMonthMenu = Menu "MONTH:" () $ map
|
|
||||||
(\(ch, name, val) ->
|
|
||||||
MenuItem ch name $
|
|
||||||
modify $ progMode.gameStateL.gameMonth ?~ val)
|
|
||||||
[ ( 'A', "JANUARY", 1 )
|
|
||||||
, ( 'B', "FEBRUARY", 2 )
|
|
||||||
, ( 'C', "MARCH", 3 )
|
|
||||||
, ( 'D', "APRIL", 4 )
|
|
||||||
, ( 'E', "MAY", 5 )
|
|
||||||
, ( 'F', "JUNE", 6 )
|
|
||||||
, ( 'G', "JULY", 7 )
|
|
||||||
, ( 'H', "AUGUST", 8 )
|
|
||||||
, ( 'I', "SEPTEMBER", 9 )
|
|
||||||
, ( 'J', "OCTOBER", 10 )
|
|
||||||
, ( 'K', "NOVEMBER", 11 )
|
|
||||||
, ( 'L', "DECEMBER", 12 )
|
|
||||||
]
|
|
||||||
|
|
||||||
-- | The game type menu (home/away)
|
-- | The game type menu (home/away)
|
||||||
gameTypeMenu :: Menu ()
|
gameTypeMenu :: Menu ()
|
||||||
gameTypeMenu = Menu "GAME TYPE:" ()
|
gameTypeMenu = Menu "GAME TYPE:" ()
|
||||||
@@ -170,10 +148,11 @@ gameGoalieMenu s = let
|
|||||||
goalie <- nth n $ s^.database.dbGoalies
|
goalie <- nth n $ s^.database.dbGoalies
|
||||||
Just (n, goalie))
|
Just (n, goalie))
|
||||||
gids
|
gids
|
||||||
in Menu title () $ map
|
in Menu title () $ zipWith
|
||||||
(\(ch, (gid, goalie)) -> MenuItem ch (goalieSummary goalie) $
|
(\ch (gid, goalie) -> MenuItem ch (goalieSummary goalie) $
|
||||||
modify $ GI.setGameGoalie gid) $
|
modify $ GI.setGameGoalie gid)
|
||||||
zip ['1'..] goalies
|
['1'..]
|
||||||
|
goalies
|
||||||
|
|
||||||
-- | The edit menu
|
-- | The edit menu
|
||||||
editMenu :: Menu ()
|
editMenu :: Menu ()
|
||||||
|
|||||||
@@ -38,12 +38,13 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
|||||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
|
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT NUMBER", set EGNumber )
|
[ ( 'A', "NUMBER", set EGNumber )
|
||||||
, ( 'B', "EDIT NAME", set EGName )
|
, ( 'B', "NAME", set EGName )
|
||||||
, ( 'C', "TOGGLE ROOKIE FLAG", toggleRookie )
|
, ( 'C', "ROOKIE FLAG", toggleRookie )
|
||||||
, ( 'D', "TOGGLE ACTIVE FLAG", toggleActive )
|
, ( 'D', "ACTIVE FLAG", toggleActive )
|
||||||
, ( 'E', "EDIT YTD STATS", set EGYtd )
|
, ( 'E', "YTD STATS", set EGYtd )
|
||||||
, ( 'F', "EDIT LIFETIME STATS", set EGLifetime )
|
, ( 'F', "LIFETIME STATS", set EGLifetime )
|
||||||
|
, ( 'G', "DELETE RECORD", set EGDelete )
|
||||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -56,14 +57,14 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
|||||||
editGoalieYtdMenu :: Menu ()
|
editGoalieYtdMenu :: Menu ()
|
||||||
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT ALL YTD STATS", EGYtdGames True )
|
[ ( 'A', "ALL YTD STATS", EGYtdGames True )
|
||||||
, ( 'B', "EDIT YTD GAMES", EGYtdGames False )
|
, ( 'B', "YTD GAMES", EGYtdGames False )
|
||||||
, ( 'C', "EDIT YTD MINUTES", EGYtdMins False )
|
, ( 'C', "YTD MINUTES", EGYtdMins False )
|
||||||
, ( 'D', "EDIT YTD GOALS", EGYtdGoals False )
|
, ( 'D', "YTD GOALS", EGYtdGoals False )
|
||||||
, ( 'E', "EDIT YTD SHUTOUTS", EGYtdShutouts False )
|
, ( 'E', "YTD SHUTOUTS", EGYtdShutouts False )
|
||||||
, ( 'F', "EDIT YTD WINS", EGYtdWins False )
|
, ( 'F', "YTD WINS", EGYtdWins False )
|
||||||
, ( 'G', "EDIT YTD LOSSES", EGYtdLosses False )
|
, ( 'G', "YTD LOSSES", EGYtdLosses False )
|
||||||
, ( 'H', "EDIT YTD TIES", EGYtdTies )
|
, ( 'H', "YTD TIES", EGYtdTies )
|
||||||
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -71,16 +72,16 @@ editGoalieYtdMenu = editMenu "EDIT GOALTENDER YEAR-TO-DATE"
|
|||||||
editGoalieLtMenu :: Menu ()
|
editGoalieLtMenu :: Menu ()
|
||||||
editGoalieLtMenu = editMenu
|
editGoalieLtMenu = editMenu
|
||||||
"EDIT GOALTENDER LIFETIME"
|
"EDIT GOALTENDER LIFETIME"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT ALL LIFETIME STATS", EGLtGames True )
|
[ ( 'A', "ALL LIFETIME STATS", EGLtGames True )
|
||||||
, ( 'B', "EDIT LIFETIME GAMES", EGLtGames False )
|
, ( 'B', "LIFETIME GAMES", EGLtGames False )
|
||||||
, ( 'C', "EDIT LIFETIME MINUTES", EGLtMins False )
|
, ( 'C', "LIFETIME MINUTES", EGLtMins False )
|
||||||
, ( 'D', "EDIT LIFETIME GOALS", EGLtGoals False )
|
, ( 'D', "LIFETIME GOALS", EGLtGoals False )
|
||||||
, ( 'E', "EDIT LIFETIME SHUTOUTS", EGLtShutouts False )
|
, ( 'E', "LIFETIME SHUTOUTS", EGLtShutouts False )
|
||||||
, ( 'F', "EDIT LIFETIME WINS", EGLtWins False )
|
, ( 'F', "LIFETIME WINS", EGLtWins False )
|
||||||
, ( 'G', "EDIT LIFETIME LOSSES", EGLtLosses False )
|
, ( 'G', "LIFETIME LOSSES", EGLtLosses False )
|
||||||
, ( 'H', "EDIT LIFETIME TIES", EGLtTies )
|
, ( 'H', "LIFETIME TIES", EGLtTies )
|
||||||
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
, ( 'R', "RETURN TO EDIT MENU", EGMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
editMenu :: String -> [(Char, String, EditGoalieMode)] -> Menu ()
|
||||||
|
|||||||
@@ -38,13 +38,14 @@ editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
|||||||
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
(\(ch, label, action) -> MenuItem ch label $ modify action)
|
||||||
|
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT NUMBER", set EPNumber )
|
[ ( 'A', "NUMBER", set EPNumber )
|
||||||
, ( 'B', "EDIT NAME", set EPName )
|
, ( 'B', "NAME", set EPName )
|
||||||
, ( 'C', "EDIT POSITION", set EPPosition )
|
, ( 'C', "POSITION", set EPPosition )
|
||||||
, ( 'D', "TOGGLE ROOKIE FLAG", toggleRookie )
|
, ( 'D', "ROOKIE FLAG", toggleRookie )
|
||||||
, ( 'E', "TOGGLE ACTIVE FLAG", toggleActive )
|
, ( 'E', "ACTIVE FLAG", toggleActive )
|
||||||
, ( 'F', "EDIT YTD STATS", set EPYtd )
|
, ( 'F', "YTD STATS", set EPYtd )
|
||||||
, ( 'G', "EDIT LIFETIME STATS", set EPLifetime )
|
, ( 'G', "LIFETIME STATS", set EPLifetime )
|
||||||
|
, ( 'H', "DELETE RECORD", set EPDelete )
|
||||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -58,10 +59,10 @@ editPlayerYtdMenu :: Menu ()
|
|||||||
editPlayerYtdMenu = editMenu
|
editPlayerYtdMenu = editMenu
|
||||||
"EDIT PLAYER YEAR-TO-DATE"
|
"EDIT PLAYER YEAR-TO-DATE"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT ALL YTD STATS", EPYtdGoals True )
|
[ ( 'A', "ALL YTD STATS", EPYtdGoals True )
|
||||||
, ( 'B', "EDIT YTD GOALS", EPYtdGoals False )
|
, ( 'B', "YTD GOALS", EPYtdGoals False )
|
||||||
, ( 'C', "EDIT YTD ASSISTS", EPYtdAssists False )
|
, ( 'C', "YTD ASSISTS", EPYtdAssists False )
|
||||||
, ( 'D', "EDIT YTD PENALTY MINS", EPYtdPMin )
|
, ( 'D', "YTD PENALTY MINS", EPYtdPMin )
|
||||||
, ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
|
, ( 'R', "RETURN TO PLAYER EDIT MENU", EPMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
@@ -70,10 +71,10 @@ editPlayerLtMenu :: Menu ()
|
|||||||
editPlayerLtMenu = editMenu
|
editPlayerLtMenu = editMenu
|
||||||
"EDIT PLAYER LIFETIME"
|
"EDIT PLAYER LIFETIME"
|
||||||
-- key, label, value
|
-- key, label, value
|
||||||
[ ( 'A', "EDIT ALL LIFETIME STATS", EPLtGoals True )
|
[ ( 'A', "ALL LIFETIME STATS", EPLtGoals True )
|
||||||
, ( 'B', "EDIT LIFETIME GOALS", EPLtGoals False )
|
, ( 'B', "LIFETIME GOALS", EPLtGoals False )
|
||||||
, ( 'C', "EDIT LIFETIME ASSITS", EPLtAssists False )
|
, ( 'C', "LIFETIME ASSITS", EPLtAssists False )
|
||||||
, ( 'D', "EDIT LIFETIME PENALTY MINS", EPLtPMin )
|
, ( 'D', "LIFETIME PENALTY MINS", EPLtPMin )
|
||||||
, ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
|
, ( 'R', "RETURN TO EDIT PLAYER MENU", EPMenu )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|||||||
@@ -31,9 +31,12 @@ module Mtlstats.Prompt (
|
|||||||
ucStrPrompt,
|
ucStrPrompt,
|
||||||
namePrompt,
|
namePrompt,
|
||||||
numPrompt,
|
numPrompt,
|
||||||
|
numPromptRange,
|
||||||
numPromptWithFallback,
|
numPromptWithFallback,
|
||||||
|
dbNamePrompt,
|
||||||
selectPrompt,
|
selectPrompt,
|
||||||
-- * Individual prompts
|
-- * Individual prompts
|
||||||
|
getDBPrompt,
|
||||||
newSeasonPrompt,
|
newSeasonPrompt,
|
||||||
playerNumPrompt,
|
playerNumPrompt,
|
||||||
playerNamePrompt,
|
playerNamePrompt,
|
||||||
@@ -41,7 +44,10 @@ module Mtlstats.Prompt (
|
|||||||
goalieNumPrompt,
|
goalieNumPrompt,
|
||||||
goalieNamePrompt,
|
goalieNamePrompt,
|
||||||
selectPlayerPrompt,
|
selectPlayerPrompt,
|
||||||
|
selectActivePlayerPrompt,
|
||||||
selectGoaliePrompt,
|
selectGoaliePrompt,
|
||||||
|
selectActiveGoaliePrompt,
|
||||||
|
selectPositionPrompt,
|
||||||
playerToEditPrompt
|
playerToEditPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -56,6 +62,7 @@ import qualified UI.NCurses as C
|
|||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
import Mtlstats.Config
|
import Mtlstats.Config
|
||||||
|
import Mtlstats.Helpers.Position
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
@@ -148,6 +155,20 @@ numPrompt
|
|||||||
-> Prompt
|
-> Prompt
|
||||||
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
numPrompt pStr = numPromptWithFallback pStr $ return ()
|
||||||
|
|
||||||
|
-- | Builds a numberic prompt with a range
|
||||||
|
numPromptRange
|
||||||
|
:: Int
|
||||||
|
-- ^ The minimum value
|
||||||
|
-> Int
|
||||||
|
-- ^ The maximum value
|
||||||
|
-> String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Int -> Action ())
|
||||||
|
-- ^ The callback function for the result
|
||||||
|
-> Prompt
|
||||||
|
numPromptRange nMin nMax pStr callback = numPrompt pStr $ \n ->
|
||||||
|
when (n >= nMin && n <= nMax) $ callback n
|
||||||
|
|
||||||
-- | Builds a numeric prompt with a fallback action
|
-- | Builds a numeric prompt with a fallback action
|
||||||
numPromptWithFallback
|
numPromptWithFallback
|
||||||
:: String
|
:: String
|
||||||
@@ -162,27 +183,34 @@ numPromptWithFallback pStr fallback act = Prompt
|
|||||||
, promptProcessChar = \ch str -> if isDigit ch
|
, promptProcessChar = \ch str -> if isDigit ch
|
||||||
then str ++ [ch]
|
then str ++ [ch]
|
||||||
else str
|
else str
|
||||||
, promptAction = \inStr -> case readMaybe inStr of
|
, promptAction = maybe fallback act . readMaybe
|
||||||
Nothing -> fallback
|
|
||||||
Just n -> act n
|
|
||||||
, promptSpecialKey = const $ return ()
|
, promptSpecialKey = const $ return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Prompts for a database name
|
||||||
|
dbNamePrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The callback to pass the result to
|
||||||
|
-> Prompt
|
||||||
|
dbNamePrompt pStr act = (strPrompt pStr act)
|
||||||
|
{ promptProcessChar = \ch -> if isAlphaNum ch || ch == '-'
|
||||||
|
then (++[toUpper ch])
|
||||||
|
else id
|
||||||
|
}
|
||||||
|
|
||||||
-- | Prompts the user for a filename to save a backup of the database
|
-- | Prompts the user for a filename to save a backup of the database
|
||||||
-- to
|
-- to
|
||||||
newSeasonPrompt :: Prompt
|
newSeasonPrompt :: Prompt
|
||||||
newSeasonPrompt = prompt
|
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
|
||||||
{ promptProcessChar = \ch str -> if isAlphaNum ch
|
if null fn
|
||||||
then str ++ [toUpper ch]
|
then modify backHome
|
||||||
else str
|
else do
|
||||||
}
|
saveDatabase
|
||||||
where
|
modify
|
||||||
prompt = strPrompt "Filename to save database: " $ \fn ->
|
$ (dbName .~ fn)
|
||||||
if null fn
|
. (progMode .~ NewSeason True)
|
||||||
then modify backHome
|
|
||||||
else do
|
|
||||||
saveDatabase $ fn ++ ".json"
|
|
||||||
modify $ progMode .~ NewSeason True
|
|
||||||
|
|
||||||
-- | Builds a selection prompt
|
-- | Builds a selection prompt
|
||||||
selectPrompt :: SelectParams a -> Prompt
|
selectPrompt :: SelectParams a -> Prompt
|
||||||
@@ -221,6 +249,12 @@ selectPrompt params = Prompt
|
|||||||
_ -> return ()
|
_ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Prompts for the database to load
|
||||||
|
getDBPrompt :: Prompt
|
||||||
|
getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
|
||||||
|
modify $ dbName .~ fn
|
||||||
|
loadDatabase
|
||||||
|
|
||||||
-- | Prompts for a new player's number
|
-- | Prompts for a new player's number
|
||||||
playerNumPrompt :: Prompt
|
playerNumPrompt :: Prompt
|
||||||
playerNumPrompt = numPrompt "Player number: " $
|
playerNumPrompt = numPrompt "Player number: " $
|
||||||
@@ -233,7 +267,7 @@ playerNamePrompt = namePrompt "Player name: " $
|
|||||||
|
|
||||||
-- | Prompts for a new player's position
|
-- | Prompts for a new player's position
|
||||||
playerPosPrompt :: Prompt
|
playerPosPrompt :: Prompt
|
||||||
playerPosPrompt = ucStrPrompt "Player position: " $
|
playerPosPrompt = selectPositionPrompt "Player position: " $
|
||||||
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
modify . (progMode.createPlayerStateL.cpsPosition .~)
|
||||||
|
|
||||||
-- | Prompts tor the goalie's number
|
-- | Prompts tor the goalie's number
|
||||||
@@ -246,18 +280,21 @@ goalieNamePrompt :: Prompt
|
|||||||
goalieNamePrompt = namePrompt "Goalie name: " $
|
goalieNamePrompt = namePrompt "Goalie name: " $
|
||||||
modify . (progMode.createGoalieStateL.cgsName .~)
|
modify . (progMode.createGoalieStateL.cgsName .~)
|
||||||
|
|
||||||
-- | Selects a player (creating one if necessary)
|
-- | Selects a player using a specified search function (creating the
|
||||||
selectPlayerPrompt
|
-- player if necessary)
|
||||||
:: String
|
selectPlayerPromptWith
|
||||||
|
:: (String -> [Player] -> [(Int, Player)])
|
||||||
|
-- ^ The search function
|
||||||
|
-> String
|
||||||
-- ^ The prompt string
|
-- ^ The prompt string
|
||||||
-> (Maybe Int -> Action ())
|
-> (Maybe Int -> Action ())
|
||||||
-- ^ 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 = selectPrompt SelectParams
|
selectPlayerPromptWith sFunc pStr callback = selectPrompt SelectParams
|
||||||
{ spPrompt = pStr
|
{ spPrompt = pStr
|
||||||
, spSearchHeader = "Player select:"
|
, spSearchHeader = "Player select:"
|
||||||
, spSearch = \sStr db -> playerSearch sStr (db^.dbPlayers)
|
, spSearch = \sStr db -> sFunc sStr (db^.dbPlayers)
|
||||||
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
, spSearchExact = \sStr db -> fst <$> playerSearchExact sStr (db^.dbPlayers)
|
||||||
, spElemDesc = playerSummary
|
, spElemDesc = playerSummary
|
||||||
, spProcessChar = capitalizeName
|
, spProcessChar = capitalizeName
|
||||||
@@ -275,18 +312,41 @@ selectPlayerPrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreatePlayer cps
|
modify $ progMode .~ CreatePlayer cps
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Selects a goalie (creating one if necessary)
|
-- | Selects a player (creating one if necessary)
|
||||||
selectGoaliePrompt
|
selectPlayerPrompt
|
||||||
:: String
|
:: String
|
||||||
-- ^ The prompt string
|
-- ^ The prompt string
|
||||||
-> (Maybe Int -> Action ())
|
-> (Maybe Int -> Action ())
|
||||||
|
-- ^ The callback to run (takes the index number of the payer as
|
||||||
|
-- input)
|
||||||
|
-> Prompt
|
||||||
|
selectPlayerPrompt = selectPlayerPromptWith playerSearch
|
||||||
|
|
||||||
|
-- | Selects an active player (creating one if necessary)
|
||||||
|
selectActivePlayerPrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Maybe Int -> Action ())
|
||||||
|
-- ^ The callback to run (takes the index number of the payer as
|
||||||
|
-- input)
|
||||||
|
-> Prompt
|
||||||
|
selectActivePlayerPrompt = selectPlayerPromptWith activePlayerSearch
|
||||||
|
|
||||||
|
-- | Selects a goalie with a specified search criteria (creating the
|
||||||
|
-- goalie if necessary)
|
||||||
|
selectGoaliePromptWith
|
||||||
|
:: (String -> [Goalie] -> [(Int, Goalie)])
|
||||||
|
-- ^ The search criteria
|
||||||
|
-> String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Maybe Int -> Action ())
|
||||||
-- ^ The callback to run (takes the index number of the goalie as
|
-- ^ The callback to run (takes the index number of the goalie as
|
||||||
-- input)
|
-- input)
|
||||||
-> Prompt
|
-> Prompt
|
||||||
selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
selectGoaliePromptWith criteria pStr callback = selectPrompt SelectParams
|
||||||
{ spPrompt = pStr
|
{ spPrompt = pStr
|
||||||
, spSearchHeader = "Goalie select:"
|
, spSearchHeader = "Goalie select:"
|
||||||
, spSearch = \sStr db -> goalieSearch sStr (db^.dbGoalies)
|
, spSearch = \sStr db -> criteria sStr (db^.dbGoalies)
|
||||||
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
, spSearchExact = \sStr db -> fst <$> goalieSearchExact sStr (db^.dbGoalies)
|
||||||
, spElemDesc = goalieSummary
|
, spElemDesc = goalieSummary
|
||||||
, spProcessChar = capitalizeName
|
, spProcessChar = capitalizeName
|
||||||
@@ -304,6 +364,44 @@ selectGoaliePrompt pStr callback = selectPrompt SelectParams
|
|||||||
modify $ progMode .~ CreateGoalie cgs
|
modify $ progMode .~ CreateGoalie cgs
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Selects a goalie (creating one if necessary)
|
||||||
|
selectGoaliePrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Maybe Int -> Action ())
|
||||||
|
-- ^ The callback to run (takes the index number of the goalie as
|
||||||
|
-- input)
|
||||||
|
-> Prompt
|
||||||
|
selectGoaliePrompt = selectGoaliePromptWith goalieSearch
|
||||||
|
|
||||||
|
-- | Selects an active goalie (creating one if necessary)
|
||||||
|
selectActiveGoaliePrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The prompt string
|
||||||
|
-> (Maybe Int -> Action ())
|
||||||
|
-- ^ The callback to run (takes the index number of the goalie as
|
||||||
|
-- input)
|
||||||
|
-> Prompt
|
||||||
|
selectActiveGoaliePrompt = selectGoaliePromptWith activeGoalieSearch
|
||||||
|
|
||||||
|
-- | Selects (or creates) a player position
|
||||||
|
selectPositionPrompt
|
||||||
|
:: String
|
||||||
|
-- ^ The 'Prompt' string
|
||||||
|
-> (String -> Action ())
|
||||||
|
-- ^ The action to perform when a value is entered
|
||||||
|
-> Prompt
|
||||||
|
selectPositionPrompt pStr callback = selectPrompt SelectParams
|
||||||
|
{ spPrompt = pStr
|
||||||
|
, spSearchHeader = "Positions:"
|
||||||
|
, spSearch = posSearch
|
||||||
|
, spSearchExact = posSearchExact
|
||||||
|
, spElemDesc = id
|
||||||
|
, spProcessChar = \ch -> (++ [toUpper ch])
|
||||||
|
, spCallback = posCallback callback
|
||||||
|
, spNotFound = callback
|
||||||
|
}
|
||||||
|
|
||||||
playerToEditPrompt :: Prompt
|
playerToEditPrompt :: Prompt
|
||||||
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
playerToEditPrompt = selectPlayerPrompt "Player to edit: " $
|
||||||
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
modify . (progMode.editPlayerStateL.epsSelectedPlayer .~)
|
||||||
|
|||||||
@@ -52,85 +52,119 @@ goalieToEditPrompt = selectGoaliePrompt "Goalie to edit: " $
|
|||||||
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
modify . (progMode.editGoalieStateL.egsSelectedGoalie .~)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's number
|
-- | Prompt to edit a goalie's number
|
||||||
editGoalieNumberPrompt :: Prompt
|
editGoalieNumberPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
editGoalieNumberPrompt = editNum "Goalie number: " EGMenu
|
||||||
(gNumber .~)
|
(gNumber .~)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's name
|
-- | Prompt to edit a goalie's name
|
||||||
editGoalieNamePrompt :: Prompt
|
editGoalieNamePrompt
|
||||||
editGoalieNamePrompt = namePrompt "Goalie name: " $ \name ->
|
:: Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
|
editGoalieNamePrompt cb = namePrompt "Goalie name: " $ \name -> do
|
||||||
if null name
|
if null name
|
||||||
then goto EGMenu
|
then goto EGMenu
|
||||||
else doEdit EGMenu $ gName .~ name
|
else doEdit EGMenu $ gName .~ name
|
||||||
|
cb
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD games played
|
-- | Prompt to edit a goalie's YTD games played
|
||||||
editGoalieYtdGamesPrompt
|
editGoalieYtdGamesPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdGamesPrompt batchMode =
|
editGoalieYtdGamesPrompt batchMode cb =
|
||||||
editNum "Year-to-date games played: " mode
|
editNum "Year-to-date games played: " mode
|
||||||
(gYtd.gsGames .~)
|
(gYtd.gsGames .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdMins True else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdMins True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD minutes played
|
-- | Prompt to edit a goalie's YTD minutes played
|
||||||
editGoalieYtdMinsPrompt
|
editGoalieYtdMinsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdMinsPrompt batchMode =
|
editGoalieYtdMinsPrompt batchMode cb =
|
||||||
editNum "Year-to-date minutes played: " mode
|
editNum "Year-to-date minutes played: " mode
|
||||||
(gYtd.gsMinsPlayed .~)
|
(gYtd.gsMinsPlayed .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdGoals True else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdGoals True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD goales allowed
|
-- | Prompt to edit a goalie's YTD goales allowed
|
||||||
editGoalieYtdGoalsPrompt
|
editGoalieYtdGoalsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdGoalsPrompt batchMode =
|
editGoalieYtdGoalsPrompt batchMode cb =
|
||||||
editNum "Year-to-date goals allowed: " mode
|
editNum "Year-to-date goals allowed: " mode
|
||||||
(gYtd.gsGoalsAllowed .~)
|
(gYtd.gsGoalsAllowed .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdShutouts True else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdShutouts True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD shutouts
|
-- | Prompt to edit a goalie's YTD shutouts
|
||||||
editGoalieYtdShutoutsPrompt
|
editGoalieYtdShutoutsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdShutoutsPrompt batchMode =
|
editGoalieYtdShutoutsPrompt batchMode cb =
|
||||||
editNum "Year-to-date shutouts: " mode
|
editNum "Year-to-date shutouts: " mode
|
||||||
(gYtd.gsShutouts .~)
|
(gYtd.gsShutouts .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdWins True else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdWins True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD wins
|
-- | Prompt to edit a goalie's YTD wins
|
||||||
editGoalieYtdWinsPrompt
|
editGoalieYtdWinsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdWinsPrompt batchMode =
|
editGoalieYtdWinsPrompt batchMode cb =
|
||||||
editNum "Year-to-date wins: " mode
|
editNum "Year-to-date wins: " mode
|
||||||
(gYtd.gsWins .~)
|
(gYtd.gsWins .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdLosses True else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdLosses True, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD losses
|
-- | Prompt to edit a goalie's YTD losses
|
||||||
editGoalieYtdLossesPrompt
|
editGoalieYtdLossesPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieYtdLossesPrompt batchMode =
|
editGoalieYtdLossesPrompt batchMode cb =
|
||||||
editNum "Year-to-date losses: " mode
|
editNum "Year-to-date losses: " mode
|
||||||
(gYtd.gsLosses .~)
|
(gYtd.gsLosses .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGYtdTies else EGYtd
|
(mode, cb') = if batchMode
|
||||||
|
then (EGYtdTies, return ())
|
||||||
|
else (EGYtd, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's YTD ties
|
-- | Prompt to edit a goalie's YTD ties
|
||||||
editGoalieYtdTiesPrompt :: Prompt
|
editGoalieYtdTiesPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
||||||
(gYtd.gsTies .~)
|
(gYtd.gsTies .~)
|
||||||
|
|
||||||
@@ -138,70 +172,97 @@ editGoalieYtdTiesPrompt = editNum "Year-to-date ties: " EGYtd
|
|||||||
editGoalieLtGamesPrompt
|
editGoalieLtGamesPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtGamesPrompt batchMode =
|
editGoalieLtGamesPrompt batchMode cb =
|
||||||
editNum "Lifetime games played: " mode
|
editNum "Lifetime games played: " mode
|
||||||
(gLifetime.gsGames .~)
|
(gLifetime.gsGames .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtMins True else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtMins True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime minutes played
|
-- | Prompt to edit a goalie's lifetime minutes played
|
||||||
editGoalieLtMinsPrompt
|
editGoalieLtMinsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtMinsPrompt batchMode =
|
editGoalieLtMinsPrompt batchMode cb =
|
||||||
editNum "Lifetime minutes played: " mode
|
editNum "Lifetime minutes played: " mode
|
||||||
(gLifetime.gsMinsPlayed .~)
|
(gLifetime.gsMinsPlayed .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtGoals True else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtGoals True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime goals allowed
|
-- | Prompt to edit a goalie's lifetime goals allowed
|
||||||
editGoalieLtGoalsPrompt
|
editGoalieLtGoalsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtGoalsPrompt batchMode =
|
editGoalieLtGoalsPrompt batchMode cb =
|
||||||
editNum "Lifetime goals allowed: " mode
|
editNum "Lifetime goals allowed: " mode
|
||||||
(gLifetime.gsGoalsAllowed .~)
|
(gLifetime.gsGoalsAllowed .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtShutouts True else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtShutouts True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime shutouts
|
-- | Prompt to edit a goalie's lifetime shutouts
|
||||||
editGoalieLtShutoutsPrompt
|
editGoalieLtShutoutsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtShutoutsPrompt batchMode =
|
editGoalieLtShutoutsPrompt batchMode cb =
|
||||||
editNum "Lifetime shutouts: " mode
|
editNum "Lifetime shutouts: " mode
|
||||||
(gLifetime.gsShutouts .~)
|
(gLifetime.gsShutouts .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtWins True else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtWins True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime wins
|
-- | Prompt to edit a goalie's lifetime wins
|
||||||
editGoalieLtWinsPrompt
|
editGoalieLtWinsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtWinsPrompt batchMode =
|
editGoalieLtWinsPrompt batchMode cb =
|
||||||
editNum "Lifetime wins: " mode
|
editNum "Lifetime wins: " mode
|
||||||
(gLifetime.gsWins .~)
|
(gLifetime.gsWins .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtLosses True else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtLosses True, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime losses
|
-- | Prompt to edit a goalie's lifetime losses
|
||||||
editGoalieLtLossesPrompt
|
editGoalieLtLossesPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates whether or not we're in batch mode
|
-- ^ Indicates whether or not we're in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editGoalieLtLossesPrompt batchMode =
|
editGoalieLtLossesPrompt batchMode cb =
|
||||||
editNum "Lifetime losses: " mode
|
editNum "Lifetime losses: " mode
|
||||||
(gLifetime.gsLosses .~)
|
(gLifetime.gsLosses .~) cb'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EGLtTies else EGLifetime
|
(mode, cb') = if batchMode
|
||||||
|
then (EGLtTies, return ())
|
||||||
|
else (EGLifetime, cb)
|
||||||
|
|
||||||
-- | Prompt to edit a goalie's lifetime ties
|
-- | Prompt to edit a goalie's lifetime ties
|
||||||
editGoalieLtTiesPrompt :: Prompt
|
editGoalieLtTiesPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ Action to perform on completion
|
||||||
|
-> Prompt
|
||||||
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
editGoalieLtTiesPrompt = editNum "Lifetime ties: " EGLifetime
|
||||||
(gLifetime.gsTies .~)
|
(gLifetime.gsTies .~)
|
||||||
|
|
||||||
@@ -209,10 +270,13 @@ editNum
|
|||||||
:: String
|
:: String
|
||||||
-> EditGoalieMode
|
-> EditGoalieMode
|
||||||
-> (Int -> Goalie -> Goalie)
|
-> (Int -> Goalie -> Goalie)
|
||||||
|
-> Action ()
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editNum pStr mode f = numPromptWithFallback pStr
|
editNum pStr mode f cb = numPromptWithFallback pStr
|
||||||
(goto mode)
|
(goto mode >> cb)
|
||||||
(doEdit mode . f)
|
(\num -> do
|
||||||
|
doEdit mode $ f num
|
||||||
|
cb)
|
||||||
|
|
||||||
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
doEdit :: EditGoalieMode -> (Goalie -> Goalie) -> Action ()
|
||||||
doEdit mode f = do
|
doEdit mode f = do
|
||||||
|
|||||||
@@ -39,46 +39,68 @@ import Mtlstats.Prompt
|
|||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
-- | Prompt to edit a player's number
|
-- | Prompt to edit a player's number
|
||||||
editPlayerNumPrompt :: Prompt
|
editPlayerNumPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
editPlayerNumPrompt = editNum "Player number: " EPMenu
|
||||||
(pNumber .~)
|
(pNumber .~)
|
||||||
|
|
||||||
-- | Prompt to edit a player's name
|
-- | Prompt to edit a player's name
|
||||||
editPlayerNamePrompt :: Prompt
|
editPlayerNamePrompt
|
||||||
editPlayerNamePrompt = namePrompt "Player name: " $ \name ->
|
:: Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerNamePrompt callback = namePrompt "Player name: " $ \name -> do
|
||||||
if null name
|
if null name
|
||||||
then goto EPMenu
|
then goto EPMenu
|
||||||
else doEdit EPMenu $ pName .~ name
|
else doEdit EPMenu $ pName .~ name
|
||||||
|
callback
|
||||||
|
|
||||||
-- | Prompt to edit a player's position
|
-- | Prompt to edit a player's position
|
||||||
editPlayerPosPrompt :: Prompt
|
editPlayerPosPrompt
|
||||||
editPlayerPosPrompt = ucStrPrompt "Player position: " $ \pos ->
|
:: Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
|
editPlayerPosPrompt callback = selectPositionPrompt "Player position: " $ \pos -> do
|
||||||
if null pos
|
if null pos
|
||||||
then goto EPMenu
|
then goto EPMenu
|
||||||
else doEdit EPMenu $ pPosition .~ pos
|
else doEdit EPMenu $ pPosition .~ pos
|
||||||
|
callback
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date goals
|
-- | Prompt to edit a player's year-to-date goals
|
||||||
editPlayerYtdGoalsPrompt
|
editPlayerYtdGoalsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates wheter or not we're editing in batch mode
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editPlayerYtdGoalsPrompt batchMode = editNum "Year-to-date goals: " mode
|
editPlayerYtdGoalsPrompt batchMode callback = editNum "Year-to-date goals: " mode
|
||||||
(pYtd.psGoals .~)
|
(pYtd.psGoals .~) callback'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EPYtdAssists True else EPYtd
|
(mode, callback') = if batchMode
|
||||||
|
then (EPYtdAssists True, return ())
|
||||||
|
else (EPYtd, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date assists
|
-- | Prompt to edit a player's year-to-date assists
|
||||||
editPlayerYtdAssistsPrompt
|
editPlayerYtdAssistsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates wheter or not we're editing in batch mode
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editPlayerYtdAssistsPrompt batchMode = editNum "Year-to-date assists: " mode
|
editPlayerYtdAssistsPrompt batchMode callback = editNum "Year-to-date assists: " mode
|
||||||
(pYtd.psAssists .~)
|
(pYtd.psAssists .~) callback'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EPYtdPMin else EPYtd
|
(mode, callback') = if batchMode
|
||||||
|
then (EPYtdPMin, return ())
|
||||||
|
else (EPYtd, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's year-to-date penalty minutes
|
-- | Prompt to edit a player's year-to-date penalty minutes
|
||||||
editPlayerYtdPMinPrompt :: Prompt
|
editPlayerYtdPMinPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
||||||
(pYtd.psPMin .~)
|
(pYtd.psPMin .~)
|
||||||
|
|
||||||
@@ -86,24 +108,35 @@ editPlayerYtdPMinPrompt = editNum "Year-to-date penalty minutes: " EPYtd
|
|||||||
editPlayerLtGoalsPrompt
|
editPlayerLtGoalsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates wheter or not we're editing in batch mode
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editPlayerLtGoalsPrompt batchMode = editNum "Lifetime goals: " mode
|
editPlayerLtGoalsPrompt batchMode callback = editNum "Lifetime goals: " mode
|
||||||
(pLifetime.psGoals .~)
|
(pLifetime.psGoals .~) callback'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EPLtAssists True else EPLifetime
|
(mode, callback') = if batchMode
|
||||||
|
then (EPLtAssists True, return ())
|
||||||
|
else (EPLifetime, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime assists
|
-- | Prompt to edit a player's lifetime assists
|
||||||
editPlayerLtAssistsPrompt
|
editPlayerLtAssistsPrompt
|
||||||
:: Bool
|
:: Bool
|
||||||
-- ^ Indicates wheter or not we're editing in batch mode
|
-- ^ Indicates wheter or not we're editing in batch mode
|
||||||
|
-> Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editPlayerLtAssistsPrompt batchMode = editNum "Lifetime assists: " mode
|
editPlayerLtAssistsPrompt batchMode callback = editNum "Lifetime assists: " mode
|
||||||
(pLifetime.psAssists .~)
|
(pLifetime.psAssists .~) callback'
|
||||||
where
|
where
|
||||||
mode = if batchMode then EPLtPMin else EPLifetime
|
(mode, callback') = if batchMode
|
||||||
|
then (EPLtPMin, return ())
|
||||||
|
else (EPLifetime, callback)
|
||||||
|
|
||||||
-- | Prompt to edit a player's lifetime penalty minutes
|
-- | Prompt to edit a player's lifetime penalty minutes
|
||||||
editPlayerLtPMinPrompt :: Prompt
|
editPlayerLtPMinPrompt
|
||||||
|
:: Action ()
|
||||||
|
-- ^ The action to be performed upon completion
|
||||||
|
-> Prompt
|
||||||
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
editPlayerLtPMinPrompt = editNum "Lifetime penalty minutes: " EPLifetime
|
||||||
(pLifetime.psPMin .~)
|
(pLifetime.psPMin .~)
|
||||||
|
|
||||||
@@ -111,10 +144,13 @@ editNum
|
|||||||
:: String
|
:: String
|
||||||
-> EditPlayerMode
|
-> EditPlayerMode
|
||||||
-> (Int -> Player -> Player)
|
-> (Int -> Player -> Player)
|
||||||
|
-> Action ()
|
||||||
-> Prompt
|
-> Prompt
|
||||||
editNum pStr mode f = numPromptWithFallback pStr
|
editNum pStr mode f callback = numPromptWithFallback pStr
|
||||||
(goto mode)
|
(goto mode >> callback)
|
||||||
(doEdit mode . f)
|
(\num -> do
|
||||||
|
doEdit mode $ f num
|
||||||
|
callback)
|
||||||
|
|
||||||
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
doEdit :: EditPlayerMode -> (Player -> Player) -> Action ()
|
||||||
doEdit mode f = do
|
doEdit mode f = do
|
||||||
|
|||||||
@@ -23,6 +23,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
module Mtlstats.Prompt.NewGame
|
module Mtlstats.Prompt.NewGame
|
||||||
( gameYearPrompt
|
( gameYearPrompt
|
||||||
|
, gameMonthPrompt
|
||||||
, gameDayPrompt
|
, gameDayPrompt
|
||||||
, otherTeamPrompt
|
, otherTeamPrompt
|
||||||
, homeScorePrompt
|
, homeScorePrompt
|
||||||
@@ -48,6 +49,11 @@ gameYearPrompt :: Prompt
|
|||||||
gameYearPrompt = numPrompt "Game year: " $
|
gameYearPrompt = numPrompt "Game year: " $
|
||||||
modify . (progMode.gameStateL.gameYear ?~)
|
modify . (progMode.gameStateL.gameYear ?~)
|
||||||
|
|
||||||
|
-- | Prompts for the game month
|
||||||
|
gameMonthPrompt :: Prompt
|
||||||
|
gameMonthPrompt = numPromptRange 1 12 "Game month: " $
|
||||||
|
modify . (progMode.gameStateL.gameMonth ?~)
|
||||||
|
|
||||||
-- | Prompts for the day of the month the game took place
|
-- | Prompts for the day of the month the game took place
|
||||||
gameDayPrompt :: Prompt
|
gameDayPrompt :: Prompt
|
||||||
gameDayPrompt = numPrompt "Day of month: " $
|
gameDayPrompt = numPrompt "Day of month: " $
|
||||||
@@ -76,7 +82,7 @@ recordGoalPrompt
|
|||||||
-> Int
|
-> Int
|
||||||
-- ^ The goal number
|
-- ^ The goal number
|
||||||
-> Prompt
|
-> Prompt
|
||||||
recordGoalPrompt game goal = selectPlayerPrompt
|
recordGoalPrompt game goal = selectActivePlayerPrompt
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
++ "Who scored goal number " ++ show goal ++ "? "
|
++ "Who scored goal number " ++ show goal ++ "? "
|
||||||
) $ modify . (progMode.gameStateL.goalBy .~)
|
) $ modify . (progMode.gameStateL.goalBy .~)
|
||||||
@@ -90,7 +96,7 @@ recordAssistPrompt
|
|||||||
-> Int
|
-> Int
|
||||||
-- ^ The assist number
|
-- ^ The assist number
|
||||||
-> Prompt
|
-> Prompt
|
||||||
recordAssistPrompt game goal assist = selectPlayerPrompt
|
recordAssistPrompt game goal assist = selectActivePlayerPrompt
|
||||||
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
( "*** GAME " ++ padNum 2 game ++ " ***\n"
|
||||||
++ "Goal: " ++ show goal ++ "\n"
|
++ "Goal: " ++ show goal ++ "\n"
|
||||||
++ "Assist #" ++ show assist ++ ": "
|
++ "Assist #" ++ show assist ++ ": "
|
||||||
@@ -104,7 +110,7 @@ recordAssistPrompt game goal assist = selectPlayerPrompt
|
|||||||
|
|
||||||
-- | Prompts for the player to assign penalty minutes to
|
-- | Prompts for the player to assign penalty minutes to
|
||||||
pMinPlayerPrompt :: Prompt
|
pMinPlayerPrompt :: Prompt
|
||||||
pMinPlayerPrompt = selectPlayerPrompt
|
pMinPlayerPrompt = selectActivePlayerPrompt
|
||||||
"Assign penalty minutes to: " $
|
"Assign penalty minutes to: " $
|
||||||
\case
|
\case
|
||||||
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
Nothing -> modify $ progMode.gameStateL.gamePMinsRecorded .~ True
|
||||||
|
|||||||
@@ -36,7 +36,8 @@ import Mtlstats.Types
|
|||||||
|
|
||||||
-- | Prompts for a goalie who played in the game
|
-- | Prompts for a goalie who played in the game
|
||||||
selectGameGoaliePrompt :: Prompt
|
selectGameGoaliePrompt :: Prompt
|
||||||
selectGameGoaliePrompt = selectGoaliePrompt "Which goalie played this game: " $
|
selectGameGoaliePrompt = selectActiveGoaliePrompt
|
||||||
|
"Which goalie played this game: " $
|
||||||
\case
|
\case
|
||||||
Nothing -> modify finishGoalieEntry
|
Nothing -> modify finishGoalieEntry
|
||||||
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
Just n -> modify $ progMode.gameStateL.gameSelectedGoalie ?~ n
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Mtlstats.Report (report, gameDate) where
|
module Mtlstats.Report (displayReport, exportReport, gameDate) where
|
||||||
|
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
@@ -34,21 +34,37 @@ import Mtlstats.Helpers.Player
|
|||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Util
|
import Mtlstats.Util
|
||||||
|
|
||||||
-- | Generates the report
|
-- | Generates the report displayed on screen
|
||||||
report
|
displayReport
|
||||||
:: Int
|
:: Int
|
||||||
-- ^ The number of columns for the report
|
-- ^ The number of columns for the report
|
||||||
-> ProgState
|
-> ProgState
|
||||||
-- ^ The program state
|
-- ^ The program state
|
||||||
-> [String]
|
-> [String]
|
||||||
|
displayReport width s
|
||||||
|
= report width s
|
||||||
|
++ [""]
|
||||||
|
++ lifetimeStatsReport width s
|
||||||
|
|
||||||
|
-- | Generates the report to be exported to file
|
||||||
|
exportReport
|
||||||
|
:: Int
|
||||||
|
-- ^ The number of columns in the report
|
||||||
|
-> ProgState
|
||||||
|
-- ^ The program state
|
||||||
|
-> String
|
||||||
|
exportReport width s
|
||||||
|
= unlines (report width s)
|
||||||
|
++ "\f"
|
||||||
|
++ unlines (lifetimeStatsReport width s)
|
||||||
|
|
||||||
|
report :: Int -> ProgState -> [String]
|
||||||
report width s
|
report width s
|
||||||
= standingsReport width s
|
= standingsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ gameStatsReport width s
|
++ gameStatsReport width s
|
||||||
++ [""]
|
++ [""]
|
||||||
++ yearToDateStatsReport width s
|
++ yearToDateStatsReport width s
|
||||||
++ [""]
|
|
||||||
++ lifetimeStatsReport width s
|
|
||||||
|
|
||||||
standingsReport :: Int -> ProgState -> [String]
|
standingsReport :: Int -> ProgState -> [String]
|
||||||
standingsReport width s = fromMaybe [] $ do
|
standingsReport width s = fromMaybe [] $ do
|
||||||
@@ -117,7 +133,7 @@ gameStatsReport width s = let
|
|||||||
gs = s^.progMode.gameStateL
|
gs = s^.progMode.gameStateL
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = mapMaybe
|
playerStats = sortPlayers $ mapMaybe
|
||||||
(\(pid, stats) -> do
|
(\(pid, stats) -> do
|
||||||
p <- nth pid $ db^.dbPlayers
|
p <- nth pid $ db^.dbPlayers
|
||||||
Just (p, stats))
|
Just (p, stats))
|
||||||
@@ -139,7 +155,7 @@ yearToDateStatsReport :: Int -> ProgState -> [String]
|
|||||||
yearToDateStatsReport width s = let
|
yearToDateStatsReport width s = let
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = sortOn (Down . psPoints . snd)
|
playerStats = sortPlayers
|
||||||
$ map (\p -> (p, p^.pYtd))
|
$ map (\p -> (p, p^.pYtd))
|
||||||
$ filter playerIsActive
|
$ filter playerIsActive
|
||||||
$ db^.dbPlayers
|
$ db^.dbPlayers
|
||||||
@@ -156,7 +172,7 @@ lifetimeStatsReport :: Int -> ProgState -> [String]
|
|||||||
lifetimeStatsReport width s = let
|
lifetimeStatsReport width s = let
|
||||||
db = s^.database
|
db = s^.database
|
||||||
|
|
||||||
playerStats = sortOn (Down . psPoints . snd)
|
playerStats = sortPlayers
|
||||||
$ map (\p -> (p, p^.pLifetime))
|
$ map (\p -> (p, p^.pLifetime))
|
||||||
$ db^.dbPlayers
|
$ db^.dbPlayers
|
||||||
|
|
||||||
@@ -241,8 +257,7 @@ filteredPlayerReport width label criteria showTotals lineNumbers ps = let
|
|||||||
else repeat ""
|
else repeat ""
|
||||||
|
|
||||||
table = overlayLast olayText
|
table = overlayLast olayText
|
||||||
$ map (\(ln, line) -> overlay ln $ centre width line)
|
$ zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||||
$ zip lnOverlay
|
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ tHeader : body ++ if showTotals
|
$ tHeader : body ++ if showTotals
|
||||||
then [separator, totals]
|
then [separator, totals]
|
||||||
@@ -261,8 +276,10 @@ goalieReport width showTotals lineNumbers goalieData = let
|
|||||||
then "GOALTENDING TOTALS"
|
then "GOALTENDING TOTALS"
|
||||||
else ""
|
else ""
|
||||||
|
|
||||||
|
goalieData' = sortGoalies goalieData
|
||||||
|
|
||||||
tData = foldl addGoalieStats newGoalieStats
|
tData = foldl addGoalieStats newGoalieStats
|
||||||
$ map snd goalieData
|
$ map snd goalieData'
|
||||||
|
|
||||||
header =
|
header =
|
||||||
[ CellText "NO."
|
[ CellText "NO."
|
||||||
@@ -287,7 +304,7 @@ goalieReport width showTotals lineNumbers goalieData = let
|
|||||||
[ CellText $ show (goalie^.gNumber) ++ " "
|
[ CellText $ show (goalie^.gNumber) ++ " "
|
||||||
, CellText $ goalieName goalie
|
, CellText $ goalieName goalie
|
||||||
] ++ rowCells stats)
|
] ++ rowCells stats)
|
||||||
goalieData
|
goalieData'
|
||||||
|
|
||||||
separator
|
separator
|
||||||
= replicate 2 (CellText "")
|
= replicate 2 (CellText "")
|
||||||
@@ -299,8 +316,7 @@ goalieReport width showTotals lineNumbers goalieData = let
|
|||||||
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
then "" : [right 2 $ show x | x <- [(1 :: Int)..]]
|
||||||
else repeat ""
|
else repeat ""
|
||||||
|
|
||||||
in map (\(ln, line) -> overlay ln $ centre width line)
|
in zipWith (\ln line -> overlay ln $ centre width line) lnOverlay
|
||||||
$ zip lnOverlay
|
|
||||||
$ overlayLast olayText
|
$ overlayLast olayText
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ header : body ++ if showTotals
|
$ header : body ++ if showTotals
|
||||||
@@ -309,6 +325,8 @@ goalieReport width showTotals lineNumbers goalieData = let
|
|||||||
|
|
||||||
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
gameGoalieReport :: Int -> [(Goalie, GoalieStats)] -> [String]
|
||||||
gameGoalieReport width goalieData = let
|
gameGoalieReport width goalieData = let
|
||||||
|
goalieData' = sortGoalies goalieData
|
||||||
|
|
||||||
header =
|
header =
|
||||||
[ CellText "NO."
|
[ CellText "NO."
|
||||||
, CellText "GOALTENDER"
|
, CellText "GOALTENDER"
|
||||||
@@ -325,8 +343,16 @@ gameGoalieReport width goalieData = let
|
|||||||
, CellText $ show $ stats^.gsGoalsAllowed
|
, CellText $ show $ stats^.gsGoalsAllowed
|
||||||
, CellText $ showFloating $ gsAverage stats
|
, CellText $ showFloating $ gsAverage stats
|
||||||
])
|
])
|
||||||
goalieData
|
goalieData'
|
||||||
|
|
||||||
in map (centre width)
|
in map (centre width)
|
||||||
$ complexTable ([right, left] ++ repeat right)
|
$ complexTable ([right, left] ++ repeat right)
|
||||||
$ header : body
|
$ header : body
|
||||||
|
|
||||||
|
sortPlayers :: [(Player, PlayerStats)] -> [(Player, PlayerStats)]
|
||||||
|
sortPlayers = sortOn $ Down . \(p, ps) ->
|
||||||
|
(psPoints ps, psPoints $ p^.pLifetime)
|
||||||
|
|
||||||
|
sortGoalies :: [(Goalie, GoalieStats)] -> [(Goalie, GoalieStats)]
|
||||||
|
sortGoalies = sortOn $ Down . \(g, gs) ->
|
||||||
|
(gs^.gsMinsPlayed, g^.gLifetime.gsMinsPlayed)
|
||||||
|
|||||||
@@ -50,6 +50,7 @@ module Mtlstats.Types (
|
|||||||
-- ** ProgState Lenses
|
-- ** ProgState Lenses
|
||||||
database,
|
database,
|
||||||
progMode,
|
progMode,
|
||||||
|
dbName,
|
||||||
inputBuffer,
|
inputBuffer,
|
||||||
scrollOffset,
|
scrollOffset,
|
||||||
-- ** ProgMode Lenses
|
-- ** ProgMode Lenses
|
||||||
@@ -88,19 +89,25 @@ module Mtlstats.Types (
|
|||||||
cpsNumber,
|
cpsNumber,
|
||||||
cpsName,
|
cpsName,
|
||||||
cpsPosition,
|
cpsPosition,
|
||||||
|
cpsRookieFlag,
|
||||||
|
cpsActiveFlag,
|
||||||
cpsSuccessCallback,
|
cpsSuccessCallback,
|
||||||
cpsFailureCallback,
|
cpsFailureCallback,
|
||||||
-- ** CreateGoalieState Lenses
|
-- ** CreateGoalieState Lenses
|
||||||
cgsNumber,
|
cgsNumber,
|
||||||
cgsName,
|
cgsName,
|
||||||
|
cgsRookieFlag,
|
||||||
|
cgsActiveFlag,
|
||||||
cgsSuccessCallback,
|
cgsSuccessCallback,
|
||||||
cgsFailureCallback,
|
cgsFailureCallback,
|
||||||
-- ** EditPlayerState Lenses
|
-- ** EditPlayerState Lenses
|
||||||
epsSelectedPlayer,
|
epsSelectedPlayer,
|
||||||
epsMode,
|
epsMode,
|
||||||
|
epsCallback,
|
||||||
-- ** EditGoalieState Lenses
|
-- ** EditGoalieState Lenses
|
||||||
egsSelectedGoalie,
|
egsSelectedGoalie,
|
||||||
egsMode,
|
egsMode,
|
||||||
|
egsCallback,
|
||||||
-- ** Database Lenses
|
-- ** Database Lenses
|
||||||
dbPlayers,
|
dbPlayers,
|
||||||
dbGoalies,
|
dbGoalies,
|
||||||
@@ -169,6 +176,7 @@ module Mtlstats.Types (
|
|||||||
addGameStats,
|
addGameStats,
|
||||||
-- ** Player Helpers
|
-- ** Player Helpers
|
||||||
playerSearch,
|
playerSearch,
|
||||||
|
activePlayerSearch,
|
||||||
playerSearchExact,
|
playerSearchExact,
|
||||||
modifyPlayer,
|
modifyPlayer,
|
||||||
playerSummary,
|
playerSummary,
|
||||||
@@ -178,6 +186,7 @@ module Mtlstats.Types (
|
|||||||
addPlayerStats,
|
addPlayerStats,
|
||||||
-- ** Goalie Helpers
|
-- ** Goalie Helpers
|
||||||
goalieSearch,
|
goalieSearch,
|
||||||
|
activeGoalieSearch,
|
||||||
goalieSearchExact,
|
goalieSearchExact,
|
||||||
goalieSummary,
|
goalieSummary,
|
||||||
goalieIsActive,
|
goalieIsActive,
|
||||||
@@ -202,9 +211,8 @@ import Data.Aeson
|
|||||||
, (.=)
|
, (.=)
|
||||||
)
|
)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Data.List (isInfixOf)
|
import Data.List (find, isInfixOf)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (listToMaybe)
|
|
||||||
import Lens.Micro (Lens', lens, (&), (^.), (.~))
|
import Lens.Micro (Lens', lens, (&), (^.), (.~))
|
||||||
import Lens.Micro.TH (makeLenses)
|
import Lens.Micro.TH (makeLenses)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
@@ -228,6 +236,8 @@ data ProgState = ProgState
|
|||||||
-- ^ The data to be saved
|
-- ^ The data to be saved
|
||||||
, _progMode :: ProgMode
|
, _progMode :: ProgMode
|
||||||
-- ^ The program's mode
|
-- ^ The program's mode
|
||||||
|
, _dbName :: String
|
||||||
|
-- ^ The name of the database file
|
||||||
, _inputBuffer :: String
|
, _inputBuffer :: String
|
||||||
-- ^ Buffer for user input
|
-- ^ Buffer for user input
|
||||||
, _scrollOffset :: Int
|
, _scrollOffset :: Int
|
||||||
@@ -326,6 +336,10 @@ data CreatePlayerState = CreatePlayerState
|
|||||||
-- ^ The player's name
|
-- ^ The player's name
|
||||||
, _cpsPosition :: String
|
, _cpsPosition :: String
|
||||||
-- ^ The player's position
|
-- ^ The player's position
|
||||||
|
, _cpsRookieFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the player is a rookie
|
||||||
|
, _cpsActiveFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the plauer is active
|
||||||
, _cpsSuccessCallback :: Action ()
|
, _cpsSuccessCallback :: Action ()
|
||||||
-- ^ The function to call on success
|
-- ^ The function to call on success
|
||||||
, _cpsFailureCallback :: Action ()
|
, _cpsFailureCallback :: Action ()
|
||||||
@@ -334,10 +348,14 @@ data CreatePlayerState = CreatePlayerState
|
|||||||
|
|
||||||
-- | Goalie creation status
|
-- | Goalie creation status
|
||||||
data CreateGoalieState = CreateGoalieState
|
data CreateGoalieState = CreateGoalieState
|
||||||
{ _cgsNumber :: Maybe Int
|
{ _cgsNumber :: Maybe Int
|
||||||
-- ^ The goalie's number
|
-- ^ The goalie's number
|
||||||
, _cgsName :: String
|
, _cgsName :: String
|
||||||
-- ^ The goalie's name
|
-- ^ The goalie's name
|
||||||
|
, _cgsRookieFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the goalie is a rookie
|
||||||
|
, _cgsActiveFlag :: Maybe Bool
|
||||||
|
-- ^ Indicates whether or not the goalie is active
|
||||||
, _cgsSuccessCallback :: Action ()
|
, _cgsSuccessCallback :: Action ()
|
||||||
-- ^ The function to call on success
|
-- ^ The function to call on success
|
||||||
, _cgsFailureCallback :: Action ()
|
, _cgsFailureCallback :: Action ()
|
||||||
@@ -350,6 +368,8 @@ data EditPlayerState = EditPlayerState
|
|||||||
-- ^ The index number of the player being edited
|
-- ^ The index number of the player being edited
|
||||||
, _epsMode :: EditPlayerMode
|
, _epsMode :: EditPlayerMode
|
||||||
-- ^ The editing mode
|
-- ^ The editing mode
|
||||||
|
, _epsCallback :: Action ()
|
||||||
|
-- ^ The action to perform when the edit is complete
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Player editing mode
|
-- | Player editing mode
|
||||||
@@ -360,6 +380,7 @@ data EditPlayerMode
|
|||||||
| EPPosition
|
| EPPosition
|
||||||
| EPYtd
|
| EPYtd
|
||||||
| EPLifetime
|
| EPLifetime
|
||||||
|
| EPDelete
|
||||||
| EPYtdGoals Bool
|
| EPYtdGoals Bool
|
||||||
| EPYtdAssists Bool
|
| EPYtdAssists Bool
|
||||||
| EPYtdPMin
|
| EPYtdPMin
|
||||||
@@ -373,6 +394,9 @@ data EditGoalieState = EditGoalieState
|
|||||||
{ _egsSelectedGoalie :: Maybe Int
|
{ _egsSelectedGoalie :: Maybe Int
|
||||||
-- ^ The index number of the 'Goalie' being edited
|
-- ^ The index number of the 'Goalie' being edited
|
||||||
, _egsMode :: EditGoalieMode
|
, _egsMode :: EditGoalieMode
|
||||||
|
-- ^ The editing mode
|
||||||
|
, _egsCallback :: Action ()
|
||||||
|
-- ^ The action to perform when the edit is complete
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | 'Goalie' editing mode
|
-- | 'Goalie' editing mode
|
||||||
@@ -382,6 +406,7 @@ data EditGoalieMode
|
|||||||
| EGName
|
| EGName
|
||||||
| EGYtd
|
| EGYtd
|
||||||
| EGLifetime
|
| EGLifetime
|
||||||
|
| EGDelete
|
||||||
| EGYtdGames Bool
|
| EGYtdGames Bool
|
||||||
| EGYtdMins Bool
|
| EGYtdMins Bool
|
||||||
| EGYtdGoals Bool
|
| EGYtdGoals Bool
|
||||||
@@ -763,6 +788,7 @@ newProgState :: ProgState
|
|||||||
newProgState = ProgState
|
newProgState = ProgState
|
||||||
{ _database = newDatabase
|
{ _database = newDatabase
|
||||||
, _progMode = TitleScreen
|
, _progMode = TitleScreen
|
||||||
|
, _dbName = ""
|
||||||
, _inputBuffer = ""
|
, _inputBuffer = ""
|
||||||
, _scrollOffset = 0
|
, _scrollOffset = 0
|
||||||
}
|
}
|
||||||
@@ -800,6 +826,8 @@ newCreatePlayerState = CreatePlayerState
|
|||||||
{ _cpsNumber = Nothing
|
{ _cpsNumber = Nothing
|
||||||
, _cpsName = ""
|
, _cpsName = ""
|
||||||
, _cpsPosition = ""
|
, _cpsPosition = ""
|
||||||
|
, _cpsRookieFlag = Nothing
|
||||||
|
, _cpsActiveFlag = Nothing
|
||||||
, _cpsSuccessCallback = return ()
|
, _cpsSuccessCallback = return ()
|
||||||
, _cpsFailureCallback = return ()
|
, _cpsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
@@ -809,6 +837,8 @@ newCreateGoalieState :: CreateGoalieState
|
|||||||
newCreateGoalieState = CreateGoalieState
|
newCreateGoalieState = CreateGoalieState
|
||||||
{ _cgsNumber = Nothing
|
{ _cgsNumber = Nothing
|
||||||
, _cgsName = ""
|
, _cgsName = ""
|
||||||
|
, _cgsRookieFlag = Nothing
|
||||||
|
, _cgsActiveFlag = Nothing
|
||||||
, _cgsSuccessCallback = return ()
|
, _cgsSuccessCallback = return ()
|
||||||
, _cgsFailureCallback = return ()
|
, _cgsFailureCallback = return ()
|
||||||
}
|
}
|
||||||
@@ -818,6 +848,7 @@ newEditPlayerState :: EditPlayerState
|
|||||||
newEditPlayerState = EditPlayerState
|
newEditPlayerState = EditPlayerState
|
||||||
{ _epsSelectedPlayer = Nothing
|
{ _epsSelectedPlayer = Nothing
|
||||||
, _epsMode = EPMenu
|
, _epsMode = EPMenu
|
||||||
|
, _epsCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for an 'EditGoalieState' value
|
-- | Constructor for an 'EditGoalieState' value
|
||||||
@@ -825,6 +856,7 @@ newEditGoalieState :: EditGoalieState
|
|||||||
newEditGoalieState = EditGoalieState
|
newEditGoalieState = EditGoalieState
|
||||||
{ _egsSelectedGoalie = Nothing
|
{ _egsSelectedGoalie = Nothing
|
||||||
, _egsMode = EGMenu
|
, _egsMode = EGMenu
|
||||||
|
, _egsCallback = return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor for a 'Database'
|
-- | Constructor for a 'Database'
|
||||||
@@ -973,6 +1005,23 @@ addGameStats s1 s2 = GameStats
|
|||||||
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
, _gmsGoalsAgainst = s1^.gmsGoalsAgainst + s2^.gmsGoalsAgainst
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- | Searches through a list of players with a specified criteria
|
||||||
|
playerSearchWith
|
||||||
|
:: (Player -> Bool)
|
||||||
|
-- ^ The search criteria
|
||||||
|
-> String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Player]
|
||||||
|
-- ^ The list of players to search
|
||||||
|
-> [(Int, Player)]
|
||||||
|
-- ^ The matching players with their index numbers
|
||||||
|
playerSearchWith criteria sStr =
|
||||||
|
filter match . zip [0..]
|
||||||
|
where
|
||||||
|
match (_, p)
|
||||||
|
= map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
||||||
|
&& criteria p
|
||||||
|
|
||||||
-- | Searches through a list of players
|
-- | Searches through a list of players
|
||||||
playerSearch
|
playerSearch
|
||||||
:: String
|
:: String
|
||||||
@@ -981,9 +1030,17 @@ playerSearch
|
|||||||
-- ^ The list of players to search
|
-- ^ The list of players to search
|
||||||
-> [(Int, Player)]
|
-> [(Int, Player)]
|
||||||
-- ^ The matching players with their index numbers
|
-- ^ The matching players with their index numbers
|
||||||
playerSearch sStr =
|
playerSearch = playerSearchWith $ const True
|
||||||
filter match . zip [0..]
|
|
||||||
where match (_, p) = map toUpper sStr `isInfixOf` map toUpper (p^.pName)
|
-- | Searches through a list of players for an active player
|
||||||
|
activePlayerSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Player]
|
||||||
|
-- ^ The list of players to search
|
||||||
|
-> [(Int, Player)]
|
||||||
|
-- ^ The matching players with their index numbers
|
||||||
|
activePlayerSearch = playerSearchWith (^.pActive)
|
||||||
|
|
||||||
-- | Searches for a player by exact match on name
|
-- | Searches for a player by exact match on name
|
||||||
playerSearchExact
|
playerSearchExact
|
||||||
@@ -994,7 +1051,7 @@ playerSearchExact
|
|||||||
-> Maybe (Int, Player)
|
-> Maybe (Int, Player)
|
||||||
-- ^ The player's index and value
|
-- ^ The player's index and value
|
||||||
playerSearchExact sStr =
|
playerSearchExact sStr =
|
||||||
listToMaybe . filter match . zip [0..]
|
find match . zip [0..]
|
||||||
where match (_, p) = p^.pName == sStr
|
where match (_, p) = p^.pName == sStr
|
||||||
|
|
||||||
-- | Modifies a player with a given name
|
-- | Modifies a player with a given name
|
||||||
@@ -1038,6 +1095,23 @@ addPlayerStats s1 s2 = newPlayerStats
|
|||||||
& 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 with a search criteria
|
||||||
|
goalieSearchWith
|
||||||
|
:: (Goalie -> Bool)
|
||||||
|
-- ^ The search criteria
|
||||||
|
-> String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Goalie]
|
||||||
|
-- ^ The list to search
|
||||||
|
-> [(Int, Goalie)]
|
||||||
|
-- ^ The search results with their corresponding index numbers
|
||||||
|
goalieSearchWith criteria sStr =
|
||||||
|
filter match . zip [0..]
|
||||||
|
where
|
||||||
|
match (_, g)
|
||||||
|
= map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
||||||
|
&& criteria g
|
||||||
|
|
||||||
-- | Searches a list of goalies
|
-- | Searches a list of goalies
|
||||||
goalieSearch
|
goalieSearch
|
||||||
:: String
|
:: String
|
||||||
@@ -1046,9 +1120,17 @@ goalieSearch
|
|||||||
-- ^ The list to search
|
-- ^ The list to search
|
||||||
-> [(Int, Goalie)]
|
-> [(Int, Goalie)]
|
||||||
-- ^ The search results with their corresponding index numbers
|
-- ^ The search results with their corresponding index numbers
|
||||||
goalieSearch sStr =
|
goalieSearch = goalieSearchWith $ const True
|
||||||
filter match . zip [0..]
|
|
||||||
where match (_, g) = map toUpper sStr `isInfixOf` map toUpper (g^.gName)
|
-- | Searches a list of goalies for an active goalie
|
||||||
|
activeGoalieSearch
|
||||||
|
:: String
|
||||||
|
-- ^ The search string
|
||||||
|
-> [Goalie]
|
||||||
|
-- ^ The list to search
|
||||||
|
-> [(Int, Goalie)]
|
||||||
|
-- ^ The search results with their corresponding index numbers
|
||||||
|
activeGoalieSearch = goalieSearchWith (^.gActive)
|
||||||
|
|
||||||
-- | Searches a list of goalies for an exact match
|
-- | Searches a list of goalies for an exact match
|
||||||
goalieSearchExact
|
goalieSearchExact
|
||||||
|
|||||||
@@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
module Mtlstats.Util
|
module Mtlstats.Util
|
||||||
( nth
|
( nth
|
||||||
, modifyNth
|
, modifyNth
|
||||||
|
, dropNth
|
||||||
, updateMap
|
, updateMap
|
||||||
, slice
|
, slice
|
||||||
, capitalizeName
|
, capitalizeName
|
||||||
@@ -52,8 +53,21 @@ modifyNth
|
|||||||
-> [a]
|
-> [a]
|
||||||
-- ^ The list
|
-- ^ The list
|
||||||
-> [a]
|
-> [a]
|
||||||
modifyNth n f = map (\(i, x) -> if i == n then f x else x)
|
modifyNth n f = zipWith
|
||||||
. zip [0..]
|
(\i x -> if i == n then f x else x)
|
||||||
|
[0..]
|
||||||
|
|
||||||
|
-- | Attempt to drop the nth element from a list
|
||||||
|
dropNth
|
||||||
|
:: Int
|
||||||
|
-- ^ The index of the element to drop
|
||||||
|
-> [a]
|
||||||
|
-- ^ The list to be modified
|
||||||
|
-> [a]
|
||||||
|
-- ^ The modified list
|
||||||
|
dropNth n = foldr
|
||||||
|
(\(i, x) acc -> if i == n then acc else x : acc)
|
||||||
|
[] . zip [0..]
|
||||||
|
|
||||||
-- | Modify a value indexed by a given key in a map using a default
|
-- | Modify a value indexed by a given key in a map using a default
|
||||||
-- initial value if not present
|
-- initial value if not present
|
||||||
|
|||||||
@@ -23,7 +23,7 @@ module Actions.NewGame.GoalieInputSpec (spec) where
|
|||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Lens.Micro ((^.), (&), (.~), (?~))
|
import Lens.Micro ((^.), (&), (.~), (?~), (%~))
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
import Mtlstats.Actions.NewGame.GoalieInput
|
import Mtlstats.Actions.NewGame.GoalieInput
|
||||||
@@ -33,27 +33,50 @@ import Mtlstats.Util
|
|||||||
import qualified TypesSpec as TS
|
import qualified TypesSpec as TS
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Mtlstats.Actions.GoalieInput" $ do
|
spec = describe "GoalieInput" $ do
|
||||||
finishGoalieEntrySpec
|
finishGoalieEntrySpec
|
||||||
recordGoalieStatsSpec
|
recordGoalieStatsSpec
|
||||||
setGameGoalieSpec
|
setGameGoalieSpec
|
||||||
|
|
||||||
finishGoalieEntrySpec :: Spec
|
finishGoalieEntrySpec :: Spec
|
||||||
finishGoalieEntrySpec = describe "finishGoalieEntry" $ do
|
finishGoalieEntrySpec = describe "finishGoalieEntry" $ mapM_
|
||||||
let
|
(\(label, stats, grFlag, gaFlag) -> context label $ do
|
||||||
progState stats = newProgState
|
let
|
||||||
& progMode.gameStateL.gameGoalieStats .~ stats
|
ps = newProgState
|
||||||
& finishGoalieEntry
|
& progMode.gameStateL
|
||||||
|
%~ (gameGoalieStats .~ stats)
|
||||||
|
. (gameType ?~ HomeGame)
|
||||||
|
. (homeScore ?~ 1)
|
||||||
|
. (awayScore ?~ 0)
|
||||||
|
. (overtimeFlag ?~ False)
|
||||||
|
& database.dbGoalies .~ goalies
|
||||||
|
|
||||||
context "no goalie data" $
|
ps' = finishGoalieEntry ps
|
||||||
it "should not set goaliesRecorded" $ let
|
gs = ps'^.progMode.gameStateL
|
||||||
s = progState M.empty
|
|
||||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` False
|
|
||||||
|
|
||||||
context "goalie data" $
|
describe "gameGoaliesRecorded" $
|
||||||
it "should set goaliesRecorded" $ let
|
it ("should be " ++ show grFlag) $
|
||||||
s = progState $ M.fromList [(1, newGoalieStats)]
|
gs^.gameGoaliesRecorded `shouldBe` grFlag
|
||||||
in s^.progMode.gameStateL.gameGoaliesRecorded `shouldBe` True
|
|
||||||
|
describe "gameGoalieAssigned" $
|
||||||
|
it ("should be " ++ show gaFlag) $
|
||||||
|
gs^.gameGoalieAssigned `shouldBe` gaFlag)
|
||||||
|
|
||||||
|
-- label, initial stats, goalies recorded, goalie assigned
|
||||||
|
[ ( "no goalies", noGoalies, False, False )
|
||||||
|
, ( "one goalie", oneGoalie, True, True )
|
||||||
|
, ( "two goalies", twoGoalies, True, False )
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
goalies = [joe, bob]
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
bob = newGoalie 3 "Bob"
|
||||||
|
noGoalies = M.empty
|
||||||
|
oneGoalie = M.fromList [joeStats]
|
||||||
|
twoGoalies = M.fromList [joeStats, bobStats]
|
||||||
|
joeStats = (0, newGoalieStats)
|
||||||
|
bobStats = (1, newGoalieStats)
|
||||||
|
|
||||||
recordGoalieStatsSpec :: Spec
|
recordGoalieStatsSpec :: Spec
|
||||||
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
||||||
@@ -185,107 +208,175 @@ recordGoalieStatsSpec = describe "recordGoalieStats" $ let
|
|||||||
]
|
]
|
||||||
|
|
||||||
setGameGoalieSpec :: Spec
|
setGameGoalieSpec :: Spec
|
||||||
setGameGoalieSpec = describe "setGameGoalie" $ let
|
setGameGoalieSpec = describe "setGameGoalie" $ mapM_
|
||||||
|
|
||||||
goalieStats w l t = newGoalieStats
|
(\(label, goalieId, ps, expectedJoe, expectedBob, expectedGStats) ->
|
||||||
& gsWins .~ w
|
context label $ do
|
||||||
& gsLosses .~ l
|
|
||||||
& gsTies .~ t
|
|
||||||
|
|
||||||
bob = newGoalie 2 "Bob"
|
let
|
||||||
& gYtd .~ goalieStats 10 11 12
|
ps' = setGameGoalie goalieId ps
|
||||||
& gLifetime .~ goalieStats 20 21 22
|
[joe', bob'] = ps'^.database.dbGoalies
|
||||||
|
gStats' = ps'^.progMode.gameStateL.gameGoalieStats
|
||||||
|
|
||||||
joe = newGoalie 3 "Joe"
|
context "Joe" $ joe' `TS.compareTest` expectedJoe
|
||||||
& gYtd .~ goalieStats 30 31 32
|
context "Bob" $ bob' `TS.compareTest` expectedBob
|
||||||
& gLifetime .~ goalieStats 40 41 42
|
context "game stats" $ gStats' `TS.compareTest` expectedGStats)
|
||||||
|
|
||||||
gameState h a ot = newGameState
|
[ ( "Joe wins - no shutout"
|
||||||
& gameType ?~ HomeGame
|
, 0
|
||||||
& homeScore ?~ h
|
, psWin
|
||||||
& awayScore ?~ a
|
, joeWin
|
||||||
& overtimeFlag ?~ ot
|
, bob
|
||||||
|
, gsJoeWin
|
||||||
|
)
|
||||||
|
|
||||||
winningGame = gameState 1 0 False
|
, ( "Bob wins - no shutout"
|
||||||
losingGame = gameState 0 1 False
|
, 1
|
||||||
tiedGame = gameState 0 1 True
|
, psWin
|
||||||
|
, joe
|
||||||
|
, bobWin
|
||||||
|
, gsBobWin
|
||||||
|
)
|
||||||
|
|
||||||
in mapM_
|
, ( "Joe wins - shutout"
|
||||||
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
|
, 0
|
||||||
|
, psWinSO
|
||||||
|
, joeWinSO
|
||||||
|
, bob
|
||||||
|
, gsJoeWinSO
|
||||||
|
)
|
||||||
|
|
||||||
progState = newProgState
|
, ( "Bob wins - shutout"
|
||||||
& database.dbGoalies .~ [bob, joe]
|
, 1
|
||||||
& progMode.gameStateL .~ gs
|
, psWinSO
|
||||||
& setGameGoalie setGid
|
, joe
|
||||||
|
, bobWinSO
|
||||||
|
, gsBobWinSO
|
||||||
|
)
|
||||||
|
|
||||||
in mapM_
|
, ( "Joe loses"
|
||||||
(\( chkLabel
|
, 0
|
||||||
, chkGid
|
, psLose
|
||||||
, ( gWins
|
, joeLose
|
||||||
, gLosses
|
, bob
|
||||||
, gTies
|
, gsJoeLose
|
||||||
, ytdWins
|
)
|
||||||
, ytdLosses
|
|
||||||
, ytdTies
|
|
||||||
, ltWins
|
|
||||||
, ltLosses
|
|
||||||
, ltTies
|
|
||||||
)
|
|
||||||
) -> context chkLabel $ do
|
|
||||||
let
|
|
||||||
goalie = (progState^.database.dbGoalies) !! chkGid
|
|
||||||
gameStats = progState^.progMode.gameStateL.gameGoalieStats
|
|
||||||
game = M.findWithDefault newGoalieStats chkGid gameStats
|
|
||||||
ytd = goalie^.gYtd
|
|
||||||
lifetime = goalie^.gLifetime
|
|
||||||
|
|
||||||
mapM_
|
, ( "Bob loses"
|
||||||
(\(label', expected, actual) -> context label' $
|
, 1
|
||||||
expected `TS.compareTest` actual)
|
, psLose
|
||||||
[ ( "game stats", game, goalieStats gWins gLosses gTies )
|
, joe
|
||||||
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
|
, bobLose
|
||||||
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
|
, gsBobLose
|
||||||
]
|
)
|
||||||
|
|
||||||
it "should set the gameGoalieAssigned flag" $
|
, ( "Joe overtime"
|
||||||
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
|
, 0
|
||||||
[ ( "checking Bob", 0, bobData )
|
, psOT
|
||||||
, ( "checking Joe", 1, joeData )
|
, joeOT
|
||||||
])
|
, bob
|
||||||
[ ( "Bob wins"
|
, gsJoeOT
|
||||||
, winningGame
|
)
|
||||||
, 0
|
|
||||||
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 )
|
, ( "Bob overtime"
|
||||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
, 1
|
||||||
)
|
, psOT
|
||||||
, ( "Bob loses"
|
, joe
|
||||||
, losingGame
|
, bobOT
|
||||||
, 0
|
, gsBobOT
|
||||||
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
|
)
|
||||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
]
|
||||||
)
|
|
||||||
, ( "Bob ties"
|
where
|
||||||
, tiedGame
|
|
||||||
, 0
|
joe
|
||||||
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
|
= newGoalie 2 "Joe"
|
||||||
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
|
& gYtd
|
||||||
)
|
%~ (gsShutouts .~ 11)
|
||||||
, ( "Joe wins"
|
. (gsWins .~ 12)
|
||||||
, winningGame
|
. (gsLosses .~ 13)
|
||||||
, 1
|
. (gsTies .~ 14)
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
& gLifetime
|
||||||
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 )
|
%~ (gsShutouts .~ 21)
|
||||||
)
|
. (gsWins .~ 22)
|
||||||
, ( "Joe loses"
|
. (gsLosses .~ 23)
|
||||||
, losingGame
|
. (gsTies .~ 24)
|
||||||
, 1
|
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
bob
|
||||||
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 )
|
= newGoalie 3 "Bob"
|
||||||
)
|
& gYtd
|
||||||
, ( "Joe ties"
|
%~ (gsShutouts .~ 31)
|
||||||
, tiedGame
|
. (gsWins .~ 32)
|
||||||
, 1
|
. (gsLosses .~ 33)
|
||||||
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 )
|
. (gsTies .~ 34)
|
||||||
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 )
|
& gLifetime
|
||||||
)
|
%~ (gsShutouts .~ 41)
|
||||||
]
|
. (gsWins .~ 42)
|
||||||
|
. (gsLosses .~ 43)
|
||||||
|
. (gsTies .~ 44)
|
||||||
|
|
||||||
|
joeWin = win joe
|
||||||
|
bobWin = win bob
|
||||||
|
joeWinSO = winSO joe
|
||||||
|
bobWinSO = winSO bob
|
||||||
|
joeLose = lose joe
|
||||||
|
bobLose = lose bob
|
||||||
|
joeOT = tie joe
|
||||||
|
bobOT = tie bob
|
||||||
|
|
||||||
|
psWin = mkProgState
|
||||||
|
$ (homeScore ?~ 2)
|
||||||
|
. (awayScore ?~ 1)
|
||||||
|
|
||||||
|
psWinSO = mkProgState
|
||||||
|
$ (homeScore ?~ 1)
|
||||||
|
. (awayScore ?~ 0)
|
||||||
|
|
||||||
|
psLose = mkProgState
|
||||||
|
$ (homeScore ?~ 0)
|
||||||
|
. (awayScore ?~ 1)
|
||||||
|
|
||||||
|
psOT = mkProgState
|
||||||
|
$ (homeScore ?~ 0)
|
||||||
|
. (awayScore ?~ 1)
|
||||||
|
. (overtimeFlag ?~ True)
|
||||||
|
|
||||||
|
mkProgState f
|
||||||
|
= newProgState
|
||||||
|
& database.dbGoalies .~ [joe, bob]
|
||||||
|
& progMode.gameStateL
|
||||||
|
%~ f
|
||||||
|
. (gameType ?~ HomeGame)
|
||||||
|
. (overtimeFlag ?~ False)
|
||||||
|
|
||||||
|
gsJoeWin = mkGameStats 0 incWin
|
||||||
|
gsBobWin = mkGameStats 1 incWin
|
||||||
|
gsJoeWinSO = mkGameStats 0 $ incWin . incSO
|
||||||
|
gsBobWinSO = mkGameStats 1 $ incWin . incSO
|
||||||
|
gsJoeLose = mkGameStats 0 incLoss
|
||||||
|
gsBobLose = mkGameStats 1 incLoss
|
||||||
|
gsJoeOT = mkGameStats 0 incOT
|
||||||
|
gsBobOT = mkGameStats 1 incOT
|
||||||
|
|
||||||
|
mkGameStats n f = M.fromList [(n, f newGoalieStats)]
|
||||||
|
|
||||||
|
win
|
||||||
|
= (gYtd %~ incWin)
|
||||||
|
. (gLifetime %~ incWin)
|
||||||
|
|
||||||
|
winSO
|
||||||
|
= (gYtd %~ (incWin . incSO))
|
||||||
|
. (gLifetime %~ (incWin . incSO))
|
||||||
|
|
||||||
|
lose
|
||||||
|
= (gYtd %~ incLoss)
|
||||||
|
. (gLifetime %~ incLoss)
|
||||||
|
|
||||||
|
tie
|
||||||
|
= (gYtd %~ incOT)
|
||||||
|
. (gLifetime %~ incOT)
|
||||||
|
|
||||||
|
incWin = gsWins %~ succ
|
||||||
|
incSO = gsShutouts %~ succ
|
||||||
|
incLoss = gsLosses %~ succ
|
||||||
|
incOT = gsTies %~ succ
|
||||||
|
|||||||
@@ -48,61 +48,31 @@ spec = describe "NewGame" $ do
|
|||||||
GoalieInput.spec
|
GoalieInput.spec
|
||||||
|
|
||||||
overtimeCheckSpec :: Spec
|
overtimeCheckSpec :: Spec
|
||||||
overtimeCheckSpec = describe "overtimeCheck" $ do
|
overtimeCheckSpec = describe "overtimeCheck" $ mapM_
|
||||||
|
(\(label, expectation, gt, home, away, otf) ->
|
||||||
|
context label $
|
||||||
|
it expectation $ let
|
||||||
|
ps = newProgState & progMode.gameStateL
|
||||||
|
%~ (gameType ?~ gt)
|
||||||
|
. (homeScore ?~ home)
|
||||||
|
. (awayScore ?~ away)
|
||||||
|
|
||||||
context "tie game" $ do
|
ps' = overtimeCheck ps
|
||||||
let
|
in ps'^.progMode.gameStateL.overtimeFlag `shouldBe` otf)
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should clear the home score" $
|
-- label, expectation, type, home, away, ot flag
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Nothing
|
[ ( "home win", clearFlag, HomeGame, 2, 1, Just False )
|
||||||
|
, ( "home loss", leaveFlag, HomeGame, 1, 2, Nothing )
|
||||||
|
, ( "home tie", setFlag, HomeGame, 1, 1, Just True )
|
||||||
|
, ( "away win", clearFlag, AwayGame, 1, 2, Just False )
|
||||||
|
, ( "away loss", leaveFlag, AwayGame, 2, 1, Nothing )
|
||||||
|
, ( "away tie", setFlag, AwayGame, 1, 1, Just True )
|
||||||
|
]
|
||||||
|
|
||||||
it "should clear the away score" $
|
where
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Nothing
|
clearFlag = "should set the overtimeFlag to True"
|
||||||
|
setFlag = "should set the overtimeFlag to False"
|
||||||
it "should leave the overtimeFlag blank" $
|
leaveFlag = "should leave the overtimeFlag as Nothing"
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
context "game won" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 2)
|
|
||||||
. (awayScore ?~ 1)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should set the overtimeCheck flag to False" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Just False
|
|
||||||
|
|
||||||
context "game lost" $ do
|
|
||||||
let
|
|
||||||
s = newProgState
|
|
||||||
& progMode.gameStateL
|
|
||||||
%~ (gameType ?~ HomeGame)
|
|
||||||
. (homeScore ?~ 1)
|
|
||||||
. (awayScore ?~ 2)
|
|
||||||
& overtimeCheck
|
|
||||||
|
|
||||||
it "should not change the home score" $
|
|
||||||
s^.progMode.gameStateL.homeScore `shouldBe` Just 1
|
|
||||||
|
|
||||||
it "should not change the away score" $
|
|
||||||
s^.progMode.gameStateL.awayScore `shouldBe` Just 2
|
|
||||||
|
|
||||||
it "should leave the overtimeCheck flag blank" $
|
|
||||||
s^.progMode.gameStateL.overtimeFlag `shouldBe` Nothing
|
|
||||||
|
|
||||||
updateGameStatsSpec :: Spec
|
updateGameStatsSpec :: Spec
|
||||||
updateGameStatsSpec = describe "updateGameStats" $ do
|
updateGameStatsSpec = describe "updateGameStats" $ do
|
||||||
|
|||||||
@@ -312,51 +312,93 @@ editSelectedGoalieSpec = describe "editSelectedGoalie" $ mapM_
|
|||||||
goalie' n = newGoalie n "foo"
|
goalie' n = newGoalie n "foo"
|
||||||
|
|
||||||
addPlayerSpec :: Spec
|
addPlayerSpec :: Spec
|
||||||
addPlayerSpec = describe "addPlayer" $ do
|
addPlayerSpec = describe "addPlayer" $ mapM_
|
||||||
let
|
(\(label, expectation, pm, players) -> context label $
|
||||||
p1 = newPlayer 1 "Joe" "centre"
|
it expectation $ let
|
||||||
p2 = newPlayer 2 "Bob" "defense"
|
ps = newProgState
|
||||||
db = newDatabase
|
& progMode .~ pm
|
||||||
& dbPlayers .~ [p1]
|
& database.dbPlayers .~ [joe]
|
||||||
s pm = newProgState
|
ps' = addPlayer ps
|
||||||
& progMode .~ pm
|
in ps'^.database.dbPlayers `shouldBe` players)
|
||||||
& database .~ db
|
|
||||||
|
|
||||||
context "data available" $
|
-- label, expectation, progMode, players
|
||||||
it "should create the player" $ let
|
[ ( "wrong mode", failure, MainMenu, [joe] )
|
||||||
s' = addPlayer $ s $ CreatePlayer $ newCreatePlayerState
|
, ( "missing number", failure, noNum, [joe] )
|
||||||
& cpsNumber ?~ 2
|
, ( "missing rookie flag", failure, noRookie, [joe] )
|
||||||
& cpsName .~ "Bob"
|
, ( "missing active flag", failure, noActive, [joe] )
|
||||||
& cpsPosition .~ "defense"
|
, ( "rookie", success, mkRookie, [joe, rookie] )
|
||||||
in s'^.database.dbPlayers `shouldBe` [p1, p2]
|
, ( "retired", success, mkRetired, [joe, retired] )
|
||||||
|
, ( "normal player", success, mkNormal, [joe, normal] )
|
||||||
|
]
|
||||||
|
|
||||||
context "data unavailable" $
|
where
|
||||||
it "should not create the player" $ let
|
failure = "should not create the player"
|
||||||
s' = addPlayer $ s MainMenu
|
success = "should create the player"
|
||||||
in s'^.database.dbPlayers `shouldBe` [p1]
|
noNum = mkpm Nothing (Just False) (Just True)
|
||||||
|
noRookie = mkpm (Just 3) Nothing (Just True)
|
||||||
|
noActive = mkpm (Just 3) (Just False) Nothing
|
||||||
|
mkRookie = mkpm (Just 3) (Just True) (Just True)
|
||||||
|
mkRetired = mkpm (Just 3) (Just False) (Just False)
|
||||||
|
mkNormal = mkpm (Just 3) (Just False) (Just True)
|
||||||
|
joe = newPlayer 2 "Joe" "centre"
|
||||||
|
rookie = player True True
|
||||||
|
retired = player False False
|
||||||
|
normal = player False True
|
||||||
|
|
||||||
|
player r a = newPlayer 3 "Bob" "defense"
|
||||||
|
& pRookie .~ r
|
||||||
|
& pActive .~ a
|
||||||
|
|
||||||
|
mkpm n r a = CreatePlayer $ newCreatePlayerState
|
||||||
|
& cpsNumber .~ n
|
||||||
|
& cpsName .~ "Bob"
|
||||||
|
& cpsPosition .~ "defense"
|
||||||
|
& cpsRookieFlag .~ r
|
||||||
|
& cpsActiveFlag .~ a
|
||||||
|
|
||||||
addGoalieSpec :: Spec
|
addGoalieSpec :: Spec
|
||||||
addGoalieSpec = describe "addGoalie" $ do
|
addGoalieSpec = describe "addGoalie" $ mapM_
|
||||||
let
|
(\(label, expectation, pm, goalies) -> context label $
|
||||||
g1 = newGoalie 2 "Joe"
|
it expectation $ let
|
||||||
g2 = newGoalie 3 "Bob"
|
ps = newProgState
|
||||||
db = newDatabase
|
& progMode .~ pm
|
||||||
& dbGoalies .~ [g1]
|
& database.dbGoalies .~ [joe]
|
||||||
s pm = newProgState
|
ps' = addGoalie ps
|
||||||
& database .~ db
|
in ps'^.database.dbGoalies `shouldBe` goalies)
|
||||||
& progMode .~ pm
|
|
||||||
|
|
||||||
context "data available" $
|
-- label, expectation, progMode, expected goalies
|
||||||
it "should create the goalie" $ let
|
[ ( "wrong mode", failure, MainMenu, [joe] )
|
||||||
s' = addGoalie $ s $ CreateGoalie $ newCreateGoalieState
|
, ( "no number", failure, noNum, [joe] )
|
||||||
& cgsNumber ?~ 3
|
, ( "no rookie flag", failure, noRookie, [joe] )
|
||||||
& cgsName .~ "Bob"
|
, ( "no active flag", failure, noActive, [joe] )
|
||||||
in s'^.database.dbGoalies `shouldBe` [g1, g2]
|
, ( "rookie", success, mkRookie, [joe, rookie] )
|
||||||
|
, ( "retired", success, mkRetired, [joe, retired] )
|
||||||
|
, ( "normal goalie", success, mkNormal, [joe, normal] )
|
||||||
|
]
|
||||||
|
|
||||||
context "data unavailable" $
|
where
|
||||||
it "should not create the goalie" $ let
|
failure = "should not create the goalie"
|
||||||
s' = addGoalie $ s MainMenu
|
success = "should create the goalie"
|
||||||
in s'^.database.dbGoalies `shouldBe` [g1]
|
noNum = cgs Nothing (Just False) (Just True)
|
||||||
|
noRookie = cgs (Just 3) Nothing (Just True)
|
||||||
|
noActive = cgs (Just 3) (Just False) Nothing
|
||||||
|
mkRookie = cgs (Just 3) (Just True) (Just True)
|
||||||
|
mkRetired = cgs (Just 3) (Just False) (Just False)
|
||||||
|
mkNormal = cgs (Just 3) (Just False) (Just True)
|
||||||
|
joe = newGoalie 2 "Joe"
|
||||||
|
rookie = goalie True True
|
||||||
|
retired = goalie False False
|
||||||
|
normal = goalie False True
|
||||||
|
|
||||||
|
goalie r a = newGoalie 3 "Bob"
|
||||||
|
& gRookie .~ r
|
||||||
|
& gActive .~ a
|
||||||
|
|
||||||
|
cgs n r a = CreateGoalie $ newCreateGoalieState
|
||||||
|
& cgsNumber .~ n
|
||||||
|
& cgsName .~ "Bob"
|
||||||
|
& cgsRookieFlag .~ r
|
||||||
|
& cgsActiveFlag .~ a
|
||||||
|
|
||||||
resetCreatePlayerStateSpec :: Spec
|
resetCreatePlayerStateSpec :: Spec
|
||||||
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
resetCreatePlayerStateSpec = describe "resetCreatePlayerState" $ let
|
||||||
|
|||||||
@@ -141,9 +141,9 @@ labelTableSpec = describe "labelTable" $
|
|||||||
]
|
]
|
||||||
|
|
||||||
expected =
|
expected =
|
||||||
[ " foo: bar"
|
[ " foo: bar "
|
||||||
, " baz: quux"
|
, " baz: quux"
|
||||||
, "longer: x"
|
, "longer: x "
|
||||||
]
|
]
|
||||||
|
|
||||||
in labelTable input `shouldBe` expected
|
in labelTable input `shouldBe` expected
|
||||||
|
|||||||
@@ -54,7 +54,7 @@ goalieDetailsSpec = describe "goalieDetails" $ let
|
|||||||
. ( gsTies .~ 15 )
|
. ( gsTies .~ 15 )
|
||||||
|
|
||||||
expected = unlines
|
expected = unlines
|
||||||
[ "Number: 1"
|
[ "Number: 1 "
|
||||||
, " Name: Joe*"
|
, " Name: Joe*"
|
||||||
, ""
|
, ""
|
||||||
, " YTD Lifetime"
|
, " YTD Lifetime"
|
||||||
|
|||||||
@@ -50,8 +50,8 @@ playerDetailsSpec = describe "playerDetails" $
|
|||||||
}
|
}
|
||||||
|
|
||||||
expected = unlines
|
expected = unlines
|
||||||
[ " Number: 1"
|
[ " Number: 1 "
|
||||||
, " Name: Joe*"
|
, " Name: Joe* "
|
||||||
, "Position: centre"
|
, "Position: centre"
|
||||||
, ""
|
, ""
|
||||||
, " YTD Lifetime"
|
, " YTD Lifetime"
|
||||||
|
|||||||
79
test/Helpers/PositionSpec.hs
Normal file
79
test/Helpers/PositionSpec.hs
Normal file
@@ -0,0 +1,79 @@
|
|||||||
|
{-
|
||||||
|
|
||||||
|
mtlstats
|
||||||
|
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe
|
||||||
|
<rheal.lamothe@gmail.com>
|
||||||
|
|
||||||
|
This program is free software: you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation, either version 3 of the License, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful, but
|
||||||
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Helpers.PositionSpec (spec) where
|
||||||
|
|
||||||
|
import Lens.Micro ((&), (.~))
|
||||||
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
|
||||||
|
import Mtlstats.Helpers.Position
|
||||||
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Position" $ do
|
||||||
|
posSearchSpec
|
||||||
|
posSearchExactSpec
|
||||||
|
getPositionsSpec
|
||||||
|
|
||||||
|
posSearchSpec :: Spec
|
||||||
|
posSearchSpec = describe "posSearch" $ mapM_
|
||||||
|
(\(sStr, expected) -> context ("search string: " ++ show sStr) $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
posSearch sStr db `shouldBe` expected)
|
||||||
|
[ ( "fOo"
|
||||||
|
, [ ( 2, "foo" )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
, ( "A"
|
||||||
|
, [ ( 0, "bar" )
|
||||||
|
, ( 1, "baz" )
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|
||||||
|
posSearchExactSpec :: Spec
|
||||||
|
posSearchExactSpec = describe "posSearchExact" $ mapM_
|
||||||
|
(\(input, expected) -> context ("input: " ++ show input) $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
posSearchExact input db `shouldBe` expected)
|
||||||
|
|
||||||
|
-- input, expected
|
||||||
|
[ ( "foo", Just 2 )
|
||||||
|
, ( "FOO", Nothing )
|
||||||
|
, ( "bar", Just 0 )
|
||||||
|
, ( "baz", Just 1 )
|
||||||
|
, ( "a", Nothing )
|
||||||
|
, ( "quux", Nothing )
|
||||||
|
]
|
||||||
|
|
||||||
|
getPositionsSpec :: Spec
|
||||||
|
getPositionsSpec = describe "getPositions" $ let
|
||||||
|
expected = ["bar", "baz", "foo"]
|
||||||
|
in it ("should be " ++ show expected) $
|
||||||
|
getPositions db `shouldBe` expected
|
||||||
|
|
||||||
|
db :: Database
|
||||||
|
db = newDatabase & dbPlayers .~
|
||||||
|
[ newPlayer 2 "Joe" "foo"
|
||||||
|
, newPlayer 3 "Bob" "bar"
|
||||||
|
, newPlayer 5 "Bill" "foo"
|
||||||
|
, newPlayer 8 "Ed" "baz"
|
||||||
|
]
|
||||||
@@ -25,8 +25,10 @@ import Test.Hspec (Spec, describe)
|
|||||||
|
|
||||||
import qualified Helpers.GoalieSpec as Goalie
|
import qualified Helpers.GoalieSpec as Goalie
|
||||||
import qualified Helpers.PlayerSpec as Player
|
import qualified Helpers.PlayerSpec as Player
|
||||||
|
import qualified Helpers.PositionSpec as Position
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Helper" $ do
|
spec = describe "Helper" $ do
|
||||||
Player.spec
|
Player.spec
|
||||||
Goalie.spec
|
Goalie.spec
|
||||||
|
Position.spec
|
||||||
|
|||||||
@@ -19,7 +19,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
|
{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
|
||||||
|
|
||||||
module TypesSpec
|
module TypesSpec
|
||||||
( Comparable (..)
|
( Comparable (..)
|
||||||
@@ -33,6 +33,7 @@ module TypesSpec
|
|||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
import Data.Aeson (FromJSON, ToJSON, decode, encode, toJSON)
|
||||||
import Data.Aeson.Types (Value (Object))
|
import Data.Aeson.Types (Value (Object))
|
||||||
|
import qualified Data.Map.Lazy as M
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.HashMap.Strict as HM
|
||||||
import Data.Ratio ((%))
|
import Data.Ratio ((%))
|
||||||
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
import Lens.Micro (Lens', (&), (^.), (.~), (?~))
|
||||||
@@ -72,6 +73,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
gmsPointsSpec
|
gmsPointsSpec
|
||||||
addGameStatsSpec
|
addGameStatsSpec
|
||||||
playerSearchSpec
|
playerSearchSpec
|
||||||
|
activePlayerSearchSpec
|
||||||
playerSearchExactSpec
|
playerSearchExactSpec
|
||||||
modifyPlayerSpec
|
modifyPlayerSpec
|
||||||
playerSummarySpec
|
playerSummarySpec
|
||||||
@@ -79,6 +81,7 @@ spec = describe "Mtlstats.Types" $ do
|
|||||||
psPointsSpec
|
psPointsSpec
|
||||||
addPlayerStatsSpec
|
addPlayerStatsSpec
|
||||||
goalieSearchSpec
|
goalieSearchSpec
|
||||||
|
activeGoalieSearchSpec
|
||||||
goalieSearchExactSpec
|
goalieSearchExactSpec
|
||||||
goalieSummarySpec
|
goalieSummarySpec
|
||||||
goalieIsActiveSpec
|
goalieIsActiveSpec
|
||||||
@@ -646,6 +649,19 @@ playerSearchSpec = describe "playerSearch" $ mapM_
|
|||||||
, ( "x", [] )
|
, ( "x", [] )
|
||||||
]
|
]
|
||||||
|
|
||||||
|
activePlayerSearchSpec :: Spec
|
||||||
|
activePlayerSearchSpec = describe "activePlayerSearch" $ mapM_
|
||||||
|
(\(sStr, expected) -> context sStr $
|
||||||
|
it ("should return " ++ show expected) $ let
|
||||||
|
ps = [joe, bob, steve & pActive .~ False]
|
||||||
|
in activePlayerSearch sStr ps `shouldBe` expected)
|
||||||
|
-- search, result
|
||||||
|
[ ( "joe", [(0, joe)] )
|
||||||
|
, ( "o", [(0, joe), (1, bob)] )
|
||||||
|
, ( "e", [(0, joe)] )
|
||||||
|
, ( "x", [] )
|
||||||
|
]
|
||||||
|
|
||||||
playerSearchExactSpec :: Spec
|
playerSearchExactSpec :: Spec
|
||||||
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
playerSearchExactSpec = describe "playerSearchExact" $ mapM_
|
||||||
(\(sStr, expected) -> context sStr $
|
(\(sStr, expected) -> context sStr $
|
||||||
@@ -777,6 +793,28 @@ goalieSearchSpec = describe "goalieSearch" $ do
|
|||||||
it "should return Bob" $
|
it "should return Bob" $
|
||||||
goalieSearch "bob" goalies `shouldBe` [result 1]
|
goalieSearch "bob" goalies `shouldBe` [result 1]
|
||||||
|
|
||||||
|
activeGoalieSearchSpec :: Spec
|
||||||
|
activeGoalieSearchSpec = describe "activeGoalieSearch" $ do
|
||||||
|
let
|
||||||
|
goalies =
|
||||||
|
[ newGoalie 2 "Joe"
|
||||||
|
, newGoalie 3 "Bob"
|
||||||
|
, newGoalie 5 "Steve" & gActive .~ False
|
||||||
|
]
|
||||||
|
result n = (n, goalies!!n)
|
||||||
|
|
||||||
|
context "partial match" $
|
||||||
|
it "should return Joe" $
|
||||||
|
activeGoalieSearch "e" goalies `shouldBe` [result 0]
|
||||||
|
|
||||||
|
context "no match" $
|
||||||
|
it "should return an empty list" $
|
||||||
|
activeGoalieSearch "x" goalies `shouldBe` []
|
||||||
|
|
||||||
|
context "exact match" $
|
||||||
|
it "should return Bob" $
|
||||||
|
activeGoalieSearch "bob" goalies `shouldBe` [result 1]
|
||||||
|
|
||||||
goalieSearchExactSpec :: Spec
|
goalieSearchExactSpec :: Spec
|
||||||
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
goalieSearchExactSpec = describe "goalieSearchExact" $ do
|
||||||
let
|
let
|
||||||
@@ -1005,3 +1043,48 @@ instance Comparable EditStandingsMode where
|
|||||||
compareTest actual expected =
|
compareTest actual expected =
|
||||||
it ("should be " ++ show expected) $
|
it ("should be " ++ show expected) $
|
||||||
actual `shouldBe` expected
|
actual `shouldBe` expected
|
||||||
|
|
||||||
|
instance Comparable Goalie where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
describe "gNumber" $
|
||||||
|
it ("should be " ++ show (expected^.gNumber)) $
|
||||||
|
actual^.gNumber `shouldBe` expected^.gNumber
|
||||||
|
|
||||||
|
describe "gName" $
|
||||||
|
it ("should be " ++ show (expected^.gName)) $
|
||||||
|
actual^.gName `shouldBe` expected^.gName
|
||||||
|
|
||||||
|
describe "gRookie" $
|
||||||
|
it ("should be " ++ show (expected^.gRookie)) $
|
||||||
|
actual^.gRookie `shouldBe` expected^.gRookie
|
||||||
|
|
||||||
|
describe "gActive" $
|
||||||
|
it ("should be " ++ show (expected^.gActive)) $
|
||||||
|
actual^.gActive `shouldBe` expected^.gActive
|
||||||
|
|
||||||
|
describe "gYtd" $
|
||||||
|
(actual^.gYtd) `compareTest` (expected^.gYtd)
|
||||||
|
|
||||||
|
describe "gLifetime" $
|
||||||
|
(actual^.gLifetime) `compareTest` (expected^.gLifetime)
|
||||||
|
|
||||||
|
instance Comparable (M.Map Int GoalieStats) where
|
||||||
|
compareTest actual expected = do
|
||||||
|
|
||||||
|
let
|
||||||
|
aList = M.toList actual
|
||||||
|
eList = M.toList expected
|
||||||
|
|
||||||
|
it "should have the correct number of elements" $
|
||||||
|
length aList `shouldBe` length eList
|
||||||
|
|
||||||
|
mapM_
|
||||||
|
(\(n, (ka, va), (ke, ve)) -> context ("element " ++ show n) $ do
|
||||||
|
|
||||||
|
context "key" $
|
||||||
|
it ("should be " ++ show ke) $
|
||||||
|
ka `shouldBe` ke
|
||||||
|
|
||||||
|
context "value" $ va `compareTest` ve)
|
||||||
|
(zip3 ([0..] :: [Int]) aList eList)
|
||||||
|
|||||||
@@ -30,6 +30,7 @@ spec :: Spec
|
|||||||
spec = describe "Mtlstats.Util" $ do
|
spec = describe "Mtlstats.Util" $ do
|
||||||
nthSpec
|
nthSpec
|
||||||
modifyNthSpec
|
modifyNthSpec
|
||||||
|
dropNthSpec
|
||||||
updateMapSpec
|
updateMapSpec
|
||||||
sliceSpec
|
sliceSpec
|
||||||
capitalizeNameSpec
|
capitalizeNameSpec
|
||||||
@@ -64,6 +65,20 @@ modifyNthSpec = describe "modifyNth" $ do
|
|||||||
it "should not modify the value" $
|
it "should not modify the value" $
|
||||||
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
modifyNth (-1) succ list `shouldBe` [1, 2, 3]
|
||||||
|
|
||||||
|
dropNthSpec :: Spec
|
||||||
|
dropNthSpec = describe "dropNth" $ mapM_
|
||||||
|
|
||||||
|
(\(label, n, expected) ->
|
||||||
|
context label $
|
||||||
|
it ("should be " ++ show expected) $
|
||||||
|
dropNth n list `shouldBe` expected)
|
||||||
|
|
||||||
|
[ ( "out of bounds", 1, ["foo", "baz"] )
|
||||||
|
, ( "in bounds", 3, list )
|
||||||
|
]
|
||||||
|
|
||||||
|
where list = ["foo", "bar", "baz"]
|
||||||
|
|
||||||
updateMapSpec :: Spec
|
updateMapSpec :: Spec
|
||||||
updateMapSpec = describe "updateMap" $ do
|
updateMapSpec = describe "updateMap" $ do
|
||||||
let
|
let
|
||||||
|
|||||||
8
vagrant/as_user.sh
Executable file
8
vagrant/as_user.sh
Executable file
@@ -0,0 +1,8 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
echo "export PATH=\"$HOME/.local/bin:$PATH\"" >>~vagrant/.bashrc
|
||||||
|
mkdir /vagrant/data
|
||||||
|
ln -s /vagrant/data ~vagrant/.mtlstats
|
||||||
|
|
||||||
|
cd /vagrant
|
||||||
|
stack install
|
||||||
10
vagrant/provision.sh
Executable file
10
vagrant/provision.sh
Executable file
@@ -0,0 +1,10 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
apt-get update
|
||||||
|
apt-get upgrade
|
||||||
|
apt-get -y install libghc-ncurses-dev
|
||||||
|
wget -qO- https://get.haskellstack.org/ | sh
|
||||||
|
|
||||||
|
export HOME=/home/vagrant
|
||||||
|
|
||||||
|
sudo -u vagrant /vagrant/vagrant/as_user.sh
|
||||||
Reference in New Issue
Block a user