implementing database load/save
This commit is contained in:
parent
d1e4287745
commit
0adbc510ae
|
@ -41,9 +41,10 @@ main = runRequest setup >>= mapM_ (S.evalStateT mainMenu)
|
|||
setup :: Request Status
|
||||
setup = do
|
||||
g <- reqIO getStdGen
|
||||
mp <- getMasterPass
|
||||
p <- getDBPath
|
||||
return $ Status g mp p newPWDatabase
|
||||
db <- loadFrom p
|
||||
pw <- getMasterPass
|
||||
return $ Status g pw p db
|
||||
|
||||
getDBPath :: Request FilePath
|
||||
getDBPath = reqIO (lookupEnv "HOME") >>= maybe
|
||||
|
|
|
@ -109,7 +109,7 @@ lockSession = do
|
|||
else lockSession
|
||||
|
||||
quit :: S.StateT Status IO ()
|
||||
quit = return ()
|
||||
quit = save
|
||||
|
||||
buildData :: S.StateT Status IO PWData
|
||||
buildData = do
|
||||
|
|
15
app/Util.hs
15
app/Util.hs
|
@ -28,12 +28,15 @@ module Util
|
|||
, req
|
||||
, tryReq
|
||||
, confirm
|
||||
, loadFrom
|
||||
, save
|
||||
) where
|
||||
|
||||
import Control.Lens (over, view)
|
||||
import Control.Monad (join)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import qualified Control.Monad.Trans.State as S
|
||||
import Data.Aeson (decodeFileStrict, encodeFile)
|
||||
import Data.Maybe (fromJust)
|
||||
import System.Console.HCL
|
||||
( Request
|
||||
|
@ -41,6 +44,7 @@ import System.Console.HCL
|
|||
, reqAgree
|
||||
, reqChar
|
||||
, reqIf
|
||||
, reqIO
|
||||
, reqMenu
|
||||
, required
|
||||
, runRequest
|
||||
|
@ -89,4 +93,15 @@ tryReq = lift . runRequest
|
|||
confirm :: String -> Request Bool
|
||||
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
|
||||
|
|
Loading…
Reference in New Issue
Block a user