diff options
Diffstat (limited to '')
-rw-r--r-- | apps/Prompt.hs | 13 |
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 |