module Stackctl.Prompt ( prompt , promptContinue , promptOrExit ) where import Stackctl.Prelude import Blammo.Logging.Logger (flushLogger) import qualified Data.Text as T import qualified Data.Text.IO as T prompt :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => Text -- ^ Message to present -> (Text -> Either Text a) -- ^ Parse user input (stripped) -> (a -> m r) -- ^ Action to take on result -> m r prompt message parse dispatch = do flushLogger x <- liftIO $ do T.putStr $ message <> "? " hFlush stdout T.strip <$> T.getLine case parse x of Left err -> do logWarn $ "Invalid input" :# ["error" .= err] prompt message parse dispatch Right a -> dispatch a promptContinue :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => m () promptContinue = promptOrExit "Continue" promptOrExit :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => Text -> m () promptOrExit msg = prompt (msg <> " (y/n)") parse dispatch where parse x | x `elem` ["y", "Y"] = Right True | x `elem` ["n", "N"] = Right False | otherwise = Left $ "Must be y, Y, n, or N (saw " <> x <> ")" dispatch b = unless b exitSuccess