diff --git a/ChangeLog.md b/ChangeLog.md index ac732b9..dbddc58 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,8 @@ # Changelog for mtlstats +## current +- Ask for database to load on start-up + ## 0.14.0 - Fixed a bug that was causing shutouts to not be recorded - Output report to a text file (report.txt) diff --git a/src/Mtlstats.hs b/src/Mtlstats.hs index 32bbe06..40266c8 100644 --- a/src/Mtlstats.hs +++ b/src/Mtlstats.hs @@ -19,23 +19,15 @@ along with this program. If not, see . -} -{-# 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 () diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 582f0e6..a0d4161 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -19,7 +19,7 @@ along with this program. If not, see . -} -{-# 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" diff --git a/src/Mtlstats/Control.hs b/src/Mtlstats/Control.hs index b527fa4..460c62d 100644 --- a/src/Mtlstats/Control.hs +++ b/src/Mtlstats/Control.hs @@ -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 diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 7b298d6..336e838 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -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 diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index e250178..47e65b1 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -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: " $ diff --git a/src/Mtlstats/Types.hs b/src/Mtlstats/Types.hs index f3e37a5..6185a8c 100644 --- a/src/Mtlstats/Types.hs +++ b/src/Mtlstats/Types.hs @@ -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 @@ -781,6 +784,7 @@ newProgState :: ProgState newProgState = ProgState { _database = newDatabase , _progMode = TitleScreen + , _dbName = "" , _inputBuffer = "" , _scrollOffset = 0 }