{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Distribution.Client.Init.Prompt
( prompt
, promptYesNo
, promptStr
, promptList
) where
import Prelude hiding (break, putStrLn, getLine, putStr)
import Distribution.Client.Compat.Prelude hiding (break, empty, getLine, putStr, putStrLn)
import Distribution.Client.Init.Types
import qualified System.IO
promptStr :: Interactive m => String -> DefaultPrompt String -> m String
promptStr :: forall (m :: * -> *).
Interactive m =>
String -> DefaultPrompt String -> m String
promptStr = forall (m :: * -> *) t.
Interactive m =>
(String -> Either String t)
-> (t -> String) -> String -> DefaultPrompt t -> m t
promptDefault forall a b. b -> Either a b
Right forall a. a -> a
id
promptYesNo
:: Interactive m
=> String
-> DefaultPrompt Bool
-> m Bool
promptYesNo :: forall (m :: * -> *).
Interactive m =>
String -> DefaultPrompt Bool -> m Bool
promptYesNo =
forall (m :: * -> *) t.
Interactive m =>
(String -> Either String t)
-> (t -> String) -> String -> DefaultPrompt t -> m t
promptDefault String -> Either String Bool
recogniseYesNo Bool -> String
showYesNo
where
recogniseYesNo :: String -> Either String Bool
recogniseYesNo String
s
| (Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s) forall a. Eq a => a -> a -> Bool
== String
"y" = forall a b. b -> Either a b
Right Bool
True
| (Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s) forall a. Eq a => a -> a -> Bool
== String
"n" Bool -> Bool -> Bool
|| String
s forall a. Eq a => a -> a -> Bool
== String
"N" = forall a b. b -> Either a b
Right Bool
False
| Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Cannot parse input: " forall a. [a] -> [a] -> [a]
++ String
s
showYesNo :: Bool -> String
showYesNo Bool
True = String
"y"
showYesNo Bool
False = String
"n"
prompt :: (Interactive m, Parsec t, Pretty t) => String -> DefaultPrompt t -> m t
prompt :: forall (m :: * -> *) t.
(Interactive m, Parsec t, Pretty t) =>
String -> DefaultPrompt t -> m t
prompt = forall (m :: * -> *) t.
Interactive m =>
(String -> Either String t)
-> (t -> String) -> String -> DefaultPrompt t -> m t
promptDefault forall a. Parsec a => String -> Either String a
eitherParsec forall a. Pretty a => a -> String
prettyShow
mkDefPrompt :: String -> DefaultPrompt String -> String
mkDefPrompt :: String -> DefaultPrompt String -> String
mkDefPrompt String
msg DefaultPrompt String
def = String
msg forall a. [a] -> [a] -> [a]
++ String
"?" forall a. [a] -> [a] -> [a]
++ DefaultPrompt String -> String
format DefaultPrompt String
def
where
format :: DefaultPrompt String -> String
format DefaultPrompt String
MandatoryPrompt = String
" "
format DefaultPrompt String
OptionalPrompt = String
" [optional] "
format (DefaultPrompt String
s) = String
" [default: " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"] "
promptList
:: Interactive m
=> String
-> [String]
-> DefaultPrompt String
-> Maybe (String -> String)
-> Bool
-> m String
promptList :: forall (m :: * -> *).
Interactive m =>
String
-> [String]
-> DefaultPrompt String
-> Maybe (String -> String)
-> Bool
-> m String
promptList String
msg [String]
choices DefaultPrompt String
def Maybe (String -> String)
modDef Bool
hasOther = do
forall (m :: * -> *). Interactive m => String -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
msg forall a. [a] -> [a] -> [a]
++ String
":"
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, String)]
prettyChoices forall a b. (a -> b) -> a -> b
$ \(Int
i,String
c) -> do
let star :: String
star = if forall t. t -> DefaultPrompt t
DefaultPrompt String
c forall a. Eq a => a -> a -> Bool
== DefaultPrompt String
def
then String
"*"
else String
" "
let output :: String
output = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ if Int
i forall a. Ord a => a -> a -> Bool
< Int
10
then [String
" ", String
star, String
" ", forall a. Show a => a -> String
show Int
i, String
") ", String
c]
else [String
" ", String
star, forall a. Show a => a -> String
show Int
i, String
") ", String
c]
forall (m :: * -> *). Interactive m => String -> m ()
putStrLn String
output
m String
go
where
prettyChoices :: [(Int, String)]
prettyChoices =
let cs :: [String]
cs = if Bool
hasOther
then [String]
choices forall a. [a] -> [a] -> [a]
++ [String
"Other (specify)"]
else [String]
choices
in forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
choices forall a. Num a => a -> a -> a
+ Int
1] [String]
cs
numChoices :: Int
numChoices = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
choices
invalidChoice :: String -> m String
invalidChoice String
input = do
let msg' :: String
msg' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input
then String
"Empty input is not a valid choice."
else forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
input
, String
" is not a valid choice. Please choose a number from 1 to "
, forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, String)]
prettyChoices)
, String
"."
]
forall (m :: * -> *). Interactive m => String -> m ()
putStrLn String
msg'
forall (m :: * -> *) a. Interactive m => String -> m a -> m a
breakOrContinue (String
"promptList: " forall a. [a] -> [a] -> [a]
++ String
input) m String
go
go :: m String
go = do
forall (m :: * -> *). Interactive m => String -> m ()
putStr
forall a b. (a -> b) -> a -> b
$ String -> DefaultPrompt String -> String
mkDefPrompt String
"Your choice"
forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe DefaultPrompt String
def (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultPrompt String
def) Maybe (String -> String)
modDef
String
input <- forall (m :: * -> *). Interactive m => m String
getLine
case DefaultPrompt String
def of
DefaultPrompt String
d | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input -> forall (m :: * -> *) a. Monad m => a -> m a
return String
d
DefaultPrompt String
_ -> case forall a. Read a => String -> Maybe a
readMaybe String
input of
Maybe Int
Nothing -> String -> m String
invalidChoice String
input
Just Int
n
| Int
n forall a. Ord a => a -> a -> Bool
> Int
0, Int
n forall a. Ord a => a -> a -> Bool
<= Int
numChoices -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
choices forall a. [a] -> Int -> a
!! (Int
nforall a. Num a => a -> a -> a
-Int
1)
| Int
n forall a. Eq a => a -> a -> Bool
== Int
numChoices forall a. Num a => a -> a -> a
+ Int
1, Bool
hasOther ->
forall (m :: * -> *).
Interactive m =>
String -> DefaultPrompt String -> m String
promptStr String
"Please specify" forall t. DefaultPrompt t
OptionalPrompt
| Bool
otherwise -> String -> m String
invalidChoice (forall a. Show a => a -> String
show Int
n)
promptDefault
:: Interactive m
=> (String -> Either String t)
-> (t -> String)
-> String
-> (DefaultPrompt t)
-> m t
promptDefault :: forall (m :: * -> *) t.
Interactive m =>
(String -> Either String t)
-> (t -> String) -> String -> DefaultPrompt t -> m t
promptDefault String -> Either String t
parse t -> String
pprint String
msg DefaultPrompt t
def = do
forall (m :: * -> *). Interactive m => String -> m ()
putStr forall a b. (a -> b) -> a -> b
$ String -> DefaultPrompt String -> String
mkDefPrompt String
msg (t -> String
pprint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultPrompt t
def)
forall (m :: * -> *). Interactive m => Handle -> m ()
hFlush Handle
System.IO.stdout
String
input <- forall (m :: * -> *). Interactive m => m String
getLine
case DefaultPrompt t
def of
DefaultPrompt t
d | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input -> forall (m :: * -> *) a. Monad m => a -> m a
return t
d
DefaultPrompt t
_ -> case String -> Either String t
parse String
input of
Right t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return t
t
Left String
err -> do
forall (m :: * -> *). Interactive m => String -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Couldn't parse " forall a. [a] -> [a] -> [a]
++ String
input forall a. [a] -> [a] -> [a]
++ String
", please try again!"
forall (m :: * -> *) a. Interactive m => String -> m a -> m a
breakOrContinue
(String
"promptDefault: " forall a. [a] -> [a] -> [a]
++ String
err forall a. [a] -> [a] -> [a]
++ String
" on input: " forall a. [a] -> [a] -> [a]
++ String
input)
(forall (m :: * -> *) t.
Interactive m =>
(String -> Either String t)
-> (t -> String) -> String -> DefaultPrompt t -> m t
promptDefault String -> Either String t
parse t -> String
pprint String
msg DefaultPrompt t
def)
breakOrContinue :: Interactive m => String -> m a -> m a
breakOrContinue :: forall (m :: * -> *) a. Interactive m => String -> m a -> m a
breakOrContinue String
msg m a
act = forall (m :: * -> *). Interactive m => m Bool
break forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> forall (m :: * -> *) a. Interactive m => BreakException -> m a
throwPrompt forall a b. (a -> b) -> a -> b
$ String -> BreakException
BreakException String
msg
Bool
False -> m a
act