determine database path
This commit is contained in:
parent
aa0b8e13d2
commit
d1e4287745
30
app/Main.hs
30
app/Main.hs
@ -24,7 +24,9 @@ module Main where
|
|||||||
|
|
||||||
import Control.Monad (mapM_)
|
import Control.Monad (mapM_)
|
||||||
import Control.Monad.Trans.State as S
|
import Control.Monad.Trans.State as S
|
||||||
import System.Console.HCL (Request, reqIO, runRequest)
|
import Data.Maybe (maybe)
|
||||||
|
import System.Console.HCL (Request, reqFail, reqIO, runRequest)
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
import System.Random (getStdGen)
|
import System.Random (getStdGen)
|
||||||
|
|
||||||
import Password
|
import Password
|
||||||
@ -38,8 +40,30 @@ 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
|
mp <- getMasterPass
|
||||||
return $ Status g mp newPWDatabase
|
p <- getDBPath
|
||||||
|
return $ Status g mp p newPWDatabase
|
||||||
|
|
||||||
|
getDBPath :: Request FilePath
|
||||||
|
getDBPath = reqIO (lookupEnv "HOME") >>= maybe
|
||||||
|
(do
|
||||||
|
reqIO $ putStrLn "ERROR: can't find home directory"
|
||||||
|
reqFail)
|
||||||
|
(\home -> case pathDelim home of
|
||||||
|
Nothing -> do
|
||||||
|
reqIO $ putStrLn "ERROR: unsupported home path"
|
||||||
|
reqFail
|
||||||
|
Just delim -> return $ home ++
|
||||||
|
(if last home == delim then "" else [delim]) ++
|
||||||
|
".passman.json")
|
||||||
|
|
||||||
|
pathDelim :: FilePath -> Maybe Char
|
||||||
|
pathDelim = foldr
|
||||||
|
(\x a -> case x of
|
||||||
|
'/' -> Just '/'
|
||||||
|
'\\' -> Just '\\'
|
||||||
|
_ -> a)
|
||||||
|
Nothing
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
@ -22,7 +22,7 @@ License along with this program. If not, see
|
|||||||
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Types (Status (Status), gen, masterPass, database) where
|
module Types (Status (Status), gen, dbPath, masterPass, database) where
|
||||||
|
|
||||||
import Control.Lens (makeLenses, set, (^.))
|
import Control.Lens (makeLenses, set, (^.))
|
||||||
import System.Random (RandomGen (next, split), StdGen)
|
import System.Random (RandomGen (next, split), StdGen)
|
||||||
@ -32,6 +32,7 @@ import Password
|
|||||||
data Status = Status
|
data Status = Status
|
||||||
{ _gen :: StdGen
|
{ _gen :: StdGen
|
||||||
, _masterPass :: String
|
, _masterPass :: String
|
||||||
|
, _dbPath :: FilePath
|
||||||
, _database :: PWDatabase
|
, _database :: PWDatabase
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user