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 :: 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
|
||||||
|
|
|
@ -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
|
||||||
|
|
15
app/Util.hs
15
app/Util.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user