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 :: forall (m :: * -> *) env a r.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> (Text -> Either Text a) -> (a -> m r) -> m r
prompt Text
message Text -> Either Text a
parse a -> m r
dispatch = do
  forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogger env) =>
m ()
flushLogger

  Text
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ Text
message forall a. Semigroup a => a -> a -> a
<> Text
"? "
    forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout
    Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
T.getLine

  case Text -> Either Text a
parse Text
x of
    Left Text
err -> do
      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Text
"Invalid input" Text -> [SeriesElem] -> Message
:# [Key
"error" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
err]
      forall (m :: * -> *) env a r.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> (Text -> Either Text a) -> (a -> m r) -> m r
prompt Text
message Text -> Either Text a
parse a -> m r
dispatch
    Right a
a -> a -> m r
dispatch a
a

promptContinue
  :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) => m ()
promptContinue :: forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
m ()
promptContinue = forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> m ()
promptOrExit Text
"Continue"

promptOrExit
  :: (MonadIO m, MonadLogger m, MonadReader env m, HasLogger env)
  => Text
  -> m ()
promptOrExit :: forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> m ()
promptOrExit Text
msg = forall (m :: * -> *) env a r.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> (Text -> Either Text a) -> (a -> m r) -> m r
prompt (Text
msg forall a. Semigroup a => a -> a -> a
<> Text
" (y/n)") forall {a}. (Eq a, IsString a, Semigroup a) => a -> Either a Bool
parse forall {f :: * -> *}. MonadIO f => Bool -> f ()
dispatch
 where
  parse :: a -> Either a Bool
parse a
x
    | a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"y", a
"Y"] = forall a b. b -> Either a b
Right Bool
True
    | a
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"n", a
"N"] = forall a b. b -> Either a b
Right Bool
False
    | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ a
"Must be y, Y, n, or N (saw " forall a. Semigroup a => a -> a -> a
<> a
x forall a. Semigroup a => a -> a -> a
<> a
")"

  dispatch :: Bool -> f ()
dispatch Bool
b = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b forall (m :: * -> *) a. MonadIO m => m a
exitSuccess