Merge pull request #63 from mtlstats/save-db

save a copy of the database on new season

ChangeLog.md

@@ -3,6 +3,7 @@
 ## current
 - Added active flag to players/goalies
 - Clear rookie flag on new (regular) season
+- Save a copy of the database on new season
 
 ## 0.10.0
 - Don't show player number zero in reports

src/Mtlstats/Actions.hs

@@ -43,18 +43,29 @@ 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
 
 -- | Starts a new season
 startNewSeason :: ProgState -> ProgState
-startNewSeason = (progMode .~ NewSeason) . (database . dbGames .~ 0)
+startNewSeason
+  = (progMode .~ NewSeason False)
+  . (database.dbGames .~ 0)
 
 -- | Resets all players year-to-date stats
 resetYtd :: ProgState -> ProgState
@@ -196,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/Control.hs

@@ -41,10 +41,10 @@ import Mtlstats.Types
 -- run
 dispatch :: ProgState -> Controller
 dispatch s = case s^.progMode of
-  MainMenu   -> mainMenuC
-  NewSeason  -> newSeasonC
-  NewGame gs -> newGameC gs
-  EditMenu   -> editMenuC
+  MainMenu       -> mainMenuC
+  NewSeason flag -> newSeasonC flag
+  NewGame gs     -> newGameC gs
+  EditMenu       -> editMenuC
   CreatePlayer cps
     | null $ cps^.cpsNumber   -> getPlayerNumC
     | null $ cps^.cpsName     -> getPlayerNameC
@@ -63,13 +63,9 @@ mainMenuC = Controller
   , handleController = menuHandler mainMenu
   }
 
-newSeasonC :: Controller
-newSeasonC = Controller
-  { drawController   = const $ drawMenu newSeasonMenu
-  , handleController = \e -> do
-    menuHandler newSeasonMenu e
-    return True
-  }
+newSeasonC :: Bool -> Controller
+newSeasonC False = promptController newSeasonPrompt
+newSeasonC True  = menuController newSeasonMenu
 
 editMenuC :: Controller
 editMenuC = menuController editMenu

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

@@ -34,6 +34,7 @@ module Mtlstats.Prompt (
   numPromptWithFallback,
   selectPrompt,
   -- * Individual prompts
+  newSeasonPrompt,
   playerNumPrompt,
   playerNamePrompt,
   playerPosPrompt,
@@ -47,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)
@@ -167,6 +168,22 @@ numPromptWithFallback pStr fallback act = Prompt
   , promptSpecialKey  = const $ return ()
   }
 
+-- | Prompts the user for a filename to save a backup of the database
+-- to
+newSeasonPrompt :: Prompt
+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
 selectPrompt params = Prompt

src/Mtlstats/Types.hs

@@ -232,7 +232,7 @@ data ProgState = ProgState
 -- | The program mode
 data ProgMode
   = MainMenu
-  | NewSeason
+  | NewSeason Bool
   | NewGame GameState
   | EditMenu
   | CreatePlayer CreatePlayerState
@@ -242,7 +242,7 @@ data ProgMode
 
 instance Show ProgMode where
   show MainMenu         = "MainMenu"
-  show NewSeason        = "NewSeason"
+  show (NewSeason _)    = "NewSeason"
   show (NewGame _)      = "NewGame"
   show EditMenu         = "EditMenu"
   show (CreatePlayer _) = "CreatePlayer"