summaryrefslogtreecommitdiffhomepage
path: root/UI/Readline.hs
diff options
context:
space:
mode:
Diffstat (limited to 'UI/Readline.hs')
-rw-r--r--UI/Readline.hs38
1 files changed, 26 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 ""