From 10d1a5d36b71cf74fde351cfd393571b76080d94 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 11 Mar 2026 21:44:10 -0700 Subject: [PATCH 01/34] Add proof of concept for Json Schema types and JSON input format for CLIs. --- elm.json | 2 + snapshot-tests/elm.json | 3 + src/Cli/LowLevel.elm | 42 +- src/Cli/Option.elm | 526 ++++++++++++++++++++++- src/Cli/Option/Internal.elm | 12 + src/Cli/OptionsParser.elm | 121 +++++- src/Cli/Program.elm | 318 ++++++++++++++ src/Cli/UsageSpec.elm | 6 +- tests/ExperienceTests.elm | 637 +++++++++++++++++++++++++++ tests/JsonSchemaTests.elm | 832 ++++++++++++++++++++++++++++++++++++ tests/TsTypeTests.elm | 285 ++++++++++++ 11 files changed, 2753 insertions(+), 31 deletions(-) create mode 100644 tests/ExperienceTests.elm create mode 100644 tests/JsonSchemaTests.elm create mode 100644 tests/TsTypeTests.elm diff --git a/elm.json b/elm.json index c119204..3adf87c 100644 --- a/elm.json +++ b/elm.json @@ -13,7 +13,9 @@ ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { + "dillonkearns/elm-ts-json": "2.1.1 <= 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/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..21fa7d2 100644 --- a/src/Cli/LowLevel.elm +++ b/src/Cli/LowLevel.elm @@ -1,10 +1,11 @@ -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 Json.Decode import List.Extra import Set exposing (Set) @@ -266,3 +267,42 @@ 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 (OptionsParser.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 + (matchResults + |> List.concatMap + (\matchResult -> + case matchResult of + MatchResult.NoMatch reasons -> + reasons + + _ -> + [] + ) + ) + ) diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 4da56bc..c45d16d 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -1,13 +1,16 @@ module Cli.Option exposing ( requiredPositionalArg , optionalKeywordArg, requiredKeywordArg, keywordArgList + , required, optional , flag , optionalPositionalArg, restArgs , oneOf , validate, validateIfPresent, validateMap, validateMapIfPresent , map, mapFlag, withDefault + , withTypedJson, withTypedJsonIfPresent , withDescription, withDisplayName, withMissingMessage , Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption + , NoSchema, HasSchema ) {-| Here is the terminology used for building up Command-Line parsers with this library. @@ -28,6 +31,11 @@ and using `Cli.Option`s. @docs optionalKeywordArg, requiredKeywordArg, keywordArgList +## Typed Keyword Arguments + +@docs required, optional + + ## Flags @docs flag @@ -100,6 +108,11 @@ with the following functions. @docs map, mapFlag, withDefault +### Typed JSON + +@docs withTypedJson, withTypedJsonIfPresent + + ### Metadata @docs withDescription, withDisplayName, withMissingMessage @@ -108,6 +121,7 @@ with the following functions. ## Types @docs Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption +@docs NoSchema, HasSchema -} @@ -115,9 +129,20 @@ 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 Json.Encode import List.Extra import Occurences exposing (Occurences(..)) import Tokenizer +import TsJson.Decode as TsDecode +import TsJson.Type + + +{-| Extract the TsType from a TsDecode.Decoder for use as the value-level schema type. +-} +tsTypeOf : TsDecode.Decoder a -> TsJson.Type.Type +tsTypeOf = + TsDecode.tsType {-| The type returned by the builder functions below. Use with `OptionsParser.with`. @@ -153,12 +178,30 @@ type OptionalPositionalArgOption = OptionalPositionalArgOption Never +{-| Phantom type marker indicating no JSON schema has been set on this option. +All option constructors start with `NoSchema`. Once `withTypedJson` is applied, +the marker changes to `HasSchema`, preventing it from being applied again. +-} +type NoSchema + = NoSchema Never + + +{-| Phantom type marker indicating a JSON schema has been set on this option +via `withTypedJson`. This prevents `withTypedJson` from being applied a second time. +-} +type HasSchema + = HasSchema Never + + {-| Run a validation. (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). -} 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 +213,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 } @@ -206,7 +264,7 @@ Parses to: `"src/Main.elm"` Option.requiredPositionalArg "input" -} -requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } +requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : (), hasSchema : NoSchema } requiredPositionalArg operandDescription = buildRequiredOption (\{ operands, operandsSoFar } -> @@ -228,6 +286,12 @@ requiredPositionalArg operandDescription = |> Err ) (UsageSpec.operand operandDescription) + (tsTypeOf TsDecode.string) + (jsonFieldGrabber operandDescription Json.Decode.string + (Cli.Decode.MissingRequiredPositionalArg + { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } + ) + ) {-| A keyword argument that may be omitted. @@ -238,7 +302,7 @@ Parses to: `Just "main.js"` (or `Nothing` if omitted) Option.optionalKeywordArg "output" -} -optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption } +optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption, hasSchema : NoSchema } optionalKeywordArg optionName = buildOptionalOption (\{ options } -> @@ -259,6 +323,8 @@ optionalKeywordArg optionName = |> Err ) (UsageSpec.keywordArg optionName Optional) + (tsTypeOf TsDecode.string) + (jsonOptionalFieldGrabber optionName Json.Decode.string) {-| A keyword argument that must be provided. @@ -269,7 +335,7 @@ Parses to: `"my-app"` Option.requiredKeywordArg "name" -} -requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } +requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : (), hasSchema : NoSchema } requiredKeywordArg optionName = buildRequiredOption (\{ options } -> @@ -292,6 +358,136 @@ requiredKeywordArg optionName = |> Err ) (UsageSpec.keywordArg optionName Required) + (tsTypeOf TsDecode.string) + (jsonFieldGrabber optionName Json.Decode.string + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + ) + + +{-| A required keyword argument with a typed JSON decoder. + +In CLI mode, the string value is parsed via `Json.Decode.decodeString`. +In JSON mode, the value is decoded natively from the JSON field. +The schema type comes from the decoder (e.g., `TsDecode.int` → `"type": "integer"`). + + Option.required "count" TsDecode.int + -- CLI: --count 42 → string "42" → decodeString → Int + -- JSON: {"count": 42} → Int directly + -- Schema: {"type": "integer"} + +-} +required : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : (), hasSchema : HasSchema } +required optionName tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ 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 + , usageSpec = UsageSpec.keywordArg optionName Required + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (decodeCliString optionName elmJsonDecoder) + , meta = emptyMeta + , tsType = tsTypeOf tsDecoder + , jsonGrabber = + jsonFieldGrabber optionName elmJsonDecoder + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + } + + +{-| An optional keyword argument with a typed JSON decoder. + +In CLI mode, the string value is parsed via `Json.Decode.decodeString`. +In JSON mode, the value is decoded natively from the JSON field. +Returns `Nothing` if the option is omitted. + + Option.optional "count" TsDecode.int + -- CLI: --count 42 → Just 42, omitted → Nothing + -- JSON: {"count": 42} → Just 42, absent → Nothing + -- Schema: {"type": "integer"} (not in required array) + +-} +optional : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption, hasSchema : HasSchema } +optional optionName tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ 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 + , usageSpec = UsageSpec.keywordArg optionName Optional + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just stringValue -> + decodeCliString optionName elmJsonDecoder stringValue + |> Result.map Just + + Nothing -> + Ok Nothing + ) + , meta = emptyMeta + , tsType = tsTypeOf tsDecoder + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of + Ok value -> + Ok ( [], Just value ) + + Err decodeError -> + -- Check if the field is absent (ok, return Nothing) or wrong type (error) + case Json.Decode.decodeValue (Json.Decode.field optionName Json.Decode.value) blob of + Ok _ -> + -- Field exists but wrong type + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + -- Field absent, that's fine for optional + Ok ( [], Nothing ) + } {-| A flag with no argument. @@ -302,7 +498,7 @@ Parses to: `True` (or `False` if omitted) Option.flag "debug" -} -flag : String -> Option Bool Bool { position : BeginningOption } +flag : String -> Option Bool Bool { position : BeginningOption, hasSchema : NoSchema } flag flagName = buildOptionalOption (\{ options } -> @@ -316,41 +512,49 @@ flag flagName = Ok False ) (UsageSpec.flag flagName Optional) + (tsTypeOf TsDecode.bool) + (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 : (), hasSchema : NoSchema } +buildRequiredOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder , meta = 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, hasSchema : NoSchema } +buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder , meta = 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, hasSchema : NoSchema } +buildEndingOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder , meta = emptyMeta + , tsType = tsType + , jsonGrabber = jsonGrabber } @@ -362,6 +566,118 @@ emptyMeta = } +{-| Decode a CLI string value using a JSON decoder. + +Tries parsing as raw JSON first (handles numbers, bools, objects, arrays). +If that fails (e.g. "abc" is not valid JSON), falls back to treating the +string as a JSON string value (wraps it and re-decodes). This gives proper +type errors ("Expecting an INT") instead of "not valid JSON". + +-} +decodeCliString : String -> Json.Decode.Decoder a -> String -> Result Cli.Decode.ProcessingError a +decodeCliString optionName elmJsonDecoder stringValue = + case Json.Decode.decodeString elmJsonDecoder stringValue of + Ok value -> + Ok value + + Err directErr -> + -- The string wasn't valid JSON (e.g. "abc"). Try treating it as a + -- JSON string value so the decoder gives a proper type error. + case Json.Decode.decodeValue elmJsonDecoder (Json.Encode.string stringValue) of + Ok value -> + Ok value + + Err wrappedErr -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString wrappedErr + } + ) + + +{-| 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 -> Internal.JsonGrabber a +jsonFieldGrabber fieldName valueDecoder missingError = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of + Ok value -> + Ok ( [], value ) + + Err decodeError -> + -- Distinguish between "field absent" and "field present, wrong type" + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of + Ok _ -> + -- Field exists but wrong type + Err + (Cli.Decode.UnrecoverableValidationError + { name = fieldName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + -- Field entirely absent + Err (Cli.Decode.MatchError missingError) + + +{-| Create a jsonGrabber for an optional field. Returns Nothing if absent. +-} +jsonOptionalFieldGrabber : String -> Json.Decode.Decoder a -> Internal.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 -> + -- Check if the field is absent (ok, return Nothing) or wrong type (error) + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of + Ok _ -> + -- Field exists but wrong type + Err + (Cli.Decode.UnrecoverableValidationError + { name = fieldName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + -- Field absent, that's fine for optional + Ok ( [], Nothing ) + + +{-| Create a jsonGrabber for an optional field with a default value. +-} +jsonOptionalFieldGrabberWithDefault : String -> Json.Decode.Decoder a -> a -> Internal.JsonGrabber a +jsonOptionalFieldGrabberWithDefault fieldName valueDecoder defaultValue = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + -- Field absent or wrong type — use default + Ok ( [], defaultValue ) + + +{-| Create a jsonGrabber for a boolean flag. Defaults to False if absent. +-} +jsonFlagGrabber : String -> Internal.JsonGrabber Bool +jsonFlagGrabber fieldName = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.bool) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + -- Flag absent or wrong type — default to False + Ok ( [], False ) + + {-| Add a description to an option. This will be shown in help text. Option.requiredKeywordArg "name" @@ -411,6 +727,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 } @@ -469,16 +789,21 @@ raw `String` that comes from the command line into a `Regex`, as in this code sn -} 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 +933,7 @@ oneOf list (Option option) = |> List.map (\( name, _ ) -> name) ) option.usageSpec + , tsType = tsTypeOf (TsDecode.stringUnion list) } ) @@ -623,6 +949,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 +963,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 @@ -675,9 +1023,145 @@ withDefault defaultValue option = (Maybe.withDefault defaultValue) decoder ) + (\grabber -> \blob -> grabber blob |> Result.map (Tuple.mapSecond (Maybe.withDefault defaultValue))) option +{-| Decode a string option's value as JSON using a `TsDecode.Decoder`. + +This does three things: + +1. Parses the string value as JSON and decodes it using the provided decoder +2. Attaches the decoder's JSON Schema to the option for introspection via `toJsonSchema` +3. Sets the display name to `JSON` in help text (overridable with `withDisplayName`) + +The `hasSchema : NoSchema` constraint ensures this can only be applied once per option. + + import TsJson.Codec as Codec + + todoCodec = + Codec.object (\title desc -> { title = title, description = desc }) + |> Codec.field "title" .title Codec.string + |> Codec.field "description" .description Codec.string + |> Codec.buildObject + + Option.requiredKeywordArg "todo" + |> Option.withTypedJson (Codec.decoder todoCodec) + |> Option.withDescription "The todo item to create" + +-} +withTypedJson : + TsDecode.Decoder value + -> Option from String { c | hasSchema : NoSchema } + -> Option from value { c | hasSchema : HasSchema } +withTypedJson tsDecoder (Option optionRecord) = + let + optionName = + UsageSpec.name optionRecord.usageSpec + + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = optionRecord.dataGrabber + , meta = optionRecord.meta + , tsType = TsDecode.tsType tsDecoder + , usageSpec = + optionRecord.usageSpec + |> UsageSpec.setDisplayName "JSON" + , decoder = + -- CLI mode: extract string, decodeString + Cli.Decode.mapProcessingError + (\jsonString -> + case Json.Decode.decodeString elmJsonDecoder jsonString of + Ok value -> + Ok value + + Err err -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString err + } + ) + ) + optionRecord.decoder + , jsonGrabber = + -- JSON mode: decode directly from the JSON field + \blob -> + case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of + Ok value -> + Ok ( [], value ) + + Err err -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString err + } + ) + } + + +{-| Same as `withTypedJson`, but for optional (Maybe String) options. + + Option.optionalKeywordArg "filter" + |> Option.withTypedJsonIfPresent (Codec.decoder filterCodec) + +-} +withTypedJsonIfPresent : + TsDecode.Decoder value + -> Option (Maybe from) (Maybe String) { c | hasSchema : NoSchema } + -> Option (Maybe from) (Maybe value) { c | hasSchema : HasSchema } +withTypedJsonIfPresent tsDecoder (Option optionRecord) = + let + optionName = + UsageSpec.name optionRecord.usageSpec + + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = optionRecord.dataGrabber + , meta = optionRecord.meta + , tsType = TsDecode.tsType tsDecoder + , usageSpec = + optionRecord.usageSpec + |> UsageSpec.setDisplayName "JSON" + , decoder = + -- CLI mode: optionally extract string, decodeString + Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just jsonString -> + case Json.Decode.decodeString elmJsonDecoder jsonString of + Ok value -> + Ok (Just value) + + Err err -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString err + } + ) + + Nothing -> + Ok Nothing + ) + optionRecord.decoder + , jsonGrabber = + -- JSON mode: optionally decode from the JSON field + \blob -> + case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of + Ok value -> + Ok ( [], Just value ) + + Err _ -> + Ok ( [], Nothing ) + } + + {-| A keyword argument that can be provided multiple times. Example: `--header "Auth: token" --header "Accept: json"` @@ -686,7 +1170,7 @@ Parses to: `["Auth: token", "Accept: json"]` Option.keywordArgList "header" -} -keywordArgList : String -> Option (List String) (List String) { position : BeginningOption } +keywordArgList : String -> Option (List String) (List String) { position : BeginningOption, hasSchema : NoSchema } keywordArgList flagName = buildOptionalOption (\{ options } -> @@ -707,11 +1191,13 @@ keywordArgList flagName = |> Ok ) (UsageSpec.keywordArg flagName ZeroOrMore) + (tsTypeOf (TsDecode.list TsDecode.string)) + (jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) {-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. -} -optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption } +optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption, hasSchema : NoSchema } optionalPositionalArg operandDescription = buildEndingOption (\flagsAndOperands -> @@ -729,11 +1215,13 @@ optionalPositionalArg operandDescription = Ok maybeArg ) (UsageSpec.optionalPositionalArg operandDescription) + (tsTypeOf TsDecode.string) + (jsonOptionalFieldGrabber operandDescription Json.Decode.string) {-| Note that this must be used with `OptionsParser.withRestArgs`. -} -restArgs : String -> Option (List String) (List String) { position : RestArgsOption } +restArgs : String -> Option (List String) (List String) { position : RestArgsOption, hasSchema : NoSchema } restArgs restArgsDescription = buildEndingOption (\{ operands, usageSpecs } -> @@ -742,3 +1230,5 @@ restArgs restArgsDescription = |> Ok ) (UsageSpec.restArgs restArgsDescription) + (tsTypeOf (TsDecode.list TsDecode.string)) + (jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.string) []) diff --git a/src/Cli/Option/Internal.elm b/src/Cli/Option/Internal.elm index 759414e..1ae1904 100644 --- a/src/Cli/Option/Internal.elm +++ b/src/Cli/Option/Internal.elm @@ -1,13 +1,16 @@ module Cli.Option.Internal exposing ( DataGrabber , InnerOption + , JsonGrabber , Option(..) , OptionMeta ) import Cli.Decode import Cli.UsageSpec exposing (UsageSpec) +import Json.Decode import Tokenizer +import TsJson.Type type Option from to constraints @@ -19,9 +22,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 = diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index d4c687d..28c661d 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -8,7 +8,7 @@ module Cli.OptionsParser exposing , hardcoded , withDescription , end - , getSubCommand, getUsageSpecs, tryMatch, synopsis, detailedHelp + , getSubCommand, getUsageSpecs, getTsTypes, tryMatch, tryMatchJson, synopsis, detailedHelp ) {-| @@ -134,7 +134,7 @@ a valid number of positional arguments is passed in, as defined by these rules: These functions are exposed for internal use and testing. They are not part of the public API. -@docs getSubCommand, getUsageSpecs, tryMatch, synopsis, detailedHelp +@docs getSubCommand, getUsageSpecs, getTsTypes, tryMatch, tryMatchJson, synopsis, detailedHelp -} @@ -145,8 +145,11 @@ import Cli.Option.Internal as Internal import Cli.OptionsParser.BuilderState as BuilderState import Cli.OptionsParser.MatchResult import Cli.UsageSpec as UsageSpec exposing (UsageSpec) +import Json.Decode import Occurences exposing (Occurences(..)) import Tokenizer exposing (ParsedOption) +import TsJson.Decode as TsDecode +import TsJson.Type {-| Low-level function, for internal use. @@ -156,6 +159,15 @@ getUsageSpecs (OptionsParser { usageSpecs }) = usageSpecs +{-| Low-level function, for internal use. +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 + + {-| Low-level function, for internal use. -} synopsis : Bool -> String -> OptionsParser decodesTo builderState -> String @@ -281,6 +293,32 @@ tryMatch argv ((OptionsParser { usageSpecs, subCommand }) as optionsParser) = (matchErrorDetailToNoMatchReason subCommandError :: unexpectedOptionReasons) +{-| Low-level function, for internal use. +Try to match a JSON blob against this parser's jsonGrabber. +-} +tryMatchJson : Json.Decode.Value -> OptionsParser cliOptions builderState -> Cli.OptionsParser.MatchResult.MatchResult cliOptions +tryMatchJson blob (OptionsParser { jsonGrabber }) = + case jsonGrabber blob 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) + + {-| Convert internal MatchErrorDetail to public NoMatchReason. -} matchErrorDetailToNoMatchReason : Cli.Decode.MatchErrorDetail -> Cli.OptionsParser.MatchResult.NoMatchReason @@ -330,6 +368,8 @@ expectedPositionalArgCountOrFail (OptionsParser ({ decoder, usageSpecs } as opti else decoder stuff + + -- jsonGrabber unchanged — extra operand check is CLI-only } @@ -397,6 +437,8 @@ type alias OptionsParserRecord cliOptions = , usageSpecs : List UsageSpec , description : Maybe String , subCommand : Maybe String + , tsTypes : List ( String, TsJson.Type.Type ) + , jsonGrabber : Internal.JsonGrabber cliOptions } @@ -404,13 +446,15 @@ 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) = +updateDecoder : Decoder mappedCliOptions -> Internal.JsonGrabber mappedCliOptions -> OptionsParser cliOptions fromBuilderState -> OptionsParser mappedCliOptions toBuilderState +updateDecoder decoder jsonGrabber (OptionsParser optionsParserRecord) = OptionsParser { decoder = decoder , usageSpecs = optionsParserRecord.usageSpecs , description = optionsParserRecord.description , subCommand = optionsParserRecord.subCommand + , tsTypes = optionsParserRecord.tsTypes + , jsonGrabber = jsonGrabber } @@ -424,6 +468,8 @@ build cliOptionsConstructor = , description = Nothing , decoder = \_ -> Ok ( [], cliOptionsConstructor ) , subCommand = Nothing + , tsTypes = [] + , jsonGrabber = \_ -> Ok ( [], cliOptionsConstructor ) } @@ -437,6 +483,31 @@ buildSubCommand subCommandName cliOptionsConstructor = , 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 +536,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 ((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 +589,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 ((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 +611,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)) = +expectFlag flagName (OptionsParser ({ usageSpecs, decoder, tsTypes, jsonGrabber } as optionsParser)) = OptionsParser { optionsParser | usageSpecs = usageSpecs ++ [ UsageSpec.flag flagName Required ] + , tsTypes = tsTypes ++ [ ( flagName, TsDecode.tsType TsDecode.bool ) ] , decoder = \({ options } as stuff) -> if @@ -549,6 +627,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 +648,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) ((OptionsParser { decoder, usageSpecs, tsTypes, jsonGrabber }) as fullOptionsParser) = updateDecoder (\optionsAndOperands -> { options = optionsAndOperands.options @@ -584,11 +671,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 { record | usageSpecs = usageSpecs ++ [ innerOption.usageSpec ] + , tsTypes = tsTypes ++ [ ( UsageSpec.name innerOption.usageSpec, innerOption.tsType ) ] } ) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 7eed61a..d01946d 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(..) ) @@ -65,6 +67,8 @@ See the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree @docs StatelessProgram, StatefulProgram @docs FlagsIncludingArgv @docs mapConfig +@docs helpText +@docs toJsonSchema ## Low-Level / Testing @@ -79,7 +83,12 @@ 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 Json.Decode +import Json.Encode as Encode import List.Extra +import Occurences exposing (Occurences(..)) +import TsJson.Type import TypoSuggestion @@ -428,6 +437,36 @@ run (Config { optionsParsers }) argv versionMessage colorMode = errorMessage = "TODO - show error message explaining that user needs to pass unmodified `process.argv` from node here." + -- Check for JSON input mode: a single arg that's JSON with the $cli sentinel key + maybeJsonBlob = + case argv |> List.drop 2 of + [ singleArg ] -> + case Json.Decode.decodeString (Json.Decode.field "$cli" Json.Decode.string) singleArg of + Ok _ -> + Json.Decode.decodeString Json.Decode.value singleArg + |> Result.toMaybe + + Err _ -> + Nothing + + _ -> + Nothing + in + case maybeJsonBlob of + Just blob -> + -- Direct JSON mode: decode using jsonGrabbers, no lossy argv translation + runJsonMode optionsParsers blob + + Nothing -> + -- CLI mode: parse argv as before + runCliMode optionsParsers argv programName versionMessage colorMode + + +{-| 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 +523,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 +568,223 @@ 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 used by the +[Model Context Protocol (MCP)](https://modelcontextprotocol.io/specification/draft/server/tools) +for tool `inputSchema` definitions. + + import Cli.Option as Option + import Cli.OptionsParser as OptionsParser + import Cli.Program as Program + import Json.Encode + + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredKeywordArg "name") + ) + |> Program.toJsonSchema + |> Json.Encode.encode 0 + --> """{"type":"object","properties":{"name":{"type":"string"}},"required":["name"]}""" + +-} +toJsonSchema : Config msg -> Encode.Value +toJsonSchema (Config { optionsParsers }) = + let + baseSchema = + case optionsParsers of + [ singleParser ] -> + parserToJsonSchemaFromTsTypes singleParser + + multipleParsers -> + Encode.object + [ ( "anyOf" + , Encode.list parserToJsonSchemaFromTsTypes multipleParsers + ) + ] + in + mergeJsonObject + [ ( "$cli", Encode.string "elm-cli-options-parser" ) ] + baseSchema + + + +parserToJsonSchemaFromTsTypes : OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value +parserToJsonSchemaFromTsTypes parser = + let + specs = + OptionsParser.getUsageSpecs parser + + tsTypes = + OptionsParser.getTsTypes parser + + subCommandFields = + case OptionsParser.getSubCommand parser of + Just subName -> + [ ( "subcommand" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "const", Encode.string subName ) + ] + ) + ] + + Nothing -> + [] + + properties = + subCommandFields + ++ List.map2 tsTypeToProperty specs tsTypes + + required = + (case OptionsParser.getSubCommand parser of + Just _ -> + [ "subcommand" ] + + Nothing -> + [] + ) + ++ List.filterMap usageSpecToRequired specs + in + Encode.object + ([ ( "type", Encode.string "object" ) + , ( "properties", Encode.object properties ) + ] + ++ (if List.isEmpty required then + [] + + else + [ ( "required", Encode.list Encode.string required ) ] + ) + ) + + +tsTypeToProperty : UsageSpec -> ( String, TsJson.Type.Type ) -> ( String, Encode.Value ) +tsTypeToProperty spec ( optionName, tsType ) = + let + baseSchema = + TsJson.Type.toJsonSchema tsType + + -- Strip $schema from the TsJson output since we're embedding this + -- as a property within a larger schema + strippedSchema = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) baseSchema of + Ok pairs -> + pairs + |> List.filter (\( k, _ ) -> k /= "$schema") + |> Encode.object + + Err _ -> + baseSchema + + maybeDescription = + usageSpecDescription spec + + schemaWithDescription = + case maybeDescription of + Just desc -> + appendJsonFields [ ( "description", Encode.string desc ) ] strippedSchema + + Nothing -> + strippedSchema + in + ( optionName, schemaWithDescription ) + + +usageSpecDescription : UsageSpec -> Maybe String +usageSpecDescription spec = + case spec of + UsageSpec.FlagOrKeywordArg _ _ _ maybeDescription -> + maybeDescription + + UsageSpec.Operand _ _ _ maybeDescription -> + maybeDescription + + UsageSpec.RestArgs _ maybeDescription -> + maybeDescription + + + +usageSpecToRequired : UsageSpec -> Maybe String +usageSpecToRequired spec = + case spec of + UsageSpec.FlagOrKeywordArg flagOrKw _ occurences _ -> + case occurences of + Required -> + case flagOrKw of + UsageSpec.Flag flagName -> + Just flagName + + UsageSpec.KeywordArg kwName _ -> + Just kwName + + _ -> + Nothing + + UsageSpec.Operand operandName _ occurences _ -> + case occurences of + Required -> + Just operandName + + _ -> + Nothing + + UsageSpec.RestArgs _ _ -> + Nothing + + + +{-| Merge additional key-value pairs into a JSON object value. +New fields are prepended (appear first in the output). +If the value is not a decodable object, wraps the pairs as a new object. +-} +mergeJsonObject : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value +mergeJsonObject extraFields jsonValue = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue of + Ok existingFields -> + Encode.object (extraFields ++ existingFields) + + Err _ -> + Encode.object extraFields + + +{-| Append additional key-value pairs to the end of a JSON object value. +Similar to mergeJsonObject but new fields appear last in the output. +-} +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 + + {-| Generate help text for a specific subcommand. -} subcommandHelpText : ColorMode -> String -> List (OptionsParser msg BuilderState.NoMoreOptions) -> String -> String @@ -734,3 +1024,31 @@ 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 + missingFieldReasons = + reasons + |> List.filterMap + (\reason -> + case reason of + MissingRequiredKeywordArg { name } -> + Just ("Missing required field: \"" ++ name ++ "\"") + + MissingRequiredPositionalArg { 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..71d4943 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 @@ -98,6 +99,7 @@ setDisplayName displayName usageSpec = usageSpec + changeUsageSpec : List String -> UsageSpec -> UsageSpec changeUsageSpec possibleValues usageSpec = case usageSpec of diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm new file mode 100644 index 0000000..158cc1a --- /dev/null +++ b/tests/ExperienceTests.elm @@ -0,0 +1,637 @@ +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 (..) +import TsJson.Decode as TsDecode + + +{-| 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 + ) + + +{-| A simpler CLI that shows withTypedJson. + + deploy --config '{"host":"prod.example.com","port":443,"ssl":true}' + +-} +type alias DeployOptions = + { config : DeployConfig + , dryRun : Bool + } + + +type alias DeployConfig = + { host : String + , port_ : Int + , ssl : Bool + } + + +deployConfigDecoder : TsDecode.Decoder DeployConfig +deployConfigDecoder = + TsDecode.map3 DeployConfig + (TsDecode.field "host" TsDecode.string) + (TsDecode.field "port" TsDecode.int) + (TsDecode.field "ssl" TsDecode.bool) + + +deployConfig : Program.Config DeployOptions +deployConfig = + Program.config + |> Program.add + (OptionsParser.build DeployOptions + |> OptionsParser.with + (Option.requiredKeywordArg "config" + |> Option.withTypedJson deployConfigDecoder + |> Option.withDescription "Deployment configuration" + ) + |> OptionsParser.with + (Option.flag "dry-run" + |> Option.withDescription "Preview changes without deploying" + ) + ) + + +all : Test +all = + describe "Developer & User Experience" + [ describe "1. JSON Schema output (what LLMs see)" + [ test "task manager schema" <| + \() -> + taskConfig + |> Program.toJsonSchema + |> Encode.encode 2 + |> Expect.equal """{ + "$cli": "elm-cli-options-parser", + "anyOf": [ + { + "type": "object", + "properties": { + "subcommand": { + "type": "string", + "const": "add" + }, + "title": { + "type": "string", + "description": "The task title" + }, + "priority": { + "anyOf": [ + { + "const": "low" + }, + { + "const": "medium" + }, + { + "const": "high" + } + ], + "description": "Task priority level" + } + }, + "required": [ + "subcommand", + "title", + "priority" + ] + }, + { + "type": "object", + "properties": { + "subcommand": { + "type": "string", + "const": "list" + }, + "format": { + "anyOf": [ + { + "const": "json" + }, + { + "const": "table" + }, + { + "const": "csv" + } + ], + "description": "Output format" + }, + "limit": { + "type": "string", + "description": "Maximum number of tasks to show" + }, + "verbose": { + "type": "boolean", + "description": "Show full task details" + } + }, + "required": [ + "subcommand", + "limit" + ] + }, + { + "type": "object", + "properties": { + "subcommand": { + "type": "string", + "const": "complete" + }, + "task-id": { + "type": "string", + "description": "The ID of the task to mark complete" + } + }, + "required": [ + "subcommand", + "task-id" + ] + } + ] +}""" + , test "deploy tool schema (with typed JSON)" <| + \() -> + deployConfig + |> Program.toJsonSchema + |> Encode.encode 2 + |> Expect.equal """{ + "$cli": "elm-cli-options-parser", + "type": "object", + "properties": { + "config": { + "type": "object", + "properties": { + "host": { + "type": "string" + }, + "port": { + "type": "integer" + }, + "ssl": { + "type": "boolean" + } + }, + "required": [ + "host", + "port", + "ssl" + ], + "description": "Deployment configuration" + }, + "dry-run": { + "type": "boolean", + "description": "Preview changes without deploying" + } + }, + "required": [ + "config" + ] +}""" + ] + , 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 --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""" + ) + , test "deploy tool help" <| + \() -> + Program.run deployConfig + [ "node", "deploy", "--help" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Success + """Usage: deploy --config <JSON> [--dry-run] + +Options: + --config <JSON> Deployment configuration + --dry-run Preview changes without deploying""" + ) + ] + , 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" })) + , test "deploy via CLI with JSON string arg" <| + \() -> + Program.run deployConfig + [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) + ] + , describe "3b. JSON input mode - correct usage" + [ test "add task via JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"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 JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\",\"verbose\":true}" ] + "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 are just named fields in JSON + Program.run taskConfig + [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"complete\",\"task-id\":\"42\"}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) + , test "deploy via JSON - typed JSON arg gets nested object" <| + \() -> + -- With direct JSON decoding, the nested object is decoded natively + -- No round-trip through string serialization + Program.run deployConfig + [ "node", "deploy", "{\"$cli\":\"elm-cli-options-parser\",\"config\":{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) + ] + , 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`""" + ) + , test "invalid typed JSON in CLI mode" <| + \() -> + Program.run deployConfig + [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":\"not-a-number\"}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--config` option. +Problem with the value at json.port: + + "not-a-number" + +Expecting an INT""" + ) + ] + , describe "4b. JSON input mode - error messages" + [ test "missing required field in JSON" <| + \() -> + Program.run taskConfig + [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"add\",\"priority\":\"high\"}" ] + "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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"urgent\"}" ] + "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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"json\",\"limit\":10,\"verbose\":true}" ] + "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""" + ) + , test "invalid typed JSON in JSON mode" <| + \() -> + Program.run deployConfig + [ "node", "deploy", "{\"$cli\":\"elm-cli-options-parser\",\"config\":{\"host\":\"prod.example.com\",\"port\":\"not-a-number\"}}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "config" field. +Problem with the value at json.config.port: + + "not-a-number" + +Expecting an INT""" + ) + ] + , 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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"table\",\"limit\":10}" ] + "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""" + ) + , test "port in typed JSON is a real integer (no string coercion)" <| + \() -> + -- With withTypedJson, the decoder expects an actual integer + -- Passing a string "443" for port would FAIL + Program.run deployConfig + [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) + , test "port as string in typed JSON fails with type error" <| + \() -> + -- This SHOULD fail because the TsJson decoder expects int, not string + Program.run deployConfig + [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":\"443\",\"ssl\":true}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--config` option. +Problem with the value at json.port: + + "443" + +Expecting an INT""" + ) + ] + ] diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm new file mode 100644 index 0000000..44255a7 --- /dev/null +++ b/tests/JsonSchemaTests.elm @@ -0,0 +1,832 @@ +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 (..) +import TsJson.Decode as TsDecode + + +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 + { properties = + [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] + , required = [ "name" ] + } + , test "optional keyword arg is not required" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optionalKeywordArg "greeting") + ) + |> expectJsonSchema + { 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") + ) + |> expectJsonSchema + { properties = + [ ( "verbose", [ ( "type", Encode.string "boolean" ) ] ) ] + , required = [] + } + , test "required positional arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.requiredPositionalArg "file") + ) + |> expectJsonSchema + { properties = + [ ( "file", [ ( "type", Encode.string "string" ) ] ) ] + , required = [ "file" ] + } + , test "optional positional arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg (Option.optionalPositionalArg "revision") + ) + |> expectJsonSchema + { properties = + [ ( "revision", [ ( "type", Encode.string "string" ) ] ) ] + , required = [] + } + , test "rest args is array of strings" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withRestArgs (Option.restArgs "files") + ) + |> expectJsonSchema + { properties = + [ ( "files" + , [ ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + ] + , required = [] + } + , test "keyword arg list is array of strings" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.keywordArgList "header") + ) + |> expectJsonSchema + { properties = + [ ( "header" + , [ ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + ] + , required = [] + } + , test "description is included" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "name" + |> Option.withDescription "The user's name" + ) + ) + |> expectJsonSchema + { 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 + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "anyOf" + , Encode.list identity + [ Encode.object [ ( "const", Encode.string "json" ) ] + , Encode.object [ ( "const", Encode.string "junit" ) ] + , Encode.object [ ( "const", Encode.string "console" ) ] + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format" ] ) + ] + |> 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") + ) + |> expectJsonSchema + { properties = + [ ( "name", [ ( "type", Encode.string "string" ) ] ) + , ( "greeting", [ ( "type", Encode.string "string" ) ] ) + , ( "verbose", [ ( "type", Encode.string "boolean" ) ] ) + ] + , required = [ "name" ] + } + , test "no options produces empty object schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build ()) + |> expectJsonSchema + { properties = [] + , required = [] + } + ] + , describe "subcommands" + [ test "single subcommand includes subcommand property" <| + \() -> + Program.config + |> Program.add + (OptionsParser.buildSubCommand "init" identity + |> OptionsParser.with (Option.flag "bare") + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + , ( "bare", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) + ] + |> 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 + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "anyOf" + , Encode.list identity + [ Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) + ] + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) + , ( "repository", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "subcommand", "repository" ] ) + ] + ] + ) + ] + |> Encode.encode 0 + ) + ] + , describe "withTypedJson" + [ test "withTypedJson embeds JSON schema for keyword arg" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + ) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "todo" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "description", "title" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "todo" ] ) + ] + |> Encode.encode 0 + ) + , test "withTypedJson description is merged into embedded schema" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + |> Option.withDescription "The todo item" + ) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "todo" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "description", "title" ] ) + , ( "description", Encode.string "The todo item" ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "todo" ] ) + ] + |> Encode.encode 0 + ) + ] + , describe "typed constructors" + [ test "Option.required with TsDecode.int has integer schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> Encode.encode 0 + ) + , test "Option.required CLI mode parses string via decodeString" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "42" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch 42) + , test "Option.required JSON mode decodes native value" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch 42) + , test "Option.required CLI mode error for non-numeric string" <| + \() -> + -- "abc" should produce "Expecting an INT", not "not valid JSON" + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "abc" ] + "1.0.0" + Program.WithoutColor + ) + |> expectRunResultContains "Expecting an INT" + , test "Option.required CLI mode error for wrong JSON type" <| + \() -> + -- "true" is valid JSON but not an int + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "true" ] + "1.0.0" + Program.WithoutColor + ) + |> expectRunResultContains "Expecting an INT" + , test "Option.required with string decoder works in CLI mode without quoting" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "name" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--name", "hello" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch "hello") + , test "Option.required with description includes it in schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.required "count" TsDecode.int + |> Option.withDescription "Number of items" + ) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "description", Encode.string "Number of items" ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> Encode.encode 0 + ) + , test "Option.optional with TsDecode.int has integer schema and is not required" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optional "count" TsDecode.int) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) + ] + ) + ] + |> Encode.encode 0 + ) + , test "Option.optional JSON mode decodes native value" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optional "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch (Just 42)) + , test "Option.optional JSON mode returns Nothing when absent" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optional "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\"}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch Nothing) + , test "Option.optional CLI mode parses string via decodeString" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optional "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "42" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch (Just 42)) + , test "Option.optional CLI mode returns Nothing when absent" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.optional "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch Nothing) + , test "Option.required JSON mode error for wrong type" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.required "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":\"not-a-number\"}" ] + "1.0.0" + Program.WithoutColor + ) + |> expectRunResultContains "Expecting an INT" + ] + , 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", "{\"$cli\":\"elm-cli-options-parser\",\"name\":\"World\",\"greeting\":\"Hi\"}" ] + "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", "{\"$cli\":\"elm-cli-options-parser\",\"name\":\"World\",\"verbose\":true}" ] + "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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"greet\",\"name\":\"World\"}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch "World") + , test "JSON input mode with typed JSON arg" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + in + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + ) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"todo\":{\"title\":\"Buy groceries\",\"description\":\"Get milk\"}}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal + (Program.CustomMatch { title = "Buy groceries", description = "Get milk" }) + , 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", "{\"$cli\":\"elm-cli-options-parser\",\"greeting\":\"Hi\"}" ] + "1.0.0" + Program.WithoutColor + |> Expect.equal + (Program.SystemMessage Program.Failure + "Missing required field: \"name\"" + ) + , test "JSON input mode with invalid JSON for typed arg gives validation error" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + + result = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + ) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"todo\":{\"title\":123}}" ] + "1.0.0" + Program.WithoutColor + ) + in + Expect.equal result + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid "todo" field. +Problem with the value at json.todo.title: + + 123 + +Expecting a STRING""" + ) + , test "traditional CLI with invalid JSON for typed arg gives same validation error" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + + result = + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + ) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--todo", "{\"title\":123}" ] + "1.0.0" + Program.WithoutColor + ) + in + Expect.equal result + (Program.SystemMessage Program.Failure + """Validation errors: + +Invalid `--todo` option. +Problem with the value at json.title: + + 123 + +Expecting a STRING""" + ) + , 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", "{\"$cli\":\"elm-cli-options-parser\",\"name\":123}" ] + "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 "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") + ] + ] + + +{-| Helper to build expected JSON Schema and compare. +-} +expectJsonSchema : + { properties : List ( String, List ( String, Encode.Value ) ) + , required : List String + } + -> Program.Config msg + -> Expect.Expectation +expectJsonSchema { properties, required } config = + config + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + ([ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + (properties + |> List.map (\( name, fields ) -> ( name, Encode.object fields )) + ) + ) + ] + ++ (if List.isEmpty required then + [] + + else + [ ( "required", Encode.list Encode.string required ) ] + ) + ) + |> Encode.encode 0 + ) + + +{-| Assert that a Program.RunResult contains a specific substring in its error message. +-} +expectRunResultContains : String -> Program.RunResult msg -> Expect.Expectation +expectRunResultContains substring result = + case result of + Program.SystemMessage Program.Failure message -> + if String.contains substring 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) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm new file mode 100644 index 0000000..39cbddb --- /dev/null +++ b/tests/TsTypeTests.elm @@ -0,0 +1,285 @@ +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.Decode as TsDecode +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#" ) + , ( "anyOf" + , Encode.list identity + [ Encode.object [ ( "const", Encode.string "json" ) ] + , Encode.object [ ( "const", Encode.string "junit" ) ] + , Encode.object [ ( "const", Encode.string "console" ) ] + ] + ) + ] + |> Encode.encode 0 + ) + ] + , describe "withTypedJson replaces TsType" + [ test "withTypedJson replaces string TsType with object TsType" <| + \() -> + let + todoDecoder = + TsDecode.map2 (\title desc -> { title = title, description = desc }) + (TsDecode.field "title" TsDecode.string) + (TsDecode.field "description" TsDecode.string) + in + Option.requiredKeywordArg "todo" + |> Option.withTypedJson todoDecoder + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "description", "title" ] ) + ] + |> Encode.encode 0 + ) + , test "withTypedJson on int decoder gives integer type" <| + \() -> + Option.requiredKeywordArg "count" + |> Option.withTypedJson TsDecode.int + |> optionTsTypeToJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "type", Encode.string "integer" ) + ] + |> 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", () ) + ] + ) + ) + in + cfg + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "anyOf" + , Encode.list identity + [ Encode.object [ ( "const", Encode.string "json" ) ] + , Encode.object [ ( "const", Encode.string "junit" ) ] + , Encode.object [ ( "const", Encode.string "console" ) ] + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format" ] ) + ] + |> Encode.encode 0 + ) + ] + ] From 846679327f65e3aa8e499a40d84b165f7d7beab0 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Thu, 12 Mar 2026 15:46:26 -0700 Subject: [PATCH 02/34] Separate out typed schema API to separate module to prevent breaking changes to existing options parsers. --- elm.json | 3 +- src/Cli/Option.elm | 363 ++------------------------- src/Cli/Option/Typed.elm | 485 +++++++++++++++++++++++++++++++++++++ tests/ExperienceTests.elm | 173 ------------- tests/JsonSchemaTests.elm | 426 +------------------------------- tests/TsTypeTests.elm | 42 ---- tests/TypedOptionTests.elm | 296 ++++++++++++++++++++++ 7 files changed, 802 insertions(+), 986 deletions(-) create mode 100644 src/Cli/Option/Typed.elm create mode 100644 tests/TypedOptionTests.elm diff --git a/elm.json b/elm.json index 3adf87c..16edd40 100644 --- a/elm.json +++ b/elm.json @@ -9,7 +9,8 @@ "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": { diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index c45d16d..5a21e8e 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -1,16 +1,13 @@ module Cli.Option exposing ( requiredPositionalArg , optionalKeywordArg, requiredKeywordArg, keywordArgList - , required, optional , flag , optionalPositionalArg, restArgs , oneOf , validate, validateIfPresent, validateMap, validateMapIfPresent , map, mapFlag, withDefault - , withTypedJson, withTypedJsonIfPresent , withDescription, withDisplayName, withMissingMessage , Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption - , NoSchema, HasSchema ) {-| Here is the terminology used for building up Command-Line parsers with this library. @@ -31,11 +28,6 @@ and using `Cli.Option`s. @docs optionalKeywordArg, requiredKeywordArg, keywordArgList -## Typed Keyword Arguments - -@docs required, optional - - ## Flags @docs flag @@ -108,11 +100,6 @@ with the following functions. @docs map, mapFlag, withDefault -### Typed JSON - -@docs withTypedJson, withTypedJsonIfPresent - - ### Metadata @docs withDescription, withDisplayName, withMissingMessage @@ -121,7 +108,6 @@ with the following functions. ## Types @docs Option, BeginningOption, OptionalPositionalArgOption, RestArgsOption -@docs NoSchema, HasSchema -} @@ -130,7 +116,6 @@ import Cli.Option.Internal as Internal exposing (Option(..)) import Cli.UsageSpec as UsageSpec exposing (UsageSpec) import Cli.Validate as Validate import Json.Decode -import Json.Encode import List.Extra import Occurences exposing (Occurences(..)) import Tokenizer @@ -138,13 +123,6 @@ import TsJson.Decode as TsDecode import TsJson.Type -{-| Extract the TsType from a TsDecode.Decoder for use as the value-level schema type. --} -tsTypeOf : TsDecode.Decoder a -> TsJson.Type.Type -tsTypeOf = - TsDecode.tsType - - {-| The type returned by the builder functions below. Use with `OptionsParser.with`. -} type alias Option from to middleOrEnding = @@ -178,20 +156,6 @@ type OptionalPositionalArgOption = OptionalPositionalArgOption Never -{-| Phantom type marker indicating no JSON schema has been set on this option. -All option constructors start with `NoSchema`. Once `withTypedJson` is applied, -the marker changes to `HasSchema`, preventing it from being applied again. --} -type NoSchema - = NoSchema Never - - -{-| Phantom type marker indicating a JSON schema has been set on this option -via `withTypedJson`. This prevents `withTypedJson` from being applied a second time. --} -type HasSchema - = HasSchema Never - {-| Run a validation. (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). @@ -264,7 +228,7 @@ Parses to: `"src/Main.elm"` Option.requiredPositionalArg "input" -} -requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : (), hasSchema : NoSchema } +requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : ()} requiredPositionalArg operandDescription = buildRequiredOption (\{ operands, operandsSoFar } -> @@ -286,7 +250,7 @@ requiredPositionalArg operandDescription = |> Err ) (UsageSpec.operand operandDescription) - (tsTypeOf TsDecode.string) + (TsDecode.tsType TsDecode.string) (jsonFieldGrabber operandDescription Json.Decode.string (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } @@ -302,7 +266,7 @@ Parses to: `Just "main.js"` (or `Nothing` if omitted) Option.optionalKeywordArg "output" -} -optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption, hasSchema : NoSchema } +optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption} optionalKeywordArg optionName = buildOptionalOption (\{ options } -> @@ -323,7 +287,7 @@ optionalKeywordArg optionName = |> Err ) (UsageSpec.keywordArg optionName Optional) - (tsTypeOf TsDecode.string) + (TsDecode.tsType TsDecode.string) (jsonOptionalFieldGrabber optionName Json.Decode.string) @@ -335,7 +299,7 @@ Parses to: `"my-app"` Option.requiredKeywordArg "name" -} -requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : (), hasSchema : NoSchema } +requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : ()} requiredKeywordArg optionName = buildRequiredOption (\{ options } -> @@ -358,138 +322,12 @@ requiredKeywordArg optionName = |> Err ) (UsageSpec.keywordArg optionName Required) - (tsTypeOf TsDecode.string) + (TsDecode.tsType TsDecode.string) (jsonFieldGrabber optionName Json.Decode.string (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) ) -{-| A required keyword argument with a typed JSON decoder. - -In CLI mode, the string value is parsed via `Json.Decode.decodeString`. -In JSON mode, the value is decoded natively from the JSON field. -The schema type comes from the decoder (e.g., `TsDecode.int` → `"type": "integer"`). - - Option.required "count" TsDecode.int - -- CLI: --count 42 → string "42" → decodeString → Int - -- JSON: {"count": 42} → Int directly - -- Schema: {"type": "integer"} - --} -required : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : (), hasSchema : HasSchema } -required optionName tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in - Option - { dataGrabber = - \{ 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 - , usageSpec = UsageSpec.keywordArg optionName Required - , decoder = - Cli.Decode.decoder - |> Cli.Decode.mapProcessingError - (decodeCliString optionName elmJsonDecoder) - , meta = emptyMeta - , tsType = tsTypeOf tsDecoder - , jsonGrabber = - jsonFieldGrabber optionName elmJsonDecoder - (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) - } - - -{-| An optional keyword argument with a typed JSON decoder. - -In CLI mode, the string value is parsed via `Json.Decode.decodeString`. -In JSON mode, the value is decoded natively from the JSON field. -Returns `Nothing` if the option is omitted. - - Option.optional "count" TsDecode.int - -- CLI: --count 42 → Just 42, omitted → Nothing - -- JSON: {"count": 42} → Just 42, absent → Nothing - -- Schema: {"type": "integer"} (not in required array) - --} -optional : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption, hasSchema : HasSchema } -optional optionName tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in - Option - { dataGrabber = - \{ 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 - , usageSpec = UsageSpec.keywordArg optionName Optional - , decoder = - Cli.Decode.decoder - |> Cli.Decode.mapProcessingError - (\maybeString -> - case maybeString of - Just stringValue -> - decodeCliString optionName elmJsonDecoder stringValue - |> Result.map Just - - Nothing -> - Ok Nothing - ) - , meta = emptyMeta - , tsType = tsTypeOf tsDecoder - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of - Ok value -> - Ok ( [], Just value ) - - Err decodeError -> - -- Check if the field is absent (ok, return Nothing) or wrong type (error) - case Json.Decode.decodeValue (Json.Decode.field optionName Json.Decode.value) blob of - Ok _ -> - -- Field exists but wrong type - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString decodeError - } - ) - - Err _ -> - -- Field absent, that's fine for optional - Ok ( [], Nothing ) - } - - {-| A flag with no argument. Example: `--debug` in `elm make --debug` @@ -498,7 +336,7 @@ Parses to: `True` (or `False` if omitted) Option.flag "debug" -} -flag : String -> Option Bool Bool { position : BeginningOption, hasSchema : NoSchema } +flag : String -> Option Bool Bool { position : BeginningOption} flag flagName = buildOptionalOption (\{ options } -> @@ -512,13 +350,13 @@ flag flagName = Ok False ) (UsageSpec.flag flagName Optional) - (tsTypeOf TsDecode.bool) + (TsDecode.tsType TsDecode.bool) (jsonFlagGrabber flagName) {-| Build an option for required arguments (has canAddMissingMessage capability). -} -buildRequiredOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption, canAddMissingMessage : (), hasSchema : NoSchema } +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 @@ -532,7 +370,7 @@ buildRequiredOption dataGrabber usageSpec tsType jsonGrabber = {-| Build an option for optional arguments (no canAddMissingMessage capability). -} -buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption, hasSchema : NoSchema } +buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption} buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber @@ -546,7 +384,7 @@ buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = {-| Build an ending option (like restArgs, optionalPositionalArg). -} -buildEndingOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : position, hasSchema : NoSchema } +buildEndingOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : position} buildEndingOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber @@ -566,36 +404,6 @@ emptyMeta = } -{-| Decode a CLI string value using a JSON decoder. - -Tries parsing as raw JSON first (handles numbers, bools, objects, arrays). -If that fails (e.g. "abc" is not valid JSON), falls back to treating the -string as a JSON string value (wraps it and re-decodes). This gives proper -type errors ("Expecting an INT") instead of "not valid JSON". - --} -decodeCliString : String -> Json.Decode.Decoder a -> String -> Result Cli.Decode.ProcessingError a -decodeCliString optionName elmJsonDecoder stringValue = - case Json.Decode.decodeString elmJsonDecoder stringValue of - Ok value -> - Ok value - - Err directErr -> - -- The string wasn't valid JSON (e.g. "abc"). Try treating it as a - -- JSON string value so the decoder gives a proper type error. - case Json.Decode.decodeValue elmJsonDecoder (Json.Encode.string stringValue) of - Ok value -> - Ok value - - Err wrappedErr -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString wrappedErr - } - ) - - {-| 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. @@ -933,7 +741,7 @@ oneOf list (Option option) = |> List.map (\( name, _ ) -> name) ) option.usageSpec - , tsType = tsTypeOf (TsDecode.stringUnion list) + , tsType = TsDecode.tsType (TsDecode.stringUnion list) } ) @@ -1027,141 +835,6 @@ withDefault defaultValue option = option -{-| Decode a string option's value as JSON using a `TsDecode.Decoder`. - -This does three things: - -1. Parses the string value as JSON and decodes it using the provided decoder -2. Attaches the decoder's JSON Schema to the option for introspection via `toJsonSchema` -3. Sets the display name to `JSON` in help text (overridable with `withDisplayName`) - -The `hasSchema : NoSchema` constraint ensures this can only be applied once per option. - - import TsJson.Codec as Codec - - todoCodec = - Codec.object (\title desc -> { title = title, description = desc }) - |> Codec.field "title" .title Codec.string - |> Codec.field "description" .description Codec.string - |> Codec.buildObject - - Option.requiredKeywordArg "todo" - |> Option.withTypedJson (Codec.decoder todoCodec) - |> Option.withDescription "The todo item to create" - --} -withTypedJson : - TsDecode.Decoder value - -> Option from String { c | hasSchema : NoSchema } - -> Option from value { c | hasSchema : HasSchema } -withTypedJson tsDecoder (Option optionRecord) = - let - optionName = - UsageSpec.name optionRecord.usageSpec - - elmJsonDecoder = - TsDecode.decoder tsDecoder - in - Option - { dataGrabber = optionRecord.dataGrabber - , meta = optionRecord.meta - , tsType = TsDecode.tsType tsDecoder - , usageSpec = - optionRecord.usageSpec - |> UsageSpec.setDisplayName "JSON" - , decoder = - -- CLI mode: extract string, decodeString - Cli.Decode.mapProcessingError - (\jsonString -> - case Json.Decode.decodeString elmJsonDecoder jsonString of - Ok value -> - Ok value - - Err err -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString err - } - ) - ) - optionRecord.decoder - , jsonGrabber = - -- JSON mode: decode directly from the JSON field - \blob -> - case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of - Ok value -> - Ok ( [], value ) - - Err err -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString err - } - ) - } - - -{-| Same as `withTypedJson`, but for optional (Maybe String) options. - - Option.optionalKeywordArg "filter" - |> Option.withTypedJsonIfPresent (Codec.decoder filterCodec) - --} -withTypedJsonIfPresent : - TsDecode.Decoder value - -> Option (Maybe from) (Maybe String) { c | hasSchema : NoSchema } - -> Option (Maybe from) (Maybe value) { c | hasSchema : HasSchema } -withTypedJsonIfPresent tsDecoder (Option optionRecord) = - let - optionName = - UsageSpec.name optionRecord.usageSpec - - elmJsonDecoder = - TsDecode.decoder tsDecoder - in - Option - { dataGrabber = optionRecord.dataGrabber - , meta = optionRecord.meta - , tsType = TsDecode.tsType tsDecoder - , usageSpec = - optionRecord.usageSpec - |> UsageSpec.setDisplayName "JSON" - , decoder = - -- CLI mode: optionally extract string, decodeString - Cli.Decode.mapProcessingError - (\maybeString -> - case maybeString of - Just jsonString -> - case Json.Decode.decodeString elmJsonDecoder jsonString of - Ok value -> - Ok (Just value) - - Err err -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString err - } - ) - - Nothing -> - Ok Nothing - ) - optionRecord.decoder - , jsonGrabber = - -- JSON mode: optionally decode from the JSON field - \blob -> - case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of - Ok value -> - Ok ( [], Just value ) - - Err _ -> - Ok ( [], Nothing ) - } - - {-| A keyword argument that can be provided multiple times. Example: `--header "Auth: token" --header "Accept: json"` @@ -1170,7 +843,7 @@ Parses to: `["Auth: token", "Accept: json"]` Option.keywordArgList "header" -} -keywordArgList : String -> Option (List String) (List String) { position : BeginningOption, hasSchema : NoSchema } +keywordArgList : String -> Option (List String) (List String) { position : BeginningOption} keywordArgList flagName = buildOptionalOption (\{ options } -> @@ -1191,13 +864,13 @@ keywordArgList flagName = |> Ok ) (UsageSpec.keywordArg flagName ZeroOrMore) - (tsTypeOf (TsDecode.list TsDecode.string)) + (TsDecode.tsType (TsDecode.list TsDecode.string)) (jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) {-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. -} -optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption, hasSchema : NoSchema } +optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption} optionalPositionalArg operandDescription = buildEndingOption (\flagsAndOperands -> @@ -1215,13 +888,13 @@ optionalPositionalArg operandDescription = Ok maybeArg ) (UsageSpec.optionalPositionalArg operandDescription) - (tsTypeOf TsDecode.string) + (TsDecode.tsType TsDecode.string) (jsonOptionalFieldGrabber operandDescription Json.Decode.string) {-| Note that this must be used with `OptionsParser.withRestArgs`. -} -restArgs : String -> Option (List String) (List String) { position : RestArgsOption, hasSchema : NoSchema } +restArgs : String -> Option (List String) (List String) { position : RestArgsOption} restArgs restArgsDescription = buildEndingOption (\{ operands, usageSpecs } -> @@ -1230,5 +903,5 @@ restArgs restArgsDescription = |> Ok ) (UsageSpec.restArgs restArgsDescription) - (tsTypeOf (TsDecode.list TsDecode.string)) + (TsDecode.tsType (TsDecode.list TsDecode.string)) (jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.string) []) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm new file mode 100644 index 0000000..c0a0e30 --- /dev/null +++ b/src/Cli/Option/Typed.elm @@ -0,0 +1,485 @@ +module Cli.Option.Typed exposing + ( requiredKeywordArg, optionalKeywordArg, keywordArgList + , requiredPositionalArg, optionalPositionalArg + , flag, restArgs + , oneOf, validateMap, validateMapIfPresent, withDefault + , withDescription, withDisplayName + ) + +{-| Typed option constructors that take a `TsDecode.Decoder` for first-class +JSON schema support. Each constructor produces both a CLI parser and a JSON +schema from the same decoder. + +Use this module instead of `Cli.Option` when you want typed JSON schemas +(e.g., `"type": "integer"` instead of `"type": "string"` with manual validation). + + +## Keyword Arguments + +@docs requiredKeywordArg, optionalKeywordArg, keywordArgList + + +## Positional Arguments + +@docs requiredPositionalArg, optionalPositionalArg + + +## Flags and Rest Args + +@docs flag, restArgs + + +## Modifiers + +Re-exported from `Cli.Option` for convenience. + +@docs oneOf, validateMap, validateMapIfPresent, withDefault +@docs withDescription, withDisplayName + +-} + +import Cli.Decode +import Cli.Option exposing (BeginningOption, OptionalPositionalArgOption, RestArgsOption) +import Cli.Option.Internal as Internal exposing (Option(..)) +import Cli.UsageSpec as UsageSpec +import Json.Decode +import Json.Encode +import List.Extra +import Occurences exposing (Occurences(..)) +import Tokenizer +import TsJson.Decode as TsDecode + + +{-| A required keyword argument with a typed decoder. + + Option.requiredKeywordArg "count" TsDecode.int + -- CLI: --count 42 → 42 + -- JSON: {"count": 42} → 42 + -- Schema: {"type": "integer"} + +-} +requiredKeywordArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : ()} +requiredKeywordArg optionName tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ 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 + , usageSpec = UsageSpec.keywordArg optionName Required + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (decodeCliString optionName elmJsonDecoder) + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType tsDecoder + , jsonGrabber = + jsonFieldGrabber optionName elmJsonDecoder + (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) + } + + +{-| An optional keyword argument with a typed decoder. + + Option.optionalKeywordArg "greeting" TsDecode.string + -- CLI: --greeting hi → Just "hi", omitted → Nothing + -- JSON: {"greeting": "hi"} → Just "hi", absent → Nothing + +-} +optionalKeywordArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption} +optionalKeywordArg optionName tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ 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 + , usageSpec = UsageSpec.keywordArg optionName Optional + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just stringValue -> + decodeCliString optionName elmJsonDecoder stringValue + |> Result.map Just + + Nothing -> + Ok Nothing + ) + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType tsDecoder + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of + Ok value -> + Ok ( [], Just value ) + + Err decodeError -> + case Json.Decode.decodeValue (Json.Decode.field optionName Json.Decode.value) blob of + Ok _ -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + Ok ( [], Nothing ) + } + + +{-| A repeated keyword argument with a typed decoder for each value. + + Option.keywordArgList "header" TsDecode.string + -- CLI: --header "X-A: 1" --header "X-B: 2" → ["X-A: 1", "X-B: 2"] + +-} +keywordArgList : String -> TsDecode.Decoder value -> Option (List String) (List value) { position : BeginningOption} +keywordArgList flagName tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ options } -> + options + |> List.filterMap + (\(Tokenizer.ParsedOption optionName optionKind) -> + case ( optionName == flagName, optionKind ) of + ( False, _ ) -> + Nothing + + ( True, Tokenizer.KeywordArg optionValue ) -> + Just optionValue + + ( True, _ ) -> + Nothing + ) + |> Ok + , 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 decodeCliString flagName elmJsonDecoder s of + Ok v -> + Ok (v :: values) + + Err e -> + Err e + ) + (Ok []) + ) + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType (TsDecode.list tsDecoder) + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field flagName (Json.Decode.list elmJsonDecoder)) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + Ok ( [], [] ) + } + + +{-| A required positional argument with a typed decoder. + + Option.requiredPositionalArg "port" TsDecode.int + -- CLI: mytool 8080 → 8080 + -- JSON: {"port": 8080} → 8080 + +-} +requiredPositionalArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : ()} +requiredPositionalArg operandDescription tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \{ 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 + , usageSpec = UsageSpec.operand operandDescription + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (decodeCliString operandDescription elmJsonDecoder) + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType tsDecoder + , jsonGrabber = + jsonFieldGrabber operandDescription elmJsonDecoder + (Cli.Decode.MissingRequiredPositionalArg + { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } + ) + } + + +{-| An optional positional argument with a typed decoder. +Must be used with `OptionsParser.withOptionalPositionalArg`. + + Option.optionalPositionalArg "revision" TsDecode.string + +-} +optionalPositionalArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption} +optionalPositionalArg operandDescription tsDecoder = + let + elmJsonDecoder = + TsDecode.decoder tsDecoder + in + Option + { dataGrabber = + \flagsAndOperands -> + let + operandsSoFar = + UsageSpec.operandCount flagsAndOperands.usageSpecs - 1 + + maybeArg = + flagsAndOperands.operands + |> List.Extra.getAt operandsSoFar + in + Ok maybeArg + , usageSpec = UsageSpec.optionalPositionalArg operandDescription + , decoder = + Cli.Decode.decoder + |> Cli.Decode.mapProcessingError + (\maybeString -> + case maybeString of + Just stringValue -> + decodeCliString operandDescription elmJsonDecoder stringValue + |> Result.map Just + + Nothing -> + Ok Nothing + ) + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType tsDecoder + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field operandDescription elmJsonDecoder) blob of + Ok value -> + Ok ( [], Just value ) + + Err decodeError -> + case Json.Decode.decodeValue (Json.Decode.field operandDescription Json.Decode.value) blob of + Ok _ -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = operandDescription + , invalidReason = Json.Decode.errorToString decodeError + } + ) + + Err _ -> + Ok ( [], Nothing ) + } + + +{-| A boolean flag. Always `Bool` — no decoder needed. + + 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 = + \{ options } -> + if + options + |> List.member (Tokenizer.ParsedOption flagName Tokenizer.Flag) + then + Ok True + + else + Ok False + , usageSpec = UsageSpec.flag flagName Optional + , decoder = Cli.Decode.decoder + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType TsDecode.bool + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field flagName Json.Decode.bool) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + Ok ( [], False ) + } + + +{-| Collect all remaining positional arguments. Must be used with `OptionsParser.withRestArgs`. + + 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 = + \{ operands, usageSpecs } -> + operands + |> List.drop (UsageSpec.operandCount usageSpecs) + |> Ok + , usageSpec = UsageSpec.restArgs restArgsDescription + , decoder = Cli.Decode.decoder + , meta = { missingMessage = Nothing } + , tsType = TsDecode.tsType (TsDecode.list TsDecode.string) + , jsonGrabber = + \blob -> + case Json.Decode.decodeValue (Json.Decode.field restArgsDescription (Json.Decode.list Json.Decode.string)) blob of + Ok value -> + Ok ( [], value ) + + Err _ -> + Ok ( [], [] ) + } + + +{-| See `Cli.Option.oneOf`. +-} +oneOf : List ( String, value ) -> Option from String builderState -> Option from value builderState +oneOf = + Cli.Option.oneOf + + +{-| See `Cli.Option.validateMap`. +-} +validateMap : (to -> Result String toMapped) -> Option from to builderState -> Option from toMapped builderState +validateMap = + Cli.Option.validateMap + + +{-| See `Cli.Option.validateMapIfPresent`. +-} +validateMapIfPresent : (to -> Result String toMapped) -> Option (Maybe from) (Maybe to) builderState -> Option (Maybe from) (Maybe toMapped) builderState +validateMapIfPresent = + Cli.Option.validateMapIfPresent + + +{-| See `Cli.Option.withDefault`. +-} +withDefault : to -> Option from (Maybe to) builderState -> Option from to builderState +withDefault = + Cli.Option.withDefault + + +{-| See `Cli.Option.withDescription`. +-} +withDescription : String -> Option from to builderState -> Option from to builderState +withDescription = + Cli.Option.withDescription + + +{-| See `Cli.Option.withDisplayName`. +-} +withDisplayName : String -> Option from to builderState -> Option from to builderState +withDisplayName = + Cli.Option.withDisplayName + + + +-- Internal helpers + + +decodeCliString : String -> Json.Decode.Decoder a -> String -> Result Cli.Decode.ProcessingError a +decodeCliString optionName elmJsonDecoder stringValue = + case Json.Decode.decodeString elmJsonDecoder stringValue of + Ok value -> + Ok value + + Err _ -> + case Json.Decode.decodeValue elmJsonDecoder (Json.Encode.string stringValue) of + Ok value -> + Ok value + + Err wrappedErr -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString wrappedErr + } + ) + + +jsonFieldGrabber : String -> Json.Decode.Decoder a -> Cli.Decode.MatchErrorDetail -> Internal.JsonGrabber a +jsonFieldGrabber fieldName elmJsonDecoder missingError blob = + case Json.Decode.decodeValue (Json.Decode.field fieldName elmJsonDecoder) 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) diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 158cc1a..c9f295a 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -6,8 +6,6 @@ import Cli.Program as Program import Expect import Json.Encode as Encode import Test exposing (..) -import TsJson.Decode as TsDecode - {-| A realistic CLI: a task management tool with subcommands. @@ -119,48 +117,6 @@ taskConfig = ) -{-| A simpler CLI that shows withTypedJson. - - deploy --config '{"host":"prod.example.com","port":443,"ssl":true}' - --} -type alias DeployOptions = - { config : DeployConfig - , dryRun : Bool - } - - -type alias DeployConfig = - { host : String - , port_ : Int - , ssl : Bool - } - - -deployConfigDecoder : TsDecode.Decoder DeployConfig -deployConfigDecoder = - TsDecode.map3 DeployConfig - (TsDecode.field "host" TsDecode.string) - (TsDecode.field "port" TsDecode.int) - (TsDecode.field "ssl" TsDecode.bool) - - -deployConfig : Program.Config DeployOptions -deployConfig = - Program.config - |> Program.add - (OptionsParser.build DeployOptions - |> OptionsParser.with - (Option.requiredKeywordArg "config" - |> Option.withTypedJson deployConfigDecoder - |> Option.withDescription "Deployment configuration" - ) - |> OptionsParser.with - (Option.flag "dry-run" - |> Option.withDescription "Preview changes without deploying" - ) - ) - all : Test all = @@ -259,44 +215,6 @@ all = ] } ] -}""" - , test "deploy tool schema (with typed JSON)" <| - \() -> - deployConfig - |> Program.toJsonSchema - |> Encode.encode 2 - |> Expect.equal """{ - "$cli": "elm-cli-options-parser", - "type": "object", - "properties": { - "config": { - "type": "object", - "properties": { - "host": { - "type": "string" - }, - "port": { - "type": "integer" - }, - "ssl": { - "type": "boolean" - } - }, - "required": [ - "host", - "port", - "ssl" - ], - "description": "Deployment configuration" - }, - "dry-run": { - "type": "boolean", - "description": "Preview changes without deploying" - } - }, - "required": [ - "config" - ] }""" ] , describe "2. Help text (what users see with --help)" @@ -341,20 +259,6 @@ Options: --limit <LIMIT> Maximum number of tasks to show --verbose Show full task details""" ) - , test "deploy tool help" <| - \() -> - Program.run deployConfig - [ "node", "deploy", "--help" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal - (Program.SystemMessage Program.Success - """Usage: deploy --config <JSON> [--dry-run] - -Options: - --config <JSON> Deployment configuration - --dry-run Preview changes without deploying""" - ) ] , describe "3a. CLI mode - correct usage" [ test "add task via CLI" <| @@ -378,13 +282,6 @@ Options: "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) - , test "deploy via CLI with JSON string arg" <| - \() -> - Program.run deployConfig - [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) ] , describe "3b. JSON input mode - correct usage" [ test "add task via JSON" <| @@ -409,15 +306,6 @@ Options: "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) - , test "deploy via JSON - typed JSON arg gets nested object" <| - \() -> - -- With direct JSON decoding, the nested object is decoded natively - -- No round-trip through string serialization - Program.run deployConfig - [ "node", "deploy", "{\"$cli\":\"elm-cli-options-parser\",\"config\":{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) ] , describe "4a. CLI mode - error messages" [ test "missing required option" <| @@ -499,23 +387,6 @@ Run with --help for usage information.""" `--pririty` <> `--priority`""" ) - , test "invalid typed JSON in CLI mode" <| - \() -> - Program.run deployConfig - [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":\"not-a-number\"}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal - (Program.SystemMessage Program.Failure - """Validation errors: - -Invalid `--config` option. -Problem with the value at json.port: - - "not-a-number" - -Expecting an INT""" - ) ] , describe "4b. JSON input mode - error messages" [ test "missing required field in JSON" <| @@ -560,23 +431,6 @@ Problem with the value at json.limit: Expecting a STRING""" ) - , test "invalid typed JSON in JSON mode" <| - \() -> - Program.run deployConfig - [ "node", "deploy", "{\"$cli\":\"elm-cli-options-parser\",\"config\":{\"host\":\"prod.example.com\",\"port\":\"not-a-number\"}}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal - (Program.SystemMessage Program.Failure - """Validation errors: - -Invalid "config" field. -Problem with the value at json.config.port: - - "not-a-number" - -Expecting an INT""" - ) ] , describe "5. String vs int type difference" [ test "limit as string '10' works (CLI)" <| @@ -606,32 +460,5 @@ Problem with the value at json.limit: Expecting a STRING""" ) - , test "port in typed JSON is a real integer (no string coercion)" <| - \() -> - -- With withTypedJson, the decoder expects an actual integer - -- Passing a string "443" for port would FAIL - Program.run deployConfig - [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":443,\"ssl\":true}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal (Program.CustomMatch { config = { host = "prod.example.com", port_ = 443, ssl = True }, dryRun = False }) - , test "port as string in typed JSON fails with type error" <| - \() -> - -- This SHOULD fail because the TsJson decoder expects int, not string - Program.run deployConfig - [ "node", "deploy", "--config", "{\"host\":\"prod.example.com\",\"port\":\"443\",\"ssl\":true}" ] - "1.0.0" - Program.WithoutColor - |> Expect.equal - (Program.SystemMessage Program.Failure - """Validation errors: - -Invalid `--config` option. -Problem with the value at json.port: - - "443" - -Expecting an INT""" - ) ] ] diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 44255a7..95239dd 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -6,8 +6,6 @@ import Cli.Program as Program import Expect import Json.Encode as Encode import Test exposing (..) -import TsJson.Decode as TsDecode - all : Test all = @@ -260,318 +258,6 @@ all = |> Encode.encode 0 ) ] - , describe "withTypedJson" - [ test "withTypedJson embeds JSON schema for keyword arg" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - in - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - ) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "todo" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) - , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "description", "title" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "todo" ] ) - ] - |> Encode.encode 0 - ) - , test "withTypedJson description is merged into embedded schema" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - in - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - |> Option.withDescription "The todo item" - ) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "todo" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) - , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "description", "title" ] ) - , ( "description", Encode.string "The todo item" ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "todo" ] ) - ] - |> Encode.encode 0 - ) - ] - , describe "typed constructors" - [ test "Option.required with TsDecode.int has integer schema" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - |> Encode.encode 0 - ) - , test "Option.required CLI mode parses string via decodeString" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "42" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch 42) - , test "Option.required JSON mode decodes native value" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch 42) - , test "Option.required CLI mode error for non-numeric string" <| - \() -> - -- "abc" should produce "Expecting an INT", not "not valid JSON" - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "abc" ] - "1.0.0" - Program.WithoutColor - ) - |> expectRunResultContains "Expecting an INT" - , test "Option.required CLI mode error for wrong JSON type" <| - \() -> - -- "true" is valid JSON but not an int - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "true" ] - "1.0.0" - Program.WithoutColor - ) - |> expectRunResultContains "Expecting an INT" - , test "Option.required with string decoder works in CLI mode without quoting" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "name" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--name", "hello" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch "hello") - , test "Option.required with description includes it in schema" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.required "count" TsDecode.int - |> Option.withDescription "Number of items" - ) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "count" - , Encode.object - [ ( "type", Encode.string "integer" ) - , ( "description", Encode.string "Number of items" ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - |> Encode.encode 0 - ) - , test "Option.optional with TsDecode.int has integer schema and is not required" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.optional "count" TsDecode.int) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) - ] - ) - ] - |> Encode.encode 0 - ) - , test "Option.optional JSON mode decodes native value" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.optional "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch (Just 42)) - , test "Option.optional JSON mode returns Nothing when absent" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.optional "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\"}" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch Nothing) - , test "Option.optional CLI mode parses string via decodeString" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.optional "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "42" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch (Just 42)) - , test "Option.optional CLI mode returns Nothing when absent" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.optional "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch Nothing) - , test "Option.required JSON mode error for wrong type" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.required "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":\"not-a-number\"}" ] - "1.0.0" - Program.WithoutColor - ) - |> expectRunResultContains "Expecting an INT" - ] , describe "JSON input mode" [ test "accepts JSON blob with $cli sentinel" <| \() -> @@ -620,31 +306,7 @@ all = ) |> Expect.equal (Program.CustomMatch "World") - , test "JSON input mode with typed JSON arg" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - in - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - ) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"todo\":{\"title\":\"Buy groceries\",\"description\":\"Get milk\"}}" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal - (Program.CustomMatch { title = "Buy groceries", description = "Get milk" }) - , test "JSON input mode with missing required field gives JSON-native error" <| + , test "JSON input mode with missing required field gives JSON-native error" <| \() -> let cfg = @@ -663,76 +325,6 @@ all = (Program.SystemMessage Program.Failure "Missing required field: \"name\"" ) - , test "JSON input mode with invalid JSON for typed arg gives validation error" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - - result = - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - ) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"todo\":{\"title\":123}}" ] - "1.0.0" - Program.WithoutColor - ) - in - Expect.equal result - (Program.SystemMessage Program.Failure - """Validation errors: - -Invalid "todo" field. -Problem with the value at json.todo.title: - - 123 - -Expecting a STRING""" - ) - , test "traditional CLI with invalid JSON for typed arg gives same validation error" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - - result = - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - ) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--todo", "{\"title\":123}" ] - "1.0.0" - Program.WithoutColor - ) - in - Expect.equal result - (Program.SystemMessage Program.Failure - """Validation errors: - -Invalid `--todo` option. -Problem with the value at json.title: - - 123 - -Expecting a STRING""" - ) , 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. @@ -814,19 +406,3 @@ expectJsonSchema { properties, required } config = ) |> Encode.encode 0 ) - - -{-| Assert that a Program.RunResult contains a specific substring in its error message. --} -expectRunResultContains : String -> Program.RunResult msg -> Expect.Expectation -expectRunResultContains substring result = - case result of - Program.SystemMessage Program.Failure message -> - if String.contains substring 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) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 39cbddb..5831139 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -7,7 +7,6 @@ import Cli.Program as Program import Expect import Json.Encode as Encode import Test exposing (..) -import TsJson.Decode as TsDecode import TsJson.Type @@ -196,47 +195,6 @@ all = |> Encode.encode 0 ) ] - , describe "withTypedJson replaces TsType" - [ test "withTypedJson replaces string TsType with object TsType" <| - \() -> - let - todoDecoder = - TsDecode.map2 (\title desc -> { title = title, description = desc }) - (TsDecode.field "title" TsDecode.string) - (TsDecode.field "description" TsDecode.string) - in - Option.requiredKeywordArg "todo" - |> Option.withTypedJson todoDecoder - |> optionTsTypeToJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "description", Encode.object [ ( "type", Encode.string "string" ) ] ) - , ( "title", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "description", "title" ] ) - ] - |> Encode.encode 0 - ) - , test "withTypedJson on int decoder gives integer type" <| - \() -> - Option.requiredKeywordArg "count" - |> Option.withTypedJson TsDecode.int - |> optionTsTypeToJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) - , ( "type", Encode.string "integer" ) - ] - |> Encode.encode 0 - ) - ] , describe "toJsonSchema output" [ test "oneOf uses anyOf/const format" <| \() -> diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm new file mode 100644 index 0000000..720a916 --- /dev/null +++ b/tests/TypedOptionTests.elm @@ -0,0 +1,296 @@ +module TypedOptionTests exposing (all) + +import Cli.Option as UntypedOption +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" + [ test "requiredKeywordArg with string decoder parses CLI arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "name" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--name", "hello" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch "hello") + , test "requiredKeywordArg with int decoder parses CLI arg" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "42" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch 42) + , test "requiredKeywordArg with int decoder works in JSON mode" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch 42) + , test "requiredKeywordArg produces correct JSON schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "count" TsDecode.int) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> Encode.encode 0 + ) + , test "requiredKeywordArg int gives clear CLI error for non-numeric" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "count" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--count", "abc" ] + "1.0.0" + Program.WithoutColor + ) + |> expectFailureContaining "Expecting an INT" + , test "optionalKeywordArg with string returns Just when present" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.optionalKeywordArg "greeting" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--greeting", "hi" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch (Just "hi")) + , test "optionalKeywordArg returns Nothing when absent" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.optionalKeywordArg "greeting" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch Nothing) + , test "re-exported oneOf works without separate import" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "format" TsDecode.string + |> Option.oneOf + [ ( "json", "JSON" ) + , ( "csv", "CSV" ) + ] + ) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--format", "json" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch "JSON") + , test "flag works" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--verbose" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch True) + , test "re-exported withDescription works without separate import" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredKeywordArg "count" TsDecode.int + |> Option.withDescription "Number of items" + ) + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "description", Encode.string "Number of items" ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> Encode.encode 0 + ) + , test "requiredPositionalArg with string decoder" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredPositionalArg "file" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "hello.txt" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch "hello.txt") + , test "requiredPositionalArg with int decoder" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.requiredPositionalArg "port" TsDecode.int) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "8080" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch 8080) + , test "optionalPositionalArg returns Just when present" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg + (Option.optionalPositionalArg "revision" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "abc123" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch (Just "abc123")) + , test "optionalPositionalArg returns Nothing when absent" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.withOptionalPositionalArg + (Option.optionalPositionalArg "revision" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch Nothing) + , test "restArgs collects remaining positional 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" ]) + , test "keywordArgList collects repeated keyword args" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with + (Option.keywordArgList "header" TsDecode.string) + ) + |> (\cfg -> + Program.run cfg + [ "node", "test", "--header", "X-A: 1", "--header", "X-B: 2" ] + "1.0.0" + Program.WithoutColor + ) + |> Expect.equal (Program.CustomMatch [ "X-A: 1", "X-B: 2" ]) + ] + + +expectFailureContaining : String -> Program.RunResult msg -> Expect.Expectation +expectFailureContaining substring result = + case result of + Program.SystemMessage Program.Failure message -> + if String.contains substring 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) From 8f6689e6cdef219ead19e00c2c0a82eb5f50717f Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Thu, 12 Mar 2026 15:55:10 -0700 Subject: [PATCH 03/34] Fix Ci. --- examples/elm.json | 8 ++++--- src/Cli/Option.elm | 27 +++++++++++---------- src/Cli/Option/Typed.elm | 34 +++++++++++++++++++-------- src/Cli/Program.elm | 3 --- src/Cli/UsageSpec.elm | 3 +-- tests/ErrorMessageFormattingTests.elm | 1 + tests/ExperienceTests.elm | 4 +++- tests/JsonSchemaTests.elm | 1 + 8 files changed, 49 insertions(+), 32 deletions(-) diff --git a/examples/elm.json b/examples/elm.json index 76934be..60b9725 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.1", "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/src/Cli/Option.elm b/src/Cli/Option.elm index 5a21e8e..4aa4b88 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -156,7 +156,6 @@ type OptionalPositionalArgOption = OptionalPositionalArgOption Never - {-| Run a validation. (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). -} @@ -228,7 +227,7 @@ Parses to: `"src/Main.elm"` Option.requiredPositionalArg "input" -} -requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : ()} +requiredPositionalArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } requiredPositionalArg operandDescription = buildRequiredOption (\{ operands, operandsSoFar } -> @@ -251,7 +250,8 @@ requiredPositionalArg operandDescription = ) (UsageSpec.operand operandDescription) (TsDecode.tsType TsDecode.string) - (jsonFieldGrabber operandDescription Json.Decode.string + (jsonFieldGrabber operandDescription + Json.Decode.string (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } ) @@ -266,7 +266,7 @@ Parses to: `Just "main.js"` (or `Nothing` if omitted) Option.optionalKeywordArg "output" -} -optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption} +optionalKeywordArg : String -> Option (Maybe String) (Maybe String) { position : BeginningOption } optionalKeywordArg optionName = buildOptionalOption (\{ options } -> @@ -299,7 +299,7 @@ Parses to: `"my-app"` Option.requiredKeywordArg "name" -} -requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : ()} +requiredKeywordArg : String -> Option String String { position : BeginningOption, canAddMissingMessage : () } requiredKeywordArg optionName = buildRequiredOption (\{ options } -> @@ -323,7 +323,8 @@ requiredKeywordArg optionName = ) (UsageSpec.keywordArg optionName Required) (TsDecode.tsType TsDecode.string) - (jsonFieldGrabber optionName Json.Decode.string + (jsonFieldGrabber optionName + Json.Decode.string (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) ) @@ -336,7 +337,7 @@ Parses to: `True` (or `False` if omitted) Option.flag "debug" -} -flag : String -> Option Bool Bool { position : BeginningOption} +flag : String -> Option Bool Bool { position : BeginningOption } flag flagName = buildOptionalOption (\{ options } -> @@ -356,7 +357,7 @@ flag flagName = {-| Build an option for required arguments (has canAddMissingMessage capability). -} -buildRequiredOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption, canAddMissingMessage : ()} +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 @@ -370,7 +371,7 @@ buildRequiredOption dataGrabber usageSpec tsType jsonGrabber = {-| Build an option for optional arguments (no canAddMissingMessage capability). -} -buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption} +buildOptionalOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : BeginningOption } buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber @@ -384,7 +385,7 @@ buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = {-| Build an ending option (like restArgs, optionalPositionalArg). -} -buildEndingOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : position} +buildEndingOption : Internal.DataGrabber a -> UsageSpec -> TsJson.Type.Type -> Internal.JsonGrabber a -> Option a a { position : position } buildEndingOption dataGrabber usageSpec tsType jsonGrabber = Option { dataGrabber = dataGrabber @@ -843,7 +844,7 @@ Parses to: `["Auth: token", "Accept: json"]` Option.keywordArgList "header" -} -keywordArgList : String -> Option (List String) (List String) { position : BeginningOption} +keywordArgList : String -> Option (List String) (List String) { position : BeginningOption } keywordArgList flagName = buildOptionalOption (\{ options } -> @@ -870,7 +871,7 @@ keywordArgList flagName = {-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. -} -optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption} +optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption } optionalPositionalArg operandDescription = buildEndingOption (\flagsAndOperands -> @@ -894,7 +895,7 @@ optionalPositionalArg operandDescription = {-| Note that this must be used with `OptionsParser.withRestArgs`. -} -restArgs : String -> Option (List String) (List String) { position : RestArgsOption} +restArgs : String -> Option (List String) (List String) { position : RestArgsOption } restArgs restArgsDescription = buildEndingOption (\{ operands, usageSpecs } -> diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index c0a0e30..52bc50b 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,5 +1,6 @@ module Cli.Option.Typed exposing - ( requiredKeywordArg, optionalKeywordArg, keywordArgList + ( Option + , requiredKeywordArg, optionalKeywordArg, keywordArgList , requiredPositionalArg, optionalPositionalArg , flag, restArgs , oneOf, validateMap, validateMapIfPresent, withDefault @@ -14,6 +15,11 @@ Use this module instead of `Cli.Option` when you want typed JSON schemas (e.g., `"type": "integer"` instead of `"type": "string"` with manual validation). +## Types + +@docs Option + + ## Keyword Arguments @docs requiredKeywordArg, optionalKeywordArg, keywordArgList @@ -50,6 +56,12 @@ import Tokenizer import TsJson.Decode as TsDecode +{-| Re-exported from `Cli.Option` for convenience. See `Cli.Option.Option`. +-} +type alias Option from to builderState = + Internal.Option from to builderState + + {-| A required keyword argument with a typed decoder. Option.requiredKeywordArg "count" TsDecode.int @@ -58,7 +70,7 @@ import TsJson.Decode as TsDecode -- Schema: {"type": "integer"} -} -requiredKeywordArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : ()} +requiredKeywordArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } requiredKeywordArg optionName tsDecoder = let elmJsonDecoder = @@ -92,7 +104,8 @@ requiredKeywordArg optionName tsDecoder = , meta = { missingMessage = Nothing } , tsType = TsDecode.tsType tsDecoder , jsonGrabber = - jsonFieldGrabber optionName elmJsonDecoder + jsonFieldGrabber optionName + elmJsonDecoder (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) } @@ -104,7 +117,7 @@ requiredKeywordArg optionName tsDecoder = -- JSON: {"greeting": "hi"} → Just "hi", absent → Nothing -} -optionalKeywordArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption} +optionalKeywordArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption } optionalKeywordArg optionName tsDecoder = let elmJsonDecoder = @@ -170,7 +183,7 @@ optionalKeywordArg optionName tsDecoder = -- CLI: --header "X-A: 1" --header "X-B: 2" → ["X-A: 1", "X-B: 2"] -} -keywordArgList : String -> TsDecode.Decoder value -> Option (List String) (List value) { position : BeginningOption} +keywordArgList : String -> TsDecode.Decoder value -> Option (List String) (List value) { position : BeginningOption } keywordArgList flagName tsDecoder = let elmJsonDecoder = @@ -235,7 +248,7 @@ keywordArgList flagName tsDecoder = -- JSON: {"port": 8080} → 8080 -} -requiredPositionalArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : ()} +requiredPositionalArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } requiredPositionalArg operandDescription tsDecoder = let elmJsonDecoder = @@ -268,7 +281,8 @@ requiredPositionalArg operandDescription tsDecoder = , meta = { missingMessage = Nothing } , tsType = TsDecode.tsType tsDecoder , jsonGrabber = - jsonFieldGrabber operandDescription elmJsonDecoder + jsonFieldGrabber operandDescription + elmJsonDecoder (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } ) @@ -281,7 +295,7 @@ Must be used with `OptionsParser.withOptionalPositionalArg`. Option.optionalPositionalArg "revision" TsDecode.string -} -optionalPositionalArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption} +optionalPositionalArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption } optionalPositionalArg operandDescription tsDecoder = let elmJsonDecoder = @@ -342,7 +356,7 @@ optionalPositionalArg operandDescription tsDecoder = -- JSON: {"verbose": true} → True, absent → False -} -flag : String -> Option Bool Bool { position : BeginningOption} +flag : String -> Option Bool Bool { position : BeginningOption } flag flagName = Option { dataGrabber = @@ -376,7 +390,7 @@ flag flagName = -- CLI: mytool a.txt b.txt → ["a.txt", "b.txt"] -} -restArgs : String -> Option (List String) (List String) { position : RestArgsOption} +restArgs : String -> Option (List String) (List String) { position : RestArgsOption } restArgs restArgsDescription = Option { dataGrabber = diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index d01946d..2d6cc4c 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -632,7 +632,6 @@ toJsonSchema (Config { optionsParsers }) = baseSchema - parserToJsonSchemaFromTsTypes : OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value parserToJsonSchemaFromTsTypes parser = let @@ -728,7 +727,6 @@ usageSpecDescription spec = maybeDescription - usageSpecToRequired : UsageSpec -> Maybe String usageSpecToRequired spec = case spec of @@ -757,7 +755,6 @@ usageSpecToRequired spec = Nothing - {-| Merge additional key-value pairs into a JSON object value. New fields are prepended (appear first in the output). If the value is not a decodable object, wraps the pairs as a new object. diff --git a/src/Cli/UsageSpec.elm b/src/Cli/UsageSpec.elm index 71d4943..cd62292 100644 --- a/src/Cli/UsageSpec.elm +++ b/src/Cli/UsageSpec.elm @@ -99,7 +99,6 @@ setDisplayName displayName usageSpec = usageSpec - changeUsageSpec : List String -> UsageSpec -> UsageSpec changeUsageSpec possibleValues usageSpec = case usageSpec of @@ -522,7 +521,7 @@ wrapPartsHelper : Int -> String -> List String -> String -> List String -> Strin 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/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 index c9f295a..e6a0913 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -7,10 +7,13 @@ 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 -} @@ -117,7 +120,6 @@ taskConfig = ) - all : Test all = describe "Developer & User Experience" diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 95239dd..88553bc 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -7,6 +7,7 @@ import Expect import Json.Encode as Encode import Test exposing (..) + all : Test all = describe "toJsonSchema" From 611ebf04a26eec00cbb07a071d18254a804d7d06 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Thu, 12 Mar 2026 19:59:31 -0700 Subject: [PATCH 04/34] Migrate to two separate modules for elm-ts-json decoder API vs. standard CLI options parsing. --- src/Cli/Option/Typed.elm | 235 +++++++++----- tests/TypedOptionTests.elm | 624 +++++++++++++++++++++---------------- 2 files changed, 522 insertions(+), 337 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 52bc50b..bb46f72 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,5 +1,6 @@ module Cli.Option.Typed exposing - ( Option + ( Option, CliDecoder + , string, int, float, bool, fromDecoder , requiredKeywordArg, optionalKeywordArg, keywordArgList , requiredPositionalArg, optionalPositionalArg , flag, restArgs @@ -7,17 +8,20 @@ module Cli.Option.Typed exposing , withDescription, withDisplayName ) -{-| Typed option constructors that take a `TsDecode.Decoder` for first-class -JSON schema support. Each constructor produces both a CLI parser and a JSON -schema from the same decoder. +{-| Typed option constructors for first-class JSON schema support. -Use this module instead of `Cli.Option` when you want typed JSON schemas -(e.g., `"type": "integer"` instead of `"type": "string"` with manual validation). +Each constructor produces both a CLI parser and a JSON schema from a `CliDecoder`. +Use `string`, `int`, `float`, `bool` for primitives, or `fromDecoder` for custom types. ## Types -@docs Option +@docs Option, CliDecoder + + +## Decoders + +@docs string, int, float, bool, fromDecoder ## Keyword Arguments @@ -49,7 +53,6 @@ import Cli.Option exposing (BeginningOption, OptionalPositionalArgOption, RestAr import Cli.Option.Internal as Internal exposing (Option(..)) import Cli.UsageSpec as UsageSpec import Json.Decode -import Json.Encode import List.Extra import Occurences exposing (Occurences(..)) import Tokenizer @@ -62,20 +65,123 @@ type alias Option from to builderState = Internal.Option from to builderState +{-| A decoder that knows how to parse values from both CLI args and JSON input. + +Use `string`, `int`, `float`, `bool` for primitives, or `fromDecoder` 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 = + fromDecoder 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 = + fromDecoder TsDecode.float + + +{-| A boolean value. In CLI mode, the string is parsed as a JSON boolean. +In JSON mode, a JSON boolean field is decoded. + +Note: for flags (present/absent), use `flag` instead. + + Option.requiredKeywordArg "dry-run" Option.bool + -- CLI: --dry-run true → True + -- JSON: {"dry-run": true} → True + +-} +bool : CliDecoder Bool +bool = + fromDecoder TsDecode.bool + + +{-| Create a `CliDecoder` from a `TsDecode.Decoder`. In CLI mode, the string +value is parsed as strict JSON. 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` instead. + + import TsJson.Decode as TsDecode + + pointDecoder = + TsDecode.succeed (\x y -> { x = x, y = y }) + |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) + |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) + + Option.requiredKeywordArg "point" (Option.fromDecoder pointDecoder) + -- CLI: --point '{"x":1,"y":2}' + -- JSON: {"point": {"x": 1, "y": 2}} + +-} +fromDecoder : TsDecode.Decoder value -> CliDecoder value +fromDecoder tsDecoder = + CliDecoder + { cliParser = decodeCliJson (TsDecode.decoder tsDecoder) + , jsonDecoder = TsDecode.decoder tsDecoder + , tsDecoder = tsDecoder + } + + + +-- Constructors + + {-| A required keyword argument with a typed decoder. - Option.requiredKeywordArg "count" TsDecode.int + Option.requiredKeywordArg "count" Option.int -- CLI: --count 42 → 42 -- JSON: {"count": 42} → 42 -- Schema: {"type": "integer"} -} -requiredKeywordArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } -requiredKeywordArg optionName tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in +requiredKeywordArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } +requiredKeywordArg optionName (CliDecoder decoder) = Option { dataGrabber = \{ options } -> @@ -100,29 +206,25 @@ requiredKeywordArg optionName tsDecoder = , decoder = Cli.Decode.decoder |> Cli.Decode.mapProcessingError - (decodeCliString optionName elmJsonDecoder) + (decoder.cliParser optionName) , meta = { missingMessage = Nothing } - , tsType = TsDecode.tsType tsDecoder + , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = jsonFieldGrabber optionName - elmJsonDecoder + decoder.jsonDecoder (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) } {-| An optional keyword argument with a typed decoder. - Option.optionalKeywordArg "greeting" TsDecode.string + Option.optionalKeywordArg "greeting" Option.string -- CLI: --greeting hi → Just "hi", omitted → Nothing -- JSON: {"greeting": "hi"} → Just "hi", absent → Nothing -} -optionalKeywordArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption } -optionalKeywordArg optionName tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in +optionalKeywordArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption } +optionalKeywordArg optionName (CliDecoder decoder) = Option { dataGrabber = \{ options } -> @@ -148,17 +250,17 @@ optionalKeywordArg optionName tsDecoder = (\maybeString -> case maybeString of Just stringValue -> - decodeCliString optionName elmJsonDecoder stringValue + decoder.cliParser optionName stringValue |> Result.map Just Nothing -> Ok Nothing ) , meta = { missingMessage = Nothing } - , tsType = TsDecode.tsType tsDecoder + , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = \blob -> - case Json.Decode.decodeValue (Json.Decode.field optionName elmJsonDecoder) blob of + case Json.Decode.decodeValue (Json.Decode.field optionName decoder.jsonDecoder) blob of Ok value -> Ok ( [], Just value ) @@ -179,16 +281,12 @@ optionalKeywordArg optionName tsDecoder = {-| A repeated keyword argument with a typed decoder for each value. - Option.keywordArgList "header" TsDecode.string + Option.keywordArgList "header" Option.string -- CLI: --header "X-A: 1" --header "X-B: 2" → ["X-A: 1", "X-B: 2"] -} -keywordArgList : String -> TsDecode.Decoder value -> Option (List String) (List value) { position : BeginningOption } -keywordArgList flagName tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in +keywordArgList : String -> CliDecoder value -> Option (List String) (List value) { position : BeginningOption } +keywordArgList flagName (CliDecoder decoder) = Option { dataGrabber = \{ options } -> @@ -219,7 +317,7 @@ keywordArgList flagName tsDecoder = Err e Ok values -> - case decodeCliString flagName elmJsonDecoder s of + case decoder.cliParser flagName s of Ok v -> Ok (v :: values) @@ -229,10 +327,10 @@ keywordArgList flagName tsDecoder = (Ok []) ) , meta = { missingMessage = Nothing } - , tsType = TsDecode.tsType (TsDecode.list tsDecoder) + , tsType = TsDecode.tsType (TsDecode.list decoder.tsDecoder) , jsonGrabber = \blob -> - case Json.Decode.decodeValue (Json.Decode.field flagName (Json.Decode.list elmJsonDecoder)) blob of + case Json.Decode.decodeValue (Json.Decode.field flagName (Json.Decode.list decoder.jsonDecoder)) blob of Ok value -> Ok ( [], value ) @@ -243,17 +341,13 @@ keywordArgList flagName tsDecoder = {-| A required positional argument with a typed decoder. - Option.requiredPositionalArg "port" TsDecode.int + Option.requiredPositionalArg "port" Option.int -- CLI: mytool 8080 → 8080 -- JSON: {"port": 8080} → 8080 -} -requiredPositionalArg : String -> TsDecode.Decoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } -requiredPositionalArg operandDescription tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in +requiredPositionalArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } +requiredPositionalArg operandDescription (CliDecoder decoder) = Option { dataGrabber = \{ operands, operandsSoFar } -> @@ -277,12 +371,12 @@ requiredPositionalArg operandDescription tsDecoder = , decoder = Cli.Decode.decoder |> Cli.Decode.mapProcessingError - (decodeCliString operandDescription elmJsonDecoder) + (decoder.cliParser operandDescription) , meta = { missingMessage = Nothing } - , tsType = TsDecode.tsType tsDecoder + , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = jsonFieldGrabber operandDescription - elmJsonDecoder + decoder.jsonDecoder (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } ) @@ -292,15 +386,11 @@ requiredPositionalArg operandDescription tsDecoder = {-| An optional positional argument with a typed decoder. Must be used with `OptionsParser.withOptionalPositionalArg`. - Option.optionalPositionalArg "revision" TsDecode.string + Option.optionalPositionalArg "revision" Option.string -} -optionalPositionalArg : String -> TsDecode.Decoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption } -optionalPositionalArg operandDescription tsDecoder = - let - elmJsonDecoder = - TsDecode.decoder tsDecoder - in +optionalPositionalArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption } +optionalPositionalArg operandDescription (CliDecoder decoder) = Option { dataGrabber = \flagsAndOperands -> @@ -320,17 +410,17 @@ optionalPositionalArg operandDescription tsDecoder = (\maybeString -> case maybeString of Just stringValue -> - decodeCliString operandDescription elmJsonDecoder stringValue + decoder.cliParser operandDescription stringValue |> Result.map Just Nothing -> Ok Nothing ) , meta = { missingMessage = Nothing } - , tsType = TsDecode.tsType tsDecoder + , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = \blob -> - case Json.Decode.decodeValue (Json.Decode.field operandDescription elmJsonDecoder) blob of + case Json.Decode.decodeValue (Json.Decode.field operandDescription decoder.jsonDecoder) blob of Ok value -> Ok ( [], Just value ) @@ -413,6 +503,10 @@ restArgs restArgsDescription = } + +-- Re-exported modifiers + + {-| See `Cli.Option.oneOf`. -} oneOf : List ( String, value ) -> Option from String builderState -> Option from value builderState @@ -459,24 +553,21 @@ withDisplayName = -- Internal helpers -decodeCliString : String -> Json.Decode.Decoder a -> String -> Result Cli.Decode.ProcessingError a -decodeCliString optionName elmJsonDecoder stringValue = +{-| 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 _ -> - case Json.Decode.decodeValue elmJsonDecoder (Json.Encode.string stringValue) of - Ok value -> - Ok value - - Err wrappedErr -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString wrappedErr - } - ) + Err err -> + Err + (Cli.Decode.UnrecoverableValidationError + { name = optionName + , invalidReason = Json.Decode.errorToString err + } + ) jsonFieldGrabber : String -> Json.Decode.Decoder a -> Cli.Decode.MatchErrorDetail -> Internal.JsonGrabber a diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 720a916..78f795a 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -1,6 +1,6 @@ module TypedOptionTests exposing (all) -import Cli.Option as UntypedOption +import Cli.Option import Cli.Option.Typed as Option import Cli.OptionsParser as OptionsParser import Cli.Program as Program @@ -13,280 +13,374 @@ import TsJson.Decode as TsDecode all : Test all = describe "Cli.Option.Typed" - [ test "requiredKeywordArg with string decoder parses CLI arg" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "name" TsDecode.string) + [ 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 + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "name" ] ) + ] + |> 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 + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> 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 "Option.bool" + [ test "parses 'true'" <| + \() -> + runWith (Option.requiredKeywordArg "dry" Option.bool) + [ "--dry", "true" ] + |> Expect.equal (Program.CustomMatch True) + , test "parses 'false'" <| + \() -> + runWith (Option.requiredKeywordArg "dry" Option.bool) + [ "--dry", "false" ] + |> Expect.equal (Program.CustomMatch False) + , test "rejects bare text" <| + \() -> + runWith (Option.requiredKeywordArg "dry" Option.bool) + [ "--dry", "abc" ] + |> expectFailure + ] + , describe "fromDecoder" + [ 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.fromDecoder 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.fromDecoder pointDecoder)) + [ "--point", "{\"x\":1,\"y\":2}" ] + |> Expect.equal (Program.CustomMatch ( 1, 2 )) + , test "fromDecoder TsDecode.string in CLI mode requires JSON-quoted string" <| + \() -> + -- bare text is NOT valid JSON — this should fail + runWith (Option.requiredKeywordArg "name" (Option.fromDecoder TsDecode.string)) + [ "--name", "hello" ] + |> expectFailure + , test "fromDecoder TsDecode.string in CLI mode accepts JSON-quoted string" <| + \() -> + -- JSON string: "hello" (with quotes on CLI) + runWith (Option.requiredKeywordArg "name" (Option.fromDecoder 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 "modifiers" + [ test "oneOf works" <| + \() -> + runWith + (Option.requiredKeywordArg "format" Option.string + |> Option.oneOf + [ ( "json", "JSON" ) + , ( "csv", "CSV" ) + ] ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--name", "hello" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch "hello") - , test "requiredKeywordArg with int decoder parses CLI arg" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "count" TsDecode.int) + [ "--format", "json" ] + |> Expect.equal (Program.CustomMatch "JSON") + , test "withDescription adds to schema" <| + \() -> + schemaFor + (Option.requiredKeywordArg "count" Option.int + |> Option.withDescription "Number of items" ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "42" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch 42) - , test "requiredKeywordArg with int decoder works in JSON mode" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"count\":42}" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch 42) - , test "requiredKeywordArg produces correct JSON schema" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "count" TsDecode.int) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - |> Encode.encode 0 - ) - , test "requiredKeywordArg int gives clear CLI error for non-numeric" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "count" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--count", "abc" ] - "1.0.0" - Program.WithoutColor - ) - |> expectFailureContaining "Expecting an INT" - , test "optionalKeywordArg with string returns Just when present" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.optionalKeywordArg "greeting" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--greeting", "hi" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch (Just "hi")) - , test "optionalKeywordArg returns Nothing when absent" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.optionalKeywordArg "greeting" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch Nothing) - , test "re-exported oneOf works without separate import" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "format" TsDecode.string - |> Option.oneOf - [ ( "json", "JSON" ) - , ( "csv", "CSV" ) + |> Expect.equal + (Encode.object + [ ( "$cli", Encode.string "elm-cli-options-parser" ) + , ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "description", Encode.string "Number of items" ) + ] + ) ] - ) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--format", "json" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch "JSON") - , test "flag works" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.flag "verbose") - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--verbose" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch True) - , test "re-exported withDescription works without separate import" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredKeywordArg "count" TsDecode.int - |> Option.withDescription "Number of items" - ) - ) - |> Program.toJsonSchema - |> Encode.encode 0 - |> Expect.equal - (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "count" - , Encode.object - [ ( "type", Encode.string "integer" ) - , ( "description", Encode.string "Number of items" ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - |> Encode.encode 0 - ) - , test "requiredPositionalArg with string decoder" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredPositionalArg "file" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "hello.txt" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch "hello.txt") - , test "requiredPositionalArg with int decoder" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.requiredPositionalArg "port" TsDecode.int) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "8080" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch 8080) - , test "optionalPositionalArg returns Just when present" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.withOptionalPositionalArg - (Option.optionalPositionalArg "revision" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "abc123" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch (Just "abc123")) - , test "optionalPositionalArg returns Nothing when absent" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.withOptionalPositionalArg - (Option.optionalPositionalArg "revision" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch Nothing) - , test "restArgs collects remaining positional 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" ]) - , test "keywordArgList collects repeated keyword args" <| - \() -> - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with - (Option.keywordArgList "header" TsDecode.string) - ) - |> (\cfg -> - Program.run cfg - [ "node", "test", "--header", "X-A: 1", "--header", "X-B: 2" ] - "1.0.0" - Program.WithoutColor - ) - |> Expect.equal (Program.CustomMatch [ "X-A: 1", "X-B: 2" ]) + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + |> 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 (( "$cli", Encode.string "elm-cli-options-parser" ) :: fields) + |> 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 + |> Encode.encode 0 + + +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 message then + if String.contains substring (String.toUpper message) then Expect.pass else From d6639573fdf5d9ddba90e6fddd756a1247abdf6f Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Thu, 12 Mar 2026 21:15:55 -0700 Subject: [PATCH 05/34] Ignore docs.json. --- .gitignore | 1 + docs.json | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) delete mode 100644 docs.json 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/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 <json|junit|console>] <TESTFILES>...\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 <greeting1> [name1][name2] <greeting2> [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 From 43b3c2911a9a2164b8c8739bcf4735a1331bc49e Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 06:40:33 -0700 Subject: [PATCH 06/34] Use structured $cli object format for JSON schema and input. --- src/Cli/OptionsParser.elm | 135 ++++++++++++- src/Cli/Program.elm | 388 ++++++++++++++++++++++++++++--------- tests/ExperienceTests.elm | 68 +++++-- tests/JsonSchemaTests.elm | 359 ++++++++++++++++++++++++++-------- tests/TsTypeTests.elm | 8 +- tests/TypedOptionTests.elm | 257 ++++++++++++++++++++++-- 6 files changed, 1003 insertions(+), 212 deletions(-) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index 28c661d..be489d2 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -146,6 +146,7 @@ import Cli.OptionsParser.BuilderState as BuilderState import Cli.OptionsParser.MatchResult import Cli.UsageSpec as UsageSpec exposing (UsageSpec) import Json.Decode +import Json.Encode as Encode import Occurences exposing (Occurences(..)) import Tokenizer exposing (ParsedOption) import TsJson.Decode as TsDecode @@ -295,10 +296,15 @@ tryMatch argv ((OptionsParser { usageSpecs, subCommand }) as optionsParser) = {-| Low-level function, for internal use. 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 }) = - case jsonGrabber blob of +tryMatchJson blob (OptionsParser { jsonGrabber, usageSpecs }) = + let + normalizedBlob = + normalizeCliJson usageSpecs blob + in + case jsonGrabber normalizedBlob of Err error -> case error of Cli.Decode.MatchError matchErrorDetail -> @@ -736,3 +742,128 @@ withDescription docString (OptionsParser optionsParserRecord) = { optionsParserRecord | description = Just docString } + + +{-| Normalize a JSON blob with `$cli` object structure into flat fields. + +Transforms: + + - `$cli.positional[N]` → flat field named by Nth operand's UsageSpec name + - `$cli.flags` array → flat boolean fields for each flag in usageSpecs + - `$cli.keywordLists.*` → flat array fields + - Strips the `$cli` key from the result + +-} +normalizeCliJson : List UsageSpec -> Json.Decode.Value -> Json.Decode.Value +normalizeCliJson usageSpecs blob = + let + maybeCli = + Json.Decode.decodeValue (Json.Decode.field "$cli" Json.Decode.value) blob + + -- Original fields minus $cli + originalFields = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) blob of + Ok pairs -> + pairs |> List.filter (\( k, _ ) -> k /= "$cli") + + Err _ -> + [] + + -- Build positional arg fields from $cli.positional + 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 _ -> + [] + + -- Build flag fields from $cli.flags + flagFields = + case maybeCli of + Ok cliValue -> + let + allFlagNames = + usageSpecs + |> List.filterMap + (\spec -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag flagName) _ _ _ -> + Just flagName + + _ -> + Nothing + ) + in + case Json.Decode.decodeValue (Json.Decode.field "flags" (Json.Decode.list Json.Decode.string)) cliValue of + Ok activeFlagNames -> + allFlagNames + |> List.map + (\flagName -> + ( flagName, Encode.bool (List.member flagName activeFlagNames) ) + ) + + Err _ -> + -- No flags in $cli — set all flags to false + allFlagNames + |> List.map (\flagName -> ( flagName, Encode.bool False )) + + Err _ -> + [] + + -- Build keyword list fields from $cli.keywordLists + keywordListFields = + case maybeCli of + Ok cliValue -> + case Json.Decode.decodeValue (Json.Decode.field "keywordLists" (Json.Decode.keyValuePairs Json.Decode.value)) cliValue of + Ok pairs -> + pairs + + Err _ -> + [] + + Err _ -> + [] + in + Encode.object (originalFields ++ positionalFields ++ flagFields ++ keywordListFields) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 2d6cc4c..428d665 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -437,11 +437,11 @@ run (Config { optionsParsers }) argv versionMessage colorMode = errorMessage = "TODO - show error message explaining that user needs to pass unmodified `process.argv` from node here." - -- Check for JSON input mode: a single arg that's JSON with the $cli sentinel key + -- 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.string) singleArg of + 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 @@ -614,22 +614,16 @@ for tool `inputSchema` definitions. -} toJsonSchema : Config msg -> Encode.Value toJsonSchema (Config { optionsParsers }) = - let - baseSchema = - case optionsParsers of - [ singleParser ] -> - parserToJsonSchemaFromTsTypes singleParser + case optionsParsers of + [ singleParser ] -> + parserToJsonSchemaFromTsTypes singleParser - multipleParsers -> - Encode.object - [ ( "anyOf" - , Encode.list parserToJsonSchemaFromTsTypes multipleParsers - ) - ] - in - mergeJsonObject - [ ( "$cli", Encode.string "elm-cli-options-parser" ) ] - baseSchema + multipleParsers -> + Encode.object + [ ( "anyOf" + , Encode.list parserToJsonSchemaFromTsTypes multipleParsers + ) + ] parserToJsonSchemaFromTsTypes : OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value @@ -641,6 +635,10 @@ parserToJsonSchemaFromTsTypes parser = tsTypes = OptionsParser.getTsTypes parser + specsWithTypes = + List.map2 Tuple.pair specs tsTypes + + -- Subcommand fields (flat properties) subCommandFields = case OptionsParser.getSubCommand parser of Just subName -> @@ -655,56 +653,297 @@ parserToJsonSchemaFromTsTypes parser = Nothing -> [] - properties = - subCommandFields - ++ List.map2 tsTypeToProperty specs tsTypes + -- Keyword args (non-ZeroOrMore) → flat properties + keywordArgProperties = + specsWithTypes + |> List.filterMap + (\( spec, ( optionName, tsType ) ) -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ occurences _ -> + if occurences /= ZeroOrMore then + Just (tsTypeToProperty spec ( optionName, tsType )) - required = - (case OptionsParser.getSubCommand parser of - Just _ -> - [ "subcommand" ] + else + Nothing - Nothing -> - [] - ) - ++ List.filterMap usageSpecToRequired specs + _ -> + Nothing + ) + + -- Flags → $cli.flags + flagSpecs = + specsWithTypes + |> List.filterMap + (\( spec, ( optionName, _ ) ) -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ _ maybeDescription -> + Just ( optionName, maybeDescription ) + + _ -> + Nothing + ) + + -- Keyword arg lists → $cli.keywordLists + keywordListProperties = + specsWithTypes + |> List.filterMap + (\( spec, ( optionName, tsType ) ) -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ ZeroOrMore _ -> + Just (tsTypeToProperty spec ( optionName, tsType )) + + _ -> + 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 + + -- Build $cli object schema + cliSubProperties = + positionalSchemaProperty positionalSpecs restArgSpec + ++ flagsSchemaProperty flagSpecs + ++ keywordListsSchemaProperty keywordListProperties + + cliSchema = + Encode.object + ([ ( "type", Encode.string "object" ) ] + ++ (if List.isEmpty cliSubProperties then + [] + + else + [ ( "properties", Encode.object cliSubProperties ) ] + ) + ) + + -- All properties + allProperties = + [ ( "$cli", cliSchema ) ] + ++ subCommandFields + ++ keywordArgProperties + + -- Required: $cli is always required, plus required keyword args and subcommand + requiredFields = + [ "$cli" ] + ++ (case OptionsParser.getSubCommand parser of + Just _ -> + [ "subcommand" ] + + Nothing -> + [] + ) + ++ (specsWithTypes + |> List.filterMap + (\( spec, _ ) -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg kwName _) _ Required _ -> + Just kwName + + _ -> + Nothing + ) + ) in Encode.object - ([ ( "type", Encode.string "object" ) - , ( "properties", Encode.object properties ) - ] - ++ (if List.isEmpty required then - [] + [ ( "type", Encode.string "object" ) + , ( "properties", Encode.object allProperties ) + , ( "required", Encode.list Encode.string requiredFields ) + ] + + +{-| 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 + prefixItemsList = + positionalArgs + |> List.map + (\( spec, tsType, _ ) -> + let + baseSchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) + in + case usageSpecDescription spec of + Just desc -> + appendJsonFields [ ( "description", Encode.string desc ) ] baseSchema + + Nothing -> + baseSchema + ) + + requiredCount = + positionalArgs + |> List.filter (\( _, _, occ ) -> occ == Required) + |> List.length + + itemsField = + case maybeRestArgs of + Just ( spec, tsType ) -> + let + arraySchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) + in + -- Extract items from the array type's schema + case Json.Decode.decodeValue (Json.Decode.field "items" Json.Decode.value) arraySchema of + Ok itemSchema -> + let + withDesc = + case usageSpecDescription spec of + Just desc -> + appendJsonFields [ ( "description", Encode.string desc ) ] itemSchema + + Nothing -> + itemSchema + in + [ ( "items", withDesc ) ] + + Err _ -> + [] + + Nothing -> + if List.isEmpty positionalArgs then + [] + + else + [ ( "items", Encode.bool False ) ] + + schemaFields = + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + ] + ++ (if List.isEmpty prefixItemsList then + [] + + else + [ ( "prefixItems", Encode.list identity prefixItemsList ) ] + ) + ++ itemsField + ++ (if requiredCount > 0 then + [ ( "minItems", Encode.int requiredCount ) ] + + else + [] + ) + in + [ ( "positional", Encode.object schemaFields ) ] + + +{-| Build the `$cli.flags` schema property. +-} +flagsSchemaProperty : List ( String, Maybe String ) -> List ( String, Encode.Value ) +flagsSchemaProperty flags = + if List.isEmpty flags then + [] + + else + let + anyHasDescription = + flags |> List.any (\( _, desc ) -> desc /= Nothing) + + itemsSchema = + if anyHasDescription then + Encode.object + [ ( "anyOf" + , Encode.list + (\( flagName, maybeDesc ) -> + case maybeDesc of + Just desc -> + Encode.object + [ ( "const", Encode.string flagName ) + , ( "description", Encode.string desc ) + ] + + Nothing -> + Encode.object + [ ( "const", Encode.string flagName ) ] + ) + flags + ) + ] else - [ ( "required", Encode.list Encode.string required ) ] - ) - ) + Encode.object + [ ( "enum", Encode.list Encode.string (List.map Tuple.first flags) ) ] + in + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items", itemsSchema ) + ] + ) + ] + + +{-| Build the `$cli.keywordLists` schema property. +-} +keywordListsSchemaProperty : List ( String, Encode.Value ) -> List ( String, Encode.Value ) +keywordListsSchemaProperty keywordListProps = + if List.isEmpty keywordListProps then + [] + + else + [ ( "keywordLists" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments that can be repeated (e.g., --header X --header Y)" ) + , ( "properties", Encode.object keywordListProps ) + ] + ) + ] + + +{-| 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 tsTypeToProperty : UsageSpec -> ( String, TsJson.Type.Type ) -> ( String, Encode.Value ) tsTypeToProperty spec ( optionName, tsType ) = let - baseSchema = - TsJson.Type.toJsonSchema tsType - - -- Strip $schema from the TsJson output since we're embedding this - -- as a property within a larger schema strippedSchema = - case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) baseSchema of - Ok pairs -> - pairs - |> List.filter (\( k, _ ) -> k /= "$schema") - |> Encode.object - - Err _ -> - baseSchema - - maybeDescription = - usageSpecDescription spec + stripSchemaKey (TsJson.Type.toJsonSchema tsType) schemaWithDescription = - case maybeDescription of + case usageSpecDescription spec of Just desc -> appendJsonFields [ ( "description", Encode.string desc ) ] strippedSchema @@ -727,50 +966,7 @@ usageSpecDescription spec = maybeDescription -usageSpecToRequired : UsageSpec -> Maybe String -usageSpecToRequired spec = - case spec of - UsageSpec.FlagOrKeywordArg flagOrKw _ occurences _ -> - case occurences of - Required -> - case flagOrKw of - UsageSpec.Flag flagName -> - Just flagName - - UsageSpec.KeywordArg kwName _ -> - Just kwName - - _ -> - Nothing - - UsageSpec.Operand operandName _ occurences _ -> - case occurences of - Required -> - Just operandName - - _ -> - Nothing - - UsageSpec.RestArgs _ _ -> - Nothing - - -{-| Merge additional key-value pairs into a JSON object value. -New fields are prepended (appear first in the output). -If the value is not a decodable object, wraps the pairs as a new object. --} -mergeJsonObject : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value -mergeJsonObject extraFields jsonValue = - case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue of - Ok existingFields -> - Encode.object (extraFields ++ existingFields) - - Err _ -> - Encode.object extraFields - - {-| Append additional key-value pairs to the end of a JSON object value. -Similar to mergeJsonObject but new fields appear last in the output. -} appendJsonFields : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value appendJsonFields extraFields jsonValue = diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index e6a0913..cabfe35 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -130,11 +130,13 @@ all = |> Program.toJsonSchema |> Encode.encode 2 |> Expect.equal """{ - "$cli": "elm-cli-options-parser", "anyOf": [ { "type": "object", "properties": { + "$cli": { + "type": "object" + }, "subcommand": { "type": "string", "const": "add" @@ -159,6 +161,7 @@ all = } }, "required": [ + "$cli", "subcommand", "title", "priority" @@ -167,6 +170,23 @@ all = { "type": "object", "properties": { + "$cli": { + "type": "object", + "properties": { + "flags": { + "type": "array", + "description": "Boolean flags, passed as --flag (e.g., --verbose)", + "items": { + "anyOf": [ + { + "const": "verbose", + "description": "Show full task details" + } + ] + } + } + } + }, "subcommand": { "type": "string", "const": "list" @@ -188,13 +208,10 @@ all = "limit": { "type": "string", "description": "Maximum number of tasks to show" - }, - "verbose": { - "type": "boolean", - "description": "Show full task details" } }, "required": [ + "$cli", "subcommand", "limit" ] @@ -202,18 +219,31 @@ all = { "type": "object", "properties": { + "$cli": { + "type": "object", + "properties": { + "positional": { + "type": "array", + "description": "Positional arguments, passed in order (e.g., mytool <source> <dest>)", + "prefixItems": [ + { + "type": "string", + "description": "The ID of the task to mark complete" + } + ], + "items": false, + "minItems": 1 + } + } + }, "subcommand": { "type": "string", "const": "complete" - }, - "task-id": { - "type": "string", - "description": "The ID of the task to mark complete" } }, "required": [ - "subcommand", - "task-id" + "$cli", + "subcommand" ] } ] @@ -289,22 +319,22 @@ Options: [ test "add task via JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"high\"}" ] + [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"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 JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\",\"verbose\":true}" ] + [ "node", "mytool", "{\"$cli\":{\"flags\":[\"verbose\"]},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\"}" ] "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 are just named fields in JSON + -- Direct JSON decoding: positional args come from $cli.positional Program.run taskConfig - [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"complete\",\"task-id\":\"42\"}" ] + [ "node", "mytool", "{\"$cli\":{\"positional\":[\"42\"]},\"subcommand\":\"complete\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) @@ -394,7 +424,7 @@ Run with --help for usage information.""" [ test "missing required field in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"add\",\"priority\":\"high\"}" ] + [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"add\",\"priority\":\"high\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -404,7 +434,7 @@ Run with --help for usage information.""" , test "invalid oneOf value in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"urgent\"}" ] + [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"urgent\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -419,7 +449,7 @@ Must be one of [low, medium, high]""" -- 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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"json\",\"limit\":10,\"verbose\":true}" ] + [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":10}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -448,7 +478,7 @@ Expecting a STRING""" -- 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", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"list\",\"format\":\"table\",\"limit\":10}" ] + [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"list\",\"format\":\"table\",\"limit\":10}" ] "1.0.0" Program.WithoutColor |> Expect.equal diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 88553bc..a5d9aee 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -43,11 +43,38 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.flag "verbose") ) - |> expectJsonSchema - { properties = - [ ( "verbose", [ ( "type", Encode.string "boolean" ) ] ) ] - , required = [] - } + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "verbose" ] ) ] + ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) , test "required positional arg" <| \() -> Program.config @@ -55,11 +82,40 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.requiredPositionalArg "file") ) - |> expectJsonSchema - { properties = - [ ( "file", [ ( "type", Encode.string "string" ) ] ) ] - , required = [ "file" ] - } + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "prefixItems" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ) ] ] + ) + , ( "items", Encode.bool False ) + , ( "minItems", Encode.int 1 ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) , test "optional positional arg" <| \() -> Program.config @@ -67,11 +123,39 @@ all = (OptionsParser.build identity |> OptionsParser.withOptionalPositionalArg (Option.optionalPositionalArg "revision") ) - |> expectJsonSchema - { properties = - [ ( "revision", [ ( "type", Encode.string "string" ) ] ) ] - , required = [] - } + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "prefixItems" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ) ] ] + ) + , ( "items", Encode.bool False ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) , test "rest args is array of strings" <| \() -> Program.config @@ -79,16 +163,35 @@ all = (OptionsParser.build identity |> OptionsParser.withRestArgs (Option.restArgs "files") ) - |> expectJsonSchema - { properties = - [ ( "files" - , [ ( "type", Encode.string "array" ) - , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "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" ] ) ] - , required = [] - } + |> Encode.encode 0 + ) , test "keyword arg list is array of strings" <| \() -> Program.config @@ -96,16 +199,44 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.keywordArgList "header") ) - |> expectJsonSchema - { properties = - [ ( "header" - , [ ( "type", Encode.string "array" ) - , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordLists" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments that can be repeated (e.g., --header X --header Y)" ) + , ( "properties" + , Encode.object + [ ( "header" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + ] + ) + ] + ) + ] + ) + ] + ) + ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] - , required = [] - } + |> Encode.encode 0 + ) , test "description is included" <| \() -> Program.config @@ -144,11 +275,11 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "format" + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "format" , Encode.object [ ( "anyOf" , Encode.list identity @@ -161,7 +292,7 @@ all = ) ] ) - , ( "required", Encode.list Encode.string [ "format" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "format" ] ) ] |> Encode.encode 0 ) @@ -174,23 +305,59 @@ all = |> OptionsParser.with (Option.optionalKeywordArg "greeting") |> OptionsParser.with (Option.flag "verbose") ) - |> expectJsonSchema - { properties = - [ ( "name", [ ( "type", Encode.string "string" ) ] ) - , ( "greeting", [ ( "type", Encode.string "string" ) ] ) - , ( "verbose", [ ( "type", Encode.string "boolean" ) ] ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "verbose" ] ) ] + ) + ] + ) + ] + ) + ] + ) + , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "greeting", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) ] - , required = [ "name" ] - } + |> Encode.encode 0 + ) , test "no options produces empty object schema" <| \() -> Program.config |> Program.add (OptionsParser.build ()) - |> expectJsonSchema - { properties = [] - , required = [] - } + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) ] , describe "subcommands" [ test "single subcommand includes subcommand property" <| @@ -204,15 +371,32 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) - , ( "bare", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "bare" ] ) ] + ) + ] + ) + ] + ) + ] + ) + , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) ] |> Encode.encode 0 ) @@ -232,26 +416,47 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "anyOf" + [ ( "anyOf" , Encode.list identity [ Encode.object [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) ] + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + ] ) - , ( "required", Encode.list Encode.string [ "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) ] , Encode.object [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) - , ( "repository", Encode.object [ ( "type", Encode.string "string" ) ] ) + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "positional" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) + , ( "prefixItems" + , Encode.list identity + [ Encode.object [ ( "type", Encode.string "string" ) ] ] + ) + , ( "items", Encode.bool False ) + , ( "minItems", Encode.int 1 ) + ] + ) + ] + ) + ] + ) + , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "subcommand", "repository" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) ] ] ) @@ -270,7 +475,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"name\":\"World\",\"greeting\":\"Hi\"}" ] + [ "node", "test", "{\"$cli\":{},\"name\":\"World\",\"greeting\":\"Hi\"}" ] "1.0.0" Program.WithoutColor ) @@ -286,7 +491,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"name\":\"World\",\"verbose\":true}" ] + [ "node", "test", "{\"$cli\":{\"flags\":[\"verbose\"]},\"name\":\"World\"}" ] "1.0.0" Program.WithoutColor ) @@ -301,7 +506,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"subcommand\":\"greet\",\"name\":\"World\"}" ] + [ "node", "test", "{\"$cli\":{},\"subcommand\":\"greet\",\"name\":\"World\"}" ] "1.0.0" Program.WithoutColor ) @@ -319,7 +524,7 @@ all = ) in Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"greeting\":\"Hi\"}" ] + [ "node", "test", "{\"$cli\":{},\"greeting\":\"Hi\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -337,7 +542,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":\"elm-cli-options-parser\",\"name\":123}" ] + [ "node", "test", "{\"$cli\":{},\"name\":123}" ] "1.0.0" Program.WithoutColor ) @@ -376,6 +581,9 @@ Expecting a STRING""" {-| 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). Adds `$cli` as a `{"type": "object"}` property and +always includes `$cli` in `required`. -} expectJsonSchema : { properties : List ( String, List ( String, Encode.Value ) ) @@ -389,21 +597,16 @@ expectJsonSchema { properties, required } config = |> Encode.encode 0 |> Expect.equal (Encode.object - ([ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - (properties - |> List.map (\( name, fields ) -> ( name, Encode.object fields )) + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + (( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + :: (properties + |> List.map (\( name, fields ) -> ( name, Encode.object fields )) + ) ) - ) - ] - ++ (if List.isEmpty required then - [] - - else - [ ( "required", Encode.list Encode.string required ) ] - ) - ) + ) + , ( "required", Encode.list Encode.string ("$cli" :: required) ) + ] |> Encode.encode 0 ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 5831139..2dc5675 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -218,11 +218,11 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "format" + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "format" , Encode.object [ ( "anyOf" , Encode.list identity @@ -235,7 +235,7 @@ all = ) ] ) - , ( "required", Encode.list Encode.string [ "format" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "format" ] ) ] |> Encode.encode 0 ) diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 78f795a..a350b33 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -54,13 +54,14 @@ all = schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] ) - , ( "required", Encode.list Encode.string [ "name" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) ] |> Encode.encode 0 ) @@ -106,13 +107,14 @@ all = schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) + ] ) - , ( "required", Encode.list Encode.string [ "count" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "count" ] ) ] |> Encode.encode 0 ) @@ -261,6 +263,235 @@ all = ) |> Expect.equal (Program.CustomMatch [ "a.txt", "b.txt" ]) ] + , describe "JSON input with $cli object" + [ test "keyword list via $cli.keywordLists" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "keywordLists" + , Encode.object + [ ( "header", Encode.list Encode.string [ "X-A: 1", "X-B: 2" ] ) ] + ) + ] + ) + ] + |> 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 in $cli.keywordLists 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 via $cli.flags" <| + \() -> + let + jsonArg = + Encode.object + [ ( "$cli" + , Encode.object + [ ( "flags", Encode.list Encode.string [ "verbose" ] ) ] + ) + ] + |> 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 from $cli.flags 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 + [ ( "$cli" + , Encode.object + [ ( "positional", Encode.list Encode.string [ "input.txt" ] ) + , ( "flags", Encode.list Encode.string [ "verbose" ] ) + , ( "keywordLists" + , Encode.object + [ ( "header", Encode.list Encode.string [ "X-A: 1" ] ) ] + ) + ] + ) + , ( "limit", Encode.string "10" ) + ] + |> 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" <| \() -> @@ -281,11 +512,11 @@ all = ) |> Expect.equal (Encode.object - [ ( "$cli", Encode.string "elm-cli-options-parser" ) - , ( "type", Encode.string "object" ) + [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "count" + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "count" , Encode.object [ ( "type", Encode.string "integer" ) , ( "description", Encode.string "Number of items" ) @@ -293,7 +524,7 @@ all = ) ] ) - , ( "required", Encode.list Encode.string [ "count" ] ) + , ( "required", Encode.list Encode.string [ "$cli", "count" ] ) ] |> Encode.encode 0 ) @@ -339,7 +570,7 @@ runJsonWith : Option.Option from to { c | position : Cli.Option.BeginningOption runJsonWith option fields = let jsonArg = - Encode.object (( "$cli", Encode.string "elm-cli-options-parser" ) :: fields) + Encode.object (( "$cli", Encode.object [] ) :: fields) |> Encode.encode 0 in Program.config From 797e29225aacc4397484313222e766db14535838 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 06:49:01 -0700 Subject: [PATCH 07/34] Add contains constraint for expectFlags. --- src/Cli/Program.elm | 52 +++++-- tests/JsonSchemaTests.elm | 291 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 333 insertions(+), 10 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 428d665..8acaea4 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -676,8 +676,8 @@ parserToJsonSchemaFromTsTypes parser = |> List.filterMap (\( spec, ( optionName, _ ) ) -> case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ _ maybeDescription -> - Just ( optionName, maybeDescription ) + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ occurences maybeDescription -> + Just ( optionName, maybeDescription, occurences ) _ -> Nothing @@ -859,7 +859,7 @@ positionalSchemaProperty positionalArgs maybeRestArgs = {-| Build the `$cli.flags` schema property. -} -flagsSchemaProperty : List ( String, Maybe String ) -> List ( String, Encode.Value ) +flagsSchemaProperty : List ( String, Maybe String, Occurences ) -> List ( String, Encode.Value ) flagsSchemaProperty flags = if List.isEmpty flags then [] @@ -867,14 +867,14 @@ flagsSchemaProperty flags = else let anyHasDescription = - flags |> List.any (\( _, desc ) -> desc /= Nothing) + flags |> List.any (\( _, desc, _ ) -> desc /= Nothing) itemsSchema = if anyHasDescription then Encode.object [ ( "anyOf" , Encode.list - (\( flagName, maybeDesc ) -> + (\( flagName, maybeDesc, _ ) -> case maybeDesc of Just desc -> Encode.object @@ -892,14 +892,46 @@ flagsSchemaProperty flags = else Encode.object - [ ( "enum", Encode.list Encode.string (List.map Tuple.first flags) ) ] + [ ( "enum", Encode.list Encode.string (List.map (\( name, _, _ ) -> name) flags) ) ] + + requiredFlags = + flags + |> List.filterMap + (\( flagName, _, occurences ) -> + if occurences == Required then + Just flagName + + else + Nothing + ) + + containsConstraints = + case requiredFlags of + [] -> + [] + + [ singleFlag ] -> + [ ( "contains", Encode.object [ ( "const", Encode.string singleFlag ) ] ) ] + + multipleFlags -> + [ ( "allOf" + , Encode.list + (\flagName -> + Encode.object + [ ( "contains", Encode.object [ ( "const", Encode.string flagName ) ] ) ] + ) + multipleFlags + ) + ] in [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items", itemsSchema ) - ] + ([ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items", itemsSchema ) + ] + ++ containsConstraints + ) ) ] diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index a5d9aee..250efb4 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -339,6 +339,216 @@ all = ] |> Encode.encode 0 ) + , test "expectFlag produces contains constraint in schema" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build () + |> OptionsParser.expectFlag "init" + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "init" ] ) ] + ) + , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) + , test "multiple expectFlags produce allOf with contains" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build () + |> OptionsParser.expectFlag "init" + |> OptionsParser.expectFlag "force" + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "init", "force" ] ) ] + ) + , ( "allOf" + , Encode.list identity + [ Encode.object [ ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) ] + , Encode.object [ ( "contains", Encode.object [ ( "const", Encode.string "force" ) ] ) ] + ] + ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) + , test "mixed flag and expectFlag — only expectFlag gets contains" <| + \() -> + Program.config + |> Program.add + (OptionsParser.build identity + |> OptionsParser.with (Option.flag "verbose") + |> OptionsParser.expectFlag "init" + ) + |> Program.toJsonSchema + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "verbose", "init" ] ) ] + ) + , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + |> Encode.encode 0 + ) + , test "discriminated union with expectFlag produces anyOf with contains" <| + \() -> + 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 + |> Encode.encode 0 + |> Expect.equal + (Encode.object + [ ( "anyOf" + , Encode.list identity + [ Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "init" ] ) ] + ) + , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + ] + ) + ] + ) + ] + ) + , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) + ] + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "flags" + , Encode.object + [ ( "type", Encode.string "array" ) + , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) + , ( "items" + , Encode.object + [ ( "enum", Encode.list Encode.string [ "build", "verbose" ] ) ] + ) + , ( "contains", Encode.object [ ( "const", Encode.string "build" ) ] ) + ] + ) + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) + ] + ] + ) + ] + |> Encode.encode 0 + ) , test "no options produces empty object schema" <| \() -> Program.config @@ -557,6 +767,87 @@ Problem with the value at json.name: Expecting a STRING""" ) + , 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", "{\"$cli\":{\"flags\":[\"init\"]},\"name\":\"my-project\"}" ] + "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", "{\"$cli\":{\"flags\":[\"build\",\"verbose\"]}}" ] + "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, From 389ef528c3ae075cf15d5b28184f013a9cc02567 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 07:40:58 -0700 Subject: [PATCH 08/34] Change format of flags to be booleans to be more intuitive for agents to discover, and add descriptions with at least name for positional args in schema. --- src/Cli/OptionsParser.elm | 13 ++++-- src/Cli/Program.elm | 86 +++++++++++++++---------------------- tests/ExperienceTests.elm | 16 +++---- tests/JsonSchemaTests.elm | 87 +++++++++++++++++++------------------- tests/TypedOptionTests.elm | 4 +- 5 files changed, 95 insertions(+), 111 deletions(-) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index be489d2..ba91089 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -819,7 +819,7 @@ normalizeCliJson usageSpecs blob = Err _ -> [] - -- Build flag fields from $cli.flags + -- Build flag fields from $cli.flags (object with boolean values) flagFields = case maybeCli of Ok cliValue -> @@ -836,12 +836,17 @@ normalizeCliJson usageSpecs blob = Nothing ) in - case Json.Decode.decodeValue (Json.Decode.field "flags" (Json.Decode.list Json.Decode.string)) cliValue of - Ok activeFlagNames -> + case Json.Decode.decodeValue (Json.Decode.field "flags" (Json.Decode.keyValuePairs Json.Decode.bool)) cliValue of + Ok flagPairs -> allFlagNames |> List.map (\flagName -> - ( flagName, Encode.bool (List.member flagName activeFlagNames) ) + ( flagName + , Encode.bool + (flagPairs + |> List.any (\( k, v ) -> k == flagName && v) + ) + ) ) Err _ -> diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 8acaea4..4318651 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -791,13 +791,16 @@ positionalSchemaProperty positionalArgs maybeRestArgs = let baseSchema = stripSchemaKey (TsJson.Type.toJsonSchema tsType) - in - case usageSpecDescription spec of - Just desc -> - appendJsonFields [ ( "description", Encode.string desc ) ] baseSchema - Nothing -> - baseSchema + desc = + case usageSpecDescription spec of + Just d -> + d + + Nothing -> + UsageSpec.name spec + in + appendJsonFields [ ( "description", Encode.string desc ) ] baseSchema ) requiredCount = @@ -858,6 +861,7 @@ positionalSchemaProperty positionalArgs maybeRestArgs = {-| Build the `$cli.flags` schema property. +Flags are an object with boolean properties. Required flags (expectFlag) go in `required`. -} flagsSchemaProperty : List ( String, Maybe String, Occurences ) -> List ( String, Encode.Value ) flagsSchemaProperty flags = @@ -866,33 +870,23 @@ flagsSchemaProperty flags = else let - anyHasDescription = - flags |> List.any (\( _, desc, _ ) -> desc /= Nothing) - - itemsSchema = - if anyHasDescription then - Encode.object - [ ( "anyOf" - , Encode.list - (\( flagName, maybeDesc, _ ) -> - case maybeDesc of - Just desc -> - Encode.object - [ ( "const", Encode.string flagName ) - , ( "description", Encode.string desc ) - ] + flagProperties = + flags + |> List.map + (\( flagName, maybeDesc, _ ) -> + ( flagName + , Encode.object + ([ ( "type", Encode.string "boolean" ) ] + ++ (case maybeDesc of + Just desc -> + [ ( "description", Encode.string desc ) ] - Nothing -> - Encode.object - [ ( "const", Encode.string flagName ) ] + Nothing -> + [] + ) ) - flags - ) - ] - - else - Encode.object - [ ( "enum", Encode.list Encode.string (List.map (\( name, _, _ ) -> name) flags) ) ] + ) + ) requiredFlags = flags @@ -904,33 +898,19 @@ flagsSchemaProperty flags = else Nothing ) - - containsConstraints = - case requiredFlags of - [] -> - [] - - [ singleFlag ] -> - [ ( "contains", Encode.object [ ( "const", Encode.string singleFlag ) ] ) ] - - multipleFlags -> - [ ( "allOf" - , Encode.list - (\flagName -> - Encode.object - [ ( "contains", Encode.object [ ( "const", Encode.string flagName ) ] ) ] - ) - multipleFlags - ) - ] in [ ( "flags" , Encode.object - ([ ( "type", Encode.string "array" ) + ([ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items", itemsSchema ) + , ( "properties", Encode.object flagProperties ) ] - ++ containsConstraints + ++ (if List.isEmpty requiredFlags then + [] + + else + [ ( "required", Encode.list Encode.string requiredFlags ) ] + ) ) ) ] diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index cabfe35..137f773 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -174,15 +174,13 @@ all = "type": "object", "properties": { "flags": { - "type": "array", + "type": "object", "description": "Boolean flags, passed as --flag (e.g., --verbose)", - "items": { - "anyOf": [ - { - "const": "verbose", - "description": "Show full task details" - } - ] + "properties": { + "verbose": { + "type": "boolean", + "description": "Show full task details" + } } } } @@ -326,7 +324,7 @@ Options: , test "list tasks via JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{\"flags\":[\"verbose\"]},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\"}" ] + [ "node", "mytool", "{\"$cli\":{\"flags\":{\"verbose\":true}},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (ListTasks { format = Json, limit = 10, verbose = True })) diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 250efb4..f1833c0 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -57,11 +57,11 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "verbose" ] ) ] + [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) ] ) @@ -100,7 +100,7 @@ all = , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) , ( "prefixItems" , Encode.list identity - [ Encode.object [ ( "type", Encode.string "string" ) ] ] + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "file" ) ] ] ) , ( "items", Encode.bool False ) , ( "minItems", Encode.int 1 ) @@ -141,7 +141,7 @@ all = , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) , ( "prefixItems" , Encode.list identity - [ Encode.object [ ( "type", Encode.string "string" ) ] ] + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "revision" ) ] ] ) , ( "items", Encode.bool False ) ] @@ -319,11 +319,11 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "verbose" ] ) ] + [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) ] ) @@ -339,7 +339,7 @@ all = ] |> Encode.encode 0 ) - , test "expectFlag produces contains constraint in schema" <| + , test "expectFlag produces required constraint in schema" <| \() -> Program.config |> Program.add @@ -360,13 +360,13 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "init" ] ) ] + [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) - , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + , ( "required", Encode.list Encode.string [ "init" ] ) ] ) ] @@ -379,7 +379,7 @@ all = ] |> Encode.encode 0 ) - , test "multiple expectFlags produce allOf with contains" <| + , test "multiple expectFlags produce required on flags object" <| \() -> Program.config |> Program.add @@ -401,18 +401,15 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "init", "force" ] ) ] - ) - , ( "allOf" - , Encode.list identity - [ Encode.object [ ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) ] - , Encode.object [ ( "contains", Encode.object [ ( "const", Encode.string "force" ) ] ) ] + [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + , ( "force", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) + , ( "required", Encode.list Encode.string [ "init", "force" ] ) ] ) ] @@ -425,7 +422,7 @@ all = ] |> Encode.encode 0 ) - , test "mixed flag and expectFlag — only expectFlag gets contains" <| + , test "mixed flag and expectFlag — only expectFlag gets required" <| \() -> Program.config |> Program.add @@ -447,13 +444,15 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "verbose", "init" ] ) ] + [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + , ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + ] ) - , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + , ( "required", Encode.list Encode.string [ "init" ] ) ] ) ] @@ -466,7 +465,7 @@ all = ] |> Encode.encode 0 ) - , test "discriminated union with expectFlag produces anyOf with contains" <| + , test "discriminated union with expectFlag produces anyOf with required flags" <| \() -> Program.config |> Program.add @@ -498,13 +497,13 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "init" ] ) ] + [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) - , ( "contains", Encode.object [ ( "const", Encode.string "init" ) ] ) + , ( "required", Encode.list Encode.string [ "init" ] ) ] ) ] @@ -527,13 +526,15 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "build", "verbose" ] ) ] + [ ( "build", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + , ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) + ] ) - , ( "contains", Encode.object [ ( "const", Encode.string "build" ) ] ) + , ( "required", Encode.list Encode.string [ "build" ] ) ] ) ] @@ -591,11 +592,11 @@ all = , Encode.object [ ( "flags" , Encode.object - [ ( "type", Encode.string "array" ) + [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "items" + , ( "properties" , Encode.object - [ ( "enum", Encode.list Encode.string [ "bare" ] ) ] + [ ( "bare", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] ) ] ) @@ -653,7 +654,7 @@ all = , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) , ( "prefixItems" , Encode.list identity - [ Encode.object [ ( "type", Encode.string "string" ) ] ] + [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "repository" ) ] ] ) , ( "items", Encode.bool False ) , ( "minItems", Encode.int 1 ) @@ -701,7 +702,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":[\"verbose\"]},\"name\":\"World\"}" ] + [ "node", "test", "{\"$cli\":{\"flags\":{\"verbose\":true}},\"name\":\"World\"}" ] "1.0.0" Program.WithoutColor ) @@ -793,7 +794,7 @@ Expecting a STRING""" ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":[\"init\"]},\"name\":\"my-project\"}" ] + [ "node", "test", "{\"$cli\":{\"flags\":{\"init\":true}},\"name\":\"my-project\"}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch "init:my-project") @@ -823,7 +824,7 @@ Expecting a STRING""" ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":[\"build\",\"verbose\"]}}" ] + [ "node", "test", "{\"$cli\":{\"flags\":{\"build\":true,\"verbose\":true}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch "build:verbose") diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index a350b33..b3e1f29 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -417,7 +417,7 @@ all = Encode.object [ ( "$cli" , Encode.object - [ ( "flags", Encode.list Encode.string [ "verbose" ] ) ] + [ ( "flags", Encode.object [ ( "verbose", Encode.bool True ) ] ) ] ) ] |> Encode.encode 0 @@ -462,7 +462,7 @@ all = [ ( "$cli" , Encode.object [ ( "positional", Encode.list Encode.string [ "input.txt" ] ) - , ( "flags", Encode.list Encode.string [ "verbose" ] ) + , ( "flags", Encode.object [ ( "verbose", Encode.bool True ) ] ) , ( "keywordLists" , Encode.object [ ( "header", Encode.list Encode.string [ "X-A: 1" ] ) ] From b3ee66db903c2794e7b9f86b79e3235eb0780f2f Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 08:48:21 -0700 Subject: [PATCH 09/34] Add usage synopsis to JSON schema description field. --- src/Cli/Program.elm | 26 +++++++---- tests/ExperienceTests.elm | 5 +- tests/JsonSchemaTests.elm | 95 +++++++++++++++++++++++--------------- tests/TsTypeTests.elm | 5 +- tests/TypedOptionTests.elm | 11 +++-- 5 files changed, 89 insertions(+), 53 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 4318651..60db708 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -597,6 +597,9 @@ The schema follows the [JSON Schema](https://json-schema.org/) format used by th [Model Context Protocol (MCP)](https://modelcontextprotocol.io/specification/draft/server/tools) for tool `inputSchema` definitions. +The `programName` argument is used to generate a usage synopsis in the schema's `description` +field, giving LLMs a concise overview of how to invoke the command. + import Cli.Option as Option import Cli.OptionsParser as OptionsParser import Cli.Program as Program @@ -607,27 +610,27 @@ for tool `inputSchema` definitions. (OptionsParser.build identity |> OptionsParser.with (Option.requiredKeywordArg "name") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "my-script" |> Json.Encode.encode 0 - --> """{"type":"object","properties":{"name":{"type":"string"}},"required":["name"]}""" + --> """{"description":"my-script --name <NAME>","type":"object","properties":{"$cli":{"type":"object"},"name":{"type":"string"}},"required":["$cli","name"]}""" -} -toJsonSchema : Config msg -> Encode.Value -toJsonSchema (Config { optionsParsers }) = +toJsonSchema : String -> Config msg -> Encode.Value +toJsonSchema programName (Config { optionsParsers }) = case optionsParsers of [ singleParser ] -> - parserToJsonSchemaFromTsTypes singleParser + parserToJsonSchemaFromTsTypes programName singleParser multipleParsers -> Encode.object [ ( "anyOf" - , Encode.list parserToJsonSchemaFromTsTypes multipleParsers + , Encode.list (parserToJsonSchemaFromTsTypes programName) multipleParsers ) ] -parserToJsonSchemaFromTsTypes : OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value -parserToJsonSchemaFromTsTypes parser = +parserToJsonSchemaFromTsTypes : String -> OptionsParser msg BuilderState.NoMoreOptions -> Encode.Value +parserToJsonSchemaFromTsTypes programName parser = let specs = OptionsParser.getUsageSpecs parser @@ -638,6 +641,10 @@ parserToJsonSchemaFromTsTypes parser = specsWithTypes = List.map2 Tuple.pair specs tsTypes + usageSynopsis = + OptionsParser.synopsis False programName parser + |> String.trim + -- Subcommand fields (flat properties) subCommandFields = case OptionsParser.getSubCommand parser of @@ -769,7 +776,8 @@ parserToJsonSchemaFromTsTypes parser = ) in Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string usageSynopsis ) + , ( "type", Encode.string "object" ) , ( "properties", Encode.object allProperties ) , ( "required", Encode.list Encode.string requiredFields ) ] diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 137f773..cdb1157 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -127,11 +127,12 @@ all = [ test "task manager schema" <| \() -> taskConfig - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 2 |> Expect.equal """{ "anyOf": [ { + "description": "test add --title <TITLE> --priority <low|medium|high>", "type": "object", "properties": { "$cli": { @@ -168,6 +169,7 @@ all = ] }, { + "description": "test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]", "type": "object", "properties": { "$cli": { @@ -215,6 +217,7 @@ all = ] }, { + "description": "test complete <task-id>", "type": "object", "properties": { "$cli": { diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index f1833c0..4fdf859 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -20,7 +20,8 @@ all = |> OptionsParser.with (Option.requiredKeywordArg "name") ) |> expectJsonSchema - { properties = + { description = "test --name <NAME>" + , properties = [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] , required = [ "name" ] } @@ -32,7 +33,8 @@ all = |> OptionsParser.with (Option.optionalKeywordArg "greeting") ) |> expectJsonSchema - { properties = + { description = "test [--greeting <GREETING>]" + , properties = [ ( "greeting", [ ( "type", Encode.string "string" ) ] ) ] , required = [] } @@ -43,11 +45,12 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.flag "verbose") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test [--verbose]" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -82,11 +85,12 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.requiredPositionalArg "file") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test <file>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -123,11 +127,12 @@ all = (OptionsParser.build identity |> OptionsParser.withOptionalPositionalArg (Option.optionalPositionalArg "revision") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test [<revision>]" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -163,11 +168,12 @@ all = (OptionsParser.build identity |> OptionsParser.withRestArgs (Option.restArgs "files") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test <files>..." ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -199,11 +205,12 @@ all = (OptionsParser.build identity |> OptionsParser.with (Option.keywordArgList "header") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test [--header <HEADER>]..." ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -248,7 +255,8 @@ all = ) ) |> expectJsonSchema - { properties = + { description = "test --name <NAME>" + , properties = [ ( "name" , [ ( "type", Encode.string "string" ) , ( "description", Encode.string "The user's name" ) @@ -271,11 +279,12 @@ all = ] ) ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --format <json|junit|console>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -305,11 +314,12 @@ all = |> OptionsParser.with (Option.optionalKeywordArg "greeting") |> OptionsParser.with (Option.flag "verbose") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --name <NAME> [--greeting <GREETING>] [--verbose]" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -346,11 +356,12 @@ all = (OptionsParser.build () |> OptionsParser.expectFlag "init" ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --init" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -387,11 +398,12 @@ all = |> OptionsParser.expectFlag "init" |> OptionsParser.expectFlag "force" ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --init --force" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -430,11 +442,12 @@ all = |> OptionsParser.with (Option.flag "verbose") |> OptionsParser.expectFlag "init" ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test [--verbose] --init" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -480,14 +493,15 @@ all = |> OptionsParser.with (Option.flag "verbose") |> OptionsParser.map (\_ -> ()) ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --init --name <NAME>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -516,7 +530,8 @@ all = , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) ] , Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --build [--verbose]" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -555,11 +570,12 @@ all = Program.config |> Program.add (OptionsParser.build ()) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -578,11 +594,12 @@ all = (OptionsParser.buildSubCommand "init" identity |> OptionsParser.with (Option.flag "bare") ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test init [--bare]" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -623,14 +640,15 @@ all = |> OptionsParser.with (Option.requiredPositionalArg "repository") |> OptionsParser.map (\_ -> ()) ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test init" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -640,7 +658,8 @@ all = , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) ] , Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test clone <repository>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" @@ -878,18 +897,20 @@ or keyword arg lists). Adds `$cli` as a `{"type": "object"}` property and always includes `$cli` in `required`. -} expectJsonSchema : - { properties : List ( String, List ( String, Encode.Value ) ) + { description : String + , properties : List ( String, List ( String, Encode.Value ) ) , required : List String } -> Program.Config msg -> Expect.Expectation -expectJsonSchema { properties, required } config = +expectJsonSchema { description, properties, required } config = config - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string description ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object (( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 2dc5675..6d69d64 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -214,11 +214,12 @@ all = ) in cfg - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --format <json|junit|console>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index b3e1f29..2871c12 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -54,7 +54,8 @@ all = schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --name <NAME>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -107,7 +108,8 @@ all = schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --count <COUNT>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -512,7 +514,8 @@ all = ) |> Expect.equal (Encode.object - [ ( "type", Encode.string "object" ) + [ ( "description", Encode.string "test --count <COUNT>" ) + , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) @@ -593,7 +596,7 @@ schemaFor option = (OptionsParser.build identity |> OptionsParser.with option ) - |> Program.toJsonSchema + |> Program.toJsonSchema "test" |> Encode.encode 0 From ad688aa7cf72d43d9cc0f692b96a3fbe183e7f1f Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 09:40:48 -0700 Subject: [PATCH 10/34] Add string type to anyOf schema. --- src/Cli/Program.elm | 30 ++++++++++++++++++++++++++++-- tests/ExperienceTests.elm | 2 ++ tests/JsonSchemaTests.elm | 3 ++- tests/TsTypeTests.elm | 3 ++- 4 files changed, 34 insertions(+), 4 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 60db708..5c9041a 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -962,13 +962,27 @@ tsTypeToProperty spec ( optionName, tsType ) = strippedSchema = stripSchemaKey (TsJson.Type.toJsonSchema tsType) + -- anyOf+const from stringUnion lacks "type":"string" — add it + withType = + case Json.Decode.decodeValue (Json.Decode.field "anyOf" Json.Decode.value) strippedSchema of + Ok _ -> + case Json.Decode.decodeValue (Json.Decode.field "type" Json.Decode.value) strippedSchema of + Ok _ -> + strippedSchema + + Err _ -> + prependJsonField ( "type", Encode.string "string" ) strippedSchema + + Err _ -> + strippedSchema + schemaWithDescription = case usageSpecDescription spec of Just desc -> - appendJsonFields [ ( "description", Encode.string desc ) ] strippedSchema + appendJsonFields [ ( "description", Encode.string desc ) ] withType Nothing -> - strippedSchema + withType in ( optionName, schemaWithDescription ) @@ -986,6 +1000,18 @@ usageSpecDescription spec = maybeDescription +{-| Prepend a key-value pair to the beginning of a JSON object value. +-} +prependJsonField : ( String, Encode.Value ) -> Encode.Value -> Encode.Value +prependJsonField field jsonValue = + case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue of + Ok existingFields -> + Encode.object (field :: existingFields) + + Err _ -> + Encode.object [ field ] + + {-| Append additional key-value pairs to the end of a JSON object value. -} appendJsonFields : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index cdb1157..a4441f0 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -147,6 +147,7 @@ all = "description": "The task title" }, "priority": { + "type": "string", "anyOf": [ { "const": "low" @@ -192,6 +193,7 @@ all = "const": "list" }, "format": { + "type": "string", "anyOf": [ { "const": "json" diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 4fdf859..60fe393 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -290,7 +290,8 @@ all = [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) , ( "format" , Encode.object - [ ( "anyOf" + [ ( "type", Encode.string "string" ) + , ( "anyOf" , Encode.list identity [ Encode.object [ ( "const", Encode.string "json" ) ] , Encode.object [ ( "const", Encode.string "junit" ) ] diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 6d69d64..c573499 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -225,7 +225,8 @@ all = [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) , ( "format" , Encode.object - [ ( "anyOf" + [ ( "type", Encode.string "string" ) + , ( "anyOf" , Encode.list identity [ Encode.object [ ( "const", Encode.string "json" ) ] , Encode.object [ ( "const", Encode.string "junit" ) ] From a93706cd32e3c7df2cae9e69710c014a47d8443f Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 11:36:29 -0700 Subject: [PATCH 11/34] Put all values under $cli to make it more unified in JSON schema. --- src/Cli/OptionsParser.elm | 35 +++++-- src/Cli/Program.elm | 112 +++++++++++++++-------- tests/ExperienceTests.elm | 160 ++++++++++++++++++-------------- tests/JsonSchemaTests.elm | 182 +++++++++++++++++++++++++++++-------- tests/TsTypeTests.elm | 38 ++++++-- tests/TypedOptionTests.elm | 92 ++++++++++++++++--- 6 files changed, 448 insertions(+), 171 deletions(-) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index ba91089..f9bd2f1 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -748,8 +748,10 @@ withDescription docString (OptionsParser optionsParserRecord) = Transforms: + - `$cli.subcommand` → flat `subcommand` field + - `$cli.keywordValues.*` → flat fields for each keyword arg - `$cli.positional[N]` → flat field named by Nth operand's UsageSpec name - - `$cli.flags` array → flat boolean fields for each flag in usageSpecs + - `$cli.flags` object → flat boolean fields for each flag in usageSpecs - `$cli.keywordLists.*` → flat array fields - Strips the `$cli` key from the result @@ -760,11 +762,30 @@ normalizeCliJson usageSpecs blob = maybeCli = Json.Decode.decodeValue (Json.Decode.field "$cli" Json.Decode.value) blob - -- Original fields minus $cli - originalFields = - case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) blob of - Ok pairs -> - pairs |> List.filter (\( k, _ ) -> k /= "$cli") + -- Build subcommand field from $cli.subcommand + 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 _ -> + [] + + -- Build keyword value fields from $cli.keywordValues + keywordValueFields = + case maybeCli of + Ok cliValue -> + case Json.Decode.decodeValue (Json.Decode.field "keywordValues" (Json.Decode.keyValuePairs Json.Decode.value)) cliValue of + Ok pairs -> + pairs + + Err _ -> + [] Err _ -> [] @@ -871,4 +892,4 @@ normalizeCliJson usageSpecs blob = Err _ -> [] in - Encode.object (originalFields ++ positionalFields ++ flagFields ++ keywordListFields) + Encode.object (subcommandField ++ keywordValueFields ++ positionalFields ++ flagFields ++ keywordListFields) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 5c9041a..f15d9a4 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -612,7 +612,7 @@ field, giving LLMs a concise overview of how to invoke the command. ) |> Program.toJsonSchema "my-script" |> Json.Encode.encode 0 - --> """{"description":"my-script --name <NAME>","type":"object","properties":{"$cli":{"type":"object"},"name":{"type":"string"}},"required":["$cli","name"]}""" + --> """{"description":"my-script --name <NAME>","type":"object","properties":{"$cli":{"type":"object","properties":{"keywordValues":{"type":"object","description":"Keyword arguments with values (e.g., --name <value>)","properties":{"name":{"type":"string"}},"required":["name"]}},"required":["keywordValues"]}},"required":["$cli"]}""" -} toJsonSchema : String -> Config msg -> Encode.Value @@ -645,8 +645,8 @@ parserToJsonSchemaFromTsTypes programName parser = OptionsParser.synopsis False programName parser |> String.trim - -- Subcommand fields (flat properties) - subCommandFields = + -- Subcommand → $cli.subcommand + subCommandProperty = case OptionsParser.getSubCommand parser of Just subName -> [ ( "subcommand" @@ -660,7 +660,7 @@ parserToJsonSchemaFromTsTypes programName parser = Nothing -> [] - -- Keyword args (non-ZeroOrMore) → flat properties + -- Keyword args (non-ZeroOrMore) → $cli.keywordValues keywordArgProperties = specsWithTypes |> List.filterMap @@ -677,6 +677,18 @@ parserToJsonSchemaFromTsTypes programName parser = Nothing ) + requiredKeywordArgs = + specsWithTypes + |> List.filterMap + (\( spec, _ ) -> + case spec of + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg kwName _) _ Required _ -> + Just kwName + + _ -> + Nothing + ) + -- Flags → $cli.flags flagSpecs = specsWithTypes @@ -690,6 +702,10 @@ parserToJsonSchemaFromTsTypes programName parser = Nothing ) + hasRequiredFlags = + flagSpecs + |> List.any (\( _, _, occ ) -> occ == Required) + -- Keyword arg lists → $cli.keywordLists keywordListProperties = specsWithTypes @@ -730,12 +746,58 @@ parserToJsonSchemaFromTsTypes programName parser = ) |> List.head - -- Build $cli object schema + -- Build $cli.keywordValues schema + keywordValuesProperty = + if List.isEmpty keywordArgProperties then + [] + + else + [ ( "keywordValues" + , Encode.object + ([ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties", Encode.object keywordArgProperties ) + ] + ++ (if List.isEmpty requiredKeywordArgs then + [] + + else + [ ( "required", Encode.list Encode.string requiredKeywordArgs ) ] + ) + ) + ) + ] + + -- Build all $cli sub-properties cliSubProperties = - positionalSchemaProperty positionalSpecs restArgSpec + subCommandProperty + ++ keywordValuesProperty + ++ positionalSchemaProperty positionalSpecs restArgSpec ++ flagsSchemaProperty flagSpecs ++ keywordListsSchemaProperty keywordListProperties + -- $cli.required: subcommand, keywordValues (if has required kw args), flags (if has expectFlag) + cliRequired = + (case OptionsParser.getSubCommand parser of + Just _ -> + [ "subcommand" ] + + Nothing -> + [] + ) + ++ (if not (List.isEmpty requiredKeywordArgs) then + [ "keywordValues" ] + + else + [] + ) + ++ (if hasRequiredFlags then + [ "flags" ] + + else + [] + ) + cliSchema = Encode.object ([ ( "type", Encode.string "object" ) ] @@ -745,41 +807,19 @@ parserToJsonSchemaFromTsTypes programName parser = else [ ( "properties", Encode.object cliSubProperties ) ] ) - ) - - -- All properties - allProperties = - [ ( "$cli", cliSchema ) ] - ++ subCommandFields - ++ keywordArgProperties - - -- Required: $cli is always required, plus required keyword args and subcommand - requiredFields = - [ "$cli" ] - ++ (case OptionsParser.getSubCommand parser of - Just _ -> - [ "subcommand" ] - - Nothing -> + ++ (if List.isEmpty cliRequired then [] - ) - ++ (specsWithTypes - |> List.filterMap - (\( spec, _ ) -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg kwName _) _ Required _ -> - Just kwName - - _ -> - Nothing - ) - ) + + else + [ ( "required", Encode.list Encode.string cliRequired ) ] + ) + ) in Encode.object [ ( "description", Encode.string usageSynopsis ) , ( "type", Encode.string "object" ) - , ( "properties", Encode.object allProperties ) - , ( "required", Encode.list Encode.string requiredFields ) + , ( "properties", Encode.object [ ( "$cli", cliSchema ) ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index a4441f0..c7515f4 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -136,37 +136,50 @@ all = "type": "object", "properties": { "$cli": { - "type": "object" - }, - "subcommand": { - "type": "string", - "const": "add" - }, - "title": { - "type": "string", - "description": "The task title" - }, - "priority": { - "type": "string", - "anyOf": [ - { - "const": "low" - }, - { - "const": "medium" + "type": "object", + "properties": { + "subcommand": { + "type": "string", + "const": "add" }, - { - "const": "high" + "keywordValues": { + "type": "object", + "description": "Keyword arguments with values (e.g., --name <value>)", + "properties": { + "title": { + "type": "string", + "description": "The task title" + }, + "priority": { + "type": "string", + "anyOf": [ + { + "const": "low" + }, + { + "const": "medium" + }, + { + "const": "high" + } + ], + "description": "Task priority level" + } + }, + "required": [ + "title", + "priority" + ] } - ], - "description": "Task priority level" + }, + "required": [ + "subcommand", + "keywordValues" + ] } }, "required": [ - "$cli", - "subcommand", - "title", - "priority" + "$cli" ] }, { @@ -176,6 +189,38 @@ all = "$cli": { "type": "object", "properties": { + "subcommand": { + "type": "string", + "const": "list" + }, + "keywordValues": { + "type": "object", + "description": "Keyword arguments with values (e.g., --name <value>)", + "properties": { + "format": { + "type": "string", + "anyOf": [ + { + "const": "json" + }, + { + "const": "table" + }, + { + "const": "csv" + } + ], + "description": "Output format" + }, + "limit": { + "type": "string", + "description": "Maximum number of tasks to show" + } + }, + "required": [ + "limit" + ] + }, "flags": { "type": "object", "description": "Boolean flags, passed as --flag (e.g., --verbose)", @@ -186,36 +231,15 @@ all = } } } - } - }, - "subcommand": { - "type": "string", - "const": "list" - }, - "format": { - "type": "string", - "anyOf": [ - { - "const": "json" - }, - { - "const": "table" - }, - { - "const": "csv" - } - ], - "description": "Output format" - }, - "limit": { - "type": "string", - "description": "Maximum number of tasks to show" + }, + "required": [ + "subcommand", + "keywordValues" + ] } }, "required": [ - "$cli", - "subcommand", - "limit" + "$cli" ] }, { @@ -225,6 +249,10 @@ all = "$cli": { "type": "object", "properties": { + "subcommand": { + "type": "string", + "const": "complete" + }, "positional": { "type": "array", "description": "Positional arguments, passed in order (e.g., mytool <source> <dest>)", @@ -237,16 +265,14 @@ all = "items": false, "minItems": 1 } - } - }, - "subcommand": { - "type": "string", - "const": "complete" + }, + "required": [ + "subcommand" + ] } }, "required": [ - "$cli", - "subcommand" + "$cli" ] } ] @@ -322,14 +348,14 @@ Options: [ test "add task via JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"high\"}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"title\":\"Buy milk\",\"priority\":\"high\"}}}" ] "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", "{\"$cli\":{\"flags\":{\"verbose\":true}},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":\"10\"}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"list\",\"flags\":{\"verbose\":true},\"keywordValues\":{\"format\":\"json\",\"limit\":\"10\"}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (ListTasks { format = Json, limit = 10, verbose = True })) @@ -337,7 +363,7 @@ Options: \() -> -- Direct JSON decoding: positional args come from $cli.positional Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{\"positional\":[\"42\"]},\"subcommand\":\"complete\"}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"complete\",\"positional\":[\"42\"]}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch (Complete { taskId = "42" })) @@ -427,7 +453,7 @@ Run with --help for usage information.""" [ test "missing required field in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"add\",\"priority\":\"high\"}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"priority\":\"high\"}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -437,7 +463,7 @@ Run with --help for usage information.""" , test "invalid oneOf value in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{},\"subcommand\":\"add\",\"title\":\"Buy milk\",\"priority\":\"urgent\"}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"title\":\"Buy milk\",\"priority\":\"urgent\"}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -452,7 +478,7 @@ Must be one of [low, medium, high]""" -- 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", "{\"$cli\":{},\"subcommand\":\"list\",\"format\":\"json\",\"limit\":10}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"list\",\"keywordValues\":{\"format\":\"json\",\"limit\":10}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -481,7 +507,7 @@ Expecting a STRING""" -- 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", "{\"$cli\":{},\"subcommand\":\"list\",\"format\":\"table\",\"limit\":10}" ] + [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"list\",\"keywordValues\":{\"format\":\"table\",\"limit\":10}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 60fe393..6415be9 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -287,22 +287,42 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "format" + [ ( "$cli" , Encode.object - [ ( "type", Encode.string "string" ) - , ( "anyOf" - , Encode.list identity - [ Encode.object [ ( "const", Encode.string "json" ) ] - , Encode.object [ ( "const", Encode.string "junit" ) ] - , Encode.object [ ( "const", Encode.string "console" ) ] + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "anyOf" + , Encode.list identity + [ Encode.object [ ( "const", Encode.string "json" ) ] + , Encode.object [ ( "const", Encode.string "junit" ) ] + , Encode.object [ ( "const", Encode.string "console" ) ] + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format" ] ) + ] + ) ] ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "format" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -328,7 +348,20 @@ all = [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "flags" + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) + , ( "greeting", Encode.object [ ( "type", Encode.string "string" ) ] ) + ] + ) + , ( "required", Encode.list Encode.string [ "name" ] ) + ] + ) + , ( "flags" , Encode.object [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) @@ -340,13 +373,12 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) ] ) - , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) - , ( "greeting", Encode.object [ ( "type", Encode.string "string" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -383,6 +415,7 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "flags" ] ) ] ) ] @@ -427,6 +460,7 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "flags" ] ) ] ) ] @@ -471,6 +505,7 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "flags" ] ) ] ) ] @@ -510,7 +545,18 @@ all = [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "flags" + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "name" ] ) + ] + ) + , ( "flags" , Encode.object [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) @@ -523,12 +569,12 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "keywordValues", "flags" ] ) ] ) - , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object [ ( "description", Encode.string "test --build [--verbose]" ) @@ -555,6 +601,7 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "flags" ] ) ] ) ] @@ -608,7 +655,8 @@ all = [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "flags" + [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + , ( "flags" , Encode.object [ ( "type", Encode.string "object" ) , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) @@ -620,12 +668,12 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) ] ) - , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -652,11 +700,20 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "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", "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object [ ( "description", Encode.string "test clone <repository>" ) @@ -668,7 +725,8 @@ all = [ ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "positional" + [ ( "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>)" ) @@ -682,12 +740,12 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "subcommand" ] ) ] ) - , ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] ] ) @@ -706,7 +764,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{},\"name\":\"World\",\"greeting\":\"Hi\"}" ] + [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"name\":\"World\",\"greeting\":\"Hi\"}}}" ] "1.0.0" Program.WithoutColor ) @@ -722,7 +780,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":{\"verbose\":true}},\"name\":\"World\"}" ] + [ "node", "test", "{\"$cli\":{\"flags\":{\"verbose\":true},\"keywordValues\":{\"name\":\"World\"}}}" ] "1.0.0" Program.WithoutColor ) @@ -737,7 +795,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{},\"subcommand\":\"greet\",\"name\":\"World\"}" ] + [ "node", "test", "{\"$cli\":{\"subcommand\":\"greet\",\"keywordValues\":{\"name\":\"World\"}}}" ] "1.0.0" Program.WithoutColor ) @@ -755,7 +813,7 @@ all = ) in Program.run cfg - [ "node", "test", "{\"$cli\":{},\"greeting\":\"Hi\"}" ] + [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"greeting\":\"Hi\"}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -773,7 +831,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{},\"name\":123}" ] + [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"name\":123}}}" ] "1.0.0" Program.WithoutColor ) @@ -814,7 +872,7 @@ Expecting a STRING""" ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":{\"init\":true}},\"name\":\"my-project\"}" ] + [ "node", "test", "{\"$cli\":{\"flags\":{\"init\":true},\"keywordValues\":{\"name\":\"my-project\"}}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch "init:my-project") @@ -894,8 +952,7 @@ Expecting a STRING""" {-| 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). Adds `$cli` as a `{"type": "object"}` property and -always includes `$cli` in `required`. +or keyword arg lists). Nests keyword args under `$cli.keywordValues`. -} expectJsonSchema : { description : String @@ -905,6 +962,57 @@ expectJsonSchema : -> Program.Config msg -> Expect.Expectation expectJsonSchema { description, properties, required } config = + let + keywordValuesObj = + Encode.object + ([ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + (properties + |> List.map (\( name, fields ) -> ( name, Encode.object fields )) + ) + ) + ] + ++ (if List.isEmpty required then + [] + + else + [ ( "required", Encode.list Encode.string required ) ] + ) + ) + + cliSubProperties = + if List.isEmpty properties then + [] + + else + [ ( "keywordValues", keywordValuesObj ) ] + + cliRequired = + if List.isEmpty required then + [] + + else + [ "keywordValues" ] + + cliObj = + Encode.object + ([ ( "type", Encode.string "object" ) ] + ++ (if List.isEmpty cliSubProperties then + [] + + else + [ ( "properties", Encode.object cliSubProperties ) ] + ) + ++ (if List.isEmpty cliRequired then + [] + + else + [ ( "required", Encode.list Encode.string cliRequired ) ] + ) + ) + in config |> Program.toJsonSchema "test" |> Encode.encode 0 @@ -914,13 +1022,9 @@ expectJsonSchema { description, properties, required } config = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - (( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - :: (properties - |> List.map (\( name, fields ) -> ( name, Encode.object fields )) - ) - ) + [ ( "$cli", cliObj ) ] ) - , ( "required", Encode.list Encode.string ("$cli" :: required) ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index c573499..e2a34cf 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -222,22 +222,42 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "format" + [ ( "$cli" , Encode.object - [ ( "type", Encode.string "string" ) - , ( "anyOf" - , Encode.list identity - [ Encode.object [ ( "const", Encode.string "json" ) ] - , Encode.object [ ( "const", Encode.string "junit" ) ] - , Encode.object [ ( "const", Encode.string "console" ) ] + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "format" + , Encode.object + [ ( "type", Encode.string "string" ) + , ( "anyOf" + , Encode.list identity + [ Encode.object [ ( "const", Encode.string "json" ) ] + , Encode.object [ ( "const", Encode.string "junit" ) ] + , Encode.object [ ( "const", Encode.string "console" ) ] + ] + ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "format" ] ) + ] + ) ] ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "format" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 2871c12..d323be3 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -58,11 +58,30 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "name" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + ] + ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "name" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -112,11 +131,30 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) + [ ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + ] + ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "count" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -469,9 +507,12 @@ all = , Encode.object [ ( "header", Encode.list Encode.string [ "X-A: 1" ] ) ] ) + , ( "keywordValues" + , Encode.object + [ ( "limit", Encode.string "10" ) ] + ) ] ) - , ( "limit", Encode.string "10" ) ] |> Encode.encode 0 in @@ -518,16 +559,36 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) - , ( "count" + [ ( "$cli" , Encode.object - [ ( "type", Encode.string "integer" ) - , ( "description", Encode.string "Number of items" ) + [ ( "type", Encode.string "object" ) + , ( "properties" + , Encode.object + [ ( "keywordValues" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) + , ( "properties" + , Encode.object + [ ( "count" + , Encode.object + [ ( "type", Encode.string "integer" ) + , ( "description", Encode.string "Number of items" ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "count" ] ) + ] + ) + ] + ) + , ( "required", Encode.list Encode.string [ "keywordValues" ] ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli", "count" ] ) + , ( "required", Encode.list Encode.string [ "$cli" ] ) ] |> Encode.encode 0 ) @@ -573,7 +634,12 @@ runJsonWith : Option.Option from to { c | position : Cli.Option.BeginningOption runJsonWith option fields = let jsonArg = - Encode.object (( "$cli", Encode.object [] ) :: fields) + Encode.object + [ ( "$cli" + , Encode.object + [ ( "keywordValues", Encode.object fields ) ] + ) + ] |> Encode.encode 0 in Program.config From dcda7b356458b68f864659eb45aeb8aa6a7ff397 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 12:20:56 -0700 Subject: [PATCH 12/34] Nest keyword args and subcommand inside $cli object. --- src/Cli/Program.elm | 43 +++++++--------------- tests/ExperienceTests.elm | 37 ++++++++----------- tests/JsonSchemaTests.elm | 74 ++++++++++++++++++++++++-------------- tests/TsTypeTests.elm | 20 ++++------- tests/TypedOptionTests.elm | 9 +++-- 5 files changed, 87 insertions(+), 96 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index f15d9a4..33c0bbe 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -642,7 +642,7 @@ parserToJsonSchemaFromTsTypes programName parser = List.map2 Tuple.pair specs tsTypes usageSynopsis = - OptionsParser.synopsis False programName parser + OptionsParser.detailedHelp False programName parser |> String.trim -- Subcommand → $cli.subcommand @@ -798,9 +798,18 @@ parserToJsonSchemaFromTsTypes programName parser = [] ) + cliDescription = + if List.isEmpty cliSubProperties then + "Required CLI input object. Include as empty object {} when no arguments are needed." + + else + "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." + cliSchema = Encode.object - ([ ( "type", Encode.string "object" ) ] + ([ ( "type", Encode.string "object" ) + , ( "description", Encode.string cliDescription ) + ] ++ (if List.isEmpty cliSubProperties then [] @@ -1002,27 +1011,13 @@ tsTypeToProperty spec ( optionName, tsType ) = strippedSchema = stripSchemaKey (TsJson.Type.toJsonSchema tsType) - -- anyOf+const from stringUnion lacks "type":"string" — add it - withType = - case Json.Decode.decodeValue (Json.Decode.field "anyOf" Json.Decode.value) strippedSchema of - Ok _ -> - case Json.Decode.decodeValue (Json.Decode.field "type" Json.Decode.value) strippedSchema of - Ok _ -> - strippedSchema - - Err _ -> - prependJsonField ( "type", Encode.string "string" ) strippedSchema - - Err _ -> - strippedSchema - schemaWithDescription = case usageSpecDescription spec of Just desc -> - appendJsonFields [ ( "description", Encode.string desc ) ] withType + appendJsonFields [ ( "description", Encode.string desc ) ] strippedSchema Nothing -> - withType + strippedSchema in ( optionName, schemaWithDescription ) @@ -1040,18 +1035,6 @@ usageSpecDescription spec = maybeDescription -{-| Prepend a key-value pair to the beginning of a JSON object value. --} -prependJsonField : ( String, Encode.Value ) -> Encode.Value -> Encode.Value -prependJsonField field jsonValue = - case Json.Decode.decodeValue (Json.Decode.keyValuePairs Json.Decode.value) jsonValue of - Ok existingFields -> - Encode.object (field :: existingFields) - - Err _ -> - Encode.object [ field ] - - {-| Append additional key-value pairs to the end of a JSON object value. -} appendJsonFields : List ( String, Encode.Value ) -> Encode.Value -> Encode.Value diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index c7515f4..ff59235 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -132,11 +132,12 @@ all = |> Expect.equal """{ "anyOf": [ { - "description": "test add --title <TITLE> --priority <low|medium|high>", + "description": "Usage: test add --title <TITLE> --priority <low|medium|high>\\n\\nOptions:\\n --title <TITLE> The task title\\n --priority <low|medium|high> Task priority level", "type": "object", "properties": { "$cli": { "type": "object", + "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", @@ -152,16 +153,10 @@ all = }, "priority": { "type": "string", - "anyOf": [ - { - "const": "low" - }, - { - "const": "medium" - }, - { - "const": "high" - } + "enum": [ + "low", + "medium", + "high" ], "description": "Task priority level" } @@ -183,11 +178,12 @@ all = ] }, { - "description": "test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]", + "description": "Usage: test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]\\n\\nOptions:\\n --format <json|table|csv> Output format\\n --limit <LIMIT> Maximum number of tasks to show\\n --verbose Show full task details", "type": "object", "properties": { "$cli": { "type": "object", + "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", @@ -199,16 +195,10 @@ all = "properties": { "format": { "type": "string", - "anyOf": [ - { - "const": "json" - }, - { - "const": "table" - }, - { - "const": "csv" - } + "enum": [ + "json", + "table", + "csv" ], "description": "Output format" }, @@ -243,11 +233,12 @@ all = ] }, { - "description": "test complete <task-id>", + "description": "Usage: test complete <task-id>\\n\\nOptions:\\n <task-id> The ID of the task to mark complete", "type": "object", "properties": { "$cli": { "type": "object", + "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 6415be9..afc9b4c 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -20,7 +20,7 @@ all = |> OptionsParser.with (Option.requiredKeywordArg "name") ) |> expectJsonSchema - { description = "test --name <NAME>" + { description = "Usage: test --name <NAME>" , properties = [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] , required = [ "name" ] @@ -33,7 +33,7 @@ all = |> OptionsParser.with (Option.optionalKeywordArg "greeting") ) |> expectJsonSchema - { description = "test [--greeting <GREETING>]" + { description = "Usage: test [--greeting <GREETING>]" , properties = [ ( "greeting", [ ( "type", Encode.string "string" ) ] ) ] , required = [] @@ -49,13 +49,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--verbose]" ) + [ ( "description", Encode.string "Usage: test [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "flags" @@ -89,13 +90,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test <file>" ) + [ ( "description", Encode.string "Usage: test <file>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -131,13 +133,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [<revision>]" ) + [ ( "description", Encode.string "Usage: test [<revision>]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -172,13 +175,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test <files>..." ) + [ ( "description", Encode.string "Usage: test <files>..." ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -209,13 +213,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--header <HEADER>]..." ) + [ ( "description", Encode.string "Usage: test [--header <HEADER>]..." ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordLists" @@ -255,7 +260,7 @@ all = ) ) |> expectJsonSchema - { description = "test --name <NAME>" + { description = "Usage: test --name <NAME>\n\nOptions:\n --name <NAME> The user's name" , properties = [ ( "name" , [ ( "type", Encode.string "string" ) @@ -283,13 +288,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --format <json|junit|console>" ) + [ ( "description", Encode.string "Usage: test --format <json|junit|console>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -301,12 +307,8 @@ all = [ ( "format" , Encode.object [ ( "type", Encode.string "string" ) - , ( "anyOf" - , Encode.list identity - [ Encode.object [ ( "const", Encode.string "json" ) ] - , Encode.object [ ( "const", Encode.string "junit" ) ] - , Encode.object [ ( "const", Encode.string "console" ) ] - ] + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] ) ] ) @@ -339,13 +341,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --name <NAME> [--greeting <GREETING>] [--verbose]" ) + [ ( "description", Encode.string "Usage: test --name <NAME> [--greeting <GREETING>] [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -393,13 +396,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --init" ) + [ ( "description", Encode.string "Usage: test --init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "flags" @@ -436,13 +440,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --init --force" ) + [ ( "description", Encode.string "Usage: test --init --force" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "flags" @@ -481,13 +486,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--verbose] --init" ) + [ ( "description", Encode.string "Usage: test [--verbose] --init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "flags" @@ -536,13 +542,14 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "test --init --name <NAME>" ) + [ ( "description", Encode.string "Usage: test --init --name <NAME>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -577,13 +584,14 @@ all = , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "test --build [--verbose]" ) + [ ( "description", Encode.string "Usage: test --build [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "flags" @@ -622,11 +630,11 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test" ) + [ ( "description", Encode.string "Usage: test" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ), ( "description", Encode.string "Required CLI input object. Include as empty object {} when no arguments are needed." ) ] ) ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) @@ -646,13 +654,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test init [--bare]" ) + [ ( "description", Encode.string "Usage: test init [--bare]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) @@ -696,13 +705,14 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "test init" ) + [ ( "description", Encode.string "Usage: test init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) @@ -716,13 +726,14 @@ all = , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "test clone <repository>" ) + [ ( "description", Encode.string "Usage: test clone <repository>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) @@ -996,9 +1007,18 @@ expectJsonSchema { description, properties, required } config = else [ "keywordValues" ] + cliDescription = + if List.isEmpty cliSubProperties then + "Required CLI input object. Include as empty object {} when no arguments are needed." + + else + "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." + cliObj = Encode.object - ([ ( "type", Encode.string "object" ) ] + ([ ( "type", Encode.string "object" ) + , ( "description", Encode.string cliDescription ) + ] ++ (if List.isEmpty cliSubProperties then [] diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index e2a34cf..92ddba3 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -184,12 +184,9 @@ all = |> Expect.equal (Encode.object [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) - , ( "anyOf" - , Encode.list identity - [ Encode.object [ ( "const", Encode.string "json" ) ] - , Encode.object [ ( "const", Encode.string "junit" ) ] - , Encode.object [ ( "const", Encode.string "console" ) ] - ] + , ( "type", Encode.string "string" ) + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] ) ] |> Encode.encode 0 @@ -218,13 +215,14 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --format <json|junit|console>" ) + [ ( "description", Encode.string "Usage: test --format <json|junit|console>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -236,12 +234,8 @@ all = [ ( "format" , Encode.object [ ( "type", Encode.string "string" ) - , ( "anyOf" - , Encode.list identity - [ Encode.object [ ( "const", Encode.string "json" ) ] - , Encode.object [ ( "const", Encode.string "junit" ) ] - , Encode.object [ ( "const", Encode.string "console" ) ] - ] + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] ) ] ) diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index d323be3..2579030 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -54,13 +54,14 @@ all = schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --name <NAME>" ) + [ ( "description", Encode.string "Usage: test --name <NAME>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -127,13 +128,14 @@ all = schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --count <COUNT>" ) + [ ( "description", Encode.string "Usage: test --count <COUNT>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" @@ -555,13 +557,14 @@ all = ) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --count <COUNT>" ) + [ ( "description", Encode.string "Usage: test --count <COUNT>\n\nOptions:\n --count <COUNT> Number of items" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "keywordValues" From f9fa20839b5052ef68fbf0279e6bf6b00d66ed81 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Fri, 13 Mar 2026 16:41:24 -0700 Subject: [PATCH 13/34] Extract common code between options APIs, and remove redundant information in help text from schema. --- src/Cli/Option.elm | 218 +++--------------------------------- src/Cli/Option/Internal.elm | 218 +++++++++++++++++++++++++++++++++++- src/Cli/Option/Typed.elm | 208 ++++------------------------------ src/Cli/Program.elm | 2 +- tests/ExperienceTests.elm | 6 +- tests/JsonSchemaTests.elm | 38 +++---- tests/TsTypeTests.elm | 2 +- tests/TypedOptionTests.elm | 6 +- 8 files changed, 282 insertions(+), 416 deletions(-) diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 4aa4b88..3d988de 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -118,7 +118,6 @@ 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 @@ -230,27 +229,10 @@ 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) - (jsonFieldGrabber operandDescription + (Internal.jsonFieldGrabber operandDescription Json.Decode.string (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } @@ -269,26 +251,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) - (jsonOptionalFieldGrabber optionName Json.Decode.string) + (Internal.jsonOptionalFieldGrabber optionName Json.Decode.string) {-| A keyword argument that must be provided. @@ -302,28 +268,10 @@ 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) - (jsonFieldGrabber optionName + (Internal.jsonFieldGrabber optionName Json.Decode.string (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) ) @@ -340,19 +288,10 @@ 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) - (jsonFlagGrabber flagName) + (Internal.jsonFlagGrabber flagName) {-| Build an option for required arguments (has canAddMissingMessage capability). @@ -363,7 +302,7 @@ buildRequiredOption dataGrabber usageSpec tsType jsonGrabber = { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder - , meta = emptyMeta + , meta = Internal.emptyMeta , tsType = tsType , jsonGrabber = jsonGrabber } @@ -377,7 +316,7 @@ buildOptionalOption dataGrabber usageSpec tsType jsonGrabber = { dataGrabber = dataGrabber , usageSpec = usageSpec , decoder = Cli.Decode.decoder - , meta = emptyMeta + , meta = Internal.emptyMeta , tsType = tsType , jsonGrabber = jsonGrabber } @@ -391,102 +330,12 @@ buildEndingOption dataGrabber usageSpec tsType jsonGrabber = { 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 - } - - -{-| 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 -> Internal.JsonGrabber a -jsonFieldGrabber fieldName valueDecoder missingError = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of - Ok value -> - Ok ( [], value ) - - Err decodeError -> - -- Distinguish between "field absent" and "field present, wrong type" - case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of - Ok _ -> - -- Field exists but wrong type - Err - (Cli.Decode.UnrecoverableValidationError - { name = fieldName - , invalidReason = Json.Decode.errorToString decodeError - } - ) - - Err _ -> - -- Field entirely absent - Err (Cli.Decode.MatchError missingError) - - -{-| Create a jsonGrabber for an optional field. Returns Nothing if absent. --} -jsonOptionalFieldGrabber : String -> Json.Decode.Decoder a -> Internal.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 -> - -- Check if the field is absent (ok, return Nothing) or wrong type (error) - case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.value) blob of - Ok _ -> - -- Field exists but wrong type - Err - (Cli.Decode.UnrecoverableValidationError - { name = fieldName - , invalidReason = Json.Decode.errorToString decodeError - } - ) - - Err _ -> - -- Field absent, that's fine for optional - Ok ( [], Nothing ) - - -{-| Create a jsonGrabber for an optional field with a default value. --} -jsonOptionalFieldGrabberWithDefault : String -> Json.Decode.Decoder a -> a -> Internal.JsonGrabber a -jsonOptionalFieldGrabberWithDefault fieldName valueDecoder defaultValue = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field fieldName valueDecoder) blob of - Ok value -> - Ok ( [], value ) - - Err _ -> - -- Field absent or wrong type — use default - Ok ( [], defaultValue ) - - -{-| Create a jsonGrabber for a boolean flag. Defaults to False if absent. --} -jsonFlagGrabber : String -> Internal.JsonGrabber Bool -jsonFlagGrabber fieldName = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field fieldName Json.Decode.bool) blob of - Ok value -> - Ok ( [], value ) - - Err _ -> - -- Flag absent or wrong type — default to False - Ok ( [], False ) - - {-| Add a description to an option. This will be shown in help text. Option.requiredKeywordArg "name" @@ -847,26 +696,10 @@ 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 - - ( True, Tokenizer.KeywordArg optionValue ) -> - Just optionValue - - ( True, _ ) -> - -- TODO this should probably be an error - Nothing - ) - |> Ok - ) + (Internal.keywordArgListGrabber flagName) (UsageSpec.keywordArg flagName ZeroOrMore) (TsDecode.tsType (TsDecode.list TsDecode.string)) - (jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) + (Internal.jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) {-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. @@ -874,23 +707,10 @@ keywordArgList flagName = 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) - (jsonOptionalFieldGrabber operandDescription Json.Decode.string) + (Internal.jsonOptionalFieldGrabber operandDescription Json.Decode.string) {-| Note that this must be used with `OptionsParser.withRestArgs`. @@ -898,11 +718,7 @@ optionalPositionalArg operandDescription = 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)) - (jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.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 1ae1904..8cb84ec 100644 --- a/src/Cli/Option/Internal.elm +++ b/src/Cli/Option/Internal.elm @@ -4,11 +4,24 @@ module Cli.Option.Internal exposing , 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 @@ -48,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 index bb46f72..4deb407 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -53,9 +53,7 @@ import Cli.Option exposing (BeginningOption, OptionalPositionalArgOption, RestAr import Cli.Option.Internal as Internal exposing (Option(..)) import Cli.UsageSpec as UsageSpec import Json.Decode -import List.Extra import Occurences exposing (Occurences(..)) -import Tokenizer import TsJson.Decode as TsDecode @@ -183,34 +181,16 @@ fromDecoder tsDecoder = requiredKeywordArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } requiredKeywordArg optionName (CliDecoder decoder) = Option - { dataGrabber = - \{ 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 + { dataGrabber = Internal.requiredKeywordArgGrabber optionName , usageSpec = UsageSpec.keywordArg optionName Required , decoder = Cli.Decode.decoder |> Cli.Decode.mapProcessingError (decoder.cliParser optionName) - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = - jsonFieldGrabber optionName + Internal.jsonFieldGrabber optionName decoder.jsonDecoder (Cli.Decode.MissingRequiredKeywordArg { name = optionName, customMessage = Nothing }) } @@ -226,23 +206,7 @@ requiredKeywordArg optionName (CliDecoder decoder) = optionalKeywordArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : BeginningOption } optionalKeywordArg optionName (CliDecoder decoder) = Option - { dataGrabber = - \{ 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 + { dataGrabber = Internal.optionalKeywordArgGrabber optionName , usageSpec = UsageSpec.keywordArg optionName Optional , decoder = Cli.Decode.decoder @@ -256,26 +220,9 @@ optionalKeywordArg optionName (CliDecoder decoder) = Nothing -> Ok Nothing ) - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType decoder.tsDecoder - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field optionName decoder.jsonDecoder) blob of - Ok value -> - Ok ( [], Just value ) - - Err decodeError -> - case Json.Decode.decodeValue (Json.Decode.field optionName Json.Decode.value) blob of - Ok _ -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = optionName - , invalidReason = Json.Decode.errorToString decodeError - } - ) - - Err _ -> - Ok ( [], Nothing ) + , jsonGrabber = Internal.jsonOptionalFieldGrabber optionName decoder.jsonDecoder } @@ -288,22 +235,7 @@ optionalKeywordArg optionName (CliDecoder decoder) = keywordArgList : String -> CliDecoder value -> Option (List String) (List value) { position : BeginningOption } keywordArgList flagName (CliDecoder decoder) = Option - { dataGrabber = - \{ options } -> - options - |> List.filterMap - (\(Tokenizer.ParsedOption optionName optionKind) -> - case ( optionName == flagName, optionKind ) of - ( False, _ ) -> - Nothing - - ( True, Tokenizer.KeywordArg optionValue ) -> - Just optionValue - - ( True, _ ) -> - Nothing - ) - |> Ok + { dataGrabber = Internal.keywordArgListGrabber flagName , usageSpec = UsageSpec.keywordArg flagName ZeroOrMore , decoder = Cli.Decode.decoder @@ -326,16 +258,9 @@ keywordArgList flagName (CliDecoder decoder) = ) (Ok []) ) - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType (TsDecode.list decoder.tsDecoder) - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field flagName (Json.Decode.list decoder.jsonDecoder)) blob of - Ok value -> - Ok ( [], value ) - - Err _ -> - Ok ( [], [] ) + , jsonGrabber = Internal.jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list decoder.jsonDecoder) [] } @@ -349,33 +274,16 @@ keywordArgList flagName (CliDecoder decoder) = requiredPositionalArg : String -> CliDecoder value -> Option String value { position : BeginningOption, canAddMissingMessage : () } requiredPositionalArg operandDescription (CliDecoder decoder) = Option - { dataGrabber = - \{ 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 + { dataGrabber = Internal.requiredPositionalArgGrabber operandDescription , usageSpec = UsageSpec.operand operandDescription , decoder = Cli.Decode.decoder |> Cli.Decode.mapProcessingError (decoder.cliParser operandDescription) - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType decoder.tsDecoder , jsonGrabber = - jsonFieldGrabber operandDescription + Internal.jsonFieldGrabber operandDescription decoder.jsonDecoder (Cli.Decode.MissingRequiredPositionalArg { name = operandDescription, operandsSoFar = 0, customMessage = Nothing } @@ -392,17 +300,7 @@ Must be used with `OptionsParser.withOptionalPositionalArg`. optionalPositionalArg : String -> CliDecoder value -> Option (Maybe String) (Maybe value) { position : OptionalPositionalArgOption } optionalPositionalArg operandDescription (CliDecoder decoder) = Option - { dataGrabber = - \flagsAndOperands -> - let - operandsSoFar = - UsageSpec.operandCount flagsAndOperands.usageSpecs - 1 - - maybeArg = - flagsAndOperands.operands - |> List.Extra.getAt operandsSoFar - in - Ok maybeArg + { dataGrabber = Internal.optionalPositionalArgGrabber , usageSpec = UsageSpec.optionalPositionalArg operandDescription , decoder = Cli.Decode.decoder @@ -416,26 +314,9 @@ optionalPositionalArg operandDescription (CliDecoder decoder) = Nothing -> Ok Nothing ) - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType decoder.tsDecoder - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field operandDescription decoder.jsonDecoder) blob of - Ok value -> - Ok ( [], Just value ) - - Err decodeError -> - case Json.Decode.decodeValue (Json.Decode.field operandDescription Json.Decode.value) blob of - Ok _ -> - Err - (Cli.Decode.UnrecoverableValidationError - { name = operandDescription - , invalidReason = Json.Decode.errorToString decodeError - } - ) - - Err _ -> - Ok ( [], Nothing ) + , jsonGrabber = Internal.jsonOptionalFieldGrabber operandDescription decoder.jsonDecoder } @@ -449,28 +330,12 @@ optionalPositionalArg operandDescription (CliDecoder decoder) = flag : String -> Option Bool Bool { position : BeginningOption } flag flagName = Option - { dataGrabber = - \{ options } -> - if - options - |> List.member (Tokenizer.ParsedOption flagName Tokenizer.Flag) - then - Ok True - - else - Ok False + { dataGrabber = Internal.flagGrabber flagName , usageSpec = UsageSpec.flag flagName Optional , decoder = Cli.Decode.decoder - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType TsDecode.bool - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field flagName Json.Decode.bool) blob of - Ok value -> - Ok ( [], value ) - - Err _ -> - Ok ( [], False ) + , jsonGrabber = Internal.jsonFlagGrabber flagName } @@ -483,23 +348,12 @@ flag flagName = restArgs : String -> Option (List String) (List String) { position : RestArgsOption } restArgs restArgsDescription = Option - { dataGrabber = - \{ operands, usageSpecs } -> - operands - |> List.drop (UsageSpec.operandCount usageSpecs) - |> Ok + { dataGrabber = Internal.restArgsGrabber , usageSpec = UsageSpec.restArgs restArgsDescription , decoder = Cli.Decode.decoder - , meta = { missingMessage = Nothing } + , meta = Internal.emptyMeta , tsType = TsDecode.tsType (TsDecode.list TsDecode.string) - , jsonGrabber = - \blob -> - case Json.Decode.decodeValue (Json.Decode.field restArgsDescription (Json.Decode.list Json.Decode.string)) blob of - Ok value -> - Ok ( [], value ) - - Err _ -> - Ok ( [], [] ) + , jsonGrabber = Internal.jsonOptionalFieldGrabberWithDefault restArgsDescription (Json.Decode.list Json.Decode.string) [] } @@ -568,23 +422,3 @@ decodeCliJson elmJsonDecoder optionName stringValue = , invalidReason = Json.Decode.errorToString err } ) - - -jsonFieldGrabber : String -> Json.Decode.Decoder a -> Cli.Decode.MatchErrorDetail -> Internal.JsonGrabber a -jsonFieldGrabber fieldName elmJsonDecoder missingError blob = - case Json.Decode.decodeValue (Json.Decode.field fieldName elmJsonDecoder) 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) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 33c0bbe..00888a3 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -642,7 +642,7 @@ parserToJsonSchemaFromTsTypes programName parser = List.map2 Tuple.pair specs tsTypes usageSynopsis = - OptionsParser.detailedHelp False programName parser + OptionsParser.synopsis False programName parser |> String.trim -- Subcommand → $cli.subcommand diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index ff59235..48e5c0f 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -132,7 +132,7 @@ all = |> Expect.equal """{ "anyOf": [ { - "description": "Usage: test add --title <TITLE> --priority <low|medium|high>\\n\\nOptions:\\n --title <TITLE> The task title\\n --priority <low|medium|high> Task priority level", + "description": "test add --title <TITLE> --priority <low|medium|high>", "type": "object", "properties": { "$cli": { @@ -178,7 +178,7 @@ all = ] }, { - "description": "Usage: test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]\\n\\nOptions:\\n --format <json|table|csv> Output format\\n --limit <LIMIT> Maximum number of tasks to show\\n --verbose Show full task details", + "description": "test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]", "type": "object", "properties": { "$cli": { @@ -233,7 +233,7 @@ all = ] }, { - "description": "Usage: test complete <task-id>\\n\\nOptions:\\n <task-id> The ID of the task to mark complete", + "description": "test complete <task-id>", "type": "object", "properties": { "$cli": { diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index afc9b4c..7beefae 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -20,7 +20,7 @@ all = |> OptionsParser.with (Option.requiredKeywordArg "name") ) |> expectJsonSchema - { description = "Usage: test --name <NAME>" + { description = "test --name <NAME>" , properties = [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] , required = [ "name" ] @@ -33,7 +33,7 @@ all = |> OptionsParser.with (Option.optionalKeywordArg "greeting") ) |> expectJsonSchema - { description = "Usage: test [--greeting <GREETING>]" + { description = "test [--greeting <GREETING>]" , properties = [ ( "greeting", [ ( "type", Encode.string "string" ) ] ) ] , required = [] @@ -49,7 +49,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test [--verbose]" ) + [ ( "description", Encode.string "test [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -90,7 +90,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test <file>" ) + [ ( "description", Encode.string "test <file>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -133,7 +133,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test [<revision>]" ) + [ ( "description", Encode.string "test [<revision>]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -175,7 +175,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test <files>..." ) + [ ( "description", Encode.string "test <files>..." ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -213,7 +213,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test [--header <HEADER>]..." ) + [ ( "description", Encode.string "test [--header <HEADER>]..." ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -260,7 +260,7 @@ all = ) ) |> expectJsonSchema - { description = "Usage: test --name <NAME>\n\nOptions:\n --name <NAME> The user's name" + { description = "test --name <NAME>" , properties = [ ( "name" , [ ( "type", Encode.string "string" ) @@ -288,7 +288,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --format <json|junit|console>" ) + [ ( "description", Encode.string "test --format <json|junit|console>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -341,7 +341,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --name <NAME> [--greeting <GREETING>] [--verbose]" ) + [ ( "description", Encode.string "test --name <NAME> [--greeting <GREETING>] [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -396,7 +396,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --init" ) + [ ( "description", Encode.string "test --init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -440,7 +440,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --init --force" ) + [ ( "description", Encode.string "test --init --force" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -486,7 +486,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test [--verbose] --init" ) + [ ( "description", Encode.string "test [--verbose] --init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -542,7 +542,7 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "Usage: test --init --name <NAME>" ) + [ ( "description", Encode.string "test --init --name <NAME>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -584,7 +584,7 @@ all = , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "Usage: test --build [--verbose]" ) + [ ( "description", Encode.string "test --build [--verbose]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -630,7 +630,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test" ) + [ ( "description", Encode.string "test" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -654,7 +654,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test init [--bare]" ) + [ ( "description", Encode.string "test init [--bare]" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -705,7 +705,7 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "Usage: test init" ) + [ ( "description", Encode.string "test init" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -726,7 +726,7 @@ all = , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "Usage: test clone <repository>" ) + [ ( "description", Encode.string "test clone <repository>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 92ddba3..0de3431 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -215,7 +215,7 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --format <json|junit|console>" ) + [ ( "description", Encode.string "test --format <json|junit|console>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 2579030..4f63f5c 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -54,7 +54,7 @@ all = schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --name <NAME>" ) + [ ( "description", Encode.string "test --name <NAME>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -128,7 +128,7 @@ all = schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --count <COUNT>" ) + [ ( "description", Encode.string "test --count <COUNT>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object @@ -557,7 +557,7 @@ all = ) |> Expect.equal (Encode.object - [ ( "description", Encode.string "Usage: test --count <COUNT>\n\nOptions:\n --count <COUNT> Number of items" ) + [ ( "description", Encode.string "test --count <COUNT>" ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object From 71cbd58fb5a6fc8b3b941ba230821c37e1e1db5e Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 06:59:23 -0700 Subject: [PATCH 14/34] Improve docs. --- src/Cli/Option.elm | 10 +++++- src/Cli/Option/Typed.elm | 65 ++++++++++++++++++++++++++++++++++++--- src/Cli/OptionsParser.elm | 11 ++++--- src/Cli/Program.elm | 23 +++++++++++--- 4 files changed, 94 insertions(+), 15 deletions(-) diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 3d988de..9d0dc66 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) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 4deb407..d3b6315 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -8,10 +8,64 @@ module Cli.Option.Typed exposing , withDescription, withDisplayName ) -{-| Typed option constructors for first-class JSON schema support. +{-| Typed option constructors with first-class JSON schema support. -Each constructor produces both a CLI parser and a JSON schema from a `CliDecoder`. -Use `string`, `int`, `float`, `bool` for primitives, or `fromDecoder` for custom types. +This module is an alternative to [`Cli.Option`](Cli-Option) for building option parsers. +The key difference: each constructor takes a [`CliDecoder`](#CliDecoder) that specifies the +type of the option's value (string, int, float, etc.). This lets the library: + +1. **Generate JSON schemas** — via [`Program.toJsonSchema`](Cli-Program#toJsonSchema), + producing [JSON Schema](https://json-schema.org/) definitions suitable for + [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) `inputSchema`. +2. **Parse JSON input** — the same parser that handles CLI args can also accept structured + JSON, enabling LLM agents to invoke your CLI tool programmatically. +3. **Validate CLI values** — typed decoders like `int` and `float` automatically validate + that CLI string arguments are well-formed numbers. + + +## When to use this vs `Cli.Option` + +Use **`Cli.Option.Typed`** when you want JSON schema generation — for example, when +building [elm-pages scripts](https://elm-pages.com/docs/elm-pages-scripts) that can be +introspected as tools, or any CLI that needs to be invocable via structured JSON. + +Use **[`Cli.Option`](Cli-Option)** 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`](Cli-OptionsParser#with) pipeline. + + +## 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**: `{ "$cli": { "keywordValues": { "name": "hello", "count": 3 }, "flags": { "verbose": true } } }` + +And `Program.toJsonSchema "mytool" programConfig` generates a JSON Schema with +proper types (`"type": "string"`, `"type": "integer"`, etc.). ## Types @@ -41,7 +95,10 @@ Use `string`, `int`, `float`, `bool` for primitives, or `fromDecoder` for custom ## Modifiers -Re-exported from `Cli.Option` for convenience. +These work the same as their [`Cli.Option`](Cli-Option) counterparts. Additional +modifiers like [`map`](Cli-Option#map), [`validate`](Cli-Option#validate), +[`mapFlag`](Cli-Option#mapFlag), and [`withMissingMessage`](Cli-Option#withMissingMessage) +can be used by importing them from `Cli.Option`. @docs oneOf, validateMap, validateMapIfPresent, withDefault @docs withDescription, withDisplayName diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index f9bd2f1..ed362e6 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -744,16 +744,17 @@ withDescription docString (OptionsParser optionsParserRecord) = } -{-| Normalize a JSON blob with `$cli` object structure into flat fields. +{-| Normalize a JSON blob with flat properties and `$cli` structural data into flat fields. + +In the flat schema format, named options (keyword args, flags, keyword lists) are +top-level properties. The `$cli` object contains only `subcommand` and `positional`. Transforms: + - All top-level fields except `$cli` → passed through as-is - `$cli.subcommand` → flat `subcommand` field - - `$cli.keywordValues.*` → flat fields for each keyword arg - `$cli.positional[N]` → flat field named by Nth operand's UsageSpec name - - `$cli.flags` object → flat boolean fields for each flag in usageSpecs - - `$cli.keywordLists.*` → flat array fields - - Strips the `$cli` key from the result + - Missing flags → defaulted to `False` -} normalizeCliJson : List UsageSpec -> Json.Decode.Value -> Json.Decode.Value diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 00888a3..cb95798 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -67,6 +67,15 @@ See the [`examples`](https://github.com/dillonkearns/elm-cli-options-parser/tree @docs StatelessProgram, StatefulProgram @docs FlagsIncludingArgv @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 @@ -593,12 +602,16 @@ helpText programName (Config { optionsParsers }) = {-| Generate a JSON Schema describing the inputs of this CLI configuration. -The schema follows the [JSON Schema](https://json-schema.org/) format used by the -[Model Context Protocol (MCP)](https://modelcontextprotocol.io/specification/draft/server/tools) -for tool `inputSchema` definitions. +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. -The `programName` argument is used to generate a usage synopsis in the schema's `description` -field, giving LLMs a concise overview of how to invoke the command. +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 From d5f0c015f4e74d58e501d2bcc27c77af32622159 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 07:02:09 -0700 Subject: [PATCH 15/34] Use flat JSON structure to simplify JSON invocation. Add x-cli-kind properties to make it clear whether to invoke as a flag, keyword value, or keyword list. --- src/Cli/OptionsParser.elm | 91 +++---- src/Cli/Program.elm | 306 ++++++++---------------- tests/ExperienceTests.elm | 120 ++++------ tests/JsonSchemaTests.elm | 476 ++++++++++++------------------------- tests/TsTypeTests.elm | 43 ++-- tests/TypedOptionTests.elm | 143 ++++------- 6 files changed, 393 insertions(+), 786 deletions(-) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index ed362e6..bb1931c 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -760,6 +760,18 @@ Transforms: normalizeCliJson : List UsageSpec -> Json.Decode.Value -> Json.Decode.Value normalizeCliJson usageSpecs blob = let + -- Get all top-level fields except $cli + 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 @@ -777,20 +789,6 @@ normalizeCliJson usageSpecs blob = Err _ -> [] - -- Build keyword value fields from $cli.keywordValues - keywordValueFields = - case maybeCli of - Ok cliValue -> - case Json.Decode.decodeValue (Json.Decode.field "keywordValues" (Json.Decode.keyValuePairs Json.Decode.value)) cliValue of - Ok pairs -> - pairs - - Err _ -> - [] - - Err _ -> - [] - -- Build positional arg fields from $cli.positional positionalFields = case maybeCli of @@ -841,56 +839,21 @@ normalizeCliJson usageSpecs blob = Err _ -> [] - -- Build flag fields from $cli.flags (object with boolean values) - flagFields = - case maybeCli of - Ok cliValue -> - let - allFlagNames = - usageSpecs - |> List.filterMap - (\spec -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.Flag flagName) _ _ _ -> - Just flagName - - _ -> - Nothing - ) - in - case Json.Decode.decodeValue (Json.Decode.field "flags" (Json.Decode.keyValuePairs Json.Decode.bool)) cliValue of - Ok flagPairs -> - allFlagNames - |> List.map - (\flagName -> - ( flagName - , Encode.bool - (flagPairs - |> List.any (\( k, v ) -> k == flagName && v) - ) - ) - ) - - Err _ -> - -- No flags in $cli — set all flags to false - allFlagNames - |> List.map (\flagName -> ( flagName, Encode.bool False )) + -- Default missing flags to False (jsonGrabber expects flag fields to exist) + 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 ) - Err _ -> - [] - - -- Build keyword list fields from $cli.keywordLists - keywordListFields = - case maybeCli of - Ok cliValue -> - case Json.Decode.decodeValue (Json.Decode.field "keywordLists" (Json.Decode.keyValuePairs Json.Decode.value)) cliValue of - Ok pairs -> - pairs - - Err _ -> - [] + else + Nothing - Err _ -> - [] + _ -> + Nothing + ) in - Encode.object (subcommandField ++ keywordValueFields ++ positionalFields ++ flagFields ++ keywordListFields) + Encode.object (topLevelFields ++ subcommandField ++ positionalFields ++ flagDefaults) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index cb95798..01a87db 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -616,16 +616,20 @@ Suitable for use as an [MCP tool](https://modelcontextprotocol.io/specification/ import Cli.Option as Option import Cli.OptionsParser as OptionsParser import Cli.Program as Program - import Json.Encode - Program.config - |> Program.add - (OptionsParser.build identity - |> OptionsParser.with (Option.requiredKeywordArg "name") - ) - |> Program.toJsonSchema "my-script" - |> Json.Encode.encode 0 - --> """{"description":"my-script --name <NAME>","type":"object","properties":{"$cli":{"type":"object","properties":{"keywordValues":{"type":"object","description":"Keyword arguments with values (e.g., --name <value>)","properties":{"name":{"type":"string"}},"required":["name"]}},"required":["keywordValues"]}},"required":["$cli"]}""" + 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 @@ -658,8 +662,16 @@ parserToJsonSchemaFromTsTypes programName parser = 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 - subCommandProperty = + subCommandProp = case OptionsParser.getSubCommand parser of Just subName -> [ ( "subcommand" @@ -673,65 +685,6 @@ parserToJsonSchemaFromTsTypes programName parser = Nothing -> [] - -- Keyword args (non-ZeroOrMore) → $cli.keywordValues - keywordArgProperties = - specsWithTypes - |> List.filterMap - (\( spec, ( optionName, tsType ) ) -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ occurences _ -> - if occurences /= ZeroOrMore then - Just (tsTypeToProperty spec ( optionName, tsType )) - - else - Nothing - - _ -> - Nothing - ) - - requiredKeywordArgs = - specsWithTypes - |> List.filterMap - (\( spec, _ ) -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg kwName _) _ Required _ -> - Just kwName - - _ -> - Nothing - ) - - -- Flags → $cli.flags - flagSpecs = - specsWithTypes - |> List.filterMap - (\( spec, ( optionName, _ ) ) -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ occurences maybeDescription -> - Just ( optionName, maybeDescription, occurences ) - - _ -> - Nothing - ) - - hasRequiredFlags = - flagSpecs - |> List.any (\( _, _, occ ) -> occ == Required) - - -- Keyword arg lists → $cli.keywordLists - keywordListProperties = - specsWithTypes - |> List.filterMap - (\( spec, ( optionName, tsType ) ) -> - case spec of - UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ ZeroOrMore _ -> - Just (tsTypeToProperty spec ( optionName, tsType )) - - _ -> - Nothing - ) - -- Positional args → $cli.positional positionalSpecs = specsWithTypes @@ -759,70 +712,24 @@ parserToJsonSchemaFromTsTypes programName parser = ) |> List.head - -- Build $cli.keywordValues schema - keywordValuesProperty = - if List.isEmpty keywordArgProperties then - [] - - else - [ ( "keywordValues" - , Encode.object - ([ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties", Encode.object keywordArgProperties ) - ] - ++ (if List.isEmpty requiredKeywordArgs then - [] - - else - [ ( "required", Encode.list Encode.string requiredKeywordArgs ) ] - ) - ) - ) - ] + hasPositionalArgs = + not (List.isEmpty positionalSpecs) || restArgSpec /= Nothing - -- Build all $cli sub-properties + -- Build $cli schema (only subcommand + positional) cliSubProperties = - subCommandProperty - ++ keywordValuesProperty - ++ positionalSchemaProperty positionalSpecs restArgSpec - ++ flagsSchemaProperty flagSpecs - ++ keywordListsSchemaProperty keywordListProperties + subCommandProp ++ positionalSchemaProperty positionalSpecs restArgSpec - -- $cli.required: subcommand, keywordValues (if has required kw args), flags (if has expectFlag) cliRequired = - (case OptionsParser.getSubCommand parser of + case OptionsParser.getSubCommand parser of Just _ -> [ "subcommand" ] Nothing -> [] - ) - ++ (if not (List.isEmpty requiredKeywordArgs) then - [ "keywordValues" ] - - else - [] - ) - ++ (if hasRequiredFlags then - [ "flags" ] - - else - [] - ) - - cliDescription = - if List.isEmpty cliSubProperties then - "Required CLI input object. Include as empty object {} when no arguments are needed." - - else - "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." cliSchema = Encode.object - ([ ( "type", Encode.string "object" ) - , ( "description", Encode.string cliDescription ) - ] + ([ ( "type", Encode.string "object" ) ] ++ (if List.isEmpty cliSubProperties then [] @@ -836,12 +743,23 @@ parserToJsonSchemaFromTsTypes programName parser = [ ( "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 usageSynopsis ) + [ ( "description", Encode.string description ) , ( "type", Encode.string "object" ) - , ( "properties", Encode.object [ ( "$cli", cliSchema ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "properties", Encode.object allProperties ) + , ( "required", Encode.list Encode.string allRequired ) ] @@ -930,78 +848,77 @@ positionalSchemaProperty positionalArgs maybeRestArgs = [ ( "positional", Encode.object schemaFields ) ] -{-| Build the `$cli.flags` schema property. -Flags are an object with boolean properties. Required flags (expectFlag) go in `required`. +{-| 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). -} -flagsSchemaProperty : List ( String, Maybe String, Occurences ) -> List ( String, Encode.Value ) -flagsSchemaProperty flags = - if List.isEmpty flags then - [] +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" - else - let - flagProperties = - flags - |> List.map - (\( flagName, maybeDesc, _ ) -> - ( flagName - , Encode.object - ([ ( "type", Encode.string "boolean" ) ] - ++ (case maybeDesc of - Just desc -> - [ ( "description", Encode.string desc ) ] + UsageSpec.FlagOrKeywordArg (UsageSpec.KeywordArg _ _) _ _ _ -> + Just "keyword" - Nothing -> - [] - ) - ) - ) - ) + UsageSpec.FlagOrKeywordArg (UsageSpec.Flag _) _ _ _ -> + Just "flag" - requiredFlags = - flags - |> List.filterMap - (\( flagName, _, occurences ) -> - if occurences == Required then - Just flagName + _ -> + Nothing + in + case maybeCliKind of + Just kind -> + let + strippedSchema = + stripSchemaKey (TsJson.Type.toJsonSchema tsType) - else - Nothing - ) - in - [ ( "flags" - , Encode.object - ([ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties", Encode.object flagProperties ) - ] - ++ (if List.isEmpty requiredFlags then - [] + extraFields = + [ ( "x-cli-kind", Encode.string kind ) ] + ++ (case usageSpecDescription spec of + Just desc -> + [ ( "description", Encode.string desc ) ] - else - [ ( "required", Encode.list Encode.string requiredFlags ) ] - ) - ) - ) - ] + Nothing -> + [] + ) + in + Just ( optionName, appendJsonFields extraFields strippedSchema ) + + Nothing -> + Nothing -{-| Build the `$cli.keywordLists` schema property. +{-| Get the name of a required top-level option (keyword arg or expectFlag). -} -keywordListsSchemaProperty : List ( String, Encode.Value ) -> List ( String, Encode.Value ) -keywordListsSchemaProperty keywordListProps = - if List.isEmpty keywordListProps then - [] +toRequiredTopLevelName : ( UsageSpec, ( String, a ) ) -> Maybe String +toRequiredTopLevelName ( spec, ( optionName, _ ) ) = + case spec of + UsageSpec.FlagOrKeywordArg _ _ Required _ -> + Just optionName - else - [ ( "keywordLists" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments that can be repeated (e.g., --header X --header Y)" ) - , ( "properties", Encode.object keywordListProps ) - ] - ) - ] + _ -> + 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 <value>\n- \"flag\": --name (present or absent, no value)\n- \"keyword-list\": --name <value> (repeatable)" + ++ "\n\n" + ++ positionalNote {-| Strip the `$schema` key from a TsJson-generated JSON schema value. @@ -1018,23 +935,6 @@ stripSchemaKey baseSchema = baseSchema -tsTypeToProperty : UsageSpec -> ( String, TsJson.Type.Type ) -> ( String, Encode.Value ) -tsTypeToProperty spec ( optionName, tsType ) = - let - strippedSchema = - stripSchemaKey (TsJson.Type.toJsonSchema tsType) - - schemaWithDescription = - case usageSpecDescription spec of - Just desc -> - appendJsonFields [ ( "description", Encode.string desc ) ] strippedSchema - - Nothing -> - strippedSchema - in - ( optionName, schemaWithDescription ) - - usageSpecDescription : UsageSpec -> Maybe String usageSpecDescription spec = case spec of diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 48e5c0f..1f0c82e 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -132,113 +132,91 @@ all = |> Expect.equal """{ "anyOf": [ { - "description": "test add --title <TITLE> --priority <low|medium|high>", + "description": "test add --title <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", - "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", "const": "add" - }, - "keywordValues": { - "type": "object", - "description": "Keyword arguments with values (e.g., --name <value>)", - "properties": { - "title": { - "type": "string", - "description": "The task title" - }, - "priority": { - "type": "string", - "enum": [ - "low", - "medium", - "high" - ], - "description": "Task priority level" - } - }, - "required": [ - "title", - "priority" - ] } }, "required": [ - "subcommand", - "keywordValues" + "subcommand" ] } }, "required": [ + "title", + "priority", "$cli" ] }, { - "description": "test list [--format <json|table|csv>] --limit <LIMIT> [--verbose]", + "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", - "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", "const": "list" - }, - "keywordValues": { - "type": "object", - "description": "Keyword arguments with values (e.g., --name <value>)", - "properties": { - "format": { - "type": "string", - "enum": [ - "json", - "table", - "csv" - ], - "description": "Output format" - }, - "limit": { - "type": "string", - "description": "Maximum number of tasks to show" - } - }, - "required": [ - "limit" - ] - }, - "flags": { - "type": "object", - "description": "Boolean flags, passed as --flag (e.g., --verbose)", - "properties": { - "verbose": { - "type": "boolean", - "description": "Show full task details" - } - } } }, "required": [ - "subcommand", - "keywordValues" + "subcommand" ] } }, "required": [ + "limit", "$cli" ] }, { - "description": "test complete <task-id>", + "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", - "description": "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable.", "properties": { "subcommand": { "type": "string", @@ -339,14 +317,14 @@ Options: [ test "add task via JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"title\":\"Buy milk\",\"priority\":\"high\"}}}" ] + [ "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", "{\"$cli\":{\"subcommand\":\"list\",\"flags\":{\"verbose\":true},\"keywordValues\":{\"format\":\"json\",\"limit\":\"10\"}}}" ] + [ "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 })) @@ -444,7 +422,7 @@ Run with --help for usage information.""" [ test "missing required field in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"priority\":\"high\"}}}" ] + [ "node", "mytool", "{\"priority\":\"high\",\"$cli\":{\"subcommand\":\"add\"}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -454,7 +432,7 @@ Run with --help for usage information.""" , test "invalid oneOf value in JSON" <| \() -> Program.run taskConfig - [ "node", "mytool", "{\"$cli\":{\"subcommand\":\"add\",\"keywordValues\":{\"title\":\"Buy milk\",\"priority\":\"urgent\"}}}" ] + [ "node", "mytool", "{\"title\":\"Buy milk\",\"priority\":\"urgent\",\"$cli\":{\"subcommand\":\"add\"}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -469,7 +447,7 @@ Must be one of [low, medium, high]""" -- 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", "{\"$cli\":{\"subcommand\":\"list\",\"keywordValues\":{\"format\":\"json\",\"limit\":10}}}" ] + [ "node", "mytool", "{\"format\":\"json\",\"limit\":10,\"$cli\":{\"subcommand\":\"list\"}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -498,7 +476,7 @@ Expecting a STRING""" -- 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", "{\"$cli\":{\"subcommand\":\"list\",\"keywordValues\":{\"format\":\"table\",\"limit\":10}}}" ] + [ "node", "mytool", "{\"format\":\"table\",\"limit\":10,\"$cli\":{\"subcommand\":\"list\"}}" ] "1.0.0" Program.WithoutColor |> Expect.equal diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 7beefae..6542397 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -49,30 +49,17 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--verbose]" ) + [ ( "description", Encode.string (fullDescription "test [--verbose]" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "verbose" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] - ) - ] - ) - ] - ) + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) @@ -90,14 +77,13 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test <file>" ) + [ ( "description", Encode.string (fullDescription "test <file>" True) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -133,14 +119,13 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [<revision>]" ) + [ ( "description", Encode.string (fullDescription "test [<revision>]" True) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -175,14 +160,13 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test <files>..." ) + [ ( "description", Encode.string (fullDescription "test <files>..." True) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "positional" @@ -213,36 +197,18 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--header <HEADER>]..." ) + [ ( "description", Encode.string (fullDescription "test [--header <HEADER>]..." False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "header" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordLists" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments that can be repeated (e.g., --header X --header Y)" ) - , ( "properties" - , Encode.object - [ ( "header" - , Encode.object - [ ( "type", Encode.string "array" ) - , ( "items", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] - ) - ] - ) - ] - ) - ] - ) + [ ( "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" ) ] ) ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) @@ -288,43 +254,21 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --format <json|junit|console>" ) + [ ( "description", Encode.string (fullDescription "test --format <json|junit|console>" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "format" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "format" - , Encode.object - [ ( "type", Encode.string "string" ) - , ( "enum" - , Encode.list Encode.string [ "json", "junit", "console" ] - ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "format" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "format", "$cli" ] ) ] |> Encode.encode 0 ) @@ -341,47 +285,32 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --name <NAME> [--greeting <GREETING>] [--verbose]" ) + [ ( "description", Encode.string (fullDescription "test --name <NAME> [--greeting <GREETING>] [--verbose]" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "name" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) - , ( "greeting", Encode.object [ ( "type", Encode.string "string" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "name" ] ) - ] - ) - , ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] - ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) ] |> Encode.encode 0 ) @@ -396,35 +325,20 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --init" ) + [ ( "description", Encode.string (fullDescription "test --init" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "init" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "init" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "flags" ] ) + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "init", "$cli" ] ) ] |> Encode.encode 0 ) @@ -440,37 +354,26 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --init --force" ) + [ ( "description", Encode.string (fullDescription "test --init --force" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "init" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - , ( "force", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "init", "force" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "flags" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "init", "force", "$cli" ] ) ] |> Encode.encode 0 ) @@ -486,37 +389,26 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test [--verbose] --init" ) + [ ( "description", Encode.string (fullDescription "test [--verbose] --init" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "verbose" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - , ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "init" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "flags" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "init", "$cli" ] ) ] |> Encode.encode 0 ) @@ -542,79 +434,48 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "test --init --name <NAME>" ) + [ ( "description", Encode.string (fullDescription "test --init --name <NAME>" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "init" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "name" ] ) - ] - ) - , ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "init", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "init" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues", "flags" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "init", "name", "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "test --build [--verbose]" ) + [ ( "description", Encode.string (fullDescription "test --build [--verbose]" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "build" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "build", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - , ( "verbose", Encode.object [ ( "type", Encode.string "boolean" ) ] ) - ] - ) - , ( "required", Encode.list Encode.string [ "build" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "flags" ] ) + [ ( "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" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "build", "$cli" ] ) ] ] ) @@ -630,11 +491,11 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test" ) + [ ( "description", Encode.string (fullDescription "test" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ), ( "description", Encode.string "Required CLI input object. Include as empty object {} when no arguments are needed." ) ] ) + [ ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) @@ -654,27 +515,22 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string "test init [--bare]" ) + [ ( "description", Encode.string (fullDescription "test init [--bare]" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "bare" + , Encode.object + [ ( "type", Encode.string "boolean" ) + , ( "x-cli-kind", Encode.string "flag" ) + ] + ) + , ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) - , ( "flags" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Boolean flags, passed as --flag (e.g., --verbose)" ) - , ( "properties" - , Encode.object - [ ( "bare", Encode.object [ ( "type", Encode.string "boolean" ) ] ) ] - ) - ] - ) ] ) , ( "required", Encode.list Encode.string [ "subcommand" ] ) @@ -705,14 +561,13 @@ all = [ ( "anyOf" , Encode.list identity [ Encode.object - [ ( "description", Encode.string "test init" ) + [ ( "description", Encode.string (fullDescription "test init" False) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "init" ) ] ) @@ -726,14 +581,13 @@ all = , ( "required", Encode.list Encode.string [ "$cli" ] ) ] , Encode.object - [ ( "description", Encode.string "test clone <repository>" ) + [ ( "description", Encode.string (fullDescription "test clone <repository>" True) ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) , ( "properties" , Encode.object [ ( "subcommand", Encode.object [ ( "type", Encode.string "string" ), ( "const", Encode.string "clone" ) ] ) @@ -775,7 +629,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"name\":\"World\",\"greeting\":\"Hi\"}}}" ] + [ "node", "test", "{\"name\":\"World\",\"greeting\":\"Hi\",\"$cli\":{}}" ] "1.0.0" Program.WithoutColor ) @@ -791,7 +645,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":{\"verbose\":true},\"keywordValues\":{\"name\":\"World\"}}}" ] + [ "node", "test", "{\"name\":\"World\",\"verbose\":true,\"$cli\":{}}" ] "1.0.0" Program.WithoutColor ) @@ -806,7 +660,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"subcommand\":\"greet\",\"keywordValues\":{\"name\":\"World\"}}}" ] + [ "node", "test", "{\"name\":\"World\",\"$cli\":{\"subcommand\":\"greet\"}}" ] "1.0.0" Program.WithoutColor ) @@ -824,7 +678,7 @@ all = ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"greeting\":\"Hi\"}}}" ] + [ "node", "test", "{\"greeting\":\"Hi\",\"$cli\":{}}" ] "1.0.0" Program.WithoutColor |> Expect.equal @@ -842,7 +696,7 @@ all = ) |> (\cfg -> Program.run cfg - [ "node", "test", "{\"$cli\":{\"keywordValues\":{\"name\":123}}}" ] + [ "node", "test", "{\"name\":123,\"$cli\":{}}" ] "1.0.0" Program.WithoutColor ) @@ -883,7 +737,7 @@ Expecting a STRING""" ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":{\"init\":true},\"keywordValues\":{\"name\":\"my-project\"}}}" ] + [ "node", "test", "{\"init\":true,\"name\":\"my-project\",\"$cli\":{}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch "init:my-project") @@ -913,7 +767,7 @@ Expecting a STRING""" ) in Program.run cfg - [ "node", "test", "{\"$cli\":{\"flags\":{\"build\":true,\"verbose\":true}}}" ] + [ "node", "test", "{\"build\":true,\"verbose\":true,\"$cli\":{}}" ] "1.0.0" Program.WithoutColor |> Expect.equal (Program.CustomMatch "build:verbose") @@ -961,9 +815,30 @@ Expecting a STRING""" ] +{-| 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). Nests keyword args under `$cli.keywordValues`. +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 @@ -974,77 +849,42 @@ expectJsonSchema : -> Expect.Expectation expectJsonSchema { description, properties, required } config = let - keywordValuesObj = - Encode.object - ([ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - (properties - |> List.map (\( name, fields ) -> ( name, Encode.object fields )) - ) - ) - ] - ++ (if List.isEmpty required then - [] - - else - [ ( "required", Encode.list Encode.string required ) ] - ) - ) + topLevelProperties = + properties + |> List.map + (\( name, fields ) -> + let + -- Separate base type fields from description + baseFields = + fields |> List.filter (\( k, _ ) -> k /= "description") - cliSubProperties = - if List.isEmpty properties then - [] - - else - [ ( "keywordValues", keywordValuesObj ) ] - - cliRequired = - if List.isEmpty required then - [] - - else - [ "keywordValues" ] - - cliDescription = - if List.isEmpty cliSubProperties then - "Required CLI input object. Include as empty object {} when no arguments are needed." - - else - "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." + 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" ) - , ( "description", Encode.string cliDescription ) - ] - ++ (if List.isEmpty cliSubProperties then - [] + Encode.object [ ( "type", Encode.string "object" ) ] - else - [ ( "properties", Encode.object cliSubProperties ) ] - ) - ++ (if List.isEmpty cliRequired then - [] + allProperties = + topLevelProperties ++ [ ( "$cli", cliObj ) ] - else - [ ( "required", Encode.list Encode.string cliRequired ) ] - ) - ) + allRequired = + required ++ [ "$cli" ] in config |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string description ) + [ ( "description", Encode.string (fullDescription description False) ) , ( "type", Encode.string "object" ) - , ( "properties" - , Encode.object - [ ( "$cli", cliObj ) ] - ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "properties", Encode.object allProperties ) + , ( "required", Encode.list Encode.string allRequired ) ] |> Encode.encode 0 ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 0de3431..54504c8 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -210,48 +210,35 @@ all = ) ) in + let + 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 - [ ( "description", Encode.string "test --format <json|junit|console>" ) + [ ( "description", Encode.string desc ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "format" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "format" - , Encode.object - [ ( "type", Encode.string "string" ) - , ( "enum" - , Encode.list Encode.string [ "json", "junit", "console" ] - ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "format" ] ) - ] - ) - ] + [ ( "type", Encode.string "string" ) + , ( "enum" + , Encode.list Encode.string [ "json", "junit", "console" ] ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + , ( "x-cli-kind", Encode.string "keyword" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "format", "$cli" ] ) ] |> Encode.encode 0 ) diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 4f63f5c..5dd54d0 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -54,35 +54,20 @@ all = schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --name <NAME>" ) + [ ( "description", Encode.string (schemaDescription "test --name <NAME>") ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "name" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "name", Encode.object [ ( "type", Encode.string "string" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "name" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + [ ( "type", Encode.string "string" ) + , ( "x-cli-kind", Encode.string "keyword" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "name", "$cli" ] ) ] |> Encode.encode 0 ) @@ -128,35 +113,20 @@ all = schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --count <COUNT>" ) + [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "count" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "count", Encode.object [ ( "type", Encode.string "integer" ) ] ) ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + [ ( "type", Encode.string "integer" ) + , ( "x-cli-kind", Encode.string "keyword" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "count", "$cli" ] ) ] |> Encode.encode 0 ) @@ -306,19 +276,13 @@ all = |> Expect.equal (Program.CustomMatch [ "a.txt", "b.txt" ]) ] , describe "JSON input with $cli object" - [ test "keyword list via $cli.keywordLists" <| + [ test "keyword list at top level" <| \() -> let jsonArg = Encode.object - [ ( "$cli" - , Encode.object - [ ( "keywordLists" - , Encode.object - [ ( "header", Encode.list Encode.string [ "X-A: 1", "X-B: 2" ] ) ] - ) - ] - ) + [ ( "header", Encode.list Encode.string [ "X-A: 1", "X-B: 2" ] ) + , ( "$cli", Encode.object [] ) ] |> Encode.encode 0 in @@ -334,7 +298,7 @@ all = Program.WithoutColor ) |> Expect.equal (Program.CustomMatch [ "X-A: 1", "X-B: 2" ]) - , test "keyword list absent in $cli.keywordLists defaults to empty" <| + , test "keyword list absent defaults to empty" <| \() -> let jsonArg = @@ -452,15 +416,13 @@ all = Program.WithoutColor ) |> Expect.equal (Program.CustomMatch [ "x.txt", "y.txt" ]) - , test "flag via $cli.flags" <| + , test "flag at top level" <| \() -> let jsonArg = Encode.object - [ ( "$cli" - , Encode.object - [ ( "flags", Encode.object [ ( "verbose", Encode.bool True ) ] ) ] - ) + [ ( "verbose", Encode.bool True ) + , ( "$cli", Encode.object [] ) ] |> Encode.encode 0 in @@ -476,7 +438,7 @@ all = Program.WithoutColor ) |> Expect.equal (Program.CustomMatch True) - , test "flag absent from $cli.flags defaults to False" <| + , test "flag absent defaults to False" <| \() -> let jsonArg = @@ -501,19 +463,12 @@ all = let jsonArg = Encode.object - [ ( "$cli" + [ ( "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" ] ) - , ( "flags", Encode.object [ ( "verbose", Encode.bool True ) ] ) - , ( "keywordLists" - , Encode.object - [ ( "header", Encode.list Encode.string [ "X-A: 1" ] ) ] - ) - , ( "keywordValues" - , Encode.object - [ ( "limit", Encode.string "10" ) ] - ) - ] + [ ( "positional", Encode.list Encode.string [ "input.txt" ] ) ] ) ] |> Encode.encode 0 @@ -557,41 +512,21 @@ all = ) |> Expect.equal (Encode.object - [ ( "description", Encode.string "test --count <COUNT>" ) + [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli" + [ ( "count" , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "CLI input: contains keywordValues, flags, positional args, and subcommand as applicable." ) - , ( "properties" - , Encode.object - [ ( "keywordValues" - , Encode.object - [ ( "type", Encode.string "object" ) - , ( "description", Encode.string "Keyword arguments with values (e.g., --name <value>)" ) - , ( "properties" - , Encode.object - [ ( "count" - , Encode.object - [ ( "type", Encode.string "integer" ) - , ( "description", Encode.string "Number of items" ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "count" ] ) - ] - ) - ] - ) - , ( "required", Encode.list Encode.string [ "keywordValues" ] ) + [ ( "type", Encode.string "integer" ) + , ( "x-cli-kind", Encode.string "keyword" ) + , ( "description", Encode.string "Number of items" ) ] ) + , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) ] ) - , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "required", Encode.list Encode.string [ "count", "$cli" ] ) ] |> Encode.encode 0 ) @@ -638,11 +573,7 @@ runJsonWith option fields = let jsonArg = Encode.object - [ ( "$cli" - , Encode.object - [ ( "keywordValues", Encode.object fields ) ] - ) - ] + (fields ++ [ ( "$cli", Encode.object [] ) ]) |> Encode.encode 0 in Program.config @@ -669,6 +600,14 @@ schemaFor option = |> 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)." + + expectFailure : Program.RunResult msg -> Expect.Expectation expectFailure result = case result of From ff069337d8b9748cd74ffc579ab0737b221c8248 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 07:09:00 -0700 Subject: [PATCH 16/34] Formatting. --- src/Cli/Program.elm | 37 +++++++++++++++++++------------------ src/Cli/UsageSpec.elm | 5 +---- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index 01a87db..a711ed1 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -432,20 +432,6 @@ 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 - - _ -> - errorMessage - - errorMessage = - "TODO - show error message explaining that user needs to pass unmodified `process.argv` from node here." - -- Check for JSON input mode: a single arg that's JSON with $cli as an object maybeJsonBlob = case argv |> List.drop 2 of @@ -467,6 +453,21 @@ run (Config { optionsParsers }) argv versionMessage colorMode = 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 @@ -729,8 +730,8 @@ parserToJsonSchemaFromTsTypes programName parser = cliSchema = Encode.object - ([ ( "type", Encode.string "object" ) ] - ++ (if List.isEmpty cliSubProperties then + (( "type", Encode.string "object" ) + :: (if List.isEmpty cliSubProperties then [] else @@ -875,8 +876,8 @@ toFlatProperty ( spec, ( optionName, tsType ) ) = stripSchemaKey (TsJson.Type.toJsonSchema tsType) extraFields = - [ ( "x-cli-kind", Encode.string kind ) ] - ++ (case usageSpecDescription spec of + ( "x-cli-kind", Encode.string kind ) + :: (case usageSpecDescription spec of Just desc -> [ ( "description", Encode.string desc ) ] diff --git a/src/Cli/UsageSpec.elm b/src/Cli/UsageSpec.elm index cd62292..0b5c658 100644 --- a/src/Cli/UsageSpec.elm +++ b/src/Cli/UsageSpec.elm @@ -510,11 +510,8 @@ 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 From eab2faed4a23a21ab15f333435b22e2f2830da4b Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 08:40:04 -0700 Subject: [PATCH 17/34] Update elm-ts-json. --- elm.json | 2 +- tests/TsTypeTests.elm | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/elm.json b/elm.json index 16edd40..c556347 100644 --- a/elm.json +++ b/elm.json @@ -14,7 +14,7 @@ ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { - "dillonkearns/elm-ts-json": "2.1.1 <= v < 3.0.0", + "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", diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index 54504c8..fc2f0d2 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -209,8 +209,7 @@ all = ] ) ) - in - let + 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." From 5347ea7bf2b90798c33b1217c1bd9fa045ede510 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 08:54:17 -0700 Subject: [PATCH 18/34] Improve docs. --- elm.json | 2 +- src/Cli/Option.elm | 31 ++++++++++++++++++++--- src/Cli/Option/Typed.elm | 53 ++++++++++++++++++++++++++++++++++----- src/Cli/OptionsParser.elm | 4 +-- 4 files changed, 78 insertions(+), 12 deletions(-) diff --git a/elm.json b/elm.json index c556347..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": [ diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 9d0dc66..3689e4e 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -679,7 +679,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 = @@ -710,7 +717,16 @@ keywordArgList flagName = (Internal.jsonOptionalFieldGrabberWithDefault flagName (Json.Decode.list Json.Decode.string) []) -{-| Note that this must be used with `OptionsParser.withOptionalPositionalArg`. +{-| An optional positional argument. + +Must be used with [`OptionsParser.withOptionalPositionalArg`](Cli-OptionsParser#withOptionalPositionalArg) +(not `OptionsParser.with`). + +Example: `<revision>` in `git log [<revision>]` +Parses to: `Just "abc123"` (or `Nothing` if omitted) + + Option.optionalPositionalArg "revision" + -} optionalPositionalArg : String -> Option (Maybe String) (Maybe String) { position : OptionalPositionalArgOption } optionalPositionalArg operandDescription = @@ -721,7 +737,16 @@ optionalPositionalArg operandDescription = (Internal.jsonOptionalFieldGrabber operandDescription Json.Decode.string) -{-| Note that this must be used with `OptionsParser.withRestArgs`. +{-| 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: `<files>...` in `elm-test [<files>...]` +Parses to: `["tests/First.elm", "tests/Second.elm"]` (or `[]` if none provided) + + Option.restArgs "files" + -} restArgs : String -> Option (List String) (List String) { position : RestArgsOption } restArgs restArgsDescription = diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index d3b6315..8805d69 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -418,42 +418,83 @@ restArgs restArgsDescription = -- Re-exported modifiers -{-| See `Cli.Option.oneOf`. +{-| 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 + + Option.requiredKeywordArg "report" Option.string + |> Option.oneOf + [ ( "json", Json ) + , ( "junit", Junit ) + , ( "console", Console ) + ] + +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 -{-| See `Cli.Option.validateMap`. +{-| 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 -{-| See `Cli.Option.validateMapIfPresent`. +{-| 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 -{-| See `Cli.Option.withDefault`. +{-| 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 -{-| See `Cli.Option.withDescription`. +{-| 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 -{-| See `Cli.Option.withDisplayName`. +{-| Set a custom display name (metavar) for the value placeholder in help text. + + Option.requiredKeywordArg "output-dir" Option.string + |> Option.withDisplayName "PATH" + -- Shows as: --output-dir <PATH> + -} withDisplayName : String -> Option from to builderState -> Option from to builderState withDisplayName = diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index bb1931c..5608f20 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -465,7 +465,7 @@ updateDecoder decoder jsonGrabber (OptionsParser optionsParserRecord) = {-| 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 = @@ -480,7 +480,7 @@ build 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 = From d1d8da18cca31eeb8033fc4efde19e37e02aa0b5 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 09:31:02 -0700 Subject: [PATCH 19/34] Update readme. --- README.md | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 67 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index ac011c2..61b5e5e 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 <author>] [--max-count <max-count>] [--stat] [<revision range> 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/latest/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: From 9fc5decf0d74746f1fded6c0e1442cb1d555b849 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 09:41:20 -0700 Subject: [PATCH 20/34] Add typed options example, update changelog and readme. --- CHANGELOG.md | 25 ++++++++++++++ README.md | 2 +- examples/elm.json | 2 +- examples/src/TypedGreet.elm | 69 +++++++++++++++++++++++++++++++++++++ 4 files changed, 96 insertions(+), 2 deletions(-) create mode 100644 examples/src/TypedGreet.elm diff --git a/CHANGELOG.md b/CHANGELOG.md index 1d9bb65..c750a78 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`, `bool`, and `fromDecoder` 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 <PATH>`). +- `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 61b5e5e..2be54d3 100644 --- a/README.md +++ b/README.md @@ -101,7 +101,7 @@ Note: the `--help` option is a built-in command, so no need to write a `OptionsP ## Typed Options & JSON Schema -The [`Cli.Option.Typed`](https://package.elm-lang.org/packages/dillonkearns/elm-cli-options-parser/latest/Cli-Option-Typed) +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: diff --git a/examples/elm.json b/examples/elm.json index 60b9725..27421e3 100644 --- a/examples/elm.json +++ b/examples/elm.json @@ -7,7 +7,7 @@ "elm-version": "0.19.1", "dependencies": { "direct": { - "dillonkearns/elm-ts-json": "2.1.1", + "dillonkearns/elm-ts-json": "2.1.2", "elm/browser": "1.0.2", "elm/core": "1.0.5", "elm/html": "1.0.1", 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 + } From 4a8275434a86ed42486e418f8d2acbbfcd58babe Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 10:08:31 -0700 Subject: [PATCH 21/34] Export all key parts of API for Typed varation so you only need to import and use that module. --- src/Cli/Option.elm | 26 +++------ src/Cli/Option/Typed.elm | 119 +++++++++++++++++++++++++++++++++++---- 2 files changed, 115 insertions(+), 30 deletions(-) diff --git a/src/Cli/Option.elm b/src/Cli/Option.elm index 3689e4e..0f2a408 100644 --- a/src/Cli/Option.elm +++ b/src/Cli/Option.elm @@ -430,27 +430,15 @@ 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) - - type alias CliOptions = - { pattern : Regex } + Option.requiredKeywordArg "name" + |> Option.map String.toUpper - 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 diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 8805d69..2987965 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,11 +1,14 @@ module Cli.Option.Typed exposing ( Option, CliDecoder + , BeginningOption, OptionalPositionalArgOption, RestArgsOption , string, int, float, bool, fromDecoder , requiredKeywordArg, optionalKeywordArg, keywordArgList , requiredPositionalArg, optionalPositionalArg , flag, restArgs - , oneOf, validateMap, validateMapIfPresent, withDefault - , withDescription, withDisplayName + , oneOf + , validate, validateIfPresent, validateMap, validateMapIfPresent + , map, mapFlag, withDefault + , withDescription, withDisplayName, withMissingMessage ) {-| Typed option constructors with first-class JSON schema support. @@ -62,7 +65,7 @@ Both modules produce the same `Option` type and work with the same This parser handles both CLI and JSON input: - **CLI**: `mytool --name hello --count 3 --verbose` - - **JSON**: `{ "$cli": { "keywordValues": { "name": "hello", "count": 3 }, "flags": { "verbose": true } } }` + - **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.). @@ -71,6 +74,7 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). ## Types @docs Option, CliDecoder +@docs BeginningOption, OptionalPositionalArgOption, RestArgsOption ## Decoders @@ -93,15 +97,24 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). @docs flag, restArgs -## Modifiers +## Mutually Exclusive Values -These work the same as their [`Cli.Option`](Cli-Option) counterparts. Additional -modifiers like [`map`](Cli-Option#map), [`validate`](Cli-Option#validate), -[`mapFlag`](Cli-Option#mapFlag), and [`withMissingMessage`](Cli-Option#withMissingMessage) -can be used by importing them from `Cli.Option`. +@docs oneOf -@docs oneOf, validateMap, validateMapIfPresent, withDefault -@docs withDescription, withDisplayName + +## Validation + +@docs validate, validateIfPresent, validateMap, validateMapIfPresent + + +## Mapping and Defaults + +@docs map, mapFlag, withDefault + + +## Metadata + +@docs withDescription, withDisplayName, withMissingMessage -} @@ -109,17 +122,41 @@ 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 -{-| Re-exported from `Cli.Option` for convenience. See `Cli.Option.Option`. +{-| 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`, `bool` for primitives, or `fromDecoder` for @@ -501,6 +538,66 @@ withDisplayName = Cli.Option.withDisplayName +{-| Add a custom error message for when a required option is missing. + + 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 + +-} +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 + + 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 From c9ba9d202702407bd7225265531d22eec9027d64 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 11:33:34 -0700 Subject: [PATCH 22/34] Update docs. --- src/Cli/Option/Typed.elm | 90 +++++++++++++++++++++++++++++----------- 1 file changed, 65 insertions(+), 25 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 2987965..4129ca9 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -2,42 +2,60 @@ module Cli.Option.Typed exposing ( Option, CliDecoder , BeginningOption, OptionalPositionalArgOption, RestArgsOption , string, int, float, bool, fromDecoder + , requiredPositionalArg , requiredKeywordArg, optionalKeywordArg, keywordArgList - , requiredPositionalArg, optionalPositionalArg - , flag, restArgs + , flag + , optionalPositionalArg, restArgs , oneOf , validate, validateIfPresent, validateMap, validateMapIfPresent , map, mapFlag, withDefault , withDescription, withDisplayName, withMissingMessage ) -{-| Typed option constructors with first-class JSON schema support. - -This module is an alternative to [`Cli.Option`](Cli-Option) for building option parsers. -The key difference: each constructor takes a [`CliDecoder`](#CliDecoder) that specifies the -type of the option's value (string, int, float, etc.). This lets the library: - -1. **Generate JSON schemas** — via [`Program.toJsonSchema`](Cli-Program#toJsonSchema), +{-| Build command-line options as string values, with validation and transformation. + +This is an alternative to [`Cli.Option`](Cli-Option) that is designed to +generate a JSON schema with more precise type information. `Cli.Option` +still gives you types, but [`Cli.Option.Typed.fromDecoder`](#fromDecoder) 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` +when they build [`elm-pages` scripts](https://elm-pages.com/docs/elm-pages-scripts). +When you use [`Script.withSchema`](https://package.elm-lang.org/packages/dillonkearns/elm-pages/latest/Pages-Script#withCliOptions), +you define an [`elm-ts-json` `Encoder`](https://package.elm-lang.org/packages/dillonkearns/elm-ts-json/latest/TsJson-Encode) +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. + +information via [`Program.toJsonSchema`](Cli-Program#toJsonSchema). +. Each constructor takes a +[`CliDecoder`](#CliDecoder) that specifies the type of the option's value +(string, int, float, etc.). This gives you: + +1. **JSON Schema generation** — via [`Program.toJsonSchema`](Cli-Program#toJsonSchema), producing [JSON Schema](https://json-schema.org/) definitions suitable for - [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) `inputSchema`. -2. **Parse JSON input** — the same parser that handles CLI args can also accept structured + [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) `inputSchema` + and [elm-pages script](https://elm-pages.com/docs/elm-pages-scripts) introspection. +2. **JSON input mode** — the same parser that handles CLI args can also accept structured JSON, enabling LLM agents to invoke your CLI tool programmatically. -3. **Validate CLI values** — typed decoders like `int` and `float` automatically validate +3. **CLI validation** — typed decoders like `int` and `float` automatically validate that CLI string arguments are well-formed numbers. +If you don't need JSON schema generation or JSON input, you can use +[`Cli.Option`](Cli-Option) instead — it's simpler (no decoder argument needed) and +treats all values as strings. -## When to use this vs `Cli.Option` +Both modules produce the same `Option` type and work with the same +[`OptionsParser.with`](Cli-OptionsParser#with) pipeline, so they can be mixed freely. -Use **`Cli.Option.Typed`** when you want JSON schema generation — for example, when -building [elm-pages scripts](https://elm-pages.com/docs/elm-pages-scripts) that can be -introspected as tools, or any CLI that needs to be invocable via structured JSON. +Here is the terminology used for building up Command-Line parsers with this library. -Use **[`Cli.Option`](Cli-Option)** 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. +![Terminology Legend](https://raw.githubusercontent.com/dillonkearns/elm-cli-options-parser/master/terminology.png) -Both modules produce the same `Option` type and work with the same -[`OptionsParser.with`](Cli-OptionsParser#with) pipeline. +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 @@ -82,19 +100,28 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). @docs string, int, float, bool, fromDecoder +## Positional Arguments + +@docs requiredPositionalArg + + ## Keyword Arguments @docs requiredKeywordArg, optionalKeywordArg, keywordArgList -## Positional Arguments +## Flags + +@docs flag -@docs requiredPositionalArg, optionalPositionalArg +## Ending Options -## Flags and Rest Args +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 flag, restArgs +@docs optionalPositionalArg, restArgs ## Mutually Exclusive Values @@ -104,6 +131,19 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). ## 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. + +See [`Cli.Validate`](Cli-Validate) for some validation helpers that can be used +in conjunction with the following functions. + @docs validate, validateIfPresent, validateMap, validateMapIfPresent From 81eaa0e8a7342f5d55e046b2e06067799291eb5b Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 12:14:05 -0700 Subject: [PATCH 23/34] Update docs. --- src/Cli/Option/Typed.elm | 42 +++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 4129ca9..ba65caa 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -12,43 +12,41 @@ module Cli.Option.Typed exposing , withDescription, withDisplayName, withMissingMessage ) -{-| Build command-line options as string values, with validation and transformation. +{-| 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 with more precise type information. `Cli.Option` -still gives you types, but [`Cli.Option.Typed.fromDecoder`](#fromDecoder) lets you pass in an +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.fromDecoder`](#fromDecoder) 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` +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 use [`Script.withSchema`](https://package.elm-lang.org/packages/dillonkearns/elm-pages/latest/Pages-Script#withCliOptions), -you define an [`elm-ts-json` `Encoder`](https://package.elm-lang.org/packages/dillonkearns/elm-ts-json/latest/TsJson-Encode) +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. -information via [`Program.toJsonSchema`](Cli-Program#toJsonSchema). -. Each constructor takes a -[`CliDecoder`](#CliDecoder) that specifies the type of the option's value -(string, int, float, etc.). This gives you: -1. **JSON Schema generation** — via [`Program.toJsonSchema`](Cli-Program#toJsonSchema), - producing [JSON Schema](https://json-schema.org/) definitions suitable for - [MCP tool](https://modelcontextprotocol.io/specification/draft/server/tools) `inputSchema` - and [elm-pages script](https://elm-pages.com/docs/elm-pages-scripts) introspection. -2. **JSON input mode** — the same parser that handles CLI args can also accept structured - JSON, enabling LLM agents to invoke your CLI tool programmatically. -3. **CLI validation** — typed decoders like `int` and `float` automatically validate - that CLI string arguments are well-formed numbers. +## When to Use `Cli.Option.Typed` -If you don't need JSON schema generation or JSON input, you can use -[`Cli.Option`](Cli-Option) instead — it's simpler (no decoder argument needed) and -treats all values as strings. +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 make 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 mixed freely. +[`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. From a831c7abb462b7ecdc346e9b3768d0eef1590625 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 12:45:54 -0700 Subject: [PATCH 24/34] Update docs. --- src/Cli/Option/Typed.elm | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index ba65caa..09a1ddf 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,6 +1,5 @@ module Cli.Option.Typed exposing ( Option, CliDecoder - , BeginningOption, OptionalPositionalArgOption, RestArgsOption , string, int, float, bool, fromDecoder , requiredPositionalArg , requiredKeywordArg, optionalKeywordArg, keywordArgList @@ -9,6 +8,7 @@ module Cli.Option.Typed exposing , oneOf , validate, validateIfPresent, validateMap, validateMapIfPresent , map, mapFlag, withDefault + , BeginningOption, OptionalPositionalArgOption, RestArgsOption , withDescription, withDisplayName, withMissingMessage ) @@ -37,7 +37,7 @@ All CLIs built with `elm-cli-options-parser` can be invoked either with traditio 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 make be invoked programmatically or by LLM agents. +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. @@ -73,9 +73,20 @@ folder for end-to-end examples (including `TypedGreet.elm` which uses this modul Program.config |> Program.add (OptionsParser.build Options - |> with (Option.requiredKeywordArg "name" Option.string) - |> with (Option.requiredKeywordArg "count" Option.int) - |> with (Option.flag "verbose") + |> with + (Option.requiredKeywordArg + "name" + Option.string + ) + |> with + (Option.requiredKeywordArg + "count" + Option.int + ) + |> with + (Option.flag + "verbose" + ) ) This parser handles both CLI and JSON input: @@ -90,7 +101,6 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). ## Types @docs Option, CliDecoder -@docs BeginningOption, OptionalPositionalArgOption, RestArgsOption ## Decoders @@ -150,6 +160,11 @@ in conjunction with the following functions. @docs map, mapFlag, withDefault +## Builder Position Types + +@docs BeginningOption, OptionalPositionalArgOption, RestArgsOption + + ## Metadata @docs withDescription, withDisplayName, withMissingMessage From 7927803b030d2c12843159736f66e5074154e458 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 12:54:46 -0700 Subject: [PATCH 25/34] Rename function. --- CHANGELOG.md | 2 +- src/Cli/Option/Typed.elm | 20 ++++++++++---------- tests/TypedOptionTests.elm | 14 +++++++------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c750a78..72468dc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,7 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0. - **`Cli.Option.Typed` module** — new option constructors that take a `CliDecoder` for typed CLI parsing and JSON schema generation. Includes `string`, `int`, - `float`, `bool`, and `fromDecoder` for custom types. + `float`, `bool`, 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) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 09a1ddf..2dc67f2 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,6 +1,6 @@ module Cli.Option.Typed exposing ( Option, CliDecoder - , string, int, float, bool, fromDecoder + , string, int, float, bool, customDecoder , requiredPositionalArg , requiredKeywordArg, optionalKeywordArg, keywordArgList , flag @@ -16,7 +16,7 @@ module Cli.Option.Typed exposing 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.fromDecoder`](#fromDecoder) lets you pass in an +`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` @@ -105,7 +105,7 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). ## Decoders -@docs string, int, float, bool, fromDecoder +@docs string, int, float, bool, customDecoder ## Positional Arguments @@ -212,7 +212,7 @@ type alias RestArgsOption = {-| A decoder that knows how to parse values from both CLI args and JSON input. -Use `string`, `int`, `float`, `bool` for primitives, or `fromDecoder` for +Use `string`, `int`, `float`, `bool` for primitives, or `customDecoder` for custom types (objects, arrays, etc.) where the CLI input is a JSON string. -} @@ -255,7 +255,7 @@ In JSON mode, a JSON integer field is decoded. -} int : CliDecoder Int int = - fromDecoder TsDecode.int + customDecoder TsDecode.int {-| A float value. In CLI mode, the string is parsed as a JSON number. @@ -268,7 +268,7 @@ In JSON mode, a JSON number field is decoded. -} float : CliDecoder Float float = - fromDecoder TsDecode.float + customDecoder TsDecode.float {-| A boolean value. In CLI mode, the string is parsed as a JSON boolean. @@ -283,7 +283,7 @@ Note: for flags (present/absent), use `flag` instead. -} bool : CliDecoder Bool bool = - fromDecoder TsDecode.bool + customDecoder TsDecode.bool {-| Create a `CliDecoder` from a `TsDecode.Decoder`. In CLI mode, the string @@ -299,13 +299,13 @@ If you want bare string values, use `string` instead. |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) - Option.requiredKeywordArg "point" (Option.fromDecoder pointDecoder) + Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder) -- CLI: --point '{"x":1,"y":2}' -- JSON: {"point": {"x": 1, "y": 2}} -} -fromDecoder : TsDecode.Decoder value -> CliDecoder value -fromDecoder tsDecoder = +customDecoder : TsDecode.Decoder value -> CliDecoder value +customDecoder tsDecoder = CliDecoder { cliParser = decodeCliJson (TsDecode.decoder tsDecoder) , jsonDecoder = TsDecode.decoder tsDecoder diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 5dd54d0..f807c8e 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -165,7 +165,7 @@ all = [ "--dry", "abc" ] |> expectFailure ] - , describe "fromDecoder" + , describe "customDecoder" [ test "custom decoder works in JSON mode" <| \() -> let @@ -174,7 +174,7 @@ all = |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) in - runJsonWith (Option.requiredKeywordArg "point" (Option.fromDecoder pointDecoder)) + 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" <| @@ -185,19 +185,19 @@ all = |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) in - runWith (Option.requiredKeywordArg "point" (Option.fromDecoder pointDecoder)) + runWith (Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder)) [ "--point", "{\"x\":1,\"y\":2}" ] |> Expect.equal (Program.CustomMatch ( 1, 2 )) - , test "fromDecoder TsDecode.string in CLI mode requires JSON-quoted string" <| + , 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.fromDecoder TsDecode.string)) + runWith (Option.requiredKeywordArg "name" (Option.customDecoder TsDecode.string)) [ "--name", "hello" ] |> expectFailure - , test "fromDecoder TsDecode.string in CLI mode accepts JSON-quoted string" <| + , test "customDecoder TsDecode.string in CLI mode accepts JSON-quoted string" <| \() -> -- JSON string: "hello" (with quotes on CLI) - runWith (Option.requiredKeywordArg "name" (Option.fromDecoder TsDecode.string)) + runWith (Option.requiredKeywordArg "name" (Option.customDecoder TsDecode.string)) [ "--name", "\"hello\"" ] |> Expect.equal (Program.CustomMatch "hello") ] From 216d7c78ebfcbc60f314d29552de2864effd15fd Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 13:07:46 -0700 Subject: [PATCH 26/34] Remove the bool CLI optiosn decoder, it isn't necessary because we have flags. --- CHANGELOG.md | 2 +- src/Cli/Option/Typed.elm | 35 ++++++++++++----------------------- tests/TypedOptionTests.elm | 17 ----------------- 3 files changed, 13 insertions(+), 41 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 72468dc..03f1a29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,7 +13,7 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0. - **`Cli.Option.Typed` module** — new option constructors that take a `CliDecoder` for typed CLI parsing and JSON schema generation. Includes `string`, `int`, - `float`, `bool`, and `customDecoder` for custom types. + `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) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 2dc67f2..020acf8 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -1,6 +1,6 @@ module Cli.Option.Typed exposing ( Option, CliDecoder - , string, int, float, bool, customDecoder + , string, int, float, customDecoder , requiredPositionalArg , requiredKeywordArg, optionalKeywordArg, keywordArgList , flag @@ -105,7 +105,7 @@ proper types (`"type": "string"`, `"type": "integer"`, etc.). ## Decoders -@docs string, int, float, bool, customDecoder +@docs string, int, float, customDecoder ## Positional Arguments @@ -212,7 +212,7 @@ type alias RestArgsOption = {-| A decoder that knows how to parse values from both CLI args and JSON input. -Use `string`, `int`, `float`, `bool` for primitives, or `customDecoder` for +Use `string`, `int`, `float` for primitives, or `customDecoder` for custom types (objects, arrays, etc.) where the CLI input is a JSON string. -} @@ -271,33 +271,22 @@ float = customDecoder TsDecode.float -{-| A boolean value. In CLI mode, the string is parsed as a JSON boolean. -In JSON mode, a JSON boolean field is decoded. - -Note: for flags (present/absent), use `flag` instead. - - Option.requiredKeywordArg "dry-run" Option.bool - -- CLI: --dry-run true → True - -- JSON: {"dry-run": true} → True - --} -bool : CliDecoder Bool -bool = - customDecoder TsDecode.bool - - -{-| Create a `CliDecoder` from a `TsDecode.Decoder`. In CLI mode, the string -value is parsed as strict JSON. This means the CLI user must pass valid JSON. +{-| 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` instead. +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.succeed (\x y -> { x = x, y = y }) - |> TsDecode.andMap (TsDecode.field "x" TsDecode.int) - |> TsDecode.andMap (TsDecode.field "y" TsDecode.int) + |> TsDecode.andMap (TsDecode.field "x" + TsDecode.int) + |> TsDecode.andMap (TsDecode.field "y" + TsDecode.int) Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder) -- CLI: --point '{"x":1,"y":2}' diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index f807c8e..2b6aee1 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -148,23 +148,6 @@ all = [ "--rate", "abc" ] |> expectFailure ] - , describe "Option.bool" - [ test "parses 'true'" <| - \() -> - runWith (Option.requiredKeywordArg "dry" Option.bool) - [ "--dry", "true" ] - |> Expect.equal (Program.CustomMatch True) - , test "parses 'false'" <| - \() -> - runWith (Option.requiredKeywordArg "dry" Option.bool) - [ "--dry", "false" ] - |> Expect.equal (Program.CustomMatch False) - , test "rejects bare text" <| - \() -> - runWith (Option.requiredKeywordArg "dry" Option.bool) - [ "--dry", "abc" ] - |> expectFailure - ] , describe "customDecoder" [ test "custom decoder works in JSON mode" <| \() -> From 786e0945602ce7fa1dc747a3370cb62d38c547fa Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 13:10:18 -0700 Subject: [PATCH 27/34] Update docs. --- src/Cli/Option/Typed.elm | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 020acf8..2a02319 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -281,14 +281,16 @@ If you want bare string values, use [`string`](#string) instead. 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) + |> 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) - Option.requiredKeywordArg "point" (Option.customDecoder pointDecoder) -- CLI: --point '{"x":1,"y":2}' -- JSON: {"point": {"x": 1, "y": 2}} @@ -505,12 +507,14 @@ string values, each mapped to an Elm value. | Junit | Console - Option.requiredKeywordArg "report" Option.string - |> Option.oneOf - [ ( "json", Json ) - , ( "junit", Junit ) - , ( "console", Console ) - ] + reportOption : Option String ReportFormat { position : BeginningOption, canAddMissingMessage : () } + reportOption = + Option.requiredKeywordArg "report" Option.string + |> Option.oneOf + [ ( "json", Json ) + , ( "junit", Junit ) + , ( "console", Console ) + ] The JSON schema will include an `enum` constraint with the allowed values. @@ -610,8 +614,10 @@ map = = Quiet | Verbose - Option.flag "verbose" - |> Option.mapFlag { present = Verbose, absent = Quiet } + 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 From d11faeb086bc74d4bdd6062f5b672798f8c381dd Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 13:19:57 -0700 Subject: [PATCH 28/34] Pull in relevant docs from Cli.Option for Typed version. --- src/Cli/Option/Typed.elm | 95 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 86 insertions(+), 9 deletions(-) diff --git a/src/Cli/Option/Typed.elm b/src/Cli/Option/Typed.elm index 2a02319..dc0deb3 100644 --- a/src/Cli/Option/Typed.elm +++ b/src/Cli/Option/Typed.elm @@ -149,6 +149,35 @@ 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. @@ -308,7 +337,9 @@ customDecoder tsDecoder = -- Constructors -{-| A required keyword argument with a typed decoder. +{-| A keyword argument that must be provided. + +Example: `--name my-app` or `--name=my-app` Option.requiredKeywordArg "count" Option.int -- CLI: --count 42 → 42 @@ -334,7 +365,9 @@ requiredKeywordArg optionName (CliDecoder decoder) = } -{-| An optional keyword argument with a typed decoder. +{-| 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 @@ -364,7 +397,9 @@ optionalKeywordArg optionName (CliDecoder decoder) = } -{-| A repeated keyword argument with a typed decoder for each value. +{-| 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"] @@ -402,7 +437,9 @@ keywordArgList flagName (CliDecoder decoder) = } -{-| A required positional argument with a typed decoder. +{-| 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 @@ -429,8 +466,13 @@ requiredPositionalArg operandDescription (CliDecoder decoder) = } -{-| An optional positional argument with a typed decoder. -Must be used with `OptionsParser.withOptionalPositionalArg`. +{-| An optional positional argument. + +Must be used with [`OptionsParser.withOptionalPositionalArg`](Cli-OptionsParser#withOptionalPositionalArg) +(not `OptionsParser.with`). + +Example: `<revision>` in `git log [<revision>]` +Parses to: `Just "abc123"` (or `Nothing` if omitted) Option.optionalPositionalArg "revision" Option.string @@ -458,7 +500,9 @@ optionalPositionalArg operandDescription (CliDecoder decoder) = } -{-| A boolean flag. Always `Bool` — no decoder needed. +{-| A flag with no argument. Always `Bool` — no decoder needed. + +Example: `--debug` in `elm make --debug` Option.flag "verbose" -- CLI: --verbose → True, omitted → False @@ -477,7 +521,13 @@ flag flagName = } -{-| Collect all remaining positional arguments. Must be used with `OptionsParser.withRestArgs`. +{-| 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: `<files>...` in `elm-test [<files>...]` +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"] @@ -516,6 +566,24 @@ string values, each mapped to an Elm value. , ( "console", Console ) ] +The help text will show the allowed values: + +```shell +$ ./elm-test --help +elm-test [--report <json|junit|console>] <TESTFILES>... +``` + +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. -} @@ -572,7 +640,11 @@ withDescription = Cli.Option.withDescription -{-| Set a custom display name (metavar) for the value placeholder in help text. +{-| 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 <OUTPUT_DIR>`). +Use this to provide a more descriptive placeholder. Option.requiredKeywordArg "output-dir" Option.string |> Option.withDisplayName "PATH" @@ -586,6 +658,8 @@ 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." @@ -602,6 +676,9 @@ 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 = From d4a210568151bb040cccdb5fde64dcda367288a7 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 13:43:10 -0700 Subject: [PATCH 29/34] Mark positional property as required in json schema. --- src/Cli/Program.elm | 13 ++++++++++++- tests/ExperienceTests.elm | 3 ++- tests/JsonSchemaTests.elm | 3 ++- 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index a711ed1..f8c97ac 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -720,13 +720,24 @@ parserToJsonSchemaFromTsTypes programName parser = cliSubProperties = subCommandProp ++ positionalSchemaProperty positionalSpecs restArgSpec + hasRequiredPositionalArgs = + positionalSpecs + |> List.any (\( _, _, occurences ) -> occurences == Required) + cliRequired = - case OptionsParser.getSubCommand parser of + (case OptionsParser.getSubCommand parser of Just _ -> [ "subcommand" ] Nothing -> [] + ) + ++ (if hasRequiredPositionalArgs then + [ "positional" ] + + else + [] + ) cliSchema = Encode.object diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 1f0c82e..6e94cfd 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -236,7 +236,8 @@ all = } }, "required": [ - "subcommand" + "subcommand", + "positional" ] } }, diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 6542397..c4c9157 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -100,6 +100,7 @@ all = ) ] ) + , ( "required", Encode.list Encode.string [ "positional" ] ) ] ) ] @@ -605,7 +606,7 @@ all = ) ] ) - , ( "required", Encode.list Encode.string [ "subcommand" ] ) + , ( "required", Encode.list Encode.string [ "subcommand", "positional" ] ) ] ) ] From fca70b6576979b2b24d22312f9d5f3d833c9ee94 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 14:00:39 -0700 Subject: [PATCH 30/34] Add additionalProperties: false in schema to make it clear that unrecognized properties are rejected in JSON mode and CLI mode. --- src/Cli/Program.elm | 7 +- tests/ExperienceTests.elm | 12 +++- tests/JsonSchemaTests.elm | 132 +++++++++++++++++++++++++++++++++---- tests/TsTypeTests.elm | 8 ++- tests/TypedOptionTests.elm | 24 ++++++- 5 files changed, 163 insertions(+), 20 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index f8c97ac..3484459 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -741,8 +741,10 @@ parserToJsonSchemaFromTsTypes programName parser = cliSchema = Encode.object - (( "type", Encode.string "object" ) - :: (if List.isEmpty cliSubProperties then + ([ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ++ (if List.isEmpty cliSubProperties then [] else @@ -772,6 +774,7 @@ parserToJsonSchemaFromTsTypes programName parser = , ( "type", Encode.string "object" ) , ( "properties", Encode.object allProperties ) , ( "required", Encode.list Encode.string allRequired ) + , ( "additionalProperties", Encode.bool False ) ] diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 6e94cfd..838b5ca 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -152,6 +152,7 @@ all = }, "$cli": { "type": "object", + "additionalProperties": false, "properties": { "subcommand": { "type": "string", @@ -167,7 +168,8 @@ all = "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).", @@ -195,6 +197,7 @@ all = }, "$cli": { "type": "object", + "additionalProperties": false, "properties": { "subcommand": { "type": "string", @@ -209,7 +212,8 @@ all = "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.", @@ -217,6 +221,7 @@ all = "properties": { "$cli": { "type": "object", + "additionalProperties": false, "properties": { "subcommand": { "type": "string", @@ -243,7 +248,8 @@ all = }, "required": [ "$cli" - ] + ], + "additionalProperties": false } ] }""" diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index c4c9157..afeec8a 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -25,6 +25,40 @@ all = [ ( "name", [ ( "type", Encode.string "string" ) ] ) ] , required = [ "name" ] } + , 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 + (Encode.object + [ ( "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 @@ -59,10 +93,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "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 ) @@ -84,6 +124,7 @@ all = [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) , ( "properties" , Encode.object [ ( "positional" @@ -106,6 +147,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] |> Encode.encode 0 ) @@ -127,6 +169,7 @@ all = [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) , ( "properties" , Encode.object [ ( "positional" @@ -147,6 +190,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] |> Encode.encode 0 ) @@ -168,6 +212,7 @@ all = [ ( "$cli" , Encode.object [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) , ( "properties" , Encode.object [ ( "positional" @@ -184,6 +229,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] |> Encode.encode 0 ) @@ -209,10 +255,16 @@ all = , ( "x-cli-kind", Encode.string "keyword-list" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "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 ) @@ -266,10 +318,16 @@ all = , ( "x-cli-kind", Encode.string "keyword" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -308,10 +366,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -336,10 +400,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -371,10 +441,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -406,10 +482,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -451,10 +533,16 @@ all = , ( "x-cli-kind", Encode.string "keyword" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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) ) @@ -473,10 +561,16 @@ all = , ( "x-cli-kind", Encode.string "flag" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$cli" + , Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] + ) ] ) , ( "required", Encode.list Encode.string [ "build", "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] ] ) @@ -496,10 +590,16 @@ all = , ( "type", Encode.string "object" ) , ( "properties" , Encode.object - [ ( "$cli", Encode.object [ ( "type", Encode.string "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 ) @@ -529,6 +629,7 @@ all = , ( "$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" ) ] ) @@ -540,6 +641,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] |> Encode.encode 0 ) @@ -569,6 +671,7 @@ all = [ ( "$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" ) ] ) @@ -580,6 +683,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] , Encode.object [ ( "description", Encode.string (fullDescription "test clone <repository>" True) ) @@ -589,6 +693,7 @@ all = [ ( "$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" ) ] ) @@ -612,6 +717,7 @@ all = ] ) , ( "required", Encode.list Encode.string [ "$cli" ] ) + , ( "additionalProperties", Encode.bool False ) ] ] ) @@ -869,7 +975,10 @@ expectJsonSchema { description, properties, required } config = ) cliObj = - Encode.object [ ( "type", Encode.string "object" ) ] + Encode.object + [ ( "type", Encode.string "object" ) + , ( "additionalProperties", Encode.bool False ) + ] allProperties = topLevelProperties ++ [ ( "$cli", cliObj ) ] @@ -886,6 +995,7 @@ expectJsonSchema { description, properties, required } config = , ( "type", Encode.string "object" ) , ( "properties", Encode.object allProperties ) , ( "required", Encode.list Encode.string allRequired ) + , ( "additionalProperties", Encode.bool False ) ] |> Encode.encode 0 ) diff --git a/tests/TsTypeTests.elm b/tests/TsTypeTests.elm index fc2f0d2..4c9cd49 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -234,10 +234,16 @@ all = , ( "x-cli-kind", Encode.string "keyword" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 index 2b6aee1..5422fa7 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -64,10 +64,16 @@ all = , ( "x-cli-kind", Encode.string "keyword" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -123,10 +129,16 @@ all = , ( "x-cli-kind", Encode.string "keyword" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) @@ -506,10 +518,16 @@ all = , ( "description", Encode.string "Number of items" ) ] ) - , ( "$cli", Encode.object [ ( "type", Encode.string "object" ) ] ) + , ( "$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 ) From f3e2c78975d57990321f85569fcd99a9e9ccea8a Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 14:15:27 -0700 Subject: [PATCH 31/34] Reject unknown fields in JSON mode to give clear error feedback (mirrors CLI options parsing behavior). --- src/Cli/LowLevel.elm | 134 +++++++++++++++---------------- src/Cli/OptionsParser.elm | 160 +++++++++++++++++++++++++++++++++----- src/Cli/Program.elm | 41 ++++++++-- tests/JsonSchemaTests.elm | 74 ++++++++++++++++++ 4 files changed, 309 insertions(+), 100 deletions(-) diff --git a/src/Cli/LowLevel.elm b/src/Cli/LowLevel.elm index 21fa7d2..8e8f59c 100644 --- a/src/Cli/LowLevel.elm +++ b/src/Cli/LowLevel.elm @@ -89,65 +89,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 @@ -227,6 +169,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 @@ -293,16 +296,5 @@ tryJson optionsParsers blob = ValidationErrors validationErrors Nothing -> - NoMatch - (matchResults - |> List.concatMap - (\matchResult -> - case matchResult of - MatchResult.NoMatch reasons -> - reasons - - _ -> - [] - ) - ) + NoMatch (aggregateNoMatchReasons matchResults) ) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index 5608f20..42d5985 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -299,30 +299,35 @@ 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 }) = - let - normalizedBlob = - normalizeCliJson usageSpecs blob - in - case jsonGrabber normalizedBlob of - Err error -> - case error of - Cli.Decode.MatchError matchErrorDetail -> - Cli.OptionsParser.MatchResult.NoMatch - [ matchErrorDetailToNoMatchReason matchErrorDetail ] +tryMatchJson blob (OptionsParser { jsonGrabber, usageSpecs, subCommand }) = + case rawJsonShapeErrors subCommand usageSpecs blob of + [] -> + let + normalizedBlob = + normalizeCliJson usageSpecs blob + in + case jsonGrabber normalizedBlob 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.UnrecoverableValidationError validationError -> - Cli.OptionsParser.MatchResult.Match (Err [ validationError ]) + Cli.Decode.UnexpectedOptions unexpectedOptions -> + Cli.OptionsParser.MatchResult.NoMatch + (List.map Cli.OptionsParser.MatchResult.UnexpectedOption unexpectedOptions) - Cli.Decode.UnexpectedOptions unexpectedOptions -> - Cli.OptionsParser.MatchResult.NoMatch - (List.map Cli.OptionsParser.MatchResult.UnexpectedOption unexpectedOptions) + Ok ( [], value ) -> + Cli.OptionsParser.MatchResult.Match (Ok value) - Ok ( [], value ) -> - Cli.OptionsParser.MatchResult.Match (Ok value) + Ok ( validationErrors, _ ) -> + Cli.OptionsParser.MatchResult.Match (Err validationErrors) - Ok ( validationErrors, _ ) -> - Cli.OptionsParser.MatchResult.Match (Err validationErrors) + shapeErrors -> + Cli.OptionsParser.MatchResult.NoMatch shapeErrors {-| Convert internal MatchErrorDetail to public NoMatchReason. @@ -375,7 +380,8 @@ expectedPositionalArgCountOrFail (OptionsParser ({ decoder, usageSpecs } as opti else decoder stuff - -- jsonGrabber unchanged — extra operand check is CLI-only + -- jsonGrabber unchanged — JSON mode checks extra positional args + -- in rawJsonShapeErrors before normalization } @@ -857,3 +863,115 @@ normalizeCliJson usageSpecs blob = ) 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 ++ extraJsonPositionalErrors usageSpecs cliValue + + +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 -> Maybe Json.Decode.Value -> List Cli.OptionsParser.MatchResult.NoMatchReason +extraJsonPositionalErrors usageSpecs maybeCliValue = + if UsageSpec.hasRestArgs usageSpecs || not (hasJsonPositionalInput usageSpecs) then + [] + + else + case maybeCliValue of + Just cliValue -> + case Json.Decode.decodeValue (Json.Decode.field "positional" (Json.Decode.list Json.Decode.value)) cliValue of + Ok positionalValues -> + if List.length positionalValues > List.length (List.filter UsageSpec.isOperand usageSpecs) then + [ Cli.OptionsParser.MatchResult.ExtraOperand ] + + else + [] + + 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/src/Cli/Program.elm b/src/Cli/Program.elm index 3484459..d11dc4e 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -1221,24 +1221,49 @@ formatFallbackMessage colorMode programName optionsParsers = formatJsonNoMatchReasons : List NoMatchReason -> String formatJsonNoMatchReasons reasons = let - missingFieldReasons = + unexpectedFieldReasons = reasons |> List.filterMap (\reason -> case reason of - MissingRequiredKeywordArg { name } -> - Just ("Missing required field: \"" ++ name ++ "\"") - - MissingRequiredPositionalArg { name } -> - Just ("Missing required field: \"" ++ name ++ "\"") + UnexpectedOption name -> + Just ("Unexpected field: \"" ++ name ++ "\"") _ -> Nothing ) in - case missingFieldReasons of + case unexpectedFieldReasons of first :: _ -> first [] -> - "No matching command found for JSON input." + 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/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index afeec8a..057ebce 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -818,6 +818,80 @@ Problem with the value at json.name: 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 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 From 5323cf39f2c0df056cb072d67c66cc596527b936 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 14:31:40 -0700 Subject: [PATCH 32/34] Show decoding errors at the initial failure level for clarity (like showing expected list instead of missing value). --- src/Cli/OptionsParser.elm | 195 +++++++++++++++++++++++++++++++------- tests/JsonSchemaTests.elm | 72 ++++++++++++++ 2 files changed, 231 insertions(+), 36 deletions(-) diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index 42d5985..13adcdb 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -300,34 +300,66 @@ 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 }) = - case rawJsonShapeErrors subCommand usageSpecs blob of + 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 - normalizedBlob = - normalizeCliJson usageSpecs blob + unexpectedShapeErrors = + rawJsonShapeErrors subCommand usageSpecs blob + + positionalCountErrors = + extraJsonPositionalErrors usageSpecs blob baseMatchResult in - case jsonGrabber normalizedBlob of - Err error -> - case error of - Cli.Decode.MatchError matchErrorDetail -> - Cli.OptionsParser.MatchResult.NoMatch - [ matchErrorDetailToNoMatchReason matchErrorDetail ] + case baseMatchResult of + Cli.OptionsParser.MatchResult.Match _ -> + if List.isEmpty unexpectedShapeErrors && List.isEmpty positionalCountErrors then + baseMatchResult - Cli.Decode.UnrecoverableValidationError validationError -> - Cli.OptionsParser.MatchResult.Match (Err [ validationError ]) + else + Cli.OptionsParser.MatchResult.NoMatch (unexpectedShapeErrors ++ positionalCountErrors) - Cli.Decode.UnexpectedOptions unexpectedOptions -> - Cli.OptionsParser.MatchResult.NoMatch - (List.map Cli.OptionsParser.MatchResult.UnexpectedOption unexpectedOptions) + Cli.OptionsParser.MatchResult.NoMatch reasons -> + Cli.OptionsParser.MatchResult.NoMatch + (unexpectedShapeErrors ++ positionalCountErrors ++ reasons) - Ok ( [], value ) -> - Cli.OptionsParser.MatchResult.Match (Ok value) - Ok ( validationErrors, _ ) -> - Cli.OptionsParser.MatchResult.Match (Err validationErrors) +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 ] - shapeErrors -> - Cli.OptionsParser.MatchResult.NoMatch shapeErrors + 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) {-| Convert internal MatchErrorDetail to public NoMatchReason. @@ -892,7 +924,7 @@ rawJsonShapeErrors subCommand usageSpecs blob = Nothing -> [] in - unexpectedTopLevelFields ++ unexpectedCliFields ++ extraJsonPositionalErrors usageSpecs cliValue + unexpectedTopLevelFields ++ unexpectedCliFields allowedTopLevelFieldNames : List UsageSpec -> List String @@ -948,29 +980,120 @@ hasJsonPositionalInput usageSpecs = ) -extraJsonPositionalErrors : List UsageSpec -> Maybe Json.Decode.Value -> List Cli.OptionsParser.MatchResult.NoMatchReason -extraJsonPositionalErrors usageSpecs maybeCliValue = - if UsageSpec.hasRestArgs usageSpecs || not (hasJsonPositionalInput usageSpecs) then +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 maybeCliValue of - Just cliValue -> - case Json.Decode.decodeValue (Json.Decode.field "positional" (Json.Decode.list Json.Decode.value)) cliValue of - Ok positionalValues -> - if List.length positionalValues > List.length (List.filter UsageSpec.isOperand usageSpecs) then - [ Cli.OptionsParser.MatchResult.ExtraOperand ] + 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 _ -> - [] + else + [] - Nothing -> + 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 diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 057ebce..00faaa5 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -852,6 +852,78 @@ Expecting a STRING""" (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 From d301386f4dce37a2df05c19ad1dddfbebe1a0911 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 15:24:27 -0700 Subject: [PATCH 33/34] Use draft 07 json schema. --- src/Cli/Program.elm | 114 ++++++++++++++++++------------- tests/ExperienceTests.elm | 5 +- tests/JsonSchemaTests.elm | 134 +++++++++++++++++++++++++++++++------ tests/TsTypeTests.elm | 3 +- tests/TypedOptionTests.elm | 14 +++- 5 files changed, 197 insertions(+), 73 deletions(-) diff --git a/src/Cli/Program.elm b/src/Cli/Program.elm index d11dc4e..530be63 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -635,16 +635,20 @@ for JSON input mode. -} toJsonSchema : String -> Config msg -> Encode.Value toJsonSchema programName (Config { optionsParsers }) = - case optionsParsers of - [ singleParser ] -> - parserToJsonSchemaFromTsTypes programName singleParser - - multipleParsers -> - Encode.object - [ ( "anyOf" - , Encode.list (parserToJsonSchemaFromTsTypes programName) multipleParsers - ) - ] + 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 @@ -787,7 +791,7 @@ positionalSchemaProperty positionalArgs maybeRestArgs = else let - prefixItemsList = + fixedItemSchemas = positionalArgs |> List.map (\( spec, tsType, _ ) -> @@ -811,48 +815,54 @@ positionalSchemaProperty positionalArgs maybeRestArgs = |> 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 = - case maybeRestArgs of - Just ( spec, tsType ) -> - let - arraySchema = - stripSchemaKey (TsJson.Type.toJsonSchema tsType) - in - -- Extract items from the array type's schema - case Json.Decode.decodeValue (Json.Decode.field "items" Json.Decode.value) arraySchema of - Ok itemSchema -> - let - withDesc = - case usageSpecDescription spec of - Just desc -> - appendJsonFields [ ( "description", Encode.string desc ) ] itemSchema - - Nothing -> - itemSchema - in - [ ( "items", withDesc ) ] - - Err _ -> - [] - - Nothing -> - if List.isEmpty positionalArgs then - [] + if List.isEmpty fixedItemSchemas then + restItemSchema + |> Maybe.map (\itemSchema -> [ ( "items", itemSchema ) ]) + |> Maybe.withDefault [] - else - [ ( "items", Encode.bool False ) ] + 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 <source> <dest>)" ) ] - ++ (if List.isEmpty prefixItemsList then - [] - - else - [ ( "prefixItems", Encode.list identity prefixItemsList ) ] - ) ++ itemsField + ++ additionalItemsField ++ (if requiredCount > 0 then [ ( "minItems", Encode.int requiredCount ) ] @@ -975,6 +985,20 @@ appendJsonFields extraFields jsonValue = 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 diff --git a/tests/ExperienceTests.elm b/tests/ExperienceTests.elm index 838b5ca..dff2184 100644 --- a/tests/ExperienceTests.elm +++ b/tests/ExperienceTests.elm @@ -130,6 +130,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 2 |> Expect.equal """{ + "$schema": "http://json-schema.org/draft-07/schema#", "anyOf": [ { "description": "test add --title <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).", @@ -230,13 +231,13 @@ all = "positional": { "type": "array", "description": "Positional arguments, passed in order (e.g., mytool <source> <dest>)", - "prefixItems": [ + "items": [ { "type": "string", "description": "The ID of the task to mark complete" } ], - "items": false, + "additionalItems": false, "minItems": 1 } }, diff --git a/tests/JsonSchemaTests.elm b/tests/JsonSchemaTests.elm index 00faaa5..45bfefd 100644 --- a/tests/JsonSchemaTests.elm +++ b/tests/JsonSchemaTests.elm @@ -25,6 +25,40 @@ all = [ ( "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 @@ -35,7 +69,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test --name <NAME>" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -82,7 +116,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test [--verbose]" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -116,7 +150,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test <file>" True) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -131,11 +165,59 @@ all = , Encode.object [ ( "type", Encode.string "array" ) , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) - , ( "prefixItems" + , ( "items" , Encode.list identity [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "file" ) ] ] ) - , ( "items", Encode.bool False ) + , ( "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 ) ] ) @@ -161,7 +243,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test [<revision>]" True) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -176,11 +258,11 @@ all = , Encode.object [ ( "type", Encode.string "array" ) , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) - , ( "prefixItems" + , ( "items" , Encode.list identity [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "revision" ) ] ] ) - , ( "items", Encode.bool False ) + , ( "additionalItems", Encode.bool False ) ] ) ] @@ -204,7 +286,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test <files>..." True) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -243,7 +325,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test [--header <HEADER>]..." False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -306,7 +388,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test --format <json|junit|console>" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -343,7 +425,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test --name <NAME> [--greeting <GREETING>] [--verbose]" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -389,7 +471,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test --init" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -424,7 +506,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test --init --force" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -465,7 +547,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test [--verbose] --init" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -513,7 +595,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "anyOf" , Encode.list identity [ Encode.object @@ -585,7 +667,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -615,7 +697,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription "test init [--bare]" False) ) , ( "type", Encode.string "object" ) , ( "properties" @@ -660,7 +742,7 @@ all = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "anyOf" , Encode.list identity [ Encode.object @@ -701,11 +783,11 @@ all = , Encode.object [ ( "type", Encode.string "array" ) , ( "description", Encode.string "Positional arguments, passed in order (e.g., mytool <source> <dest>)" ) - , ( "prefixItems" + , ( "items" , Encode.list identity [ Encode.object [ ( "type", Encode.string "string" ), ( "description", Encode.string "repository" ) ] ] ) - , ( "items", Encode.bool False ) + , ( "additionalItems", Encode.bool False ) , ( "minItems", Encode.int 1 ) ] ) @@ -1136,7 +1218,7 @@ expectJsonSchema { description, properties, required } config = |> Program.toJsonSchema "test" |> Encode.encode 0 |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (fullDescription description False) ) , ( "type", Encode.string "object" ) , ( "properties", Encode.object allProperties ) @@ -1145,3 +1227,11 @@ expectJsonSchema { description, properties, required } config = ] |> 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 index 4c9cd49..dd3620c 100644 --- a/tests/TsTypeTests.elm +++ b/tests/TsTypeTests.elm @@ -221,7 +221,8 @@ all = |> Encode.encode 0 |> Expect.equal (Encode.object - [ ( "description", Encode.string desc ) + [ ( "$schema", Encode.string "http://json-schema.org/draft-07/schema#" ) + , ( "description", Encode.string desc ) , ( "type", Encode.string "object" ) , ( "properties" , Encode.object diff --git a/tests/TypedOptionTests.elm b/tests/TypedOptionTests.elm index 5422fa7..cc566a6 100644 --- a/tests/TypedOptionTests.elm +++ b/tests/TypedOptionTests.elm @@ -53,7 +53,7 @@ all = \() -> schemaFor (Option.requiredKeywordArg "name" Option.string) |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (schemaDescription "test --name <NAME>") ) , ( "type", Encode.string "object" ) , ( "properties" @@ -118,7 +118,7 @@ all = \() -> schemaFor (Option.requiredKeywordArg "count" Option.int) |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) , ( "type", Encode.string "object" ) , ( "properties" @@ -506,7 +506,7 @@ all = |> Option.withDescription "Number of items" ) |> Expect.equal - (Encode.object + (draft07Object [ ( "description", Encode.string (schemaDescription "test --count <COUNT>") ) , ( "type", Encode.string "object" ) , ( "properties" @@ -609,6 +609,14 @@ schemaDescription usageSynopsis = ++ "\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 From 4328d2f60e14c0b56170c289f0cfc681bc7aa024 Mon Sep 17 00:00:00 2001 From: Dillon Kearns <dillon@incrementalelm.com> Date: Sat, 14 Mar 2026 19:37:05 -0700 Subject: [PATCH 34/34] Move some internal details. Results in major change because a type changed to a type alias of an internal type. --- src/Cli/LowLevel.elm | 3 +- src/Cli/OptionsParser.elm | 477 +++------------------------------ src/Cli/Program.elm | 3 +- src/Internal/OptionsParser.elm | 440 ++++++++++++++++++++++++++++++ 4 files changed, 476 insertions(+), 447 deletions(-) create mode 100644 src/Internal/OptionsParser.elm diff --git a/src/Cli/LowLevel.elm b/src/Cli/LowLevel.elm index 8e8f59c..66067ad 100644 --- a/src/Cli/LowLevel.elm +++ b/src/Cli/LowLevel.elm @@ -5,6 +5,7 @@ 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) @@ -280,7 +281,7 @@ tryJson optionsParsers blob = let matchResults = optionsParsers - |> List.map (OptionsParser.tryMatchJson blob) + |> List.map (OPInternal.tryMatchJson blob) in matchResults |> List.map MatchResult.matchResultToMaybe diff --git a/src/Cli/OptionsParser.elm b/src/Cli/OptionsParser.elm index 13adcdb..b40cb32 100644 --- a/src/Cli/OptionsParser.elm +++ b/src/Cli/OptionsParser.elm @@ -8,7 +8,7 @@ module Cli.OptionsParser exposing , hardcoded , withDescription , end - , getSubCommand, getUsageSpecs, getTsTypes, tryMatch, tryMatchJson, synopsis, detailedHelp + , getSubCommand, getUsageSpecs, tryMatch, synopsis, detailedHelp ) {-| @@ -134,7 +134,7 @@ a valid number of positional arguments is passed in, as defined by these rules: These functions are exposed for internal use and testing. They are not part of the public API. -@docs getSubCommand, getUsageSpecs, getTsTypes, tryMatch, tryMatchJson, synopsis, detailedHelp +@docs getSubCommand, getUsageSpecs, tryMatch, synopsis, detailedHelp -} @@ -145,30 +145,20 @@ 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 Json.Encode as Encode import Occurences exposing (Occurences(..)) import Tokenizer exposing (ParsedOption) import TsJson.Decode as TsDecode -import TsJson.Type {-| Low-level function, for internal use. -} getUsageSpecs : OptionsParser decodesTo builderState -> List UsageSpec -getUsageSpecs (OptionsParser { usageSpecs }) = +getUsageSpecs (OPInternal.OptionsParser { usageSpecs }) = usageSpecs -{-| Low-level function, for internal use. -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 - - {-| Low-level function, for internal use. -} synopsis : Bool -> String -> OptionsParser decodesTo builderState -> String @@ -182,7 +172,7 @@ synopsis useColor programName optionsParser = Cli.ColorMode.WithoutColor in optionsParser - |> (\(OptionsParser record) -> record) + |> (\(OPInternal.OptionsParser record) -> record) |> UsageSpec.synopsis colorMode programName @@ -200,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 @@ -294,76 +284,6 @@ tryMatch argv ((OptionsParser { usageSpecs, subCommand }) as optionsParser) = (matchErrorDetailToNoMatchReason subCommandError :: unexpectedOptionReasons) -{-| Low-level function, for internal use. -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) - - -{-| Convert internal MatchErrorDetail to public NoMatchReason. --} matchErrorDetailToNoMatchReason : Cli.Decode.MatchErrorDetail -> Cli.OptionsParser.MatchResult.NoMatchReason matchErrorDetailToNoMatchReason detail = case detail of @@ -377,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 -> @@ -394,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) -> @@ -425,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 -> @@ -448,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 @@ -465,34 +384,20 @@ 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 - , tsTypes : List ( String, TsJson.Type.Type ) - , jsonGrabber : Internal.JsonGrabber cliOptions - } - +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 -> Internal.JsonGrabber mappedCliOptions -> OptionsParser cliOptions fromBuilderState -> OptionsParser mappedCliOptions toBuilderState -updateDecoder decoder jsonGrabber (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 @@ -507,7 +412,7 @@ updateDecoder decoder jsonGrabber (OptionsParser optionsParserRecord) = -} build : cliOptions -> OptionsParser cliOptions BuilderState.AnyOptions build cliOptionsConstructor = - OptionsParser + OPInternal.OptionsParser { usageSpecs = [] , description = Nothing , decoder = \_ -> Ok ( [], cliOptionsConstructor ) @@ -522,7 +427,7 @@ build cliOptionsConstructor = -} buildSubCommand : String -> cliOptions -> OptionsParser cliOptions BuilderState.AnyOptions buildSubCommand subCommandName cliOptionsConstructor = - OptionsParser + OPInternal.OptionsParser { usageSpecs = [] , description = Nothing , decoder = \_ -> Ok ( [], cliOptionsConstructor ) @@ -580,7 +485,7 @@ 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, jsonGrabber }) as 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))) @@ -633,7 +538,7 @@ map : (cliOptions -> mappedCliOptions) -> OptionsParser cliOptions builderState -> OptionsParser mappedCliOptions builderState -map mapFunction ((OptionsParser { decoder, jsonGrabber }) as optionsParser) = +map mapFunction ((OPInternal.OptionsParser { decoder, jsonGrabber }) as optionsParser) = updateDecoder (decoder >> Result.map (Tuple.mapSecond mapFunction)) (\blob -> jsonGrabber blob |> Result.map (Tuple.mapSecond mapFunction)) @@ -655,8 +560,8 @@ 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, tsTypes, jsonGrabber } 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 ) ] @@ -692,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, tsTypes, jsonGrabber }) as fullOptionsParser) = +withCommon (Internal.Option innerOption) ((OPInternal.OptionsParser { decoder, usageSpecs, tsTypes, jsonGrabber }) as fullOptionsParser) = updateDecoder (\optionsAndOperands -> { options = optionsAndOperands.options @@ -729,8 +634,8 @@ withCommon (Internal.Option innerOption) ((OptionsParser { decoder, usageSpecs, Err err ) fullOptionsParser - |> (\(OptionsParser record) -> - OptionsParser + |> (\(OPInternal.OptionsParser record) -> + OPInternal.OptionsParser { record | usageSpecs = usageSpecs ++ [ innerOption.usageSpec ] , tsTypes = tsTypes ++ [ ( UsageSpec.name innerOption.usageSpec, innerOption.tsType ) ] @@ -775,326 +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 } - - -{-| Normalize a JSON blob with flat properties and `$cli` structural data into flat fields. - -In the flat schema format, named options (keyword args, flags, keyword lists) are -top-level properties. The `$cli` object contains only `subcommand` and `positional`. - -Transforms: - - - All top-level fields except `$cli` → passed through as-is - - `$cli.subcommand` → flat `subcommand` field - - `$cli.positional[N]` → flat field named by Nth operand's UsageSpec name - - Missing flags → defaulted to `False` - --} -normalizeCliJson : List UsageSpec -> Json.Decode.Value -> Json.Decode.Value -normalizeCliJson usageSpecs blob = - let - -- Get all top-level fields except $cli - 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 - - -- Build subcommand field from $cli.subcommand - 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 _ -> - [] - - -- Build positional arg fields from $cli.positional - 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 _ -> - [] - - -- Default missing flags to False (jsonGrabber expects flag fields to exist) - 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/src/Cli/Program.elm b/src/Cli/Program.elm index 530be63..3772a30 100644 --- a/src/Cli/Program.elm +++ b/src/Cli/Program.elm @@ -93,6 +93,7 @@ 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 @@ -658,7 +659,7 @@ parserToJsonSchemaFromTsTypes programName parser = OptionsParser.getUsageSpecs parser tsTypes = - OptionsParser.getTsTypes parser + OPInternal.getTsTypes parser specsWithTypes = List.map2 Tuple.pair specs tsTypes 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 []