{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module Unison.CommandLine
( ParseFailure (..),
ExpansionFailure (..),
FZFResolveFailure (..),
allow,
parseInput,
prompt,
reportParseFailure,
)
where
import Control.Lens hiding (aside)
import Control.Monad.Except
import Control.Monad.Trans.Except
import Data.List (isPrefixOf, isSuffixOf)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Map qualified as Map
import Data.Text qualified as Text
import System.FilePath (takeFileName)
import Text.Numeral (defaultInflection)
import Text.Numeral.Language.ENG qualified as Numeral
import Unison.Codebase (Codebase)
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.Input (Input (..))
import Unison.Codebase.Editor.Output (NumberedArgs)
import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
import Unison.CommandLine.FuzzySelect qualified as Fuzzy
import Unison.CommandLine.Helpers (warn)
import Unison.CommandLine.InputPattern (Argument (..), CliArg (..), InputPattern (..), NumberedArg (..))
import Unison.CommandLine.InputPattern qualified as InputPattern
import Unison.CommandLine.InputPatterns qualified as IP
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyTerminal qualified as PrettyTerm
import Unison.Symbol (Symbol)
import Unison.Util.Pretty qualified as P
import Prelude hiding (readFile, writeFile)
allow :: FilePath -> Bool
allow :: String -> Bool
allow String
p =
Bool -> Bool
not (String
".#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
takeFileName String
p)
Bool -> Bool -> Bool
&& (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".u" String
p Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".uu" String
p)
data ExpansionFailure
= TooManyArguments (Data.List.NonEmpty.NonEmpty (Either CliArg StructuredArgument))
| UnexpectedStructuredArgument StructuredArgument
expandArguments ::
NumberedArgs ->
InputPattern.Parameters ->
[CliArg] ->
Either ExpansionFailure (InputPattern.Arguments, InputPattern.Parameters)
expandArguments :: NumberedArgs
-> Parameters
-> [CliArg]
-> Either ExpansionFailure (Arguments, Parameters)
expandArguments NumberedArgs
numberedArgs Parameters
params [CliArg]
args = do
Either
(NonEmpty (Either CliArg StructuredArgument))
(Arguments, Parameters)
result <-
[CliArg]
args
[CliArg]
-> ([CliArg] -> [Either CliArg StructuredArgument])
-> [Either CliArg StructuredArgument]
forall a b. a -> (a -> b) -> b
& (CliArg -> Either CliArg StructuredArgument)
-> [CliArg] -> [Either CliArg StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CliArg -> Either CliArg StructuredArgument
forall a b. a -> Either a b
Left
[Either CliArg StructuredArgument]
-> ([Either CliArg StructuredArgument]
-> Either
ExpansionFailure
(Either
(NonEmpty (Either CliArg StructuredArgument))
(Arguments, Parameters)))
-> Either
ExpansionFailure
(Either
(NonEmpty (Either CliArg StructuredArgument))
(Arguments, Parameters))
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) state arg.
Monad m =>
(state -> Parameter -> arg -> m (state, [arg]))
-> state
-> Parameters
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
InputPattern.foldParamsWithM @(Either ExpansionFailure) @[Argument] @(Either CliArg StructuredArgument)
( \Arguments
acc (Text
_, ParameterType
param) Either CliArg StructuredArgument
arg ->
case Either CliArg StructuredArgument
arg of
Left (InputPattern.QuotedArg String
quoted Bool
_) -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right (String -> Argument
RawArg String
quoted Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc, [])
Left (InputPattern.UnquotedArg String
raw) -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right ((Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. (a -> b) -> a -> b
$ (String -> Argument
RawArg String
raw Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc, [])
Left (InputPattern.NumberedArg NumberedArg
n) ->
case NumberedArgs -> NumberedArg -> Maybe NumberedArgs
expandNumber NumberedArgs
numberedArgs NumberedArg
n of
Maybe NumberedArgs
Nothing -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right (Arguments
acc, [])
Just [] -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right (Arguments
acc, [])
Just (StructuredArgument
h : NumberedArgs
t)
| ParameterType -> Bool
InputPattern.isStructured ParameterType
param -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right ((Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. (a -> b) -> a -> b
$ (StructuredArgument -> Argument
StructuredArg StructuredArgument
h Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc, StructuredArgument -> Either CliArg StructuredArgument
forall a b. b -> Either a b
Right (StructuredArgument -> Either CliArg StructuredArgument)
-> NumberedArgs -> [Either CliArg StructuredArgument]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NumberedArgs
t)
| Bool
otherwise -> ExpansionFailure
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. a -> Either a b
Left (ExpansionFailure
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> (StructuredArgument -> ExpansionFailure)
-> StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredArgument -> ExpansionFailure
UnexpectedStructuredArgument (StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. (a -> b) -> a -> b
$ StructuredArgument
h
Right StructuredArgument
structured
| ParameterType -> Bool
InputPattern.isStructured ParameterType
param -> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. b -> Either a b
Right ((Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> (Arguments, [Either CliArg StructuredArgument])
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. (a -> b) -> a -> b
$ ((StructuredArgument -> Argument
StructuredArg StructuredArgument
structured Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc), [])
| Bool
otherwise ->
ExpansionFailure
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. a -> Either a b
Left (ExpansionFailure
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> (StructuredArgument -> ExpansionFailure)
-> StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredArgument -> ExpansionFailure
UnexpectedStructuredArgument (StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument]))
-> StructuredArgument
-> Either
ExpansionFailure (Arguments, [Either CliArg StructuredArgument])
forall a b. (a -> b) -> a -> b
$ StructuredArgument
structured
)
[]
Parameters
params
case Either
(NonEmpty (Either CliArg StructuredArgument))
(Arguments, Parameters)
result of
Left NonEmpty (Either CliArg StructuredArgument)
eArgs -> ExpansionFailure -> Either ExpansionFailure (Arguments, Parameters)
forall a b. a -> Either a b
Left (ExpansionFailure
-> Either ExpansionFailure (Arguments, Parameters))
-> ExpansionFailure
-> Either ExpansionFailure (Arguments, Parameters)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Either CliArg StructuredArgument) -> ExpansionFailure
TooManyArguments NonEmpty (Either CliArg StructuredArgument)
eArgs
Right (Arguments
rArgs, Parameters
params) -> (Arguments, Parameters)
-> Either ExpansionFailure (Arguments, Parameters)
forall a b. b -> Either a b
Right (Arguments -> Arguments
forall a. [a] -> [a]
reverse Arguments
rArgs, Parameters
params)
data ParseFailure
= NoCommand
| UnknownCommand String
| ExpansionFailure String InputPattern ExpansionFailure
| FZFResolveFailure InputPattern FZFResolveFailure
| SubParseFailure String InputPattern (P.Pretty P.ColorText)
reportParseFailure :: ParseFailure -> P.Pretty P.ColorText
reportParseFailure :: ParseFailure -> Pretty ColorText
reportParseFailure = \case
ParseFailure
NoCommand -> Pretty ColorText
""
UnknownCommand String
command ->
Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
warn (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
Pretty ColorText
"I don't know how to"
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (String -> Pretty ColorText
forall a. IsString a => String -> a
fromString String
command Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Type"
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
IP.makeExample' InputPattern
IP.help
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or `?` to get help."
ExpansionFailure String
command pat :: InputPattern
pat@InputPattern {Parameters
params :: Parameters
$sel:params:InputPattern :: InputPattern -> Parameters
params} ExpansionFailure
ef -> case ExpansionFailure
ef of
TooManyArguments NonEmpty (Either CliArg StructuredArgument)
extraArgs ->
let showNum :: a -> Text
showNum a
n = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (a -> Text
forall a. Show a => a -> Text
tShow a
n) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Inflection -> a -> Maybe Text
forall a. Integral a => Inflection -> a -> Maybe Text
Numeral.us_cardinal Inflection
defaultInflection a
n
in String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat
(Pretty ColorText -> Pretty ColorText)
-> (Maybe Int -> Pretty ColorText) -> Maybe Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text
(Text -> Pretty ColorText)
-> (Maybe Int -> Text) -> Maybe Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
( Text
"Internal error: fuzzy finder complained that there are "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum (NonEmpty (Either CliArg StructuredArgument) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Either CliArg StructuredArgument)
extraArgs)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" too many arguments provided, but the command apparently allows an unbounded number of arguments."
)
( \Int
maxCount ->
let foundCount :: Text
foundCount = Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
maxCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NonEmpty (Either CliArg StructuredArgument) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Either CliArg StructuredArgument)
extraArgs
in case Int
maxCount of
Int
0 -> Text
"I expected no arguments, but received " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
foundCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Int
_ -> Text
"I expected no more than " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum Int
maxCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" arguments, but received " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
foundCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
)
(Maybe Int -> Pretty ColorText) -> Maybe Int -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Parameters -> Maybe Int
InputPattern.maxArgs Parameters
params
UnexpectedStructuredArgument StructuredArgument
_arg -> Pretty ColorText
"Internal error: Expected a String, but got a structured argument instead."
FZFResolveFailure InputPattern
pat FZFResolveFailure
frf -> case FZFResolveFailure
frf of
NoFZFResolverForArgumentType Text
_argDesc -> InputPattern -> Pretty ColorText
InputPattern.help InputPattern
pat
NoFZFOptions Text
argDesc ->
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty ColorText
"⚠️" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
Pretty ColorText
"Sorry, I was expecting an argument for the " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
argDesc Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
", and I couldn't find any to suggest to you. 😅"
SubParseFailure String
command InputPattern
pat Pretty ColorText
msg -> String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat Pretty ColorText
msg
where
wrapFailure :: String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat Pretty ColorText
msg =
Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Sorry, I wasn’t sure how to process your request:",
Pretty ColorText
"",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 Pretty ColorText
msg,
Pretty ColorText
"",
Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
Pretty ColorText
"You can run"
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
IP.makeExample InputPattern
IP.help [String -> Pretty ColorText
forall a. IsString a => String -> a
fromString String
command]
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"for more information on using"
Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
IP.makeExampleEOS InputPattern
pat []
]
parseInput ::
Codebase IO Symbol Ann ->
PP.ProjectPath ->
IO (Branch.Branch IO) ->
NumberedArgs ->
Map String InputPattern ->
[CliArg] ->
IO (Either ParseFailure (Maybe (InputPattern.Arguments, Input)))
parseInput :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch IO)
-> NumberedArgs
-> Map String InputPattern
-> [CliArg]
-> IO (Either ParseFailure (Maybe (Arguments, Input)))
parseInput Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch IO)
currentProjectRoot NumberedArgs
numberedArgs Map String InputPattern
patterns [CliArg]
cliArgs = ExceptT ParseFailure IO (Maybe (Arguments, Input))
-> IO (Either ParseFailure (Maybe (Arguments, Input)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
let getCurrentBranch0 :: IO (Branch0 IO)
getCurrentBranch0 :: IO (Branch0 IO)
getCurrentBranch0 = do
Branch IO
projRoot <- IO (Branch IO)
currentProjectRoot
Branch0 IO -> IO (Branch0 IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 IO -> IO (Branch0 IO))
-> (Branch IO -> Branch0 IO) -> Branch IO -> IO (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> IO (Branch0 IO)) -> Branch IO -> IO (Branch0 IO)
forall a b. (a -> b) -> a -> b
$ Path -> Branch IO -> Branch IO
forall (m :: * -> *). Path -> Branch m -> Branch m
Branch.getAt' (ProjectPath
projPath ProjectPath -> Getting Path ProjectPath Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path ProjectPath Path
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_) Branch IO
projRoot
(String
cmd, [CliArg]
args) <- case [CliArg]
cliArgs of
[] -> ParseFailure -> ExceptT ParseFailure IO (String, [CliArg])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ParseFailure
NoCommand
(NumberedArg {} : [CliArg]
_) -> ParseFailure -> ExceptT ParseFailure IO (String, [CliArg])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ParseFailure
NoCommand
(UnquotedArg String
cmd : [CliArg]
args) -> (String, [CliArg]) -> ExceptT ParseFailure IO (String, [CliArg])
forall a. a -> ExceptT ParseFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
cmd, [CliArg]
args)
(QuotedArg String
cmd Bool
_ : [CliArg]
args) -> (String, [CliArg]) -> ExceptT ParseFailure IO (String, [CliArg])
forall a. a -> ExceptT ParseFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
cmd, [CliArg]
args)
pat :: InputPattern
pat@(InputPattern {Parameters
$sel:params:InputPattern :: InputPattern -> Parameters
params :: Parameters
params, Arguments -> Either (Pretty ColorText) Input
parse :: Arguments -> Either (Pretty ColorText) Input
$sel:parse:InputPattern :: InputPattern -> Arguments -> Either (Pretty ColorText) Input
parse}) <- case String -> Map String InputPattern -> Maybe InputPattern
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
cmd Map String InputPattern
patterns of
Just InputPattern
pat -> InputPattern -> ExceptT ParseFailure IO InputPattern
forall a. a -> ExceptT ParseFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InputPattern
pat
Maybe InputPattern
Nothing -> ParseFailure -> ExceptT ParseFailure IO InputPattern
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ParseFailure -> ExceptT ParseFailure IO InputPattern)
-> ParseFailure -> ExceptT ParseFailure IO InputPattern
forall a b. (a -> b) -> a -> b
$ String -> ParseFailure
UnknownCommand String
cmd
let mkResult :: [Argument] -> ExceptT ParseFailure IO ([Argument], Input)
mkResult :: Arguments -> ExceptT ParseFailure IO (Arguments, Input)
mkResult Arguments
finalArgs = Either ParseFailure (Arguments, Input)
-> ExceptT ParseFailure IO (Arguments, Input)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either ParseFailure (Arguments, Input)
-> ExceptT ParseFailure IO (Arguments, Input))
-> (Either (Pretty ColorText) Input
-> Either ParseFailure (Arguments, Input))
-> Either (Pretty ColorText) Input
-> ExceptT ParseFailure IO (Arguments, Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty ColorText -> ParseFailure)
-> (Input -> (Arguments, Input))
-> Either (Pretty ColorText) Input
-> Either ParseFailure (Arguments, Input)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> InputPattern -> Pretty ColorText -> ParseFailure
SubParseFailure String
cmd InputPattern
pat) (String -> Argument
RawArg String
cmd Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
finalArgs,) (Either (Pretty ColorText) Input
-> ExceptT ParseFailure IO (Arguments, Input))
-> Either (Pretty ColorText) Input
-> ExceptT ParseFailure IO (Arguments, Input)
forall a b. (a -> b) -> a -> b
$ Arguments -> Either (Pretty ColorText) Input
parse Arguments
finalArgs
(Arguments
expandedArgs, Parameters
remainingParams) <-
Either ParseFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either ParseFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters))
-> (Either ExpansionFailure (Arguments, Parameters)
-> Either ParseFailure (Arguments, Parameters))
-> Either ExpansionFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpansionFailure -> ParseFailure)
-> Either ExpansionFailure (Arguments, Parameters)
-> Either ParseFailure (Arguments, Parameters)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> InputPattern -> ExpansionFailure -> ParseFailure
ExpansionFailure String
cmd InputPattern
pat) (Either ExpansionFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters))
-> Either ExpansionFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall a b. (a -> b) -> a -> b
$ NumberedArgs
-> Parameters
-> [CliArg]
-> Either ExpansionFailure (Arguments, Parameters)
expandArguments NumberedArgs
numberedArgs Parameters
params [CliArg]
args
if Bool
Fuzzy.isFZFInstalled
then do
Either FZFResolveFailure (Maybe Arguments)
argResult <- IO (Either FZFResolveFailure (Maybe Arguments))
-> ExceptT
ParseFailure IO (Either FZFResolveFailure (Maybe Arguments))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ParseFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> Parameters
-> IO (Either FZFResolveFailure (Maybe Arguments))
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch0 IO)
getCurrentBranch0 Parameters
remainingParams)
case Either FZFResolveFailure (Maybe Arguments)
argResult of
Left err :: FZFResolveFailure
err@(NoFZFOptions {}) -> ParseFailure -> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a. ParseFailure -> ExceptT ParseFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParseFailure
-> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> ParseFailure
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a b. (a -> b) -> a -> b
$ InputPattern -> FZFResolveFailure -> ParseFailure
FZFResolveFailure InputPattern
pat FZFResolveFailure
err
Left (NoFZFResolverForArgumentType {}) ->
(Arguments, Input) -> Maybe (Arguments, Input)
forall a. a -> Maybe a
Just ((Arguments, Input) -> Maybe (Arguments, Input))
-> ExceptT ParseFailure IO (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> ExceptT ParseFailure IO (Arguments, Input)
mkResult Arguments
expandedArgs
Right Maybe Arguments
mayResolvedArgs -> case Maybe Arguments
mayResolvedArgs of
Maybe Arguments
Nothing -> Maybe (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a. a -> ExceptT ParseFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> Maybe (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a b. (a -> b) -> a -> b
$ Maybe (Arguments, Input)
forall a. Maybe a
Nothing
Just Arguments
resolvedArgs -> (Arguments, Input) -> Maybe (Arguments, Input)
forall a. a -> Maybe a
Just ((Arguments, Input) -> Maybe (Arguments, Input))
-> ExceptT ParseFailure IO (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> ExceptT ParseFailure IO (Arguments, Input)
mkResult (Arguments
expandedArgs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
resolvedArgs)
else do
(Arguments, Input) -> Maybe (Arguments, Input)
forall a. a -> Maybe a
Just ((Arguments, Input) -> Maybe (Arguments, Input))
-> ExceptT ParseFailure IO (Arguments, Input)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> ExceptT ParseFailure IO (Arguments, Input)
mkResult Arguments
expandedArgs
expandNumber :: NumberedArgs -> NumberedArg -> Maybe NumberedArgs
expandNumber :: NumberedArgs -> NumberedArg -> Maybe NumberedArgs
expandNumber NumberedArgs
numberedArgs NumberedArg
selection =
case NumberedArg
selection of
NumberedSingle Int
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure @[] (StructuredArgument -> NumberedArgs)
-> Maybe StructuredArgument -> Maybe NumberedArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NumberedArgs
numberedArgs NumberedArgs
-> Getting
(First StructuredArgument) NumberedArgs StructuredArgument
-> Maybe StructuredArgument
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index NumberedArgs
-> Traversal' NumberedArgs (IxValue NumberedArgs)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int -> Int
forall a. Enum a => a -> a
pred Int
n))
NumberedRange Int
start Int
end ->
NumberedArgs
numberedArgs
NumberedArgs -> (NumberedArgs -> NumberedArgs) -> NumberedArgs
forall a b. a -> (a -> b) -> b
& Int -> NumberedArgs -> NumberedArgs
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
start)
NumberedArgs -> (NumberedArgs -> NumberedArgs) -> NumberedArgs
forall a b. a -> (a -> b) -> b
& Int -> NumberedArgs -> NumberedArgs
forall a. Int -> [a] -> [a]
take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Enum a => a -> a
pred Int
start)
NumberedArgs
-> (NumberedArgs -> Maybe NumberedArgs) -> Maybe NumberedArgs
forall a b. a -> (a -> b) -> b
& NumberedArgs -> Maybe NumberedArgs
forall a. a -> Maybe a
Just
NumberedBeforeEnd Int
end ->
NumberedArgs
numberedArgs
NumberedArgs -> (NumberedArgs -> NumberedArgs) -> NumberedArgs
forall a b. a -> (a -> b) -> b
& Int -> NumberedArgs -> NumberedArgs
forall a. Int -> [a] -> [a]
take Int
end
NumberedArgs
-> (NumberedArgs -> Maybe NumberedArgs) -> Maybe NumberedArgs
forall a b. a -> (a -> b) -> b
& NumberedArgs -> Maybe NumberedArgs
forall a. a -> Maybe a
Just
NumberedAfterStart Int
start ->
NumberedArgs
numberedArgs
NumberedArgs -> (NumberedArgs -> NumberedArgs) -> NumberedArgs
forall a b. a -> (a -> b) -> b
& Int -> NumberedArgs -> NumberedArgs
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
start)
NumberedArgs
-> (NumberedArgs -> Maybe NumberedArgs) -> Maybe NumberedArgs
forall a b. a -> (a -> b) -> b
& NumberedArgs -> Maybe NumberedArgs
forall a. a -> Maybe a
Just
data FZFResolveFailure
= NoFZFResolverForArgumentType InputPattern.ParameterDescription
| NoFZFOptions
Text
fzfResolve ::
Codebase IO Symbol Ann ->
PP.ProjectPath ->
(IO (Branch0 IO)) ->
InputPattern.Parameters ->
IO (Either FZFResolveFailure (Maybe InputPattern.Arguments))
fzfResolve :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> Parameters
-> IO (Either FZFResolveFailure (Maybe Arguments))
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
ppCtx IO (Branch0 IO)
getCurrentBranch InputPattern.Parameters {[Parameter]
requiredParams :: [Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams, TrailingParameters
trailingParams :: TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams} = ExceptT FZFResolveFailure IO (Maybe Arguments)
-> IO (Either FZFResolveFailure (Maybe Arguments))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
argumentResolvers :: [MaybeT (ExceptT FZFResolveFailure IO) (Data.List.NonEmpty.NonEmpty InputPattern.Argument)] <-
([MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)])
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a b c.
(a -> b -> c)
-> ExceptT FZFResolveFailure IO a
-> ExceptT FZFResolveFailure IO b
-> ExceptT FZFResolveFailure IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. Semigroup a => a -> a -> a
(<>) ((Parameter
-> ExceptT
FZFResolveFailure
IO
(MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> [Parameter]
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Bool
-> Parameter
-> ExceptT
FZFResolveFailure
IO
(MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall {m :: * -> *}.
MonadError FZFResolveFailure m =>
Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
False) [Parameter]
requiredParams) case TrailingParameters
trailingParams of
InputPattern.Optional [Parameter]
_ Maybe Parameter
_ -> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. Monoid a => a
mempty
InputPattern.OnePlus Parameter
p -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)])
-> ExceptT
FZFResolveFailure
IO
(MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> ExceptT
FZFResolveFailure
IO
[MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Parameter
-> ExceptT
FZFResolveFailure
IO
(MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall {m :: * -> *}.
MonadError FZFResolveFailure m =>
Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
True Parameter
p
MaybeT (ExceptT FZFResolveFailure IO) Arguments
-> ExceptT FZFResolveFailure IO (Maybe Arguments)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ExceptT FZFResolveFailure IO) Arguments
-> ExceptT FZFResolveFailure IO (Maybe Arguments))
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
-> ExceptT FZFResolveFailure IO (Maybe Arguments)
forall a b. (a -> b) -> a -> b
$ (Arguments
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments)
-> Arguments
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Arguments
bs -> ((Arguments
bs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<>) (Arguments -> Arguments)
-> (NonEmpty Argument -> Arguments)
-> NonEmpty Argument
-> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Argument -> Arguments
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Argument -> Arguments)
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) [] [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
argumentResolvers
where
maybeFillArg :: Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
allowMulti (Text
argName, InputPattern.ParameterType {Maybe FZFResolver
fzfResolver :: Maybe FZFResolver
$sel:fzfResolver:ParameterType :: ParameterType -> Maybe FZFResolver
fzfResolver}) =
m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> (FZFResolver
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> Maybe FZFResolver
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(FZFResolveFailure
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a. FZFResolveFailure -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FZFResolveFailure
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> FZFResolveFailure
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a b. (a -> b) -> a -> b
$ Text -> FZFResolveFailure
NoFZFResolverForArgumentType Text
argName)
(MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> (FZFResolver
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> FZFResolver
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Text
-> FZFResolver
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
fuzzyFillArg Bool
allowMulti Text
argName)
Maybe FZFResolver
fzfResolver
fuzzyFillArg ::
Bool -> Text -> InputPattern.FZFResolver -> MaybeT (ExceptT FZFResolveFailure IO) (Data.List.NonEmpty.NonEmpty InputPattern.Argument)
fuzzyFillArg :: Bool
-> Text
-> FZFResolver
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
fuzzyFillArg Bool
allowMulti Text
argDesc FZFResolver
fzfResolver = ExceptT FZFResolveFailure IO (Maybe (NonEmpty Argument))
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT do
Branch0 IO
currentBranch <- Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs (Branch0 IO -> Branch0 IO)
-> ExceptT FZFResolveFailure IO (Branch0 IO)
-> ExceptT FZFResolveFailure IO (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Branch0 IO) -> ExceptT FZFResolveFailure IO (Branch0 IO)
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Branch0 IO)
getCurrentBranch
Maybe [Text]
results <- case FZFResolver
fzfResolver of
InputPattern.FetchOptions OptionFetcher
getOptions -> do
[Text]
options <- IO [Text] -> ExceptT FZFResolveFailure IO [Text]
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> ExceptT FZFResolveFailure IO [Text])
-> IO [Text] -> ExceptT FZFResolveFailure IO [Text]
forall a b. (a -> b) -> a -> b
$ OptionFetcher
getOptions Codebase IO Symbol Ann
codebase ProjectPath
ppCtx Branch0 IO
currentBranch
Bool
-> ExceptT FZFResolveFailure IO ()
-> ExceptT FZFResolveFailure IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
options) (ExceptT FZFResolveFailure IO ()
-> ExceptT FZFResolveFailure IO ())
-> (FZFResolveFailure -> ExceptT FZFResolveFailure IO ())
-> FZFResolveFailure
-> ExceptT FZFResolveFailure IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FZFResolveFailure -> ExceptT FZFResolveFailure IO ()
forall a. FZFResolveFailure -> ExceptT FZFResolveFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FZFResolveFailure -> ExceptT FZFResolveFailure IO ())
-> FZFResolveFailure -> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ Text -> FZFResolveFailure
NoFZFOptions Text
argDesc
IO () -> ExceptT FZFResolveFailure IO ()
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FZFResolveFailure IO ())
-> IO () -> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> IO ()
PrettyTerm.putPrettyLn' (Text -> Pretty ColorText
FZFResolvers.fuzzySelectHeader Text
argDesc)
let selections :: FuzzySelections Text
selections = (Text -> Text) -> [Text] -> FuzzySelections Text
forall a. (a -> Text) -> [a] -> FuzzySelections a
Fuzzy.SelectFromChoices Text -> Text
forall a. a -> a
id [Text]
options
IO (Maybe [Text]) -> ExceptT FZFResolveFailure IO (Maybe [Text])
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Options -> FuzzySelections Text -> IO (Maybe [Text])
forall a. Options -> FuzzySelections a -> IO (Maybe [a])
Fuzzy.fuzzySelect Options
Fuzzy.defaultOptions {Fuzzy.allowMultiSelect = allowMulti} FuzzySelections Text
selections)
FZFResolver
InputPattern.DefaultFZFFileSearch -> do
IO () -> ExceptT FZFResolveFailure IO ()
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FZFResolveFailure IO ())
-> IO () -> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> IO ()
PrettyTerm.putPrettyLn' (Text -> Pretty ColorText
FZFResolvers.fuzzySelectHeader Text
argDesc)
let selections :: FuzzySelections Text
selections = FuzzySelections Text
Fuzzy.SelectFiles
IO (Maybe [Text]) -> ExceptT FZFResolveFailure IO (Maybe [Text])
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Options -> FuzzySelections Text -> IO (Maybe [Text])
forall a. Options -> FuzzySelections a -> IO (Maybe [a])
Fuzzy.fuzzySelect Options
Fuzzy.defaultOptions {Fuzzy.allowMultiSelect = allowMulti} FuzzySelections Text
selections)
Maybe (NonEmpty Argument)
-> ExceptT FZFResolveFailure IO (Maybe (NonEmpty Argument))
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty Argument)
-> ExceptT FZFResolveFailure IO (Maybe (NonEmpty Argument)))
-> Maybe (NonEmpty Argument)
-> ExceptT FZFResolveFailure IO (Maybe (NonEmpty Argument))
forall a b. (a -> b) -> a -> b
$ (NonEmpty Text -> NonEmpty Argument)
-> Maybe (NonEmpty Text) -> Maybe (NonEmpty Argument)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Argument
RawArg (String -> Argument) -> (Text -> String) -> Text -> Argument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Argument) -> NonEmpty Text -> NonEmpty Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (NonEmpty Text) -> Maybe (NonEmpty Argument))
-> ([Text] -> Maybe (NonEmpty Text))
-> [Text]
-> Maybe (NonEmpty Argument)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
Data.List.NonEmpty.nonEmpty ([Text] -> Maybe (NonEmpty Argument))
-> Maybe [Text] -> Maybe (NonEmpty Argument)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Text]
results
prompt :: String
prompt :: String
prompt = String
"> "