progress display for storing

2 files changed, 39 insertions, 12 deletions

diff --git a/UI/Readline.hs b/UI/Readline.hs
index ed619df..c75bd19 100644
--- a/UI/Readline.hs
+++ b/UI/Readline.hs
@@ -22,6 +22,7 @@ readlineUI :: UI
 readlineUI = UI
 	{ isAvailable = queryTerminal stdInput
 	, showError = myShowError
+	, showInfo = myShowInfo
 	, promptQuestion = myPromptQuestion
 	, promptName = myPromptName
 	, promptPassword = myPromptPassword
@@ -32,14 +33,22 @@ readlineUI = UI
 myShowError :: Desc -> IO ()
 myShowError desc = do
 	hPutStrLn stderr $ "Error: " ++ desc
+	_ <- readline "[Press Enter]"
 	putStrLn ""
 
-myPromptQuestion :: Title -> Desc -> Question -> IO Bool
-myPromptQuestion title desc question = do
+myShowInfo :: Title -> Desc -> IO ()
+myShowInfo title desc = do
 	showTitle title
 	putStrLn desc
-	go
+	putStrLn ""
+
+myPromptQuestion :: Title -> Desc -> Question -> IO Bool
+myPromptQuestion title desc question = bracket_ setup cleanup go
   where
+	setup = do
+		showTitle title
+		putStrLn desc
+	cleanup = putStrLn ""
 	go = do
 		mresp <- readline $ question ++ " [y/n] "
 		case mresp of
@@ -53,11 +62,13 @@ myPromptQuestion title desc question = do
 				go
 
 myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-myPromptName title desc (Name suggested) checkproblem = do
-	showTitle title
-	putStrLn desc
-	go
+myPromptName title desc (Name suggested) checkproblem =
+	bracket_ setup cleanup go
   where
+	setup = do
+		showTitle title
+		putStrLn desc
+	cleanup = putStrLn ""
 	go = do
 		addHistory (BU8.toString suggested)
 		mname <- readline "Name> "
@@ -75,7 +86,7 @@ myPromptName title desc (Name suggested) checkproblem = do
 			Nothing -> return Nothing
 
 myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)
-myPromptPassword confirm title desc = bracket setup teardown (const prompt)
+myPromptPassword confirm title desc = bracket setup cleanup (const prompt)
   where
 	setup = do
 		showTitle title
@@ -84,7 +95,9 @@ myPromptPassword confirm title desc = bracket setup teardown (const prompt)
 		let newattr = origattr `withoutMode` EnableEcho
 		setTerminalAttributes stdInput newattr Immediately
 		return origattr
-	teardown origattr = setTerminalAttributes stdInput origattr Immediately
+	cleanup origattr = do
+		setTerminalAttributes stdInput origattr Immediately
+		putStrLn ""
 	prompt = do
 		putStr "Enter password> "
 		hFlush stdout
@@ -125,14 +138,15 @@ myPromptKeyId title desc l = do
 		putStrLn ""
 		case readMaybe r of
 			Just n
-				| n > 0 && n < length l ->
+				| n > 0 && n < length l -> do
+					putStrLn ""
 					return $ Just $ snd (l !! n)
 			_ -> do
 				putStrLn $ "Enter a number from 1 to " ++ show (length l)
 				prompt
 
 myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO a) -> IO a
-myWithProgress title desc a = bracket_ setup teardown (a sendpercent)
+myWithProgress title desc a = bracket_ setup cleanup (a sendpercent)
   where
 	setup = do
 		showTitle title
@@ -140,7 +154,7 @@ myWithProgress title desc a = bracket_ setup teardown (a sendpercent)
 	sendpercent p = do
 		putStr (show p ++ "%  ")
 		hFlush stdout
-	teardown = do
+	cleanup = do
 		putStrLn "done"
 		putStrLn ""
 
diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index 228b11a..a419b62 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -23,6 +23,7 @@ zenityUI = UI
 		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps
 		return (not (null loc))
 	, showError = myShowError
+	, showInfo = myShowInfo
 	, promptQuestion = myPromptQuestion
 	, promptName = myPromptName
 	, promptPassword = myPromptPassword
@@ -42,6 +43,18 @@ myShowError desc = bracket go cleanup (\_ -> return ())
 		_ <- waitZenity h
 		return ()
 
+myShowInfo :: Title -> Desc -> IO ()
+myShowInfo title desc = bracket go cleanup (\_ -> return ())
+  where
+	go = runZenity
+		[ "--info"
+		, "--title", title
+		, "--text", desc
+		]
+	cleanup h = do
+		_ <- waitZenity h
+		return ()
+
 myPromptQuestion :: Title -> Desc -> Question -> IO Bool
 myPromptQuestion title desc question = do
 	h <- runZenity