load and save databases properly

src/Mtlstats.hs

@@ -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)
-import Data.Maybe (fromJust, fromMaybe)
-import Lens.Micro ((&), (.~))
-import System.EasyFile (getAppUserDataDirectory, (</>))
 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
+  return newProgState
-    dir <- getAppUserDataDirectory appName
-    let dbFile = dir </> dbFname
-    fromMaybe newDatabase <$> catch
-      (decodeFileStrict dbFile)
-      (\(_ :: IOException) -> return Nothing)
-  return
-    $ newProgState
-    & database .~ db
 
 -- | Main program loop
 mainLoop :: Action ()

src/Mtlstats/Actions.hs

@@ -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
+  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 :: 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
     dir <- getAppUserDataDirectory appName
-    let dbFile = dir </> fn
     createDirectoryIfMissing True dir
-    encodeFile dbFile db
+    return $ dir </> fn ++ ".json"

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

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
+newSeasonPrompt = dbNamePrompt "Filename for new season: " $ \fn ->
-  { promptProcessChar = \ch str -> if validChar ch
+  if null fn
-    then str ++ [toUpper ch]
+  then modify backHome
-    else str
+  else do
-  }
+    saveDatabase
-  where
+    modify
-
+      $ (dbName .~ fn)
-    prompt = strPrompt "Filename to save database: " $ \fn ->
+      . (progMode .~ NewSeason True)
-      if null fn
-      then modify backHome
-      else do
-        saveDatabase $ fn ++ ".json"
-        modify $ progMode .~ NewSeason True
-
-    validChar = (||) <$> isAlphaNum <*> (=='-')
 
 -- | 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: " $
+getDBPrompt = dbNamePrompt "Season database to load: " $ \fn -> do
-  modify . (dbName .~)
+  modify $ dbName .~ fn
+  loadDatabase
 
 -- | Prompts for a new player's number
 playerNumPrompt :: Prompt