summaryrefslogtreecommitdiffhomepage
path: root/UI
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2016-08-12 12:10:41 -0400
committerJoey Hess <joeyh@joeyh.name>2016-08-12 12:10:41 -0400
commitecc967a33fbd4724f5782f6d6b858b3df103b134 (patch)
treed7fc098e08f558170db2c6979dfd2f300e9b559d /UI
parent3ee306d3d4bda52268f07df874070b65d171694e (diff)
downloadkeysafe-ecc967a33fbd4724f5782f6d6b858b3df103b134.tar.gz
prompt for name
Diffstat (limited to 'UI')
-rw-r--r--UI/Readline.hs32
-rw-r--r--UI/Zenity.hs5
2 files changed, 21 insertions, 16 deletions
diff --git a/UI/Readline.hs b/UI/Readline.hs
index bcbe27e..50f2e99 100644
--- a/UI/Readline.hs
+++ b/UI/Readline.hs
@@ -10,7 +10,6 @@ import Types
import System.Console.Readline
import System.Posix.Terminal
import System.Posix.IO
-import Control.Monad
import Control.Exception
import System.IO
import qualified Data.ByteString.UTF8 as BU8
@@ -23,15 +22,14 @@ readlineUI = UI
, withProgress = progress
}
-name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
-name title desc checkproblem = go ""
+name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+name title desc (Name suggested) checkproblem = do
+ showTitle title
+ putStrLn desc
+ go
where
- go extradesc = do
- putStrLn title
- putStrLn ""
- putStrLn desc
- unless (null extradesc) $
- putStrLn extradesc
+ go = do
+ addHistory (BU8.toString suggested)
mname <- readline "Name> "
case mname of
Just s -> do
@@ -41,15 +39,16 @@ name title desc checkproblem = go ""
Nothing -> do
putStrLn ""
return $ Just n
- Just problem -> go problem
+ Just problem -> do
+ putStrLn problem
+ go
Nothing -> return Nothing
password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
password title desc checkproblem = bracket setup teardown (const go)
where
setup = do
- putStrLn title
- putStrLn ""
+ showTitle title
putStrLn desc
origattr <- getTerminalAttributes stdInput
let newattr = origattr `withoutMode` EnableEcho
@@ -83,10 +82,15 @@ progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
progress title desc a = bracket_ setup teardown (a sendpercent)
where
setup = do
- putStrLn title
- putStrLn ""
+ showTitle title
putStrLn desc
sendpercent p = do
putStr (show p ++ "% ")
hFlush stdout
teardown = putStrLn "done"
+
+showTitle :: Title -> IO ()
+showTitle title = do
+ putStrLn title
+ putStrLn (replicate (length title) '-')
+ putStrLn ""
diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index 3b8b028..f61bb44 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -27,14 +27,15 @@ zenityUI = UI
, withProgress = progress
}
-name :: Title -> Desc -> (Name -> Maybe Problem) -> IO (Maybe Name)
-name title desc checkproblem = go ""
+name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+name title desc (Name suggested) checkproblem = go ""
where
go extradesc = do
h <- runZenity
[ "--entry"
, "--title", title
, "--text", desc ++ "\n" ++ extradesc
+ , "--entry-text", BU8.toString suggested
]
(ret, ok) <- waitZenity h
if ok