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
}