Compare commits
18 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
c20fb30f5b | ||
|
|
3c0e690ed3 | ||
|
|
f37e231623 | ||
|
|
fbaf2a1e60 | ||
|
|
65979329bd | ||
|
|
ded019faac | ||
|
|
1322004d38 | ||
|
|
2cb279e7e7 | ||
|
|
7ca66ad801 | ||
|
|
82544046ce | ||
|
|
95c97d722e | ||
|
|
0eb46cacce | ||
|
|
25f887a5e8 | ||
|
|
7ba670948b | ||
|
|
ca06b0570e | ||
|
|
1e8473538a | ||
|
|
87336dcd1d | ||
|
|
ffa241c1f7 |
@@ -1,5 +1,10 @@
|
||||
# Changelog for mtlstats
|
||||
|
||||
## 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)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
name: mtlstats
|
||||
version: 0.14.0
|
||||
version: 0.15.0
|
||||
github: "mtlstats/mtlstats"
|
||||
license: GPL-3
|
||||
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
|
||||
|
||||
import Control.Exception (IOException, catch)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Extra (whenM)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.State (get, gets)
|
||||
import Data.Aeson (decodeFileStrict)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Lens.Micro ((&), (.~))
|
||||
import System.EasyFile (getAppUserDataDirectory, (</>))
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Control
|
||||
import Mtlstats.Types
|
||||
|
||||
@@ -44,15 +36,7 @@ initState :: C.Curses ProgState
|
||||
initState = do
|
||||
C.setEcho False
|
||||
void $ C.setCursorMode C.CursorInvisible
|
||||
db <- liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> dbFname
|
||||
fromMaybe newDatabase <$> catch
|
||||
(decodeFileStrict dbFile)
|
||||
(\(_ :: IOException) -> return Nothing)
|
||||
return
|
||||
$ newProgState
|
||||
& database .~ db
|
||||
return newProgState
|
||||
|
||||
-- | Main program loop
|
||||
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
|
||||
( startNewSeason
|
||||
@@ -43,12 +43,14 @@ module Mtlstats.Actions
|
||||
, backHome
|
||||
, scrollUp
|
||||
, scrollDown
|
||||
, loadDatabase
|
||||
, saveDatabase
|
||||
) where
|
||||
|
||||
import Control.Exception (IOException, catch)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Aeson (encodeFile)
|
||||
import Data.Aeson (decodeFileStrict, encodeFile)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.), (&), (.~), (%~))
|
||||
import System.EasyFile
|
||||
@@ -216,12 +218,27 @@ scrollUp = scrollOffset %~ max 0 . pred
|
||||
scrollDown :: ProgState -> ProgState
|
||||
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
|
||||
saveDatabase :: String -> Action ()
|
||||
saveDatabase fn = do
|
||||
db <- gets (^.database)
|
||||
saveDatabase :: Action ()
|
||||
saveDatabase = do
|
||||
db <- gets (^.database)
|
||||
dbFile <- dbSetup
|
||||
liftIO $ encodeFile dbFile db
|
||||
|
||||
dbSetup :: Action String
|
||||
dbSetup = do
|
||||
fn <- gets (^.dbName)
|
||||
liftIO $ do
|
||||
dir <- getAppUserDataDirectory appName
|
||||
let dbFile = dir </> fn
|
||||
createDirectoryIfMissing True dir
|
||||
encodeFile dbFile db
|
||||
return $ dir </> fn ++ ".json"
|
||||
|
||||
@@ -33,10 +33,6 @@ maxFunKeys = 9
|
||||
appName :: String
|
||||
appName = "mtlstats"
|
||||
|
||||
-- | The database filename
|
||||
dbFname :: String
|
||||
dbFname = "database.json"
|
||||
|
||||
-- | The maximum number of assists
|
||||
maxAssists :: Int
|
||||
maxAssists = 2
|
||||
|
||||
@@ -39,7 +39,7 @@ import Mtlstats.Types
|
||||
dispatch :: ProgState -> Controller
|
||||
dispatch s = case s^.progMode of
|
||||
TitleScreen -> titleScreenC
|
||||
MainMenu -> mainMenuC
|
||||
MainMenu -> mainMenuC s
|
||||
NewSeason flag -> newSeasonC flag
|
||||
NewGame gs -> newGameC gs
|
||||
EditMenu -> editMenuC
|
||||
@@ -49,11 +49,13 @@ dispatch s = case s^.progMode of
|
||||
EditGoalie egs -> editGoalieC egs
|
||||
(EditStandings esm) -> editStandingsC esm
|
||||
|
||||
mainMenuC :: Controller
|
||||
mainMenuC = Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
mainMenuC :: ProgState -> Controller
|
||||
mainMenuC s = if null $ s^.dbName
|
||||
then promptController getDBPrompt
|
||||
else Controller
|
||||
{ drawController = const $ drawMenu mainMenu
|
||||
, handleController = menuHandler mainMenu
|
||||
}
|
||||
|
||||
newSeasonC :: Bool -> Controller
|
||||
newSeasonC False = promptController newSeasonPrompt
|
||||
|
||||
@@ -23,10 +23,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.EditGoalie (editGoalieC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Goalie
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditGoalie
|
||||
@@ -52,6 +55,7 @@ editC cb =
|
||||
EGName -> nameC
|
||||
EGYtd -> ytdMenuC
|
||||
EGLifetime -> lifetimeMenuC
|
||||
EGDelete -> deleteC
|
||||
EGYtdGames b -> ytdGamesC b
|
||||
EGYtdMins b -> ytdMinsC b
|
||||
EGYtdGoals b -> ytdGoalsC b
|
||||
@@ -83,6 +87,38 @@ ytdMenuC _ = menuControllerWith header editGoalieYtdMenu
|
||||
lifetimeMenuC :: Action () -> Controller
|
||||
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 = curry $ promptController .
|
||||
uncurry editGoalieYtdGamesPrompt
|
||||
|
||||
@@ -21,10 +21,13 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
module Mtlstats.Control.EditPlayer (editPlayerC) where
|
||||
|
||||
import Control.Monad.Trans.State (gets, modify)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Lens.Micro ((^.))
|
||||
import Lens.Micro ((^.), (.~), (%~))
|
||||
import qualified UI.NCurses as C
|
||||
|
||||
import Mtlstats.Actions
|
||||
import Mtlstats.Handlers
|
||||
import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Menu
|
||||
import Mtlstats.Menu.EditPlayer
|
||||
@@ -45,6 +48,7 @@ editPlayerC eps
|
||||
EPPosition -> positionC
|
||||
EPYtd -> ytdC
|
||||
EPLifetime -> lifetimeC
|
||||
EPDelete -> deleteC
|
||||
EPYtdGoals b -> ytdGoalsC b
|
||||
EPYtdAssists b -> ytdAssistsC b
|
||||
EPYtdPMin -> ytdPMinC
|
||||
@@ -74,6 +78,38 @@ ytdC _ = menuControllerWith header editPlayerYtdMenu
|
||||
lifetimeC :: Action () -> Controller
|
||||
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 batchMode callback = promptController $
|
||||
editPlayerYtdGoalsPrompt batchMode callback
|
||||
|
||||
@@ -206,7 +206,7 @@ reportC = Controller
|
||||
C.drawString $ unlines $ slice
|
||||
(s^.scrollOffset)
|
||||
(fromInteger $ pred rows)
|
||||
(report (fromInteger $ pred cols) s)
|
||||
(displayReport (fromInteger $ pred cols) s)
|
||||
return C.CursorInvisible
|
||||
, handleController = \e -> do
|
||||
case e of
|
||||
@@ -215,7 +215,7 @@ reportC = Controller
|
||||
C.EventSpecialKey C.KeyHome -> modify $ scrollOffset .~ 0
|
||||
|
||||
C.EventCharacter '\n' -> do
|
||||
get >>= liftIO . writeFile reportFilename . unlines . report reportCols
|
||||
get >>= liftIO . writeFile reportFilename . exportReport reportCols
|
||||
modify backHome
|
||||
|
||||
_ -> return ()
|
||||
|
||||
@@ -45,7 +45,6 @@ import qualified UI.NCurses as C
|
||||
import Mtlstats.Actions
|
||||
import qualified Mtlstats.Actions.NewGame.GoalieInput as GI
|
||||
import Mtlstats.Actions.EditStandings
|
||||
import Mtlstats.Config
|
||||
import Mtlstats.Format
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Types.Menu
|
||||
@@ -115,7 +114,7 @@ mainMenu = Menu "MASTER MENU" True
|
||||
, MenuItem 'C' "EDIT MENU" $
|
||||
modify edit >> return True
|
||||
, MenuItem 'E' "EXIT" $
|
||||
saveDatabase dbFname >> return False
|
||||
saveDatabase >> return False
|
||||
]
|
||||
|
||||
-- | The new season menu
|
||||
|
||||
@@ -44,6 +44,7 @@ editGoalieMenu = Menu "EDIT GOALTENDER" () $ map
|
||||
, ( 'D', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'E', "YTD STATS", set EGYtd )
|
||||
, ( 'F', "LIFETIME STATS", set EGLifetime )
|
||||
, ( 'G', "DELETE RECORD", set EGDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
|
||||
@@ -45,6 +45,7 @@ editPlayerMenu = Menu "EDIT PLAYER" () $ map
|
||||
, ( 'E', "ACTIVE FLAG", toggleActive )
|
||||
, ( 'F', "YTD STATS", set EPYtd )
|
||||
, ( 'G', "LIFETIME STATS", set EPLifetime )
|
||||
, ( 'H', "DELETE RECORD", set EPDelete )
|
||||
, ( 'R', "RETURN TO EDIT MENU", edit )
|
||||
]
|
||||
|
||||
|
||||
@@ -32,8 +32,10 @@ module Mtlstats.Prompt (
|
||||
namePrompt,
|
||||
numPrompt,
|
||||
numPromptWithFallback,
|
||||
dbNamePrompt,
|
||||
selectPrompt,
|
||||
-- * Individual prompts
|
||||
getDBPrompt,
|
||||
newSeasonPrompt,
|
||||
playerNumPrompt,
|
||||
playerNamePrompt,
|
||||
@@ -168,24 +170,30 @@ numPromptWithFallback pStr fallback act = Prompt
|
||||
, 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
|
||||
-- to
|
||||
newSeasonPrompt :: Prompt
|
||||
newSeasonPrompt = prompt
|
||||
{ promptProcessChar = \ch str -> if validChar ch
|
||||
then str ++ [toUpper ch]
|
||||
else str
|
||||
}
|
||||
where
|
||||
|
||||
prompt = strPrompt "Filename to save database: " $ \fn ->
|
||||
if null fn
|
||||
then modify backHome
|
||||
else do
|
||||
saveDatabase $ fn ++ ".json"
|
||||
modify $ progMode .~ NewSeason True
|
||||
|
||||
validChar = (||) <$> isAlphaNum <*> (=='-')
|
||||
newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
|
||||
if null fn
|
||||
then modify backHome
|
||||
else do
|
||||
saveDatabase
|
||||
modify
|
||||
$ (dbName .~ fn)
|
||||
. (progMode .~ NewSeason True)
|
||||
|
||||
-- | Builds a selection prompt
|
||||
selectPrompt :: SelectParams a -> Prompt
|
||||
@@ -224,6 +232,12 @@ selectPrompt params = Prompt
|
||||
_ -> 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
|
||||
playerNumPrompt :: Prompt
|
||||
playerNumPrompt = numPrompt "Player number: " $
|
||||
|
||||
@@ -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 qualified Data.Map as M
|
||||
@@ -34,21 +34,37 @@ import Mtlstats.Helpers.Player
|
||||
import Mtlstats.Types
|
||||
import Mtlstats.Util
|
||||
|
||||
-- | Generates the report
|
||||
report
|
||||
-- | Generates the report displayed on screen
|
||||
displayReport
|
||||
:: Int
|
||||
-- ^ The number of columns for the report
|
||||
-> ProgState
|
||||
-- ^ The program state
|
||||
-> [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
|
||||
= standingsReport width s
|
||||
++ [""]
|
||||
++ gameStatsReport width s
|
||||
++ [""]
|
||||
++ yearToDateStatsReport width s
|
||||
++ [""]
|
||||
++ lifetimeStatsReport width s
|
||||
|
||||
standingsReport :: Int -> ProgState -> [String]
|
||||
standingsReport width s = fromMaybe [] $ do
|
||||
|
||||
@@ -50,6 +50,7 @@ module Mtlstats.Types (
|
||||
-- ** ProgState Lenses
|
||||
database,
|
||||
progMode,
|
||||
dbName,
|
||||
inputBuffer,
|
||||
scrollOffset,
|
||||
-- ** ProgMode Lenses
|
||||
@@ -233,6 +234,8 @@ data ProgState = ProgState
|
||||
-- ^ The data to be saved
|
||||
, _progMode :: ProgMode
|
||||
-- ^ The program's mode
|
||||
, _dbName :: String
|
||||
-- ^ The name of the database file
|
||||
, _inputBuffer :: String
|
||||
-- ^ Buffer for user input
|
||||
, _scrollOffset :: Int
|
||||
@@ -375,6 +378,7 @@ data EditPlayerMode
|
||||
| EPPosition
|
||||
| EPYtd
|
||||
| EPLifetime
|
||||
| EPDelete
|
||||
| EPYtdGoals Bool
|
||||
| EPYtdAssists Bool
|
||||
| EPYtdPMin
|
||||
@@ -400,6 +404,7 @@ data EditGoalieMode
|
||||
| EGName
|
||||
| EGYtd
|
||||
| EGLifetime
|
||||
| EGDelete
|
||||
| EGYtdGames Bool
|
||||
| EGYtdMins Bool
|
||||
| EGYtdGoals Bool
|
||||
@@ -781,6 +786,7 @@ newProgState :: ProgState
|
||||
newProgState = ProgState
|
||||
{ _database = newDatabase
|
||||
, _progMode = TitleScreen
|
||||
, _dbName = ""
|
||||
, _inputBuffer = ""
|
||||
, _scrollOffset = 0
|
||||
}
|
||||
|
||||
@@ -22,6 +22,7 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
module Mtlstats.Util
|
||||
( nth
|
||||
, modifyNth
|
||||
, dropNth
|
||||
, updateMap
|
||||
, slice
|
||||
, capitalizeName
|
||||
@@ -56,6 +57,18 @@ modifyNth n f = zipWith
|
||||
(\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
|
||||
-- initial value if not present
|
||||
updateMap
|
||||
|
||||
@@ -30,6 +30,7 @@ spec :: Spec
|
||||
spec = describe "Mtlstats.Util" $ do
|
||||
nthSpec
|
||||
modifyNthSpec
|
||||
dropNthSpec
|
||||
updateMapSpec
|
||||
sliceSpec
|
||||
capitalizeNameSpec
|
||||
@@ -64,6 +65,20 @@ modifyNthSpec = describe "modifyNth" $ do
|
||||
it "should not modify the value" $
|
||||
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 = describe "updateMap" $ do
|
||||
let
|
||||
|
||||
Reference in New Issue
Block a user