module Taskell.UI.CLI
    ( prompt
    , promptYN
    , PromptYN(PromptYes)
    ) where

import ClassyPrelude

prompt :: Text -> IO Text
prompt :: Text -> IO Text
prompt Text
s = do
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
    Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout -- prevents buffering
    IO Text
forall (m :: * -> *). MonadIO m => m Text
getLine

data PromptYN
    = PromptYes
    | PromptNo

promptYN :: PromptYN -> Text -> IO Bool
promptYN :: PromptYN -> Text -> IO Bool
promptYN PromptYN
PromptYes Text
s = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
elem [Text
"n", Text
"no"] (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
forall t. Textual t => t -> t
toLower (Text -> Bool) -> IO Text -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Text
prompt (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (Y/n)")
promptYN PromptYN
PromptNo Text
s  = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
elem [Text
"y", Text
"yes"] (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
forall t. Textual t => t -> t
toLower (Text -> Bool) -> IO Text -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Text
prompt (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (y/N)")