{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
module Life.Message
( prompt
, promptNonEmpty
, abortCmd
, choose
, chooseYesNo
) where
import Colourista (blue, bold, errorMessage, formatWith, warningMessage)
import System.IO (hFlush)
import qualified Data.Text as T
putStrFlush :: Text -> IO ()
putStrFlush :: Text -> IO ()
putStrFlush msg :: Text
msg = do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
msg
Handle -> IO ()
hFlush Handle
stdout
prompt :: IO Text
prompt :: IO Text
prompt = do
Text -> IO ()
putStrFlush (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
blue] " ⟳ "
IO Text
forall (m :: * -> *). MonadIO m => m Text
getLine
promptNonEmpty :: IO Text
promptNonEmpty :: IO Text
promptNonEmpty = do
Text
res <- Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
prompt
if Text -> Bool
T.null Text
res
then Text -> IO ()
warningMessage "The answer shouldn't be empty" IO () -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Text
promptNonEmpty
else Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
res
boldDefault :: Text -> Text
boldDefault :: Text -> Text
boldDefault message :: Text
message = [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ " [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
abortCmd :: Text -> Text -> IO ()
abortCmd :: Text -> Text -> IO ()
abortCmd cmd :: Text
cmd msg :: Text
msg = do
Text -> IO ()
warningMessage Text
msg
Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Aborting 'life " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' command."
IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
printQuestion :: Text -> [Text] -> IO ()
printQuestion :: Text -> [Text] -> IO ()
printQuestion question :: Text
question [] = Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
question
printQuestion question :: Text
question (def :: Text
def:rest :: [Text]
rest) = do
let restSlash :: Text
restSlash = Text -> [Text] -> Text
T.intercalate "/" [Text]
rest
Text -> IO ()
putStrFlush (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
question Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
boldDefault Text
def
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
restSlash
choose :: Text -> NonEmpty Text -> IO Text
choose :: Text -> NonEmpty Text -> IO Text
choose question :: Text
question choices :: NonEmpty Text
choices = do
Text -> [Text] -> IO ()
printQuestion Text
question ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
choices
Text
answer <- IO Text
prompt
if | Text -> Bool
T.null Text
answer -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty Text
choices)
| Text -> Text
T.toLower Text
answer Text -> NonEmpty Text -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` NonEmpty Text
choices -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
answer
| Bool
otherwise -> do
Text -> IO ()
errorMessage "This wasn't a valid choice."
Text -> NonEmpty Text -> IO Text
choose Text
question NonEmpty Text
choices
data Answer
= Y
| N
yesOrNo :: Text -> Maybe Answer
yesOrNo :: Text -> Maybe Answer
yesOrNo (Text -> Text
T.toLower -> Text
answer )
| Text -> Bool
T.null Text
answer = Answer -> Maybe Answer
forall a. a -> Maybe a
Just Answer
Y
| Text
answer Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ["yes", "y", "ys"] = Answer -> Maybe Answer
forall a. a -> Maybe a
Just Answer
Y
| Text
answer Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` ["no", "n"] = Answer -> Maybe Answer
forall a. a -> Maybe a
Just Answer
N
| Bool
otherwise = Maybe Answer
forall a. Maybe a
Nothing
chooseYesNo :: Text -> IO Bool
chooseYesNo :: Text -> IO Bool
chooseYesNo q :: Text
q = do
Text -> [Text] -> IO ()
printQuestion Text
q ["y", "n"]
Maybe Answer
answer <- Text -> Maybe Answer
yesOrNo (Text -> Maybe Answer) -> IO Text -> IO (Maybe Answer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
prompt
case Maybe Answer
answer of
Nothing -> do
Text -> IO ()
errorMessage "This wasn't a valid choice."
Text -> IO Bool
chooseYesNo Text
q
Just Y -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Just N -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False