diff --git a/.gitignore b/.gitignore index dfd606c..ec79550 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ # Distribution build/ documentation.json +docs.json */elm.js **/*.elm.js *graphqelm-metadata.json diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d9bb65..03f1a29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,31 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0. ## [Unreleased] +### Added + +- **`Cli.Option.Typed` module** — new option constructors that take a `CliDecoder` + for typed CLI parsing and JSON schema generation. Includes `string`, `int`, + `float`, and `customDecoder` for custom types. +- **`Program.toJsonSchema`** — generates a [JSON Schema](https://json-schema.org/) + from your CLI configuration, suitable for + [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) + `inputSchema` definitions and + [elm-pages script](https://elm-pages.com/docs/elm-pages-scripts) introspection. +- **JSON input mode** — parsers accept structured JSON in addition to traditional + CLI arguments, enabling LLM agents to invoke tools programmatically. The `$cli` + object serves as the sentinel, containing positional arguments and subcommand. +- `x-cli-kind` annotations in JSON schema output (`"keyword"`, `"flag"`, + `"keyword-list"`) describing how each option maps to CLI invocation. +- Schema `description` field includes usage synopsis and invocation instructions. +- `Option.withDisplayName` for custom metavar display (e.g., `--output-dir `). +- `TypedGreet` example demonstrating the typed options API. + +### Changed + +- New dependency on `dillonkearns/elm-ts-json` (>= 2.1.2). +- Improved help text formatting: uppercase metavar names, 80-character line + wrapping, description indentation. + ## [4.0.0] See the [V4 Upgrade Guide](V4-UPGRADE-GUIDE.md) for migration instructions. diff --git a/README.md b/README.md index ac011c2..2be54d3 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,11 @@ # Elm CLI Options Parser `elm-cli-options-parser` allows you to build command-line options parsers in Elm. -It uses a syntax similar to `Json.Decode.Pipeline`. +It uses a syntax similar to `Json.Decode.Pipeline`, with automatic help text +generation, validation, and [JSON Schema](https://json-schema.org/) output +for [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) +definitions and [elm-pages script](https://elm-pages.com/docs/elm-pages-scripts) +introspection. You can play around with `elm-cli-options-parser` in a [live terminal simulation in Ellie here](https://ellie-app.com/8b8QWfcxx4Ca1)! @@ -95,6 +99,68 @@ git log [--author ] [--max-count ] [--stat] [ Note: the `--help` option is a built-in command, so no need to write a `OptionsParser` for that. +## Typed Options & JSON Schema + +The [`Cli.Option.Typed`](https://package.elm-lang.org/packages/dillonkearns/elm-cli-options-parser/4.0.0/Cli-Option-Typed/) +module lets you specify the type of each option (string, int, float, etc.) via a +`CliDecoder`. This gives you: + +- **JSON Schema generation** via `Program.toJsonSchema` — for MCP tool definitions, + elm-pages script introspection, or any tooling that needs a machine-readable + description of your CLI's inputs +- **Typed JSON input** — the same parser handles both traditional CLI args and + structured JSON, so LLM agents can invoke your tool programmatically +- **CLI validation** — typed decoders like `int` and `float` automatically reject + malformed input + +```elm +import Cli.Option.Typed as Option +import Cli.OptionsParser as OptionsParser exposing (with) +import Cli.Program as Program + +type alias Options = + { name : String + , count : Int + , verbose : Bool + } + +programConfig : Program.Config Options +programConfig = + Program.config + |> Program.add + (OptionsParser.build Options + |> with (Option.requiredKeywordArg "name" Option.string) + |> with (Option.requiredKeywordArg "count" Option.int) + |> with (Option.flag "verbose") + ) +``` + +This parser works with traditional CLI args: + +```console +$ mytool --name hello --count 3 --verbose +``` + +And also accepts JSON input (for tool-calling agents): + +```json +{ "name": "hello", "count": 3, "verbose": true, "$cli": {} } +``` + +`Program.toJsonSchema "mytool" programConfig` generates a JSON Schema with +proper types (`"type": "string"`, `"type": "integer"`, etc.) and `x-cli-kind` +annotations that describe how each option maps to CLI flags. + +### When to use `Cli.Option` vs `Cli.Option.Typed` + +Use **`Cli.Option.Typed`** when you want JSON schema generation or JSON input support. + +Use **`Cli.Option`** (the original API shown in the example above) when you only need +traditional CLI argument parsing. It's simpler — no decoder argument needed — and +treats all values as strings, which you then transform with `validateMap`, `map`, etc. + +Both modules produce the same `Option` type and work with the same `OptionsParser.with` pipeline. + ## Color Support The library automatically adds ANSI color codes to help text and error messages when enabled. To enable colors, pass `colorMode: true` in your flags from JavaScript: diff --git a/docs.json b/docs.json deleted file mode 100644 index 7f2481e..0000000 --- a/docs.json +++ /dev/null @@ -1 +0,0 @@ -[{"name":"Cli.Option","comment":" Here is the terminology used for building up Command-Line parsers with this library.\n\n![Terminology Legend](https://raw.githubusercontent.com/dillonkearns/elm-cli-options-parser/master/terminology.png)\n\nSee the README and the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder for more in-depth examples of building\nand using `Cli.Option`s.\n\n\n## Positional Arguments\n\n@docs requiredPositionalArg\n\n\n## Keyword Arguments\n\n@docs optionalKeywordArg, requiredKeywordArg, keywordArgList\n\n\n## Flags\n\n@docs flag\n\n\n## Ending Options\n\nSee note in `Cli.OptionsParser` docs.\n\n@docs optionalPositionalArg, restArgs\n\n\n## Transformations\n\n\n### Mutually Exclusive Values\n\n@docs oneOf\n\n\n### Validation\n\nValidations allow you to guarantee that if you receive the data in Elm, it\nmeets a set of preconditions. If it doesn't, the User will see an error message\ndescribing the validation error, which option it came from, and the value the\noption had.\n\nNote that failing a validation will not cause the next `OptionsParser` in\nyour `Cli.Program.Config` to be run. Instead,\nif the OptionsParser is a match except for validation errors, you will get an\nerror message regardless.\n\nExample:\n\n\n capitalizedNameRegex =\n \"[A-Z][A-Za-z]*\"\n\n validateParser =\n OptionsParser.build (\\a b -> ( a, b ))\n |> with\n (Option.requiredKeywordArg \"name\"\n |> Option.validate (Cli.Validate.regex capitalizedNameRegex)\n )\n |> with\n (Option.optionalKeywordArg \"age\"\n |> Option.validateMapIfPresent String.toInt\n )\n\n {-\n $ ./validation --name Mozart --age 262\n Mozart is 262 years old\n\n $ ./validation --name Mozart --age \"Two-hundred and sixty-two\"\n Validation errors:\n\n `age` failed a validation. could not convert string 'Two-hundred and sixty-two' to an Int\n Value was:\n Just \"Two-hundred and sixty-two\"\n -}\n\nSee `Cli.Validate` for some validation helpers that can be used in conjunction\nwith the following functions.\n\n@docs validate, validateIfPresent, validateMap, validateMapIfPresent\n\n\n### Mapping/Defaults\n\n@docs map, mapFlag, withDefault\n\n\n### Metadata\n\n@docs withDescription, withMissingMessage\n\n\n## Types\n\n@docs Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption\n\n","unions":[{"name":"BeginningOption","comment":" Phantom type marker for beginning options.\n\n`BeginningOption`s can only be used with `OptionsParser.with`.\n\n","args":[],"cases":[]},{"name":"OptionalPositionalArgOption","comment":" Phantom type marker for optional positional arg options.\n\n`OptionalPositionalArgOption`s can only be used with `OptionsParser.withOptionalPositionalArg`.\n\n","args":[],"cases":[]},{"name":"RestArgsOption","comment":" Phantom type marker for rest args options.\n\n`RestArgsOption`s can only be used with `OptionsParser.withRestArgs`.\n\n","args":[],"cases":[]}],"aliases":[{"name":"Option","comment":" The type returned by the builder functions below. Use with `OptionsParser.with`.\n","args":["from","to","middleOrEnding"],"type":"Cli.Option.Internal.Option from to middleOrEnding"}],"values":[{"name":"flag","comment":" A flag with no argument.\n\nExample: `--debug` in `elm make --debug`\nParses to: `True` (or `False` if omitted)\n\n Option.flag \"debug\"\n\n","type":"String.String -> Cli.Option.Option Basics.Bool Basics.Bool { position : Cli.Option.BeginningOption }"},{"name":"keywordArgList","comment":" A keyword argument that can be provided multiple times.\n\nExample: `--header \"Auth: token\" --header \"Accept: json\"`\nParses to: `[\"Auth: token\", \"Accept: json\"]`\n\n Option.keywordArgList \"header\"\n\n","type":"String.String -> Cli.Option.Option (List.List String.String) (List.List String.String) { position : Cli.Option.BeginningOption }"},{"name":"map","comment":" Transform an `Option`. For example, you may want to map an option from the\nraw `String` that comes from the command line into a `Regex`, as in this code snippet.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser\n import Cli.Program as Program\n import Regex exposing (Regex)\n\n type alias CliOptions =\n { pattern : Regex }\n\n programConfig : Program.Config CliOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build buildCliOptions\n |> OptionsParser.with\n (Option.requiredPositionalArg \"pattern\"\n |> Option.map Regex.regex\n )\n )\n\n","type":"(toRaw -> toMapped) -> Cli.Option.Option from toRaw builderState -> Cli.Option.Option from toMapped builderState"},{"name":"mapFlag","comment":" Useful for using a custom union type for a flag instead of a `Bool`.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser\n import Cli.Program as Program\n\n type Verbosity\n = Quiet\n | Verbose\n\n type alias CliOptions =\n { verbosity : Verbosity\n }\n\n programConfig : Program.Config CliOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build CliOptions\n |> OptionsParser.with\n (Option.flag \"verbose\"\n |> Option.mapFlag\n { present = Verbose\n , absent = Quiet\n }\n )\n )\n\n","type":"{ present : union, absent : union } -> Cli.Option.Option from Basics.Bool builderState -> Cli.Option.Option from union builderState"},{"name":"oneOf","comment":" Mutually exclusive option values.\n\n type ReportFormat\n = Json\n | Junit\n | Console\n\n type alias CliOptions =\n { reportFormat : ReportFormat\n , testFiles : List String\n }\n\n program : Program.Config CliOptions\n program =\n Program.config\n |> Program.add\n (OptionsParser.build CliOptions\n |> with\n (Option.optionalKeywordArg \"report\"\n |> Option.withDefault \"console\"\n |> Option.oneOf\n [ \"json\" => Json\n , \"junit\" => Junit\n , \"console\" => Console\n ]\n )\n |> OptionsParser.withRestArgs (Option.restArgs \"TESTFILES\")\n )\n\nNow when you run it, you get the following in your help text:\n\n```shell\n$ ./elm-test --help\nelm-test [--report ] ...\n```\n\nAnd if you run it with an unrecognized value, you get a validation error:\n\n```shell\n$ ./elm-test --report xml\nValidation errors:\n\n`report` failed a validation. Must be one of [json, junit, console]\nValue was:\n\"xml\"\n```\n\n","type":"List.List ( String.String, value ) -> Cli.Option.Option from String.String builderState -> Cli.Option.Option from value builderState"},{"name":"optionalKeywordArg","comment":" A keyword argument that may be omitted.\n\nExample: `--output main.js` or `--output=main.js`\nParses to: `Just \"main.js\"` (or `Nothing` if omitted)\n\n Option.optionalKeywordArg \"output\"\n\n","type":"String.String -> Cli.Option.Option (Maybe.Maybe String.String) (Maybe.Maybe String.String) { position : Cli.Option.BeginningOption }"},{"name":"optionalPositionalArg","comment":" Note that this must be used with `OptionsParser.withOptionalPositionalArg`.\n","type":"String.String -> Cli.Option.Option (Maybe.Maybe String.String) (Maybe.Maybe String.String) { position : Cli.Option.OptionalPositionalArgOption }"},{"name":"requiredKeywordArg","comment":" A keyword argument that must be provided.\n\nExample: `--name my-app` or `--name=my-app`\nParses to: `\"my-app\"`\n\n Option.requiredKeywordArg \"name\"\n\n","type":"String.String -> Cli.Option.Option String.String String.String { position : Cli.Option.BeginningOption, canAddMissingMessage : () }"},{"name":"requiredPositionalArg","comment":" A positional argument that must be provided.\n\nExample: `src/Main.elm` in `elm make src/Main.elm`\nParses to: `\"src/Main.elm\"`\n\n Option.requiredPositionalArg \"input\"\n\n","type":"String.String -> Cli.Option.Option String.String String.String { position : Cli.Option.BeginningOption, canAddMissingMessage : () }"},{"name":"restArgs","comment":" Note that this must be used with `OptionsParser.withRestArgs`.\n","type":"String.String -> Cli.Option.Option (List.List String.String) (List.List String.String) { position : Cli.Option.RestArgsOption }"},{"name":"validate","comment":" Run a validation. (See an example in the Validation section above, or\nin the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder).\n","type":"(to -> Cli.Validate.ValidationResult) -> Cli.Option.Option from to builderState -> Cli.Option.Option from to builderState"},{"name":"validateIfPresent","comment":" Run a validation if the value is `Just someValue`. Or do nothing if the value is `Nothing`.\n(See an example in the Validation section above, or in the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder).\n","type":"(to -> Cli.Validate.ValidationResult) -> Cli.Option.Option from (Maybe.Maybe to) builderState -> Cli.Option.Option from (Maybe.Maybe to) builderState"},{"name":"validateMap","comment":" Transform the value through a map function. If it returns `Ok someValue` then\nthe `Option` will be transformed into `someValue`. If it returns `Err someError`\nthen the User of the Command-Line Interface will see `someError` with details\nabout the `Option` that had the validation error.\n\n(See an example in the Validation section above, or\nin the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder).\n\n","type":"(to -> Result.Result String.String toMapped) -> Cli.Option.Option from to builderState -> Cli.Option.Option from toMapped builderState"},{"name":"validateMapIfPresent","comment":" Same as `validateMap` if the value is `Just someValue`. Does nothing if\nthe value is `Nothing`.\n\n(See an example in the Validation section above, or\nin the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder).\n\n","type":"(to -> Result.Result String.String toMapped) -> Cli.Option.Option (Maybe.Maybe from) (Maybe.Maybe to) builderState -> Cli.Option.Option (Maybe.Maybe from) (Maybe.Maybe toMapped) builderState"},{"name":"withDefault","comment":" Provide a default value for the `Option`.\n","type":"to -> Cli.Option.Option from (Maybe.Maybe to) builderState -> Cli.Option.Option from to builderState"},{"name":"withDescription","comment":" Add a description to an option. This will be shown in help text.\n\n Option.requiredKeywordArg \"name\"\n |> Option.withDescription \"Your name for the greeting\"\n\n","type":"String.String -> Cli.Option.Option from to builderState -> Cli.Option.Option from to builderState"},{"name":"withMissingMessage","comment":" Add a custom error message for when a required option is missing.\n\nThis only works on required options (requiredPositionalArg, requiredKeywordArg).\n\n Option.requiredPositionalArg \"repository\"\n |> Option.withMissingMessage \"You must specify a repository to clone.\"\n\n","type":"String.String -> Cli.Option.Option from to { c | canAddMissingMessage : () } -> Cli.Option.Option from to { c | canAddMissingMessage : () }"}],"binops":[]},{"name":"Cli.OptionsParser","comment":"\n\n\n## Types\n\n@docs OptionsParser\n\n\n## Start the Pipeline\n\nYou build up an `OptionsParser` similarly to the way you build a decoder using the\n[elm-decode-pipeline](http://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest)\npattern. That is, you start the pipeline by giving it a constructor function,\nand then for each argument of your constructor function, you have a corresponding\n\n |> with (Option.someKindOfOption)\n\nin the exact same order.\n\nFor example, if we define a type alias for a record with two attributes,\nElm generates a 2-argument constructor function for that record type. Here\nElm gives us a `GreetOptions` function of the type `String -> Maybe String -> GreetOptions`\n(this is just a core Elm language feature). That is, if we pass in a `String` and\na `Maybe String` as the 1st and 2nd arguments to the `GreetOptions` function,\nit will build up a record of that type.\n\nSo in this example, we call `OptionsParser.build` with our `GreetOptions`\nconstructor function. Then we chain on `with` once for each of those two arguments.\nNote that the first `with` will give us a `String`, and the second will give us\na `Maybe String`, so it matches up perfectly with the order of our constructor's\narguments.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser exposing (with)\n import Cli.Program as Program\n\n type alias GreetOptions =\n { name : String\n , maybeGreeting : Maybe String\n }\n\n programConfig : Program.Config GreetOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build GreetOptions\n |> with (Option.requiredKeywordArg \"name\")\n |> with (Option.optionalKeywordArg \"greeting\")\n )\n\n@docs build, buildSubCommand\n\n\n## Adding `Cli.Option.Option`s To The Pipeline\n\nMost options can be chained on using `with`. There are two exceptions,\n`restArgs` and `optionalPositionalArg`s. `elm-cli-options-parser` enforces that\nthey are added in an unambiguous order (see the `Cli.OptionsParser.BuilderState` docs).\nSo instead of using `with`, you add them with their corresponding `with...`\nfunctions.\n\n import Cli.Option\n import Cli.OptionsParser as OptionsParser exposing (with)\n\n type GitOptionsParser\n = Init\n | Log LogOptions -- ...\n\n type alias LogOptions =\n { maybeAuthorPattern : Maybe String\n , maybeNumberToDisplay : Maybe Int\n }\n\n logOptionsParser =\n OptionsParser.buildSubCommand \"log\" LogOptions\n |> with (Option.optionalKeywordArg \"author\")\n |> with\n (Option.optionalKeywordArg \"max-count\"\n |> Option.validateMapIfPresent String.toInt\n )\n |> with (Option.flag \"stat\")\n |> OptionsParser.withOptionalPositionalArg\n (Option.optionalPositionalArg \"revision range\")\n |> OptionsParser.withRestArgs\n (Option.restArgs \"rest args\")\n\n\n### User Error Message on Invalid Number of Positional Args\n\nThe User of the Command-Line Interface will get an error message if there is no\n`OptionsParser` that succeeds. And an `OptionsParser` will only succeed if\na valid number of positional arguments is passed in, as defined by these rules:\n\n - At least the number of required arguments\n - Can be any number greater than that if there are `restArgs`\n - Could be up to as many as (the number of required arguments) + (the number of optional arguments) if there are no rest args\n\n@docs with\n@docs withOptionalPositionalArg, withRestArgs\n\n@docs expectFlag\n\n\n## Mapping and Transforming\n\n@docs map\n@docs hardcoded\n\n\n## Meta-Data\n\n@docs withDescription\n\n\n## Finalizing\n\n@docs end\n\n\n## Internal\n\nThese functions are exposed for internal use and testing. They are not part of the public API.\n\n@docs getSubCommand, getUsageSpecs, tryMatch, synopsis, detailedHelp\n\n","unions":[{"name":"OptionsParser","comment":" An `OptionsParser` represents one possible way to interpret command line arguments.\nA `Cli.Program.Config` can be built up using one or more `OptionsParser`s. It will\ntry each parser in order until one succeeds. If none succeed, it will print\nan error message with information for the user of the Command-Line Interface.\n","args":["cliOptions","builderState"],"cases":[]}],"aliases":[],"values":[{"name":"build","comment":" Start an `OptionsParser` pipeline with no sub-command (see\n[the OptionsParser terminilogy legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)).\n","type":"cliOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions"},{"name":"buildSubCommand","comment":" Start an `OptionsParser` pipeline with a sub-command (see\n[the OptionsParser terminilogy legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)).\n","type":"String.String -> cliOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions"},{"name":"detailedHelp","comment":" Low-level function, for internal use.\nGenerate detailed help text with Usage line and Options section.\n","type":"Basics.Bool -> String.String -> Cli.OptionsParser.OptionsParser decodesTo builderState -> String.String"},{"name":"end","comment":" Low-level function, for internal use.\n","type":"Cli.OptionsParser.OptionsParser cliOptions builderState -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.NoMoreOptions"},{"name":"expectFlag","comment":" The `OptionsParser` will only match if the given flag is present. Often its\nbest to use a subcommand in these cases.\n","type":"String.String -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions"},{"name":"getSubCommand","comment":" Low-level function, for internal use.\n","type":"Cli.OptionsParser.OptionsParser cliOptions builderState -> Maybe.Maybe String.String"},{"name":"getUsageSpecs","comment":" Low-level function, for internal use.\n","type":"Cli.OptionsParser.OptionsParser decodesTo builderState -> List.List Cli.UsageSpec.UsageSpec"},{"name":"hardcoded","comment":" Use a fixed value for the next step in the pipeline. This doesn't use\nany input from the user, it just passes the supplied value through in the chain.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser\n import Cli.Program as Program\n\n type alias GreetOptions =\n { name : String\n , maybeGreeting : Maybe String\n , hardcodedValue : String\n }\n\n programConfig : Program.Config GreetOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build GreetOptions\n |> OptionsParser.with (Option.requiredKeywordArg \"name\")\n |> OptionsParser.with (Option.optionalKeywordArg \"greeting\")\n |> OptionsParser.hardcoded \"any hardcoded value\"\n )\n\n","type":"value -> Cli.OptionsParser.OptionsParser (value -> cliOptions) Cli.OptionsParser.BuilderState.AnyOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions"},{"name":"map","comment":" Map the CLI options returned in the `OptionsParser` using the supplied map function.\n\nThis is very handy when you want a type alias for a record with options for a\na given `OptionsParser`, but you need all of your `OptionsParser` to map into\na single union type.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser\n import Cli.Program as Program\n import Ports\n\n type CliOptions\n = Hello HelloOptions\n | Goodbye GoodbyeOptions\n\n type alias HelloOptions =\n { name : String\n , maybeHello : Maybe String\n }\n\n type alias GoodbyeOptions =\n { name : String\n , maybeGoodbye : Maybe String\n }\n\n programConfig : Program.Config CliOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.buildSubCommand \"hello\" HelloOptions\n |> OptionsParser.with (Option.requiredKeywordArg \"name\")\n |> OptionsParser.with (Option.optionalKeywordArg \"greeting\")\n |> OptionsParser.map Hello\n )\n |> Program.add\n (OptionsParser.buildSubCommand \"goodbye\" GoodbyeOptions\n |> OptionsParser.with (Option.requiredKeywordArg \"name\")\n |> OptionsParser.with (Option.optionalKeywordArg \"goodbye\")\n |> OptionsParser.map Goodbye\n )\n\n","type":"(cliOptions -> mappedCliOptions) -> Cli.OptionsParser.OptionsParser cliOptions builderState -> Cli.OptionsParser.OptionsParser mappedCliOptions builderState"},{"name":"synopsis","comment":" Low-level function, for internal use.\n","type":"Basics.Bool -> String.String -> Cli.OptionsParser.OptionsParser decodesTo builderState -> String.String"},{"name":"tryMatch","comment":" Low-level function, for internal use.\n","type":"List.List String.String -> Cli.OptionsParser.OptionsParser cliOptions builderState -> Cli.OptionsParser.MatchResult.MatchResult cliOptions"},{"name":"with","comment":" For chaining on any `Cli.Option.Option` besides a `restArg` or an `optionalPositionalArg`.\nSee the `Cli.Option` module.\n","type":"Cli.Option.Option from to { c | position : Cli.Option.BeginningOption } -> Cli.OptionsParser.OptionsParser (to -> cliOptions) Cli.OptionsParser.BuilderState.AnyOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.AnyOptions"},{"name":"withDescription","comment":" Add a description to an `OptionsParser`. This description appears in help output\nand error messages.\n\n import Cli.OptionsParser as OptionsParser exposing (OptionsParser, with)\n\n type GitCommand\n = Init\n | Clone String\n\n gitInitParser : OptionsParser GitCommand\n gitInitParser =\n OptionsParser.buildSubCommand \"init\" Init\n |> OptionsParser.withDescription \"initialize a git repository\"\n\nIn error messages, the description appears after `#` in the usage line:\n\n git init # initialize a git repository\n\nWhen using subcommand-specific help (`git init --help`), the description\nappears below the usage line.\n\n","type":"String.String -> Cli.OptionsParser.OptionsParser cliOptions anything -> Cli.OptionsParser.OptionsParser cliOptions anything"},{"name":"withOptionalPositionalArg","comment":" For chaining on `Cli.Option.optionalPositionalArg`s.\n","type":"Cli.Option.Option from to { c | position : Cli.Option.OptionalPositionalArgOption } -> Cli.OptionsParser.OptionsParser (to -> cliOptions) Cli.OptionsParser.BuilderState.AnyOptions -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.NoBeginningOptions"},{"name":"withRestArgs","comment":" For chaining on `Cli.Option.restArgs`.\n","type":"Cli.Option.Option from to { c | position : Cli.Option.RestArgsOption } -> Cli.OptionsParser.OptionsParser (to -> cliOptions) startingBuilderState -> Cli.OptionsParser.OptionsParser cliOptions Cli.OptionsParser.BuilderState.NoMoreOptions"}],"binops":[]},{"name":"Cli.OptionsParser.BuilderState","comment":" A BuilderState is used to ensure that no ambiguous OptionsParsers are built.\nFor example, if you were to build an OptionsParser that had optional positional\narguments after required positional arguments, it would be ambiguous.\n\n```bash\ngreet [name1][name2] [farewell]\n\ngreet Hi Hello Goodbye\n```\n\nShould `\"Goodbye\"` be set as `[name1]` or `[farewell]`? You could certainly come\nup with some rules, but they're not obvious, and you'd have to think really hard!\nSo we just completely eliminate those confusing corner cases by making it impossible\nto express!\n\nThe `BuilderState` guarantees that nothing will come after rest args (i.e. `[args]...`,\nor 0 or more args that you get as a `List` of values).\nAnd it also guarantees that Optional Positional Arguments will come after everything\nbut rest args.\n\nIf you're interested in the low-level details of how this Elm type trick is done,\ntake a look at\n[this article on Phantom Types](https://medium.com/@ckoster22/advanced-types-in-elm-phantom-types-808044c5946d).\n\n@docs AnyOptions, NoBeginningOptions, NoMoreOptions\n\n","unions":[{"name":"AnyOptions","comment":" A state where you can add any options (beginning, middle, or terminal)\n","args":[],"cases":[]},{"name":"NoBeginningOptions","comment":" A state where you can add anything but beginning options (i.e. middle or terminal)\n","args":[],"cases":[]},{"name":"NoMoreOptions","comment":" A state where you can no longer add any options\n","args":[],"cases":[]}],"aliases":[],"values":[],"binops":[]},{"name":"Cli.Program","comment":"\n\n\n## Building a Config\n\nA `Cli.Program.Config` is created with `Cli.Program.config`. Then `OptionsParser`s are added\nto it with `Cli.Program.add`. Finally, you create a `Cli.Program.StatelessProgram`\nusing `stateless` or a `Cli.Program.StatefulProgram` using `stateful`.\n\n import Cli.Option as Option\n import Cli.OptionsParser as OptionsParser\n import Cli.Program as Program\n import Ports\n\n programConfig : Program.Config GreetOptions\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build GreetOptions\n |> OptionsParser.with (Option.requiredKeywordArg \"name\")\n |> OptionsParser.with (Option.optionalKeywordArg \"greeting\")\n )\n\n type alias GreetOptions =\n { name : String\n , maybeGreeting : Maybe String\n }\n\n init : Flags -> GreetOptions -> Cmd Never\n init flags { name, maybeGreeting } =\n maybeGreeting\n |> Maybe.withDefault \"Hello\"\n |> (\\greeting -> greeting ++ \" \" ++ name ++ \"!\")\n |> Ports.print\n\n type alias Flags =\n Program.FlagsIncludingArgv {}\n\n main : Program.StatelessProgram Never\n main =\n Program.stateless\n { printAndExitFailure = Ports.printAndExitFailure\n , printAndExitSuccess = Ports.printAndExitSuccess\n , init = init\n , config = programConfig\n }\n\nSee the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) for some end-to-end examples.\n\n@docs config, Config, add\n\n\n## `Program`s\n\n@docs stateless, ProgramOptions, stateful, StatefulOptions\n@docs StatelessProgram, StatefulProgram\n@docs FlagsIncludingArgv\n@docs mapConfig\n\n\n## Low-Level / Testing\n\n@docs run, RunResult, ExitStatus, ColorMode\n\n","unions":[{"name":"ColorMode","comment":" Control whether ANSI color codes are included in output.\n\n - `WithColor` - Include ANSI color codes for styled terminal output\n - `WithoutColor` - Plain text output without any ANSI codes\n\nUsed with `run` for testing, and internally by the CLI infrastructure.\n\n","args":[],"cases":[["WithColor",[]],["WithoutColor",[]]]},{"name":"Config","comment":" A `Cli.Program.Config` is used to build up a set of `OptionsParser`s for your\nCommand-Line Interface, as well as its meta-data such as version number.\n","args":["msg"],"cases":[]},{"name":"ExitStatus","comment":" Exit status for CLI programs. `Failure` means exit code 1, `Success` means exit code 0.\n","args":[],"cases":[["Success",[]],["Failure",[]]]},{"name":"RunResult","comment":" The result of running the CLI parser. Useful for testing.\n\n - `SystemMessage exitStatus message` - A system message (help, version, or error) with exit status\n - `CustomMatch match` - Successfully matched and parsed the CLI options\n\n","args":["match"],"cases":[["SystemMessage",["Cli.Program.ExitStatus","String.String"]],["CustomMatch",["match"]]]}],"aliases":[{"name":"FlagsIncludingArgv","comment":" Flags in Cli Programs can contain any data as long as it is a record\nat the top-level which contains the required fields.\nIn other words, it must be a record of type `FlagsIncludingArgv`\n(if you aren't familiar with them, you can [read more about extensible records here](https://medium.com/@ckoster22/advanced-types-in-elm-extensible-records-67e9d804030d)).\n\nYou pass in the flags like this (see the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) folder for more):\n\n```javascript\n#!/usr/bin/env node\n\nconst useColor = process.stdout.isTTY && !process.env.NO_COLOR;\n\nlet program = require(\"./elm.js\").Elm.Main.init({\n flags: {\n argv: process.argv,\n versionMessage: \"1.2.3\",\n colorMode: useColor\n }\n});\n```\n\n","args":["flagsRecord"],"type":"{ flagsRecord | argv : List.List String.String, versionMessage : String.String, colorMode : Basics.Bool }"},{"name":"ProgramOptions","comment":" Configuration for a stateless CLI program. Pass this record to [`stateless`](#stateless).\n\nStateless programs run once and exit - there is no persistent model or update loop.\nYour `init` receives the parsed CLI options and returns a `Cmd` that performs the\nprogram's work, then the program is done.\n\n - `printAndExitFailure` - Port to print a message and exit with a non-zero status code\n - `printAndExitSuccess` - Port to print a message and exit with status code 0\n - `init` - Receives parsed CLI options and returns a `Cmd` to perform the program's work\n - `config` - The CLI configuration built with [`config`](#config) and [`add`](#add)\n\n","args":["decodesTo","options","flags"],"type":"{ printAndExitFailure : String.String -> Platform.Cmd.Cmd decodesTo, printAndExitSuccess : String.String -> Platform.Cmd.Cmd decodesTo, init : Cli.Program.FlagsIncludingArgv flags -> options -> Platform.Cmd.Cmd decodesTo, config : Cli.Program.Config options }"},{"name":"StatefulOptions","comment":" Configuration for a stateful CLI program. Pass this record to [`stateful`](#stateful).\n\nStateful programs work like standard Elm programs with a model, update loop, and\nsubscriptions. Use this when your CLI needs to wait for responses (e.g., HTTP requests)\nor maintain state across multiple events. The parsed CLI options are passed to both\n`init` and `update`.\n\n - `printAndExitFailure` - Port to print a message and exit with a non-zero status code\n - `printAndExitSuccess` - Port to print a message and exit with status code 0\n - `init` - Initialize your model with the parsed CLI options\n - `update` - Handle messages and update your model (also receives CLI options)\n - `subscriptions` - Subscribe to external events\n - `config` - The CLI configuration built with [`config`](#config) and [`add`](#add)\n\n","args":["msg","model","cliOptions","flags"],"type":"{ printAndExitFailure : String.String -> Platform.Cmd.Cmd msg, printAndExitSuccess : String.String -> Platform.Cmd.Cmd msg, init : Cli.Program.FlagsIncludingArgv flags -> cliOptions -> ( model, Platform.Cmd.Cmd msg ), update : cliOptions -> msg -> model -> ( model, Platform.Cmd.Cmd msg ), subscriptions : cliOptions -> model -> Platform.Sub.Sub msg, config : Cli.Program.Config cliOptions }"},{"name":"StatefulProgram","comment":" A program with a model and update loop. Use with `stateful`.\n","args":["model","msg","cliOptions","flags"],"type":"Platform.Program (Cli.Program.FlagsIncludingArgv flags) (Cli.Program.StatefulProgramModel model cliOptions) msg"},{"name":"StatelessProgram","comment":" A program that processes arguments and exits. Use with `stateless`.\n","args":["msg","flags"],"type":"Platform.Program (Cli.Program.FlagsIncludingArgv flags) () msg"}],"values":[{"name":"add","comment":" Add an `OptionsParser` to your `Cli.Program.Config`.\n","type":"Cli.OptionsParser.OptionsParser msg anything -> Cli.Program.Config msg -> Cli.Program.Config msg"},{"name":"config","comment":" Create a `Config` with no `OptionsParser`s. Use `Cli.Program.add` to add\n`OptionsParser`s.\n","type":"Cli.Program.Config decodesTo"},{"name":"mapConfig","comment":" Transform the return type for all of the registered `OptionsParser`'s in the `Config`.\n","type":"(a -> b) -> Cli.Program.Config a -> Cli.Program.Config b"},{"name":"run","comment":" Run the CLI parser directly and get back a `RunResult`. This is useful for testing\nyour CLI configuration without needing to set up the full Platform.Program infrastructure.\n\n import Cli.Program as Program\n\n -- Test that missing required arg shows error (use WithoutColor for tests)\n case Program.run myConfig [ \"node\", \"myprog\" ] \"1.0.0\" Program.WithoutColor of\n Program.SystemMessage Program.Failure message ->\n -- Assert on the error message\n String.contains \"Missing\" message\n\n _ ->\n False\n\nNote: `argv` should include the node path and script path as the first two elements,\njust like `process.argv` in Node.js.\n\n","type":"Cli.Program.Config msg -> List.List String.String -> String.String -> Cli.Program.ColorMode -> Cli.Program.RunResult msg"},{"name":"stateful","comment":" A `stateful` program can have a model that it creates and updates via `init`\nand `update`. It also has `subscriptions`. See\n[the `Curl.elm` example](https://github.com/dillonkearns/elm-cli-options-parser/blob/master/examples/src/Curl.elm).\n","type":"Cli.Program.StatefulOptions msg model cliOptions flags -> Platform.Program (Cli.Program.FlagsIncludingArgv flags) (Cli.Program.StatefulProgramModel model cliOptions) msg"},{"name":"stateless","comment":" Create a CLI that processes arguments and exits immediately.\nUse `stateful` instead if you need to perform `Cmd`s (HTTP, etc.).\n","type":"Cli.Program.ProgramOptions msg options flags -> Cli.Program.StatelessProgram msg flags"}],"binops":[]},{"name":"Cli.Validate","comment":" This module contains helper functions for performing validations (see the\n\"validate...\" functions in `Cli.Option`).\n\n@docs predicate, ValidationResult, regex, regexWithMessage\n\n","unions":[{"name":"ValidationResult","comment":" Used with [`Option.validate`](Cli-Option#validate) to check a parsed value.\n\n Option.requiredKeywordArg \"name\"\n |> Option.validate\n (\\name ->\n if String.length name >= 2 then\n Validate.Valid\n\n else\n Validate.Invalid \"Name must be at least 2 characters\"\n )\n\n","args":[],"cases":[["Valid",[]],["Invalid",["String.String"]]]}],"aliases":[],"values":[{"name":"predicate","comment":" Turns a predicate function into a validate function.\n\n import Cli.Option as Option\n import Cli.Validate as Validate\n\n isEven : Int -> Bool\n isEven n =\n modBy 2 n == 0\n\n pairsOption : Option.Option (Maybe String) (Maybe Int)\n pairsOption =\n Option.optionalKeywordArg \"pair-programmers\"\n |> Option.validateMapIfPresent String.toInt\n |> Option.validateIfPresent\n (Validate.predicate \"Must be even\" isEven)\n\n","type":"String.String -> (a -> Basics.Bool) -> a -> Cli.Validate.ValidationResult"},{"name":"regex","comment":" A helper for regex validations.\n\n programConfig : Program.Config String\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build identity\n |> OptionsParser.with\n (Option.requiredKeywordArg \"name\"\n |> Option.validate\n (Cli.Validate.regex \"^[A-Z][A-Za-z_]*\")\n )\n )\n\nIf the validation fails, the user gets output like this:\n\n```shell\n$ ./greet --name john\nValidation errors:\n\n`name` failed a validation. Must be of form /^[A-Z][A-Za-z_]*/\nValue was:\n\"john\"\n```\n\n","type":"String.String -> String.String -> Cli.Validate.ValidationResult"},{"name":"regexWithMessage","comment":" A helper for regex validations with an additional message.\n\n programConfig : Program.Config String\n programConfig =\n Program.config\n |> Program.add\n (OptionsParser.build identity\n |> OptionsParser.with\n (Option.requiredKeywordArg \"name\"\n |> Option.validate\n (Cli.Validate.regexWithMessage \"I expected this to be\" \"^[A-Z][A-Za-z_]*\")\n )\n )\n\nIf the validation fails, the user gets output like this:\n\n```shell\n$ ./greet --name john\nValidation errors:\n\n`name` failed a validation. I expected this to be matching \"^[A-Z][A-Za-z_]*\" but got 'john'\nValue was:\n\"john\"\n```\n\n","type":"String.String -> String.String -> String.String -> Cli.Validate.ValidationResult"}],"binops":[]}] \ No newline at end of file diff --git a/elm.json b/elm.json index c119204..4005c80 100644 --- a/elm.json +++ b/elm.json @@ -1,7 +1,7 @@ { "type": "package", "name": "dillonkearns/elm-cli-options-parser", - "summary": "Type-safe command line options parsing.", + "summary": "Type-safe command line options parsing with JSON schema generation.", "license": "BSD-3-Clause", "version": "4.0.0", "exposed-modules": [ @@ -9,11 +9,14 @@ "Cli.Option", "Cli.OptionsParser", "Cli.Validate", - "Cli.OptionsParser.BuilderState" + "Cli.OptionsParser.BuilderState", + "Cli.Option.Typed" ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { + "dillonkearns/elm-ts-json": "2.1.2 <= v < 3.0.0", "elm/core": "1.0.0 <= v < 2.0.0", + "elm/json": "1.1.3 <= v < 2.0.0", "elm/regex": "1.0.0 <= v < 2.0.0", "elmcraft/core-extra": "2.2.0 <= v < 3.0.0", "wolfadex/elm-ansi": "3.0.0 <= v < 4.0.0" diff --git a/examples/elm.json b/examples/elm.json index 76934be..27421e3 100644 --- a/examples/elm.json +++ b/examples/elm.json @@ -7,20 +7,22 @@ "elm-version": "0.19.1", "dependencies": { "direct": { + "dillonkearns/elm-ts-json": "2.1.2", "elm/browser": "1.0.2", "elm/core": "1.0.5", "elm/html": "1.0.1", "elm/http": "1.0.0", + "elm/json": "1.1.4", "elm/regex": "1.0.0", - "elm-community/list-extra": "8.3.1", + "elmcraft/core-extra": "2.3.0", "wolfadex/elm-ansi": "3.0.1" }, "indirect": { "avh4/elm-color": "1.0.0", - "elm/json": "1.1.4", "elm/time": "1.0.0", "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.5" + "elm/virtual-dom": "1.0.5", + "elm-community/dict-extra": "2.4.0" } }, "test-dependencies": { diff --git a/examples/src/TypedGreet.elm b/examples/src/TypedGreet.elm new file mode 100644 index 0000000..2a256b3 --- /dev/null +++ b/examples/src/TypedGreet.elm @@ -0,0 +1,69 @@ +module TypedGreet exposing (main) + +{-| A simple example using `Cli.Option.Typed` for typed options with JSON schema support. + +This is the typed equivalent of the `Simple.elm` example. The key difference is +that each option specifies its type via a `CliDecoder`, enabling JSON schema +generation via `Program.toJsonSchema`. + +Try it: + + node -e "require('./create-cli')('TypedGreet')" -- --name "World" + + node -e "require('./create-cli')('TypedGreet')" -- --name "World" --greeting "Hi" --times 3 + +Or with JSON input: + + node -e "require('./create-cli')('TypedGreet')" -- '{"name": "World", "times": 3, "$cli": {}}' + +-} + +import Cli.Option.Typed as Option +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Ports + + +type alias GreetOptions = + { name : String + , greeting : String + , times : Int + } + + +programConfig : Program.Config GreetOptions +programConfig = + Program.config + |> Program.add + (OptionsParser.build GreetOptions + |> OptionsParser.with (Option.requiredKeywordArg "name" Option.string) + |> OptionsParser.with + (Option.optionalKeywordArg "greeting" Option.string + |> Option.withDefault "Hello" + ) + |> OptionsParser.with + (Option.optionalKeywordArg "times" Option.int + |> Option.withDefault 1 + ) + ) + + +init : Flags -> GreetOptions -> Cmd Never +init flags { name, greeting, times } = + List.repeat times (greeting ++ " " ++ name ++ "!") + |> String.join "\n" + |> Ports.print + + +type alias Flags = + Program.FlagsIncludingArgv {} + + +main : Program.StatelessProgram Never {} +main = + Program.stateless + { printAndExitFailure = Ports.printAndExitFailure + , printAndExitSuccess = Ports.printAndExitSuccess + , init = init + , config = programConfig + } diff --git a/snapshot-tests/elm.json b/snapshot-tests/elm.json index a0aec81..045b281 100644 --- a/snapshot-tests/elm.json +++ b/snapshot-tests/elm.json @@ -9,10 +9,12 @@ "direct": { "dillonkearns/elm-pages": "10.3.0", "dillonkearns/elm-snapshot": "1.0.0", + "dillonkearns/elm-ts-json": "2.1.1", "elm/core": "1.0.5", "elm/json": "1.1.4", "elm/regex": "1.0.0", "elm-community/list-extra": "8.7.0", + "elm-explorations/test": "2.2.1", "kraklin/elm-debug-parser": "2.0.0", "lue-bird/elm-syntax-format": "1.1.14", "miniBill/elm-diff": "1.1.0", @@ -38,6 +40,7 @@ "elm/url": "1.0.0", "elm/virtual-dom": "1.0.5", "elm-community/basics-extra": "4.1.0", + "elm-community/dict-extra": "2.4.0", "elm-community/maybe-extra": "5.3.0", "elmcraft/core-extra": "2.2.0", "fredcy/elm-parseint": "2.0.1", diff --git a/src/Cli/LowLevel.elm b/src/Cli/LowLevel.elm index 5656577..66067ad 100644 --- a/src/Cli/LowLevel.elm +++ b/src/Cli/LowLevel.elm @@ -1,10 +1,12 @@ -module Cli.LowLevel exposing (MatchResult(..), detailedHelpText, helpText, try) +module Cli.LowLevel exposing (MatchResult(..), detailedHelpText, helpText, try, tryJson) import Cli.ColorMode exposing (ColorMode, useColor) import Cli.Decode import Cli.OptionsParser as OptionsParser exposing (OptionsParser) import Cli.OptionsParser.BuilderState as BuilderState import Cli.OptionsParser.MatchResult as MatchResult exposing (NoMatchReason(..)) +import Internal.OptionsParser as OPInternal +import Json.Decode import List.Extra import Set exposing (Set) @@ -88,65 +90,7 @@ try optionsParsers argv = -- 2. All other reasons (deduplicated) aggregatedReasons : List MatchResult.NoMatchReason aggregatedReasons = - let - -- Extract UnexpectedOption strings and find the common ones (truly unknown) - commonUnexpectedOptions : Set String - commonUnexpectedOptions = - matchResults - |> List.map - (\matchResult -> - case matchResult of - MatchResult.NoMatch reasons -> - reasons - |> List.filterMap - (\reason -> - case reason of - UnexpectedOption name -> - Just name - - _ -> - Nothing - ) - |> Set.fromList - - _ -> - Set.empty - ) - |> intersection - - -- Collect all NoMatchReasons from all parsers - allNoMatchReasons : List MatchResult.NoMatchReason - allNoMatchReasons = - matchResults - |> List.concatMap - (\matchResult -> - case matchResult of - MatchResult.NoMatch reasons -> - reasons - - _ -> - [] - ) - - unexpectedOptionReasons = - commonUnexpectedOptions - |> Set.toList - |> List.map UnexpectedOption - - otherReasons = - allNoMatchReasons - |> List.filter - (\reason -> - case reason of - UnexpectedOption _ -> - False - - _ -> - True - ) - |> uniqueReasons - in - unexpectedOptionReasons ++ otherReasons + aggregateNoMatchReasons matchResults in matchResults |> List.map MatchResult.matchResultToMaybe @@ -226,6 +170,67 @@ reasonToKey reason = "ExtraOperand" +aggregateNoMatchReasons : List (MatchResult.MatchResult a) -> List MatchResult.NoMatchReason +aggregateNoMatchReasons matchResults = + let + commonUnexpectedOptions : Set String + commonUnexpectedOptions = + matchResults + |> List.map + (\matchResult -> + case matchResult of + MatchResult.NoMatch reasons -> + reasons + |> List.filterMap + (\reason -> + case reason of + UnexpectedOption name -> + Just name + + _ -> + Nothing + ) + |> Set.fromList + + _ -> + Set.empty + ) + |> intersection + + allNoMatchReasons : List MatchResult.NoMatchReason + allNoMatchReasons = + matchResults + |> List.concatMap + (\matchResult -> + case matchResult of + MatchResult.NoMatch reasons -> + reasons + + _ -> + [] + ) + + unexpectedOptionReasons = + commonUnexpectedOptions + |> Set.toList + |> List.map UnexpectedOption + + otherReasons = + allNoMatchReasons + |> List.filter + (\reason -> + case reason of + UnexpectedOption _ -> + False + + _ -> + True + ) + |> uniqueReasons + in + unexpectedOptionReasons ++ otherReasons + + helpParser : OptionsParser (MatchResult msg) BuilderState.AnyOptions helpParser = OptionsParser.build ShowHelp @@ -266,3 +271,31 @@ detailedHelpText colorMode programName optionsParsers = optionsParsers |> List.map (OptionsParser.detailedHelp (useColor colorMode) programName) |> String.join "\n\n" + + +{-| Try to match a JSON blob against a list of OptionsParsers using direct JSON decoding. +No lossy argv translation — each parser's jsonGrabber decodes directly from the JSON value. +-} +tryJson : List (OptionsParser.OptionsParser msg builderState) -> Json.Decode.Value -> MatchResult msg +tryJson optionsParsers blob = + let + matchResults = + optionsParsers + |> List.map (OPInternal.tryMatchJson blob) + in + matchResults + |> List.map MatchResult.matchResultToMaybe + |> oneOf + |> (\maybeResult -> + case maybeResult of + Just result -> + case result of + Ok msg -> + Match msg + + Err validationErrors -> + ValidationErrors validationErrors + + Nothing -> + NoMatch (aggregateNoMatchReasons matchResults) + ) diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 4da56bc..0f2a408 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -10,7 +10,15 @@ module Cli.Option exposing , Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption ) -{-| Here is the terminology used for building up Command-Line parsers with this library. +{-| Build command-line options as string values, with validation and transformation. + +This module treats all CLI input as strings. Use [`validateMap`](#validateMap) to parse +strings into typed values, [`oneOf`](#oneOf) for enumerated values, and +[`validate`](#validate) for custom validation. + +For typed options with JSON schema generation, see [`Cli.Option.Typed`](Cli-Option-Typed). + +Here is the terminology used for building up Command-Line parsers with this library. ![Terminology Legend](https://raw.githubusercontent.com/dillonkearns/elm-cli-options-parser/master/terminology.png) @@ -115,9 +123,11 @@ import Cli.Decode import Cli.Option.Internal as Internal exposing (Option(..)) import Cli.UsageSpec as UsageSpec exposing (UsageSpec) import Cli.Validate as Validate +import Json.Decode import List.Extra import Occurences exposing (Occurences(..)) -import Tokenizer +import TsJson.Decode as TsDecode +import TsJson.Type {-| The type returned by the builder functions below. Use with `OptionsParser.with`. @@ -159,6 +169,9 @@ in the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/ validate : (to -> Validate.ValidationResult) -> Option from to builderState -> Option from to builderState validate validateFunction (Option option) = let + optionName = + UsageSpec.name option.usageSpec + mappedDecoder : Cli.Decode.Decoder from to mappedDecoder = option.decoder @@ -170,14 +183,29 @@ validate validateFunction (Option option) = Validate.Invalid invalidReason -> Just - { name = UsageSpec.name option.usageSpec + { name = optionName , invalidReason = invalidReason } ) + + mappedJsonGrabber : Internal.JsonGrabber to + mappedJsonGrabber = + \blob -> + option.jsonGrabber blob + |> Result.map + (\( errors, value ) -> + case validateFunction value of + Validate.Valid -> + ( errors, value ) + + Validate.Invalid invalidReason -> + ( errors ++ [ { name = optionName, invalidReason = invalidReason } ], value ) + ) in Option { option | decoder = mappedDecoder + , jsonGrabber = mappedJsonGrabber } @@ -209,25 +237,15 @@ Parses to: `"src/Main.elm"` requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } requiredPositionalArg operandDescription = buildRequiredOption - (\{ operands, operandsSoFar } -> - case - operands - |> List.Extra.getAt operandsSoFar - of - Just operandValue -> - Ok operandValue - - Nothing -> - Cli.Decode.MatchError - (Cli.Decode.MissingRequiredPositionalArg - { name = operandDescription - , operandsSoFar = operandsSoFar - , customMessage = Nothing - } - ) - |> Err - ) + (Internal.requiredPositionalArgGrabber operandDescription) (UsageSpec.operand operandDescription) + (TsDecode.tsType TsDecode.string) + (Internal.jsonFieldGrabber operandDescription + Json.Decode.string + (Cli.Decode.MissingRequiredPositionalArg + { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } + ) + ) {-| A keyword argument that may be omitted. @@ -241,24 +259,10 @@ Parses to: `Just "main.js"` (or `Nothing` if omitted) optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption } optionalKeywordArg optionName = buildOptionalOption - (\{ options } -> - case - options - |> List.Extra.find - (\(Tokenizer.ParsedOption thisOptionName _) -> thisOptionName == optionName) - of - Nothing -> - Ok Nothing - - Just (Tokenizer.ParsedOption _ (Tokenizer.KeywordArg optionArg)) -> - Ok (Just optionArg) - - _ -> - Cli.Decode.MatchError - (Cli.Decode.KeywordArgMissingValue { name = optionName }) - |> Err - ) + (Internal.optionalKeywordArgGrabber optionName) (UsageSpec.keywordArg optionName Optional) + (TsDecode.tsType TsDecode.string) + (Internal.jsonOptionalFieldGrabber optionName Json.Decode.string) {-| A keyword argument that must be provided. @@ -272,26 +276,13 @@ Parses to: `"my-app"` requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } requiredKeywordArg optionName = buildRequiredOption - (\{ options } -> - case - options - |> List.Extra.find - (\(Tokenizer.ParsedOption thisOptionName _) -> thisOptionName == optionName) - of - Nothing -> - Cli.Decode.MatchError - (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) - |> Err - - Just (Tokenizer.ParsedOption _ (Tokenizer.KeywordArg optionArg)) -> - Ok optionArg - - _ -> - Cli.Decode.MatchError - (Cli.Decode.KeywordArgMissingValue { name = optionName }) - |> Err - ) + (Internal.requiredKeywordArgGrabber optionName) (UsageSpec.keywordArg optionName Required) + (TsDecode.tsType TsDecode.string) + (Internal.jsonFieldGrabber optionName + Json.Decode.string + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + ) {-| A flag with no argument. @@ -305,63 +296,54 @@ Parses to: `True` (or `False` if omitted) flag : String -> Option Bool Bool { position : BeginningOption } flag flagName = buildOptionalOption - (\{ options } -> - if - options - |> List.member (Tokenizer.ParsedOption flagName Tokenizer.Flag) - then - Ok True - - else - Ok False - ) + (Internal.flagGrabber flagName) (UsageSpec.flag flagName Optional) + (TsDecode.tsType TsDecode.bool) + (Internal.jsonFlagGrabber flagName) {-| Build an option for required arguments (has canAddMissingMessage capability). -} -buildRequiredOption : Internal.DataGrabber a -> UsageSpec -> Option a a { position : BeginningOption, canAddMissingMessage : () } -buildRequiredOption dataGrabber usageSpec = +buildRequiredOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption, canAddMissingMessage : () } +buildRequiredOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder - , meta = emptyMeta + , meta = Internal.emptyMeta + , tsType = tsType + , jsonGrabber = jsonGrabber } {-| Build an option for optional arguments (no canAddMissingMessage capability). -} -buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> Option a a { position : BeginningOption } -buildOptionalOption dataGrabber usageSpec = +buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption } +buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder - , meta = emptyMeta + , meta = Internal.emptyMeta + , tsType = tsType + , jsonGrabber = jsonGrabber } {-| Build an ending option (like restArgs, optionalPositionalArg). -} -buildEndingOption : Internal.DataGrabber a -> UsageSpec -> Option a a { position : position } -buildEndingOption dataGrabber usageSpec = +buildEndingOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : position } +buildEndingOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder - , meta = emptyMeta + , meta = Internal.emptyMeta + , tsType = tsType + , jsonGrabber = jsonGrabber } -{-| Default empty metadata. --} -emptyMeta : Internal.OptionMeta -emptyMeta = - { missingMessage = Nothing - } - - {-| Add a description to an option. This will be shown in help text. Option.requiredKeywordArg "name" @@ -411,6 +393,10 @@ withMissingMessage message (Option option) = \context -> option.dataGrabber context |> Result.mapError (addCustomMessageToError message) + , jsonGrabber = + \blob -> + option.jsonGrabber blob + |> Result.mapError (addCustomMessageToError message) , meta = { missingMessage = Just message } @@ -444,41 +430,34 @@ addCustomMessageToMatchError message detail = other -{-| Transform an `Option`. For example, you may want to map an option from the -raw `String` that comes from the command line into a `Regex`, as in this code snippet. +{-| Transform an option's value. Use this for infallible transformations. +For transformations that can fail, use [`validateMap`](#validateMap) instead +so the user gets a helpful error message. - import Cli.Option as Option - import Cli.OptionsParser as OptionsParser - import Cli.Program as Program - import Regex exposing (Regex) + Option.requiredKeywordArg "name" + |> Option.map String.toUpper - type alias CliOptions = - { pattern : Regex } - - programConfig : Program.Config CliOptions - programConfig = - Program.config - |> Program.add - (OptionsParser.build buildCliOptions - |> OptionsParser.with - (Option.requiredPositionalArg "pattern" - |> Option.map Regex.regex - ) - ) + Option.requiredKeywordArg "output" + |> Option.map (\path -> path ++ "/index.html") -} map : (toRaw -> toMapped) -> Option from toRaw builderState -> Option from toMapped builderState map mapFn option = - updateDecoder (\decoder -> Cli.Decode.map mapFn decoder) option + updateDecoder + (\decoder -> Cli.Decode.map mapFn decoder) + (\grabber -> \blob -> grabber blob |> Result.map (Tuple.mapSecond mapFn)) + option -updateDecoder : (Cli.Decode.Decoder from to -> Cli.Decode.Decoder from toNew) -> Option from to builderState -> Option from toNew builderState -updateDecoder mappedDecoder (Option { dataGrabber, usageSpec, decoder, meta }) = +updateDecoder : (Cli.Decode.Decoder from to -> Cli.Decode.Decoder from toNew) -> (Internal.JsonGrabber to -> Internal.JsonGrabber toNew) -> Option from to builderState -> Option from toNew builderState +updateDecoder mappedDecoder jsonGrabberMapper (Option { dataGrabber, usageSpec, decoder, meta, tsType, jsonGrabber }) = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = mappedDecoder decoder , meta = meta + , tsType = tsType + , jsonGrabber = jsonGrabberMapper jsonGrabber } @@ -608,6 +587,7 @@ oneOf list (Option option) = |> List.map (\( name, _ ) -> name) ) option.usageSpec + , tsType = TsDecode.tsType (TsDecode.stringUnion list) } ) @@ -623,6 +603,10 @@ in the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/ -} validateMap : (to -> Result String toMapped) -> Option from to builderState -> Option from toMapped builderState validateMap mapFn ((Option optionRecord) as option) = + let + optionName = + UsageSpec.name optionRecord.usageSpec + in updateDecoder (\decoder -> Cli.Decode.mapProcessingError @@ -633,13 +617,31 @@ validateMap mapFn ((Option optionRecord) as option) = Err invalidReason -> Cli.Decode.UnrecoverableValidationError - { name = UsageSpec.name optionRecord.usageSpec + { name = optionName , invalidReason = invalidReason } |> Err ) decoder ) + (\grabber -> + \blob -> + grabber blob + |> Result.andThen + (\( errors, value ) -> + case mapFn value of + Ok mappedValue -> + Ok ( errors, mappedValue ) + + Err invalidReason -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = invalidReason + } + ) + ) + ) option @@ -665,7 +667,14 @@ validateMapIfPresent mapFn cliSpec = cliSpec -{-| Provide a default value for the `Option`. +{-| Provide a default value for an optional `Option`. Turns a `Maybe value` +into a plain `value`. + + Option.optionalKeywordArg "greeting" + |> Option.withDefault "Hello" + +If `--greeting` is omitted, the option's value will be `"Hello"` instead of `Nothing`. + -} withDefault : to -> Option from (Maybe to) builderState -> Option from to builderState withDefault defaultValue option = @@ -675,6 +684,7 @@ withDefault defaultValue option = (Maybe.withDefault defaultValue) decoder ) + (\grabber -> \blob -> grabber blob |> Result.map (Tuple.mapSecond (Maybe.withDefault defaultValue))) option @@ -689,56 +699,47 @@ Parses to: `["Auth: token", "Accept: json"]` keywordArgList : String -> Option (List String) (List String) { position : BeginningOption } keywordArgList flagName = buildOptionalOption - (\{ options } -> - options - |> List.filterMap - (\(Tokenizer.ParsedOption optionName optionKind) -> - case ( optionName == flagName, optionKind ) of - ( False, _ ) -> - Nothing + (Internal.keywordArgListGrabber flagName) + (UsageSpec.keywordArg flagName ZeroOrMore) + (TsDecode.tsType (TsDecode.list TsDecode.string)) + (Internal.jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) - ( True, Tokenizer.KeywordArg optionValue ) -> - Just optionValue - ( True, _ ) -> - -- TODO this should probably be an error - Nothing - ) - |> Ok - ) - (UsageSpec.keywordArg flagName ZeroOrMore) +{-| An optional positional argument. +Must be used with [`OptionsParser.withOptionalPositionalArg`](Cli-OptionsParser#withOptionalPositionalArg) +(not `OptionsParser.with`). + +Example: `` in `git log []` +Parses to: `Just "abc123"` (or `Nothing` if omitted) + + Option.optionalPositionalArg "revision" -{-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. -} optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption } optionalPositionalArg operandDescription = buildEndingOption - (\flagsAndOperands -> - let - operandsSoFar : Int - operandsSoFar = - UsageSpec.operandCount flagsAndOperands.usageSpecs - - 1 - - maybeArg : Maybe String - maybeArg = - flagsAndOperands.operands - |> List.Extra.getAt operandsSoFar - in - Ok maybeArg - ) + Internal.optionalPositionalArgGrabber (UsageSpec.optionalPositionalArg operandDescription) + (TsDecode.tsType TsDecode.string) + (Internal.jsonOptionalFieldGrabber operandDescription Json.Decode.string) + +{-| Collect all remaining positional arguments as a list. + +Must be used with [`OptionsParser.withRestArgs`](Cli-OptionsParser#withRestArgs) +(not `OptionsParser.with`), and must be the last option in the pipeline. + +Example: `...` in `elm-test [...]` +Parses to: `["tests/First.elm", "tests/Second.elm"]` (or `[]` if none provided) + + Option.restArgs "files" -{-| Note that this must be used with `OptionsParser.withRestArgs`. -} restArgs : String -> Option (List String) (List String) { position : RestArgsOption } restArgs restArgsDescription = buildEndingOption - (\{ operands, usageSpecs } -> - operands - |> List.drop (UsageSpec.operandCount usageSpecs) - |> Ok - ) + Internal.restArgsGrabber (UsageSpec.restArgs restArgsDescription) + (TsDecode.tsType (TsDecode.list TsDecode.string)) + (Internal.jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.string) []) diff --git a/src/Cli/Option/Internal.elm b/src/Cli/Option/Internal.elm index 759414e..8cb84ec 100644 --- a/src/Cli/Option/Internal.elm +++ b/src/Cli/Option/Internal.elm @@ -1,13 +1,29 @@ module Cli.Option.Internal exposing ( DataGrabber , InnerOption + , JsonGrabber , Option(..) , OptionMeta + , emptyMeta + , flagGrabber + , jsonFieldGrabber + , jsonFlagGrabber + , jsonOptionalFieldGrabber + , jsonOptionalFieldGrabberWithDefault + , keywordArgListGrabber + , optionalKeywordArgGrabber + , optionalPositionalArgGrabber + , requiredKeywordArgGrabber + , requiredPositionalArgGrabber + , restArgsGrabber ) import Cli.Decode -import Cli.UsageSpec exposing (UsageSpec) +import Cli.UsageSpec as UsageSpec exposing (UsageSpec) +import Json.Decode +import List.Extra import Tokenizer +import TsJson.Type type Option from to constraints @@ -19,9 +35,18 @@ type alias InnerOption from to = , usageSpec : UsageSpec , decoder : Cli.Decode.Decoder from to , meta : OptionMeta + , tsType : TsJson.Type.Type + , jsonGrabber : JsonGrabber to } +{-| Extracts a decoded value from a JSON blob for JSON input mode. +Produces the final `to` type (after all validation/mapping). +-} +type alias JsonGrabber to = + Json.Decode.Value -> Result Cli.Decode.ProcessingError ( List Cli.Decode.ValidationError, to ) + + {-| Metadata for an option that can be set via withMissingMessage. -} type alias OptionMeta = @@ -36,3 +61,206 @@ type alias DataGrabber decodesTo = , operandsSoFar : Int } -> Result Cli.Decode.ProcessingError decodesTo + + +{-| Default empty metadata. +-} +emptyMeta : OptionMeta +emptyMeta = + { missingMessage = Nothing + } + + + +-- JSON GRABBERS + + +{-| Create a jsonGrabber for a required field. Extracts the field from JSON, +or returns a MatchError if the field is absent. If the field is present but +the wrong type, returns an UnrecoverableValidationError. +-} +jsonFieldGrabber : String -> Json.Decode.Decoder a -> Cli.Decode.MatchErrorDetail -> JsonGrabber a +jsonFieldGrabber fieldName valueDecoder missingError blob = + case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of + Ok value -> + Ok ( [], value ) + + Err decodeError -> + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of + Ok _ -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = fieldName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + Err (Cli.Decode.MatchError missingError) + + +{-| Create a jsonGrabber for an optional field. Returns Nothing if absent. +-} +jsonOptionalFieldGrabber : String -> Json.Decode.Decoder a -> JsonGrabber (Maybe a) +jsonOptionalFieldGrabber fieldName valueDecoder blob = + case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of + Ok value -> + Ok ( [], Just value ) + + Err decodeError -> + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of + Ok _ -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = fieldName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + Ok ( [], Nothing ) + + +{-| Create a jsonGrabber for an optional field with a default value. +-} +jsonOptionalFieldGrabberWithDefault : String -> Json.Decode.Decoder a -> a -> JsonGrabber a +jsonOptionalFieldGrabberWithDefault fieldName valueDecoder defaultValue blob = + case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + Ok ( [], defaultValue ) + + +{-| Create a jsonGrabber for a boolean flag. Defaults to False if absent. +-} +jsonFlagGrabber : String -> JsonGrabber Bool +jsonFlagGrabber fieldName blob = + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.bool) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + Ok ( [], False ) + + + +-- DATA GRABBERS + + +{-| Extract a required keyword arg value from parsed options. +-} +requiredKeywordArgGrabber : String -> DataGrabber String +requiredKeywordArgGrabber optionName { options } = + case + options + |> List.Extra.find + (\(Tokenizer.ParsedOption thisOptionName _) -> thisOptionName == optionName) + of + Nothing -> + Cli.Decode.MatchError + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + |> Err + + Just (Tokenizer.ParsedOption _ (Tokenizer.KeywordArg optionArg)) -> + Ok optionArg + + _ -> + Cli.Decode.MatchError + (Cli.Decode.KeywordArgMissingValue { name = optionName }) + |> Err + + +{-| Extract an optional keyword arg value from parsed options. +-} +optionalKeywordArgGrabber : String -> DataGrabber (Maybe String) +optionalKeywordArgGrabber optionName { options } = + case + options + |> List.Extra.find + (\(Tokenizer.ParsedOption thisOptionName _) -> thisOptionName == optionName) + of + Nothing -> + Ok Nothing + + Just (Tokenizer.ParsedOption _ (Tokenizer.KeywordArg optionArg)) -> + Ok (Just optionArg) + + _ -> + Cli.Decode.MatchError + (Cli.Decode.KeywordArgMissingValue { name = optionName }) + |> Err + + +{-| Collect all instances of a repeated keyword arg from parsed options. +-} +keywordArgListGrabber : String -> DataGrabber (List String) +keywordArgListGrabber flagName { options } = + options + |> List.filterMap + (\(Tokenizer.ParsedOption optionName optionKind) -> + case ( optionName == flagName, optionKind ) of + ( False, _ ) -> + Nothing + + ( True, Tokenizer.KeywordArg optionValue ) -> + Just optionValue + + ( True, _ ) -> + Nothing + ) + |> Ok + + +{-| Extract a required positional arg by index. +-} +requiredPositionalArgGrabber : String -> DataGrabber String +requiredPositionalArgGrabber operandDescription { operands, operandsSoFar } = + case + operands + |> List.Extra.getAt operandsSoFar + of + Just operandValue -> + Ok operandValue + + Nothing -> + Cli.Decode.MatchError + (Cli.Decode.MissingRequiredPositionalArg + { name = operandDescription + , operandsSoFar = operandsSoFar + , customMessage = Nothing + } + ) + |> Err + + +{-| Extract an optional positional arg by index. +-} +optionalPositionalArgGrabber : DataGrabber (Maybe String) +optionalPositionalArgGrabber flagsAndOperands = + let + operandsSoFar = + UsageSpec.operandCount flagsAndOperands.usageSpecs - 1 + in + flagsAndOperands.operands + |> List.Extra.getAt operandsSoFar + |> Ok + + +{-| Check if a flag is present in parsed options. +-} +flagGrabber : String -> DataGrabber Bool +flagGrabber flagName { options } = + options + |> List.member (Tokenizer.ParsedOption flagName Tokenizer.Flag) + |> Ok + + +{-| Collect remaining positional args after the fixed ones. +-} +restArgsGrabber : DataGrabber (List String) +restArgsGrabber { operands, usageSpecs } = + operands + |> List.drop (UsageSpec.operandCount usageSpecs) + |> Ok diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm new file mode 100644 index 0000000..dc0deb3 --- /dev/null +++ b/src/Cli/Option/Typed.elm @@ -0,0 +1,744 @@ +module Cli.Option.Typed exposing + ( Option, CliDecoder + , string, int, float, customDecoder + , requiredPositionalArg + , requiredKeywordArg, optionalKeywordArg, keywordArgList + , flag + , optionalPositionalArg, restArgs + , oneOf + , validate, validateIfPresent, validateMap, validateMapIfPresent + , map, mapFlag, withDefault + , BeginningOption, OptionalPositionalArgOption, RestArgsOption + , withDescription, withDisplayName, withMissingMessage + ) + +{-| Build a command-line options parser to validate and map a CLI command into a structured Elm type. + +This is an alternative to [`Cli.Option`](Cli-Option) that is designed to +generate a JSON schema describing the valid ways to invoke the CLI command, but with more precise type information. +`Cli.Option` still generates a JSON schema, but [`Cli.Option.Typed.customDecoder`](#customDecoder) lets you pass in an +[`elm-ts-json` `Decoder`](https://package.elm-lang.org/packages/dillonkearns/elm-ts-json/latest/TsJson-Decode) +with arbitrary and fully typed JSON values, and the primitive `Option`s +like [`int`](#int) carry more precise type information instead of just `String` +in the JSON Schema output. + +The vast majority of users will use `elm-cli-options-parser` through [`elm-pages`](https://elm-pages.com/) +when they build [`elm-pages` scripts](https://elm-pages.com/docs/elm-pages-scripts). +When you define an `elm-pages` script using [`Script.withSchema`](https://package.elm-lang.org/packages/dillonkearns/elm-pages/latest/Pages-Script#withCliOptions), +you pass in an [`elm-ts-json` `Encoder`](https://package.elm-lang.org/packages/dillonkearns/elm-ts-json/latest/TsJson-Encode) +and return a matching Elm type that the script will output as JSON, +and `elm-pages introspect` will automatically show all of the type information for your +CLI options and the output JSON as part of the introspection output. + + +## When to Use `Cli.Option.Typed` + +All CLIs built with `elm-cli-options-parser` can be invoked either with traditional CLI arguments, or +with a single JSON string CLI argument, allowing for easier consumption by +LLM agents and programmatic invocation of your CLI. That, along with +the precise type information in the JSON Schema describing your CLI options, makes `Cli.Option.Typed` +a good choice for CLIs when they may be invoked programmatically or by LLM agents. + +You can use [`Cli.Option`](Cli-Option) for a slightly simpler API that +treats all values as strings if automated tool access isn't a priority for your CLI. + +Both modules produce the same `Option` type and work with the same +[`OptionsParser.with`](Cli-OptionsParser#with) pipeline, so they can be interwoven freely. + + +## Terminology + +Here is the terminology used for building up Command-Line parsers with this library. + +![Terminology Legend](https://raw.githubusercontent.com/dillonkearns/elm-cli-options-parser/master/terminology.png) + +See the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree/master/examples/src) +folder for end-to-end examples (including `TypedGreet.elm` which uses this module). + + +## Example + + import Cli.Option.Typed as Option + import Cli.OptionsParser as OptionsParser exposing (with) + import Cli.Program as Program + + type alias Options = + { name : String + , count : Int + , verbose : Bool + } + + programConfig : Program.Config Options + programConfig = + Program.config + |> Program.add + (OptionsParser.build Options + |> with + (Option.requiredKeywordArg + "name" + Option.string + ) + |> with + (Option.requiredKeywordArg + "count" + Option.int + ) + |> with + (Option.flag + "verbose" + ) + ) + +This parser handles both CLI and JSON input: + + - **CLI**: `mytool --name hello --count 3 --verbose` + - **JSON**: `{ "name": "hello", "count": 3, "verbose": true, "$cli": {} }` + +And `Program.toJsonSchema "mytool" programConfig` generates a JSON Schema with +proper types (`"type": "string"`, `"type": "integer"`, etc.). + + +## Types + +@docs Option, CliDecoder + + +## Decoders + +@docs string, int, float, customDecoder + + +## Positional Arguments + +@docs requiredPositionalArg + + +## Keyword Arguments + +@docs requiredKeywordArg, optionalKeywordArg, keywordArgList + + +## Flags + +@docs flag + + +## Ending Options + +These must be added with their corresponding `OptionsParser.with...` function, +not the regular `OptionsParser.with`. See the [`Cli.OptionsParser.BuilderState`](Cli-OptionsParser-BuilderState) +docs for why. + +@docs optionalPositionalArg, restArgs + + +## Mutually Exclusive Values + +@docs oneOf + + +## Validation + +Validations allow you to guarantee that if you receive the data in Elm, it +meets a set of preconditions. If it doesn't, the user will see an error message +describing the validation error, which option it came from, and the value the +option had. + +Note that failing a validation will not cause the next `OptionsParser` in +your `Cli.Program.Config` to be run. Instead, +if the OptionsParser is a match except for validation errors, you will get an +error message regardless. + +Example: + + + capitalizedNameRegex : String + capitalizedNameRegex = + "[A-Z][A-Za-z]*" + + validateParser : OptionsParser.OptionsParser ( String, Maybe Int ) BuilderState.NoMoreOptions + validateParser = + OptionsParser.build (\a b -> ( a, b )) + |> OptionsParser.with + (Option.requiredKeywordArg "name" Option.string + |> Option.validate (Cli.Validate.regex capitalizedNameRegex) + ) + |> OptionsParser.with + (Option.optionalKeywordArg "age" Option.int) + + {- + $ ./validation --name Mozart --age 262 + Mozart is 262 years old + + $ ./validation --name mozart + Validation errors: + + `name` failed a validation. Must be of form /[A-Z][A-Za-z]*/ + Value was: + "mozart" + -} + +See [`Cli.Validate`](Cli-Validate) for some validation helpers that can be used +in conjunction with the following functions. + +@docs validate, validateIfPresent, validateMap, validateMapIfPresent + + +## Mapping and Defaults + +@docs map, mapFlag, withDefault + + +## Builder Position Types + +@docs BeginningOption, OptionalPositionalArgOption, RestArgsOption + + +## Metadata + +@docs withDescription, withDisplayName, withMissingMessage + +-} + +import Cli.Decode +import Cli.Option exposing (BeginningOption, OptionalPositionalArgOption, RestArgsOption) +import Cli.Option.Internal as Internal exposing (Option(..)) +import Cli.UsageSpec as UsageSpec +import Cli.Validate +import Json.Decode +import Occurences exposing (Occurences(..)) +import TsJson.Decode as TsDecode + + +{-| The type for an option in the pipeline. Use with +[`OptionsParser.with`](Cli-OptionsParser#with). +-} +type alias Option from to builderState = + Internal.Option from to builderState + + +{-| Phantom type marker for options that can be used with +[`OptionsParser.with`](Cli-OptionsParser#with). Most option constructors +produce this type. +-} +type alias BeginningOption = + Cli.Option.BeginningOption + + +{-| Phantom type marker for optional positional args. Must be used with +[`OptionsParser.withOptionalPositionalArg`](Cli-OptionsParser#withOptionalPositionalArg). +-} +type alias OptionalPositionalArgOption = + Cli.Option.OptionalPositionalArgOption + + +{-| Phantom type marker for rest args. Must be used with +[`OptionsParser.withRestArgs`](Cli-OptionsParser#withRestArgs). +-} +type alias RestArgsOption = + Cli.Option.RestArgsOption + + +{-| A decoder that knows how to parse values from both CLI args and JSON input. + +Use `string`, `int`, `float` for primitives, or `customDecoder` for +custom types (objects, arrays, etc.) where the CLI input is a JSON string. + +-} +type CliDecoder value + = CliDecoder + { cliParser : String -> String -> Result Cli.Decode.ProcessingError value + , jsonDecoder : Json.Decode.Decoder value + , tsDecoder : TsDecode.Decoder value + } + + + +-- Decoders + + +{-| A string value. In CLI mode, the raw string is passed through as-is. +In JSON mode, a JSON string field is decoded. + + Option.requiredKeywordArg "name" Option.string + -- CLI: --name hello → "hello" + -- JSON: {"name": "hello"} → "hello" + +-} +string : CliDecoder String +string = + CliDecoder + { cliParser = \_ s -> Ok s + , jsonDecoder = Json.Decode.string + , tsDecoder = TsDecode.string + } + + +{-| An integer value. In CLI mode, the string is parsed as a JSON integer. +In JSON mode, a JSON integer field is decoded. + + Option.requiredKeywordArg "count" Option.int + -- CLI: --count 42 → 42 + -- JSON: {"count": 42} → 42 + +-} +int : CliDecoder Int +int = + customDecoder TsDecode.int + + +{-| A float value. In CLI mode, the string is parsed as a JSON number. +In JSON mode, a JSON number field is decoded. + + Option.requiredKeywordArg "rate" Option.float + -- CLI: --rate 3.14 → 3.14 + -- JSON: {"rate": 3.14} → 3.14 + +-} +float : CliDecoder Float +float = + customDecoder TsDecode.float + + +{-| Create a `CliDecoder` from a [`TsDecode.Decoder`](https://package.elm-lang.org/packages/dillonkearns/elm-ts-json/latest/TsJson-Decode). +In CLI mode, the string value is parsed as a JSON value. This means the CLI user must pass valid JSON. + +For strings, this means the CLI value must be quoted: `--name '"hello"'`. +If you want bare string values, use [`string`](#string) instead. + +`customDecoder` is especially useful for decoding complex structured values like JSON objects or arrays. + + import TsJson.Decode as TsDecode + + pointDecoder : TsDecode.Decoder { x : Int, y : Int } + pointDecoder = + TsDecode.succeed (\x y -> { x = x, y = y }) + |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) + |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) + + pointOption : Option String { x : Int, y : Int } { position : BeginningOption, canAddMissingMessage : () } + pointOption = + Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder) + + -- CLI: --point '{"x":1,"y":2}' + -- JSON: {"point": {"x": 1, "y": 2}} + +-} +customDecoder : TsDecode.Decoder value -> CliDecoder value +customDecoder tsDecoder = + CliDecoder + { cliParser = decodeCliJson (TsDecode.decoder tsDecoder) + , jsonDecoder = TsDecode.decoder tsDecoder + , tsDecoder = tsDecoder + } + + + +-- Constructors + + +{-| A keyword argument that must be provided. + +Example: `--name my-app` or `--name=my-app` + + Option.requiredKeywordArg "count" Option.int + -- CLI: --count 42 → 42 + -- JSON: {"count": 42} → 42 + -- Schema: {"type": "integer"} + +-} +requiredKeywordArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } +requiredKeywordArg optionName (CliDecoder decoder) = + Option + { dataGrabber = Internal.requiredKeywordArgGrabber optionName + , usageSpec = UsageSpec.keywordArg optionName Required + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (decoder.cliParser optionName) + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType decoder.tsDecoder + , jsonGrabber = + Internal.jsonFieldGrabber optionName + decoder.jsonDecoder + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + } + + +{-| A keyword argument that may be omitted. + +Example: `--output main.js` or `--output=main.js` + + Option.optionalKeywordArg "greeting" Option.string + -- CLI: --greeting hi → Just "hi", omitted → Nothing + -- JSON: {"greeting": "hi"} → Just "hi", absent → Nothing + +-} +optionalKeywordArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption } +optionalKeywordArg optionName (CliDecoder decoder) = + Option + { dataGrabber = Internal.optionalKeywordArgGrabber optionName + , usageSpec = UsageSpec.keywordArg optionName Optional + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just stringValue -> + decoder.cliParser optionName stringValue + |> Result.map Just + + Nothing -> + Ok Nothing + ) + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType decoder.tsDecoder + , jsonGrabber = Internal.jsonOptionalFieldGrabber optionName decoder.jsonDecoder + } + + +{-| A keyword argument that can be provided multiple times. + +Example: `--header "Auth: token" --header "Accept: json"` + + Option.keywordArgList "header" Option.string + -- CLI: --header "X-A: 1" --header "X-B: 2" → ["X-A: 1", "X-B: 2"] + +-} +keywordArgList : String -> CliDecoder value -> Option (List String) (List value) { position : BeginningOption } +keywordArgList flagName (CliDecoder decoder) = + Option + { dataGrabber = Internal.keywordArgListGrabber flagName + , usageSpec = UsageSpec.keywordArg flagName ZeroOrMore + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\strings -> + strings + |> List.foldr + (\s acc -> + case acc of + Err e -> + Err e + + Ok values -> + case decoder.cliParser flagName s of + Ok v -> + Ok (v :: values) + + Err e -> + Err e + ) + (Ok []) + ) + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType (TsDecode.list decoder.tsDecoder) + , jsonGrabber = Internal.jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list decoder.jsonDecoder) [] + } + + +{-| A positional argument that must be provided. + +Example: `src/Main.elm` in `elm make src/Main.elm` + + Option.requiredPositionalArg "port" Option.int + -- CLI: mytool 8080 → 8080 + -- JSON: {"port": 8080} → 8080 + +-} +requiredPositionalArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } +requiredPositionalArg operandDescription (CliDecoder decoder) = + Option + { dataGrabber = Internal.requiredPositionalArgGrabber operandDescription + , usageSpec = UsageSpec.operand operandDescription + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (decoder.cliParser operandDescription) + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType decoder.tsDecoder + , jsonGrabber = + Internal.jsonFieldGrabber operandDescription + decoder.jsonDecoder + (Cli.Decode.MissingRequiredPositionalArg + { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } + ) + } + + +{-| An optional positional argument. + +Must be used with [`OptionsParser.withOptionalPositionalArg`](Cli-OptionsParser#withOptionalPositionalArg) +(not `OptionsParser.with`). + +Example: `` in `git log []` +Parses to: `Just "abc123"` (or `Nothing` if omitted) + + Option.optionalPositionalArg "revision" Option.string + +-} +optionalPositionalArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption } +optionalPositionalArg operandDescription (CliDecoder decoder) = + Option + { dataGrabber = Internal.optionalPositionalArgGrabber + , usageSpec = UsageSpec.optionalPositionalArg operandDescription + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just stringValue -> + decoder.cliParser operandDescription stringValue + |> Result.map Just + + Nothing -> + Ok Nothing + ) + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType decoder.tsDecoder + , jsonGrabber = Internal.jsonOptionalFieldGrabber operandDescription decoder.jsonDecoder + } + + +{-| A flag with no argument. Always `Bool` — no decoder needed. + +Example: `--debug` in `elm make --debug` + + Option.flag "verbose" + -- CLI: --verbose → True, omitted → False + -- JSON: {"verbose": true} → True, absent → False + +-} +flag : String -> Option Bool Bool { position : BeginningOption } +flag flagName = + Option + { dataGrabber = Internal.flagGrabber flagName + , usageSpec = UsageSpec.flag flagName Optional + , decoder = Cli.Decode.decoder + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType TsDecode.bool + , jsonGrabber = Internal.jsonFlagGrabber flagName + } + + +{-| Collect all remaining positional arguments as a list. + +Must be used with [`OptionsParser.withRestArgs`](Cli-OptionsParser#withRestArgs) +(not `OptionsParser.with`), and must be the last option in the pipeline. + +Example: `...` in `elm-test [...]` +Parses to: `["tests/First.elm", "tests/Second.elm"]` (or `[]` if none provided) + + Option.restArgs "files" + -- CLI: mytool a.txt b.txt → ["a.txt", "b.txt"] + +-} +restArgs : String -> Option (List String) (List String) { position : RestArgsOption } +restArgs restArgsDescription = + Option + { dataGrabber = Internal.restArgsGrabber + , usageSpec = UsageSpec.restArgs restArgsDescription + , decoder = Cli.Decode.decoder + , meta = Internal.emptyMeta + , tsType = TsDecode.tsType (TsDecode.list TsDecode.string) + , jsonGrabber = Internal.jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.string) [] + } + + + +-- Re-exported modifiers + + +{-| Mutually exclusive option values. Restricts the option to a fixed set of +string values, each mapped to an Elm value. + + type ReportFormat + = Json + | Junit + | Console + + reportOption : Option String ReportFormat { position : BeginningOption, canAddMissingMessage : () } + reportOption = + Option.requiredKeywordArg "report" Option.string + |> Option.oneOf + [ ( "json", Json ) + , ( "junit", Junit ) + , ( "console", Console ) + ] + +The help text will show the allowed values: + +```shell +$ ./elm-test --help +elm-test [--report ] ... +``` + +And if you run it with an unrecognized value, you get a validation error: + +```shell +$ ./elm-test --report xml +Validation errors: + +`report` failed a validation. Must be one of [json, junit, console] +Value was: +"xml" +``` + +The JSON schema will include an `enum` constraint with the allowed values. + +-} +oneOf : List ( String, value ) -> Option from String builderState -> Option from value builderState +oneOf = + Cli.Option.oneOf + + +{-| Transform the option value, or fail with a validation error. + +If the function returns `Err`, the error message is shown to the user. + + Option.requiredKeywordArg "count" Option.string + |> Option.validateMap String.toInt + +-} +validateMap : (to -> Result String toMapped) -> Option from to builderState -> Option from toMapped builderState +validateMap = + Cli.Option.validateMap + + +{-| Like [`validateMap`](#validateMap), but only runs when the value is `Just`. +Does nothing for `Nothing`. + + Option.optionalKeywordArg "count" Option.string + |> Option.validateMapIfPresent String.toInt + +-} +validateMapIfPresent : (to -> Result String toMapped) -> Option (Maybe from) (Maybe to) builderState -> Option (Maybe from) (Maybe toMapped) builderState +validateMapIfPresent = + Cli.Option.validateMapIfPresent + + +{-| Provide a default value for an optional option. Turns a `Maybe value` +into a plain `value`. + + Option.optionalKeywordArg "greeting" Option.string + |> Option.withDefault "Hello" + +-} +withDefault : to -> Option from (Maybe to) builderState -> Option from to builderState +withDefault = + Cli.Option.withDefault + + +{-| Add a description shown in help text and JSON schema. + + Option.requiredKeywordArg "name" Option.string + |> Option.withDescription "Your name for the greeting" + +-} +withDescription : String -> Option from to builderState -> Option from to builderState +withDescription = + Cli.Option.withDescription + + +{-| Set a custom display name (metavar) for a keyword argument's value placeholder +in help text and usage synopsis. + +By default, the keyword arg name is uppercased (e.g., `--output-dir `). +Use this to provide a more descriptive placeholder. + + Option.requiredKeywordArg "output-dir" Option.string + |> Option.withDisplayName "PATH" + -- Shows as: --output-dir + +-} +withDisplayName : String -> Option from to builderState -> Option from to builderState +withDisplayName = + Cli.Option.withDisplayName + + +{-| Add a custom error message for when a required option is missing. + +This only works on required options (`requiredPositionalArg`, `requiredKeywordArg`). + + Option.requiredKeywordArg "repository" Option.string + |> Option.withMissingMessage "You must specify a repository to clone." + +-} +withMissingMessage : String -> Option from to { c | canAddMissingMessage : () } -> Option from to { c | canAddMissingMessage : () } +withMissingMessage = + Cli.Option.withMissingMessage + + +{-| Transform an option's value. Use this for infallible transformations. +For transformations that can fail, use [`validateMap`](#validateMap) instead +so the user gets a helpful error message. + + Option.requiredKeywordArg "name" Option.string + |> Option.map String.toUpper + + Option.requiredKeywordArg "output" Option.string + |> Option.map (\path -> path ++ "/index.html") + +-} +map : (toRaw -> toMapped) -> Option from toRaw builderState -> Option from toMapped builderState +map = + Cli.Option.map + + +{-| Transform a flag's `Bool` into a custom type. + + type Verbosity + = Quiet + | Verbose + + verbosityOption : Option Bool Verbosity { position : BeginningOption } + verbosityOption = + Option.flag "verbose" + |> Option.mapFlag { present = Verbose, absent = Quiet } + +-} +mapFlag : { present : union, absent : union } -> Option from Bool builderState -> Option from union builderState +mapFlag = + Cli.Option.mapFlag + + +{-| Run a validation on the parsed value. If validation fails, the user sees +the error message. + + Option.requiredKeywordArg "name" Option.string + |> Option.validate + (Cli.Validate.regex "^[A-Z][A-Za-z]*") + +-} +validate : (to -> Cli.Validate.ValidationResult) -> Option from to builderState -> Option from to builderState +validate = + Cli.Option.validate + + +{-| Like [`validate`](#validate), but only runs when the value is `Just`. +Does nothing for `Nothing`. +-} +validateIfPresent : (to -> Cli.Validate.ValidationResult) -> Option from (Maybe to) builderState -> Option from (Maybe to) builderState +validateIfPresent = + Cli.Option.validateIfPresent + + + +-- Internal helpers + + +{-| Parse a CLI string as strict JSON. No fallback — the string must be valid JSON. +-} +decodeCliJson : Json.Decode.Decoder a -> String -> String -> Result Cli.Decode.ProcessingError a +decodeCliJson elmJsonDecoder optionName stringValue = + case Json.Decode.decodeString elmJsonDecoder stringValue of + Ok value -> + Ok value + + Err err -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString err + } + ) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index d4c687d..b40cb32 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -145,14 +145,17 @@ import Cli.Option.Internal as Internal import Cli.OptionsParser.BuilderState as BuilderState import Cli.OptionsParser.MatchResult import Cli.UsageSpec as UsageSpec exposing (UsageSpec) +import Internal.OptionsParser as OPInternal +import Json.Decode import Occurences exposing (Occurences(..)) import Tokenizer exposing (ParsedOption) +import TsJson.Decode as TsDecode {-| Low-level function, for internal use. -} getUsageSpecs : OptionsParser decodesTo builderState -> List UsageSpec -getUsageSpecs (OptionsParser { usageSpecs }) = +getUsageSpecs (OPInternal.OptionsParser { usageSpecs }) = usageSpecs @@ -169,7 +172,7 @@ synopsis useColor programName optionsParser = Cli.ColorMode.WithoutColor in optionsParser - |> (\(OptionsParser record) -> record) + |> (\(OPInternal.OptionsParser record) -> record) |> UsageSpec.synopsis colorMode programName @@ -187,21 +190,21 @@ detailedHelp useColor programName optionsParser = Cli.ColorMode.WithoutColor in optionsParser - |> (\(OptionsParser record) -> record) + |> (\(OPInternal.OptionsParser record) -> record) |> UsageSpec.detailedHelp colorMode programName {-| Low-level function, for internal use. -} getSubCommand : OptionsParser cliOptions builderState -> Maybe String -getSubCommand (OptionsParser { subCommand }) = +getSubCommand (OPInternal.OptionsParser { subCommand }) = subCommand {-| Low-level function, for internal use. -} tryMatch : List String -> OptionsParser cliOptions builderState -> Cli.OptionsParser.MatchResult.MatchResult cliOptions -tryMatch argv ((OptionsParser { usageSpecs, subCommand }) as optionsParser) = +tryMatch argv ((OPInternal.OptionsParser { usageSpecs, subCommand }) as optionsParser) = let flagsAndOperands = Tokenizer.flagsAndOperands usageSpecs argv @@ -281,8 +284,6 @@ tryMatch argv ((OptionsParser { usageSpecs, subCommand }) as optionsParser) = (matchErrorDetailToNoMatchReason subCommandError :: unexpectedOptionReasons) -{-| Convert internal MatchErrorDetail to public NoMatchReason. --} matchErrorDetailToNoMatchReason : Cli.Decode.MatchErrorDetail -> Cli.OptionsParser.MatchResult.NoMatchReason matchErrorDetailToNoMatchReason detail = case detail of @@ -296,7 +297,6 @@ matchErrorDetailToNoMatchReason detail = Cli.OptionsParser.MatchResult.MissingRequiredKeywordArg { name = name, customMessage = customMessage } Cli.Decode.KeywordArgMissingValue { name } -> - -- Treat "keyword arg provided without value" same as "missing required keyword arg" Cli.OptionsParser.MatchResult.MissingRequiredKeywordArg { name = name, customMessage = Nothing } Cli.Decode.ExtraOperand -> @@ -313,8 +313,8 @@ matchErrorDetailToNoMatchReason detail = expectedPositionalArgCountOrFail : OptionsParser cliOptions builderState -> OptionsParser cliOptions builderState -expectedPositionalArgCountOrFail (OptionsParser ({ decoder, usageSpecs } as optionsParser)) = - OptionsParser +expectedPositionalArgCountOrFail (OPInternal.OptionsParser ({ decoder, usageSpecs } as optionsParser)) = + OPInternal.OptionsParser { optionsParser | decoder = \({ operands } as stuff) -> @@ -330,6 +330,9 @@ expectedPositionalArgCountOrFail (OptionsParser ({ decoder, usageSpecs } as opti else decoder stuff + + -- jsonGrabber unchanged — JSON mode checks extra positional args + -- in rawJsonShapeErrors before normalization } @@ -341,13 +344,13 @@ getDecoder : , usageSpecs : List UsageSpec } -> Result Cli.Decode.ProcessingError ( List Cli.Decode.ValidationError, cliOptions ) -getDecoder (OptionsParser { decoder }) = +getDecoder (OPInternal.OptionsParser { decoder }) = decoder failIfUnexpectedOptions : OptionsParser cliOptions builderState -> OptionsParser cliOptions builderState -failIfUnexpectedOptions ((OptionsParser ({ decoder } as optionsParser)) as fullOptionsParser) = - OptionsParser +failIfUnexpectedOptions ((OPInternal.OptionsParser ({ decoder } as optionsParser)) as fullOptionsParser) = + OPInternal.OptionsParser { optionsParser | decoder = \flagsAndOperands -> @@ -364,7 +367,7 @@ failIfUnexpectedOptions ((OptionsParser ({ decoder } as optionsParser)) as fullO unexpectedOptions_ : OptionsParser cliOptions builderState -> List ParsedOption -> List String -unexpectedOptions_ (OptionsParser { usageSpecs }) options = +unexpectedOptions_ (OPInternal.OptionsParser { usageSpecs }) options = List.filterMap (\(Tokenizer.ParsedOption optionName _) -> if UsageSpec.optionExists usageSpecs optionName == Nothing then @@ -381,62 +384,79 @@ A `Cli.Program.Config` can be built up using one or more `OptionsParser`s. It wi try each parser in order until one succeeds. If none succeed, it will print an error message with information for the user of the Command-Line Interface. -} -type OptionsParser cliOptions builderState - = OptionsParser (OptionsParserRecord cliOptions) +type alias OptionsParser cliOptions builderState = + OPInternal.OptionsParser cliOptions builderState {-| Low-level function, for internal use. -} end : OptionsParser cliOptions builderState -> OptionsParser cliOptions BuilderState.NoMoreOptions -end (OptionsParser record) = - OptionsParser record - - -type alias OptionsParserRecord cliOptions = - { decoder : Decoder cliOptions - , usageSpecs : List UsageSpec - , description : Maybe String - , subCommand : Maybe String - } - +end (OPInternal.OptionsParser record) = + OPInternal.OptionsParser record -type alias Decoder cliOptions = - { usageSpecs : List UsageSpec, options : List ParsedOption, operands : List String } -> Result Cli.Decode.ProcessingError ( List Cli.Decode.ValidationError, cliOptions ) - -updateDecoder : Decoder mappedCliOptions -> OptionsParser cliOptions fromBuilderState -> OptionsParser mappedCliOptions toBuilderState -updateDecoder decoder (OptionsParser optionsParserRecord) = - OptionsParser +updateDecoder : OPInternal.Decoder mappedCliOptions -> Internal.JsonGrabber mappedCliOptions -> OptionsParser cliOptions fromBuilderState -> OptionsParser mappedCliOptions toBuilderState +updateDecoder decoder jsonGrabber (OPInternal.OptionsParser optionsParserRecord) = + OPInternal.OptionsParser { decoder = decoder , usageSpecs = optionsParserRecord.usageSpecs , description = optionsParserRecord.description , subCommand = optionsParserRecord.subCommand + , tsTypes = optionsParserRecord.tsTypes + , jsonGrabber = jsonGrabber } {-| Start an `OptionsParser` pipeline with no sub-command (see -[the OptionsParser terminilogy legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)). +[the OptionsParser terminology legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)). -} build : cliOptions -> OptionsParser cliOptions BuilderState.AnyOptions build cliOptionsConstructor = - OptionsParser + OPInternal.OptionsParser { usageSpecs = [] , description = Nothing , decoder = \_ -> Ok ( [], cliOptionsConstructor ) , subCommand = Nothing + , tsTypes = [] + , jsonGrabber = \_ -> Ok ( [], cliOptionsConstructor ) } {-| Start an `OptionsParser` pipeline with a sub-command (see -[the OptionsParser terminilogy legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)). +[the OptionsParser terminology legend](https://github.com/dillonkearns/elm-cli-options-parser#options-parser-terminology)). -} buildSubCommand : String -> cliOptions -> OptionsParser cliOptions BuilderState.AnyOptions buildSubCommand subCommandName cliOptionsConstructor = - OptionsParser + OPInternal.OptionsParser { usageSpecs = [] , description = Nothing , decoder = \_ -> Ok ( [], cliOptionsConstructor ) , subCommand = Just subCommandName + , tsTypes = [] + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field "subcommand" Json.Decode.string) blob of + Ok subName -> + if subName == subCommandName then + Ok ( [], cliOptionsConstructor ) + + else + Err + (Cli.Decode.MatchError + (Cli.Decode.WrongSubCommand + { expectedSubCommand = subCommandName + , actualSubCommand = subName + } + ) + ) + + Err _ -> + Err + (Cli.Decode.MatchError + (Cli.Decode.MissingSubCommand + { expectedSubCommand = subCommandName } + ) + ) } @@ -465,8 +485,11 @@ any input from the user, it just passes the supplied value through in the chain. -} hardcoded : value -> OptionsParser (value -> cliOptions) BuilderState.AnyOptions -> OptionsParser cliOptions BuilderState.AnyOptions -hardcoded hardcodedValue ((OptionsParser { decoder }) as optionsParser) = - updateDecoder (\stuff -> resultMap (\fn -> fn hardcodedValue) (decoder stuff)) optionsParser +hardcoded hardcodedValue ((OPInternal.OptionsParser { decoder, jsonGrabber }) as optionsParser) = + updateDecoder + (\stuff -> resultMap (\fn -> fn hardcodedValue) (decoder stuff)) + (\blob -> jsonGrabber blob |> Result.map (Tuple.mapSecond (\fn -> fn hardcodedValue))) + optionsParser {-| Map the CLI options returned in the `OptionsParser` using the supplied map function. @@ -515,8 +538,11 @@ map : (cliOptions -> mappedCliOptions) -> OptionsParser cliOptions builderState -> OptionsParser mappedCliOptions builderState -map mapFunction ((OptionsParser { decoder }) as optionsParser) = - updateDecoder (decoder >> Result.map (Tuple.mapSecond mapFunction)) optionsParser +map mapFunction ((OPInternal.OptionsParser { decoder, jsonGrabber }) as optionsParser) = + updateDecoder + (decoder >> Result.map (Tuple.mapSecond mapFunction)) + (\blob -> jsonGrabber blob |> Result.map (Tuple.mapSecond mapFunction)) + optionsParser {-| Internal helper to map over the value inside a Result with validation errors. @@ -534,10 +560,11 @@ resultMap mapFunction result = best to use a subcommand in these cases. -} expectFlag : String -> OptionsParser cliOptions BuilderState.AnyOptions -> OptionsParser cliOptions BuilderState.AnyOptions -expectFlag flagName (OptionsParser ({ usageSpecs, decoder } as optionsParser)) = - OptionsParser +expectFlag flagName (OPInternal.OptionsParser ({ usageSpecs, decoder, tsTypes, jsonGrabber } as optionsParser)) = + OPInternal.OptionsParser { optionsParser | usageSpecs = usageSpecs ++ [ UsageSpec.flag flagName Required ] + , tsTypes = tsTypes ++ [ ( flagName, TsDecode.tsType TsDecode.bool ) ] , decoder = \({ options } as stuff) -> if @@ -549,6 +576,15 @@ expectFlag flagName (OptionsParser ({ usageSpecs, decoder } as optionsParser)) = else Cli.Decode.MatchError (Cli.Decode.MissingExpectedFlag { name = flagName }) |> Err + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field flagName Json.Decode.bool) blob of + Ok True -> + jsonGrabber blob + + _ -> + Cli.Decode.MatchError (Cli.Decode.MissingExpectedFlag { name = flagName }) + |> Err } @@ -561,7 +597,7 @@ with = withCommon : Cli.Option.Option from to optionConstraint -> OptionsParser (to -> cliOptions) startOptionsParserBuilderState -> OptionsParser cliOptions endOptionsParserBuilderState -withCommon (Internal.Option innerOption) ((OptionsParser { decoder, usageSpecs }) as fullOptionsParser) = +withCommon (Internal.Option innerOption) ((OPInternal.OptionsParser { decoder, usageSpecs, tsTypes, jsonGrabber }) as fullOptionsParser) = updateDecoder (\optionsAndOperands -> { options = optionsAndOperands.options @@ -584,11 +620,25 @@ withCommon (Internal.Option innerOption) ((OptionsParser { decoder, usageSpecs } value ) ) + (\blob -> + case jsonGrabber blob of + Ok ( fnErrors, fn ) -> + case innerOption.jsonGrabber blob of + Ok ( argErrors, argValue ) -> + Ok ( fnErrors ++ argErrors, fn argValue ) + + Err err -> + Err err + + Err err -> + Err err + ) fullOptionsParser - |> (\(OptionsParser record) -> - OptionsParser + |> (\(OPInternal.OptionsParser record) -> + OPInternal.OptionsParser { record | usageSpecs = usageSpecs ++ [ innerOption.usageSpec ] + , tsTypes = tsTypes ++ [ ( UsageSpec.name innerOption.usageSpec, innerOption.tsType ) ] } ) @@ -630,8 +680,8 @@ appears below the usage line. -} withDescription : String -> OptionsParser cliOptions anything -> OptionsParser cliOptions anything -withDescription docString (OptionsParser optionsParserRecord) = - OptionsParser +withDescription docString (OPInternal.OptionsParser optionsParserRecord) = + OPInternal.OptionsParser { optionsParserRecord | description = Just docString } diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 7eed61a..3772a30 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -4,6 +4,8 @@ module Cli.Program exposing , StatelessProgram, StatefulProgram , FlagsIncludingArgv , mapConfig + , helpText + , toJsonSchema , run, RunResult(..), ExitStatus(..), ColorMode(..) ) @@ -67,6 +69,17 @@ See the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree @docs mapConfig +## Help Text and JSON Schema + +Generate help text for terminal display, or a [JSON Schema](https://json-schema.org/) +for use as an [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) +`inputSchema` definition. JSON schemas are generated from the types provided by +[`Cli.Option.Typed`](Cli-Option-Typed) constructors. + +@docs helpText +@docs toJsonSchema + + ## Low-Level / Testing @docs run, RunResult, ExitStatus, ColorMode @@ -79,7 +92,13 @@ import Cli.OptionsParser as OptionsParser exposing (OptionsParser) import Cli.OptionsParser.BuilderState as BuilderState import Cli.OptionsParser.MatchResult exposing (NoMatchReason(..)) import Cli.Style +import Cli.UsageSpec as UsageSpec exposing (UsageSpec) +import Internal.OptionsParser as OPInternal +import Json.Decode +import Json.Encode as Encode import List.Extra +import Occurences exposing (Occurences(..)) +import TsJson.Type import TypoSuggestion @@ -414,20 +433,51 @@ just like `process.argv` in Node.js. run : Config msg -> List String -> String -> ColorMode -> RunResult msg run (Config { optionsParsers }) argv versionMessage colorMode = let - programName = - case argv of - _ :: programPath :: _ -> - programPath - |> String.split "/" - |> List.Extra.last - |> Maybe.withDefault errorMessage + -- Check for JSON input mode: a single arg that's JSON with $cli as an object + maybeJsonBlob = + case argv |> List.drop 2 of + [ singleArg ] -> + case Json.Decode.decodeString (Json.Decode.field "$cli" (Json.Decode.keyValuePairs Json.Decode.value)) singleArg of + Ok _ -> + Json.Decode.decodeString Json.Decode.value singleArg + |> Result.toMaybe + + Err _ -> + Nothing _ -> - errorMessage + Nothing + in + case maybeJsonBlob of + Just blob -> + -- Direct JSON mode: decode using jsonGrabbers, no lossy argv translation + runJsonMode optionsParsers blob + + Nothing -> + let + errorMessage = + "TODO - show error message explaining that user needs to pass unmodified `process.argv` from node here." + + programName = + case argv of + _ :: programPath :: _ -> + programPath + |> String.split "/" + |> List.Extra.last + |> Maybe.withDefault errorMessage + + _ -> + errorMessage + in + -- CLI mode: parse argv as before + runCliMode optionsParsers argv programName versionMessage colorMode - errorMessage = - "TODO - show error message explaining that user needs to pass unmodified `process.argv` from node here." +{-| Run in CLI mode — parse argv using tokenizer and data grabbers. +-} +runCliMode : List (OptionsParser msg BuilderState.NoMoreOptions) -> List String -> String -> String -> ColorMode -> RunResult msg +runCliMode optionsParsers argv programName versionMessage colorMode = + let matchResult = Cli.LowLevel.try optionsParsers argv in @@ -484,6 +534,40 @@ run (Config { optionsParsers }) argv versionMessage colorMode = |> SystemMessage Success +{-| Run in JSON mode — decode directly from JSON blob using jsonGrabbers. +No lossy argv translation. Error messages use JSON terminology (field names, not --flags). +-} +runJsonMode : List (OptionsParser msg BuilderState.NoMoreOptions) -> Json.Decode.Value -> RunResult msg +runJsonMode optionsParsers blob = + case Cli.LowLevel.tryJson optionsParsers blob of + Cli.LowLevel.Match msg -> + CustomMatch msg + + Cli.LowLevel.ValidationErrors validationErrors -> + ("Validation errors:\n\n" + ++ (validationErrors + |> List.map + (\{ name, invalidReason } -> + "Invalid \"" + ++ name + ++ "\" field." + ++ "\n" + ++ invalidReason + ) + |> String.join "\n" + ) + ) + |> SystemMessage Failure + + Cli.LowLevel.NoMatch reasons -> + formatJsonNoMatchReasons reasons + |> SystemMessage Failure + + _ -> + -- ShowHelp, ShowVersion, ShowSubcommandHelp shouldn't happen in JSON mode + SystemMessage Failure "Unexpected error in JSON mode." + + {-| Transform the return type for all of the registered `OptionsParser`'s in the `Config`. -} mapConfig : (a -> b) -> Config a -> Config b @@ -495,6 +579,427 @@ mapConfig mapFn (Config configValue) = } +{-| Generate plain-text help for a `Config`, suitable for including in machine-readable introspection output. + +Uses no ANSI color codes. The `programName` argument is used as the prefix in the usage synopsis. + + import Cli.Option as Option + import Cli.OptionsParser as OptionsParser + import Cli.Program as Program + + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.with (Option.flag "verbose") + ) + |> Program.helpText "my-script" + --> "my-script --name [--verbose]" + +-} +helpText : String -> Config msg -> String +helpText programName (Config { optionsParsers }) = + Cli.LowLevel.helpText Cli.ColorMode.WithoutColor programName optionsParsers + + +{-| Generate a JSON Schema describing the inputs of this CLI configuration. + +The schema follows the [JSON Schema](https://json-schema.org/) format. Named options +(keyword args, flags, keyword lists) are top-level properties with an `x-cli-kind` +annotation indicating their CLI invocation form. Positional arguments and subcommands +go inside a `$cli` object. + +The schema's `description` field includes a usage synopsis and instructions for +how to invoke the command via JSON or traditional CLI flags. + +Suitable for use as an [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) +`inputSchema` definition. + + import Cli.Option as Option + import Cli.OptionsParser as OptionsParser + import Cli.Program as Program + + programConfig = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + + schema = + Program.toJsonSchema "my-script" programConfig + +The resulting schema has `name` as a top-level property with +`"x-cli-kind": "keyword"`, and a required `$cli` object as the sentinel +for JSON input mode. + +-} +toJsonSchema : String -> Config msg -> Encode.Value +toJsonSchema programName (Config { optionsParsers }) = + let + baseSchema = + case optionsParsers of + [ singleParser ] -> + parserToJsonSchemaFromTsTypes programName singleParser + + multipleParsers -> + Encode.object + [ ( "anyOf" + , Encode.list (parserToJsonSchemaFromTsTypes programName) multipleParsers + ) + ] + in + withDraft07Schema baseSchema + + +parserToJsonSchemaFromTsTypes : String -> OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value +parserToJsonSchemaFromTsTypes programName parser = + let + specs = + OptionsParser.getUsageSpecs parser + + tsTypes = + OPInternal.getTsTypes parser + + specsWithTypes = + List.map2 Tuple.pair specs tsTypes + + usageSynopsis = + OptionsParser.synopsis False programName parser + |> String.trim + + -- Top-level properties: keyword args, keyword lists, flags (with x-cli-kind) + topLevelProperties = + specsWithTypes |> List.filterMap toFlatProperty + + -- Required top-level property names + requiredTopLevel = + specsWithTypes |> List.filterMap toRequiredTopLevelName + + -- Subcommand → $cli.subcommand + subCommandProp = + case OptionsParser.getSubCommand parser of + Just subName -> + [ ( "subcommand" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "const", Encode.string subName ) + ] + ) + ] + + Nothing -> + [] + + -- Positional args → $cli.positional + positionalSpecs = + specsWithTypes + |> List.filterMap + (\( spec, ( _, tsType ) ) -> + case spec of + UsageSpec.Operand _ _ occurences _ -> + Just ( spec, tsType, occurences ) + + _ -> + Nothing + ) + + -- Rest args → $cli.positional.items + restArgSpec = + specsWithTypes + |> List.filterMap + (\( spec, ( _, tsType ) ) -> + case spec of + UsageSpec.RestArgs _ _ -> + Just ( spec, tsType ) + + _ -> + Nothing + ) + |> List.head + + hasPositionalArgs = + not (List.isEmpty positionalSpecs) || restArgSpec /= Nothing + + -- Build $cli schema (only subcommand + positional) + cliSubProperties = + subCommandProp ++ positionalSchemaProperty positionalSpecs restArgSpec + + hasRequiredPositionalArgs = + positionalSpecs + |> List.any (\( _, _, occurences ) -> occurences == Required) + + cliRequired = + (case OptionsParser.getSubCommand parser of + Just _ -> + [ "subcommand" ] + + Nothing -> + [] + ) + ++ (if hasRequiredPositionalArgs then + [ "positional" ] + + else + [] + ) + + cliSchema = + Encode.object + ([ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ++ (if List.isEmpty cliSubProperties then + [] + + else + [ ( "properties", Encode.object cliSubProperties ) ] + ) + ++ (if List.isEmpty cliRequired then + [] + + else + [ ( "required", Encode.list Encode.string cliRequired ) ] + ) + ) + + -- Build description with invocation instructions + description = + buildSchemaDescription usageSynopsis hasPositionalArgs + + -- Assemble full schema + allProperties = + topLevelProperties ++ [ ( "$cli", cliSchema ) ] + + allRequired = + requiredTopLevel ++ [ "$cli" ] + in + Encode.object + [ ( "description", Encode.string description ) + , ( "type", Encode.string "object" ) + , ( "properties", Encode.object allProperties ) + , ( "required", Encode.list Encode.string allRequired ) + , ( "additionalProperties", Encode.bool False ) + ] + + +{-| Build the `$cli.positional` schema property. +-} +positionalSchemaProperty : List ( UsageSpec, TsJson.Type.Type, Occurences ) -> Maybe ( UsageSpec, TsJson.Type.Type ) -> List ( String, Encode.Value ) +positionalSchemaProperty positionalArgs maybeRestArgs = + if List.isEmpty positionalArgs && maybeRestArgs == Nothing then + [] + + else + let + fixedItemSchemas = + positionalArgs + |> List.map + (\( spec, tsType, _ ) -> + let + baseSchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) + + desc = + case usageSpecDescription spec of + Just d -> + d + + Nothing -> + UsageSpec.name spec + in + appendJsonFields [ ( "description", Encode.string desc ) ] baseSchema + ) + + requiredCount = + positionalArgs + |> List.filter (\( _, _, occ ) -> occ == Required) + |> List.length + + restItemSchema = + maybeRestArgs + |> Maybe.andThen + (\( spec, tsType ) -> + let + arraySchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) + in + case Json.Decode.decodeValue (Json.Decode.field "items" Json.Decode.value) arraySchema of + Ok itemSchema -> + case usageSpecDescription spec of + Just desc -> + Just (appendJsonFields [ ( "description", Encode.string desc ) ] itemSchema) + + Nothing -> + Just itemSchema + + Err _ -> + Nothing + ) + + itemsField = + if List.isEmpty fixedItemSchemas then + restItemSchema + |> Maybe.map (\itemSchema -> [ ( "items", itemSchema ) ]) + |> Maybe.withDefault [] + + else + [ ( "items", Encode.list identity fixedItemSchemas ) ] + + additionalItemsField = + if List.isEmpty fixedItemSchemas then + [] + + else + case restItemSchema of + Just itemSchema -> + [ ( "additionalItems", itemSchema ) ] + + Nothing -> + [ ( "additionalItems", Encode.bool False ) ] + + schemaFields = + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool )" ) + ] + ++ itemsField + ++ additionalItemsField + ++ (if requiredCount > 0 then + [ ( "minItems", Encode.int requiredCount ) ] + + else + [] + ) + in + [ ( "positional", Encode.object schemaFields ) ] + + +{-| Convert a spec+type pair to a top-level property with `x-cli-kind`, if it's a named option. +Returns Nothing for positional args and rest args (those go in $cli). +-} +toFlatProperty : ( UsageSpec, ( String, TsJson.Type.Type ) ) -> Maybe ( String, Encode.Value ) +toFlatProperty ( spec, ( optionName, tsType ) ) = + let + maybeCliKind = + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ ZeroOrMore _ -> + Just "keyword-list" + + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ _ _ -> + Just "keyword" + + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ _ _ -> + Just "flag" + + _ -> + Nothing + in + case maybeCliKind of + Just kind -> + let + strippedSchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) + + extraFields = + ( "x-cli-kind", Encode.string kind ) + :: (case usageSpecDescription spec of + Just desc -> + [ ( "description", Encode.string desc ) ] + + Nothing -> + [] + ) + in + Just ( optionName, appendJsonFields extraFields strippedSchema ) + + Nothing -> + Nothing + + +{-| Get the name of a required top-level option (keyword arg or expectFlag). +-} +toRequiredTopLevelName : ( UsageSpec, ( String, a ) ) -> Maybe String +toRequiredTopLevelName ( spec, ( optionName, _ ) ) = + case spec of + UsageSpec.FlagOrKeywordArg _ _ Required _ -> + Just optionName + + _ -> + Nothing + + +{-| Build the full schema description with usage synopsis and invocation instructions. +-} +buildSchemaDescription : String -> Bool -> String +buildSchemaDescription usageSynopsis hasPositionalArgs = + let + positionalNote = + if hasPositionalArgs then + "Positional arguments are passed in order via the `$cli.positional` array." + + else + "Positional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty)." + in + usageSynopsis + ++ "\n\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above." + ++ "\n\nEach property has an `x-cli-kind` indicating its CLI invocation form:\n- \"keyword\": --name \n- \"flag\": --name (present or absent, no value)\n- \"keyword-list\": --name (repeatable)" + ++ "\n\n" + ++ positionalNote + + +{-| Strip the `$schema` key from a TsJson-generated JSON schema value. +-} +stripSchemaKey : Encode.Value -> Encode.Value +stripSchemaKey baseSchema = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) baseSchema of + Ok pairs -> + pairs + |> List.filter (\( k, _ ) -> k /= "$schema") + |> Encode.object + + Err _ -> + baseSchema + + +usageSpecDescription : UsageSpec -> Maybe String +usageSpecDescription spec = + case spec of + UsageSpec.FlagOrKeywordArg _ _ _ maybeDescription -> + maybeDescription + + UsageSpec.Operand _ _ _ maybeDescription -> + maybeDescription + + UsageSpec.RestArgs _ maybeDescription -> + maybeDescription + + +{-| Append additional key-value pairs to the end of a JSON object value. +-} +appendJsonFields : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value +appendJsonFields extraFields jsonValue = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue of + Ok existingFields -> + Encode.object (existingFields ++ extraFields) + + Err _ -> + Encode.object extraFields + + +withDraft07Schema : Encode.Value -> Encode.Value +withDraft07Schema schemaValue = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) schemaValue of + Ok fields -> + Encode.object + (( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + :: fields + ) + + Err _ -> + Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) ] + + {-| Generate help text for a specific subcommand. -} subcommandHelpText : ColorMode -> String -> List (OptionsParser msg BuilderState.NoMoreOptions) -> String -> String @@ -734,3 +1239,56 @@ formatFallbackMessage colorMode programName optionsParsers = ++ applyBold colorMode "Usage:" ++ "\n\n" ++ Cli.LowLevel.helpText (toInternalColorMode colorMode) programName optionsParsers + + +{-| Format NoMatchReasons for JSON mode — no CLI terminology (no --, no usage lines). +-} +formatJsonNoMatchReasons : List NoMatchReason -> String +formatJsonNoMatchReasons reasons = + let + unexpectedFieldReasons = + reasons + |> List.filterMap + (\reason -> + case reason of + UnexpectedOption name -> + Just ("Unexpected field: \"" ++ name ++ "\"") + + _ -> + Nothing + ) + in + case unexpectedFieldReasons of + first :: _ -> + first + + [] -> + if List.member ExtraOperand reasons then + "Too many positional arguments in \"$cli.positional\"." + + else + let + missingFieldReasons = + reasons + |> List.filterMap + (\reason -> + case reason of + MissingRequiredKeywordArg { name } -> + Just ("Missing required field: \"" ++ name ++ "\"") + + MissingRequiredPositionalArg { name } -> + Just ("Missing required field: \"" ++ name ++ "\"") + + MissingExpectedFlag { name } -> + Just ("Missing required field: \"" ++ name ++ "\"") + + _ -> + Nothing + ) + in + case missingFieldReasons of + first :: _ -> + first + + [] -> + "No matching command found for JSON input." diff --git a/src/Cli/UsageSpec.elm b/src/Cli/UsageSpec.elm index 8266e00..0b5c658 100644 --- a/src/Cli/UsageSpec.elm +++ b/src/Cli/UsageSpec.elm @@ -1,6 +1,7 @@ module Cli.UsageSpec exposing - ( MutuallyExclusiveValues - , UsageSpec + ( FlagOrKeywordArg(..) + , MutuallyExclusiveValues(..) + , UsageSpec(..) , changeUsageSpec , detailedHelp , flag @@ -509,18 +510,15 @@ wrapParts maxWidth indent prefix parts = let firstLine = prefix ++ " " ++ first - - result = - wrapPartsHelper maxWidth indent rest firstLine [] in - result + wrapPartsHelper maxWidth indent rest firstLine [] wrapPartsHelper : Int -> String -> List String -> String -> List String -> String wrapPartsHelper maxWidth indent parts currentLine accLines = case parts of [] -> - (List.reverse (currentLine :: accLines)) + List.reverse (currentLine :: accLines) |> String.join "\n" part :: rest -> diff --git a/src/Internal/OptionsParser.elm b/src/Internal/OptionsParser.elm new file mode 100644 index 0000000..efe7c32 --- /dev/null +++ b/src/Internal/OptionsParser.elm @@ -0,0 +1,440 @@ +module Internal.OptionsParser exposing + ( Decoder + , OptionsParser(..) + , OptionsParserRecord + , getTsTypes + , tryMatchJson + ) + +import Cli.Decode +import Cli.Option.Internal as Internal +import Cli.OptionsParser.MatchResult +import Cli.UsageSpec as UsageSpec exposing (UsageSpec) +import Json.Decode +import Json.Encode as Encode +import Tokenizer exposing (ParsedOption) +import TsJson.Type + + +type OptionsParser cliOptions builderState + = OptionsParser (OptionsParserRecord cliOptions) + + +type alias OptionsParserRecord cliOptions = + { decoder : Decoder cliOptions + , usageSpecs : List UsageSpec + , description : Maybe String + , subCommand : Maybe String + , tsTypes : List ( String, TsJson.Type.Type ) + , jsonGrabber : Internal.JsonGrabber cliOptions + } + + +type alias Decoder cliOptions = + { usageSpecs : List UsageSpec, options : List ParsedOption, operands : List String } -> Result Cli.Decode.ProcessingError ( List Cli.Decode.ValidationError, cliOptions ) + + +{-| Get the TsTypes collected from each option in this parser. +Returns a list of (name, tsType) pairs. +-} +getTsTypes : OptionsParser decodesTo builderState -> List ( String, TsJson.Type.Type ) +getTsTypes (OptionsParser { tsTypes }) = + tsTypes + + +{-| Try to match a JSON blob against this parser's jsonGrabber. +Normalizes the `$cli` object into flat fields before passing to jsonGrabber. +-} +tryMatchJson : Json.Decode.Value -> OptionsParser cliOptions builderState -> Cli.OptionsParser.MatchResult.MatchResult cliOptions +tryMatchJson blob (OptionsParser { jsonGrabber, usageSpecs, subCommand }) = + let + normalizedBlob = + normalizeCliJson usageSpecs blob + + baseMatchResult = + jsonGrabber normalizedBlob + |> jsonGrabberResultToMatchResult + + structuralTypeValidationErrors = + subcommandJsonTypeValidationErrors subCommand blob + ++ positionalJsonTypeValidationErrors usageSpecs blob baseMatchResult + in + case structuralTypeValidationErrors of + firstValidationError :: otherValidationErrors -> + Cli.OptionsParser.MatchResult.Match (Err (firstValidationError :: otherValidationErrors)) + + [] -> + let + unexpectedShapeErrors = + rawJsonShapeErrors subCommand usageSpecs blob + + positionalCountErrors = + extraJsonPositionalErrors usageSpecs blob baseMatchResult + in + case baseMatchResult of + Cli.OptionsParser.MatchResult.Match _ -> + if List.isEmpty unexpectedShapeErrors && List.isEmpty positionalCountErrors then + baseMatchResult + + else + Cli.OptionsParser.MatchResult.NoMatch (unexpectedShapeErrors ++ positionalCountErrors) + + Cli.OptionsParser.MatchResult.NoMatch reasons -> + Cli.OptionsParser.MatchResult.NoMatch + (unexpectedShapeErrors ++ positionalCountErrors ++ reasons) + + +jsonGrabberResultToMatchResult : + Result Cli.Decode.ProcessingError ( List Cli.Decode.ValidationError, cliOptions ) + -> Cli.OptionsParser.MatchResult.MatchResult cliOptions +jsonGrabberResultToMatchResult jsonGrabberResult = + case jsonGrabberResult of + Err error -> + case error of + Cli.Decode.MatchError matchErrorDetail -> + Cli.OptionsParser.MatchResult.NoMatch + [ matchErrorDetailToNoMatchReason matchErrorDetail ] + + Cli.Decode.UnrecoverableValidationError validationError -> + Cli.OptionsParser.MatchResult.Match (Err [ validationError ]) + + Cli.Decode.UnexpectedOptions unexpectedOptions -> + Cli.OptionsParser.MatchResult.NoMatch + (List.map Cli.OptionsParser.MatchResult.UnexpectedOption unexpectedOptions) + + Ok ( [], value ) -> + Cli.OptionsParser.MatchResult.Match (Ok value) + + Ok ( validationErrors, _ ) -> + Cli.OptionsParser.MatchResult.Match (Err validationErrors) + + +matchErrorDetailToNoMatchReason : Cli.Decode.MatchErrorDetail -> Cli.OptionsParser.MatchResult.NoMatchReason +matchErrorDetailToNoMatchReason detail = + case detail of + Cli.Decode.MissingExpectedFlag { name } -> + Cli.OptionsParser.MatchResult.MissingExpectedFlag { name = name } + + Cli.Decode.MissingRequiredPositionalArg { name, customMessage } -> + Cli.OptionsParser.MatchResult.MissingRequiredPositionalArg { name = name, customMessage = customMessage } + + Cli.Decode.MissingRequiredKeywordArg { name, customMessage } -> + Cli.OptionsParser.MatchResult.MissingRequiredKeywordArg { name = name, customMessage = customMessage } + + Cli.Decode.KeywordArgMissingValue { name } -> + Cli.OptionsParser.MatchResult.MissingRequiredKeywordArg { name = name, customMessage = Nothing } + + Cli.Decode.ExtraOperand -> + Cli.OptionsParser.MatchResult.ExtraOperand + + Cli.Decode.MissingSubCommand { expectedSubCommand } -> + Cli.OptionsParser.MatchResult.MissingSubCommand { expectedSubCommand = expectedSubCommand } + + Cli.Decode.WrongSubCommand { expectedSubCommand, actualSubCommand } -> + Cli.OptionsParser.MatchResult.WrongSubCommand + { expectedSubCommand = expectedSubCommand + , actualSubCommand = actualSubCommand + } + + +{-| Normalize a JSON blob with flat properties and `$cli` structural data into flat fields. +-} +normalizeCliJson : List UsageSpec -> Json.Decode.Value -> Json.Decode.Value +normalizeCliJson usageSpecs blob = + let + topLevelFields = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) blob of + Ok pairs -> + pairs |> List.filter (\( k, _ ) -> k /= "$cli") + + Err _ -> + [] + + topLevelFieldNames = + List.map Tuple.first topLevelFields + + maybeCli = + Json.Decode.decodeValue (Json.Decode.field "$cli" Json.Decode.value) blob + + subcommandField = + case maybeCli of + Ok cliValue -> + case Json.Decode.decodeValue (Json.Decode.field "subcommand" Json.Decode.string) cliValue of + Ok subName -> + [ ( "subcommand", Encode.string subName ) ] + + Err _ -> + [] + + Err _ -> + [] + + positionalFields = + case maybeCli of + Ok cliValue -> + case Json.Decode.decodeValue (Json.Decode.field "positional" (Json.Decode.list Json.Decode.value)) cliValue of + Ok positionalValues -> + let + operandSpecs = + usageSpecs + |> List.filter UsageSpec.isOperand + + fixedFields = + List.map2 + (\spec val -> ( UsageSpec.name spec, val )) + operandSpecs + positionalValues + + restArgsName = + usageSpecs + |> List.filterMap + (\spec -> + case spec of + UsageSpec.RestArgs restName _ -> + Just restName + + _ -> + Nothing + ) + |> List.head + + restFields = + case restArgsName of + Just rName -> + [ ( rName + , Encode.list identity + (List.drop (List.length operandSpecs) positionalValues) + ) + ] + + Nothing -> + [] + in + fixedFields ++ restFields + + Err _ -> + [] + + Err _ -> + [] + + flagDefaults = + usageSpecs + |> List.filterMap + (\spec -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag flagName) _ _ _ -> + if not (List.member flagName topLevelFieldNames) then + Just ( flagName, Encode.bool False ) + + else + Nothing + + _ -> + Nothing + ) + in + Encode.object (topLevelFields ++ subcommandField ++ positionalFields ++ flagDefaults) + + +rawJsonShapeErrors : Maybe String -> List UsageSpec -> Json.Decode.Value -> List Cli.OptionsParser.MatchResult.NoMatchReason +rawJsonShapeErrors subCommand usageSpecs blob = + let + topLevelFields = + jsonObjectFields blob + + cliValue = + Json.Decode.decodeValue (Json.Decode.field "$cli" Json.Decode.value) blob + |> Result.toMaybe + + unexpectedTopLevelFields = + topLevelFields + |> List.map Tuple.first + |> List.filter (\fieldName -> not (List.member fieldName (allowedTopLevelFieldNames usageSpecs))) + |> List.map Cli.OptionsParser.MatchResult.UnexpectedOption + + unexpectedCliFields = + case cliValue of + Just actualCliValue -> + jsonObjectFields actualCliValue + |> List.map Tuple.first + |> List.filter (\fieldName -> not (List.member fieldName (allowedCliFieldNames subCommand usageSpecs))) + |> List.map (\fieldName -> Cli.OptionsParser.MatchResult.UnexpectedOption ("$cli." ++ fieldName)) + + Nothing -> + [] + in + unexpectedTopLevelFields ++ unexpectedCliFields + + +allowedTopLevelFieldNames : List UsageSpec -> List String +allowedTopLevelFieldNames usageSpecs = + "$cli" + :: (usageSpecs + |> List.filterMap + (\usageSpec -> + case usageSpec of + UsageSpec.FlagOrKeywordArg _ _ _ _ -> + Just (UsageSpec.name usageSpec) + + UsageSpec.Operand _ _ _ _ -> + Nothing + + UsageSpec.RestArgs _ _ -> + Nothing + ) + ) + + +allowedCliFieldNames : Maybe String -> List UsageSpec -> List String +allowedCliFieldNames subCommand usageSpecs = + (case subCommand of + Just _ -> + [ "subcommand" ] + + Nothing -> + [] + ) + ++ (if hasJsonPositionalInput usageSpecs then + [ "positional" ] + + else + [] + ) + + +hasJsonPositionalInput : List UsageSpec -> Bool +hasJsonPositionalInput usageSpecs = + usageSpecs + |> List.any + (\usageSpec -> + case usageSpec of + UsageSpec.FlagOrKeywordArg _ _ _ _ -> + False + + UsageSpec.Operand _ _ _ _ -> + True + + UsageSpec.RestArgs _ _ -> + True + ) + + +extraJsonPositionalErrors : + List UsageSpec + -> Json.Decode.Value + -> Cli.OptionsParser.MatchResult.MatchResult cliOptions + -> List Cli.OptionsParser.MatchResult.NoMatchReason +extraJsonPositionalErrors usageSpecs blob baseMatchResult = + if + UsageSpec.hasRestArgs usageSpecs + || not (hasJsonPositionalInput usageSpecs) + || not (shouldValidateJsonPositionals baseMatchResult) + then + [] + + else + case Json.Decode.decodeValue (Json.Decode.field "$cli" (Json.Decode.field "positional" (Json.Decode.list Json.Decode.value))) blob of + Ok positionalValues -> + if List.length positionalValues > List.length (List.filter UsageSpec.isOperand usageSpecs) then + [ Cli.OptionsParser.MatchResult.ExtraOperand ] + + else + [] + + Err _ -> + [] + + +positionalJsonTypeValidationErrors : + List UsageSpec + -> Json.Decode.Value + -> Cli.OptionsParser.MatchResult.MatchResult cliOptions + -> List Cli.Decode.ValidationError +positionalJsonTypeValidationErrors usageSpecs blob baseMatchResult = + if hasJsonPositionalInput usageSpecs && shouldValidateJsonPositionals baseMatchResult then + nestedJsonFieldTypeError + { name = "$cli.positional" + , decoder = Json.Decode.field "$cli" (Json.Decode.field "positional" (Json.Decode.list Json.Decode.value)) + , presenceDecoder = Json.Decode.field "$cli" (Json.Decode.field "positional" Json.Decode.value) + , blob = blob + } + |> Maybe.map List.singleton + |> Maybe.withDefault [] + + else + [] + + +subcommandJsonTypeValidationErrors : Maybe String -> Json.Decode.Value -> List Cli.Decode.ValidationError +subcommandJsonTypeValidationErrors subCommand blob = + case subCommand of + Just _ -> + nestedJsonFieldTypeError + { name = "$cli.subcommand" + , decoder = Json.Decode.field "$cli" (Json.Decode.field "subcommand" Json.Decode.string) + , presenceDecoder = Json.Decode.field "$cli" (Json.Decode.field "subcommand" Json.Decode.value) + , blob = blob + } + |> Maybe.map List.singleton + |> Maybe.withDefault [] + + Nothing -> + [] + + +shouldValidateJsonPositionals : Cli.OptionsParser.MatchResult.MatchResult cliOptions -> Bool +shouldValidateJsonPositionals baseMatchResult = + case baseMatchResult of + Cli.OptionsParser.MatchResult.Match _ -> + True + + Cli.OptionsParser.MatchResult.NoMatch reasons -> + not + (List.any + (\reason -> + case reason of + Cli.OptionsParser.MatchResult.MissingExpectedFlag _ -> + True + + Cli.OptionsParser.MatchResult.MissingSubCommand _ -> + True + + Cli.OptionsParser.MatchResult.WrongSubCommand _ -> + True + + _ -> + False + ) + reasons + ) + + +nestedJsonFieldTypeError : + { name : String + , decoder : Json.Decode.Decoder a + , presenceDecoder : Json.Decode.Decoder Json.Decode.Value + , blob : Json.Decode.Value + } + -> Maybe Cli.Decode.ValidationError +nestedJsonFieldTypeError { name, decoder, presenceDecoder, blob } = + case Json.Decode.decodeValue decoder blob of + Ok _ -> + Nothing + + Err decodeError -> + case Json.Decode.decodeValue presenceDecoder blob of + Ok _ -> + Just + { name = name + , invalidReason = Json.Decode.errorToString decodeError + } + + Err _ -> + Nothing + + +jsonObjectFields : Json.Decode.Value -> List ( String, Json.Decode.Value ) +jsonObjectFields jsonValue = + Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue + |> Result.withDefault [] diff --git a/tests/ErrorMessageFormattingTests.elm b/tests/ErrorMessageFormattingTests.elm index 322f242..629f25f 100644 --- a/tests/ErrorMessageFormattingTests.elm +++ b/tests/ErrorMessageFormattingTests.elm @@ -4,6 +4,7 @@ module ErrorMessageFormattingTests exposing (all) These tests assert on the exact error message output to ensure users see clear, helpful messages. + -} import Cli.Option as Option diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm new file mode 100644 index 0000000..dff2184 --- /dev/null +++ b/tests/ExperienceTests.elm @@ -0,0 +1,502 @@ +module ExperienceTests exposing (all) + +import Cli.Option as Option +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Expect +import Json.Encode as Encode +import Test exposing (..) + + +{-| A realistic CLI: a task management tool with subcommands. + + mytool add --title "Buy milk" --priority high + + mytool list --format json --limit 10 + + mytool complete 42 + +-} +type CliOptions + = Add AddOptions + | ListTasks ListOptions + | Complete CompleteOptions + + +type alias AddOptions = + { title : String + , priority : Priority + } + + +type Priority + = Low + | Medium + | High + + +type alias ListOptions = + { format : Format + , limit : Int + , verbose : Bool + } + + +type Format + = Json + | Table + | Csv + + +type alias CompleteOptions = + { taskId : String + } + + +{-| The CLI config as a developer would write it. +-} +taskConfig : Program.Config CliOptions +taskConfig = + Program.config + |> Program.add + (OptionsParser.buildSubCommand "add" AddOptions + |> OptionsParser.with + (Option.requiredKeywordArg "title" + |> Option.withDescription "The task title" + ) + |> OptionsParser.with + (Option.requiredKeywordArg "priority" + |> Option.oneOf + [ ( "low", Low ) + , ( "medium", Medium ) + , ( "high", High ) + ] + |> Option.withDescription "Task priority level" + ) + |> OptionsParser.map Add + ) + |> Program.add + (OptionsParser.buildSubCommand "list" ListOptions + |> OptionsParser.with + (Option.optionalKeywordArg "format" + |> Option.withDefault "table" + |> Option.oneOf + [ ( "json", Json ) + , ( "table", Table ) + , ( "csv", Csv ) + ] + |> Option.withDescription "Output format" + ) + |> OptionsParser.with + (Option.requiredKeywordArg "limit" + |> Option.validateMap + (\s -> + case String.toInt s of + Just n -> + if n > 0 then + Ok n + + else + Err "limit must be a positive integer" + + Nothing -> + Err ("expected an integer but got: " ++ s) + ) + |> Option.withDescription "Maximum number of tasks to show" + ) + |> OptionsParser.with + (Option.flag "verbose" + |> Option.withDescription "Show full task details" + ) + |> OptionsParser.map ListTasks + ) + |> Program.add + (OptionsParser.buildSubCommand "complete" CompleteOptions + |> OptionsParser.with + (Option.requiredPositionalArg "task-id" + |> Option.withDescription "The ID of the task to mark complete" + ) + |> OptionsParser.map Complete + ) + + +all : Test +all = + describe "Developer & User Experience" + [ describe "1. JSON Schema output (what LLMs see)" + [ test "task manager schema" <| + \() -> + taskConfig + |> Program.toJsonSchema "test" + |> Encode.encode 2 + |> Expect.equal """{ + "$schema": "http://json-schema.org/draft-07/schema#", + "anyOf": [ + { + "description": "test add --title --priority <low|medium|high>\\n\\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above.\\n\\nEach property has an `x-cli-kind` indicating its CLI invocation form:\\n- \\"keyword\\": --name <value>\\n- \\"flag\\": --name (present or absent, no value)\\n- \\"keyword-list\\": --name <value> (repeatable)\\n\\nPositional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty).", + "type": "object", + "properties": { + "title": { + "type": "string", + "x-cli-kind": "keyword", + "description": "The task title" + }, + "priority": { + "type": "string", + "enum": [ + "low", + "medium", + "high" + ], + "x-cli-kind": "keyword", + "description": "Task priority level" + }, + "$cli": { + "type": "object", + "additionalProperties": false, + "properties": { + "subcommand": { + "type": "string", + "const": "add" + } + }, + "required": [ + "subcommand" + ] + } + }, + "required": [ + "title", + "priority", + "$cli" + ], + "additionalProperties": false + }, + { + "description": "test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]\\n\\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above.\\n\\nEach property has an `x-cli-kind` indicating its CLI invocation form:\\n- \\"keyword\\": --name <value>\\n- \\"flag\\": --name (present or absent, no value)\\n- \\"keyword-list\\": --name <value> (repeatable)\\n\\nPositional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty).", + "type": "object", + "properties": { + "format": { + "type": "string", + "enum": [ + "json", + "table", + "csv" + ], + "x-cli-kind": "keyword", + "description": "Output format" + }, + "limit": { + "type": "string", + "x-cli-kind": "keyword", + "description": "Maximum number of tasks to show" + }, + "verbose": { + "type": "boolean", + "x-cli-kind": "flag", + "description": "Show full task details" + }, + "$cli": { + "type": "object", + "additionalProperties": false, + "properties": { + "subcommand": { + "type": "string", + "const": "list" + } + }, + "required": [ + "subcommand" + ] + } + }, + "required": [ + "limit", + "$cli" + ], + "additionalProperties": false + }, + { + "description": "test complete <task-id>\\n\\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above.\\n\\nEach property has an `x-cli-kind` indicating its CLI invocation form:\\n- \\"keyword\\": --name <value>\\n- \\"flag\\": --name (present or absent, no value)\\n- \\"keyword-list\\": --name <value> (repeatable)\\n\\nPositional arguments are passed in order via the `$cli.positional` array.", + "type": "object", + "properties": { + "$cli": { + "type": "object", + "additionalProperties": false, + "properties": { + "subcommand": { + "type": "string", + "const": "complete" + }, + "positional": { + "type": "array", + "description": "Positional arguments, passed in order (e.g., mytool <source> <dest>)", + "items": [ + { + "type": "string", + "description": "The ID of the task to mark complete" + } + ], + "additionalItems": false, + "minItems": 1 + } + }, + "required": [ + "subcommand", + "positional" + ] + } + }, + "required": [ + "$cli" + ], + "additionalProperties": false + } + ] +}""" + ] + , describe "2. Help text (what users see with --help)" + [ test "task manager help" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "--help" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Success + """Usage: mytool add --title <TITLE> --priority <low|medium|high> + +Options: + --title <TITLE> The task title + --priority <low|medium|high> Task priority level + +Usage: mytool list [--format <json|table|csv>] --limit <LIMIT> [--verbose] + +Options: + --format <json|table|csv> Output format + --limit <LIMIT> Maximum number of tasks to show + --verbose Show full task details + +Usage: mytool complete <task-id> + +Options: + <task-id> The ID of the task to mark complete""" + ) + , test "task manager subcommand help" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "list", "--help" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Success + """Usage: mytool list [--format <json|table|csv>] --limit <LIMIT> [--verbose] + +Options: + --format <json|table|csv> Output format + --limit <LIMIT> Maximum number of tasks to show + --verbose Show full task details""" + ) + ] + , describe "3a. CLI mode - correct usage" + [ test "add task via CLI" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "add", "--title", "Buy milk", "--priority", "high" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (Add { title = "Buy milk", priority = High })) + , test "list tasks via CLI" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "list", "--format", "json", "--limit", "10", "--verbose" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (ListTasks { format = Json, limit = 10, verbose = True })) + , test "complete task via CLI" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "complete", "42" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) + ] + , describe "3b. JSON input mode - correct usage" + [ test "add task via JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"title\":\"Buy milk\",\"priority\":\"high\",\"$cli\":{\"subcommand\":\"add\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (Add { title = "Buy milk", priority = High })) + , test "list tasks via JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"format\":\"json\",\"limit\":\"10\",\"verbose\":true,\"$cli\":{\"subcommand\":\"list\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (ListTasks { format = Json, limit = 10, verbose = True })) + , test "complete task via JSON" <| + \() -> + -- Direct JSON decoding: positional args come from $cli.positional + Program.run taskConfig + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"complete\",\"positional\":[\"42\"]}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) + ] + , describe "4a. CLI mode - error messages" + [ test "missing required option" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "add", "--priority", "high" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Missing required option: --title + +mytool add --title <TITLE> --priority <low|medium|high> +mytool list [--format <json|table|csv>] --limit <LIMIT> [--verbose] +mytool complete <task-id>""" + ) + , test "invalid oneOf value" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "add", "--title", "Buy milk", "--priority", "urgent" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--priority` option. +Must be one of [low, medium, high]""" + ) + , test "invalid integer (non-numeric string)" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "list", "--format", "json", "--limit", "abc" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--limit` option. +expected an integer but got: abc""" + ) + , test "invalid integer (negative)" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "list", "--format", "json", "--limit", "-5" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--limit` option. +limit must be a positive integer""" + ) + , test "unknown subcommand" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "delete" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Unknown command: `delete` + +Available commands: add, list, complete + +Run with --help for usage information.""" + ) + , test "unknown option (typo)" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "add", "--title", "Buy milk", "--pririty", "high" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """The `--pririty` flag was not found. Maybe it was one of these typos? + +`--pririty` <> `--priority`""" + ) + ] + , describe "4b. JSON input mode - error messages" + [ test "missing required field in JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"priority\":\"high\",\"$cli\":{\"subcommand\":\"add\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + "Missing required field: \"title\"" + ) + , test "invalid oneOf value in JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"title\":\"Buy milk\",\"priority\":\"urgent\",\"$cli\":{\"subcommand\":\"add\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "priority" field. +Must be one of [low, medium, high]""" + ) + , test "wrong type for limit in JSON (number instead of string)" <| + \() -> + -- With direct JSON decoding, JSON number 10 for a string field is a type error + -- The schema says "type": "string", so LLMs should send "10" not 10 + Program.run taskConfig + [ "node", "mytool", "{\"format\":\"json\",\"limit\":10,\"$cli\":{\"subcommand\":\"list\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "limit" field. +Problem with the value at json.limit: + + 10 + +Expecting a STRING""" + ) + ] + , describe "5. String vs int type difference" + [ test "limit as string '10' works (CLI)" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "list", "--format", "table", "--limit", "10" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (ListTasks { format = Table, limit = 10, verbose = False })) + , test "limit as number 10 in JSON fails (no silent coercion)" <| + \() -> + -- With direct JSON decoding, number 10 for a string field is a type error. + -- The schema says "type": "string" for limit. LLMs should send "10" not 10. + -- No more silent number-to-string coercion. + Program.run taskConfig + [ "node", "mytool", "{\"format\":\"table\",\"limit\":10,\"$cli\":{\"subcommand\":\"list\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "limit" field. +Problem with the value at json.limit: + + 10 + +Expecting a STRING""" + ) + ] + ] diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm new file mode 100644 index 0000000..45bfefd --- /dev/null +++ b/tests/JsonSchemaTests.elm @@ -0,0 +1,1237 @@ +module JsonSchemaTests exposing (all) + +import Cli.Option as Option +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Expect +import Json.Encode as Encode +import Test exposing (..) + + +all : Test +all = + describe "toJsonSchema" + [ describe "single parser" + [ test "single required keyword arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> expectJsonSchema + { description = "test --name <NAME>" + , properties = + [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] + , required = [ "name" ] + } + , test "top-level schema declares draft-07" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --name <NAME>" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "name" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "schema forbids additional top-level and $cli properties" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --name <NAME>" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "name" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "optional keyword arg is not required" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optionalKeywordArg "greeting") + ) + |> expectJsonSchema + { description = "test [--greeting <GREETING>]" + , properties = + [ ( "greeting", [ ( "type", Encode.string "string" ) ] ) ] + , required = [] + } + , test "flag is boolean and not required" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test [--verbose]" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "verbose" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "required positional arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "file") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test <file>" True) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "items" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "file" ) ] ] + ) + , ( "additionalItems", Encode.bool False ) + , ( "minItems", Encode.int 1 ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "positional" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "fixed positional args with rest args use draft-07 tuple syntax" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build Tuple.pair + |> OptionsParser.with (Option.requiredPositionalArg "source") + |> OptionsParser.withRestArgs (Option.restArgs "targets") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test <source> <targets>..." True) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "items" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "source" ) ] ] + ) + , ( "additionalItems" + , Encode.object [ ( "type", Encode.string "string" ) ] + ) + , ( "minItems", Encode.int 1 ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "positional" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "optional positional arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg (Option.optionalPositionalArg "revision") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test [<revision>]" True) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "items" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "revision" ) ] ] + ) + , ( "additionalItems", Encode.bool False ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "rest args is array of strings" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withRestArgs (Option.restArgs "files") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test <files>..." True) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "keyword arg list is array of strings" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.keywordArgList "header") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test [--header <HEADER>]..." False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "header" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "x-cli-kind", Encode.string "keyword-list" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "description is included" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "name" + |> Option.withDescription "The user's name" + ) + ) + |> expectJsonSchema + { description = "test --name <NAME>" + , properties = + [ ( "name" + , [ ( "type", Encode.string "string" ) + , ( "description", Encode.string "The user's name" ) + ] + ) + ] + , required = [ "name" ] + } + , test "oneOf adds anyOf with const values" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "format" + |> Option.oneOf + [ ( "json", () ) + , ( "junit", () ) + , ( "console", () ) + ] + ) + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --format <json|junit|console>" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "enum", Encode.list Encode.string [ "json", "junit", "console" ] ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "mixed options - required and optional together" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build (\a b c -> ( a, b, c )) + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.with (Option.optionalKeywordArg "greeting") + |> OptionsParser.with (Option.flag "verbose") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --name <NAME> [--greeting <GREETING>] [--verbose]" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "name" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "greeting" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "verbose" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "expectFlag produces required constraint in schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build () + |> OptionsParser.expectFlag "init" + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --init" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "init" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "init", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "multiple expectFlags produce required on flags object" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build () + |> OptionsParser.expectFlag "init" + |> OptionsParser.expectFlag "force" + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test --init --force" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "init" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "force" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "init", "force", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "mixed flag and expectFlag — only expectFlag gets required" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + |> OptionsParser.expectFlag "init" + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test [--verbose] --init" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "verbose" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "init" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "init", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "discriminated union with expectFlag produces anyOf with required flags" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.expectFlag "init" + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.map (\_ -> ()) + ) + |> Program.add + (OptionsParser.build identity + |> OptionsParser.expectFlag "build" + |> OptionsParser.with (Option.flag "verbose") + |> OptionsParser.map (\_ -> ()) + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "anyOf" + , Encode.list identity + [ Encode.object + [ ( "description", Encode.string (fullDescription "test --init --name <NAME>" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "init" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "name" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "init", "name", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + , Encode.object + [ ( "description", Encode.string (fullDescription "test --build [--verbose]" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "build" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "verbose" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "build", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + ] + ) + ] + |> Encode.encode 0 + ) + , test "no options produces empty object schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build ()) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + ] + , describe "subcommands" + [ test "single subcommand includes subcommand property" <| + \() -> + Program.config + |> Program.add + (OptionsParser.buildSubCommand "init" identity + |> OptionsParser.with (Option.flag "bare") + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription "test init [--bare]" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "bare" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + , test "multiple subcommands produce anyOf" <| + \() -> + Program.config + |> Program.add + (OptionsParser.buildSubCommand "init" () + |> OptionsParser.map (\_ -> ()) + ) + |> Program.add + (OptionsParser.buildSubCommand "clone" identity + |> OptionsParser.with (Option.requiredPositionalArg "repository") + |> OptionsParser.map (\_ -> ()) + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "anyOf" + , Encode.list identity + [ Encode.object + [ ( "description", Encode.string (fullDescription "test init" False) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + , Encode.object + [ ( "description", Encode.string (fullDescription "test clone <repository>" True) ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) + , ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "items" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "repository" ) ] ] + ) + , ( "additionalItems", Encode.bool False ) + , ( "minItems", Encode.int 1 ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "subcommand", "positional" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + ] + ) + ] + |> Encode.encode 0 + ) + ] + , describe "JSON input mode" + [ test "accepts JSON blob with $cli sentinel" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build (\name greeting -> { name = name, greeting = greeting }) + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.with (Option.optionalKeywordArg "greeting") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"greeting\":\"Hi\",\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch { name = "World", greeting = Just "Hi" }) + , test "JSON input mode with boolean flag" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build (\name verbose -> { name = name, verbose = verbose }) + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.with (Option.flag "verbose") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"verbose\":true,\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch { name = "World", verbose = True }) + , test "JSON input mode with subcommand" <| + \() -> + Program.config + |> Program.add + (OptionsParser.buildSubCommand "greet" identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"$cli\":{\"subcommand\":\"greet\"}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch "World") + , test "JSON input mode with missing required field gives JSON-native error" <| + \() -> + let + cfg = + Program.config + |> Program.add + (OptionsParser.build (\name greeting -> { name = name, greeting = greeting }) + |> OptionsParser.with (Option.requiredKeywordArg "name") + |> OptionsParser.with (Option.optionalKeywordArg "greeting") + ) + in + Program.run cfg + [ "node", "test", "{\"greeting\":\"Hi\",\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + "Missing required field: \"name\"" + ) + , test "JSON input mode with wrong type for untyped arg gives type error" <| + \() -> + -- With direct JSON decoding, number 123 for a string field is a type error. + -- No more silent number-to-string coercion. + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":123,\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "name" field. +Problem with the value at json.name: + + 123 + +Expecting a STRING""" + ) + , test "JSON input mode rejects unexpected top-level field" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"nickname\":\"W\",\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + "Unexpected field: \"nickname\"" + ) + , test "JSON input mode rejects unexpected $cli field" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"$cli\":{\"mode\":\"json\"}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + "Unexpected field: \"$cli.mode\"" + ) + , test "JSON input mode rejects non-array $cli.positional" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "file") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":{\"positional\":123}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "$cli.positional" field. +Problem with the value at json['$cli'].positional: + + 123 + +Expecting a LIST""" + ) + , test "JSON input mode rejects non-string $cli.subcommand" <| + \() -> + Program.config + |> Program.add + (OptionsParser.buildSubCommand "greet" identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"name\":\"World\",\"$cli\":{\"subcommand\":123}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "$cli.subcommand" field. +Problem with the value at json['$cli'].subcommand: + + 123 + +Expecting a STRING""" + ) + , test "JSON input mode rejects non-array $cli.positional for optional positional args" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg (Option.optionalPositionalArg "revision") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":{\"positional\":123}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "$cli.positional" field. +Problem with the value at json['$cli'].positional: + + 123 + +Expecting a LIST""" + ) + , test "JSON input mode rejects extra positional values" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "file") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":{\"positional\":[\"a.txt\",\"b.txt\"]}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.SystemMessage Program.Failure + "Too many positional arguments in \"$cli.positional\"." + ) + , test "JSON input mode only reports fields as unexpected when no parser accepts them" <| + \() -> + let + cfg = + Program.config + |> Program.add + (OptionsParser.build (\name -> "init:" ++ name) + |> OptionsParser.expectFlag "init" + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.add + (OptionsParser.build "build" + |> OptionsParser.expectFlag "build" + ) + in + Program.run cfg + [ "node", "test", "{\"init\":true,\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + "Missing required field: \"name\"" + ) + , test "JSON input mode expectFlag selects init branch" <| + \() -> + let + cfg = + Program.config + |> Program.add + (OptionsParser.build (\name -> "init:" ++ name) + |> OptionsParser.expectFlag "init" + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.add + (OptionsParser.build + (\verbose -> + "build:" + ++ (if verbose then + "verbose" + + else + "quiet" + ) + ) + |> OptionsParser.expectFlag "build" + |> OptionsParser.with (Option.flag "verbose") + ) + in + Program.run cfg + [ "node", "test", "{\"init\":true,\"name\":\"my-project\",\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch "init:my-project") + , test "JSON input mode expectFlag selects build branch" <| + \() -> + let + cfg = + Program.config + |> Program.add + (OptionsParser.build (\name -> "init:" ++ name) + |> OptionsParser.expectFlag "init" + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.add + (OptionsParser.build + (\verbose -> + "build:" + ++ (if verbose then + "verbose" + + else + "quiet" + ) + ) + |> OptionsParser.expectFlag "build" + |> OptionsParser.with (Option.flag "verbose") + ) + in + Program.run cfg + [ "node", "test", "{\"build\":true,\"verbose\":true,\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch "build:verbose") + , test "JSON input mode expectFlag rejects when flag missing" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build () + |> OptionsParser.expectFlag "init" + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":{}}" ] + "1.0.0" + Program.WithoutColor + ) + |> (\result -> + case result of + Program.SystemMessage Program.Failure _ -> + Expect.pass + + _ -> + Expect.fail ("Expected failure but got: " ++ Debug.toString result) + ) + , test "malformed JSON falls back to regular CLI parsing" <| + \() -> + -- Malformed JSON is NOT treated as JSON input mode, + -- it falls back to regular CLI parsing where it becomes a positional arg + let + result = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "input") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{not valid json" ] + "1.0.0" + Program.WithoutColor + ) + in + Expect.equal result (Program.CustomMatch "{not valid json") + ] + ] + + +{-| Build the full description with invocation instructions, matching the source code's +`buildSchemaDescription` function. +-} +fullDescription : String -> Bool -> String +fullDescription synopsis hasPositionalArgs = + let + positionalNote = + if hasPositionalArgs then + "Positional arguments are passed in order via the `$cli.positional` array." + + else + "Positional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty)." + in + synopsis + ++ "\n\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above." + ++ "\n\nEach property has an `x-cli-kind` indicating its CLI invocation form:\n- \"keyword\": --name <value>\n- \"flag\": --name (present or absent, no value)\n- \"keyword-list\": --name <value> (repeatable)" + ++ "\n\n" + ++ positionalNote + + +{-| Helper to build expected JSON Schema and compare. +Used for tests where only keyword args are present (no flags, positional args, +or keyword arg lists). Places keyword args as flat top-level properties with +`x-cli-kind: "keyword"` and a `$cli: {"type": "object"}`. +-} +expectJsonSchema : + { description : String + , properties : List ( String, List ( String, Encode.Value ) ) + , required : List String + } + -> Program.Config msg + -> Expect.Expectation +expectJsonSchema { description, properties, required } config = + let + topLevelProperties = + properties + |> List.map + (\( name, fields ) -> + let + -- Separate base type fields from description + baseFields = + fields |> List.filter (\( k, _ ) -> k /= "description") + + descFields = + fields |> List.filter (\( k, _ ) -> k == "description") + in + ( name + , Encode.object + (baseFields ++ [ ( "x-cli-kind", Encode.string "keyword" ) ] ++ descFields) + ) + ) + + cliObj = + Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + + allProperties = + topLevelProperties ++ [ ( "$cli", cliObj ) ] + + allRequired = + required ++ [ "$cli" ] + in + config + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (fullDescription description False) ) + , ( "type", Encode.string "object" ) + , ( "properties", Encode.object allProperties ) + , ( "required", Encode.list Encode.string allRequired ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + + +draft07Object : List ( String, Encode.Value ) -> Encode.Value +draft07Object fields = + Encode.object + (( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + :: fields + ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm new file mode 100644 index 0000000..dd3620c --- /dev/null +++ b/tests/TsTypeTests.elm @@ -0,0 +1,252 @@ +module TsTypeTests exposing (all) + +import Cli.Option as Option +import Cli.Option.Internal as Internal +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Expect +import Json.Encode as Encode +import Test exposing (..) +import TsJson.Type + + +{-| Extract the TsType from an option and convert to JSON Schema for testing. +-} +optionTsTypeToJsonSchema : Internal.Option from to constraints -> Encode.Value +optionTsTypeToJsonSchema (Internal.Option innerOption) = + TsJson.Type.toJsonSchema innerOption.tsType + + +all : Test +all = + describe "Option TsType" + [ describe "basic option constructors carry correct TsType" + [ test "requiredKeywordArg has string type" <| + \() -> + Option.requiredKeywordArg "name" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "optionalKeywordArg has string type (optionality expressed via required array)" <| + \() -> + Option.optionalKeywordArg "greeting" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "flag has boolean type" <| + \() -> + Option.flag "verbose" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "boolean" ) + ] + |> Encode.encode 0 + ) + , test "requiredPositionalArg has string type" <| + \() -> + Option.requiredPositionalArg "file" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "optionalPositionalArg has string type (optionality expressed via required array)" <| + \() -> + Option.optionalPositionalArg "revision" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "keywordArgList has array of strings type" <| + \() -> + Option.keywordArgList "header" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + |> Encode.encode 0 + ) + , test "restArgs has array of strings type" <| + \() -> + Option.restArgs "files" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + |> Encode.encode 0 + ) + ] + , describe "modifiers preserve TsType" + [ test "map preserves TsType" <| + \() -> + Option.requiredKeywordArg "name" + |> Option.map String.toUpper + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "validateMap preserves TsType" <| + \() -> + Option.requiredKeywordArg "count" + |> Option.validateMap + (\s -> + case String.toInt s of + Just n -> + Ok n + + Nothing -> + Err "not an int" + ) + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "withDefault preserves TsType" <| + \() -> + Option.optionalKeywordArg "greeting" + |> Option.withDefault "hello" + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + ] + |> Encode.encode 0 + ) + , test "mapFlag preserves TsType" <| + \() -> + Option.flag "verbose" + |> Option.mapFlag { present = "yes", absent = "no" } + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "boolean" ) + ] + |> Encode.encode 0 + ) + ] + , describe "oneOf updates TsType" + [ test "oneOf on requiredKeywordArg produces string literal union type" <| + \() -> + Option.requiredKeywordArg "format" + |> Option.oneOf + [ ( "json", () ) + , ( "junit", () ) + , ( "console", () ) + ] + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "string" ) + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] + ) + ] + |> Encode.encode 0 + ) + ] + , describe "toJsonSchema output" + [ test "oneOf uses anyOf/const format" <| + \() -> + let + cfg = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "format" + |> Option.oneOf + [ ( "json", () ) + , ( "junit", () ) + , ( "console", () ) + ] + ) + ) + + desc = + "test --format <json|junit|console>" + ++ "\n\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above." + ++ "\n\nEach property has an `x-cli-kind` indicating its CLI invocation form:\n- \"keyword\": --name <value>\n- \"flag\": --name (present or absent, no value)\n- \"keyword-list\": --name <value> (repeatable)" + ++ "\n\nPositional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty)." + in + cfg + |> Program.toJsonSchema "test" + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "description", Encode.string desc ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] + ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + ] + ] diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm new file mode 100644 index 0000000..cc566a6 --- /dev/null +++ b/tests/TypedOptionTests.elm @@ -0,0 +1,641 @@ +module TypedOptionTests exposing (all) + +import Cli.Option +import Cli.Option.Typed as Option +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Expect +import Json.Encode as Encode +import Test exposing (..) +import TsJson.Decode as TsDecode + + +all : Test +all = + describe "Cli.Option.Typed" + [ describe "Option.string" + [ test "parses bare CLI arg" <| + \() -> + runWith (Option.requiredKeywordArg "name" Option.string) + [ "--name", "hello" ] + |> Expect.equal (Program.CustomMatch "hello") + , test "preserves numeric-looking input as string" <| + \() -> + runWith (Option.requiredKeywordArg "name" Option.string) + [ "--name", "42" ] + |> Expect.equal (Program.CustomMatch "42") + , test "preserves 'true' as string" <| + \() -> + runWith (Option.requiredKeywordArg "name" Option.string) + [ "--name", "true" ] + |> Expect.equal (Program.CustomMatch "true") + , test "preserves 'null' as string" <| + \() -> + runWith (Option.requiredKeywordArg "name" Option.string) + [ "--name", "null" ] + |> Expect.equal (Program.CustomMatch "null") + , test "preserves quotes in input" <| + \() -> + runWith (Option.requiredKeywordArg "name" Option.string) + [ "--name", "\"quoted\"" ] + |> Expect.equal (Program.CustomMatch "\"quoted\"") + , test "preserves spaces and special chars" <| + \() -> + runWith (Option.requiredKeywordArg "msg" Option.string) + [ "--msg", "hello world!" ] + |> Expect.equal (Program.CustomMatch "hello world!") + , test "works in JSON mode" <| + \() -> + runJsonWith (Option.requiredKeywordArg "name" Option.string) + [ ( "name", Encode.string "hello" ) ] + |> Expect.equal (Program.CustomMatch "hello") + , test "produces string schema" <| + \() -> + schemaFor (Option.requiredKeywordArg "name" Option.string) + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (schemaDescription "test --name <NAME>") ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "name" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + ] + , describe "Option.int" + [ test "parses numeric CLI arg" <| + \() -> + runWith (Option.requiredKeywordArg "count" Option.int) + [ "--count", "42" ] + |> Expect.equal (Program.CustomMatch 42) + , test "parses negative int" <| + \() -> + runWith (Option.requiredKeywordArg "count" Option.int) + [ "--count", "-7" ] + |> Expect.equal (Program.CustomMatch -7) + , test "rejects float" <| + \() -> + runWith (Option.requiredKeywordArg "count" Option.int) + [ "--count", "3.14" ] + |> expectFailure + , test "rejects bare text with clear error" <| + \() -> + runWith (Option.requiredKeywordArg "count" Option.int) + [ "--count", "abc" ] + |> expectFailure + , test "rejects 'true'" <| + \() -> + runWith (Option.requiredKeywordArg "count" Option.int) + [ "--count", "true" ] + |> expectFailure + , test "works in JSON mode" <| + \() -> + runJsonWith (Option.requiredKeywordArg "count" Option.int) + [ ( "count", Encode.int 42 ) ] + |> Expect.equal (Program.CustomMatch 42) + , test "JSON mode rejects string" <| + \() -> + runJsonWith (Option.requiredKeywordArg "count" Option.int) + [ ( "count", Encode.string "abc" ) ] + |> expectFailure + , test "produces integer schema" <| + \() -> + schemaFor (Option.requiredKeywordArg "count" Option.int) + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "x-cli-kind", Encode.string "keyword" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "count", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + ] + , describe "Option.float" + [ test "parses float CLI arg" <| + \() -> + runWith (Option.requiredKeywordArg "rate" Option.float) + [ "--rate", "3.14" ] + |> Expect.equal (Program.CustomMatch 3.14) + , test "parses integer as float" <| + \() -> + runWith (Option.requiredKeywordArg "rate" Option.float) + [ "--rate", "42" ] + |> Expect.equal (Program.CustomMatch 42.0) + , test "rejects bare text" <| + \() -> + runWith (Option.requiredKeywordArg "rate" Option.float) + [ "--rate", "abc" ] + |> expectFailure + ] + , describe "customDecoder" + [ test "custom decoder works in JSON mode" <| + \() -> + let + pointDecoder = + TsDecode.succeed (\x y -> ( x, y )) + |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) + |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) + in + runJsonWith (Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder)) + [ ( "point", Encode.object [ ( "x", Encode.int 1 ), ( "y", Encode.int 2 ) ] ) ] + |> Expect.equal (Program.CustomMatch ( 1, 2 )) + , test "custom decoder in CLI mode expects strict JSON" <| + \() -> + let + pointDecoder = + TsDecode.succeed (\x y -> ( x, y )) + |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) + |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) + in + runWith (Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder)) + [ "--point", "{\"x\":1,\"y\":2}" ] + |> Expect.equal (Program.CustomMatch ( 1, 2 )) + , test "customDecoder TsDecode.string in CLI mode requires JSON-quoted string" <| + \() -> + -- bare text is NOT valid JSON — this should fail + runWith (Option.requiredKeywordArg "name" (Option.customDecoder TsDecode.string)) + [ "--name", "hello" ] + |> expectFailure + , test "customDecoder TsDecode.string in CLI mode accepts JSON-quoted string" <| + \() -> + -- JSON string: "hello" (with quotes on CLI) + runWith (Option.requiredKeywordArg "name" (Option.customDecoder TsDecode.string)) + [ "--name", "\"hello\"" ] + |> Expect.equal (Program.CustomMatch "hello") + ] + , describe "optionalKeywordArg" + [ test "returns Just when present" <| + \() -> + runWith (Option.optionalKeywordArg "greeting" Option.string) + [ "--greeting", "hi" ] + |> Expect.equal (Program.CustomMatch (Just "hi")) + , test "returns Nothing when absent" <| + \() -> + runWith (Option.optionalKeywordArg "greeting" Option.string) + [{- absent -}] + |> Expect.equal (Program.CustomMatch Nothing) + , test "optional int present" <| + \() -> + runWith (Option.optionalKeywordArg "count" Option.int) + [ "--count", "42" ] + |> Expect.equal (Program.CustomMatch (Just 42)) + , test "optional int invalid gives error" <| + \() -> + runWith (Option.optionalKeywordArg "count" Option.int) + [ "--count", "abc" ] + |> expectFailure + ] + , describe "keywordArgList" + [ test "collects repeated args" <| + \() -> + runWith (Option.keywordArgList "header" Option.string) + [ "--header", "X-A: 1", "--header", "X-B: 2" ] + |> Expect.equal (Program.CustomMatch [ "X-A: 1", "X-B: 2" ]) + ] + , describe "requiredPositionalArg" + [ test "string positional" <| + \() -> + runWith (Option.requiredPositionalArg "file" Option.string) + [ "hello.txt" ] + |> Expect.equal (Program.CustomMatch "hello.txt") + , test "int positional" <| + \() -> + runWith (Option.requiredPositionalArg "port" Option.int) + [ "8080" ] + |> Expect.equal (Program.CustomMatch 8080) + ] + , describe "optionalPositionalArg" + [ test "returns Just when present" <| + \() -> + runOptionalPositionalWith (Option.optionalPositionalArg "revision" Option.string) + [ "abc123" ] + |> Expect.equal (Program.CustomMatch (Just "abc123")) + , test "returns Nothing when absent" <| + \() -> + runOptionalPositionalWith (Option.optionalPositionalArg "revision" Option.string) + [] + |> Expect.equal (Program.CustomMatch Nothing) + ] + , describe "flag and restArgs (no decoder)" + [ test "flag works" <| + \() -> + runWith (Option.flag "verbose") + [ "--verbose" ] + |> Expect.equal (Program.CustomMatch True) + , test "restArgs collects remaining args" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withRestArgs (Option.restArgs "files") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "a.txt", "b.txt" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch [ "a.txt", "b.txt" ]) + ] + , describe "JSON input with $cli object" + [ test "keyword list at top level" <| + \() -> + let + jsonArg = + Encode.object + [ ( "header", Encode.list Encode.string [ "X-A: 1", "X-B: 2" ] ) + , ( "$cli", Encode.object [] ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.keywordArgList "header" Option.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch [ "X-A: 1", "X-B: 2" ]) + , test "keyword list absent defaults to empty" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli", Encode.object [] ) ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.keywordArgList "header" Option.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch []) + , test "positional arg via $cli.positional" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "hello.txt" ] ) ] + ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "file" Option.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch "hello.txt") + , test "multiple positional args via $cli.positional" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "src.txt", "dest.txt" ] ) ] + ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build Tuple.pair + |> OptionsParser.with (Option.requiredPositionalArg "source" Option.string) + |> OptionsParser.with (Option.requiredPositionalArg "dest" Option.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch ( "src.txt", "dest.txt" )) + , test "rest args via $cli.positional tail" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "a.txt", "b.txt", "c.txt" ] ) ] + ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build Tuple.pair + |> OptionsParser.with (Option.requiredPositionalArg "source" Option.string) + |> OptionsParser.withRestArgs (Option.restArgs "files") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch ( "a.txt", [ "b.txt", "c.txt" ] )) + , test "rest args only (no fixed positional) via $cli.positional" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "x.txt", "y.txt" ] ) ] + ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withRestArgs (Option.restArgs "files") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch [ "x.txt", "y.txt" ]) + , test "flag at top level" <| + \() -> + let + jsonArg = + Encode.object + [ ( "verbose", Encode.bool True ) + , ( "$cli", Encode.object [] ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch True) + , test "flag absent defaults to False" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli", Encode.object [] ) ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch False) + , test "mixed: positional + keyword + flag + keyword list" <| + \() -> + let + jsonArg = + Encode.object + [ ( "limit", Encode.string "10" ) + , ( "verbose", Encode.bool True ) + , ( "header", Encode.list Encode.string [ "X-A: 1" ] ) + , ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "input.txt" ] ) ] + ) + ] + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build (\file limit verbose headers -> ( ( file, limit ), ( verbose, headers ) )) + |> OptionsParser.with (Option.requiredPositionalArg "file" Option.string) + |> OptionsParser.with (Option.requiredKeywordArg "limit" Option.string) + |> OptionsParser.with (Option.flag "verbose") + |> OptionsParser.with (Option.keywordArgList "header" Option.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch + ( ( "input.txt", "10" ), ( True, [ "X-A: 1" ] ) ) + ) + ] + , describe "modifiers" + [ test "oneOf works" <| + \() -> + runWith + (Option.requiredKeywordArg "format" Option.string + |> Option.oneOf + [ ( "json", "JSON" ) + , ( "csv", "CSV" ) + ] + ) + [ "--format", "json" ] + |> Expect.equal (Program.CustomMatch "JSON") + , test "withDescription adds to schema" <| + \() -> + schemaFor + (Option.requiredKeywordArg "count" Option.int + |> Option.withDescription "Number of items" + ) + |> Expect.equal + (draft07Object + [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "x-cli-kind", Encode.string "keyword" ) + , ( "description", Encode.string "Number of items" ) + ] + ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "count", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) + ] + |> Encode.encode 0 + ) + ] + ] + + + +-- Test helpers + + +runWith : Option.Option from to { c | position : Cli.Option.BeginningOption } -> List String -> Program.RunResult to +runWith option args = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with option + ) + |> (\cfg -> + Program.run cfg + ([ "node", "test" ] ++ args) + "1.0.0" + Program.WithoutColor + ) + + +runOptionalPositionalWith : Option.Option from to { c | position : Cli.Option.OptionalPositionalArgOption } -> List String -> Program.RunResult to +runOptionalPositionalWith option args = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg option + ) + |> (\cfg -> + Program.run cfg + ([ "node", "test" ] ++ args) + "1.0.0" + Program.WithoutColor + ) + + +runJsonWith : Option.Option from to { c | position : Cli.Option.BeginningOption } -> List ( String, Encode.Value ) -> Program.RunResult to +runJsonWith option fields = + let + jsonArg = + Encode.object + (fields ++ [ ( "$cli", Encode.object [] ) ]) + |> Encode.encode 0 + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with option + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", jsonArg ] + "1.0.0" + Program.WithoutColor + ) + + +schemaFor : Option.Option from to { c | position : Cli.Option.BeginningOption } -> String +schemaFor option = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with option + ) + |> Program.toJsonSchema "test" + |> Encode.encode 0 + + +schemaDescription : String -> String +schemaDescription usageSynopsis = + usageSynopsis + ++ "\n\nTo invoke this command, build a JSON object matching this schema and pass it as a single argument. Alternatively, use traditional CLI flags as shown in the usage line above." + ++ "\n\nEach property has an `x-cli-kind` indicating its CLI invocation form:\n- \"keyword\": --name <value>\n- \"flag\": --name (present or absent, no value)\n- \"keyword-list\": --name <value> (repeatable)" + ++ "\n\nPositional arguments are passed in order via the `$cli.positional` array (for this CLI it will always be empty)." + + +draft07Object : List ( String, Encode.Value ) -> Encode.Value +draft07Object fields = + Encode.object + (( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + :: fields + ) + + +expectFailure : Program.RunResult msg -> Expect.Expectation +expectFailure result = + case result of + Program.SystemMessage Program.Failure _ -> + Expect.pass + + other -> + Expect.fail ("Expected SystemMessage Failure but got: " ++ Debug.toString other) + + +expectFailureContaining : String -> Program.RunResult msg -> Expect.Expectation +expectFailureContaining substring result = + case result of + Program.SystemMessage Program.Failure message -> + if String.contains substring (String.toUpper message) then + Expect.pass + + else + Expect.fail ("Expected error containing \"" ++ substring ++ "\" but got:\n" ++ message) + + other -> + Expect.fail ("Expected SystemMessage Failure but got: " ++ Debug.toString other)