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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
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 (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPrint String
inp
    then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
inp
    else do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      String
"input rejected because of unprintable character(s): '" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String -> String
forall a. Show a => a -> String
show String
inp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    String -> IO String
prompt String
s

prompt_ :: String -> IO ()
prompt_ :: String -> IO ()
prompt_ = IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> (String -> IO String) -> String -> IO ()
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 (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"? " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (Bool -> String) -> Maybe Bool -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"[y/n]" (String -> String -> Bool -> String
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" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    String
"yes" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    String
"n" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    String
"no" -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    String
"" -> IO Bool -> (Bool -> IO Bool) -> Maybe Bool -> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Bool -> String -> IO Bool
yesno Maybe Bool
forall a. Maybe a
Nothing String
desc) Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
mdefault
    String
_ ->  Maybe Bool -> String -> IO Bool
yesno Maybe Bool
mdefault String
desc