From fccf788a5ce9788d7c073321a3d19941bc1269b1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 16 Aug 2016 14:58:16 -0400
Subject: more command line interface improvements

---
 UI/Readline.hs | 23 ++++++++++++++---------
 UI/Zenity.hs   | 31 ++++++++++++++++++++++---------
 2 files changed, 36 insertions(+), 18 deletions(-)

(limited to 'UI')

diff --git a/UI/Readline.hs b/UI/Readline.hs
index 50f2e99..086da1e 100644
--- a/UI/Readline.hs
+++ b/UI/Readline.hs
@@ -17,13 +17,18 @@ import qualified Data.ByteString.UTF8 as BU8
 readlineUI :: UI
 readlineUI = UI
 	{ isAvailable = queryTerminal stdInput
-	, promptName = name
-	, promptPassword = password
-	, withProgress = progress
+	, showError = myShowError
+	, promptName = myPromptName
+	, promptPassword = myPromptPassword
+	, withProgress = myWithProgress
 	}
 
-name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-name title desc (Name suggested) checkproblem = do
+myShowError :: Desc -> IO ()
+myShowError desc = do
+	hPutStrLn stderr $ "Error: " ++ desc
+
+myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+myPromptName title desc (Name suggested) checkproblem = do
 	showTitle title
 	putStrLn desc
 	go
@@ -44,8 +49,8 @@ name title desc (Name suggested) checkproblem = do
 						go
 			Nothing -> return Nothing
 
-password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-password title desc checkproblem = bracket setup teardown (const go)
+myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
+myPromptPassword title desc checkproblem = bracket setup teardown (const go)
   where
 	setup = do
 		showTitle title
@@ -78,8 +83,8 @@ password title desc checkproblem = bracket setup teardown (const go)
 						putStrLn problem
 						go
 
-progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
-progress title desc a = bracket_ setup teardown (a sendpercent)
+myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
+myWithProgress title desc a = bracket_ setup teardown (a sendpercent)
   where
 	setup = do
 		showTitle title
diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index f61bb44..c8fca2d 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -22,13 +22,26 @@ zenityUI = UI
 		ps <- getSearchPath
 		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps
 		return (not (null loc))
-	, promptName = name
-	, promptPassword = password
-	, withProgress = progress
+	, showError = myShowError
+	, promptName = myPromptName
+	, promptPassword = myPromptPassword
+	, withProgress = myWithProgress
 	}
 
-name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-name title desc (Name suggested) checkproblem = go ""
+myShowError :: Desc -> IO ()
+myShowError desc = bracket go cleanup (\_ -> return ())
+  where
+	go = runZenity
+		[ "--error"
+		, "--title", "keysafe"
+		, "--text", "Error: " ++ desc
+		]
+	cleanup h = do
+		_ <- waitZenity h
+		return ()
+
+myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+myPromptName title desc (Name suggested) checkproblem = go ""
   where
 	go extradesc = do
 		h <- runZenity
@@ -46,8 +59,8 @@ name title desc (Name suggested) checkproblem = go ""
 					Just problem -> go problem
 			else return Nothing
 
-password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-password title desc checkproblem = go ""
+myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
+myPromptPassword title desc checkproblem = go ""
   where
 	go extradesc = do
 		h <- runZenity
@@ -71,8 +84,8 @@ password title desc checkproblem = go ""
 							Just problem -> go problem
 			else return Nothing
 
-progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
-progress title desc a = bracket setup teardown (a . sendpercent)
+myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
+myWithProgress title desc a = bracket setup teardown (a . sendpercent)
   where
 	setup = do
 		h <- runZenity
-- 
cgit v1.2.3