save a copy of the database on start of new season

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

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

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