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..26d5000 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
+ db <- gets (^.database)
+ dbFile <- dbSetup
+ db' <- liftIO $ catch
+ (fromMaybe db <$> decodeFileStrict dbFile)
+ (\(_ :: IOException) -> return db)
+ modify $ database .~ db'
+
-- | 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/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 60ccc87..47e65b1 100644
--- a/src/Mtlstats/Prompt.hs
+++ b/src/Mtlstats/Prompt.hs
@@ -186,21 +186,14 @@ dbNamePrompt pStr act = (strPrompt pStr act)
-- | 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
@@ -241,8 +234,9 @@ selectPrompt params = Prompt
-- | Prompts for the database to load
getDBPrompt :: Prompt
-getDBPrompt = dbNamePrompt "Season database to load: " $
- modify . (dbName .~)
+getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
+ modify $ dbName .~ fn
+ loadDatabase
-- | Prompts for a new player's number
playerNumPrompt :: Prompt