{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module Unison.CommandLine.InputPattern
( InputPattern (..),
ParameterDescription,
ParameterType (..),
Parameter,
TrailingParameters (..),
Parameters (..),
Argument (..),
Arguments,
noParams,
foldParamsWithM,
paramType,
FZFResolver (..),
Visibility (..),
parseArgs,
CliArg (..),
NumberedArg (..),
renderCliArg,
renderCliArgUnquoted,
minArgs,
maxArgs,
unionSuggestions,
suggestionFallbacks,
)
where
import Control.Lens
import Data.Char qualified as Char
import Data.List.Extra qualified as List
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text qualified as Text
import System.Console.Haskeline qualified as Line
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MP
import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
import Unison.Codebase (Codebase)
import Unison.Codebase.Editor.Input (Input (..))
import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.CommandLine.FZFResolvers (FZFResolver (..))
import Unison.Prelude
import Unison.Util.ColorText qualified as CT
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Pretty qualified as P
data Visibility = Hidden | Visible
deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Visibility -> ShowS
showsPrec :: Int -> Visibility -> ShowS
$cshow :: Visibility -> String
show :: Visibility -> String
$cshowList :: [Visibility] -> ShowS
showList :: [Visibility] -> ShowS
Show, Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
/= :: Visibility -> Visibility -> Bool
Eq, Eq Visibility
Eq Visibility =>
(Visibility -> Visibility -> Ordering)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Visibility)
-> (Visibility -> Visibility -> Visibility)
-> Ord Visibility
Visibility -> Visibility -> Bool
Visibility -> Visibility -> Ordering
Visibility -> Visibility -> Visibility
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Visibility -> Visibility -> Ordering
compare :: Visibility -> Visibility -> Ordering
$c< :: Visibility -> Visibility -> Bool
< :: Visibility -> Visibility -> Bool
$c<= :: Visibility -> Visibility -> Bool
<= :: Visibility -> Visibility -> Bool
$c> :: Visibility -> Visibility -> Bool
> :: Visibility -> Visibility -> Bool
$c>= :: Visibility -> Visibility -> Bool
>= :: Visibility -> Visibility -> Bool
$cmax :: Visibility -> Visibility -> Visibility
max :: Visibility -> Visibility -> Visibility
$cmin :: Visibility -> Visibility -> Visibility
min :: Visibility -> Visibility -> Visibility
Ord)
data Argument
= RawArg String
| StructuredArg StructuredArgument
type Arguments = [Argument]
type ParameterDescription = Text
data InputPattern = InputPattern
{ InputPattern -> String
patternName :: String,
InputPattern -> [String]
aliases :: [String],
InputPattern -> Visibility
visibility :: Visibility,
InputPattern -> Parameters
params :: Parameters,
InputPattern -> Pretty ColorText
help :: P.Pretty CT.ColorText,
InputPattern -> Arguments -> Either (Pretty ColorText) Input
parse :: Arguments -> Either (P.Pretty CT.ColorText) Input
}
data ParameterType = ParameterType
{ ParameterType -> String
typeName :: String,
ParameterType
-> forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions ::
forall m v a.
(MonadIO m) =>
String ->
Codebase m v a ->
AuthenticatedHttpClient ->
PP.ProjectPath ->
m [Line.Completion],
ParameterType -> Maybe FZFResolver
fzfResolver :: Maybe FZFResolver,
ParameterType -> Bool
isStructured :: Bool
}
type Parameter = (ParameterDescription, ParameterType)
data TrailingParameters
=
Optional [Parameter] (Maybe Parameter)
|
OnePlus Parameter
data Parameters = Parameters {Parameters -> [Parameter]
requiredParams :: [Parameter], Parameters -> TrailingParameters
trailingParams :: TrailingParameters}
noParams :: Parameters
noParams :: Parameters
noParams = [Parameter] -> TrailingParameters -> Parameters
Parameters [] (TrailingParameters -> Parameters)
-> TrailingParameters -> Parameters
forall a b. (a -> b) -> a -> b
$ [Parameter] -> Maybe Parameter -> TrailingParameters
Optional [] Maybe Parameter
forall a. Maybe a
Nothing
foldParamsWithM ::
(Monad m) =>
(state -> Parameter -> arg -> m (state, [arg])) ->
state ->
Parameters ->
[arg] ->
m (Either (NonEmpty arg) (state, Parameters))
foldParamsWithM :: forall (m :: * -> *) state arg.
Monad m =>
(state -> Parameter -> arg -> m (state, [arg]))
-> state
-> Parameters
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldParamsWithM state -> Parameter -> arg -> m (state, [arg])
fn state
z Parameters {[Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams :: [Parameter]
requiredParams, TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams :: TrailingParameters
trailingParams} = state
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldRequiredArgs state
z [Parameter]
requiredParams
where
foldRequiredArgs :: state
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldRequiredArgs state
res = (([Parameter], [arg])
-> m (Either (NonEmpty arg) (state, Parameters)))
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
([], [arg]
as) -> case TrailingParameters
trailingParams of
Optional [Parameter]
optParams Maybe Parameter
zeroPlus -> state
-> Maybe Parameter
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldOptionalArgs state
res Maybe Parameter
zeroPlus [Parameter]
optParams [arg]
as
OnePlus Parameter
param -> case [arg]
as of
[] -> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters)))
-> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ (state, Parameters) -> Either (NonEmpty arg) (state, Parameters)
forall a. a -> Either (NonEmpty arg) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state
res, [Parameter] -> TrailingParameters -> Parameters
Parameters [] (TrailingParameters -> Parameters)
-> TrailingParameters -> Parameters
forall a b. (a -> b) -> a -> b
$ Parameter -> TrailingParameters
OnePlus Parameter
param)
arg
a : [arg]
args -> state
-> Parameter
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
foldCatchallArg state
res Parameter
param (NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters)))
-> NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ arg
a arg -> [arg] -> NonEmpty arg
forall a. a -> [a] -> NonEmpty a
:| [arg]
args
([Parameter]
ps, []) -> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters)))
-> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ (state, Parameters) -> Either (NonEmpty arg) (state, Parameters)
forall a. a -> Either (NonEmpty arg) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state
res, [Parameter] -> TrailingParameters -> Parameters
Parameters [Parameter]
ps TrailingParameters
trailingParams)
(Parameter
p : [Parameter]
ps, arg
a : [arg]
as) -> do
(state
res', [arg]
extraArgs) <- state -> Parameter -> arg -> m (state, [arg])
fn state
res Parameter
p arg
a
state
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldRequiredArgs state
res' [Parameter]
ps ([arg] -> m (Either (NonEmpty arg) (state, Parameters)))
-> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ [arg]
extraArgs [arg] -> [arg] -> [arg]
forall a. Semigroup a => a -> a -> a
<> [arg]
as
foldOptionalArgs :: state
-> Maybe Parameter
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldOptionalArgs state
res Maybe Parameter
zp = (([Parameter], [arg])
-> m (Either (NonEmpty arg) (state, Parameters)))
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry \case
([Parameter]
ps, []) -> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters)))
-> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ (state, Parameters) -> Either (NonEmpty arg) (state, Parameters)
forall a. a -> Either (NonEmpty arg) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state
res, [Parameter] -> TrailingParameters -> Parameters
Parameters [] (TrailingParameters -> Parameters)
-> TrailingParameters -> Parameters
forall a b. (a -> b) -> a -> b
$ [Parameter] -> Maybe Parameter -> TrailingParameters
Optional [Parameter]
ps Maybe Parameter
zp)
([], arg
a : [arg]
as) -> (NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters)))
-> (Parameter
-> NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters)))
-> Maybe Parameter
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters)))
-> (NonEmpty arg -> Either (NonEmpty arg) (state, Parameters))
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty arg -> Either (NonEmpty arg) (state, Parameters)
forall a b. a -> Either a b
Left) (state
-> Parameter
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
foldCatchallArg state
res) Maybe Parameter
zp (NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters)))
-> NonEmpty arg -> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ arg
a arg -> [arg] -> NonEmpty arg
forall a. a -> [a] -> NonEmpty a
:| [arg]
as
(Parameter
p : [Parameter]
ps, arg
a : [arg]
as) -> do
(state
res', [arg]
extraArgs) <- state -> Parameter -> arg -> m (state, [arg])
fn state
res Parameter
p arg
a
state
-> Maybe Parameter
-> [Parameter]
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
foldOptionalArgs state
res' Maybe Parameter
zp [Parameter]
ps ([arg] -> m (Either (NonEmpty arg) (state, Parameters)))
-> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ [arg]
extraArgs [arg] -> [arg] -> [arg]
forall a. Semigroup a => a -> a -> a
<> [arg]
as
foldCatchallArg :: state
-> Parameter
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
foldCatchallArg state
res Parameter
p =
let collectRemainingArgs :: state -> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
collectRemainingArgs state
prevRes = \case
[] -> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters)))
-> Either (NonEmpty arg) (state, Parameters)
-> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ (state, Parameters) -> Either (NonEmpty arg) (state, Parameters)
forall a. a -> Either (NonEmpty arg) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state
prevRes, [Parameter] -> TrailingParameters -> Parameters
Parameters [] (TrailingParameters -> Parameters)
-> (Maybe Parameter -> TrailingParameters)
-> Maybe Parameter
-> Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parameter] -> Maybe Parameter -> TrailingParameters
Optional [] (Maybe Parameter -> Parameters) -> Maybe Parameter -> Parameters
forall a b. (a -> b) -> a -> b
$ Parameter -> Maybe Parameter
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Parameter
p)
arg
a : [arg]
args -> do
(state
res', [arg]
extraArgs) <- state -> Parameter -> arg -> m (state, [arg])
fn state
prevRes Parameter
p arg
a
state -> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
collectRemainingArgs state
res' ([arg] -> m (Either (NonEmpty arg) (state, Parameters)))
-> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
forall a b. (a -> b) -> a -> b
$ [arg]
extraArgs [arg] -> [arg] -> [arg]
forall a. Semigroup a => a -> a -> a
<> [arg]
args
in state -> [arg] -> m (Either (NonEmpty arg) (state, Parameters))
collectRemainingArgs state
res ([arg] -> m (Either (NonEmpty arg) (state, Parameters)))
-> (NonEmpty arg -> [arg])
-> NonEmpty arg
-> m (Either (NonEmpty arg) (state, Parameters))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty arg -> [arg]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
paramInfo :: Parameters -> Int -> Maybe (ParameterDescription, ParameterType)
paramInfo :: Parameters -> Int -> Maybe Parameter
paramInfo Parameters {[Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams :: [Parameter]
requiredParams, TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams :: TrailingParameters
trailingParams} Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
requiredParams
then Parameter -> Maybe Parameter
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parameter -> Maybe Parameter) -> Parameter -> Maybe Parameter
forall a b. (a -> b) -> a -> b
$ [Parameter]
requiredParams [Parameter] -> Int -> Parameter
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
else case TrailingParameters
trailingParams of
Optional [Parameter]
optParams Maybe Parameter
zeroPlus ->
let rem :: Int
rem = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
requiredParams
in if Int
rem Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
optParams
then Parameter -> Maybe Parameter
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parameter -> Maybe Parameter) -> Parameter -> Maybe Parameter
forall a b. (a -> b) -> a -> b
$ [Parameter]
optParams [Parameter] -> Int -> Parameter
forall a. HasCallStack => [a] -> Int -> a
!! Int
rem
else Maybe Parameter
zeroPlus
OnePlus Parameter
arg -> Parameter -> Maybe Parameter
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Parameter
arg
paramType :: Parameters -> Int -> Maybe ParameterType
paramType :: Parameters -> Int -> Maybe ParameterType
paramType Parameters
p = (Parameter -> ParameterType)
-> Maybe Parameter -> Maybe ParameterType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Parameter -> ParameterType
forall a b. (a, b) -> b
snd (Maybe Parameter -> Maybe ParameterType)
-> (Int -> Maybe Parameter) -> Int -> Maybe ParameterType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameters -> Int -> Maybe Parameter
paramInfo Parameters
p
minArgs :: Parameters -> Int
minArgs :: Parameters -> Int
minArgs Parameters {[Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams :: [Parameter]
requiredParams, TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams :: TrailingParameters
trailingParams} =
[Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
requiredParams Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case TrailingParameters
trailingParams of
Optional [Parameter]
_ Maybe Parameter
_ -> Int
0
OnePlus Parameter
_ -> Int
1
maxArgs :: Parameters -> Maybe Int
maxArgs :: Parameters -> Maybe Int
maxArgs Parameters {[Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams :: [Parameter]
requiredParams, TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams :: TrailingParameters
trailingParams} =
case TrailingParameters
trailingParams of
Optional [Parameter]
optParams Maybe Parameter
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
requiredParams Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Parameter] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Parameter]
optParams
TrailingParameters
_ -> Maybe Int
forall a. Maybe a
Nothing
unionSuggestions ::
forall m v a.
(MonadIO m) =>
[ ( String ->
Codebase m v a ->
AuthenticatedHttpClient ->
PP.ProjectPath ->
m [Line.Completion]
)
] ->
( String ->
Codebase m v a ->
AuthenticatedHttpClient ->
PP.ProjectPath ->
m [Line.Completion]
)
unionSuggestions :: forall (m :: * -> *) v a.
MonadIO m =>
[String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
unionSuggestions [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
suggesters String
inp Codebase m v a
codebase AuthenticatedHttpClient
httpClient ProjectPath
path = do
[String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
suggesters [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> ([String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> m [Completion])
-> m [Completion]
forall a b. a -> (a -> b) -> b
& ((String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion])
-> m [Completion])
-> [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> m [Completion]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggester ->
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggester String
inp Codebase m v a
codebase AuthenticatedHttpClient
httpClient ProjectPath
path
m [Completion]
-> (m [Completion] -> m [Completion]) -> m [Completion]
forall a b. a -> (a -> b) -> b
& ([Completion] -> [Completion]) -> m [Completion] -> m [Completion]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Completion] -> [Completion]
forall a. Ord a => [a] -> [a]
List.nubOrd
suggestionFallbacks ::
forall m v a.
(MonadIO m) =>
[ ( String ->
Codebase m v a ->
AuthenticatedHttpClient ->
PP.ProjectPath ->
m [Line.Completion]
)
] ->
( String ->
Codebase m v a ->
AuthenticatedHttpClient ->
PP.ProjectPath ->
m [Line.Completion]
)
suggestionFallbacks :: forall (m :: * -> *) v a.
MonadIO m =>
[String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestionFallbacks [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
suggesters String
inp Codebase m v a
codebase AuthenticatedHttpClient
httpClient ProjectPath
path = [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> m [Completion]
go [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
suggesters
where
go :: [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> m [Completion]
go (String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
s : [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
rest) = do
[Completion]
suggestions <- String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
s String
inp Codebase m v a
codebase AuthenticatedHttpClient
httpClient ProjectPath
path
if [Completion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Completion]
suggestions
then [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
-> m [Completion]
go [String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]]
rest
else [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Completion]
suggestions
go [] = [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
type Parser = MP.Parsec Void String
data NumberedArg
= NumberedSingle Int
| NumberedRange Int Int
| NumberedAfterStart Int
| NumberedBeforeEnd Int
deriving (NumberedArg -> NumberedArg -> Bool
(NumberedArg -> NumberedArg -> Bool)
-> (NumberedArg -> NumberedArg -> Bool) -> Eq NumberedArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumberedArg -> NumberedArg -> Bool
== :: NumberedArg -> NumberedArg -> Bool
$c/= :: NumberedArg -> NumberedArg -> Bool
/= :: NumberedArg -> NumberedArg -> Bool
Eq, Int -> NumberedArg -> ShowS
[NumberedArg] -> ShowS
NumberedArg -> String
(Int -> NumberedArg -> ShowS)
-> (NumberedArg -> String)
-> ([NumberedArg] -> ShowS)
-> Show NumberedArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberedArg -> ShowS
showsPrec :: Int -> NumberedArg -> ShowS
$cshow :: NumberedArg -> String
show :: NumberedArg -> String
$cshowList :: [NumberedArg] -> ShowS
showList :: [NumberedArg] -> ShowS
Show)
data CliArg
= NumberedArg NumberedArg
| QuotedArg
String
Bool
| UnquotedArg String
deriving (CliArg -> CliArg -> Bool
(CliArg -> CliArg -> Bool)
-> (CliArg -> CliArg -> Bool) -> Eq CliArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CliArg -> CliArg -> Bool
== :: CliArg -> CliArg -> Bool
$c/= :: CliArg -> CliArg -> Bool
/= :: CliArg -> CliArg -> Bool
Eq, Int -> CliArg -> ShowS
[CliArg] -> ShowS
CliArg -> String
(Int -> CliArg -> ShowS)
-> (CliArg -> String) -> ([CliArg] -> ShowS) -> Show CliArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CliArg -> ShowS
showsPrec :: Int -> CliArg -> ShowS
$cshow :: CliArg -> String
show :: CliArg -> String
$cshowList :: [CliArg] -> ShowS
showList :: [CliArg] -> ShowS
Show)
renderCliArg :: CliArg -> String
renderCliArg :: CliArg -> String
renderCliArg =
\case
NumberedArg NumberedArg
n -> case NumberedArg
n of
NumberedSingle Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
NumberedRange Int
s Int
e -> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
NumberedAfterStart Int
s -> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
NumberedBeforeEnd Int
e -> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
QuotedArg String
s Bool
False -> String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
QuotedArg String
s Bool
True -> String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
UnquotedArg String
s -> String
s
renderCliArgUnquoted :: CliArg -> String
renderCliArgUnquoted :: CliArg -> String
renderCliArgUnquoted =
\case
NumberedArg NumberedArg
n -> case NumberedArg
n of
NumberedSingle Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
NumberedRange Int
s Int
e -> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
NumberedAfterStart Int
s -> Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
NumberedBeforeEnd Int
e -> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
e
QuotedArg String
s Bool
False -> String
s
QuotedArg String
s Bool
True -> String
s
UnquotedArg String
s -> String
s
parseArgs :: String -> Maybe [CliArg]
parseArgs :: String -> Maybe [CliArg]
parseArgs String
input = Parsec Void String [CliArg] -> String -> Maybe [CliArg]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
MP.parseMaybe Parsec Void String [CliArg]
argsP (ShowS
strip String
input)
where
strip :: ShowS
strip = Text -> String
Text.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
argP :: Parser CliArg
argP :: Parser CliArg
argP = do
Parser CliArg -> Parser CliArg
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Parser CliArg
numberedArgP Parser CliArg -> ParsecT Void String Identity () -> Parser CliArg
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
wordBoundary)
Parser CliArg -> Parser CliArg -> Parser CliArg
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
MP.<|> (Parser CliArg
quotedArgP Parser CliArg -> ParsecT Void String Identity () -> Parser CliArg
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
wordBoundary)
Parser CliArg -> Parser CliArg -> Parser CliArg
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
MP.<|> (Parser CliArg
unquotedArgP Parser CliArg -> ParsecT Void String Identity () -> Parser CliArg
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
wordBoundary)
where
wordBoundary :: ParsecT Void String Identity ()
wordBoundary = ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.lookAhead (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MP.space1 ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)
escapedQuote :: Parser Char
escapedQuote :: Parser Char
escapedQuote = do
Char
_ <- Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'\\'
Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'"'
numberedArgP :: Parser CliArg
numberedArgP :: Parser CliArg
numberedArgP = do
NumberedArg -> CliArg
NumberedArg (NumberedArg -> CliArg)
-> ParsecT Void String Identity NumberedArg -> Parser CliArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity NumberedArg
-> ParsecT Void String Identity NumberedArg
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity NumberedArg
rangeP ParsecT Void String Identity NumberedArg
-> ParsecT Void String Identity NumberedArg
-> ParsecT Void String Identity NumberedArg
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
MP.<|> ParsecT Void String Identity NumberedArg
singleP)
where
singleP :: Parser NumberedArg
singleP :: ParsecT Void String Identity NumberedArg
singleP = do
String
digits <- Parser Char -> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.digitChar
case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
digits of
Just Int
n -> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NumberedArg -> ParsecT Void String Identity NumberedArg)
-> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a b. (a -> b) -> a -> b
$ Int -> NumberedArg
NumberedSingle Int
n
Maybe Int
Nothing -> ParsecT Void String Identity NumberedArg
forall a. ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
rangeP :: Parser NumberedArg
rangeP :: ParsecT Void String Identity NumberedArg
rangeP = do
Maybe String
start <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ Parser Char -> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.digitChar
Char
_dash <- Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'-'
Maybe String
end <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ Parser Char -> ParsecT Void String Identity String
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.digitChar
case (Maybe String
start Maybe String -> (String -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay, Maybe String
end Maybe String -> (String -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay) of
(Just Int
s, Just Int
e) -> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NumberedArg -> ParsecT Void String Identity NumberedArg)
-> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a b. (a -> b) -> a -> b
$ Int -> Int -> NumberedArg
NumberedRange Int
s Int
e
(Just Int
s, Maybe Int
Nothing) -> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NumberedArg -> ParsecT Void String Identity NumberedArg)
-> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a b. (a -> b) -> a -> b
$ Int -> NumberedArg
NumberedAfterStart Int
s
(Maybe Int
Nothing, Just Int
e) -> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NumberedArg -> ParsecT Void String Identity NumberedArg)
-> NumberedArg -> ParsecT Void String Identity NumberedArg
forall a b. (a -> b) -> a -> b
$ Int -> NumberedArg
NumberedBeforeEnd Int
e
(Maybe Int
Nothing, Maybe Int
Nothing) -> ParsecT Void String Identity NumberedArg
forall a. ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
quotedArgP :: Parser CliArg
quotedArgP :: Parser CliArg
quotedArgP = do
Char
_ <- Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'"'
(String
content, Bool
hasUnterminatedQuote) <-
Parser Char
-> ParsecT Void String Identity Bool
-> ParsecT Void String Identity (String, Bool)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
MP.manyTill_
(Parser Char
escapedQuote Parser Char -> Parser Char -> Parser Char
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
ParsecT Void String Identity (Token String)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
MP.anySingle)
(((Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
'"') Parser Char -> Bool -> ParsecT Void String Identity Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False) ParsecT Void String Identity Bool
-> ParsecT Void String Identity Bool
-> ParsecT Void String Identity Bool
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof ParsecT Void String Identity ()
-> Bool -> ParsecT Void String Identity Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True))
CliArg -> Parser CliArg
forall a. a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CliArg -> Parser CliArg) -> CliArg -> Parser CliArg
forall a b. (a -> b) -> a -> b
$ String -> Bool -> CliArg
QuotedArg String
content Bool
hasUnterminatedQuote
unquotedArgP :: Parser CliArg
unquotedArgP :: Parser CliArg
unquotedArgP = do
String -> CliArg
UnquotedArg (String -> CliArg)
-> ParsecT Void String Identity String -> Parser CliArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some ((Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace))
argsP :: Parser [CliArg]
argsP :: Parsec Void String [CliArg]
argsP = do
Parser CliArg
-> ParsecT Void String Identity () -> Parsec Void String [CliArg]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
MP.sepBy Parser CliArg
argP ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MP.space