Merge pull request #18 from mtlstats/db

load/save database
This commit is contained in:
Jonathan Lamothe 2019-09-19 12:48:36 -04:00 committed by GitHub
commit 49b909e4b1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 44 additions and 4 deletions

View File

@ -22,6 +22,7 @@ description: Please see the README on GitHub at <https://github.com/jlam
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- aeson >= 1.4.4.0 && < 1.5 - aeson >= 1.4.4.0 && < 1.5
- easy-file >= 0.2.2 && < 0.3
- extra >= 1.6.17 && < 1.7 - extra >= 1.6.17 && < 1.7
- microlens-th >= 0.4.2.3 && < 0.5 - microlens-th >= 0.4.2.3 && < 0.5
- ncurses >= 0.2.16 && < 0.3 - ncurses >= 0.2.16 && < 0.3

View File

@ -19,15 +19,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE ScopedTypeVariables #-}
module Mtlstats (initState, mainLoop) where module Mtlstats (initState, mainLoop) where
import Control.Exception (IOException, catch)
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.Extra (whenM) import Control.Monad.Extra (whenM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (get, gets) import Control.Monad.Trans.State (get, gets)
import Data.Maybe (fromJust) import Data.Aeson (decodeFileStrict)
import Data.Maybe (fromJust, fromMaybe)
import Lens.Micro ((&), (.~))
import System.EasyFile (getAppUserDataDirectory, (</>))
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Config
import Mtlstats.Control import Mtlstats.Control
import Mtlstats.Types import Mtlstats.Types
@ -36,7 +44,15 @@ initState :: C.Curses ProgState
initState = do initState = do
C.setEcho False C.setEcho False
void $ C.setCursorMode C.CursorInvisible void $ C.setCursorMode C.CursorInvisible
return newProgState db <- liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> dbFname
fromMaybe newDatabase <$> catch
(decodeFileStrict dbFile)
(\(_ :: IOException) -> return Nothing)
return
$ newProgState
& database .~ db
-- | Main program loop -- | Main program loop
mainLoop :: Action () mainLoop :: Action ()

View File

@ -28,3 +28,11 @@ myTeam = "MONTREAL"
-- | The maximum number of function keys -- | The maximum number of function keys
maxFunKeys :: Int maxFunKeys :: Int
maxFunKeys = 9 maxFunKeys = 9
-- | The application name
appName :: String
appName = "mtlstats"
-- | The database filename
dbFname :: String
dbFname = "database.json"

View File

@ -30,12 +30,21 @@ module Mtlstats.Menu (
gameTypeMenu gameTypeMenu
) where ) 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.Char (toUpper) import Data.Char (toUpper)
import Lens.Micro ((^.), (.~), (?~)) import Lens.Micro ((^.), (.~), (?~))
import Lens.Micro.Extras (view)
import System.EasyFile
( createDirectoryIfMissing
, getAppUserDataDirectory
, (</>)
)
import qualified UI.NCurses as C import qualified UI.NCurses as C
import Mtlstats.Actions import Mtlstats.Actions
import Mtlstats.Config
import Mtlstats.Types import Mtlstats.Types
import Mtlstats.Types.Menu import Mtlstats.Types.Menu
@ -62,7 +71,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
modify startNewGame >> return True modify startNewGame >> return True
, MenuItem '3' "Create Player" $ , MenuItem '3' "Create Player" $
modify createPlayer >> return True modify createPlayer >> return True
, MenuItem '4' "Exit" $ , MenuItem '4' "Exit" $ do
db <- gets $ view database
liftIO $ do
dir <- getAppUserDataDirectory appName
let dbFile = dir </> dbFname
createDirectoryIfMissing True dir
encodeFile dbFile db
return False return False
] ]