{-# LANGUAGE MultiWayIf   #-}
{-# LANGUAGE ViewPatterns #-}

{- |
Copyright:  (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Contains functions for colorful printing, prompt and other terminal related
messages.
-}

module Life.Message
    ( prompt
    , promptNonEmpty
    , abortCmd

      -- * Questions
    , choose
    , chooseYesNo
    ) where

import Colourista (blue, bold, errorMessage, formatWith, warningMessage)
import System.IO (hFlush)

import qualified Data.Text as T


----------------------------------------------------------------------------
-- Ansi-terminal
----------------------------------------------------------------------------

-- Explicit flush ensures prompt messages are in the correct order on all systems.
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

{- | Read 'Text' from standard input after arrow prompt.
-}
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
<> "]"

-- | Print message and abort current process.
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

----------------------------------------------------------------------------
-- Questions
----------------------------------------------------------------------------

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