43 Commits

Author SHA1 Message Date
f869209ec6 version 0.16.1
also updated copyright notice
2021-05-08 12:19:34 -04:00
Jonathan Lamothe
c6393830e2 Merge pull request #86 from mtlstats/no-game-new-season
Don't automatically start a new game on new season
2021-05-08 12:01:17 -04:00
b054ba66f2 Don't automatically start a new game on new season 2021-05-08 11:44:38 -04:00
Jonathan Lamothe
1e0b72fc40 version 0.16.0 2020-04-15 22:26:33 -04:00
Jonathan Lamothe
2c5b4a0791 Merge pull request #85 from mtlstats/month-numbers
enter months by number
2020-04-15 22:24:14 -04:00
Jonathan Lamothe
bce31d059b enter months by number 2020-04-15 22:07:56 -04:00
Jonathan Lamothe
99baebe144 version 0.15.2 2020-04-07 21:34:05 -04:00
Jonathan Lamothe
eb3714c40a Merge pull request #84 from mtlstats/allow-ties
allow ties
2020-04-07 21:32:49 -04:00
Jonathan Lamothe
1bd3ae9564 allow ties 2020-04-07 21:30:47 -04:00
Jonathan Lamothe
2adfe9b016 version 0.15.1 2020-04-06 15:34:10 -04:00
Jonathan Lamothe
85a8e3baf1 Merge pull request #83 from mtlstats/active-player-search
only search for active players/goalies on game input
2020-04-06 15:32:29 -04:00
Jonathan Lamothe
393a2c6dc4 updated change log 2020-04-06 15:16:27 -04:00
Jonathan Lamothe
ed240c6a38 only search through active players/goalies on game input 2020-04-06 15:14:48 -04:00
Jonathan Lamothe
4f147cd5a4 implemented searchActiveGoaliePrompt 2020-04-06 15:01:26 -04:00
Jonathan Lamothe
9b6dfc4be9 implemented selectActivePlayerPrompt 2020-04-06 14:46:30 -04:00
Jonathan Lamothe
c20fb30f5b version 0.15.0 2020-03-13 00:00:52 -04:00
Jonathan Lamothe
3c0e690ed3 Merge pull request #82 from mtlstats/del-player
delete player/goalie
2020-03-12 23:59:16 -04:00
Jonathan Lamothe
f37e231623 updated change log 2020-03-12 23:53:27 -04:00
Jonathan Lamothe
fbaf2a1e60 exit properly from delete menus 2020-03-12 23:52:40 -04:00
Jonathan Lamothe
65979329bd added player/goalie delete to menus 2020-03-12 23:42:40 -04:00
Jonathan Lamothe
ded019faac implemented deleting of goalies 2020-03-12 23:37:42 -04:00
Jonathan Lamothe
1322004d38 implemented player deletion 2020-03-12 23:19:17 -04:00
Jonathan Lamothe
2cb279e7e7 implemented dropNth 2020-03-12 22:41:28 -04:00
Jonathan Lamothe
7ca66ad801 Merge pull request #81 from mtlstats/page-break
add page break to report
2020-03-12 22:14:40 -04:00
Jonathan Lamothe
82544046ce add page break to report 2020-03-12 22:09:05 -04:00
Jonathan Lamothe
95c97d722e removed unnecessary dbFname config value 2020-03-12 12:47:38 -04:00
Jonathan Lamothe
0eb46cacce Merge pull request #80 from mtlstats/season-select
Select season database on startup
2020-03-12 03:27:04 -04:00
Jonathan Lamothe
25f887a5e8 don't call modify if database isn't changing 2020-03-12 03:19:27 -04:00
Jonathan Lamothe
7ba670948b updated change log 2020-03-12 02:46:44 -04:00
Jonathan Lamothe
ca06b0570e load and save databases properly 2020-03-12 02:44:41 -04:00
Jonathan Lamothe
1e8473538a prompt for database name 2020-03-11 03:56:58 -04:00
Jonathan Lamothe
87336dcd1d control flow branch for reading database 2020-03-11 03:20:38 -04:00
Jonathan Lamothe
ffa241c1f7 added dbName field to ProgState 2020-03-11 03:09:47 -04:00
Jonathan Lamothe
f9085832f4 version 0.14.0 2020-03-05 16:56:48 -05:00
Jonathan Lamothe
e15623bde3 Merge pull request #79 from mtlstats/report-file
output report to a text file (report.txt)
2020-03-05 16:54:55 -05:00
Jonathan Lamothe
db62fbb542 output report to a text file (report.txt) 2020-03-05 16:45:40 -05:00
Jonathan Lamothe
4a8515b862 Merge pull request #78 from mtlstats/fix-shutouts
Fix shutouts
2020-03-05 05:35:17 -05:00
Jonathan Lamothe
e4c668d1e4 updated change log 2020-03-05 05:28:56 -05:00
Jonathan Lamothe
9ee33cbd03 hlint suggestions 2020-03-05 05:26:25 -05:00
Jonathan Lamothe
53c49492cb fixed shutout bug
shutouts weren't being recorded
2020-03-05 05:26:25 -05:00
Jonathan Lamothe
4d1eaa1523 Merge branch 'master' into dev 2020-03-05 05:24:57 -05:00
Jonathan Lamothe
8a8a550854 Merge pull request #77 from mtlstats/vagrant
vagrant setup
2020-03-03 14:33:58 -05:00
Jonathan Lamothe
6227df8e01 vagrant setup 2020-03-03 14:23:13 -05:00
55 changed files with 801 additions and 347 deletions

3
.gitignore vendored
View File

@@ -1,3 +1,6 @@
.stack-work/ .stack-work/
mtlstats.cabal mtlstats.cabal
.vagrant
data
*.log
*~ *~

View File

@@ -1,5 +1,26 @@
# Changelog for mtlstats # Changelog for mtlstats
## 0.16.1
- Don't automatically start a new game on new season
## 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 ## 0.13.0
- Added autocomplete to player position prompt - Added autocomplete to player position prompt
- Don't prompt for lifetime stats on rookie player/goalie creation - Don't prompt for lifetime stats on rookie player/goalie creation

10
Vagrantfile vendored Normal file
View 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

View File

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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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 ()

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
@@ -216,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"

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -90,15 +90,19 @@ setGameGoalie gid s = fromMaybe s $ do
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)

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -39,7 +39,7 @@ import Mtlstats.Types
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
@@ -49,8 +49,10 @@ dispatch s = case s^.progMode of
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
then promptController getDBPrompt
else Controller
{ drawController = const $ drawMenu mainMenu { drawController = const $ drawMenu mainMenu
, handleController = menuHandler mainMenu , handleController = menuHandler mainMenu
} }

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
@@ -52,6 +55,7 @@ editC cb =
EGName -> nameC EGName -> nameC
EGYtd -> ytdMenuC EGYtd -> ytdMenuC
EGLifetime -> lifetimeMenuC EGLifetime -> lifetimeMenuC
EGDelete -> deleteC
EGYtdGames b -> ytdGamesC b EGYtdGames b -> ytdGamesC b
EGYtdMins b -> ytdMinsC b EGYtdMins b -> ytdMinsC b
EGYtdGoals b -> ytdGoalsC b EGYtdGoals b -> ytdGoalsC b
@@ -83,6 +87,38 @@ ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
lifetimeMenuC :: Action () -> Controller lifetimeMenuC :: Action () -> Controller
lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu lifetimeMenuC _ = menuControllerWith header editGoalieLtMenu
deleteC :: Action () -> Controller
deleteC _ = Controller
{ drawController = \s -> do
C.drawString $ let
hdr = fromMaybe [] $ do
gid <- s^.progMode.editGoalieStateL.egsSelectedGoalie
goalie <- nth gid $ s^.database.dbGoalies
Just $ "Goalie: " ++ goalieDetails goalie ++ "\n\n"
in hdr ++ "Are you sure you want to delete this goalie? (Y/N)"
return C.CursorInvisible
, handleController = \e -> do
case ynHandler e of
Just True -> do
gets (^.progMode.editGoalieStateL.egsSelectedGoalie) >>= mapM_
(\gid -> modify $ database.dbGoalies %~ dropNth gid)
modify edit
Just False -> modify $ progMode.editGoalieStateL.egsMode .~ EGMenu
Nothing -> return ()
return True
}
ytdGamesC :: Bool -> Action () -> Controller ytdGamesC :: Bool -> Action () -> Controller
ytdGamesC = curry $ promptController . ytdGamesC = curry $ promptController .
uncurry editGoalieYtdGamesPrompt uncurry editGoalieYtdGamesPrompt

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
@@ -45,6 +48,7 @@ editPlayerC eps
EPPosition -> positionC EPPosition -> positionC
EPYtd -> ytdC EPYtd -> ytdC
EPLifetime -> lifetimeC EPLifetime -> lifetimeC
EPDelete -> deleteC
EPYtdGoals b -> ytdGoalsC b EPYtdGoals b -> ytdGoalsC b
EPYtdAssists b -> ytdAssistsC b EPYtdAssists b -> ytdAssistsC b
EPYtdPMin -> ytdPMinC EPYtdPMin -> ytdPMinC
@@ -74,6 +78,38 @@ ytdC _ = menuControllerWith header editPlayerYtdMenu
lifetimeC :: Action () -> Controller lifetimeC :: Action () -> Controller
lifetimeC _ = menuControllerWith header editPlayerLtMenu lifetimeC _ = menuControllerWith header editPlayerLtMenu
deleteC :: Action () -> Controller
deleteC _ = Controller
{ drawController = \s -> do
C.drawString $ let
hdr = fromMaybe [] $ do
pid <- s^.progMode.editPlayerStateL.epsSelectedPlayer
player <- nth pid $ s^.database.dbPlayers
Just $ "Player: " ++ playerDetails player ++ "\n\n"
in hdr ++ "Are you sure you want to delete this player? (Y/N)"
return C.CursorInvisible
, 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 :: Bool -> Action () -> Controller
ytdGoalsC batchMode callback = promptController $ ytdGoalsC batchMode callback = promptController $
editPlayerYtdGoalsPrompt batchMode callback editPlayerYtdGoalsPrompt batchMode callback

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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,15 +206,18 @@ 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
get >>= liftIO . writeFile reportFilename . exportReport reportCols
modify backHome
_ -> return () _ -> 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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -41,7 +41,7 @@ titleScreenC = Controller
] ]
++ titleText ++ titleText
++ [ "" ++ [ ""
, "Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe" , "Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe"
, "<rheal.lamothe@gmail.com>" , "<rheal.lamothe@gmail.com>"
, "" , ""
, "Press any key to continue..." , "Press any key to continue..."

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
@@ -125,30 +123,10 @@ newSeasonMenu = Menu "SEASON TYPE" ()
$ resetYtd $ resetYtd
. clearRookies . clearRookies
. resetStandings . resetStandings
. startNewGame . backHome
, MenuItem 'P' "PLAYOFFS" $ modify , MenuItem 'P' "PLAYOFFS" $ modify
$ resetStandings $ resetStandings
. startNewGame . backHome
]
-- | 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)
@@ -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 ()

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -44,6 +44,7 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
, ( 'D', "ACTIVE FLAG", toggleActive ) , ( 'D', "ACTIVE FLAG", toggleActive )
, ( 'E', "YTD STATS", set EGYtd ) , ( 'E', "YTD STATS", set EGYtd )
, ( 'F', "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 )
] ]

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -45,6 +45,7 @@ editPlayerMenu = Menu "EDIT PLAYER" () $ map
, ( 'E', "ACTIVE FLAG", toggleActive ) , ( 'E', "ACTIVE FLAG", toggleActive )
, ( 'F', "YTD STATS", set EPYtd ) , ( 'F', "YTD STATS", set EPYtd )
, ( 'G', "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 )
] ]

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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,9 @@ module Mtlstats.Prompt (
goalieNumPrompt, goalieNumPrompt,
goalieNamePrompt, goalieNamePrompt,
selectPlayerPrompt, selectPlayerPrompt,
selectActivePlayerPrompt,
selectGoaliePrompt, selectGoaliePrompt,
selectActiveGoaliePrompt,
selectPositionPrompt, selectPositionPrompt,
playerToEditPrompt playerToEditPrompt
) where ) where
@@ -150,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
@@ -164,30 +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 validChar ch
then str ++ [toUpper ch]
else str
}
where
prompt = strPrompt "Filename to save database: " $ \fn ->
if null fn if null fn
then modify backHome then modify backHome
else do else do
saveDatabase $ fn ++ ".json" saveDatabase
modify $ progMode .~ NewSeason True modify
$ (dbName .~ fn)
validChar = (||) <$> isAlphaNum <*> (=='-') . (progMode .~ NewSeason True)
-- | Builds a selection prompt -- | Builds a selection prompt
selectPrompt :: SelectParams a -> Prompt selectPrompt :: SelectParams a -> Prompt
@@ -226,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: " $
@@ -251,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
@@ -280,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
@@ -309,6 +364,26 @@ 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 -- | Selects (or creates) a player position
selectPositionPrompt selectPositionPrompt
:: String :: String

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
@@ -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]
@@ -301,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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -50,6 +50,7 @@ module Mtlstats.Types (
-- ** ProgState Lenses -- ** ProgState Lenses
database, database,
progMode, progMode,
dbName,
inputBuffer, inputBuffer,
scrollOffset, scrollOffset,
-- ** ProgMode Lenses -- ** ProgMode Lenses
@@ -175,6 +176,7 @@ module Mtlstats.Types (
addGameStats, addGameStats,
-- ** Player Helpers -- ** Player Helpers
playerSearch, playerSearch,
activePlayerSearch,
playerSearchExact, playerSearchExact,
modifyPlayer, modifyPlayer,
playerSummary, playerSummary,
@@ -184,6 +186,7 @@ module Mtlstats.Types (
addPlayerStats, addPlayerStats,
-- ** Goalie Helpers -- ** Goalie Helpers
goalieSearch, goalieSearch,
activeGoalieSearch,
goalieSearchExact, goalieSearchExact,
goalieSummary, goalieSummary,
goalieIsActive, goalieIsActive,
@@ -208,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
@@ -234,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
@@ -376,6 +380,7 @@ data EditPlayerMode
| EPPosition | EPPosition
| EPYtd | EPYtd
| EPLifetime | EPLifetime
| EPDelete
| EPYtdGoals Bool | EPYtdGoals Bool
| EPYtdAssists Bool | EPYtdAssists Bool
| EPYtdPMin | EPYtdPMin
@@ -401,6 +406,7 @@ data EditGoalieMode
| EGName | EGName
| EGYtd | EGYtd
| EGLifetime | EGLifetime
| EGDelete
| EGYtdGames Bool | EGYtdGames Bool
| EGYtdMins Bool | EGYtdMins Bool
| EGYtdGoals Bool | EGYtdGoals Bool
@@ -782,6 +788,7 @@ newProgState :: ProgState
newProgState = ProgState newProgState = ProgState
{ _database = newDatabase { _database = newDatabase
, _progMode = TitleScreen , _progMode = TitleScreen
, _dbName = ""
, _inputBuffer = "" , _inputBuffer = ""
, _scrollOffset = 0 , _scrollOffset = 0
} }
@@ -998,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
@@ -1006,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
@@ -1019,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
@@ -1063,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
@@ -1071,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

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- | {- |
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -33,7 +33,7 @@ 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
@@ -208,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"
& gYtd .~ goalieStats 10 11 12
& gLifetime .~ goalieStats 20 21 22
joe = newGoalie 3 "Joe"
& gYtd .~ goalieStats 30 31 32
& gLifetime .~ goalieStats 40 41 42
gameState h a ot = newGameState
& gameType ?~ HomeGame
& homeScore ?~ h
& awayScore ?~ a
& overtimeFlag ?~ ot
winningGame = gameState 1 0 False
losingGame = gameState 0 1 False
tiedGame = gameState 0 1 True
in mapM_
(\(setLabel, gs, setGid, bobData, joeData) -> context setLabel $ let
progState = newProgState
& database.dbGoalies .~ [bob, joe]
& progMode.gameStateL .~ gs
& setGameGoalie setGid
in mapM_
(\( chkLabel
, chkGid
, ( gWins
, gLosses
, gTies
, ytdWins
, ytdLosses
, ytdTies
, ltWins
, ltLosses
, ltTies
)
) -> context chkLabel $ do
let let
goalie = (progState^.database.dbGoalies) !! chkGid ps' = setGameGoalie goalieId ps
gameStats = progState^.progMode.gameStateL.gameGoalieStats [joe', bob'] = ps'^.database.dbGoalies
game = M.findWithDefault newGoalieStats chkGid gameStats gStats' = ps'^.progMode.gameStateL.gameGoalieStats
ytd = goalie^.gYtd
lifetime = goalie^.gLifetime
mapM_ context "Joe" $ joe' `TS.compareTest` expectedJoe
(\(label', expected, actual) -> context label' $ context "Bob" $ bob' `TS.compareTest` expectedBob
expected `TS.compareTest` actual) context "game stats" $ gStats' `TS.compareTest` expectedGStats)
[ ( "game stats", game, goalieStats gWins gLosses gTies )
, ( "YTD stats", ytd, goalieStats ytdWins ytdLosses ytdTies )
, ( "lifetime stats", lifetime, goalieStats ltWins ltLosses ltTies )
]
it "should set the gameGoalieAssigned flag" $ [ ( "Joe wins - no shutout"
progState^.progMode.gameStateL.gameGoalieAssigned `shouldBe` True)
[ ( "checking Bob", 0, bobData )
, ( "checking Joe", 1, joeData )
])
[ ( "Bob wins"
, winningGame
, 0 , 0
, ( 1, 0, 0, 11, 11, 12, 21, 21, 22 ) , psWin
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 ) , joeWin
, bob
, gsJoeWin
) )
, ( "Bob loses"
, losingGame , ( "Bob wins - no shutout"
, 0
, ( 0, 1, 0, 10, 12, 12, 20, 22, 22 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Bob ties"
, tiedGame
, 0
, ( 0, 0, 1, 10, 11, 13, 20, 21, 23 )
, ( 0, 0, 0, 30, 31, 32, 40, 41, 42 )
)
, ( "Joe wins"
, winningGame
, 1 , 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) , psWin
, ( 1, 0, 0, 31, 31, 32, 41, 41, 42 ) , joe
, bobWin
, gsBobWin
) )
, ( "Joe wins - shutout"
, 0
, psWinSO
, joeWinSO
, bob
, gsJoeWinSO
)
, ( "Bob wins - shutout"
, 1
, psWinSO
, joe
, bobWinSO
, gsBobWinSO
)
, ( "Joe loses" , ( "Joe loses"
, losingGame , 0
, 1 , psLose
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) , joeLose
, ( 0, 1, 0, 30, 32, 32, 40, 42, 42 ) , bob
, gsJoeLose
) )
, ( "Joe ties"
, tiedGame , ( "Bob loses"
, 1 , 1
, ( 0, 0, 0, 10, 11, 12, 20, 21, 22 ) , psLose
, ( 0, 0, 1, 30, 31, 33, 40, 41, 43 ) , joe
, bobLose
, gsBobLose
)
, ( "Joe overtime"
, 0
, psOT
, joeOT
, bob
, gsJoeOT
)
, ( "Bob overtime"
, 1
, psOT
, joe
, bobOT
, gsBobOT
) )
] ]
where
joe
= newGoalie 2 "Joe"
& gYtd
%~ (gsShutouts .~ 11)
. (gsWins .~ 12)
. (gsLosses .~ 13)
. (gsTies .~ 14)
& gLifetime
%~ (gsShutouts .~ 21)
. (gsWins .~ 22)
. (gsLosses .~ 23)
. (gsTies .~ 24)
bob
= newGoalie 3 "Bob"
& gYtd
%~ (gsShutouts .~ 31)
. (gsWins .~ 32)
. (gsLosses .~ 33)
. (gsTies .~ 34)
& 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

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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"

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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"

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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)

View File

@@ -1,7 +1,7 @@
{- {-
mtlstats mtlstats
Copyright (C) 1984, 1985, 2019, 2020 Rhéal Lamothe Copyright (C) 1984, 1985, 2019, 2020, 2021 Rhéal Lamothe
<rheal.lamothe@gmail.com> <rheal.lamothe@gmail.com>
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@@ -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
View 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
View 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