diff --git a/src/Mtlstats/Actions.hs b/src/Mtlstats/Actions.hs index 68258e5..4e13f23 100644 --- a/src/Mtlstats/Actions.hs +++ b/src/Mtlstats/Actions.hs @@ -43,12 +43,21 @@ module Mtlstats.Actions , backHome , scrollUp , scrollDown + , saveDatabase ) where -import Control.Monad.Trans.State (modify) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.State (gets, modify) +import Data.Aeson (encodeFile) import Data.Maybe (fromMaybe) import Lens.Micro ((^.), (&), (.~), (%~)) +import System.EasyFile + ( createDirectoryIfMissing + , getAppUserDataDirectory + , () + ) +import Mtlstats.Config import Mtlstats.Types import Mtlstats.Util @@ -198,3 +207,13 @@ scrollUp = scrollOffset %~ max 0 . pred -- | Scrolls the display down scrollDown :: ProgState -> ProgState scrollDown = scrollOffset %~ succ + +-- | Saves the database +saveDatabase :: String -> Action () +saveDatabase fn = do + db <- gets (^.database) + liftIO $ do + dir <- getAppUserDataDirectory appName + let dbFile = dir fn + createDirectoryIfMissing True dir + encodeFile dbFile db diff --git a/src/Mtlstats/Menu.hs b/src/Mtlstats/Menu.hs index 40d49a0..e9e1eda 100644 --- a/src/Mtlstats/Menu.hs +++ b/src/Mtlstats/Menu.hs @@ -35,19 +35,11 @@ module Mtlstats.Menu ( editMenu ) where -import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (gets, modify) -import Data.Aeson (encodeFile) import Data.Char (toUpper) import qualified Data.Map as M import Data.Maybe (mapMaybe) import Lens.Micro ((^.), (?~)) -import Lens.Micro.Extras (view) -import System.EasyFile - ( createDirectoryIfMissing - , getAppUserDataDirectory - , () - ) import qualified UI.NCurses as C import Mtlstats.Actions @@ -116,14 +108,8 @@ mainMenu = Menu "*** MAIN MENU ***" True modify startNewGame >> return True , MenuItem '3' "Edit" $ modify edit >> return True - , MenuItem 'X' "Exit" $ do - db <- gets $ view database - liftIO $ do - dir <- getAppUserDataDirectory appName - let dbFile = dir dbFname - createDirectoryIfMissing True dir - encodeFile dbFile db - return False + , MenuItem 'X' "Exit" $ + saveDatabase dbFname >> return False ] -- | The new season menu diff --git a/src/Mtlstats/Prompt.hs b/src/Mtlstats/Prompt.hs index 298cac7..c7a6e49 100644 --- a/src/Mtlstats/Prompt.hs +++ b/src/Mtlstats/Prompt.hs @@ -48,7 +48,7 @@ module Mtlstats.Prompt ( import Control.Monad (when) import Control.Monad.Extra (whenJust) import Control.Monad.Trans.State (gets, modify) -import Data.Char (isDigit, toUpper) +import Data.Char (isAlphaNum, isDigit, toUpper) import Lens.Micro ((^.), (&), (.~), (?~), (%~)) import Lens.Micro.Extras (view) import Text.Read (readMaybe) @@ -171,7 +171,18 @@ numPromptWithFallback pStr fallback act = Prompt -- | Prompts the user for a filename to save a backup of the database -- to newSeasonPrompt :: Prompt -newSeasonPrompt = undefined +newSeasonPrompt = prompt + { promptProcessChar = \ch str -> if isAlphaNum 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 -- | Builds a selection prompt selectPrompt :: SelectParams a -> Prompt