module FortyTwo.Prompts.Confirm (confirm, confirmWithDefault) where

import qualified Data.Text as T

import FortyTwo.Renderers.Confirm (renderConfirm)
import FortyTwo.Renderers.Question (renderQuestion)
import FortyTwo.Utils (clearLines, flush)
import FortyTwo.Constants (emptyString)

-- | Normalize a string transforming it to lowercase and trimming it and getting either n or y
-- >>> normalizeString "Yes"
-- "y"
normalizeString :: String -> String
normalizeString :: String -> String
normalizeString String
s = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

-- | Get a clean user input string
getCleanConfirm :: IO String
getCleanConfirm :: IO String
getCleanConfirm = do String
s <- IO String
getLine; String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
normalizeString String
s

-- | Ask a confirm falling back to a default value if no answer will be provided
confirmWithDefault :: String -> Bool -> IO Bool
confirmWithDefault :: String -> Bool -> IO Bool
confirmWithDefault String
question Bool
defaultAnswer = do
  String -> IO ()
putStrLn String
emptyString
  String -> String -> String -> IO ()
renderQuestion String
question String
defaultAnswerHumanized String
emptyString
  IO ()
renderConfirm
  IO ()
flush
  String
answer <- IO String
getCleanConfirm
  Int -> IO ()
clearLines Int
1
  if String
answer String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"n" Bool -> Bool -> Bool
|| (String
answer String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"y" Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
defaultAnswer) then do
    String -> String -> String -> IO ()
renderQuestion String
question String
emptyString String
"no"
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  else do
    String -> String -> String -> IO ()
renderQuestion String
question String
emptyString String
"yes"
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  where
    defaultAnswerHumanized :: String
defaultAnswerHumanized = if Bool
defaultAnswer then String
"yes" else String
"no"

-- | Ask a confirm question by default it will be true
confirm :: String -> IO Bool
confirm :: String -> IO Bool
confirm String
question = String -> Bool -> IO Bool
confirmWithDefault String
question Bool
False