aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/apps/Prompt.hs
diff options
context:
space:
mode:
authorEgor Tensin <Egor.Tensin@gmail.com>2016-12-13 01:47:35 +0300
committerEgor Tensin <Egor.Tensin@gmail.com>2016-12-13 01:47:35 +0300
commitd7d33810d562a80e0954bafe045ae2275109999a (patch)
treeb07e041a8d6c840df460b5a6dd3e4fa1d56b29a8 /apps/Prompt.hs
parentuse monad transformers (diff)
downloadwindows-env-d7d33810d562a80e0954bafe045ae2275109999a.tar.gz
windows-env-d7d33810d562a80e0954bafe045ae2275109999a.zip
bugfix (withPrompt no longer swallows IOError)
Diffstat (limited to '')
-rw-r--r--apps/Prompt.hs13
1 files changed, 8 insertions, 5 deletions
diff --git a/apps/Prompt.hs b/apps/Prompt.hs
index d256f63..12a967f 100644
--- a/apps/Prompt.hs
+++ b/apps/Prompt.hs
@@ -10,6 +10,8 @@ module Prompt
) where
import Control.Monad (void, when)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except (ExceptT)
import Data.Char (toLower)
import System.IO (hFlush, stdout)
@@ -34,13 +36,14 @@ promptYesNo msg = do
promptToContinue :: IO Bool
promptToContinue = promptYesNo "Continue? (y/n) "
-withPrompt :: String -> IO a -> IO Bool
+withPrompt :: String -> ExceptT IOError IO a -> ExceptT IOError IO Bool
withPrompt msg m = do
- putStr msg
- hFlush stdout
- agreed <- promptToContinue
+ lift $ do
+ putStr msg
+ hFlush stdout
+ agreed <- lift promptToContinue
when agreed $ void m
return agreed
-withoutPrompt :: IO a -> IO Bool
+withoutPrompt :: ExceptT IOError IO a -> ExceptT IOError IO Bool
withoutPrompt m = m >> return True