module SimplePrompt (
  prompt,
  prompt_,
  yesno
  ) where

import Control.Monad (void)
import Data.Bool (bool)
import Data.Char (isPrint)
import Data.List.Extra (lower, trim)

import System.IO

prompt :: String -> IO String
prompt :: String -> IO String
prompt String
s = do
  String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
s forall a. [a] -> [a] -> [a]
++ String
": "
  Handle
tty <- String -> IOMode -> IO Handle
openFile String
"/dev/tty" IOMode
ReadMode
  String
inp <- Handle -> IO String
hGetLine Handle
tty
  if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPrint String
inp
    then forall (m :: * -> *) a. Monad m => a -> m a
return String
inp
    else do
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
      String
"input rejected because of unprintable character(s): '" forall a. [a] -> [a] -> [a]
++
      forall a. Show a => a -> String
show String
inp forall a. [a] -> [a] -> [a]
++ String
"'"
    String -> IO String
prompt String
s

prompt_ :: String -> IO ()
prompt_ :: String -> IO ()
prompt_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
prompt

yesno :: Maybe Bool -> String -> IO Bool
yesno :: Maybe Bool -> String -> IO Bool
yesno Maybe Bool
mdefault String
desc = do
  String
inp <- String -> IO String
prompt forall a b. (a -> b) -> a -> b
$ String
desc forall a. [a] -> [a] -> [a]
++ String
"? " forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"[y/n]" (forall a. a -> a -> Bool -> a
bool String
"[y/N]" String
"[Y/n]") Maybe Bool
mdefault
  case String -> String
trim (String -> String
lower String
inp) of
    String
"y" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    String
"yes" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    String
"n" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    String
"no" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    String
"" -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Bool -> String -> IO Bool
yesno forall a. Maybe a
Nothing String
desc) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
mdefault
    String
_ ->  Maybe Bool -> String -> IO Bool
yesno Maybe Bool
mdefault String
desc