diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 30cc7a1..a721e59 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -1,24 +1,24 @@ { - "version": 1, - "isRoot": true, - "tools": { - "fake-cli": { - "version": "6.1.4", - "commands": [ - "fake" - ] - }, - "paket": { - "version": "10.0.0-alpha011", - "commands": [ - "paket" - ] - }, - "dotnet-fsharplint": { - "version": "0.23.6", - "commands": [ - "dotnet-fsharplint" - ] - } + "version": 1, + "isRoot": true, + "tools": { + "fake-cli": { + "version": "6.1.4", + "commands": [ + "fake" + ] + }, + "paket": { + "version": "10.3.1", + "commands": [ + "paket" + ] + }, + "dotnet-fsharplint": { + "version": "0.26.10", + "commands": [ + "dotnet-fsharplint" + ] } + } } diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..9cc0ca4 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,80 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## Commands + +Build system uses FAKE 6. `./build.sh` handles tool restore and Paket restore before running. + +```bash +# Build +./build.sh -t Build + +# Run tests +./build.sh -t Tests + +# Lint (FSharpLint) +./build.sh -t Lint + +# Pack NuGet package +./build.sh -t Release + +# Publish to NuGet (requires NUGET_API_KEY env var) +./build.sh -t Publish + +# Watch mode +./build.sh -t Watch +``` + +Run a single test by name with Expecto's `--filter` flag: +```bash +dotnet test tests/tests.fsproj -- --filter "test name substring" +``` + +## Architecture + +This is an F# library (`Feather.ConsoleApplication`) for building CLI applications. Ships as a NuGet package targeting .NET 10. + +### Layers (bottom-up) + +**Domain types & validation** (`src/Types.fs`, `src/Arguments.fs`, `src/Options.fs`) +- Private wrapper types (`Name`, `CommandName`, `OptionName`, etc.) prevent invalid values at the type level +- All construction goes through validated factory functions returning `Result` +- `ArgumentValueDefinition` (Required/Optional/Array/RequiredArray) and `OptionValueDefinition` (5 variants) define command signatures + +**Parsing & input** (`src/Input.fs`) +- `Input` record holds parsed arguments + options alongside their definitions +- Active patterns (`Input.Argument.Has`, `Input.Argument.Value`, `Input.Option.Has`, etc.) are the intended API for command handlers to access input — prefer these over raw record access + +**Command definition & dispatch** (`src/Command.fs`) +- `CommandDefinition` (raw, before validation) → `Command` (validated, private) +- Three lifecycle hooks per command: `Initialize` (pre-parse setup), `Interact` (interactive prompting), `Execute` (main handler) +- `Execute` DU supports sync/async × result/unit variants + +**Shell completion** (`src/Completion/`, namespace `Feather.ConsoleApplication.Completion`) +- One module per file, compiled in this order: `Shell` (supported shells) → `Words` (normalizes the words the shell passed) → `Definitions` (option/command lookups) → `Suggestions` (`resolve`) → `ShellScript` (script generation) → `Setup` (`validateConfig`, `wire`) +- `Setup.wire` adds the user-facing script command plus the hidden `__completion` resolver command the generated script calls back into + +**Fluent builder** (`src/Builder.fs`) +- `consoleApplication { ... }` computation expression builds the app +- Custom CE operations: `command`, `name`, `version`, `title`, `info`, `showOptions`, `defaultCommand`, `withStyle`, `withCustomTags` + +**Runtime dispatcher** (`src/ConsoleApplication.fs`) +- `runAsyncResult` is the core entrypoint; handles built-in flags (--help, --version, --quiet, --verbose, --no-ansi), resolves command, runs Initialize → Interact → Execute lifecycle +- Error operators ``, `<*!!*>`, `` attach command context to errors for richer messages +- `runResult`, `run`, `runInteractively` are convenience wrappers around `runAsyncResult` + +**Rendering** (`src/Render.fs`) +- Help and error rendering only; output styling delegated to `Feather.ConsoleStyle` +- `{{command.name}}` and `{{command.full_name}}` placeholders supported in help text + +### Key dependencies + +- **Feather.ErrorHandling** — `Result`/`AsyncResult` operators used throughout +- **Feather.ConsoleStyle** — `Output`/`ConsoleStyle` type for styled terminal output (aliased as `Output` in this lib) +- **ShellProgressBar** — wrapped by `src/Progress.fs` +- **Expecto** — test framework + +### Testing pattern + +Tests use `BufferOutput` to capture console output and assert on exact formatted strings. See `tests/DefaultCommandsTests.fs` for examples. Test fixtures (reusable command definitions) live in `tests/Fixtures/Commands.fs`. diff --git a/CHANGELOG.md b/CHANGELOG.md index e92349c..2c59a1b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,17 @@ ## Unreleased +- Shell completion support (opt-in) for bash, zsh, and fish + - `enableCompletion` CE operation in `consoleApplication { }` builder + - Built-in `completion` script command (configurable name, visibility and completed executable) + - Internal hidden `__completion` resolver command used by generated scripts, called as ` -- ...` + - Quoted and backslash-escaped words are completed as single words, and values containing spaces are completed + - Clustered short options (`-fv`, `-fo val`, `-oval`) are completed + - Option names are not suggested after the `--` end-of-options separator, where every word is a positional value + - Command and option name suggestions carry their description, shown by zsh and fish + - `Suggest.describedValues` attaches a description to the values of a suggestion callback + - Suggestions are shell-agnostic; each generated script filters, escapes and inserts them itself + ## 2.0.0 - 2025-12-04 - [**BC**] Use net10 diff --git a/CLAUDE.md b/CLAUDE.md new file mode 120000 index 0000000..47dc3e3 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1 @@ +AGENTS.md \ No newline at end of file diff --git a/README.md b/README.md index c08152c..1e3a7d0 100644 --- a/README.md +++ b/README.md @@ -11,20 +11,35 @@ The Console application allows you to create command-line commands. Your console This library is inspired by [Symfony/Style](https://symfony.com/doc/current/console/style.html) and [Symfony/Console](https://symfony.com/doc/current/components/console.html) ## Table of Contents -- [Installation](#installation) -- [Creating a Console Application](#creating-a-console-application) +- [ Console Application](#-console-application) + - [Table of Contents](#table-of-contents) + - [Installation](#installation) + - [Creating a Console Application](#creating-a-console-application) + - [Outputs:](#outputs) - [Builder](#builder) -- [Life-cycle](#life-cycle) + - [Life-cycle](#life-cycle) - [Interaction](#interaction) -- [Console Input](#console-input-arguments--options) - - [Command Name](#command-name) - - [Shortcut syntax](#shortcut-syntax) + - [Examples:](#examples) + - [Console Input (Arguments \& Options)](#console-input-arguments--options) + - [Command name](#command-name) + - [Shortcut Syntax](#shortcut-syntax) - [Arguments](#arguments) - [Options](#options) -- [Console Output](#console-output) -- [Default commands](#default-commands) + - [Application Options](#application-options) + - [Console Output](#console-output) + - [Default commands](#default-commands) - [Help](#help) - [List](#list) + - [About](#about) + - [Create help message](#create-help-message) + - [Shell Completion](#shell-completion) + - [Enabling Completion](#enabling-completion) + - [Generating Shell Scripts](#generating-shell-scripts) + - [How It Works](#how-it-works) + - [Dynamic Value Suggestions](#dynamic-value-suggestions) + - [Controlling Visibility](#controlling-visibility) + - [Limitations](#limitations) + - [Tips](#tips) ## Installation ```sh @@ -171,12 +186,15 @@ Command: `dotnet example.dll my:first-command --help` | showOptions | `OptionDecorationLevel` | It will define, how options will be shown in the command help output. (Default is `Minimal`) | | command | `commandName: string`, `CommandDefinition` | It will register a command to the application. | | defaultCommand | `commandName: string` | It will set a name of default command. Default command is run when no command name is pass to the arguments. (_Default is `list`._) | +| fallbackCommand | `commandName: string` | It will set a name of fallback command. Fallback command is run with all the given arguments, when the first argument does not match any command name - it allows a command-less `executable ` usage. (_Default is none - an unknown command name results in an error._) | | useOutput | `Output` | It will override `Output` in `IO`, which gets every command life-cycle function. (_Default is implemented by [ConsoleStyle](https://github.com/FeatherTools/console-style)_) | | useAsk | `question: string -> answer: string` | It will override an Ask function, which is used in `Interact` life-cycle stage. (_Default is implemented by [ConsoleStyle](https://github.com/FeatherTools/console-application#ask))_ | | updateOutput | `Output -> Output` | Function which allows to change the output (set style, different outputInterface for a ConsoleStyle and more) | | withStyle | `Feather.ConsoleApplication.Style` | A style which will be set to the `Output`. | | withCustomTags | `Feather.ConsoleApplication.CustomTag list` | It will register custom tags to the Output Style. | | | `Result list` | It will handle results and register custom tags to the Output Style. | +| enableCompletion | | It will enable shell completion with the default configuration. (_See [Shell Completion](#shell-completion)._) | +| | `CompletionConfig` | It will enable shell completion with a custom configuration. | NOTES: - All parts of ApplicationInfo are shown in `about` command @@ -284,32 +302,32 @@ There are many ways how to access Arguments: - Through pattern matching - | Active Pattern | Description | - | --- | --- | - | _Input_._Argument_.**IsDefined** | Matched when given string is defined as argument name. | + | Active Pattern | Description | + | -------------------------------- | ---------------------------------------------------------------------------------- | + | _Input_._Argument_.**IsDefined** | Matched when given string is defined as argument name. | | _Input_._Argument_.**Has** | Matched when given string has any value in current Input (_default or from args_). | - | _Input_._Argument_.**IsSet** | Matched when input _has_ argument AND that value is _not empty_. | + | _Input_._Argument_.**IsSet** | Matched when input _has_ argument AND that value is _not empty_. | - Active patterns for accessing a value - | Active Pattern | Description | Value | - | --- | --- | --- | - | _Input_._Argument_.**Value** | Matched when input _has_ argument. (_Fail with exception when value is not set or it is a list._) | `string` | - | _Input_._Argument_.**OptionalValue** | Matched when input _has_ argument AND it has a single value. | `string` | - | _Input_._Argument_.**ListValue** | Matched when input _has_ argument. | `string list` | + | Active Pattern | Description | Value | + | ------------------------------------ | ------------------------------------------------------------------------------------------------- | ------------- | + | _Input_._Argument_.**Value** | Matched when input _has_ argument. (_Fail with exception when value is not set or it is a list._) | `string` | + | _Input_._Argument_.**OptionalValue** | Matched when input _has_ argument AND it has a single value. | `string` | + | _Input_._Argument_.**ListValue** | Matched when input _has_ argument. | `string list` | - Just get a value from `Input` - | Function | Description | - | --- | --- | - | _Input_._Argument_.**tryGet** | Returns an `ArgumentValue option`, when Input _has_ argument. | - | _Input_._Argument_.**get** | Returns an `ArgumentValue`, when Input _has_ argument OR fail with exception. | - | _Input_._Argument_.**value** | Returns a `string` value from ArgumentValue, when Input _has_ argument OR fail with exception. | - | _Input_._Argument_.**asString** | Returns a `string option` value from ArgumentValue, when Input _has_ argument. | + | Function | Description | + | ---------------------------------- | ----------------------------------------------------------------------------------------------------------------------------------------- | + | _Input_._Argument_.**tryGet** | Returns an `ArgumentValue option`, when Input _has_ argument. | + | _Input_._Argument_.**get** | Returns an `ArgumentValue`, when Input _has_ argument OR fail with exception. | + | _Input_._Argument_.**value** | Returns a `string` value from ArgumentValue, when Input _has_ argument OR fail with exception. | + | _Input_._Argument_.**asString** | Returns a `string option` value from ArgumentValue, when Input _has_ argument. | | _Input_._Argument_.**asInt** | Returns an `int option` value from ArgumentValue, when Input _has_ argument. (_It fails with an exception when string value is not int._) | - | _Input_._Argument_.**asList** | Returns an `string list` value from ArgumentValue, when Input _has_ argument. (_It returns a list even for single values._) | - | _Input_._Argument_.**tryGetAsInt** | Returns an `int option` value from ArgumentValue, when Input _has_ argument. (_It returns None when string value is not int._) | - | _Input_._Argument_.**isValueSet** | Checks whether argument has a value AND that value is _not empty_. | + | _Input_._Argument_.**asList** | Returns an `string list` value from ArgumentValue, when Input _has_ argument. (_It returns a list even for single values._) | + | _Input_._Argument_.**tryGetAsInt** | Returns an `int option` value from ArgumentValue, when Input _has_ argument. (_It returns None when string value is not int._) | + | _Input_._Argument_.**isValueSet** | Checks whether argument has a value AND that value is _not empty_. | Note: All functions above will fail with an exception when given "argument" is not defined. @@ -356,32 +374,32 @@ There are many ways how to access Options: - Through pattern matching - | Active Pattern | Description | - | --- | --- | - | _Input_._Option_.**IsDefined** | Matched when given string is defined as option name. | + | Active Pattern | Description | + | ------------------------------ | ---------------------------------------------------------------------------------- | + | _Input_._Option_.**IsDefined** | Matched when given string is defined as option name. | | _Input_._Option_.**Has** | Matched when given string has any value in current Input (_default or from args_). | - | _Input_._Option_.**IsSet** | Matched when input _has_ option AND that value is _not empty_. | + | _Input_._Option_.**IsSet** | Matched when input _has_ option AND that value is _not empty_. | - Active patterns for accessing a value - | Active Pattern | Description | Value | - | --- | --- | --- | - | _Input_._Option_.**Value** | Matched when input _has_ option. (_Fail with exception when value is not set or it is a list._) | `string` | - | _Input_._Option_.**OptionalValue** | Matched when input _has_ option AND it has a single value. | `string` | - | _Input_._Option_.**ListValue** | Matched when input _has_ option. | `string list` | + | Active Pattern | Description | Value | + | ---------------------------------- | ----------------------------------------------------------------------------------------------- | ------------- | + | _Input_._Option_.**Value** | Matched when input _has_ option. (_Fail with exception when value is not set or it is a list._) | `string` | + | _Input_._Option_.**OptionalValue** | Matched when input _has_ option AND it has a single value. | `string` | + | _Input_._Option_.**ListValue** | Matched when input _has_ option. | `string list` | - Just get a value from `Input` - | Function | Description | - | --- | --- | - | _Input_.Option_.**tryGet** | Returns an `OptionValue option`, when Input _has_ option. | - | _Input_.Option_.**get** | Returns an `OptionValue`, when Input _has_ option OR fail with exception. | - | _Input_.Option_.**value** | Returns a `string` value from OptionValue, when Input _has_ option OR fail with exception. | - | _Input_.Option_.**asString** | Returns a `string option` value from OptionValue, when Input _has_ option. | + | Function | Description | + | ------------------------------- | ------------------------------------------------------------------------------------------------------------------------------------- | + | _Input_.Option_.**tryGet** | Returns an `OptionValue option`, when Input _has_ option. | + | _Input_.Option_.**get** | Returns an `OptionValue`, when Input _has_ option OR fail with exception. | + | _Input_.Option_.**value** | Returns a `string` value from OptionValue, when Input _has_ option OR fail with exception. | + | _Input_.Option_.**asString** | Returns a `string option` value from OptionValue, when Input _has_ option. | | _Input_.Option_.**asInt** | Returns an `int option` value from OptionValue, when Input _has_ option. (_It fails with an exception when string value is not int._) | - | _Input_.Option_.**asList** | Returns an `string list` value from OptionValue, when Input _has_ option. (_It returns a list even for single values._) | - | _Input_.Option_.**tryGetAsInt** | Returns an `int option` value from OptionValue, when Input _has_ option. (_It returns None when string value is not int._) | - | _Input_._Option_.**isValueSet** | Checks whether option has a value AND that value is _not empty_. | + | _Input_.Option_.**asList** | Returns an `string list` value from OptionValue, when Input _has_ option. (_It returns a list even for single values._) | + | _Input_.Option_.**tryGetAsInt** | Returns an `int option` value from OptionValue, when Input _has_ option. (_It returns None when string value is not int._) | + | _Input_._Option_.**isValueSet** | Checks whether option has a value AND that value is _not empty_. | Note: All functions above will fail with an exception when given "option" is not defined. @@ -527,6 +545,148 @@ Help = ] ``` +## Shell Completion + +### Enabling Completion + +To enable shell completion for your console application, use the `enableCompletion` CE operation: + +```fsharp +let app = + consoleApplication { + name "myapp" + enableCompletion // Uses default configuration: command name "completion", visible in help + } +``` + +You can also customize the completion command configuration: + +```fsharp +enableCompletion { CompletionConfig.defaults with CommandName = "complete" } +``` + +| Field | Default | Meaning | +| --- | --- | --- | +| `CommandName` | `"completion"` | Name of the command generating the shell scripts. It must not collide with a reserved name or with one of your commands. | +| `IsVisible` | `true` | Whether the completion command is shown by `list` and `help`. | +| `ExecutableName` | `None` | Command the generated script completes. Defaults to the name of the running executable, which is what you want unless your binary is started under a different name. | + +### Generating Shell Scripts + +Once completion is enabled, you can generate integration scripts for your shell: + +```bash +myapp completion bash >> ~/.bashrc +myapp completion zsh >> ~/.zshrc +myapp completion fish >> ~/.config/fish/completions/myapp.fish +``` + +After adding the script, source the file (or restart your shell): + +```bash +source ~/.bashrc +# or +source ~/.zshrc +# or just restart your terminal for fish +``` + +The generated script completes the running executable automatically — no manual substitution needed. Set `ExecutableName` when the binary is invoked under another name. + +### How It Works + +Completion uses two commands internally: + +- `completion` (or your configured public name) generates shell integration scripts. +- `__completion` is an internal hidden resolver command used by generated scripts at runtime. + +The shell tokenizes the line, so the resolver is called with the words it parsed and the index of the word being completed: + +```bash +myapp __completion 2 -- myapp deploy pro +``` + +The resolver resolves suggestions from your registered command metadata (command names, arguments, and options) and returns one per line, as `value` or `valuedescription`. Each generated script then filters, escapes and inserts them the way its own shell requires. + +Both `--option value` and `--option=value` are completed, and a value given to an option is not counted as a positional argument. After the `--` end-of-options separator, every word is completed as a positional value and option names are never suggested. A failing suggestion callback yields no suggestions, so it never leaks into the shell. + +Quoting is handled by the shell, which passes the word at the cursor already unquoted: `"my value"`, `'my value'` and `my\ value` are completed as a single word, and an unclosed quote is the word being typed. Values containing spaces are completed and escaped as the typed word requires. + +Short options are completed as clusters, mirroring how they are parsed: `-fv` extends a cluster of value-less shortcuts, and when the last shortcut takes a value, that value is completed either inside the same word (`-oval1`) or as the next one (`-fo val1`). + +Command and option name suggestions carry the description you defined for them. Zsh and fish display it next to the value, bash drops it — readline has nowhere to show it. + +### Dynamic Value Suggestions + +Suggestions are attached directly to option and argument definitions with `Option.suggest` and `Argument.suggest`: + +```fsharp +command "deploy" { + Description = "Deploy command" + Help = None + Arguments = [ + Argument.required "target" "Deployment target" + |> Argument.suggest (Suggest.sync (fun ctx -> getTargets ctx.CurrentWord)) + ] + Options = [ + Option.required "env" (Some "e") "Environment" "" + |> Option.suggest (Suggest.values ["dev"; "staging"; "prod"]) + ] + Initialize = None + Interact = None + Execute = Execute <| fun (_, _) -> ExitCode.Success +} +``` + +Built-in suggestion sources: + +```fsharp +Option.required "path" None "Path" "" +|> Option.suggest Suggest.files + +Option.required "dir" None "Directory" "" +|> Option.suggest Suggest.directories + +Option.required "project" None "Project file" "" +|> Option.suggest (Suggest.filesWithExtension [".fsproj"; ".csproj"]) +``` + +Suggestion sources are composable: + +```fsharp +Suggest.values ["dev"; "staging"; "prod"] +|> Suggest.map String.toUpperInvariant +|> Suggest.filter (fun value -> value <> "PROD") +``` + +Available combinators: + +- `Suggest.map` +- `Suggest.mapAsync` +- `Suggest.filter` +- `Suggest.filterAsync` + +Values may carry a description of their own, shown by the shells able to display it: + +```fsharp +Option.required "env" (Some "e") "Environment" "" +|> Option.suggest (Suggest.describedValues ["dev", "Development"; "prod", "Production"]) +``` + +### Controlling Visibility + +Set `IsVisible = false` to hide the completion command from `list` and `help` output while still allowing the shell to invoke it: + +```fsharp +enableCompletion { CompletionConfig.defaults with IsVisible = false } +``` + +### Limitations + +- **PowerShell not supported**: PowerShell shell completion is not yet supported. +- **No descriptions in bash**: readline shows the value only, so descriptions are dropped by the bash script. +- **Escaped display in bash**: when several suggestions match, bash lists them escaped (`my\ value`), since the escaping is what makes the inserted word correct. +- **bash 3 quoting**: the bash script takes the unquoted word at the cursor from `$2`, which needs bash 4 or newer. On bash 3 (the version shipped with macOS) a word with a quote in it is passed to the resolver as typed. + ## Tips Add `bin/console` file with following content to allow a simple entry point for your application diff --git a/build/Build.fs b/build/Build.fs index a13ebec..7af78fd 100644 --- a/build/Build.fs +++ b/build/Build.fs @@ -1,5 +1,5 @@ // ======================================================================================================== -// === F# / Project fake build ==================================================================== 1.3.0 = +// === F# / Project fake build ==================================================================== 1.6.0 = // -------------------------------------------------------------------------------------------------------- // Options: // - no-clean - disables clean of dirs in the first step (required on CI) diff --git a/build/SafeBuildHelpers.fs b/build/SafeBuildHelpers.fs index c7ef503..7671c46 100644 --- a/build/SafeBuildHelpers.fs +++ b/build/SafeBuildHelpers.fs @@ -12,31 +12,31 @@ module internal SafeBuildHelpers = module Parallel = open System - let locker = obj() - - let colors = - [| - ConsoleColor.Blue - ConsoleColor.Yellow - ConsoleColor.Magenta - ConsoleColor.Cyan - ConsoleColor.DarkBlue - ConsoleColor.DarkYellow - ConsoleColor.DarkMagenta - ConsoleColor.DarkCyan - |] + let locker = obj () + + let colors = [| + ConsoleColor.Blue + ConsoleColor.Yellow + ConsoleColor.Magenta + ConsoleColor.Cyan + ConsoleColor.DarkBlue + ConsoleColor.DarkYellow + ConsoleColor.DarkMagenta + ConsoleColor.DarkCyan + |] let print color (colored: string) (line: string) = - lock locker - (fun () -> - let currentColor = Console.ForegroundColor - Console.ForegroundColor <- color - Console.Write colored - Console.ForegroundColor <- currentColor - Console.WriteLine line) + lock locker (fun () -> + let currentColor = Console.ForegroundColor + Console.ForegroundColor <- color + Console.Write colored + Console.ForegroundColor <- currentColor + Console.WriteLine line + ) let onStdout index name (line: string) = - let color = colors.[index % colors.Length] + let color = colors[index % colors.Length] + if isNull line then print color $"{name}: --- END ---" "" else if String.isNotNullOrEmpty line then @@ -44,6 +44,7 @@ module internal SafeBuildHelpers = let onStderr name (line: string) = let color = ConsoleColor.Red + if isNull line |> not then print color $"{name}: " line @@ -54,10 +55,8 @@ module internal SafeBuildHelpers = let printStarting indexed = for (index, (name, c: CreateProcess<_>)) in indexed do - let color = colors.[index % colors.Length] - let wd = - c.WorkingDirectory - |> Option.defaultValue "" + let color = colors[index % colors.Length] + let wd = c.WorkingDirectory |> Option.defaultValue "" let exe = c.Command.Executable let args = c.Command.Arguments.ToStartInfo print color $"{name}: {wd}> {exe} {args}" "" @@ -66,36 +65,36 @@ module internal SafeBuildHelpers = cs |> Seq.toArray |> Array.indexed - |> fun x -> printStarting x; x + |> fun x -> + printStarting x + x |> Array.map redirect |> Array.Parallel.map Proc.run - let createProcess exe arg dir = - CreateProcess.fromRawCommandLine exe arg + let createProcess exe args dir = + // Use `fromRawCommand` rather than `fromRawCommandLine`, as its behaviour is less likely to be misunderstood. + // See https://github.com/SAFE-Stack/SAFE-template/issues/551. + CreateProcess.fromRawCommand exe args |> CreateProcess.withWorkingDirectory dir |> CreateProcess.ensureExitCode - let dotnet = createProcess "dotnet" - let npm = + let dotnet args dir = createProcess "dotnet" args dir + + let npm args dir = let npmPath = match ProcessUtils.tryFindFileOnPath "npm" with | Some path -> path | None -> - "npm was not found in path. Please install it and make sure it's available from your path. " + - "See https://safe-stack.github.io/docs/quickstart/#install-pre-requisites for more info" + "npm was not found in path. Please install it and make sure it's available from your path. " + + "See https://safe-stack.github.io/docs/quickstart/#install-pre-requisites for more info" |> failwith - createProcess npmPath + createProcess npmPath args dir - let run proc arg dir = - proc arg dir - |> Proc.run - |> ignore + let run proc arg dir = proc arg dir |> Proc.run |> ignore let runParallel processes = - processes - |> Proc.Parallel.run - |> ignore + processes |> Proc.Parallel.run |> ignore let runOrDefault args = try diff --git a/build/Targets.fs b/build/Targets.fs index 963a51c..a997082 100644 --- a/build/Targets.fs +++ b/build/Targets.fs @@ -25,45 +25,57 @@ module internal Targets = let init safe = Target.create "SafeClean" (fun _ -> Shell.cleanDir safe.DeployPath - run dotnet "fable clean --yes" safe.ClientPath // Delete *.fs.js files created by Fable + run dotnet [ "fable"; "clean"; "--yes" ] safe.ClientPath // Delete *.fs.js files created by Fable ) Target.create "InstallClient" (fun _ -> - run npm "--version" "." - run npm "install" "." + run npm [ "--version" ] "." + run npm [ "install" ] "." ) Target.create "Bundle" (fun _ -> [ - "server", dotnet $"publish -c Release -o \"{safe.DeployPath}\"" safe.ServerPath - "client", dotnet "fable -o output -s --run npm run build" safe.ClientPath + "server", dotnet [ "publish"; "-c"; "Release"; "-o"; safe.DeployPath ] safe.ServerPath + "client", dotnet [ "fable"; "-o"; "output"; "-s"; "--run"; "npx"; "vite"; "build" ] safe.ClientPath ] |> runParallel ) Target.create "Run" (fun _ -> - run dotnet "build" safe.SharedPath + run dotnet [ "build" ] safe.SharedPath [ - "server", dotnet "watch run" safe.ServerPath - "client", dotnet "fable watch -o output -s --run npm run start" safe.ClientPath + "server", dotnet [ "watch"; "run" ] safe.ServerPath + "client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] safe.ClientPath + ] + |> runParallel + ) + + Target.create "RunMirrord" (fun _ -> + run dotnet [ "build" ] safe.SharedPath + Environment.setEnvironVar "RUN_IN" "mirrord" + [ + "server", createProcess "mirrord" [ "exec"; "--config-file"; "../../.mirrord/mirrord.json"; "--"; "dotnet"; "watch"; "run" ] safe.ServerPath + "client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] safe.ClientPath ] |> runParallel ) Target.create "WatchTests" (fun _ -> - run dotnet "build" safe.SharedTestsPath + run dotnet [ "build" ] safe.SharedTestsPath + [ - "server", dotnet "watch run" safe.ServerTestsPath - "client", dotnet "fable watch -o output -s --run npm run test:live" safe.ClientTestsPath + "server", dotnet [ "watch"; "run" ] safe.ServerTestsPath + "client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] safe.ClientTestsPath ] |> runParallel ) Target.create "Tests" (fun _ -> - run dotnet "build" safe.SharedTestsPath + run dotnet [ "build" ] safe.SharedTestsPath + [ - "server", dotnet "run" safe.ServerTestsPath - // "client", dotnet "fable watch -o output -s --run npm run test:live" clientTestsPath + "server", dotnet [ "run" ] safe.ServerTestsPath + //"client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] safe.ClientTestsPath ] |> runParallel ) @@ -85,7 +97,7 @@ module internal Targets = ==> "Tests" <=> "WatchTests" "Build" - ==> "Run" + ==> "Run" <=> "RunMirrord" ] let init (definition: ProjectDefinition) = @@ -341,10 +353,20 @@ module internal Targets = Dotnet.runInRootOrFail "watch run" ) + Target.create "WatchMirrord" (fun _ -> + Environment.setEnvironVar "RUN_IN" "mirrord" + run (createProcess "mirrord") "exec --config-file .mirrord/mirrord.json -- dotnet watch run" "." + ) + Target.create "Run" (fun _ -> Dotnet.runInRootOrFail "run" ) + Target.create "RunMirrord" (fun _ -> + Environment.setEnvironVar "RUN_IN" "mirrord" + run (createProcess "mirrord") "exec --config-file .mirrord/mirrord.json -- dotnet run" "." + ) + // -------------------------------------------------------------------------------------------------------- // 3. FAKE targets hierarchy // -------------------------------------------------------------------------------------------------------- @@ -372,7 +394,7 @@ module internal Targets = ==> "ZipRelease" "Build" - ==> "Watch" <=> "Run" + ==> "Watch" <=> "WatchMirrord" <=> "Run" <=> "RunMirrord" ] | { Specs = Executable _ } -> @@ -382,7 +404,7 @@ module internal Targets = ==> "Build" ==> "Lint" ==> "Tests" - ==> "Release" <=> "Watch" <=> "Run" + ==> "Release" <=> "Watch" <=> "WatchMirrord" <=> "Run" <=> "RunMirrord" ] | { Specs = SAFEStackApplication safe } -> diff --git a/build/build.fsproj b/build/build.fsproj index f7eb3b9..2d46ce8 100644 --- a/build/build.fsproj +++ b/build/build.fsproj @@ -4,6 +4,7 @@ Exe net10.0 false + NU1510 diff --git a/console-application.fsproj b/console-application.fsproj index 37c4141..c64e763 100644 --- a/console-application.fsproj +++ b/console-application.fsproj @@ -24,10 +24,18 @@ + + + + + + + + diff --git a/fsharplint.json b/fsharplint.json new file mode 100644 index 0000000..e0e6bd8 --- /dev/null +++ b/fsharplint.json @@ -0,0 +1,496 @@ +{ + "ignoreFiles": [ + "AssemblyInfo", + "AssemblyInfo.fs", + "AssemblyAttributes" + ], + "global": { + "numIndentationSpaces": 4 + }, + "typedItemSpacing": { + "enabled": true, + "config": { + "typedItemStyle": "SpaceAfter" + } + }, + "typePrefixing": { + "enabled": true, + "config": { + "mode": "Hybrid" + } + }, + "unionDefinitionIndentation": { "enabled": false }, + "moduleDeclSpacing": { "enabled": false }, + "classMemberSpacing": { "enabled": false }, + "tupleCommaSpacing": { "enabled": true }, + "tupleIndentation": { "enabled": false }, + "tupleParentheses": { "enabled": false }, + "patternMatchClausesOnNewLine": { "enabled": false }, + "patternMatchOrClausesOnNewLine": { "enabled": false }, + "patternMatchClauseIndentation": { "enabled": false }, + "patternMatchExpressionIndentation": { "enabled": false }, + "recursiveAsyncFunction": { "enabled": true }, + "redundantNewKeyword": { "enabled": true }, + "nestedStatements": { + "enabled": false, + "config": { + "depth": 8 + } + }, + "cyclomaticComplexity": { + "enabled": false, + "config": { + "maxComplexity": 40 + } + }, + "reimplementsFunction": { "enabled": true }, + "canBeReplacedWithComposition": { "enabled": true }, + "avoidSinglePipeOperator": { "enabled": false }, + "usedUnderscorePrefixedElements": { "enabled": true }, + "failwithWithSingleArgument": { "enabled": true }, + "raiseWithSingleArgument": { "enabled": true }, + "nullArgWithSingleArgument": { "enabled": true }, + "invalidOpWithSingleArgument": { "enabled": true }, + "invalidArgWithTwoArguments": { "enabled": true }, + "failwithfWithArgumentsMatchingFormatString": { "enabled": true }, + "failwithBadUsage": { "enabled": true }, + "maxLinesInLambdaFunction": { + "enabled": false, + "config": { + "maxLines": 7 + } + }, + "maxLinesInMatchLambdaFunction": { + "enabled": false, + "config": { + "maxLines": 100 + } + }, + "maxLinesInValue": { + "enabled": false, + "config": { + "maxLines": 100 + } + }, + "maxLinesInFunction": { + "enabled": false, + "config": { + "maxLines": 100 + } + }, + "maxLinesInMember": { + "enabled": false, + "config": { + "maxLines": 100 + } + }, + "maxLinesInConstructor": { + "enabled": false, + "config": { + "maxLines": 100 + } + }, + "maxLinesInProperty": { + "enabled": false, + "config": { + "maxLines": 70 + } + }, + "maxLinesInModule": { + "enabled": false, + "config": { + "maxLines": 1000 + } + }, + "maxLinesInRecord": { + "enabled": false, + "config": { + "maxLines": 500 + } + }, + "maxLinesInEnum": { + "enabled": false, + "config": { + "maxLines": 500 + } + }, + "maxLinesInUnion": { + "enabled": false, + "config": { + "maxLines": 500 + } + }, + "maxLinesInClass": { + "enabled": false, + "config": { + "maxLines": 500 + } + }, + "interfaceNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None", + "prefix": "I" + } + }, + "exceptionNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None", + "suffix": "Exception" + } + }, + "typeNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "recordFieldNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "enumCasesNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "unionCasesNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "moduleNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "literalNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "namespaceNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "memberNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "AllowPrefix" + } + }, + "parameterNames": { + "enabled": true, + "config": { + "naming": "CamelCase", + "underscores": "AllowPrefix" + } + }, + "measureTypeNames": { + "enabled": true, + "config": { + "underscores": "None" + } + }, + "activePatternNames": { + "enabled": true, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "genericTypesNames": { + "enabled": false, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "publicValuesNames": { + "enabled": true, + "config": { + "underscores": "AllowPrefix" + } + }, + "privateValuesNames": { + "enabled": true, + "config": { + "naming": "CamelCase", + "underscores": "AllowPrefix" + } + }, + "internalValuesNames": { + "enabled": true, + "config": { + "naming": "CamelCase", + "underscores": "AllowPrefix" + } + }, + "unnestedFunctionNames": { + "enabled": false, + "config": { + "naming": "PascalCase", + "underscores": "None" + } + }, + "nestedFunctionNames": { + "enabled": false, + "config": { + "naming": "CamelCase", + "underscores": "None" + } + }, + "maxNumberOfItemsInTuple": { + "enabled": false, + "config": { + "maxItems": 4 + } + }, + "maxNumberOfFunctionParameters": { + "enabled": false, + "config": { + "maxItems": 5 + } + }, + "maxNumberOfMembers": { + "enabled": false, + "config": { + "maxItems": 32 + } + }, + "maxNumberOfBooleanOperatorsInCondition": { + "enabled": false, + "config": { + "maxItems": 4 + } + }, + "favourIgnoreOverLetWild": { "enabled": true }, + "wildcardNamedWithAsPattern": { "enabled": true }, + "uselessBinding": { "enabled": true }, + "tupleOfWildcards": { "enabled": true }, + "favourTypedIgnore": { "enabled": false }, + "favourNonMutablePropertyInitialization": { "enabled": false }, + "favourReRaise": { "enabled": true }, + "favourStaticEmptyFields": { "enabled": false }, + "favourConsistentThis": { + "enabled": false, + "config": { + "symbol": "this" + } + }, + "suggestUseAutoProperty": { "enabled": false }, + "avoidTooShortNames": { "enabled": false }, + "asyncExceptionWithoutReturn": { "enabled": false }, + "unneededRecKeyword": { "enabled": true }, + "indentation": { + "enabled": false + }, + "maxCharactersOnLine": { + "enabled": false, + "config": { + "maxCharactersOnLine": 120 + } + }, + "trailingWhitespaceOnLine": { + "enabled": true, + "config": { + "numberOfSpacesAllowed": 0, + "oneSpaceAllowedAfterOperator": false, + "ignoreBlankLines": false + } + }, + "maxLinesInFile": { + "enabled": false, + "config": { + "maxLinesInFile": 1000 + } + }, + "trailingNewLineInFile": { "enabled": false }, + "noTabCharacters": { "enabled": true }, + "noPartialFunctions": { + "enabled": false, + "config": { + "allowedPartials": [], + "additionalPartials": [] + } + }, + "ensureTailCallDiagnosticsInRecursiveFunctions": { "enabled": true }, + "favourAsKeyword": { "enabled": true }, + "interpolatedStringWithNoSubstitution": { "enabled": false }, + "indexerAccessorStyleConsistency": { + "enabled": true, + "config": { + "style": "CSharp" + } + }, + "favourSingleton": { "enabled": false }, + "noAsyncRunSynchronouslyInLibrary": { "enabled": true }, + "favourNestedFunctions": { "enabled": false }, + "disallowShadowing": { "enabled": false }, + "discourageStringInterpolationWithStringFormat": { + "enabled": false + }, + "favourNamedMembers": { "enabled": false }, + "synchronousFunctionNames": { "enabled": true }, + "asynchronousFunctionNames": { + "enabled": true, + "config": { + "mode": "OnlyPublicAPIsInLibraries" + } + }, + "simpleAsyncComplementaryHelpers": { + "enabled": false, + "config": { + "mode": "OnlyPublicAPIsInLibraries" + } + }, + "hints": { + "add": [ + "not (a = b) ===> a <> b", + "not (a <> b) ===> a = b", + "not (a > b) ===> a <= b", + "not (a >= b) ===> a < b", + "not (a < b) ===> a >= b", + "not (a <= b) ===> a > b", + "compare x y <> 1 ===> x <= y", + "compare x y = -1 ===> x < y", + "compare x y <> -1 ===> x >= y", + "compare x y = 1 ===> x > y", + "compare x y <= 0 ===> x <= y", + "compare x y < 0 ===> x < y", + "compare x y >= 0 ===> x >= y", + "compare x y > 0 ===> x > y", + "compare x y = 0 ===> x = y", + "compare x y <> 0 ===> x <> y", + + "List.head (List.sort x) ===> List.min x", + "List.head (List.sortBy f x) ===> List.minBy f x", + + "List.map f (List.map g x) ===> List.map (g >> f) x", + "Array.map f (Array.map g x) ===> Array.map (g >> f) x", + "Seq.map f (Seq.map g x) ===> Seq.map (g >> f) x", + "List.nth x 0 ===> List.head x", + "List.map f (List.replicate n x) ===> List.replicate n (f x)", + "List.rev (List.rev x) ===> x", + "Array.rev (Array.rev x) ===> x", + "List.fold (@) [] x ===> List.concat x", + "List.map id x ===> id x", + "Array.map id x ===> id x", + "Seq.map id x ===> id x", + "(List.length x) = 0 ===> List.isEmpty x", + "(Array.length x) = 0 ===> Array.isEmpty x", + "(Seq.length x) = 0 ===> Seq.isEmpty x", + "x = [] ===> List.isEmpty x", + "x = [||] ===> Array.isEmpty x", + "(List.length x) <> 0 ===> not (List.isEmpty x)", + "(Array.length x) <> 0 ===> not (Array.isEmpty x)", + "(Seq.length x) <> 0 ===> not (Seq.isEmpty x)", + "(List.length x) > 0 ===> not (List.isEmpty x)", + "(Array.length x) <> 0 ===> not (Array.isEmpty x)", + "(Seq.length x) <> 0 ===> not (Seq.isEmpty x)", + + "List.concat (List.map f x) ===> List.collect f x", + "Array.concat (Array.map f x) ===> Array.collect f x", + "Seq.concat (Seq.map f x) ===> Seq.collect f x", + + "List.isEmpty (List.filter f x) ===> not (List.exists f x)", + "Array.isEmpty (Array.filter f x) ===> not (Array.exists f x)", + "Seq.isEmpty (Seq.filter f x) ===> not (Seq.exists f x)", + "not (List.isEmpty (List.filter f x)) ===> List.exists f x", + "not (Array.isEmpty (Array.filter f x)) ===> Array.exists f x", + "not (Seq.isEmpty (Seq.filter f x)) ===> Seq.exists f x", + + "List.length x >= 0 ===> true", + "Array.length x >= 0 ===> true", + "Seq.length x >= 0 ===> true", + + "x = true ===> x", + "x = false ===> not x", + "true = a ===> a", + "false = a ===> not a", + "a <> true ===> not a", + "a <> false ===> a", + "true <> a ===> not a", + "false <> a ===> a", + "if a then true else false ===> a", + "if a then false else true ===> not a", + "if x then y else y ===> y", + "not (not x) ===> x", + + "(fst x, snd x) ===> x", + + "true && x ===> x", + "false && x ===> false", + "true || x ===> true", + "false || x ===> x", + "not true ===> false", + "not false ===> true", + "fst (x, y) ===> x", + "snd (x, y) ===> y", + "List.fold f x [] ===> x", + "Array.fold f x [||] ===> x", + "List.foldBack f [] x ===> x", + "Array.foldBack f [||] x ===> x", + "x - 0 ===> x", + "x * 1 ===> x", + "x / 1 ===> x", + + "List.fold (+) 0 x ===> List.sum x", + "Array.fold (+) 0 x ===> Array.sum x", + "Seq.fold (+) 0 x ===> Seq.sum x", + "List.sum (List.map x y) ===> List.sumBy x y", + "Array.sum (Array.map x y) ===> Array.sumBy x y", + "Seq.sum (Seq.map x y) ===> Seq.sumBy x y", + "List.average (List.map x y) ===> List.averageBy x y", + "Array.average (Array.map x y) ===> Array.averageBy x y", + "Seq.average (Seq.map x y) ===> Seq.averageBy x y", + "(List.take x y, List.skip x y) ===> List.splitAt x y", + "(Array.take x y, Array.skip x y) ===> Array.splitAt x y", + "(Seq.take x y, Seq.skip x y) ===> Seq.splitAt x y", + + "List.empty ===> []", + "Array.empty ===> [||]", + + "x::[] ===> [x]", + "pattern: x::[] ===> [x]", + + "x @ [] ===> x", + "(List.singleton x) @ y ===> x :: y", + + "List.isEmpty [] ===> true", + "Array.isEmpty [||] ===> true", + + "fun _ -> () ===> ignore", + "fun x -> x ===> id", + "id x ===> x", + "id >> f ===> f", + "f >> id ===> f", + + "x = null ===> isNull x", + "null = x ===> isNull x", + "x <> null ===> not (isNull x)", + "null <> x ===> not (isNull x)", + + "Array.append a (Array.append b c) ===> Array.concat [|a; b; c|]" + ] + } +} \ No newline at end of file diff --git a/src/Arguments.fs b/src/Arguments.fs index 8cd7ad0..f05ee72 100644 --- a/src/Arguments.fs +++ b/src/Arguments.fs @@ -36,12 +36,14 @@ type Argument = private { ArgumentName: ArgumentName Description: string Value: ArgumentValueDefinition + Suggest: Suggest option } type RawArgumentDefinition = internal { ArgumentName: ArgumentName Description: string Value: ArgumentValueDefinition + Suggest: Suggest option } [] @@ -60,6 +62,7 @@ module internal RawArgumentDefinition = ArgumentName = name Description = description Value = value + Suggest = None } } @@ -86,12 +89,17 @@ module Argument = let optionalArray name description defaultValue = create name description (ArgumentValueDefinition.Array defaultValue) + /// Attach completion suggestions to an argument definition. + let suggest (suggestion: Suggest) (def: Result): Result = + def |> Result.map (fun d -> { d with Suggest = Some suggestion }) + // // Internal Argument functions // let internal name ({ ArgumentName = name }: Argument) = name let internal nameValue = name >> ArgumentName.value let internal valueDefinition ({ Value = value }: Argument) = value + let internal suggestion ({ Suggest = suggest }: Argument) = suggest let internal usage ({ ArgumentName = name; Value = definition }: Argument) = name @@ -183,6 +191,7 @@ module internal ArgumentsDefinitions = ArgumentName = raw.ArgumentName Description = raw.Description Value = raw.Value + Suggest = raw.Suggest } let validate (arguments: RawArgumentDefinition list) = diff --git a/src/Builder.fs b/src/Builder.fs index 0d5f94e..f9c5ca9 100644 --- a/src/Builder.fs +++ b/src/Builder.fs @@ -21,6 +21,7 @@ type internal DefinitionParts = { Commands: Commands DefaultCommand: CommandName OptionDecorationLevel: OptionDecorationLevel + Completion: CompletionConfig option } [] @@ -46,6 +47,7 @@ module internal DefinitionParts = Commands = Map.empty DefaultCommand = CommandName (Name CommandNames.List) OptionDecorationLevel = Minimal + Completion = None } let output { Output = output } = output @@ -229,10 +231,19 @@ type ConsoleApplicationBuilder<'Application> internal (buildApplication: Definit return parts } + [] + member _.EnableCompletion(state): Definition = + state fun parts -> { parts with Completion = Some CompletionConfig.defaults } + + [] + member _.EnableCompletion(state, config: CompletionConfig): Definition = + state fun parts -> { parts with Completion = Some config } + [] module internal ConsoleApplicationBuilder = let buildApplication showHelpForCommand (Definition definition) = - definition (fun parts -> + definition + |> Result.bind (fun parts -> result { let showHelpForCommand = showHelpForCommand parts.Output parts.OptionDecorationLevel parts.ApplicationOptions let aboutCommand = Commands.aboutCommand parts.Meta @@ -247,11 +258,19 @@ module internal ConsoleApplicationBuilder = ] |> Map.ofList - { parts with - Commands = commands - |> Commands.add CommandNames.List (Commands.listCommand parts.ApplicationOptions commands) - |> Commands.add CommandNames.Help (Commands.helpCommand showHelpForCommand commands) - |> Commands.add CommandNames.About aboutCommand - } - ) + let! dispatchCommands, discoveryCommands = + match parts.Completion with + | None -> Ok (commands, commands) + | Some config -> + let userCommandNames = parts.Commands |> Map.toList |> List.map (fst >> CommandName.value) + commands |> Completion.Setup.wire userCommandNames parts.ApplicationOptions config + + let finalCommands = + dispatchCommands + |> Commands.add CommandNames.List (Commands.listCommand parts.ApplicationOptions discoveryCommands) + |> Commands.add CommandNames.Help (Commands.helpCommand showHelpForCommand discoveryCommands) + |> Commands.add CommandNames.About aboutCommand + + return { parts with Commands = finalCommands } + }) |> ConsoleApplication diff --git a/src/Command.fs b/src/Command.fs index 32fbede..910ff30 100644 --- a/src/Command.fs +++ b/src/Command.fs @@ -66,6 +66,13 @@ type CommandDefinition = { Execute: Execute } +[] +type CommandKind = + | User + /// Invoked by another process which parses its output, so it emits nothing but its result + /// and skips the interactive part of the life-cycle. + | System + type Command = private { Description: string Help: string option @@ -74,6 +81,7 @@ type Command = private { Initialize: Initialize option Interact: Interact option Execute: Execute + Kind: CommandKind } [] @@ -100,13 +108,18 @@ module internal CommandDefinition = Initialize = definition.Initialize Interact = definition.Interact Execute = definition.Execute + Kind = CommandKind.User } } + let internal validateAsSystemCommand (definition: CommandDefinition): Result = + validate definition fun command -> { command with Kind = CommandKind.System } + [] module internal Command = let description ({ Description = description }: Command) = description let definitions ({ Options = options; Arguments = arguments }: Command) = options, arguments + let kind ({ Kind = kind }: Command) = kind type internal Commands = Map @@ -144,7 +157,7 @@ module internal Commands = match commands |> namesByPattern partialNamePattern with | [] -> NoCommand name - | [ commandName ] -> ExactlyOne (commandName, commands.[commandName]) + | [ commandName ] -> ExactlyOne (commandName, commands[commandName]) | commandNames -> MoreThanOne (name, commandNames) let applicationOptions: OptionsDefinitions = @@ -396,4 +409,5 @@ module internal Commands = Initialize = None Interact = None Execute = Execute <| fun _ -> failwith "Exit command should not be executed." + Kind = CommandKind.User } diff --git a/src/Completion/CompletionConfig.fs b/src/Completion/CompletionConfig.fs new file mode 100644 index 0000000..a202a4d --- /dev/null +++ b/src/Completion/CompletionConfig.fs @@ -0,0 +1,17 @@ +namespace Feather.ConsoleApplication + +type CompletionConfig = { + CommandName: string + /// Whether the completion command is shown by list/help. + IsVisible: bool + /// Command the generated script completes; defaults to the running executable name. + ExecutableName: string option +} + +[] +module CompletionConfig = + let defaults = { + CommandName = "completion" + IsVisible = true + ExecutableName = None + } diff --git a/src/Completion/Definitions.fs b/src/Completion/Definitions.fs new file mode 100644 index 0000000..9c78e37 --- /dev/null +++ b/src/Completion/Definitions.fs @@ -0,0 +1,100 @@ +namespace Feather.ConsoleApplication.Completion + +open Feather.ConsoleApplication + +/// Answers the questions a completion asks about the application's definitions. +[] +module internal Definitions = + open System + + /// A short token may cluster several shortcuts (`-abc`). Parsing stops at the first shortcut + /// taking a value, since the rest of the token is then that value. + type ShortcutCluster = + | ValueLessShortcuts + | ShortcutWithValue of Option * string + | UndefinedShortcut + + /// What a token already on the line means for the words after it. + [] + type TokenRole = + | EndOfOptions + | InlineValueOption + | ValueExpectingOption of Option + | FlagOption + | Positional + + [] + let EndOfOptions = "--" + + /// Accepts a lone `-` or `--` too: the parser has no option to match them against, but + /// completion must already treat them as the start of one. + let isOptionLike token = + token |> String.startsWith "-" + + /// Every shortcut variant an option answers to, paired with its option. + let shortcutVariants (options: OptionsDefinitions): (string * Option) list = + options + |> List.collect (fun (option: Option) -> + match option |> Option.shortcut with + | Some shortcut -> shortcut |> OptionShortcut.variants |> List.map (fun variant -> variant, option) + | None -> [] + ) + + let optionRequiresValue (option: Option) = + match option.Value with + | OptionValueDefinition.ValueRequired _ + | OptionValueDefinition.ValueRequiredArray _ -> true + | OptionValueDefinition.ValueNone + | OptionValueDefinition.ValueOptional _ + | OptionValueDefinition.ValueIsArray _ -> false + + let optionTakesValue (option: Option) = + match option.Value with + | OptionValueDefinition.ValueNone -> false + | _ -> true + + let findOption (token: string) (options: OptionsDefinitions) = + options |> List.tryFind (fun option -> token |> Option.isMatching option) + + [] + let rec private resolveShortcutLetters (options: OptionsDefinitions) letters = + match letters with + | [] -> ValueLessShortcuts + | letter :: rest -> + match options |> findOption ("-" + string (letter: char)) with + | None -> UndefinedShortcut + | Some option when option |> optionTakesValue -> ShortcutWithValue (option, rest |> List.toArray |> String) + | Some _ -> rest |> resolveShortcutLetters options + + let resolveShortcutCluster (token: string) (options: OptionsDefinitions) = + token.TrimStart '-' |> List.ofSeq |> resolveShortcutLetters options + + /// The option whose value is completed at the position right after the given token. + let optionExpectingValue (token: string) (options: OptionsDefinitions) = + if token |> String.startsWith "--" then + options |> findOption token |> Option.filter optionRequiresValue + elif token |> String.startsWith "-" then + match options |> resolveShortcutCluster token with + | ShortcutWithValue (option, "") when option |> optionRequiresValue -> Some option + | _ -> None + else None + + let classifyToken (options: OptionsDefinitions) (token: string): TokenRole = + if token = EndOfOptions then TokenRole.EndOfOptions + elif token |> isOptionLike then + match token |> Words.splitAssignment with + | Some _ -> TokenRole.InlineValueOption + | None -> + match options |> optionExpectingValue token with + | Some option -> TokenRole.ValueExpectingOption option + | None -> TokenRole.FlagOption + else TokenRole.Positional + + let findCommand (name: string) (commands: Commands) = + match name |> CommandName.createInRuntime with + | Error _ -> None + | Ok commandName -> + match commands |> Commands.find commandName with + | ExactlyOne (_, command) -> Some command + | MoreThanOne _ + | NoCommand _ -> None diff --git a/src/Completion/Setup.fs b/src/Completion/Setup.fs new file mode 100644 index 0000000..9934602 --- /dev/null +++ b/src/Completion/Setup.fs @@ -0,0 +1,132 @@ +namespace Feather.ConsoleApplication.Completion + +open Feather.ConsoleApplication +open Feather.ErrorHandling + +/// Adds the two commands completion needs to the application: the user-facing one printing the +/// shell script, and the hidden one the script calls back for suggestions. +[] +module internal Setup = + open System + open Feather.ErrorHandling.Result.Operators + + [] + let HiddenResolverCommandName = "__completion" + + type private ValidatedConfig = { + CommandName: CommandName + ResolverName: CommandName + IsVisible: bool + ExecutableName: string + } + + let private validateConfig (userCommandNames: string list) (config: CompletionConfig): Result = + let ensureAvailable name = + if userCommandNames |> List.contains name then Error (CommandNameError.Reserved name) + else name |> CommandName.create + + result { + do! + if config.CommandName = HiddenResolverCommandName + then Error (CommandNameError.Reserved HiddenResolverCommandName) + else Ok () + + let! commandName = ensureAvailable config.CommandName + let! resolverName = ensureAvailable HiddenResolverCommandName + + return { + CommandName = commandName + ResolverName = resolverName + IsVisible = config.IsVisible + ExecutableName = config.ExecutableName |> Option.defaultValue AppDomain.CurrentDomain.FriendlyName + } + } + <@> ConsoleApplicationError.CommandNameError + + let private scriptCommand (config: ValidatedConfig) = + let commandName = config.CommandName |> CommandName.value + + CommandDefinition.validateAsSystemCommand { + Description = "Generate shell completion scripts" + Help = None + Arguments = [ + Argument.optional "shell" (sprintf "Shell name (%s) for script generation" (Shell.names |> String.concat "|")) None + |> Argument.suggest (Suggest.values Shell.names) + ] + Options = [] + Initialize = None + Interact = None + Execute = Execute <| fun (input, output) -> + match input with + | Input.Argument.OptionalValue "shell" shellName -> + match shellName |> Shell.create with + | Ok shell -> + output.Message (ShellScript.generate shell config.ExecutableName commandName HiddenResolverCommandName) + ExitCode.Success + | Error error -> + output.Message (ShellError.format error) + ExitCode.Error + | _ -> + output.Message (sprintf "Usage: %s <%s>" commandName (Shell.names |> String.concat "|")) + ExitCode.Error + } + <@> ConsoleApplicationError.CommandDefinitionError + + /// The scripts of the shells showing descriptions split the line at the tab, the others cut it there. + let private formatSuggestion (suggestion: CompletionSuggestion) = + match suggestion |> CompletionSuggestion.description with + | Some description -> sprintf "%s\t%s" suggestion.Value description + | None -> suggestion.Value + + let private resolverCommand (commands: Commands) (applicationOptions: OptionsDefinitions) = + CommandDefinition.validateAsSystemCommand { + Description = "Resolve shell completion suggestions" + Help = None + Arguments = [ + Argument.required "index" "Index of the word being completed" + Argument.requiredArray "words" "Words of the command line, as the shell tokenized them" + ] + Options = [] + Initialize = None + Interact = None + // Everything this command writes is read back as suggestions, so a malformed call stays silent. + Execute = ExecuteAsync <| fun (input, output) -> + async { + match input with + | Input.Argument.Value "index" index & Input.Argument.ListValue "words" words -> + match index |> String.toInt with + | Some index -> + let! suggestions = + { Words = words; Index = index } + |> Suggestions.resolve commands applicationOptions + + suggestions |> List.iter (formatSuggestion >> output.Message) + + return ExitCode.Success + | None -> return ExitCode.Error + | _ -> return ExitCode.Error + } + } + <@> ConsoleApplicationError.CommandDefinitionError + + /// Returns the commands available for dispatch (including the hidden resolver) and the ones shown by list/help. + let wire + (userCommandNames: string list) + (applicationOptions: OptionsDefinitions) + (config: CompletionConfig) + (commands: Commands) + : Result = + result { + let! config = validateConfig userCommandNames config + + let! script = scriptCommand config + let withScript = commands |> Map.add config.CommandName script + + // The resolver suggests the script command too, but never itself. + let! resolver = resolverCommand withScript applicationOptions + + let dispatch = withScript |> Map.add config.ResolverName resolver + let discovery = if config.IsVisible then withScript else commands + + return dispatch, discovery + } diff --git a/src/Completion/Shell.fs b/src/Completion/Shell.fs new file mode 100644 index 0000000..2b54f66 --- /dev/null +++ b/src/Completion/Shell.fs @@ -0,0 +1,33 @@ +namespace Feather.ConsoleApplication.Completion + +[] +type internal Shell = + | Bash + | Zsh + | Fish + +[] +type internal ShellError = + | UnknownShell of string + +[] +module internal Shell = + let all = [ Shell.Bash; Shell.Zsh; Shell.Fish ] + + let value = function + | Shell.Bash -> "bash" + | Shell.Zsh -> "zsh" + | Shell.Fish -> "fish" + + let names = all |> List.map value + + let create (name: string): Result = + match all |> List.tryFind (fun shell -> shell |> value = name.ToLowerInvariant()) with + | Some shell -> Ok shell + | None -> Error (ShellError.UnknownShell name) + +[] +module internal ShellError = + let format = function + | ShellError.UnknownShell name -> + sprintf "Unknown shell \"%s\", expected one of %s." name (Shell.names |> String.concat "|") diff --git a/src/Completion/ShellScript.fs b/src/Completion/ShellScript.fs new file mode 100644 index 0000000..79e6290 --- /dev/null +++ b/src/Completion/ShellScript.fs @@ -0,0 +1,138 @@ +namespace Feather.ConsoleApplication.Completion + +/// Generates the script a user sources to hook the application's resolver into their shell. +[] +module internal ShellScript = + open System + + type private ScriptParts = { + ExecutableName: string + ScriptInvocation: string + ResolverInvocation: string + FunctionName: string + } + + /// Shell function names allow no dashes, dots or spaces, all of which an application name may contain. + let private functionName (executableName: string) = + let sanitized = + executableName + |> Seq.map (fun c -> if Char.IsLetterOrDigit c || c = '_' then c else '_') + |> Seq.toArray + |> String + + match sanitized with + | "" -> "_completion" + | name when name[0] |> Char.IsDigit -> sprintf "_%s_completion" name + | name -> sprintf "%s_completion" name + + // The suggestions are shell-agnostic, so each script filters and escapes them the way its shell inserts them. + + let private bashScript (parts: ScriptParts) = + $$$"""# Bash completion script for {{{parts.ExecutableName}}} +# Source this file in your .bashrc or .bash_profile: +# source <({{{parts.ScriptInvocation}}} bash) + +_{{{parts.FunctionName}}}() { + local index suggestion quoted + local -a completionWords suggestions + + completionWords=("${COMP_WORDS[@]}") + index=$COMP_CWORD + + # Readline inserts into the quotes it already knows about, so only an unquoted word is escaped. + quoted=0 + case "${COMP_WORDS[COMP_CWORD]}" in + \"*|\'*) quoted=1 ;; + esac + + # COMP_WORDS keeps the word as typed, $2 is the same word with the quoting already removed. + if [ "${BASH_VERSINFO[0]}" -ge 4 ]; then + completionWords[index]="$2" + fi + + # Readline shows no descriptions, so everything after the tab is dropped. + suggestions=() + while IFS= read -r suggestion; do + suggestion="${suggestion%%$'\t'*}" + [ -n "$suggestion" ] && suggestions+=("$suggestion") + done < <({{{parts.ResolverInvocation}}} "$index" -- "${completionWords[@]}" 2>/dev/null) + + COMPREPLY=() + while IFS= read -r suggestion; do + if [ "$quoted" -eq 1 ]; then + COMPREPLY+=("$suggestion") + else + COMPREPLY+=("$(printf '%q' "$suggestion")") + fi + done < <(IFS=$'\n'; compgen -W "${suggestions[*]}" -- "$2") +} +complete -F _{{{parts.FunctionName}}} {{{parts.ExecutableName}}}""" + + let private zshScript (parts: ScriptParts) = + $$$"""#compdef {{{parts.ExecutableName}}} +# Zsh completion script for {{{parts.ExecutableName}}} +# Source this file in your .zshrc: +# source <({{{parts.ScriptInvocation}}} zsh) + +_{{{parts.FunctionName}}}() { + local -a completionWords suggestions described + local suggestion value description + + # A quote left open by the cursor stays in `words`, while `PREFIX` is the word as typed without it. + completionWords=("${(@Q)words[1,CURRENT-1]}" "$PREFIX") + + suggestions=(${(f)"$({{{parts.ResolverInvocation}}} $((CURRENT - 1)) -- "${completionWords[@]}" 2>/dev/null)"}) + suggestions=(${suggestions:#}) + + # _describe separates the value from its description by a colon, so a colon in a value is escaped. + described=() + for suggestion in $suggestions; do + value=${suggestion%%$'\t'*} + description=${suggestion#*$'\t'} + if [[ $description == $suggestion ]]; then + described+=(${value//:/\\:}) + else + described+=("${value//:/\\:}:$description") + fi + done + + # An assigned value is completed on its own, the `--option=` part is already on the line. + compset -P '-*=' + + _describe -t suggestions 'suggestion' described +} +compdef _{{{parts.FunctionName}}} {{{parts.ExecutableName}}}""" + + let private fishScript (parts: ScriptParts) = + $$$"""# Fish completion script for {{{parts.ExecutableName}}} +# Source this file in your config.fish: +# source ({{{parts.ScriptInvocation}}} fish | psub) + +function __{{{parts.FunctionName}}} + set -l completionWords (commandline --current-process --tokenize --cut-at-cursor) + set -l currentWord (commandline --current-token --cut-at-cursor --tokenize) + + # An assigned value is completed on its own, while fish replaces the whole token. + set -l assignedPrefix "" + if string match --quiet --regex -- '^-.*=' "$currentWord" + set assignedPrefix (string replace --regex -- '^(-[^=]*=).*$' '$1' "$currentWord") + end + + for suggestion in ({{{parts.ResolverInvocation}}} (count $completionWords) -- $completionWords $currentWord 2>/dev/null) + echo $assignedPrefix$suggestion + end +end +complete -c {{{parts.ExecutableName}}} -f -a '(__{{{parts.FunctionName}}})'""" + + let generate (shell: Shell) (executableName: string) (scriptCommandName: string) (resolverCommandName: string) = + let parts = { + ExecutableName = executableName + ScriptInvocation = sprintf "%s %s" executableName scriptCommandName + ResolverInvocation = sprintf "%s %s" executableName resolverCommandName + FunctionName = functionName executableName + } + + match shell with + | Shell.Bash -> bashScript parts + | Shell.Zsh -> zshScript parts + | Shell.Fish -> fishScript parts diff --git a/src/Completion/Suggestions.fs b/src/Completion/Suggestions.fs new file mode 100644 index 0000000..1f4aaee --- /dev/null +++ b/src/Completion/Suggestions.fs @@ -0,0 +1,154 @@ +namespace Feather.ConsoleApplication.Completion + +open Feather.ConsoleApplication +open Feather.ErrorHandling + +/// Resolves what the shell offers at the cursor. +[] +module internal Suggestions = + + let private runSuggestion context (filter: CompletionSuggestion list -> CompletionSuggestion list) suggestion : Async = + async { + // A user-supplied callback may throw; a completion round answers with nothing instead of failing. + try + match suggestion with + | Some (Suggest.SuggestSync f) -> return f context |> filter + | Some (Suggest.SuggestAsync f) -> return! f context |> Async.map filter + | None -> return [] + with _ -> + return [] + } + + let private byPrefix prefix = List.filter (CompletionSuggestion.value >> String.startsWith prefix) + + /// Every suggestion is a whole word, so a value completed inside a longer word carries what precedes it. + let private withPrefix prefix = + List.map (fun (suggestion: CompletionSuggestion) -> { suggestion with Value = prefix + suggestion.Value }) + + let private longOptionSuggestions (options: OptionsDefinitions): CompletionSuggestion list = + options + |> List.map (fun (option: Option) -> + "--" + (option |> Option.name |> OptionName.value) |> CompletionSuggestion.createDescribed option.Description) + + let private shortOptionSuggestions (options: OptionsDefinitions): CompletionSuggestion list = + options + |> Definitions.shortcutVariants + |> List.map (fun (variant, option) -> "-" + variant |> CompletionSuggestion.createDescribed option.Description) + + let private commandNameSuggestions prefix (commands: Commands) = + commands + |> Map.toList + |> List.map (fun (name, command) -> + name |> CommandName.value |> CompletionSuggestion.createDescribed (command |> Command.description)) + |> byPrefix prefix + + /// Counts the values already given for positional arguments, so that the next one can be suggested. + /// A value belonging to an option is not a positional one. + [] + let rec private countPositionalValues options tokens count = + match tokens with + | [] -> count + | token :: rest -> + match token |> Definitions.classifyToken options with + | Definitions.TokenRole.EndOfOptions -> count + (rest |> List.length) + | Definitions.TokenRole.ValueExpectingOption _ -> + match rest with + | [] -> count + | _ :: afterValue -> countPositionalValues options afterValue count + | Definitions.TokenRole.InlineValueOption + | Definitions.TokenRole.FlagOption -> countPositionalValues options rest count + | Definitions.TokenRole.Positional -> countPositionalValues options rest (count + 1) + + /// Completes a short token as a cluster of shortcuts (`-abc`), whose last shortcut may carry + /// its value in the same token (`-oValue`). + let private shortcutSuggestions (currentWord: string) context (options: OptionsDefinitions) = + let typedLetters = currentWord.TrimStart '-' + + if typedLetters |> String.isNullOrEmpty then + async { return options |> shortOptionSuggestions } + else + match options |> Definitions.resolveShortcutCluster currentWord with + | Definitions.UndefinedShortcut -> async { return [] } + | Definitions.ValueLessShortcuts -> + async { + return + options + |> Definitions.shortcutVariants + // A cluster is parsed one letter at a time, so only a single-letter shortcut can extend it. + |> List.filter (fun (letter, _) -> letter.Length = 1 && not (typedLetters.Contains letter)) + |> List.map (fun (letter, option) -> + currentWord + letter |> CompletionSuggestion.createDescribed option.Description) + } + | Definitions.ShortcutWithValue (option, typedValue) -> + let clusterPrefix = currentWord.Substring(0, currentWord.Length - typedValue.Length) + + option + |> Option.suggestion + |> runSuggestion { context with CurrentWord = typedValue } (byPrefix typedValue) + |> Async.map (withPrefix clusterPrefix) + + let private suggestArgumentValue (command: Command) context filter argumentIndex : Async = + match command |> Command.definitions |> snd |> List.tryItem argumentIndex with + | Some argument -> argument |> Argument.suggestion |> runSuggestion context filter + | None -> async { return [] } + + let resolve + (commands: Commands) + (applicationOptions: OptionsDefinitions) + (completionInput: CompletionInput) + : Async = + async { + let context = Words.normalize completionInput.Words completionInput.Index + let { CurrentWord = currentWord; PrecedingWords = precedingWords } = context + + match precedingWords with + | [] + | [ _ ] -> + return commands |> commandNameSuggestions currentWord + + | _ :: commandNameValue :: _ -> + match commands |> Definitions.findCommand commandNameValue with + | None -> return [] + | Some command -> + let allOptions = applicationOptions @ (command |> Command.definitions |> fst) + let argumentTokens = precedingWords |> List.skip 2 + let optionsEnded = argumentTokens |> List.contains Definitions.EndOfOptions + + if not optionsEnded && currentWord |> Definitions.isOptionLike then + match currentWord |> Words.splitAssignment with + | Some (optionToken, typedValue) -> + match allOptions |> Definitions.findOption optionToken with + | Some option when option |> Definitions.optionRequiresValue -> + // The `=` breaks the word in every shell, so only what follows it is replaced. + return! + option + |> Option.suggestion + |> runSuggestion { context with CurrentWord = typedValue } (byPrefix typedValue) + | _ -> return [] + | None -> + if currentWord |> String.startsWith "--" then + return + allOptions + |> longOptionSuggestions + |> byPrefix currentWord + else + return! allOptions |> shortcutSuggestions currentWord context + else + let previousOption = + if optionsEnded then None + else + precedingWords + |> List.tryLast + |> Option.bind (fun token -> + match token |> Definitions.classifyToken allOptions with + | Definitions.TokenRole.ValueExpectingOption option -> Some option + | _ -> None) + + match previousOption with + | Some option -> + return! option |> Option.suggestion |> runSuggestion context (byPrefix currentWord) + | None -> + let argumentIndex = countPositionalValues allOptions argumentTokens 0 + + return! argumentIndex |> suggestArgumentValue command context (byPrefix currentWord) + } diff --git a/src/Completion/Words.fs b/src/Completion/Words.fs new file mode 100644 index 0000000..7da0875 --- /dev/null +++ b/src/Completion/Words.fs @@ -0,0 +1,62 @@ +namespace Feather.ConsoleApplication.Completion + +open Feather.ConsoleApplication + +type internal CompletionInput = { + /// Words the shell tokenized, including the executable name. + Words: string list + /// Index into `Words` of the word being completed. + Index: int +} + +/// Turns the words a shell hands over into the words a completion is resolved against: bash +/// breaks a word at `=`, and every shell leaves its own quoting in the words it passes. +[] +module internal Words = + open System + + /// Splits `--name=value` into the option token and the value typed after the `=`. + let splitAssignment (token: string) = + match token.IndexOf '=' with + | -1 -> None + | index -> Some (token.Substring(0, index), token.Substring(index + 1)) + + [] + let rec private rejoinAssignments accumulated words = + match words with + | [] -> accumulated |> List.rev + | option :: "=" :: value :: rest -> rest |> rejoinAssignments (option + "=" + value :: accumulated) + | [ option; "=" ] -> [] |> rejoinAssignments (option + "=" :: accumulated) + | word :: rest -> rest |> rejoinAssignments (word :: accumulated) + + let private unquote (word: string) = + if word.Length >= 2 && (word[0] = '"' || word[0] = '\'') && word[word.Length - 1] = word[0] + then word.Substring(1, word.Length - 2) + else word + + [] + let rec private unescapeChars accumulated characters = + match characters with + | [] + | [ '\\' ] -> accumulated |> List.rev |> List.toArray |> String + | '\\' :: escaped :: rest -> rest |> unescapeChars (escaped :: accumulated) + | character :: rest -> rest |> unescapeChars (character :: accumulated) + + let private unescape (word: string) = + word |> List.ofSeq |> unescapeChars [] + + /// The word at the index is the one being completed; what follows the cursor is not part of it. + let normalize (words: string list) (index: int) : CompletionContext = + let index = index |> max 0 + + let upToCursor = + (words |> List.truncate index) @ [ words |> List.tryItem index |> Option.defaultValue "" ] + |> rejoinAssignments [] + |> List.map (unquote >> unescape) + + match upToCursor |> List.rev with + | currentWord :: reversedPrecedingWords -> { + CurrentWord = currentWord + PrecedingWords = reversedPrecedingWords |> List.rev + } + | [] -> { CurrentWord = ""; PrecedingWords = [] } diff --git a/src/ConsoleApplication.fs b/src/ConsoleApplication.fs index e4a000f..b747687 100644 --- a/src/ConsoleApplication.fs +++ b/src/ConsoleApplication.fs @@ -51,14 +51,14 @@ module MFConsoleApplication = /// Map error by appending a current command. let private () result (currentCommand: CurrentCommand) = - result <@> fun __ -> (__, currentCommand) + result <@> fun e -> (e, currentCommand) let private (<*!!*>) xResult (currentCommand: CurrentCommand) = - xResult |> AsyncResult.mapError (fun __ -> (__, currentCommand)) + xResult |> AsyncResult.mapError (fun e -> (e, currentCommand)) /// Map error with appended current command. let private () result f = - result <@> fun (error, (__: CurrentCommand)) -> (error |> f, __) + result <@> fun (error, (currentCommand: CurrentCommand)) -> (error |> f, currentCommand) type private Args = InputValue [] @@ -179,16 +179,25 @@ module MFConsoleApplication = return ExitCode.Success | args -> - parts |> showApplicationInfo - let! (input, unfilledArguments) = args |> Args.parse output parts.ApplicationOptions parts.Commands ConsoleApplicationError.ArgsError let commandName = input |> Input.getCommandName - let command = parts.Commands.[commandName] + let command = parts.Commands[commandName] let currentCommand: CurrentCommand = Some (commandName, command) + match command |> Command.kind with + | CommandKind.System -> () + | CommandKind.User -> parts |> showApplicationInfo + + let prepareInput = + match command |> Command.kind with + | CommandKind.System -> id + | CommandKind.User -> + (command.Initialize id) + >> Interact.map parts.Ask (command.Interact Interact.id) + //debug <| sprintf "Input:\n%A" input // todo - show input as table(s) -> // - same as `dumpInput` function in Example @@ -197,10 +206,7 @@ module MFConsoleApplication = // this could be done after `debug` is set for application directly, with -vvvv try - let (input, _) = - (input, output) - |> (command.Initialize id) - |> Interact.map parts.Ask (command.Interact Interact.id) + let (input, _) = (input, output) |> prepareInput let! input = input diff --git a/src/Input.fs b/src/Input.fs index 65b7723..98f18a5 100644 --- a/src/Input.fs +++ b/src/Input.fs @@ -34,6 +34,7 @@ module Input = OptionDefinitions = [] } + [] let rec internal parse output allArgumentDefinitions definitionsToParse (input: ParsedInput) (args: InputValue list) = let (optionDefinitions: OptionsDefinitions, argumentDefinitions: ArgumentsDefinitions) = definitionsToParse let debug = debug output @@ -213,11 +214,11 @@ module Input = | OptionValueDefinition.ValueIsArray _ -> OptionValue.ValueIsArray [value] | OptionValueDefinition.ValueRequiredArray _ -> match value with - | String.IsNullOrEmpty -> failwithf "The \"%s\" option does not accept an empty value." option + | String.IsNullOrEmpty -> failwithf "The \"%s\" option does not accept an empty value in a list." option | value -> OptionValue.ValueRequiredArray [value] { input with Options = input.Options.Add(option, value) } - | _ -> failwithf "The \"--%s\" option does not exists." option + | _ -> failwithf "The \"--%s\" option does not exists, a value cannot be set." option /// Set a list value for an option with array value or fail with exception when option is not defined. /// You can set only a list value, if you want to set a single value for option, use `Input.setOptionValue` instead. @@ -226,7 +227,7 @@ module Input = | OptionsDefinitions.HasDefinedOption option definition -> let value = match definition.Value with - | OptionValueDefinition.ValueNone -> failwithf "The \"%s\" option does not accept any value." option + | OptionValueDefinition.ValueNone -> failwithf "The \"%s\" option does not accept a list of values." option | OptionValueDefinition.ValueIsArray _ -> OptionValue.ValueIsArray values | OptionValueDefinition.ValueRequiredArray _ -> match values with @@ -236,7 +237,7 @@ module Input = | OptionValueDefinition.ValueOptional _ -> failwithf "The \"%s\" option does not accept a list value. Use `Input.setOptionValue` instead." option { input with Options = input.Options.Add(option, value) } - | _ -> failwithf "The \"--%s\" option does not exists." option + | _ -> failwithf "The \"--%s\" option does not exists, a list value cannot be set." option [] @@ -336,11 +337,11 @@ module Input = | ArgumentValueDefinition.Array _ -> ArgumentValue.Array [value] | ArgumentValueDefinition.RequiredArray -> match value with - | String.IsNullOrEmpty -> failwithf "The \"%s\" argument does not accept an empty value." argument + | String.IsNullOrEmpty -> failwithf "The \"%s\" argument does not accept an empty value in a list." argument | value -> ArgumentValue.RequiredArray (NotEmptyList.ofListWithValues [value]) { input with Arguments = input.Arguments.Add(argument, value) } - | _ -> failwithf "The \"%s\" argument does not exists." argument + | _ -> failwithf "The \"%s\" argument does not exists, a value cannot be set." argument /// Set a list value for an array argument or fail with exception when argument is not defined. /// You can set only a list value, if you want to set a single value for argument, use `Input.setArgumentValue` instead. @@ -358,7 +359,7 @@ module Input = | ArgumentValueDefinition.Optional _ -> failwithf "The \"%s\" argument does not accept a list value. Use `Input.setArgumentValue` instead." argument { input with Arguments = input.Arguments.Add(argument, value) } - | _ -> failwithf "The \"%s\" argument does not exists." argument + | _ -> failwithf "The \"%s\" argument does not exists, a list value cannot be set." argument let internal getCommandName input = input diff --git a/src/Options.fs b/src/Options.fs index 63b5fcf..d0058fe 100644 --- a/src/Options.fs +++ b/src/Options.fs @@ -60,6 +60,9 @@ module internal OptionShortcut = let value (OptionShortcut shortcut) = shortcut + /// A shortcut definition may hold several `|`-separated variants (`v|vv|vvv`). + let variants (OptionShortcut shortcut) = shortcut.Split '|' |> Seq.toList + [] type OptionValue = | ValueNone @@ -135,6 +138,7 @@ type Option = private { Shortcut: OptionShortcut option Description: string Value: OptionValueDefinition + Suggest: Suggest option } type RawOptionDefinition = internal { @@ -142,6 +146,7 @@ type RawOptionDefinition = internal { Shortcut: OptionShortcut option Description: string Value: OptionValueDefinition + Suggest: Suggest option } [] @@ -161,6 +166,7 @@ module internal RawOptionDefinition = Shortcut = shortcut Description = description Value = value + Suggest = None } } @@ -170,7 +176,7 @@ module internal RawOptionDefinition = [] module Option = // - // Public create functions for RawArgumentDefinition + // Public create functions for RawOptionDefinition // let create = RawOptionDefinition.create @@ -194,12 +200,21 @@ module Option = let requiredArray name shortcut description defaultValues = create name shortcut description (OptionValueDefinition.ValueRequiredArray defaultValues) + // + // Completion helper + // + + /// Attach completion suggestions to an option definition. + let suggest (suggestion: Suggest) (def: Result): Result = + def |> Result.map (fun d -> { d with Suggest = Some suggestion }) + // // Internal options functions // let internal name ({ Name = name }: Option) = name let internal nameValue = name >> OptionName.value let internal shortcut ({ Shortcut = shortcut }: Option) = shortcut + let internal suggestion ({ Suggest = suggest }: Option) = suggest let internal createApplicationOption name shortcut description value: Option = { @@ -207,6 +222,7 @@ module Option = Shortcut = Some (OptionShortcut shortcut) Description = description Value = value + Suggest = None } let internal createApplicationOptionWithoutShortcut name description value: Option = @@ -215,6 +231,7 @@ module Option = Shortcut = None Description = description Value = value + Suggest = None } let internal isOption (value: InputValue) = @@ -240,7 +257,7 @@ module Option = let internal isMatchingShortcut (value: InputValue) (shortcut: OptionShortcut option) = if value |> isShortcut then match shortcut with - | Some (OptionShortcut shortcut) -> shortcut.Split '|' |> Seq.contains (value.TrimStart '-') + | Some shortcut -> shortcut |> OptionShortcut.variants |> List.contains (value.TrimStart '-') | None -> false else false @@ -350,6 +367,7 @@ module internal OptionsDefinitions = Shortcut = option.Shortcut Description = option.Description Value = option.Value + Suggest = option.Suggest } let validate (options: RawOptionDefinition list) = @@ -521,6 +539,7 @@ module internal Options = RestOfArgs = rawArgs } + [] let rec parseShortcut optionDefinitions (parsed: Options) (rawArgs: InputValue list) = function | [] -> Ok (parsed, rawArgs) | letter :: rest -> @@ -540,6 +559,7 @@ module internal Options = | Some defaultValue -> options.Add(optionName |> OptionName.value, optionValue defaultValue) | _ -> options + [] let rec prepareOptionsDefaults (options: Options) = function | [] -> options | (definition: Option) :: definitions -> diff --git a/src/Render.fs b/src/Render.fs index f7801a0..f60da1a 100644 --- a/src/Render.fs +++ b/src/Render.fs @@ -30,9 +30,22 @@ module internal Render = let baseDir = AppDomain.CurrentDomain.BaseDirectory let executableFileName = AppDomain.CurrentDomain.FriendlyName - let currentDir = Environment.CurrentDirectory - let relativePath = baseDir.Replace(currentDir, "").TrimStart '/' + let relativePath = + let trimmedBaseDir = baseDir.TrimEnd '/' + let pathSegments = trimmedBaseDir.Split '/' + let executableSegmentIndex = + pathSegments + |> Array.tryFindIndexBack ((=) executableFileName) + + match executableSegmentIndex with + | Some index when index + 1 < pathSegments.Length -> + pathSegments[(index + 1) ..] + |> String.concat "/" + |> String.append "/" + | _ -> + baseDir.Replace(Environment.CurrentDirectory, "").TrimStart '/' + let commandName = commandName |> CommandName.value [ diff --git a/src/Suggest.fs b/src/Suggest.fs new file mode 100644 index 0000000..0c45a9f --- /dev/null +++ b/src/Suggest.fs @@ -0,0 +1,225 @@ +namespace Feather.ConsoleApplication + +open Feather.ErrorHandling + +type CompletionSuggestion = { + Value: string + /// Shown next to the value by the shells able to display it. + Description: string option +} + +[] +module CompletionSuggestion = + let create value = { Value = value; Description = None } + + /// An empty description is the same as none, so nothing is shown for it. + let createDescribed description value = { + Value = value + Description = if description |> String.isNullOrEmpty then None else Some description + } + + let value (suggestion: CompletionSuggestion) = suggestion.Value + + let description (suggestion: CompletionSuggestion) = suggestion.Description + +type CompletionContext = { + /// Token being typed at the cursor, empty when the cursor starts a new one. + CurrentWord: string + /// Tokens on the line before the current word, including the executable name. + PrecedingWords: string list +} + +/// Provides value suggestions for an option or a positional argument. +[] +type Suggest = + | SuggestSync of (CompletionContext -> CompletionSuggestion list) + | SuggestAsync of (CompletionContext -> Async) + +[] +module Suggest = + open System.IO + + type FileSystemListers = { + DirectoryExists: string -> bool + FileExists: string -> bool + EnumerateFileSystemEntries: string -> seq + EnumerateDirectories: string -> seq + } + + let fileSystemListers: FileSystemListers = { + DirectoryExists = Directory.Exists + FileExists = File.Exists + EnumerateFileSystemEntries = Directory.EnumerateFileSystemEntries + EnumerateDirectories = Directory.EnumerateDirectories + } + + let private completionPathParts (currentWord: string) = + let dirPath = + if String.isNullOrEmpty currentWord then + "." + else + let dir = Path.GetDirectoryName currentWord + if String.isNullOrEmpty dir then "." else dir + + let baseName = Path.GetFileName currentWord + dirPath, baseName + + let private includeByDotfileRule (baseName: string) (name: string) = + if name |> String.startsWith "." then + baseName |> String.startsWith "." + else + not (baseName |> String.startsWith ".") + + let private prefixedName dirPath name = + if dirPath = "." then + name + else + Path.Combine(dirPath, name) + + let private matchesBaseName (baseName: string) (name: string) = + name |> String.startsWith baseName + + let private isVisibleAndMatchingName baseName name = + includeByDotfileRule baseName name + && matchesBaseName baseName name + + let private tryListNames (listers: FileSystemListers) (enumeratePath: string -> seq) (dirPath: string) = + try + if listers.DirectoryExists dirPath then + enumeratePath dirPath + |> Seq.toList + |> List.map (fun path -> Path.GetFileName(path)) + else + [] + with _ -> + [] + + let private matchingNames listers enumeratePath currentWord = + let dirPath, baseName = completionPathParts currentWord + + let names = + tryListNames listers enumeratePath dirPath + |> List.filter (isVisibleAndMatchingName baseName) + + dirPath, names + + let private asAsync (suggest: Suggest): CompletionContext -> Async = + match suggest with + | Suggest.SuggestSync callback -> callback >> async.Return + | Suggest.SuggestAsync callback -> callback + + let private withValue value (suggestion: CompletionSuggestion) = + { suggestion with Value = value } + + /// A completion round must stay snappy, so per-value callbacks are not fanned out without a bound. + [] + let private MaxConcurrentValues = 8 + + let private mapSuggestions (f: CompletionSuggestion list -> CompletionSuggestion list) = function + | Suggest.SuggestSync callback -> Suggest.SuggestSync (callback >> f) + | Suggest.SuggestAsync callback -> Suggest.SuggestAsync (callback >> Async.map f) + + let private chooseBounded (f: CompletionSuggestion -> Async) (suggest: Suggest): Suggest = + Suggest.SuggestAsync (fun ctx -> + asAsync suggest ctx + |> Async.bind (fun suggestions -> + Async.Parallel(suggestions |> List.map f, MaxConcurrentValues) + |> Async.map (Array.toList >> List.choose id) + ) + ) + + let values (values: string list): Suggest = + Suggest.SuggestSync (fun _ -> values |> List.map CompletionSuggestion.create) + + /// Values paired with the description shown next to them. + let describedValues (values: (string * string) list): Suggest = + Suggest.SuggestSync (fun _ -> + values |> List.map (fun (value, description) -> value |> CompletionSuggestion.createDescribed description) + ) + + let map (f: string -> string): Suggest -> Suggest = + mapSuggestions (List.map (fun suggestion -> suggestion |> withValue (f suggestion.Value))) + + let mapAsync (f: string -> Async): Suggest -> Suggest = + chooseBounded (fun suggestion -> + f suggestion.Value |> Async.map (fun value -> Some (suggestion |> withValue value))) + + let filter (predicate: string -> bool): Suggest -> Suggest = + mapSuggestions (List.filter (CompletionSuggestion.value >> predicate)) + + let filterAsync (predicate: string -> Async): Suggest -> Suggest = + chooseBounded (fun suggestion -> + predicate suggestion.Value |> Async.map (fun isValid -> if isValid then Some suggestion else None)) + + let internal filesWith (listers: FileSystemListers): Suggest = + Suggest.SuggestSync (fun ctx -> + let dirPath, names = matchingNames listers listers.EnumerateFileSystemEntries ctx.CurrentWord + + names + |> List.map (fun name -> + let fullPath = Path.Combine(dirPath, name) + let withPrefix = prefixedName dirPath name + + if listers.DirectoryExists fullPath then + withPrefix + "/" + else + withPrefix + |> CompletionSuggestion.create + ) + ) + + /// Files and directories under the current word, directories with a trailing slash. + /// Dot-prefixed entries are suggested only when the current word starts with a dot. + let files: Suggest = + filesWith fileSystemListers + + let internal directoriesWith (listers: FileSystemListers): Suggest = + Suggest.SuggestSync (fun ctx -> + let dirPath, names = matchingNames listers listers.EnumerateDirectories ctx.CurrentWord + + names + |> List.map (fun name -> + let withPrefix = prefixedName dirPath name + withPrefix + "/" |> CompletionSuggestion.create + ) + ) + + /// Directories under the current word, each with a trailing slash. + /// Dot-prefixed directories are suggested only when the current word starts with a dot. + let directories: Suggest = + directoriesWith fileSystemListers + + let internal filesWithExtensionWith (listers: FileSystemListers) (extensions: string list): Suggest = + let normalizedExts = extensions |> List.map (fun e -> if e |> String.startsWith "." then e else "." + e) + + Suggest.SuggestSync (fun ctx -> + let dirPath, names = matchingNames listers listers.EnumerateFileSystemEntries ctx.CurrentWord + + names + |> List.choose (fun name -> + let fullPath = Path.Combine(dirPath, name) + if listers.DirectoryExists fullPath then + Some (prefixedName dirPath name + "/" |> CompletionSuggestion.create) + elif listers.FileExists fullPath then + let ext = Path.GetExtension name + if normalizedExts |> List.contains ext then + Some (prefixedName dirPath name |> CompletionSuggestion.create) + else + None + else + None + ) + ) + + /// Files with one of the given extensions (given with or without the leading dot), + /// plus all directories, so nested paths stay reachable. + let filesWithExtension (extensions: string list): Suggest = + filesWithExtensionWith fileSystemListers extensions + + // Constructors are declared last, so that `async` does not shadow the builder for the rest of the module. + + let sync (f: CompletionContext -> string list): Suggest = + Suggest.SuggestSync (f >> List.map CompletionSuggestion.create) + + let async (f: CompletionContext -> Async): Suggest = + Suggest.SuggestAsync (f >> Async.map (List.map CompletionSuggestion.create)) diff --git a/src/Types.fs b/src/Types.fs index 4428e9a..c5b3766 100644 --- a/src/Types.fs +++ b/src/Types.fs @@ -464,20 +464,37 @@ type ConsoleApplicationError = [] module internal ConsoleApplicationError = - let rec format showDetails = function + // Worklist recursion keeps the traversal tail-recursive, which the lint gate requires of every `rec`. + [] + let rec private formatPending showDetails pending acc = + match pending with + | [] -> List.rev acc + | current :: rest -> + match current with + | CommandError.Exception ex -> + let message = + if showDetails then + sprintf "%A" ex + else + ex.Message + + formatPending showDetails rest (message :: acc) + | CommandError.Message message -> + formatPending showDetails rest (message :: acc) + | CommandError.Errors errors -> + formatPending showDetails (errors @ rest) acc + + let private formatCommandError showDetails (error: CommandError) = + formatPending showDetails [ error ] [] + + let format showDetails = function | ConsoleApplicationError.ArgsError error -> [ ArgsError.format error ] | ConsoleApplicationError.CommandNameError error -> [ CommandNameError.format error ] | ConsoleApplicationError.ApplicationNameError error -> [ ApplicationNameError.format error ] | ConsoleApplicationError.CommandDefinitionError error -> CommandDefinitionError.format error - | ConsoleApplicationError.ConsoleApplicationException error - | ConsoleApplicationError.CommandError (CommandError.Exception error) -> - [ - if showDetails then - sprintf "%A" error - else - error.Message - ] - | ConsoleApplicationError.CommandError (CommandError.Message error) -> [ error ] - | ConsoleApplicationError.CommandError (CommandError.Errors errors) -> - errors - |> List.collect (ConsoleApplicationError.CommandError >> format showDetails) + | ConsoleApplicationError.ConsoleApplicationException error -> + CommandError.Exception error + |> formatCommandError showDetails + | ConsoleApplicationError.CommandError error -> + error + |> formatCommandError showDetails diff --git a/src/Utils.fs b/src/Utils.fs index a60dfb1..1beaddd 100644 --- a/src/Utils.fs +++ b/src/Utils.fs @@ -34,6 +34,9 @@ module internal String = let toUpper (string: string) = string.ToUpper() + let startsWith (prefix: string) (string: string) = + string.StartsWith(prefix, StringComparison.Ordinal) + let toInt (string: string) = match string |> Int32.TryParse with | true, int -> Some int diff --git a/tests/ArgsTests.fs b/tests/ArgsTests.fs index 7cba454..1b6fcb9 100644 --- a/tests/ArgsTests.fs +++ b/tests/ArgsTests.fs @@ -26,9 +26,6 @@ let expect options arguments = let provideArgs = seq { let messageFromInteraction = "message", OptionValue.ValueOptional (Some "from-interaction") - // - // cases without separator -- - // yield { Description = "No arguments and empty options with interaction" Command = "one" @@ -198,9 +195,6 @@ let provideArgs = seq { ] } - // - // cases with separator -- - // yield { Description = "Argument and empty options with interaction, with separator" Command = "one" @@ -479,9 +473,6 @@ let provideArgs = seq { |> ExpectedError } - // - // Cases for using multi shortcuts and other options combinations - // yield { Description = "Simple option value with `=`" Command = "six" @@ -619,11 +610,6 @@ let provideArgs = seq { [ "arg", ArgumentValue.Optional None ] } - // - // Cases for default options - // - - // Cases with no-interaction yield { Description = "No arguments and empty options with no-interaction shortuct" Command = "one" @@ -649,7 +635,6 @@ let provideArgs = seq { ] } - // cases for version/verbosity yield { Description = "Match version by shortcut - and do not run execute" Command = "one" @@ -712,7 +697,6 @@ let provideArgs = seq { ] } - // Cases for a common scenarious yield { Description = "Use command 7 without any input" Command = "seven" diff --git a/tests/CompletionResolveTests.fs b/tests/CompletionResolveTests.fs new file mode 100644 index 0000000..568ede0 --- /dev/null +++ b/tests/CompletionResolveTests.fs @@ -0,0 +1,418 @@ +module Feather.ConsoleApplication.Tests.CompletionResolve + +open Expecto +open Feather.ConsoleApplication +open Feather.ConsoleApplication.Completion +open Feather.ConsoleApplication.Tests.Commands +open Feather.ErrorHandling + +let private commandNameOrFail name = + CommandName.createInRuntime name |> Result.orFail + +let private commandsOrFail definitions = + definitions + |> List.map (fun (name, definition) -> commandNameOrFail name, CommandDefinition.validate definition |> Result.orFail) + |> Map.ofList +let private noApplicationOptions: OptionsDefinitions = [] +let private resolveSuggestions applicationOptions commands words index = + { Words = words; Index = index } + |> Completion.Suggestions.resolve commands applicationOptions + |> Async.RunSynchronously + |> List.map CompletionSuggestion.value + |> List.sort + +let private resolveDescribedSuggestions applicationOptions commands words index = + { Words = words; Index = index } + |> Completion.Suggestions.resolve commands applicationOptions + |> Async.RunSynchronously + |> List.map (fun suggestion -> suggestion.Value, suggestion.Description) + |> List.sortBy fst + +[] +let completionResolveTests = + testList "Completion.Suggestions.resolve" [ + testList "command names" [ + testCase "should suggest every command when the line is empty" <| fun _ -> + let commands = + commandsOrFail [ + "foo", commandOne ignore + "bar", commandTwo ignore + "baz", commandThree ignore + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "" ] 0 + + Expect.equal suggestions [ "bar"; "baz"; "foo" ] "Every command name should be suggested" + + testCase "should suggest only commands with the typed prefix when a partial name is typed" <| fun _ -> + let commands = + commandsOrFail [ + "foo", commandOne ignore + "foobar", commandTwo ignore + "bar", commandThree ignore + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "fo" ] 1 + + Expect.equal suggestions [ "foo"; "foobar" ] "Only commands starting with the typed prefix should be suggested" + ] + + testList "option values" [ + testCase "should suggest every callback value when the cursor follows an option expecting a value" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith [] [ + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "val1"; "val2"; "other" ]) + ] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "" ] 3 + + Expect.equal suggestions [ "other"; "val1"; "val2" ] "Every value of the option callback should be suggested" + + testCase "should suggest only values with the typed prefix when part of a value is typed" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith [] [ + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "val1"; "val2"; "other" ]) + ] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "val" ] 3 + + Expect.equal suggestions [ "val1"; "val2" ] "Only values starting with the typed prefix should be suggested" + + testCase "should suggest the option callback values when the option is written as its shortcut" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith [] [ + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "shortval1"; "shortval2" ]) + ] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-o"; "" ] 3 + + Expect.equal suggestions [ "shortval1"; "shortval2" ] "Shortcut should resolve to the same option callback as the long name" + + testCase "should return no suggestions when the option has no suggestion callback" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith [] [ Option.required "opt1" (Some "o") "Option one" "" ] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "" ] 3 + + Expect.equal suggestions [] "Option without a callback should produce no suggestions" + + testCase "should suggest the values of the option when the index points past the last word" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1" ] 3 + + Expect.equal suggestions [ "val1"; "val2" ] "An index past the last word starts an empty word at the cursor" + ] + + testList "positional arguments" [ + testCase "should suggest every callback value when the cursor is at a positional argument" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith + [ + Argument.required "myArg" "Description" + |> Argument.suggest (Suggest.values [ "foo"; "bar"; "baz" ]) + ] + [] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "" ] 2 + + Expect.equal suggestions [ "bar"; "baz"; "foo" ] "Every value of the argument callback should be suggested" + + testCase "should suggest only values with the typed prefix when part of the argument is typed" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith + [ + Argument.required "myArg" "Description" + |> Argument.suggest (Suggest.values [ "foo"; "bar"; "baz" ]) + ] + [] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "b" ] 2 + + Expect.equal suggestions [ "bar"; "baz" ] "Only values starting with the typed prefix should be suggested" + + testCase "should return no suggestions when the argument has no suggestion callback" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith [ Argument.required "myArg" "Description" ] [] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "" ] 2 + + Expect.equal suggestions [] "Argument without a callback should produce no suggestions" + + testCase "should suggest the values of the first argument when an option with a value precedes it" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "val1"; "" ] 4 + + Expect.equal suggestions [ "alpha"; "beta" ] "The value of the option should not be counted as a positional argument" + + testCase "should suggest the values of the first argument when an assigned option precedes it" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1=val1"; "" ] 3 + + Expect.equal suggestions [ "alpha"; "beta" ] "An assigned option should not be counted as a positional argument" + + testCase "should return no suggestions when the argument callback throws" <| fun _ -> + let commands = + commandsOrFail [ + "test", commandWith + [ + Argument.required "myArg" "Description" + |> Argument.suggest (Suggest.sync (fun _ -> failwith "boom")) + ] + [] + ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "" ] 2 + + Expect.equal suggestions [] "A failing callback should produce no suggestions" + ] + + testList "assigned option values" [ + testCase "should suggest every callback value when the option is assigned with an empty value" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1=" ] 2 + + Expect.equal suggestions [ "val1"; "val2" ] "Every value of the option callback should be suggested without the assignment" + + testCase "should suggest only values with the typed prefix when part of an assigned value is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1=val2" ] 2 + + Expect.equal suggestions [ "val2" ] "Only values starting with the typed prefix should be suggested" + + testCase "should suggest the values of the assigned option when the shell split the word at the equals sign" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = + resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "="; "va" ] 4 + + Expect.equal suggestions [ "val1"; "val2" ] "The split parts should resolve as one assigned option word" + + testCase "should return no suggestions when an unknown option is assigned" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--unknown=" ] 2 + + Expect.equal suggestions [] "An unknown option should produce no suggestions" + ] + + testList "option names" [ + testCase "should suggest every long option name when only -- is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandSix ignore ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--" ] 2 + + Expect.equal suggestions [ "--bar"; "--cat"; "--foo" ] "Every long option name of the command should be suggested" + + testCase "should suggest only long option names with the typed prefix when a partial option is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandSix ignore ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--ba" ] 2 + + Expect.equal suggestions [ "--bar" ] "Only long option names starting with the typed prefix should be suggested" + + testCase "should suggest every short option name when only - is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandSix ignore ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-" ] 2 + + Expect.equal suggestions [ "-b"; "-c"; "-f" ] "Every short option name of the command should be suggested" + + testCase "should suggest the option names when a complete option name is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1" ] 2 + + Expect.equal suggestions [ "--opt1"; "--opt1-extra" ] "A typed option name should be completed by option names, not by its values" + + testCase "should suggest application options alongside command options when only -- is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandSix ignore ] + let applicationOptions = + [ Option.noValue "debug" (Some "d") "" |> Result.orFail ] + |> OptionsDefinitions.validate + |> Result.orFail + + let suggestions = resolveSuggestions applicationOptions commands [ "myapp"; "test"; "--" ] 2 + + Expect.contains suggestions "--debug" "Application option should be suggested" + Expect.contains suggestions "--foo" "Command option should be suggested" + ] + + testList "quoted words" [ + testCase "should suggest the values containing a space when the shell passed the current word unquoted" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSpacedSuggestions ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "my v" ] 2 + + Expect.equal suggestions [ "my value" ] "A word containing a space should be completed as a single word" + + testCase "should suggest the values of the first argument when a quoted option value contains a space" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = + resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1"; "\"my value\""; "" ] 4 + + Expect.equal suggestions [ "alpha"; "beta" ] "The quoted option value should be counted as a single word" + + testCase "should suggest the values of the first argument when the command name is quoted" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "\"test\""; "" ] 2 + + Expect.equal suggestions [ "alpha"; "beta" ] "The quotes around the command name should be stripped" + ] + + testList "descriptions" [ + testCase "should describe a command name with the description of the command" <| fun _ -> + let commands = commandsOrFail [ "test", commandWith [] [] ] + + let suggestions = resolveDescribedSuggestions noApplicationOptions commands [ "myapp"; "te" ] 1 + + Expect.equal suggestions [ "test", Some "Test command" ] "The description of the command should be suggested with its name" + + testCase "should describe a long option name with the description of the option" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveDescribedSuggestions noApplicationOptions commands [ "myapp"; "test"; "--opt1" ] 2 + + Expect.equal + suggestions + [ "--opt1", Some "Option one"; "--opt1-extra", Some "Option one extra" ] + "The description of the option should be suggested with its name" + + testCase "should describe a short option name with the description of the option" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveDescribedSuggestions noApplicationOptions commands [ "myapp"; "test"; "-" ] 2 + + Expect.equal + suggestions + [ "-f", Some "Flag foo"; "-l", Some "Flag loud"; "-o", Some "Option one" ] + "The description of the option should be suggested with its shortcut" + + testCase "should describe the added shortcut when a cluster is extended" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveDescribedSuggestions noApplicationOptions commands [ "myapp"; "test"; "-f" ] 2 + + Expect.equal + suggestions + [ "-fl", Some "Flag loud"; "-fo", Some "Option one" ] + "The shortcut added to the cluster should carry its own description" + + testCase "should describe no value suggested by a callback" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveDescribedSuggestions noApplicationOptions commands [ "myapp"; "test"; "" ] 2 + + Expect.equal suggestions [ "alpha", None; "beta", None ] "A value coming from a callback has no description" + ] + + testList "end of options" [ + testCase "should suggest the values of the first argument when the separator precedes the cursor" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--"; "" ] 3 + + Expect.equal suggestions [ "alpha"; "beta" ] "The separator itself should not be counted as a positional value" + + testCase "should return no option names when a word starting with dashes is typed after the separator" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithSuggestedInput ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--"; "--" ] 3 + + Expect.equal suggestions [] "After the separator a typed word is a positional value, not an option name" + + testCase "should suggest the values of the second argument when a value follows the separator" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithTwoSuggestedArguments ] + + let suggestions = + resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--"; "alpha"; "" ] 4 + + Expect.equal suggestions [ "one"; "two" ] "Only the value after the separator should be counted as a positional one" + + testCase "should suggest the values of the second argument when an option name follows the separator" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithTwoSuggestedArguments ] + + let suggestions = + resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "--"; "--opt1"; "" ] 4 + + Expect.equal suggestions [ "one"; "two" ] "After the separator an option name is a positional value, so it takes no value of its own" + ] + + testList "short option clusters" [ + testCase "should suggest the remaining shortcuts when a value-less shortcut is typed" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-f" ] 2 + + Expect.equal suggestions [ "-fl"; "-fo" ] "The typed shortcut should be extended by the shortcuts not used yet" + + testCase "should suggest the values of the clustered option when the cluster ends with an option expecting a value" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-fo"; "" ] 3 + + Expect.equal suggestions [ "val1"; "val2" ] "The last shortcut of the cluster should provide the values" + + testCase "should suggest the values inside the cluster when the value is typed right after the shortcut" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-fov" ] 2 + + Expect.equal suggestions [ "-foval1"; "-foval2" ] "The value typed in the cluster should be completed within the same word" + + testCase "should return no suggestions when the cluster contains an undefined shortcut" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-fx" ] 2 + + Expect.equal suggestions [] "An undefined shortcut should produce no suggestions" + + testCase "should extend the cluster only with single-letter shortcuts when an option has multi-letter shortcuts" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions Commands.applicationOptions commands [ "myapp"; "test"; "-v" ] 2 + + Expect.contains suggestions "-vf" "A single-letter command shortcut should extend the cluster" + Expect.isFalse + (suggestions |> List.exists (fun suggestion -> suggestion.Contains "vv")) + "A multi-letter shortcut should not extend the cluster" + + testCase "should suggest the values of the first argument when a value-less cluster precedes it" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-fl"; "" ] 3 + + Expect.equal suggestions [ "alpha"; "beta" ] "A cluster of value-less shortcuts should not shift the position of the argument" + + testCase "should suggest the values of the first argument when a cluster expecting a value and its value precede it" <| fun _ -> + let commands = commandsOrFail [ "test", commandWithClusteredShortcuts ] + + let suggestions = resolveSuggestions noApplicationOptions commands [ "myapp"; "test"; "-fo"; "val1"; "" ] 4 + + Expect.equal suggestions [ "alpha"; "beta" ] "The value of the clustered option should not be counted as a positional argument" + ] + ] + diff --git a/tests/CompletionSetupTests.fs b/tests/CompletionSetupTests.fs new file mode 100644 index 0000000..7f45bf7 --- /dev/null +++ b/tests/CompletionSetupTests.fs @@ -0,0 +1,412 @@ +module Feather.ConsoleApplication.Tests.CompletionSetup + +open Expecto +open Feather.ConsoleApplication +open Feather.ConsoleApplication.Completion +open Feather.ConsoleApplication.Tests.Commands +open Feather.ErrorHandling + + +let private runApplication buildApplication args = + use buffer = new Feather.ConsoleStyle.Output.BufferOutput(Feather.ConsoleStyle.Verbosity.Normal) + let console = Feather.ConsoleStyle.ConsoleStyle(buffer) + + let result = buildApplication console |> runResult args + + result, (buffer.Fetch() |> console.RemoveMarkup) + +let private runScriptApplication executableName shell = + runApplication + (fun console -> + consoleApplication { + name "Test app" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with ExecutableName = executableName } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "completion"; shell |] + +let private runCompletionApplication completionCommandName = + runApplication + (fun console -> + consoleApplication { + name "Test app" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with CommandName = completionCommandName } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "list" |] + +[] +let completionApplicationTests = + testList "ConsoleApplication - completion" [ + testList "enabled completion" [ + testCase "should list the completion command when completion is enabled" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "Test app" + version "1.0.0" + info ApplicationInfo.NameAndVersion + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "list" |] + + Expect.equal result (Ok ExitCode.Success) "List command should succeed" + Expect.stringContains output "completion" "Completion command should be listed" + + testCase "should not list the hidden resolver command when completion is enabled" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "Test app" + version "1.0.0" + info ApplicationInfo.NameAndVersion + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "list" |] + + Expect.equal result (Ok ExitCode.Success) "List command should succeed" + Expect.isFalse (output.Contains "__completion") "Hidden resolver command should never be listed" + + testCase "should print suggestions when the hidden resolver is invoked with an index and words" <| fun _ -> + let deployCommand = + commandWith [] [ + Option.required "env" (Some "e") "Environment" "" + |> Option.suggest (Suggest.values [ "dev"; "staging"; "prod" ]) + ] + + let result, output = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "testapp" + version "1.0.0" + info ApplicationInfo.NameAndVersion + enableCompletion + useOutput console + command "deploy" deployCommand + }) + [| "__completion"; "3"; "--"; "testapp"; "deploy"; "--env" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.stringContains output "dev" "Suggestions of the option callback should be printed" + Expect.stringContains output "staging" "Suggestions of the option callback should be printed" + Expect.stringContains output "prod" "Suggestions of the option callback should be printed" + + testCase "should print the description after a tab when the suggestion has one" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "1"; "--"; "myapp"; "d" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.stringContains output "deploy\tTest command" "The description should follow the value after a tab" + + testCase "should print no tab when the suggestion has no description" <| fun _ -> + let deployCommand = + commandWith + [ + Argument.required "target" "Target" + |> Argument.suggest (Suggest.values [ "alpha" ]) + ] + [] + + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion + useOutput console + command "deploy" deployCommand + }) + [| "__completion"; "2"; "--"; "myapp"; "deploy" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.equal (output.Trim()) "alpha" "A value without a description should be printed on its own" + + testCase "should not print the application banner when the hidden resolver is invoked" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "myapp" + version "1.2.3" + info ApplicationInfo.NameAndVersion + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "1"; "--"; "myapp"; "d" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.isFalse (output.Contains "myapp") "Application banner should not be printed" + + testCase "should suggest the completion command itself when its name is partially typed" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "1"; "--"; "myapp"; "comp" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.stringContains output "completion" "Completion command should be suggested" + Expect.isFalse (output.Contains "__completion") "Hidden resolver command should never be suggested" + + testCase "should suggest the supported shells when the completion command expects one" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "2"; "--"; "myapp"; "completion" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.stringContains output "bash" "Supported shell should be suggested" + Expect.stringContains output "zsh" "Supported shell should be suggested" + Expect.stringContains output "fish" "Supported shell should be suggested" + + testCase "should print nothing when the hidden resolver is invoked with an index which is not a number" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "here"; "--"; "myapp"; "d" |] + + Expect.equal result (Ok ExitCode.Error) "Hidden resolver command should fail" + Expect.equal (output.Trim()) "" "Nothing should be printed, as the output is read back as suggestions" + + testCase "should run the help command successfully when completion is enabled" <| fun _ -> + let result, _ = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "Test app" + version "1.0.0" + info ApplicationInfo.NameAndVersion + enableCompletion + useOutput console + command "foo" (commandWith [] []) + }) + [| "help" |] + + Expect.equal result (Ok ExitCode.Success) "Help command should succeed" + ] + + testList "disabled completion" [ + testCase "should not list the completion command when completion is not enabled" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + title "Feather.ConsoleApplication.Test" + name "Test app" + version "1.0.0" + info ApplicationInfo.NameAndVersion + useOutput console + command "foo" (commandWith [] []) + }) + [| "list" |] + + Expect.equal result (Ok ExitCode.Success) "List command should succeed" + Expect.isFalse (output.Contains "completion") "Completion command should not be listed" + ] + + testList "hidden completion command" [ + testCase "should not list the completion command when IsVisible is false" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with IsVisible = false; ExecutableName = Some "myapp" } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "list" |] + + Expect.equal result (Ok ExitCode.Success) "List command should succeed" + Expect.isFalse (output.Contains "completion") "Completion command should not be listed" + + testCase "should generate the script when IsVisible is false" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with IsVisible = false; ExecutableName = Some "myapp" } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "completion"; "bash" |] + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "myapp" "Generated script should be printed" + + testCase "should reject the resolver arguments when they are passed to the public completion command" <| fun _ -> + let result, _ = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with IsVisible = false; ExecutableName = Some "myapp" } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "completion"; "1"; "--"; "myapp"; "d" |] + + Expect.isError result "Public completion command should not accept an index and words" + + testCase "should resolve suggestions when the hidden resolver is invoked and the completion command is hidden" <| fun _ -> + let result, output = + runApplication + (fun console -> + consoleApplication { + name "myapp" + version "1.0.0" + enableCompletion { CompletionConfig.defaults with IsVisible = false; ExecutableName = Some "myapp" } + useOutput console + command "deploy" (commandWith [] []) + }) + [| "__completion"; "1"; "--"; "myapp"; "d" |] + + Expect.equal result (Ok ExitCode.Success) "Hidden resolver command should succeed" + Expect.stringContains output "deploy" "Matching command name should be suggested" + ] + + testList "completion script" [ + testCase "should complete the executable name when it differs from the application name" <| fun _ -> + let result, output = runScriptApplication (Some "my-tool") "bash" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "complete -F _my_tool_completion my-tool" "Generated script should complete the executable, not the application name" + + testCase "should replace characters not allowed in a shell function name" <| fun _ -> + let result, output = runScriptApplication (Some "my tool.exe") "bash" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "_my_tool_exe_completion() {" "Function name should contain only letters, digits and underscores" + + testCase "should complete the running executable when no executable name is configured" <| fun _ -> + let result, output = runScriptApplication None "bash" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output System.AppDomain.CurrentDomain.FriendlyName "Generated script should default to the running executable name" + + testCase "should pass the words and the index of the completed one when generating the bash script" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "bash" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "myapp __completion \"$index\" -- \"${completionWords[@]}\"" "Resolver should be called with the index and the words" + Expect.isFalse (output.Contains "COMP_LINE") "The line should not be passed to the resolver" + Expect.isFalse (output.Contains "COMP_POINT") "The cursor position should not be passed to the resolver" + + testCase "should cut the suggestion at the tab when generating the bash script" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "bash" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "suggestion=\"${suggestion%%$'\\t'*}\"" "Readline shows no descriptions, so the script should drop them" + + testCase "should pass the words and the index of the completed one when generating the zsh script" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "zsh" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "#compdef myapp" "Generated script should be a zsh completion definition" + Expect.stringContains output "completionWords=(\"${(@Q)words[1,CURRENT-1]}\" \"$PREFIX\")" "Words should be taken from zsh unquoted, with the word at the cursor taken from its prefix" + Expect.stringContains output "myapp __completion $((CURRENT - 1)) -- \"${completionWords[@]}\"" "Resolver should be called with the words zsh parsed and the index of the current one" + Expect.stringContains output "compdef _myapp_completion myapp" "Completion function should be registered for the executable" + + testCase "should describe the suggestions when generating the zsh script" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "zsh" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "described+=(\"${value//:/\\\\:}:$description\")" "The description should be paired with its value by a colon" + Expect.stringContains output "_describe -t suggestions 'suggestion' described" "Zsh should list the suggestions with their descriptions" + + testCase "should pass the words and the index of the completed one when generating the fish script" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "fish" + + Expect.equal result (Ok ExitCode.Success) "Completion script command should succeed" + Expect.stringContains output "commandline --current-process --tokenize --cut-at-cursor" "Words should be read up to the cursor" + Expect.stringContains output "myapp __completion (count $completionWords) -- $completionWords $currentWord" "Resolver should be called with the words and the index of the current one" + Expect.stringContains output "complete -c myapp" "Completion function should be registered for the executable" + + testCase "should fail with the supported shells when an unknown shell is given" <| fun _ -> + let result, output = runScriptApplication (Some "myapp") "powershell" + + Expect.equal result (Ok ExitCode.Error) "Completion script command should fail for an unsupported shell" + Expect.stringContains output "bash|zsh|fish" "Supported shells should be listed" + Expect.isFalse (output.Contains "complete -F") "No script should be generated for an unsupported shell" + ] + ] + +[] +let completionConfigValidationTests = + testList "ConsoleApplication - completion config" [ + testCase "should fail when the completion command name is a reserved one" <| fun _ -> + let result, _ = runCompletionApplication "list" + + Expect.isError result "A reserved command name should not be accepted" + + testCase "should fail when the completion command name is already used by a command" <| fun _ -> + let result, _ = runCompletionApplication "deploy" + + Expect.isError result "A command name of the application should not be accepted" + + testCase "should fail when the completion command name is the hidden resolver name" <| fun _ -> + let result, _ = runCompletionApplication Setup.HiddenResolverCommandName + + Expect.isError result "The hidden resolver name should not be accepted" + + testCase "should fail when the completion command name is not a valid command name" <| fun _ -> + let result, _ = runCompletionApplication "not a command!" + + Expect.isError result "An invalid command name should not be accepted" + + testCase "should succeed when the completion command name is free" <| fun _ -> + let result, _ = runCompletionApplication "shell-completion" + + Expect.equal result (Ok ExitCode.Success) "A free command name should be accepted" + ] diff --git a/tests/CompletionWordsTests.fs b/tests/CompletionWordsTests.fs new file mode 100644 index 0000000..271ebba --- /dev/null +++ b/tests/CompletionWordsTests.fs @@ -0,0 +1,52 @@ +module Feather.ConsoleApplication.Tests.CompletionWords + +open Expecto +open Feather.ConsoleApplication +open Feather.ConsoleApplication.Completion +open Feather.ConsoleApplication.Tests.Commands +open Feather.ErrorHandling + +[] +let completionWordsTests = + testList "Completion.Words" [ + testList "Words.normalize" [ + testCase "should join the option with its value when the shell split the word at the equals sign" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test"; "--opt1"; "="; "va" ] 4 + + Expect.equal context.CurrentWord "--opt1=va" "The split word should be joined back into the word at the cursor" + Expect.equal context.PrecedingWords [ "myapp"; "test" ] "The parts of the joined word should not remain as preceding words" + + testCase "should join the option with an empty value when the equals sign is the last word" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test"; "--opt1"; "=" ] 3 + + Expect.equal context.CurrentWord "--opt1=" "The trailing equals sign should belong to the option word" + + testCase "should drop the backslashes of an escaped word" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test"; @"my\ o" ] 2 + + Expect.equal context.CurrentWord "my o" "The escaped space should be part of the word value" + + testCase "should turn a doubled backslash into a single one" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test"; @"a\\b" ] 2 + + Expect.equal context.CurrentWord @"a\b" "The escaping backslash should be dropped and the escaped one kept" + + testCase "should drop the quotes surrounding a preceding word" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "\"test\""; "" ] 2 + + Expect.equal context.PrecedingWords [ "myapp"; "test" ] "The quotes typed around a word should not be part of its value" + + testCase "should yield an empty current word when the index is past the end of the words" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test" ] 2 + + Expect.equal context.CurrentWord "" "A cursor past the last word starts a new one" + Expect.equal context.PrecedingWords [ "myapp"; "test" ] "Every word typed so far should precede the cursor" + + testCase "should drop the words following the index" <| fun _ -> + let context = Completion.Words.normalize [ "myapp"; "test"; "al"; "beta" ] 2 + + Expect.equal context.CurrentWord "al" "The word at the index is the one being completed" + Expect.equal context.PrecedingWords [ "myapp"; "test" ] "Words typed after the cursor should be ignored" + ] + ] + diff --git a/tests/DefaultCommandsTests.fs b/tests/DefaultCommandsTests.fs index dfbc2af..70496df 100644 --- a/tests/DefaultCommandsTests.fs +++ b/tests/DefaultCommandsTests.fs @@ -4,17 +4,22 @@ open System open Expecto open Feather.ConsoleApplication +type LineMatch = + | Exact of string + | Contains of string + | ContainsAll of string list + type TestCase = { Description: string Command: string - ExpectedOutput: string list + ExpectedOutput: LineMatch list } let provideDefaultCommands = seq { let header = [ - "Default command test <1.0.0>" - "============================" - "" + Exact "Default command test <1.0.0>" + Exact "============================" + Exact "" ] { @@ -24,32 +29,32 @@ let provideDefaultCommands = seq { [ yield! header - "Description:" - " Displays help for a command" - "" - "Usage:" - " help [options] [--] []" - "" - "Arguments:" - " command_name The command name [default: \"help\"]" - "" - "Options:" - " -h, --help Display this help message " - " -q, --quiet Do not output any message " - " -V, --version Display this application version " - " -n, --no-interaction Do not ask any interactive question " - " --no-progress Whether to disable all progress bars " - " --no-ansi Whether to disable all markup with ansi formatting" - " -v|vv|vvv, --verbose Increase the verbosity of messages " - "" - "Help:" - " The help command displays help for a given command:" - "" - " dotnet bin/Debug/net10.0/tests.dll help list" - "" - " To display list of available commands, please use list command." - "" - "" + Exact "Description:" + Exact " Displays help for a command" + Exact "" + Exact "Usage:" + Exact " help [options] [--] []" + Exact "" + Exact "Arguments:" + Exact " command_name The command name [default: \"help\"]" + Exact "" + Exact "Options:" + Exact " -h, --help Display this help message " + Exact " -q, --quiet Do not output any message " + Exact " -V, --version Display this application version " + Exact " -n, --no-interaction Do not ask any interactive question " + Exact " --no-progress Whether to disable all progress bars " + Exact " --no-ansi Whether to disable all markup with ansi formatting" + Exact " -v|vv|vvv, --verbose Increase the verbosity of messages " + Exact "" + Exact "Help:" + Exact " The help command displays help for a given command:" + Exact "" + Contains "help list" + Exact "" + Exact " To display list of available commands, please use list command." + Exact "" + Exact "" ] } @@ -60,24 +65,24 @@ let provideDefaultCommands = seq { [ yield! header - "Usage:" - " command [options] [--] [arguments] " - "" - "Options:" - " -h, --help Display this help message " - " -q, --quiet Do not output any message " - " -V, --version Display this application version " - " -n, --no-interaction Do not ask any interactive question " - " --no-progress Whether to disable all progress bars " - " --no-ansi Whether to disable all markup with ansi formatting" - " -v|vv|vvv, --verbose Increase the verbosity of messages " - "" - "Available commands:" - " about Displays information about the current project" - " help Displays help for a command " - " list Lists commands " - "" - "" + Exact "Usage:" + Exact " command [options] [--] [arguments] " + Exact "" + Exact "Options:" + Exact " -h, --help Display this help message " + Exact " -q, --quiet Do not output any message " + Exact " -V, --version Display this application version " + Exact " -n, --no-interaction Do not ask any interactive question " + Exact " --no-progress Whether to disable all progress bars " + Exact " --no-ansi Whether to disable all markup with ansi formatting" + Exact " -v|vv|vvv, --verbose Increase the verbosity of messages " + Exact "" + Exact "Available commands:" + Exact " about Displays information about the current project" + Exact " help Displays help for a command " + Exact " list Lists commands " + Exact "" + Exact "" ] } @@ -88,32 +93,32 @@ let provideDefaultCommands = seq { [ yield! header - "Description:" - " Displays information about the current project" - "" - "Usage:" - " about [options] " - "" - "Options:" - " -h, --help Display this help message " - " -q, --quiet Do not output any message " - " -V, --version Display this application version " - " -n, --no-interaction Do not ask any interactive question " - " --no-progress Whether to disable all progress bars " - " --no-ansi Whether to disable all markup with ansi formatting" - " -v|vv|vvv, --verbose Increase the verbosity of messages " - "" - "Help:" - " The about command displays information about the current project:" - "" - " dotnet bin/Debug/net10.0/tests.dll about about" - "" - " There are multiple sections shown in the output:" - " - current project details/meta information" - " - environment" - " - console application library" - "" - "" + Exact "Description:" + Exact " Displays information about the current project" + Exact "" + Exact "Usage:" + Exact " about [options] " + Exact "" + Exact "Options:" + Exact " -h, --help Display this help message " + Exact " -q, --quiet Do not output any message " + Exact " -V, --version Display this application version " + Exact " -n, --no-interaction Do not ask any interactive question " + Exact " --no-progress Whether to disable all progress bars " + Exact " --no-ansi Whether to disable all markup with ansi formatting" + Exact " -v|vv|vvv, --verbose Increase the verbosity of messages " + Exact "" + Exact "Help:" + Exact " The about command displays information about the current project:" + Exact "" + Contains "about about" + Exact "" + Exact " There are multiple sections shown in the output:" + Exact " - current project details/meta information" + Exact " - environment" + Exact " - console application library" + Exact "" + Exact "" ] } @@ -122,51 +127,49 @@ let provideDefaultCommands = seq { Command = "about" ExpectedOutput = let version = AssemblyVersionInformation.AssemblyVersion - let spaces value = String.replicate (101 - (string value).Length) " " let createdAt = AssemblyVersionInformation.AssemblyMetadata_createdAt.[0 .. "yyyy-mm-dd".Length - 1] let gitCommit = AssemblyVersionInformation.AssemblyMetadata_gitcommit - let dotnetVersion = string Environment.Version [ yield! header - " " - " Default command test .NET Core Git Branch Feather.ConsoleApplication " - $" 1.0.0 {dotnetVersion} {version} ({createdAt}) " - " " - "" - "---------------------------- ------------------------------------------------------------------------------------------------------" - " Application " - " --------------------- ---------------------------------------------------------------------------------------------------- " - " Name Default command test " - " Version 1.0.0 " - " Description About command " - " Environment Test " - " command about " - " args " - " --------------------- ---------------------------------------------------------------------------------------------------- " - " Environment " - " --------------------- ---------------------------------------------------------------------------------------------------- " - $" .NET Core {dotnetVersion}{spaces dotnetVersion}" - $" Command Line {Environment.CommandLine}{spaces Environment.CommandLine}" - $" Current Directory {Environment.CurrentDirectory}{spaces Environment.CurrentDirectory}" - $" Machine Name {Environment.MachineName}{spaces Environment.MachineName}" - $" OS Version {Environment.OSVersion}{spaces Environment.OSVersion}" - $" Processor Count {Environment.ProcessorCount}{spaces Environment.ProcessorCount}" - " --------------------- ---------------------------------------------------------------------------------------------------- " - " Git " - " --------------------- ---------------------------------------------------------------------------------------------------- " - " Branch " - " Commit " - " --------------------- ---------------------------------------------------------------------------------------------------- " - " Feather.ConsoleApplication " - " --------------------- ---------------------------------------------------------------------------------------------------- " - $" Version {version}{spaces version}" - $" Commit {gitCommit}{spaces gitCommit}" - $" Released {createdAt}{spaces createdAt}" - "---------------------------- ------------------------------------------------------------------------------------------------------" - "" - "" + Contains "" + ContainsAll [ "Default command test"; ".NET Core"; "Git Branch"; "Feather.ConsoleApplication" ] + ContainsAll [ "1.0.0"; ""; version; createdAt ] + Contains "" + Exact "" + Contains "----------------------------" + Contains " Application" + Contains " ---------------------" + Contains " Name Default command test" + Contains " Version 1.0.0" + Contains " Description About command" + Contains " Environment Test" + Contains " command about" + Contains " args" + Contains " ---------------------" + Contains " Environment" + Contains " ---------------------" + Contains " .NET Core " + Contains " Command Line " + Contains " Current Directory " + Contains " Machine Name " + Contains " OS Version " + Contains " Processor Count " + Contains " ---------------------" + Contains " Git" + Contains " ---------------------" + Contains " Branch " + Contains " Commit " + Contains " ---------------------" + Contains " Feather.ConsoleApplication" + Contains " ---------------------" + Contains $" Version {version}" + Contains $" Commit {gitCommit}" + Contains $" Released {createdAt}" + Contains "----------------------------" + Exact "" + Exact "" ] } } @@ -217,9 +220,18 @@ let defaultCommandsTests = |> List.ofArray expected - |> List.iteri (fun i line -> - Expect.stringHasLength output.[i] line.Length $"Output line {i + 1} should have correct length ({line.Length} but has {output.[i].Length})." - Expect.equal output.[i] line $"Line {i + 1} should match." + |> List.iteri (fun i expectedLine -> + match expectedLine with + | Exact expected -> + Expect.stringHasLength output[i] expected.Length $"Output line {i + 1} should have correct length ({expected.Length} but has {output[i].Length})." + Expect.equal output[i] expected $"Line {i + 1} should match." + | Contains substring -> + Expect.stringContains output[i] substring $"Output line {i + 1} should contain '{substring}'." + | ContainsAll substrings -> + substrings + |> List.iter (fun substring -> + Expect.stringContains output[i] substring $"Output line {i + 1} should contain '{substring}'." + ) ) ) ] diff --git a/tests/Fixtures/Commands.fs b/tests/Fixtures/Commands.fs index 0b9b5ba..7d8984a 100644 --- a/tests/Fixtures/Commands.fs +++ b/tests/Fixtures/Commands.fs @@ -145,3 +145,64 @@ let commandSeven executeCallback: CommandDefinition = executeCallback input ExitCode.Success } + +let commandWith arguments options: CommandDefinition = + { + Description = "Test command" + Help = None + Arguments = arguments + Options = options + Initialize = None + Interact = None + Execute = Execute <| fun (_, _) -> ExitCode.Success + } + +let commandWithSuggestedInput = + commandWith + [ + Argument.required "target" "Target" + |> Argument.suggest (Suggest.values [ "alpha"; "beta" ]) + ] + [ + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "val1"; "val2" ]) + + Option.required "opt1-extra" None "Option one extra" "" + ] + +let commandWithClusteredShortcuts = + commandWith + [ + Argument.required "target" "Target" + |> Argument.suggest (Suggest.values [ "alpha"; "beta" ]) + ] + [ + Option.noValue "foo" (Some "f") "Flag foo" + Option.noValue "loud" (Some "l") "Flag loud" + + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "val1"; "val2" ]) + ] + +let commandWithTwoSuggestedArguments = + commandWith + [ + Argument.required "first" "First" + |> Argument.suggest (Suggest.values [ "alpha"; "beta" ]) + + Argument.required "second" "Second" + |> Argument.suggest (Suggest.values [ "one"; "two" ]) + ] + [ + Option.required "opt1" (Some "o") "Option one" "" + |> Option.suggest (Suggest.values [ "val1"; "val2" ]) + ] + +let commandWithSpacedSuggestions = + commandWith + [ + Argument.required "target" "Target" + |> Argument.suggest (Suggest.values [ "my value"; "my other value"; "plain" ]) + ] + [] + diff --git a/tests/InputTests.fs b/tests/InputTests.fs index 01d27df..45ac198 100644 --- a/tests/InputTests.fs +++ b/tests/InputTests.fs @@ -15,9 +15,6 @@ type ArgsHasOption = { exception InputWasNotSetInTheCommandException let provideArgsHasOption = seq { - // - // cases without separator -- - // yield { Description = "Empty options with interaction - should not exists" Argv = [| |] @@ -55,9 +52,6 @@ let provideArgsHasOption = seq { ExpectedWithValue = Some (OptionValue.ValueRequired "value1") } - // - // cases with separator -- - // yield { Description = "No interaction" Argv = [| "-n"; "--"; "value" |] @@ -128,9 +122,6 @@ let provideArgsHasOption = seq { ExpectedWithValue = Some (OptionValue.ValueOptional (Some "")) } - // - // cases with no-interaction - // yield { Description = "No arguments and empty options with no-interaction shortuct - should not exists" Argv = [| |] @@ -237,9 +228,6 @@ type ArgsHasArgument = { } let provideArgsHasArgument = seq { - // - // cases without separator -- - // yield { Description = "No arguments with interaction" Argv = [| "value" |] @@ -253,9 +241,6 @@ let provideArgsHasArgument = seq { Expected = Some (ArgumentValue.Optional (Some "default")) } - // - // cases with separator -- - // yield { Description = "Argument value with no interaction" Argv = [| "-n"; "--"; "mandatory" |] diff --git a/tests/SuggestTests.fs b/tests/SuggestTests.fs new file mode 100644 index 0000000..801358a --- /dev/null +++ b/tests/SuggestTests.fs @@ -0,0 +1,225 @@ +module Feather.ConsoleApplication.Tests.SuggestTests + +open Expecto +open Feather.ConsoleApplication +open Feather.ConsoleApplication.Completion +open Feather.ConsoleApplication.Tests.Commands +open Feather.ErrorHandling + +let private runDescribedSuggest (suggest: Suggest) (context: CompletionContext) = + match suggest with + | Suggest.SuggestSync suggestion -> suggestion context + | Suggest.SuggestAsync suggestion -> suggestion context |> Async.RunSynchronously + +let private runSuggest (suggest: Suggest) (context: CompletionContext) = + runDescribedSuggest suggest context |> List.map CompletionSuggestion.value + +let private fakeListers: Suggest.FileSystemListers = + { + DirectoryExists = (fun path -> + path = "." || + path = "src" || path = "./src" || + path = "docs" || path = "./docs" || + path = ".hidden" || path = "./.hidden") + FileExists = (fun path -> + path.EndsWith "README.md" || + path.EndsWith "tool.fsx" || + path.EndsWith "notes.txt" || + path.EndsWith ".env") + EnumerateFileSystemEntries = (fun path -> + [ "src"; "docs"; "README.md"; "tool.fsx"; "notes.txt"; ".env" ] + |> List.map (fun name -> System.IO.Path.Combine(path, name)) + |> Seq.ofList) + EnumerateDirectories = (fun path -> + [ "src"; "docs"; ".hidden" ] + |> List.map (fun name -> System.IO.Path.Combine(path, name)) + |> Seq.ofList) + } + +let private fakeMissingDirectoryListers: Suggest.FileSystemListers = + { + DirectoryExists = (fun _ -> false) + FileExists = (fun _ -> false) + EnumerateFileSystemEntries = (fun _ -> Seq.empty) + EnumerateDirectories = (fun _ -> Seq.empty) + } + +let private fakeThrowingListers: Suggest.FileSystemListers = + { + DirectoryExists = (fun _ -> true) + FileExists = (fun _ -> false) + EnumerateFileSystemEntries = (fun _ -> failwith "boom") + EnumerateDirectories = (fun _ -> failwith "boom") + } + +[] +let suggestCombinatorsTests = + testList "Suggest combinators" [ + testList "Suggest.map" [ + testCase "should transform every value when the source suggests a static list" <| fun _ -> + let suggest = Suggest.values [ "dev"; "prod" ] |> Suggest.map _.ToUpperInvariant() + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [ "DEV"; "PROD" ] "Every suggested value should be upper-cased" + ] + + testList "Suggest.mapAsync" [ + testCase "should transform every value when the source suggests a static list" <| fun _ -> + let suggest = + Suggest.values [ "dev"; "prod" ] + |> Suggest.mapAsync (fun value -> async { return value + "-x" }) + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [ "dev-x"; "prod-x" ] "Every suggested value should have the suffix appended" + ] + + testList "Suggest.filter" [ + testCase "should keep only values matching the predicate" <| fun _ -> + let suggest = Suggest.values [ "dev"; "prod" ] |> Suggest.filter ((=) "dev") + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [ "dev" ] "Only values matching the predicate should be suggested" + ] + + testList "Suggest.filterAsync" [ + testCase "should keep only values matching the predicate" <| fun _ -> + let suggest = + Suggest.values [ "dev"; "prod" ] + |> Suggest.filterAsync (fun value -> async { return value = "dev" }) + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [ "dev" ] "Only values matching the predicate should be suggested" + ] + + testList "Suggest.describedValues" [ + testCase "should suggest every value with its description" <| fun _ -> + let suggest = Suggest.describedValues [ "dev", "Development"; "prod", "Production" ] + + let suggestions = runDescribedSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal + suggestions + [ + { Value = "dev"; Description = Some "Development" } + { Value = "prod"; Description = Some "Production" } + ] + "Every value should keep the description given with it" + + testCase "should describe no value when the description is empty" <| fun _ -> + let suggest = Suggest.describedValues [ "dev", "" ] + + let suggestions = runDescribedSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [ { Value = "dev"; Description = None } ] "An empty description should be the same as none" + + testCase "should keep the descriptions when the values are transformed" <| fun _ -> + let suggest = + Suggest.describedValues [ "dev", "Development" ] + |> Suggest.map _.ToUpperInvariant() + + let suggestions = runDescribedSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal + suggestions + [ { Value = "DEV"; Description = Some "Development" } ] + "Transforming the value should leave its description untouched" + + testCase "should keep the descriptions when the values are filtered asynchronously" <| fun _ -> + let suggest = + Suggest.describedValues [ "dev", "Development"; "prod", "Production" ] + |> Suggest.filterAsync (fun value -> async { return value = "dev" }) + + let suggestions = runDescribedSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal + suggestions + [ { Value = "dev"; Description = Some "Development" } ] + "Filtering by the value should leave the description of the kept value untouched" + ] + ] + +[] +let suggestFileHelpersTests = + testList "Suggest file helpers" [ + testList "Suggest.files" [ + testCase "should append a trailing slash when the entry is a directory" <| fun _ -> + let suggest = Suggest.filesWith fakeListers + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.contains suggestions "src/" "Directory should be suggested with a trailing slash" + + testCase "should suggest file entries by their plain name" <| fun _ -> + let suggest = Suggest.filesWith fakeListers + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.contains suggestions "README.md" "File entry should be suggested by its name" + Expect.contains suggestions "tool.fsx" "File entry should be suggested by its name" + + testCase "should omit dotfiles when the current word does not start with a dot" <| fun _ -> + let suggest = Suggest.filesWith fakeListers + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.isFalse (suggestions |> List.contains ".env") "Dotfile should not be suggested" + + testCase "should return no suggestions when the directory does not exist" <| fun _ -> + let suggest = Suggest.filesWith fakeMissingDirectoryListers + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [] "Missing directory should produce no suggestions" + + testCase "should return no suggestions when listing the directory throws" <| fun _ -> + let suggest = Suggest.filesWith fakeThrowingListers + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.equal suggestions [] "Failed listing should produce no suggestions" + ] + + testList "Suggest.directories" [ + testCase "should suggest dot-prefixed directories when the current word starts with a dot" <| fun _ -> + let suggest = Suggest.directoriesWith fakeListers + + let suggestions = runSuggest suggest { CurrentWord = "."; PrecedingWords = [] } + + Expect.contains suggestions ".hidden/" "Dot-prefixed directory should be suggested" + ] + + testList "Suggest.filesWithExtension" [ + testCase "should suggest directories even when they do not match the extension" <| fun _ -> + let suggest = Suggest.filesWithExtensionWith fakeListers [ ".fsx" ] + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.contains suggestions "src/" "Directory should be suggested regardless of the extension filter" + + testCase "should suggest files when their extension is in the filter" <| fun _ -> + let suggest = Suggest.filesWithExtensionWith fakeListers [ ".fsx" ] + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.contains suggestions "tool.fsx" "File with an allowed extension should be suggested" + + testCase "should omit files when their extension is not in the filter" <| fun _ -> + let suggest = Suggest.filesWithExtensionWith fakeListers [ ".fsx" ] + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.isFalse (suggestions |> List.contains "README.md") "File with a disallowed extension should not be suggested" + + testCase "should omit every file when the extension filter is empty" <| fun _ -> + let suggest = Suggest.filesWithExtensionWith fakeListers [] + + let suggestions = runSuggest suggest { CurrentWord = ""; PrecedingWords = [] } + + Expect.isFalse (suggestions |> List.contains "tool.fsx") "No file should be suggested for an empty extension filter" + ] + ] + diff --git a/tests/tests.fsproj b/tests/tests.fsproj index 27021fd..de07d67 100644 --- a/tests/tests.fsproj +++ b/tests/tests.fsproj @@ -23,6 +23,10 @@ + + + +