implementing database load/save

This commit is contained in:
Jonathan Lamothe 2018-12-29 20:15:59 -05:00
parent d1e4287745
commit 0adbc510ae
3 changed files with 19 additions and 3 deletions

View File

@ -41,9 +41,10 @@ main = runRequest setup >>= mapM_ (S.evalStateT mainMenu)
setup :: Request Status setup :: Request Status
setup = do setup = do
g <- reqIO getStdGen g <- reqIO getStdGen
mp <- getMasterPass
p <- getDBPath p <- getDBPath
return $ Status g mp p newPWDatabase db <- loadFrom p
pw <- getMasterPass
return $ Status g pw p db
getDBPath :: Request FilePath getDBPath :: Request FilePath
getDBPath = reqIO (lookupEnv "HOME") >>= maybe getDBPath = reqIO (lookupEnv "HOME") >>= maybe

View File

@ -109,7 +109,7 @@ lockSession = do
else lockSession else lockSession
quit :: S.StateT Status IO () quit :: S.StateT Status IO ()
quit = return () quit = save
buildData :: S.StateT Status IO PWData buildData :: S.StateT Status IO PWData
buildData = do buildData = do

View File

@ -28,12 +28,15 @@ module Util
, req , req
, tryReq , tryReq
, confirm , confirm
, loadFrom
, save
) where ) where
import Control.Lens (over, view) import Control.Lens (over, view)
import Control.Monad (join) import Control.Monad (join)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.State as S
import Data.Aeson (decodeFileStrict, encodeFile)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import System.Console.HCL import System.Console.HCL
( Request ( Request
@ -41,6 +44,7 @@ import System.Console.HCL
, reqAgree , reqAgree
, reqChar , reqChar
, reqIf , reqIf
, reqIO
, reqMenu , reqMenu
, required , required
, runRequest , runRequest
@ -89,4 +93,15 @@ tryReq = lift . runRequest
confirm :: String -> Request Bool confirm :: String -> Request Bool
confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar confirm x = prompt (x ++ " (y/n): ") $ reqAgree Nothing $ fmap return reqChar
loadFrom :: FilePath -> Request PWDatabase
loadFrom path = reqIO $ (decodeFileStrict path) >>= maybe
(return newPWDatabase)
return
save :: S.StateT Status IO ()
save = do
path <- S.gets $ view dbPath
db <- S.gets $ view database
lift $ encodeFile path db
--jl --jl