{-# LANGUAGE CPP #-}

module SimplePrompt (
  prompt,
  promptInitial,
  promptBuffered,
  promptNonEmpty,
  promptChar,
  promptEnter,
  promptPassword,
  yesNo,
  yesNoDefault
  ) where

import Control.Monad (void)
import Data.List.Extra (lower)

import SimplePrompt.Internal

#include "monadconstraint.h"

-- FIXME use haveTerminalUI ?
-- | prompt which drops buffered input (using clearedInput)
--
-- Ignores buffered input lines (ie if input line gotten in under 5ms)
prompt :: MONADCONSTRAINT => String -> m String
prompt :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> m String
prompt = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => InputT m a -> InputT m a
clearedInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine

-- FIXME non-empty?
-- | reads string with initial input (using clearedInput)
promptInitial :: MONADCONSTRAINT => String -> String -> m String
promptInitial :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> String -> m String
promptInitial String
s = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => InputT m a -> InputT m a
clearedInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> String -> InputT m String
getPromptInitial String
s

-- | reads string with buffering
promptBuffered :: MONADCONSTRAINT => String -> m String
promptBuffered :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> m String
promptBuffered = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine

-- | reads non-empty string (using nonEmptyInput)
promptNonEmpty :: MONADCONSTRAINT => String -> m String
promptNonEmpty :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> m String
promptNonEmpty = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
InputT m String -> InputT m String
nonEmptyInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine

-- | prompt for a password
promptPassword :: MONADCONSTRAINT => String -> m String
promptPassword :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> m String
promptPassword = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
InputT m String -> InputT m String
nonEmptyInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptPassword

-- | prompt for character key
promptChar :: MONADCONSTRAINT => String -> m Char
promptChar :: forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m Char
promptChar =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => InputT m a -> InputT m a
clearedInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m Char
getPromptChar

-- | prompt for Enter key
promptEnter :: MONADCONSTRAINT => String -> m ()
promptEnter :: forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m ()
promptEnter =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(a -> Bool) -> InputT m a -> InputT m a
untilInput (forall a. Eq a => a -> a -> Bool
== String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => InputT m a -> InputT m a
clearedInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine

-- | Yes-No prompt (accepts only {y,n,yes,no} case-insensitive)
yesNo :: MONADCONSTRAINT => String -> m Bool
yesNo :: forall (m :: * -> *). (MonadIO m, MonadMask m) => String -> m Bool
yesNo String
desc =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(MonadIO m, MonadMask m) =>
(a -> Maybe b) -> InputT m a -> InputT m b
mapInput String -> Maybe Bool
maybeYN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine forall a b. (a -> b) -> a -> b
$ String
desc forall a. [a] -> [a] -> [a]
++ String
"? [y/n]"
  where
    maybeYN :: String -> Maybe Bool
maybeYN String
inp =
      case String -> String
lower String
inp of
        String
"y" -> forall a. a -> Maybe a
Just Bool
True
        String
"yes" -> forall a. a -> Maybe a
Just Bool
True
        String
"n" -> forall a. a -> Maybe a
Just Bool
False
        String
"no" -> forall a. a -> Maybe a
Just Bool
False
        String
_ ->  forall a. Maybe a
Nothing

-- | Yes-No prompt with default (uses clearedInput)
yesNoDefault :: MONADCONSTRAINT => Bool -> String -> m Bool
yesNoDefault :: forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Bool -> String -> m Bool
yesNoDefault Bool
yes String
desc =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> m a
runPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(MonadIO m, MonadMask m) =>
(a -> Maybe b) -> InputT m a -> InputT m b
mapInput String -> Maybe Bool
maybeYN' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => InputT m a -> InputT m a
clearedInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m String
getPromptLine forall a b. (a -> b) -> a -> b
$
  String
desc forall a. [a] -> [a] -> [a]
++ String
"? " forall a. [a] -> [a] -> [a]
++ if Bool
yes then String
"[Y/n]" else String
"[y/N]"
  where
    maybeYN' :: String -> Maybe Bool
maybeYN' String
inp =
      case String -> String
lower String
inp of
        String
"" -> forall a. a -> Maybe a
Just Bool
yes
        String
"y" -> forall a. a -> Maybe a
Just Bool
True
        String
"yes" -> forall a. a -> Maybe a
Just Bool
True
        String
"n" -> forall a. a -> Maybe a
Just Bool
False
        String
"no" -> forall a. a -> Maybe a
Just Bool
False
        String
_ ->  forall a. Maybe a
Nothing