Compare commits

..

12 Commits

Author SHA1 Message Date
Patrick Stevens
e8571553c4 Fix the incorrect rendering of the Patch attribute (#375) 2025-04-22 22:53:32 +01:00
Patrick Stevens
19761db983 Fix treatment of Patch (#374) 2025-04-21 22:46:01 +00:00
Patrick Stevens
f30a73fd4f Bump WoofWare.Whippet.Fantomas (#373) 2025-04-21 21:36:26 +00:00
Patrick Stevens
b2d64562bf Support octet-stream content type in Swagger gen (#372) 2025-04-21 20:57:51 +00:00
Patrick Stevens
e7e629613e Work around Gitea's malformed responses again (#371) 2025-04-21 20:07:44 +00:00
Patrick Stevens
4560138b59 Work around a strange Gitea behaviour (#370) 2025-04-21 20:49:32 +01:00
Patrick Stevens
425d5313b4 Be compatible with <Nullable>enable</Nullable> (#369) 2025-04-21 18:43:52 +01:00
Patrick Stevens
0fe97da788 Have arg parser take string -> string option (#368) 2025-04-21 09:07:58 +00:00
Patrick Stevens
f944953384 Enforce non-nullability in more cases during JSON parse (#367) 2025-04-20 17:20:22 +00:00
Patrick Stevens
7930039ad1 Revert "Some fixes to nullability (#365)" (#366)
This reverts commit 8d275f0047.
2025-04-20 17:02:40 +00:00
Patrick Stevens
8d275f0047 Some fixes to nullability (#365) 2025-04-20 16:26:45 +00:00
patrick-conscriptus[bot]
682b12fdb2 Automated commit (#363)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-04-20 01:31:43 +00:00
34 changed files with 31642 additions and 18649 deletions

View File

@@ -1,5 +1,27 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 7.0.1
All generators should now be compatible with `<Nullable>enable</Nullable>`.
**Please test the results and let me know of unexpected failures.**
There are a number of heuristics in this code, because:
* `System.Text.Json.Nodes` is an unfathomably weird API which simply requires us to make educated guesses about whether a user-provided type is supposed to be nullable, despite this being irrelevant to the operation of `System.Text.Json`;
* Some types (like `Uri` and `String`) have `ToString` methods which can't return `null`, but in general `Object.ToString` can of course return `null`, and as far as I can tell there is simply no way to know from the source alone whether a given type will have a nullable `ToString`.
# WoofWare.Myriad.Plugins 6.0.1
The `ArgParser` generator's type signatures have changed.
The `parse'` method no longer takes `getEnvironmentVariable : string -> string`; it's now `getEnvironmentVariable : string -> string option`.
This is to permit satisfying the `<Nullable>enable</Nullable>` compiler setting.
If you're calling `parse'`, give it `Environment.GetEnvironmentVariable >> Option.ofObj` instead.
# WoofWare.Myriad.Plugins 5.0.1
We now enforce non-nullability on more types during JSON parse.
We have always expected you to consume nullable types wrapped in an `option`, but now we enforce this in more cases by throwing `ArgumentNullException`.
# WoofWare.Myriad.Plugins 3.0.1
Semantics of `HttpClient`'s URI component composition changed:

View File

@@ -235,9 +235,3 @@ type FlagsIntoPositionalArgs' =
[<PositionalArgs false>]
DontGrabEverything : string list
}
[<ArgParser true>]
type PassThru =
{
A : ParentRecordChildPos
}

View File

@@ -1,35 +0,0 @@
namespace ConsumePlugin.ArgsWithUnions
open System
open System.IO
open WoofWare.Myriad.Plugins
type BasicNoPositionals =
{
Foo : int
Bar : string
Baz : bool
Rest : int list
}
type UsernamePasswordAuth =
{
Username : string
Password : string
}
type TokenAuth =
{
Token : string
}
type AuthOptions =
| UsernamePassword of UsernamePasswordAuth
| Token of TokenAuth
[<ArgParser>]
type DoTheThing =
{
Basics : BasicNoPositionals
Auth : AuthOptions
}

View File

@@ -4,6 +4,7 @@
<TargetFramework>net9.0</TargetFramework>
<IsPackable>false</IsPackable>
<OtherFlags>--reflectionfree $(OtherFlags)</OtherFlags>
<Nullable>enable</Nullable>
</PropertyGroup>
<ItemGroup>
<MyriadSdkGenerator Include="$(MSBuildThisFileDirectory)..\WoofWare.Myriad.Plugins\bin\$(Configuration)\net6.0\WoofWare.Myriad.Plugins.dll"/>
@@ -12,7 +13,6 @@
<ItemGroup>
<None Include="myriad.toml"/>
<Compile Include="AssemblyInfo.fs" />
<!--
<Compile Include="RecordFile.fs"/>
<Compile Include="GeneratedRecord.fs">
<MyriadFile>RecordFile.fs</MyriadFile>
@@ -67,16 +67,10 @@
<Compile Include="ListCata.fs">
<MyriadFile>List.fs</MyriadFile>
</Compile>
-->
<Compile Include="Args.fs" />
<Compile Include="GeneratedArgs.fs">
<MyriadFile>Args.fs</MyriadFile>
</Compile>
<Compile Include="ArgsWithUnions.fs" />
<Compile Include="GeneratedArgsWithUnions.fs">
<MyriadFile>ArgsWithUnions.fs</MyriadFile>
</Compile>
<!--
<None Include="swagger-gitea.json" />
<Compile Include="GeneratedSwaggerGitea.fs">
<MyriadFile>swagger-gitea.json</MyriadFile>
@@ -88,7 +82,6 @@
<Compile Include="Generated2SwaggerGitea.fs">
<MyriadFile>GeneratedSwaggerGitea.fs</MyriadFile>
</Compile>
-->
</ItemGroup>
<ItemGroup>

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,686 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ArgParserHelpers
/// Helper types for arg parsing
module internal ArgParseHelpers_ConsumePlugin_ArgsWithUnions =
open System
open System.IO
open WoofWare.Myriad.Plugins
open ConsumePlugin.ArgsWithUnions
/// A partially-parsed BasicNoPositionals.
type internal BasicNoPositionals_InProgress =
{
mutable Bar : string option
mutable Baz : bool option
mutable Foo : int option
mutable Rest : ResizeArray<int>
}
/// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args.
member this.Assemble_
(getEnvironmentVariable : string -> string)
(positionals : Choice<string * int, string * int> list)
: Result<BasicNoPositionals * string option, string list>
=
let errors = ResizeArray<string> ()
let positionalConsumers = ResizeArray<string> ()
let outOfPlacePositionals : ResizeArray<string> = ResizeArray ()
let arg0 : int =
match this.Foo with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "foo")
Unchecked.defaultof<_>
let arg1 : string =
match this.Bar with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "bar")
Unchecked.defaultof<_>
let arg2 : bool =
match this.Baz with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "baz")
Unchecked.defaultof<_>
let arg3 : int list = this.Rest |> Seq.toList
if positionalConsumers.Count <= 1 then
if outOfPlacePositionals.Count > 0 then
outOfPlacePositionals
|> String.concat " "
|> (fun x ->
if 0 = outOfPlacePositionals.Count then
"Unmatched args which look like they are meant to be flags. " + x
else
sprintf
"Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s"
positionalConsumers.[0]
x
)
|> errors.Add
else
()
if errors.Count = 0 then
Ok (
{
Foo = arg0
Bar = arg1
Baz = arg2
Rest = arg3
},
Seq.tryExactlyOne positionalConsumers
)
else
errors |> Seq.toList |> Error
else
("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: "
+ String.concat ", " positionalConsumers)
|> List.singleton
|> Error
static member _Empty () : BasicNoPositionals_InProgress =
{
Bar = None
Baz = None
Foo = None
Rest = ResizeArray ()
}
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
member this.ProcessKeyValueSelf_
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
if System.String.Equals (key, sprintf "--%s" "rest", System.StringComparison.OrdinalIgnoreCase) then
value |> (fun x -> System.Int32.Parse x) |> (fun x -> x) |> this.Rest.Add
() |> Ok
else if System.String.Equals (key, sprintf "--%s" "foo", System.StringComparison.OrdinalIgnoreCase) then
match this.Foo with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "foo")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Foo <- value |> (fun x -> System.Int32.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then
match this.Baz with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "baz")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Baz <- value |> (fun x -> System.Boolean.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if System.String.Equals (key, sprintf "--%s" "bar", System.StringComparison.OrdinalIgnoreCase) then
match this.Bar with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "bar")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Bar <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
member this.ProcessKeyValue
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
match this.ProcessKeyValueSelf_ argNum_ errors_ key value with
| Ok () -> Ok ()
| Error None -> Error None
| Error (Some errorFromLeaf) -> Error (Some errorFromLeaf)
/// Returns false if we didn't set a value.
member this.SetFlagValue_ (errors_ : ResizeArray<string>) (key : string) : bool =
if System.String.Equals (key, sprintf "--%s" "baz", System.StringComparison.OrdinalIgnoreCase) then
match this.Baz with
| Some _ ->
sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "baz")
|> errors_.Add
true
| None ->
this.Baz <- true |> Some
true
else
false
/// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces.
static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO"
/// A partially-parsed UsernamePasswordAuth.
type internal UsernamePasswordAuth_InProgress =
{
mutable Password : string option
mutable Username : string option
}
/// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args.
member this.Assemble_
(getEnvironmentVariable : string -> string)
(positionals : Choice<string * int, string * int> list)
: Result<UsernamePasswordAuth * string option, string list>
=
let errors = ResizeArray<string> ()
let positionalConsumers = ResizeArray<string> ()
let outOfPlacePositionals : ResizeArray<string> = ResizeArray ()
let arg0 : string =
match this.Username with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "username")
Unchecked.defaultof<_>
let arg1 : string =
match this.Password with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "password")
Unchecked.defaultof<_>
if positionalConsumers.Count <= 1 then
if outOfPlacePositionals.Count > 0 then
outOfPlacePositionals
|> String.concat " "
|> (fun x ->
if 0 = outOfPlacePositionals.Count then
"Unmatched args which look like they are meant to be flags. " + x
else
sprintf
"Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s"
positionalConsumers.[0]
x
)
|> errors.Add
else
()
if errors.Count = 0 then
Ok (
{
Username = arg0
Password = arg1
},
Seq.tryExactlyOne positionalConsumers
)
else
errors |> Seq.toList |> Error
else
("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: "
+ String.concat ", " positionalConsumers)
|> List.singleton
|> Error
static member _Empty () : UsernamePasswordAuth_InProgress =
{
Password = None
Username = None
}
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
member this.ProcessKeyValueSelf_
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
if System.String.Equals (key, sprintf "--%s" "username", System.StringComparison.OrdinalIgnoreCase) then
match this.Username with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "username")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Username <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "password", System.StringComparison.OrdinalIgnoreCase)
then
match this.Password with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "password")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Password <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
member this.ProcessKeyValue
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
match this.ProcessKeyValueSelf_ argNum_ errors_ key value with
| Ok () -> Ok ()
| Error None -> Error None
| Error (Some errorFromLeaf) -> Error (Some errorFromLeaf)
/// Returns false if we didn't set a value.
member this.SetFlagValue_ (errors_ : ResizeArray<string>) (key : string) : bool = false
/// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces.
static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO"
/// A partially-parsed TokenAuth.
type internal TokenAuth_InProgress =
{
mutable Token : string option
}
/// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args.
member this.Assemble_
(getEnvironmentVariable : string -> string)
(positionals : Choice<string * int, string * int> list)
: Result<TokenAuth * string option, string list>
=
let errors = ResizeArray<string> ()
let positionalConsumers = ResizeArray<string> ()
let outOfPlacePositionals : ResizeArray<string> = ResizeArray ()
let arg0 : string =
match this.Token with
| Some result -> result
| None ->
errors.Add (sprintf "Required argument '--%s' received no value" "token")
Unchecked.defaultof<_>
if positionalConsumers.Count <= 1 then
if outOfPlacePositionals.Count > 0 then
outOfPlacePositionals
|> String.concat " "
|> (fun x ->
if 0 = outOfPlacePositionals.Count then
"Unmatched args which look like they are meant to be flags. " + x
else
sprintf
"Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s"
positionalConsumers.[0]
x
)
|> errors.Add
else
()
if errors.Count = 0 then
Ok (
{
Token = arg0
},
Seq.tryExactlyOne positionalConsumers
)
else
errors |> Seq.toList |> Error
else
("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: "
+ String.concat ", " positionalConsumers)
|> List.singleton
|> Error
static member _Empty () : TokenAuth_InProgress =
{
Token = None
}
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
member this.ProcessKeyValueSelf_
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
if System.String.Equals (key, sprintf "--%s" "token", System.StringComparison.OrdinalIgnoreCase) then
match this.Token with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "token")
(x.ToString ())
(value.ToString ())
|> errors_.Add
Ok ()
| None ->
try
this.Token <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
member this.ProcessKeyValue
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
match this.ProcessKeyValueSelf_ argNum_ errors_ key value with
| Ok () -> Ok ()
| Error None -> Error None
| Error (Some errorFromLeaf) -> Error (Some errorFromLeaf)
/// Returns false if we didn't set a value.
member this.SetFlagValue_ (errors_ : ResizeArray<string>) (key : string) : bool = false
/// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces.
static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO"
/// A partially-parsed AuthOptions.
type internal AuthOptions_InProgress =
{
Token : TokenAuth_InProgress
UsernamePassword : UsernamePasswordAuth_InProgress
}
/// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args.
member this.Assemble_
(getEnvironmentVariable : string -> string)
(positionals : Choice<string * int, string * int> list)
: Result<AuthOptions * string option, string list>
=
failwith "TODO"
static member _Empty () : AuthOptions_InProgress =
{
Token = TokenAuth_InProgress._Empty ()
UsernamePassword = UsernamePasswordAuth_InProgress._Empty ()
}
/// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces.
static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO"
/// A partially-parsed DoTheThing.
type internal DoTheThing_InProgress =
{
mutable Auth : AuthOptions_InProgress
mutable Basics : BasicNoPositionals_InProgress
}
/// Freeze this in-progress type. On success, returns the frozen type and the arg (if any) which consumed the input positional args.
member this.Assemble_
(getEnvironmentVariable : string -> string)
(positionals : Choice<string * int, string * int> list)
: Result<DoTheThing * string option, string list>
=
let errors = ResizeArray<string> ()
let positionalConsumers = ResizeArray<string> ()
let outOfPlacePositionals : ResizeArray<string> = ResizeArray ()
let arg0 : BasicNoPositionals =
match this.Basics.Assemble_ getEnvironmentVariable positionals with
| Ok (result, consumedPositional) ->
match consumedPositional with
| None -> ()
| Some positionalConsumer -> positionalConsumers.Add positionalConsumer
result
| Error err ->
errors.AddRange err
Unchecked.defaultof<_>
let arg1 : AuthOptions =
match this.Auth.Assemble_ getEnvironmentVariable positionals with
| Ok (result, consumedPositional) ->
match consumedPositional with
| None -> ()
| Some positionalConsumer -> positionalConsumers.Add positionalConsumer
result
| Error err ->
errors.AddRange err
Unchecked.defaultof<_>
if positionalConsumers.Count <= 1 then
if outOfPlacePositionals.Count > 0 then
outOfPlacePositionals
|> String.concat " "
|> (fun x ->
if 0 = outOfPlacePositionals.Count then
"Unmatched args which look like they are meant to be flags. " + x
else
sprintf
"Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `%s=` syntax, or place them after a trailing `--`. %s"
positionalConsumers.[0]
x
)
|> errors.Add
else
()
if errors.Count = 0 then
Ok (
{
Basics = arg0
Auth = arg1
},
Seq.tryExactlyOne positionalConsumers
)
else
errors |> Seq.toList |> Error
else
("Multiple parsers consumed positional args; this is an error in the application, not an error by the user: "
+ String.concat ", " positionalConsumers)
|> List.singleton
|> Error
static member _Empty () : DoTheThing_InProgress =
{
Basics = BasicNoPositionals_InProgress._Empty ()
Auth = AuthOptions_InProgress._Empty ()
}
/// Passes the key-value pair to any child records, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
member this.ProcessKeyValueRecord_
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
let errors : ResizeArray<string> = ResizeArray ()
match this.Basics.ProcessKeyValue argNum_ errors_ key value with
| Ok () -> Ok ()
| Error e -> Error None
member this.ProcessKeyValue
(argNum_ : int)
(errors_ : ResizeArray<string>)
(key : string)
(value : string)
: Result<unit, string option>
=
match this.ProcessKeyValueRecord_ argNum_ errors_ key value with
| Ok () -> Ok ()
| Error errorFromRecord -> Error errorFromRecord
/// Returns false if we didn't set a value.
member this.SetFlagValue_ (errors_ : ResizeArray<string>) (key : string) : bool = false
/// Compute help text for this parser, optionally noting the given prefix on each argument and indenting each line by this many spaces.
static member HelpText_ (prefix : string option) (indent : int) : string = failwith "TODO"
namespace ConsumePlugin.ArgsWithUnions
open ArgParserHelpers
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type DoTheThing
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module DoTheThing =
type internal ParseState_DoTheThing =
/// Ready to consume a key or positional arg
| AwaitingKey
/// Waiting to receive a value for the key we've already consumed
| AwaitingValue of key : string
let parse' (getEnvironmentVariable : string -> string) (args : string list) : DoTheThing =
let inProgress =
ArgParseHelpers_ConsumePlugin_ArgsWithUnions.DoTheThing_InProgress._Empty ()
let positionals : ResizeArray<Choice<string * int, string * int>> = ResizeArray ()
let errors_ = ResizeArray ()
let rec go (argNum_ : int) (state : ParseState_DoTheThing) (args : string list) =
match args with
| [] ->
match state with
| ParseState_DoTheThing.AwaitingKey -> ()
| ParseState_DoTheThing.AwaitingValue key ->
if inProgress.SetFlagValue_ errors_ key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> errors_.Add
| "--" :: rest -> positionals.AddRange (rest |> Seq.map (fun x -> (x, argNum_ + 1)) |> Seq.map Choice2Of2)
| arg :: args ->
match state with
| ParseState_DoTheThing.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
"TODO" |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
go (argNum_ + 1) (ParseState_DoTheThing.AwaitingValue arg) args
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match inProgress.ProcessKeyValue argNum_ errors_ key value with
| Ok () -> go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args
| Error x ->
match x with
| None ->
positionals.Add (Choice1Of2 (arg, argNum_))
go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> errors_.Add
go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args
else
(arg, argNum_) |> Choice1Of2 |> positionals.Add
go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey args
| ParseState_DoTheThing.AwaitingValue key ->
match inProgress.ProcessKeyValue argNum_ errors_ key arg with
| Ok () -> go argNum_ ParseState_DoTheThing.AwaitingKey args
| Error exc ->
if inProgress.SetFlagValue_ errors_ key then
go argNum_ ParseState_DoTheThing.AwaitingKey (arg :: args)
else
(key, argNum_) |> Choice1Of2 |> positionals.Add
go (argNum_ + 1) ParseState_DoTheThing.AwaitingKey (arg :: args)
go 0 ParseState_DoTheThing.AwaitingKey args
if 0 = errors_.Count then
()
else
errors_
|> String.concat System.Environment.NewLine
|> (fun x -> "Errors during parse!\n" + x)
|> failwith
match inProgress.Assemble_ getEnvironmentVariable (positionals |> Seq.toList) with
| Ok (result, posConsumer) ->
if positionals.Count > 0 && posConsumer.IsNone then
positionals
|> Seq.map (fun choiceValue ->
match choiceValue with
| Choice1Of2 (arg, _) -> arg
| Choice2Of2 (arg, _) -> arg
)
|> String.concat " "
|> sprintf "Parse error: The following arguments were not consumed: %s"
|> failwith
else
result
| Error e ->
e
|> String.concat System.Environment.NewLine
|> (fun x -> "Errors during parse!\n" + x)
|> failwith
let parse (args : string list) : DoTheThing =
parse' System.Environment.GetEnvironmentVariable args

View File

@@ -14,7 +14,24 @@ module internal InternalTypeNotExtensionSerial =
/// Serialize to a JSON node
let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do node.Add ((Literals.something), (input.InternalThing2 |> System.Text.Json.Nodes.JsonValue.Create<string>))
do
node.Add (
(Literals.something),
(input.InternalThing2
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<string> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type string to be non-null, but received a null value when serialising"
)
| field -> field)
))
)
node :> _
namespace ConsumePlugin
@@ -29,7 +46,24 @@ module internal InternalTypeExtensionJsonSerializeExtension =
/// Serialize to a JSON node
static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do node.Add ((Literals.something), (input.ExternalThing |> System.Text.Json.Nodes.JsonValue.Create<string>))
do
node.Add (
(Literals.something),
(input.ExternalThing
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<string> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type string to be non-null, but received a null value when serialising"
)
| field -> field)
))
)
node :> _
namespace ConsumePlugin
@@ -40,16 +74,14 @@ module InnerType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
let arg_0 =
(match node.[(Literals.something)] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.[(Literals.something)] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
Thing = arg_0
@@ -62,79 +94,97 @@ module JsonRecordType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let arg_5 =
(match node.["f"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("f")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ())
|> Array.ofSeq
match node.["f"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("f")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type int32) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.Int32> ())
)
|> Array.ofSeq
let arg_4 =
(match node.["e"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("e")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> Array.ofSeq
match node.["e"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("e")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type string) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.String> ())
)
|> Array.ofSeq
let arg_3 =
InnerType.jsonParse (
match node.["d"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
match node.["d"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
| v -> v
)
)
| Some node -> InnerType.jsonParse node
let arg_2 =
(match node.["hi"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hi")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.Int32> ())
|> List.ofSeq
match node.["hi"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hi")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type int32) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.Int32> ())
)
|> List.ofSeq
let arg_1 =
(match node.["another-thing"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("another-thing")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["another-thing"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("another-thing")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_0 =
(match node.["a"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("a")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["a"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("a")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
{
A = arg_0
@@ -152,16 +202,14 @@ module internal InternalTypeNotExtension =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InternalTypeNotExtension =
let arg_0 =
(match node.[(Literals.something)] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.[(Literals.something)] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
InternalThing = arg_0
@@ -177,16 +225,14 @@ module internal InternalTypeExtensionJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : InternalTypeExtension =
let arg_0 =
(match node.[(Literals.something)] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.[(Literals.something)] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ((Literals.something))
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
ExternalThing = arg_0
@@ -201,248 +247,215 @@ module ToGetExtensionMethodJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let arg_20 = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ())
let arg_20 =
match node.["whiskey"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("whiskey")
)
)
| Some node -> System.Numerics.BigInteger.Parse (node.ToJsonString ())
let arg_19 =
(match node.["victor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("victor")
)
)
| v -> v)
.AsValue()
.GetValue<System.Char> ()
match node.["victor"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("victor")
)
)
| Some node -> node.AsValue().GetValue<System.Char> ()
let arg_18 =
(match node.["uniform"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("uniform")
)
)
| v -> v)
.AsValue()
.GetValue<System.Decimal> ()
match node.["uniform"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("uniform")
)
)
| Some node -> node.AsValue().GetValue<System.Decimal> ()
let arg_17 =
(match node.["tango"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tango")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
match node.["tango"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tango")
)
)
| Some node -> node.AsValue().GetValue<System.SByte> ()
let arg_16 =
(match node.["quebec"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("quebec")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
match node.["quebec"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("quebec")
)
)
| Some node -> node.AsValue().GetValue<System.Byte> ()
let arg_15 =
(match node.["papa"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("papa")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
match node.["papa"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("papa")
)
)
| Some node -> node.AsValue().GetValue<System.Byte> ()
let arg_14 =
(match node.["oscar"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("oscar")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
match node.["oscar"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("oscar")
)
)
| Some node -> node.AsValue().GetValue<System.SByte> ()
let arg_13 =
(match node.["november"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("november")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt16> ()
match node.["november"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("november")
)
)
| Some node -> node.AsValue().GetValue<System.UInt16> ()
let arg_12 =
(match node.["mike"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mike")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int16> ()
match node.["mike"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mike")
)
)
| Some node -> node.AsValue().GetValue<System.Int16> ()
let arg_11 =
(match node.["lima"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lima")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
match node.["lima"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lima")
)
)
| Some node -> node.AsValue().GetValue<System.UInt32> ()
let arg_10 =
(match node.["kilo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("kilo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["kilo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("kilo")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_9 =
(match node.["juliette"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("juliette")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
match node.["juliette"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("juliette")
)
)
| Some node -> node.AsValue().GetValue<System.UInt32> ()
let arg_8 =
(match node.["india"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("india")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["india"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("india")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_7 =
(match node.["hotel"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hotel")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt64> ()
match node.["hotel"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hotel")
)
)
| Some node -> node.AsValue().GetValue<System.UInt64> ()
let arg_6 =
(match node.["golf"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("golf")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int64> ()
match node.["golf"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("golf")
)
)
| Some node -> node.AsValue().GetValue<System.Int64> ()
let arg_5 =
(match node.["foxtrot"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("foxtrot")
)
)
| v -> v)
.AsValue()
.GetValue<System.Double> ()
match node.["foxtrot"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("foxtrot")
)
)
| Some node -> node.AsValue().GetValue<System.Double> ()
let arg_4 =
(match node.["echo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("echo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
match node.["echo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("echo")
)
)
| Some node -> node.AsValue().GetValue<System.Single> ()
let arg_3 =
(match node.["delta"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("delta")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
match node.["delta"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("delta")
)
)
| Some node -> node.AsValue().GetValue<System.Single> ()
let arg_2 =
(match node.["charlie"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("charlie")
)
)
| v -> v)
.AsValue()
.GetValue<System.Double> ()
match node.["charlie"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("charlie")
)
)
| Some node -> node.AsValue().GetValue<System.Double> ()
let arg_1 =
(match node.["bravo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("bravo")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
|> System.Uri
match node.["bravo"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("bravo")
)
)
| Some node -> node.AsValue().GetValue<string> () |> System.Uri
let arg_0 =
(match node.["alpha"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("alpha")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["alpha"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("alpha")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
Alpha = arg_0

File diff suppressed because it is too large Load Diff

View File

@@ -48,7 +48,27 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
return jsonNode.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Gym list"
)
| jsonNode -> jsonNode)
return
jsonNode.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type Gym) to be non-null, but found a null element"
)
| elt -> Gym.jsonParse elt)
)
|> List.ofSeq
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -82,6 +102,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type GymAttendance"
)
| jsonNode -> jsonNode)
return GymAttendance.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -116,6 +145,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type GymAttendance"
)
| jsonNode -> jsonNode)
return GymAttendance.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -146,6 +184,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Member"
)
| jsonNode -> jsonNode)
return Member.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -179,6 +226,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Gym"
)
| jsonNode -> jsonNode)
return Gym.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -209,6 +265,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type MemberActivityDto"
)
| jsonNode -> jsonNode)
return MemberActivityDto.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -239,6 +304,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type UriThing"
)
| jsonNode -> jsonNode)
return UriThing.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -266,23 +340,42 @@ module PureGymApi =
foo
|> (fun field ->
match field with
| None -> null :> System.Text.Json.Nodes.JsonNode
| None -> None
| Some field ->
((fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
(field
|> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do
ret.Add (
key.ToString (),
System.Text.Json.Nodes.JsonValue.Create<string> value
)
for (KeyValue (key, value)) in field do
let key = key.ToString ()
ret
)
field)
ret.Add (
key,
(fun field ->
let field =
System.Text.Json.Nodes.JsonValue.Create<string> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type string to be non-null, but received a null value when serialising"
)
| field -> field)
)
value
)
ret
))
:> System.Text.Json.Nodes.JsonNode
|> Some
)
|> (fun node ->
match node with
| None -> "null"
| Some node -> node.ToJsonString ()
)
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -294,15 +387,25 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode = jsonNode |> Option.ofObj
return
match jsonNode with
| null -> None
| v ->
| None -> None
| Some v ->
v.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> Map.ofSeq
|> Some
@@ -346,6 +449,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Sessions"
)
| jsonNode -> jsonNode)
return Sessions.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -387,6 +499,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Sessions"
)
| jsonNode -> jsonNode)
return Sessions.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -546,9 +667,7 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user
|> PureGym.Member.toJsonNode
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
user |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -580,8 +699,18 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user
|> System.Text.Json.Nodes.JsonValue.Create<Uri>
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<Uri> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type URI to be non-null, but received a null value when serialising"
)
| field -> field)
)
|> (fun node -> node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -613,8 +742,18 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user
|> System.Text.Json.Nodes.JsonValue.Create<int>
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
|> (fun field ->
let field = System.Text.Json.Nodes.JsonValue.Create<int> field
(match field with
| null ->
raise (
System.ArgumentNullException
"Expected type int32 to be non-null, but received a null value when serialising"
)
| field -> field)
)
|> (fun node -> node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -878,6 +1017,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Response<MemberActivityDto>"
)
| jsonNode -> jsonNode)
return
new RestEase.Response<_> (
responseString,
@@ -914,6 +1062,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type RestEase.Response<MemberActivityDto>"
)
| jsonNode -> jsonNode)
return
new RestEase.Response<_> (
responseString,
@@ -950,6 +1107,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type Response<MemberActivityDto>"
)
| jsonNode -> jsonNode)
return
new RestEase.Response<_> (
responseString,
@@ -986,6 +1152,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type RestEase.Response<MemberActivityDto>"
)
| jsonNode -> jsonNode)
return
new RestEase.Response<_> (
responseString,

File diff suppressed because it is too large Load Diff

View File

@@ -3423,7 +3423,7 @@ type IGitea =
[<RestEase.Path "id">] id : int * ?ct : System.Threading.CancellationToken -> Hook System.Threading.Tasks.Task
/// Update a hook
[<RestEase.Post "admin/hooks/{id}">]
[<RestEase.Patch "admin/hooks/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract AdminEditHook :
[<RestEase.Path "id">] id : int *
@@ -3494,7 +3494,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit an existing user
[<RestEase.Post "admin/users/{username}">]
[<RestEase.Patch "admin/users/{username}">]
[<RestEase.Header("Content-Type", "json")>]
abstract AdminEditUser :
[<RestEase.Path "username">] username : string *
@@ -3601,7 +3601,7 @@ type IGitea =
NotificationThread System.Threading.Tasks.Task
/// Mark notification thread as read by ID
[<RestEase.Post "notifications/threads/{id}">]
[<RestEase.Patch "notifications/threads/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract NotifyReadThread :
[<RestEase.Path "id">] id : string *
@@ -3649,7 +3649,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit an organization
[<RestEase.Post "orgs/{org}">]
[<RestEase.Patch "orgs/{org}">]
[<RestEase.Header("Content-Type", "json")>]
abstract OrgEdit :
[<RestEase.Path "org">] org : string *
@@ -3695,7 +3695,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Update a hook
[<RestEase.Post "orgs/{org}/hooks/{id}">]
[<RestEase.Patch "orgs/{org}/hooks/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract OrgEditHook :
[<RestEase.Path "org">] org : string *
@@ -3742,7 +3742,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Update a label
[<RestEase.Post "orgs/{org}/labels/{id}">]
[<RestEase.Patch "orgs/{org}/labels/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract OrgEditLabel :
[<RestEase.Path "org">] org : string *
@@ -3984,7 +3984,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a repository's properties. Only fields that are set will be changed.
[<RestEase.Post "repos/{owner}/{repo}">]
[<RestEase.Patch "repos/{owner}/{repo}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEdit :
[<RestEase.Path "owner">] owner : string *
@@ -4052,7 +4052,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a branch protections for a repository. Only fields that are set will be changed
[<RestEase.Post "repos/{owner}/{repo}/branch_protections/{name}">]
[<RestEase.Patch "repos/{owner}/{repo}/branch_protections/{name}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditBranchProtection :
[<RestEase.Path "owner">] owner : string *
@@ -4425,7 +4425,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a Git hook in a repository
[<RestEase.Post "repos/{owner}/{repo}/hooks/git/{id}">]
[<RestEase.Patch "repos/{owner}/{repo}/hooks/git/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditGitHook :
[<RestEase.Path "owner">] owner : string *
@@ -4456,7 +4456,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a hook in a repository
[<RestEase.Post "repos/{owner}/{repo}/hooks/{id}">]
[<RestEase.Patch "repos/{owner}/{repo}/hooks/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditHook :
[<RestEase.Path "owner">] owner : string *
@@ -4573,7 +4573,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a comment attachment
[<RestEase.Post "repos/{owner}/{repo}/issues/comments/{id}/assets/{attachment_id}">]
[<RestEase.Patch "repos/{owner}/{repo}/issues/comments/{id}/assets/{attachment_id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract IssueEditIssueCommentAttachment :
[<RestEase.Path "owner">] owner : string *
@@ -4626,7 +4626,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit an issue. If using deadline only the date will be taken into account, and time of day ignored.
[<RestEase.Post "repos/{owner}/{repo}/issues/{index}">]
[<RestEase.Patch "repos/{owner}/{repo}/issues/{index}">]
[<RestEase.Header("Content-Type", "json")>]
abstract IssueEditIssue :
[<RestEase.Path "owner">] owner : string *
@@ -4669,7 +4669,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit an issue attachment
[<RestEase.Post "repos/{owner}/{repo}/issues/{index}/assets/{attachment_id}">]
[<RestEase.Patch "repos/{owner}/{repo}/issues/{index}/assets/{attachment_id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract IssueEditIssueAttachment :
[<RestEase.Path "owner">] owner : string *
@@ -4999,7 +4999,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Update a label
[<RestEase.Post "repos/{owner}/{repo}/labels/{id}">]
[<RestEase.Patch "repos/{owner}/{repo}/labels/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract IssueEditLabel :
[<RestEase.Path "owner">] owner : string *
@@ -5073,7 +5073,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Update a milestone
[<RestEase.Post "repos/{owner}/{repo}/milestones/{id}">]
[<RestEase.Patch "repos/{owner}/{repo}/milestones/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract IssueEditMilestone :
[<RestEase.Path "owner">] owner : string *
@@ -5157,7 +5157,7 @@ type IGitea =
PullRequest System.Threading.Tasks.Task
/// Update a pull request. If using deadline only the date will be taken into account, and time of day ignored.
[<RestEase.Post "repos/{owner}/{repo}/pulls/{index}">]
[<RestEase.Patch "repos/{owner}/{repo}/pulls/{index}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditPullRequest :
[<RestEase.Path "owner">] owner : string *
@@ -5495,7 +5495,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Update a release
[<RestEase.Post "repos/{owner}/{repo}/releases/{id}">]
[<RestEase.Patch "repos/{owner}/{repo}/releases/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditRelease :
[<RestEase.Path "owner">] owner : string *
@@ -5538,7 +5538,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a release attachment
[<RestEase.Post "repos/{owner}/{repo}/releases/{id}/assets/{attachment_id}">]
[<RestEase.Patch "repos/{owner}/{repo}/releases/{id}/assets/{attachment_id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditReleaseAttachment :
[<RestEase.Path "owner">] owner : string *
@@ -5845,7 +5845,7 @@ type IGitea =
unit System.Threading.Tasks.Task
/// Edit a wiki page
[<RestEase.Post "repos/{owner}/{repo}/wiki/page/{pageName}">]
[<RestEase.Patch "repos/{owner}/{repo}/wiki/page/{pageName}">]
[<RestEase.Header("Content-Type", "json")>]
abstract RepoEditWikiPage :
[<RestEase.Path "owner">] owner : string *
@@ -5936,7 +5936,7 @@ type IGitea =
[<RestEase.Path "id">] id : int * ?ct : System.Threading.CancellationToken -> unit System.Threading.Tasks.Task
/// Edit a team
[<RestEase.Post "teams/{id}">]
[<RestEase.Patch "teams/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract OrgEditTeam :
[<RestEase.Path "id">] id : int *
@@ -6066,7 +6066,7 @@ type IGitea =
[<RestEase.Path "id">] id : int * ?ct : System.Threading.CancellationToken -> unit System.Threading.Tasks.Task
/// update an OAuth2 Application, this includes regenerating the client secret
[<RestEase.Post "user/applications/oauth2/{id}">]
[<RestEase.Patch "user/applications/oauth2/{id}">]
[<RestEase.Header("Content-Type", "json")>]
abstract UserUpdateOAuth2Application :
[<RestEase.Path "id">] id : int *
@@ -6204,7 +6204,7 @@ type IGitea =
abstract GetUserSettings : ?ct : System.Threading.CancellationToken -> UserSettings list System.Threading.Tasks.Task
/// Update user settings
[<RestEase.Post "user/settings">]
[<RestEase.Patch "user/settings">]
[<RestEase.Header("Content-Type", "json")>]
abstract UpdateUserSettings :
[<RestEase.Body>] body : UserSettingsOptions * ?ct : System.Threading.CancellationToken ->

View File

@@ -13,139 +13,147 @@ module JwtVaultAuthResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let arg_10 =
(match node.["num_uses"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("num_uses")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["num_uses"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("num_uses")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_9 =
(match node.["orphan"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("orphan")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
match node.["orphan"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("orphan")
)
)
| Some node -> node.AsValue().GetValue<System.Boolean> ()
let arg_8 =
(match node.["entity_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("entity_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["entity_id"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("entity_id")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_7 =
(match node.["token_type"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_type")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["token_type"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_type")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_6 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
match node.["renewable"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| Some node -> node.AsValue().GetValue<System.Boolean> ()
let arg_5 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["lease_duration"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_4 =
(match node.["identity_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("identity_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
match node.["identity_policies"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("identity_policies")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type string) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.String> ())
)
|> List.ofSeq
let arg_3 =
(match node.["token_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
match node.["token_policies"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_policies")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type string) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.String> ())
)
|> List.ofSeq
let arg_2 =
(match node.["policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
match node.["policies"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("policies")
)
)
| Some node ->
node.AsArray ()
|> Seq.map (fun elt ->
(match elt with
| null ->
raise (
System.ArgumentNullException
"Expected element of array (element type string) to be non-null, but found a null element"
)
| elt -> elt.AsValue().GetValue<System.String> ())
)
|> List.ofSeq
let arg_1 =
(match node.["accessor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessor")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["accessor"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessor")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_0 =
(match node.["client_token"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("client_token")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["client_token"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("client_token")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
ClientToken = arg_0
@@ -168,64 +176,54 @@ module JwtVaultResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let arg_4 =
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
match node.["auth"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
| v -> v
)
)
| Some node -> JwtVaultAuthResponse.jsonParse node
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["lease_duration"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
match node.["renewable"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| Some node -> node.AsValue().GetValue<System.Boolean> ()
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["lease_id"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["request_id"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
RequestId = arg_0
@@ -242,190 +240,246 @@ module JwtSecretResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let arg_11 =
(match node.["data8"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data8")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> () |> System.Uri
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
match node.["data8"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data8")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type URI to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<string> () |> System.Uri)
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let arg_10 =
(match node.["data7"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data7")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.Int32> ()
key, value
)
|> Map.ofSeq
match node.["data7"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data7")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type int32 to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.Int32> ())
)
|> Map.ofSeq
let arg_9 =
(match node.["data6"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data6")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> dict
match node.["data6"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data6")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> dict
let arg_8 =
(match node.["data5"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data5")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> readOnlyDict
match node.["data5"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data5")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> readOnlyDict
let arg_7 =
(match node.["data4"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data4")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> Map.ofSeq
match node.["data4"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data4")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> Map.ofSeq
let arg_6 =
(match node.["data3"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data3")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
match node.["data3"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data3")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let arg_5 =
(match node.["data2"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data2")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> dict
match node.["data2"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data2")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> dict
let arg_4 =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> readOnlyDict
match node.["data"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| Some node ->
node.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = kvp.Value
key,
(match value with
| null ->
raise (
System.ArgumentNullException
"Expected dictionary value of type string to be non-null, but it was null"
)
| value -> value.AsValue().GetValue<System.String> ())
)
|> readOnlyDict
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
match node.["lease_duration"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| Some node -> node.AsValue().GetValue<System.Int32> ()
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
match node.["renewable"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| Some node -> node.AsValue().GetValue<System.Boolean> ()
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["lease_id"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
match node.["request_id"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| Some node -> node.AsValue().GetValue<System.String> ()
{
RequestId = arg_0
@@ -496,6 +550,15 @@ module VaultClient =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtSecretResponse"
)
| jsonNode -> jsonNode)
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -532,6 +595,15 @@ module VaultClient =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtVaultResponse"
)
| jsonNode -> jsonNode)
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -590,6 +662,15 @@ module VaultClientNonExtensionMethod =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtSecretResponse"
)
| jsonNode -> jsonNode)
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -626,6 +707,15 @@ module VaultClientNonExtensionMethod =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtVaultResponse"
)
| jsonNode -> jsonNode)
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -687,6 +777,15 @@ module VaultClientExtensionMethodHttpClientExtension =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtSecretResponse"
)
| jsonNode -> jsonNode)
return JwtSecretResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -723,6 +822,15 @@ module VaultClientExtensionMethodHttpClientExtension =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode =
(match jsonNode with
| null ->
raise (
System.ArgumentNullException
"Response from server was the JSON null object; expected a non-nullable type JwtVaultResponse"
)
| jsonNode -> jsonNode)
return JwtVaultResponse.jsonParse jsonNode
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))

View File

@@ -1,47 +0,0 @@
namespace Playground
open System
open WoofWare.Myriad.Plugins
[<ArgParser>]
type SubMode1 =
{
Info1 : int
Info2 : string
Rest : string list
}
[<ArgParser>]
type SubMode2 =
{
Info1 : int
Info2 : string
Rest : int list
}
[<ArgParser>]
type Mode1 =
{
Things : SubMode1
Whatnot : int
}
[<ArgParser>]
type Mode2 =
{
Things : SubMode2
Whatnot : DateTime
}
[<ArgParser>]
type Modes =
| Mode1 of Mode1
| Mode2 of Mode2
[<ArgParser>]
type Args =
{
WhatToDo : Modes
[<PositionalArgs>]
OtherArgs : string list
}

View File

@@ -1,563 +0,0 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace Playground // Assuming a namespace
open System
open System.IO
open WoofWare.Myriad.Plugins // Assuming attributes are here
// Assume original type definitions are accessible here
// [<ArgParser>] type SubMode1 = { Info1 : int; Info2 : string; Rest : string list }
// [<ArgParser>] type SubMode2 = { Info1 : int; Info2 : string; Rest : int list }
// [<ArgParser>] type Mode1 = { Things : SubMode1; Whatnot : int }
// [<ArgParser>] type Mode2 = { Things : SubMode2; Whatnot : DateTime }
// [<ArgParser>] type Modes = | Mode1 of Mode1 | Mode2 of Mode2
// [<ArgParser>] type Args = { WhatToDo : Modes; [<PositionalArgs>] OtherArgs : string list }
/// Methods to parse arguments for the type Args
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Args =
//--------------------------------------------------------------------------
// Internal state definitions (Non-Flattened with combined Assemble/Validate)
//--------------------------------------------------------------------------
/// State representing the parse progress for SubMode1 record
type private State_SubMode1 =
{
mutable Info1 : int option
mutable Info2 : string option
Rest : ResizeArray<string> // Corresponds to --rest
}
static member Create () =
{
Info1 = None
Info2 = None
Rest = ResizeArray ()
}
/// Check completeness and assemble the SubMode1 record from state.
member this.Assemble () : Result<SubMode1, string list> =
let errors = ResizeArray<string> ()
let mutable complete = true
if this.Info1.IsNone then
complete <- false
errors.Add ("Argument '--info1' is required.")
if this.Info2.IsNone then
complete <- false
errors.Add ("Argument '--info2' is required.")
// Rest is list, always 'complete'
if complete then
Ok
{
Info1 = this.Info1.Value
Info2 = this.Info2.Value
Rest = this.Rest |> Seq.toList
}
else
Error (errors |> Seq.toList)
/// State representing the parse progress for SubMode2 record
type private State_SubMode2 =
{
mutable Info1 : int option
mutable Info2 : string option
Rest : ResizeArray<int> // Corresponds to --rest
}
static member Create () =
{
Info1 = None
Info2 = None
Rest = ResizeArray ()
}
/// Check completeness and assemble the SubMode2 record from state.
member this.Assemble () : Result<SubMode2, string list> =
let errors = ResizeArray<string> ()
if this.Info1.IsNone then
errors.Add ("Argument '--info1' is required.")
if this.Info2.IsNone then
errors.Add ("Argument '--info2' is required.")
// Rest is list, always 'complete'
if errors.Count = 0 then
Ok
{
Info1 = this.Info1.Value
Info2 = this.Info2.Value
Rest = this.Rest |> Seq.toList
}
else
Error (errors |> Seq.toList)
/// State representing the parse progress for Mode1 record (references SubMode1 state)
type private State_Mode1 =
{
ThingsState : State_SubMode1 // Holds state for the nested record
mutable Whatnot : int option
}
static member Create () =
{
ThingsState = State_SubMode1.Create ()
Whatnot = None
}
/// Check completeness and assemble the Mode1 record from state (including nested).
member this.Assemble () : Result<Mode1, string list> =
let errors = ResizeArray<string> ()
// Check direct fields
if this.Whatnot.IsNone then
errors.Add ("Argument '--whatnot' is required for Mode1.")
// Assemble nested state (which includes its own validation)
let thingsResult = this.ThingsState.Assemble ()
let mutable thingsValue = None
match thingsResult with
| Ok v -> thingsValue <- Some v
| Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context
if errors.Count = 0 then
Ok
{
Things = thingsValue.Value
Whatnot = this.Whatnot.Value
}
else
Error (errors |> Seq.toList)
/// State representing the parse progress for Mode2 record (references SubMode2 state)
type private State_Mode2 =
{
ThingsState : State_SubMode2 // Holds state for the nested record
mutable Whatnot : DateTime option
}
static member Create () =
{
ThingsState = State_SubMode2.Create ()
Whatnot = None
}
/// Check completeness and assemble the Mode2 record from state (including nested).
member this.Assemble () : Result<Mode2, string list> =
let errors = ResizeArray<string> ()
// Check direct fields
if this.Whatnot.IsNone then
errors.Add ("Argument '--whatnot' is required for Mode2.")
// Assemble nested state (which includes its own validation)
let thingsResult = this.ThingsState.Assemble ()
let mutable thingsValue = Unchecked.defaultof<_>
match thingsResult with
| Ok v -> thingsValue <- v
| Error nestedErrors -> errors.AddRange (nestedErrors |> List.map (sprintf "Things: %s")) // Add context
if errors.Count = 0 then
{
Things = thingsValue
Whatnot = this.Whatnot.Value
}
|> Ok
else
Error (errors |> Seq.toList)
/// State for a single candidate parse path for the Modes DU (Structure unchanged)
type private CandidateParseState_Modes =
{
CaseName : string // "Mode1" or "Mode2"
mutable IsViable : bool
Errors : ResizeArray<string> // Errors specific to this candidate's path
ConsumedArgIndices : System.Collections.Generic.HashSet<int> // Indices consumed *by this candidate*
CaseState : obj // Holds either State_Mode1 or State_Mode2
}
static member CreateMode1 () =
{
CaseName = "Mode1"
IsViable = true
Errors = ResizeArray ()
ConsumedArgIndices = System.Collections.Generic.HashSet ()
CaseState = State_Mode1.Create () :> obj
}
static member CreateMode2 () =
{
CaseName = "Mode2"
IsViable = true
Errors = ResizeArray ()
ConsumedArgIndices = System.Collections.Generic.HashSet ()
CaseState = State_Mode2.Create () :> obj
}
//--------------------------------------------------------------------------
// Main Parser Logic
//--------------------------------------------------------------------------
type private ParseState_Args =
| AwaitingArg
| AwaitingValue of keyIndex : int * key : string
let parse' (getEnvironmentVariable : string -> string) (args : string list) : Args =
let ArgParser_errors = ResizeArray () // Global errors accumulator
let helpText () =
// Help text generation unchanged
[
(sprintf "%s int32%s%s" (sprintf "--%s" "info1") "" " (for Mode1/Mode2 Things)")
(sprintf "%s string%s%s" (sprintf "--%s" "info2") "" " (for Mode1/Mode2 Things)")
(sprintf "%s string%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode1 Things)")
(sprintf "%s int32%s%s" (sprintf "--%s" "rest") " (can be repeated)" " (for Mode2 Things)")
(sprintf "%s int32%s%s" (sprintf "--%s" "whatnot") "" " (for Mode1)")
(sprintf "%s DateTime%s%s" (sprintf "--%s" "whatnot") "" " (for Mode2)")
(sprintf "%s string%s%s" (sprintf "--%s" "other-args") " (positional args) (can be repeated)" "")
]
|> String.concat "\n"
let arg_OtherArgs : string ResizeArray = ResizeArray ()
let mutable candidates_WhatToDo : CandidateParseState_Modes list =
[
CandidateParseState_Modes.CreateMode1 ()
CandidateParseState_Modes.CreateMode2 ()
]
let consumedArgIndices_WhatToDo = System.Collections.Generic.HashSet<int> ()
//----------------------------------------------------------------------
// Helper functions for applying args (applyKeyValueToSubModeXState unchanged)
//----------------------------------------------------------------------
let applyKeyValueToSubMode1State
(argIndex : int)
(keyIndex : int)
(key : string)
(value : string)
(subState : State_SubMode1)
(candidate : CandidateParseState_Modes)
: unit
=
// ... (Implementation identical to previous version) ...
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
match subState.Info1 with
| Some _ ->
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode1)")
candidate.IsViable <- false
| None ->
try
subState.Info1 <- Some (Int32.Parse value)
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
with ex ->
candidate.Errors.Add (
sprintf "Failed to parse '%s' for --info1 (SubMode1): %s" value ex.Message
)
candidate.IsViable <- false
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
match subState.Info2 with
| Some _ ->
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode1)")
candidate.IsViable <- false
| None ->
subState.Info2 <- Some value
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
subState.Rest.Add value
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
else
()
let applyKeyValueToSubMode2State
(argIndex : int)
(keyIndex : int)
(key : string)
(value : string)
(subState : State_SubMode2)
(candidate : CandidateParseState_Modes)
: unit
=
// ... (Implementation identical to previous version) ...
if String.Equals (key, "--info1", StringComparison.OrdinalIgnoreCase) then
match subState.Info1 with
| Some _ ->
candidate.Errors.Add (sprintf "Argument '--info1' supplied multiple times (SubMode2)")
candidate.IsViable <- false
| None ->
try
subState.Info1 <- Some (Int32.Parse value)
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
with ex ->
candidate.Errors.Add (
sprintf "Failed to parse '%s' for --info1 (SubMode2): %s" value ex.Message
)
candidate.IsViable <- false
elif String.Equals (key, "--info2", StringComparison.OrdinalIgnoreCase) then
match subState.Info2 with
| Some _ ->
candidate.Errors.Add (sprintf "Argument '--info2' supplied multiple times (SubMode2)")
candidate.IsViable <- false
| None ->
subState.Info2 <- Some value
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
elif String.Equals (key, "--rest", StringComparison.OrdinalIgnoreCase) then
try
subState.Rest.Add (Int32.Parse value)
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
with ex ->
candidate.Errors.Add (
sprintf "Failed to parse '%s' as int32 for --rest (SubMode2): %s" value ex.Message
)
candidate.IsViable <- false
else
()
//----------------------------------------------------------------------
// Routing and Main Application Logic (applyKeyValueToCandidate unchanged)
//----------------------------------------------------------------------
let applyKeyValueToCandidate
(argIndex : int, keyIndex : int, key : string, value : string)
(candidate : CandidateParseState_Modes)
: unit
=
// ... (Implementation identical to previous version, calling sub-state helpers) ...
if not candidate.IsViable then
()
else
match candidate.CaseName with
| "Mode1" ->
let state = candidate.CaseState :?> State_Mode1
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
match state.Whatnot with
| Some _ ->
candidate.Errors.Add (
sprintf "Argument '--whatnot' supplied multiple times for Mode1 candidate"
)
candidate.IsViable <- false
| None ->
try
state.Whatnot <- Some (Int32.Parse value)
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
with ex ->
candidate.Errors.Add (
sprintf "Failed to parse '%s' as int32 for --whatnot (Mode1): %s" value ex.Message
)
candidate.IsViable <- false
elif key = "--info1" || key = "--info2" || key = "--rest" then
applyKeyValueToSubMode1State argIndex keyIndex key value state.ThingsState candidate
else
()
| "Mode2" ->
let state = candidate.CaseState :?> State_Mode2
if String.Equals (key, "--whatnot", StringComparison.OrdinalIgnoreCase) then
match state.Whatnot with
| Some _ ->
candidate.Errors.Add (
sprintf "Argument '--whatnot' supplied multiple times for Mode2 candidate"
)
candidate.IsViable <- false
| None ->
try
state.Whatnot <- Some (DateTime.Parse value)
candidate.ConsumedArgIndices.Add argIndex |> ignore
candidate.ConsumedArgIndices.Add keyIndex |> ignore
with ex ->
candidate.Errors.Add (
sprintf "Failed to parse '%s' as DateTime for --whatnot (Mode2): %s" value ex.Message
)
candidate.IsViable <- false
elif key = "--info1" || key = "--info2" || key = "--rest" then
applyKeyValueToSubMode2State argIndex keyIndex key value state.ThingsState candidate
else
()
| _ -> failwith "Internal error: Unknown case name"
// processKeyValue, setFlagValue, and main loop `go` are identical to previous version
let processKeyValue (keyIndex : int, key : string, valueIndex : int, value : string) : bool =
let mutable handled = false
for candidate in candidates_WhatToDo do
let initialConsumedCount = candidate.ConsumedArgIndices.Count
if candidate.IsViable then
applyKeyValueToCandidate (valueIndex, keyIndex, key, value) candidate
if candidate.IsViable && candidate.ConsumedArgIndices.Count > initialConsumedCount then
handled <- true
consumedArgIndices_WhatToDo.Add keyIndex |> ignore
consumedArgIndices_WhatToDo.Add valueIndex |> ignore
handled
let setFlagValue (keyIndex : int) (key : string) : bool = false // No flags
let rec go (state : ParseState_Args) (args : (int * string) list) =
// ... (Implementation identical to previous version) ...
match args with
| [] ->
match state with
| ParseState_Args.AwaitingArg -> ()
| ParseState_Args.AwaitingValue (i, k) ->
if not (setFlagValue i k) then
ArgParser_errors.Add (sprintf "Trailing argument '%s' (at index %d) requires a value." k i)
| (idx, arg) :: rest ->
match state with
| ParseState_Args.AwaitingArg ->
if arg = "--" then
rest
|> List.iter (fun (i, v) ->
if not (consumedArgIndices_WhatToDo.Contains i) then
arg_OtherArgs.Add v
)
go ParseState_Args.AwaitingArg []
elif arg.StartsWith ("--") then
if arg = "--help" then
helpText () |> failwithf "Help text requested:\n%s"
else
let eq = arg.IndexOf ('=')
if eq > 0 then
let k = arg.[.. eq - 1]
let v = arg.[eq + 1 ..]
if not (processKeyValue (idx, k, idx, v)) then
if not (consumedArgIndices_WhatToDo.Contains idx) then
arg_OtherArgs.Add arg
go ParseState_Args.AwaitingArg rest
elif setFlagValue idx arg then
consumedArgIndices_WhatToDo.Add idx |> ignore
go ParseState_Args.AwaitingArg rest
else
go (ParseState_Args.AwaitingValue (idx, arg)) rest
else
if not (consumedArgIndices_WhatToDo.Contains idx) then
arg_OtherArgs.Add arg
go ParseState_Args.AwaitingArg rest
| ParseState_Args.AwaitingValue (keyIdx, key) ->
if processKeyValue (keyIdx, key, idx, arg) then
go ParseState_Args.AwaitingArg rest
elif setFlagValue keyIdx key then
consumedArgIndices_WhatToDo.Add keyIdx |> ignore<bool>
go ParseState_Args.AwaitingArg ((idx, arg) :: rest) // Reprocess arg
elif not (consumedArgIndices_WhatToDo.Contains keyIdx) then
arg_OtherArgs.Add key
if not (consumedArgIndices_WhatToDo.Contains idx) then
arg_OtherArgs.Add arg
go ParseState_Args.AwaitingArg rest
args |> List.mapi (fun i s -> (i, s)) |> go ParseState_Args.AwaitingArg
//----------------------------------------------------------------------
// Final Validation and Assembly (Uses new Assemble methods)
//----------------------------------------------------------------------
let viableWinners = candidates_WhatToDo |> List.filter (fun c -> c.IsViable)
// No longer filter based on IsComplete here; Assemble handles it.
// Still need to check for relative leftovers if that logic were implemented.
let whatToDoResult =
match viableWinners with
| [] ->
// Add specific errors from candidates that were viable *before* Assemble check
ArgParser_errors.Add ("No valid parse found for 'WhatToDo'.")
candidates_WhatToDo
|> List.iter (fun c ->
if c.Errors.Count <> 0 then
ArgParser_errors.Add (
sprintf " Candidate %s parse errors: %s" c.CaseName (String.concat "; " c.Errors)
)
// Potentially try to Assemble even non-viable ones to get completion errors? Maybe too complex.
)
Unchecked.defaultof<_> // Error path
| [ winner ] ->
// Assemble the winning case, checking the Result for completion errors
match winner.CaseName with
| "Mode1" ->
match (winner.CaseState :?> State_Mode1).Assemble () with
| Ok mode1Value -> Modes.Mode1 mode1Value
| Error completionErrors ->
ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode1:")
ArgParser_errors.AddRange completionErrors
Unchecked.defaultof<_> // Error path
| "Mode2" ->
match (winner.CaseState :?> State_Mode2).Assemble () with
| Ok mode2Value -> Modes.Mode2 mode2Value
| Error completionErrors ->
ArgParser_errors.Add (sprintf "Validation failed for selected candidate Mode2:")
ArgParser_errors.AddRange completionErrors
Unchecked.defaultof<_> // Error path
| _ -> failwith "Internal error: Unknown winning case name"
| winners -> // Ambiguous parse
ArgParser_errors.Add ("Ambiguous parse for 'WhatToDo'. Multiple modes potentially viable:")
winners
|> List.iter (fun c ->
ArgParser_errors.Add (
sprintf
" - %s (Initial Errors: %s)"
c.CaseName
(if c.Errors.Count = 0 then
"None"
else
String.concat "; " c.Errors)
)
)
Unchecked.defaultof<_> // Error path
// Finalize OtherArgs (unchanged)
let otherArgsResult = arg_OtherArgs |> Seq.toList
// Assemble Final Result or Fail (unchanged)
if ArgParser_errors.Count > 0 then
ArgParser_errors
|> String.concat "\n"
|> failwithf "Errors during parse!\n%s\n\nHelp Text:\n%s" (helpText ())
else
{
WhatToDo = whatToDoResult
OtherArgs = otherArgsResult
}
let parse (args : string list) : Args =
parse' System.Environment.GetEnvironmentVariable args

View File

@@ -1,19 +0,0 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net9.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<OutputType>Exe</OutputType>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
<Compile Include="Library.fs"/>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\WoofWare.Myriad.Plugins.Attributes\WoofWare.Myriad.Plugins.Attributes.fsproj" />
</ItemGroup>
</Project>

View File

@@ -1,10 +0,0 @@
namespace Playground
module Program =
[<EntryPoint>]
let main argv =
[ "--whatnot=2024-01-12" ; "--info1=4" ; "--info2=hi" ]
|> Args.parse
|> printfn "%O"
0

View File

@@ -136,7 +136,7 @@ module InnerTypeWithBoth =
ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value)
ret
) input.Map
) input.ReadOnlyDict
)
node

View File

@@ -68,7 +68,7 @@ module TestArgParser =
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
""
None
let args = [ "--foo=3" ; "--non-existent" ; "--bar=4" ; "--baz=true" ]
@@ -79,8 +79,11 @@ module TestArgParser =
exc.Message
|> shouldEqual
"""Errors during parse!
Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--rest=` syntax, or place them after a trailing `--`. --non-existent"""
"""Unable to process supplied arg --non-existent. Help text follows.
--foo int32 : This is a foo!
--bar string
--baz bool
--rest string (positional args) (can be repeated) : Here's where the rest of the args go"""
[<Test>]
let ``Can supply positional args with key`` () =
@@ -88,7 +91,7 @@ Unmatched args which look like they are meant to be flags. If you intended them
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
""
None
let property (args : (int * bool) list) (afterDoubleDash : int list option) =
let flatArgs =
@@ -124,7 +127,7 @@ Unmatched args which look like they are meant to be flags. If you intended them
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
""
None
let args = [ "--foo=3" ; "--rest" ; "7" ; "--bar=4" ; "--baz=true" ; "--rest=8" ]
@@ -147,7 +150,7 @@ Unmatched args which look like they are meant to be flags. If you intended them
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
""
None
let args = [ "--foo=3" ; "--foo" ; "9" ; "--bar=4" ; "--baz=true" ; "--baz=false" ]
@@ -168,7 +171,7 @@ Argument '--baz' was supplied multiple times: True and false"""
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
""
None
let args = [ "--" ; "--foo=3" ; "--bar=4" ; "--baz=true" ]
@@ -188,7 +191,7 @@ Required argument '--baz' received no value"""
let ``Help text`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
"hi!"
Some "hi!"
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
@@ -207,7 +210,7 @@ Required argument '--baz' received no value"""
let getEnvVar (_ : string) =
Interlocked.Increment envVars |> ignore<int>
""
None
let exc =
Assert.Throws<exn> (fun () -> LoadsOfTypes.parse' getEnvVar [ "--help" ] |> ignore<LoadsOfTypes>)
@@ -233,7 +236,7 @@ Required argument '--baz' received no value"""
let ``Default values`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
"hi!"
Some "hi!"
let args =
[
@@ -261,7 +264,7 @@ Required argument '--baz' received no value"""
let getEnvVar (_ : string) =
Interlocked.Increment count |> ignore<int>
""
None
let exc =
Assert.Throws<exn> (fun () -> DatesAndTimes.parse' getEnvVar [ "--help" ] |> ignore<DatesAndTimes>)
@@ -282,7 +285,7 @@ Required argument '--baz' received no value"""
let getEnvVar (_ : string) =
Interlocked.Increment count |> ignore<int>
""
None
let parsed =
DatesAndTimes.parse'
@@ -315,7 +318,8 @@ Required argument '--baz' received no value"""
exc.Message
|> shouldEqual
"""Errors during parse!
Input string was not in a correct format. (at arg --invariant-exact=23:59)"""
Input string was not in a correct format. (at arg --invariant-exact=23:59)
Required argument '--invariant-exact' received no value"""
let exc =
Assert.Throws<exn> (fun () ->
@@ -333,7 +337,8 @@ Input string was not in a correct format. (at arg --invariant-exact=23:59)"""
exc.Message
|> shouldEqual
"""Errors during parse!
Input string was not in a correct format. (at arg --exact=11:34)"""
Input string was not in a correct format. (at arg --exact=11:34)
Required argument '--exact' received no value"""
count.Value |> shouldEqual 0
@@ -439,11 +444,11 @@ Input string was not in a correct format. (at arg --exact=11:34)"""
]
|> List.map TestCaseData
[<TestCaseSource(nameof boolCases)>]
[<TestCaseSource(nameof (boolCases))>]
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
envValue
Some envValue
ContainsBoolEnvVar.parse' getEnvVar []
|> shouldEqual
@@ -465,7 +470,7 @@ Input string was not in a correct format. (at arg --exact=11:34)"""
let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
envValue
Some envValue
let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
@@ -599,10 +604,7 @@ Input string was not in a correct format. (at arg --exact=11:34)"""
)
exc.Message
|> shouldEqual
"""Errors during parse!
Required argument '--do-something-else' received no value
Required argument '--turn-it-on' received no value"""
|> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
[<Test>]
let ``Long-form args help text`` () =
@@ -690,9 +692,7 @@ Required argument '--turn-it-on' received no value"""
)
exc.Message
|> shouldEqual
"""Errors during parse!
Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--dont-grab-everything=` syntax, or place them after a trailing `--`. --b=false --c"""
|> shouldEqual """Unable to process argument --b=false as key --b and value false"""
let exc =
Assert.Throws<exn> (fun () ->
@@ -703,6 +703,4 @@ Unmatched args which look like they are meant to be flags. If you intended them
// Again perhaps eccentric!
// Again, we don't try to detect that the user has missed out the desired argument to `--a`.
exc.Message
|> shouldEqual
"""Errors during parse!
Unmatched args which look like they are meant to be flags. If you intended them as positional args, explicitly pass them with the `--my-arg-name=` syntax, or place them after a trailing `--`. --c=hi"""
|> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""

View File

@@ -1,21 +0,0 @@
namespace WoofWare.Myriad.Plugins.Test
open FsUnitTyped
open NUnit.Framework
open ConsumePlugin.ArgsWithUnions
[<TestFixture>]
module TestArgsWithUnions =
let argsWithUnionsCases =
[
["--token" ; "hello" ; "--foo" ; "3" ; "--bar=hi" ; "--baz"], { Auth = AuthOptions.Token { Token = "hello" } ; Basics = { Foo = 3 ; Bar = "hi" ; Baz = true ; Rest = [] } }
]
|> List.map TestCaseData
[<TestCaseSource (nameof argsWithUnionsCases)>]
let ``foo`` (args : string list, expected : DoTheThing) : unit =
args
|> DoTheThing.parse' (fun _ -> failwith "didn't expect env var")
|> shouldEqual expected

View File

@@ -13,7 +13,6 @@
</PropertyGroup>
<ItemGroup>
<!--
<Compile Include="HttpClient.fs"/>
<Compile Include="PureGymDtos.fs"/>
<Compile Include="TestJsonParse\TestJsonParse.fs" />
@@ -35,14 +34,10 @@
<Compile Include="TestCataGenerator\TestGift.fs" />
<Compile Include="TestCataGenerator\TestMyList.fs" />
<Compile Include="TestCataGenerator\TestMyList2.fs" />
-->
<Compile Include="TestArgParser\TestArgParser.fs" />
<Compile Include="TestArgParser\TestArgsWithUnions.fs" />
<!--
<Compile Include="TestSwagger\TestSwaggerParse.fs" />
<Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestSurface.fs"/>
-->
<None Include="../.github/workflows/dotnet.yaml" />
</ItemGroup>

View File

@@ -7,6 +7,82 @@ open Fantomas.FCS.Text.Range
open TypeEquality
open WoofWare.Whippet.Fantomas
type internal ArgParserOutputSpec =
{
ExtensionMethods : bool
}
type internal FlagDu =
{
Name : Ident
Case1Name : Ident
Case2Name : Ident
/// Hopefully this is simply the const bool True or False, but it might e.g. be a literal
Case1Arg : SynExpr
/// Hopefully this is simply the const bool True or False, but it might e.g. be a literal
Case2Arg : SynExpr
}
static member FromBoolean (flagDu : FlagDu) (value : SynExpr) =
SynExpr.ifThenElse
(SynExpr.equals value flagDu.Case1Arg)
(SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ])
(SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ])
/// The default value of an argument which admits default values can be pulled from different sources.
/// This defines which source a particular default value comes from.
type private ArgumentDefaultSpec =
/// From parsing the environment variable with the given name (e.g. "WOOFWARE_DISABLE_FOO" or whatever).
| EnvironmentVariable of name : SynExpr
/// From calling the static member `{typeWeParseInto}.Default{name}()`
/// For example, if `type MyArgs = { Thing : Choice<int, int> }`, then
/// we would use `MyArgs.DefaultThing () : int`.
///
| FunctionCall of name : Ident
type private Accumulation<'choice> =
| Required
| Optional
| Choice of 'choice
| List of Accumulation<'choice>
type private ParseFunction<'acc> =
{
FieldName : Ident
TargetVariable : Ident
/// Any of the forms in this set are acceptable, but make sure they all start with a dash, or we might
/// get confused with positional args or something! I haven't thought that hard about this.
/// In the default case, this is `Const("arg-name")` for the `ArgName : blah` field; note that we have
/// omitted the initial `--` that will be required at runtime.
ArgForm : SynExpr list
/// If this is a boolean-like field (e.g. a bool or a flag DU), the help text should look a bit different:
/// we should lie to the user about the value of the cases there.
/// Similarly, if we're reading from an environment variable with the laxer parsing rules of accepting e.g.
/// "0" instead of "false", we need to know if we're reading a bool.
/// In that case, `boolCases` is Some, and contains the construction of the flag (or boolean, in which case
/// you get no data).
BoolCases : Choice<FlagDu, unit> option
Help : SynExpr option
/// A function string -> %TargetType%, where TargetVariable is probably a `%TargetType% option`.
/// (Depending on `Accumulation`, we'll remove the `option` at the end of the parse, asserting that the
/// argument was supplied.)
/// This is allowed to throw if it fails to parse.
Parser : SynExpr
/// If `Accumulation` is `List`, then this is the type of the list *element*; analogously for optionals
/// and choices and so on.
TargetType : SynType
Accumulation : 'acc
}
/// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all
/// the ways they can refer to this arg.
member arg.HumanReadableArgForm : SynExpr =
let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
[<RequireQualifiedAccess>]
type private ChoicePositional =
| Normal of includeFlagLike : SynExpr option
@@ -38,14 +114,14 @@ type private ParseTree<'hasPositional> =
/// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in
/// the branch (e.g. each record field name),
/// and composes them into a `SynExpr` (e.g. the record-typed object).
| DescendRecord of
| Branch of
fields : (Ident * ParseTree<HasNoPositional>) list *
assemble : (Map<string, SynExpr> -> SynExpr) *
Teq<'hasPositional, HasNoPositional>
/// `assemble` takes the SynExpr's (e.g. each record field contents) corresponding to each `Ident` in
/// the branch (e.g. each record field name),
/// and composes them into a `SynExpr` (e.g. the record-typed object).
| DescendRecordPos of
| BranchPos of
posField : Ident *
fields : ParseTree<HasPositional> *
(Ident * ParseTree<HasNoPositional>) list *
@@ -108,6 +184,63 @@ module private ParseTree =
go None ([], None) subs
let rec accumulatorsNonPos (tree : ParseTree<HasNoPositional>) : ParseFunctionNonPositional list =
match tree with
| ParseTree.PositionalLeaf (_, teq) -> exFalso teq
| ParseTree.BranchPos (_, _, _, _, teq) -> exFalso teq
| ParseTree.NonPositionalLeaf (pf, _) -> [ pf ]
| ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos)
/// Returns the positional arg separately.
let rec accumulatorsPos
(tree : ParseTree<HasPositional>)
: ParseFunctionNonPositional list * ParseFunctionPositional
=
match tree with
| ParseTree.PositionalLeaf (pf, _) -> [], pf
| ParseTree.NonPositionalLeaf (_, teq) -> exFalso' teq
| ParseTree.Branch (_, _, teq) -> exFalso' teq
| ParseTree.BranchPos (_, tree, trees, _, _) ->
let nonPos = trees |> List.collect (snd >> accumulatorsNonPos)
let nonPos2, pos = accumulatorsPos tree
nonPos @ nonPos2, pos
/// Collect all the ParseFunctions which are necessary to define variables, throwing away
/// all information relevant to composing the resulting variables into records.
/// Returns the list of non-positional parsers, and any positional parser that exists.
let accumulators<'a> (tree : ParseTree<'a>) : ParseFunctionNonPositional list * ParseFunctionPositional option =
// Sad duplication of some code here, but it was the easiest way to make it type-safe :(
match tree with
| ParseTree.PositionalLeaf (pf, _) -> [], Some pf
| ParseTree.NonPositionalLeaf (pf, _) -> [ pf ], None
| ParseTree.Branch (trees, _, _) -> trees |> List.collect (snd >> accumulatorsNonPos) |> (fun i -> i, None)
| ParseTree.BranchPos (_, tree, trees, _, _) ->
let nonPos = trees |> List.collect (snd >> accumulatorsNonPos)
let nonPos2, pos = accumulatorsPos tree
nonPos @ nonPos2, Some pos
|> fun (nonPos, pos) ->
let duplicateArgs =
// This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings.
Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm)
|> Seq.concat
|> Seq.choose (fun expr ->
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, _, _), _) -> Some s
| _ -> None
)
|> List.ofSeq
|> List.groupBy id
|> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None)
match duplicateArgs with
| [] -> nonPos, pos
| dups ->
let dups = dups |> String.concat " "
failwith $"Duplicate args detected! %s{dups}"
/// Build the return value.
let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr =
match tree with
@@ -1263,7 +1396,7 @@ module internal ArgParserGenerator =
[
SynMatchClause.create
SynPat.createNull
(SynPat.named "None")
(SynExpr.sequential
[
errorMessage
@@ -1273,7 +1406,7 @@ module internal ArgParserGenerator =
unchecked
])
SynMatchClause.create (SynPat.named "x") parser
SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "x" ]) parser
]
|> SynExpr.createMatch result
| ArgumentDefaultSpec.FunctionCall name ->
@@ -1561,7 +1694,7 @@ module internal ArgParserGenerator =
[ Ident.create "parse'" ]
[
SynPat.named "getEnvironmentVariable"
|> SynPat.annotateType (SynType.funFromDomain SynType.string SynType.string)
|> SynPat.annotateType (SynType.funFromDomain SynType.string (SynType.option SynType.string))
argsParam
]
|> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ])
@@ -1575,7 +1708,12 @@ module internal ArgParserGenerator =
let parse =
SynExpr.createLongIdent' parsePrimeCall
|> SynExpr.applyTo (SynExpr.createLongIdent [ "System" ; "Environment" ; "GetEnvironmentVariable" ])
|> SynExpr.applyTo (
SynExpr.paren (
SynExpr.createLongIdent [ "System" ; "Environment" ; "GetEnvironmentVariable" ]
|> SynExpr.composeWith (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
)
)
|> SynExpr.applyTo (SynExpr.createIdent "args")
|> SynBinding.basic [ Ident.create "parse" ] [ argsParam ]
|> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ])

View File

@@ -1,6 +1,5 @@
namespace WoofWare.Myriad.Plugins
open System.IO
open System.Net.Http
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
@@ -14,17 +13,6 @@ type internal HttpClientGeneratorOutputSpec =
module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range
let outputFile = FileInfo "/tmp/output.txt"
// do
// use _ = File.Create outputFile.FullName
// ()
let log (line : string) =
// use w = outputFile.AppendText ()
// w.WriteLine line
()
[<RequireQualifiedAccess>]
type PathSpec =
| Verbatim of string
@@ -82,7 +70,7 @@ module internal HttpClientGenerator =
if m = HttpMethod.Get then "Get"
elif m = HttpMethod.Post then "Post"
elif m = HttpMethod.Delete then "Delete"
elif m = HttpMethod.Patch then "Post"
elif m = HttpMethod.Patch then "Patch"
elif m = HttpMethod.Options then "Options"
elif m = HttpMethod.Head then "Head"
elif m = HttpMethod.Put then "Put"
@@ -409,30 +397,59 @@ module internal HttpClientGenerator =
| String -> SynExpr.createIdent "responseString"
| Stream -> SynExpr.createIdent "responseStream"
| RestEaseResponseType contents ->
let deserialiser =
JsonParseGenerator.parseNode
match JsonNodeWithNullability.Identify contents with
| CannotBeNull ->
let deserialiser =
JsonParseGenerator.parseNonNullableNode
None
JsonParseGenerator.JsonParseOption.None
contents
(SynExpr.createIdent "jsonNode")
|> SynExpr.paren
|> SynExpr.createThunk
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
SynExpr.createNew
(SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ])
(SynExpr.tupleNoParen
[
SynExpr.createIdent "responseString"
SynExpr.createIdent "response"
deserialiser
])
| Nullable ->
let deserialiser =
JsonParseGenerator.parseNullableNode
None
JsonParseGenerator.JsonParseOption.None
contents
(SynExpr.createIdent "jsonNode")
|> SynExpr.paren
|> SynExpr.createThunk
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
SynExpr.createNew
(SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ])
(SynExpr.tupleNoParen
[
SynExpr.createIdent "responseString"
SynExpr.createIdent "response"
deserialiser
])
| retType ->
match JsonNodeWithNullability.Identify retType with
| Nullable ->
JsonParseGenerator.parseNullableNode
None
JsonParseGenerator.JsonParseOption.None
contents
retType
(SynExpr.createIdent "jsonNode")
| CannotBeNull ->
JsonParseGenerator.parseNonNullableNode
None
JsonParseGenerator.JsonParseOption.None
retType
(SynExpr.createIdent "jsonNode")
|> SynExpr.paren
|> SynExpr.createThunk
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
SynExpr.createNew
(SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ])
(SynExpr.tupleNoParen
[
SynExpr.createIdent "responseString"
SynExpr.createIdent "response"
deserialiser
])
| retType ->
JsonParseGenerator.parseNode
None
JsonParseGenerator.JsonParseOption.None
retType
(SynExpr.createIdent "jsonNode")
let contentTypeHeader, memberHeaders =
info.Headers
@@ -505,23 +522,45 @@ module internal HttpClientGenerator =
)
]
| BodyParamMethods.Serialise ty ->
let isNullable =
match JsonNodeWithNullability.Identify ty with
| CannotBeNull -> false
| Nullable -> true
[
Let (
"queryParams",
createStringContent (
SynExpr.createIdent' bodyParamName
|> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty))
|> SynExpr.pipeThroughFunction (
fst (
(if isNullable then
JsonSerializeGenerator.serializeNodeNullable
else
JsonSerializeGenerator.serializeNodeNonNullable)
ty
)
)
|> SynExpr.pipeThroughFunction (
SynExpr.createLambda
"node"
(SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createIdent "isNull")
(SynExpr.createIdent "node"))
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
(SynExpr.CreateConst ()))
(SynExpr.CreateConst "null"))
(if isNullable then
SynExpr.createMatch
(SynExpr.createIdent "node")
[
SynMatchClause.create
(SynPat.named "None")
(SynExpr.CreateConst "null")
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "node" ])
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
(SynExpr.CreateConst ()))
]
else
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
(SynExpr.CreateConst ())))
)
)
)
@@ -568,6 +607,24 @@ module internal HttpClientGenerator =
)
)
let jsonNodeWithoutNull =
match JsonNodeWithNullability.Identify info.TaskReturnType with
| Nullable ->
Let (
"jsonNode",
SynExpr.createIdent "jsonNode"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
)
| CannotBeNull ->
Let (
"jsonNode",
JsonSerializeGenerator.assertNotNull
(Ident.create "jsonNode")
(SynExpr.CreateConst
$"Response from server was the JSON null object; expected a non-nullable type %s{SynType.toHumanReadableString info.TaskReturnType}")
(SynExpr.createIdent "jsonNode")
)
let setVariableHeaders =
variableHeaders
|> List.map (fun (headerName, callToGetValue) ->
@@ -642,6 +699,7 @@ module internal HttpClientGenerator =
yield responseString
yield responseStream
yield jsonNode
yield jsonNodeWithoutNull
| String -> yield responseString
| Stream -> yield responseStream
| UnitType ->
@@ -650,6 +708,7 @@ module internal HttpClientGenerator =
| _ ->
yield responseStream
yield jsonNode
yield jsonNodeWithoutNull
]
|> SynExpr.createCompExpr "async" returnExpr
|> SynExpr.startAsTask cancellationTokenArg

View File

@@ -26,7 +26,7 @@ module internal JsonParseGenerator =
}
/// (match {indexed} with | null -> raise (System.Collections.Generic.KeyNotFoundException ({propertyName} not found)) | v -> v)
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
let assertPropertyExists (propertyName : SynExpr) (indexed : SynExpr) =
let raiseExpr =
SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
@@ -40,34 +40,34 @@ module internal JsonParseGenerator =
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
[
SynMatchClause.create SynPat.createNull raiseExpr
SynMatchClause.create (SynPat.named "v") (SynExpr.createIdent "v")
SynMatchClause.create (SynPat.named "None") raiseExpr
SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "v" ]) (SynExpr.createIdent "v")
]
|> SynExpr.createMatch indexed
|> SynExpr.paren
/// {node}.AsValue().GetValue<{typeName}> ()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
/// If `propertyName` is Some, uses `assertPropertyExists {node}` instead of `{node}`.
let asValueGetValue (propertyName : SynExpr option) (typeName : string) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
| Some propertyName -> assertPropertyExists propertyName node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod' "GetValue" typeName
let asValueGetValueIdent (propertyName : SynExpr option) (typeName : LongIdent) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
| Some propertyName -> assertPropertyExists propertyName node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod (SynLongIdent.createS "GetValue") [ SynType.createLongIdent typeName ]
/// {node}.AsObject()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
/// If `propertyName` is Some, uses `assertPropertyExists {node}` instead of `{node}`.
let asObject (propertyName : SynExpr option) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
| Some propertyName -> assertPropertyExists propertyName node
|> SynExpr.callMethod "AsObject"
/// {type}.jsonParse {node}
@@ -77,11 +77,12 @@ module internal JsonParseGenerator =
/// collectionType is e.g. "List"; we'll be calling `ofSeq` on it.
/// body is the body of a lambda which takes a parameter `elt`.
/// {assertNotNull node}.AsArray()
/// |> Seq.map (fun elt -> {body})
/// {assertPropertyExists node}.AsArray()
/// |> Seq.map (fun elt -> {assertNotNull} {body})
/// |> {collectionType}.ofSeq
let asArrayMapped
(propertyName : SynExpr option)
(elementType : SynType)
(collectionType : string)
(node : SynExpr)
(body : SynExpr)
@@ -89,10 +90,23 @@ module internal JsonParseGenerator =
=
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
| Some propertyName -> assertPropertyExists propertyName node
|> SynExpr.callMethod "AsArray"
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) (SynExpr.createLambda "elt" body)
body
|> JsonSerializeGenerator.assertNotNull
(Ident.create "elt")
(match propertyName with
| None ->
SynExpr.CreateConst
$"Expected element of array (element type %s{SynType.toHumanReadableString elementType}) to be non-null, but found a null element"
| Some propertyName ->
SynExpr.CreateConst
$"Expected element of array (element type %s{SynType.toHumanReadableString elementType}) to be non-null, but found a null element, at %%s"
|> SynExpr.applyFunction (SynExpr.createIdent "sprintf")
|> SynExpr.applyTo propertyName)
|> SynExpr.createLambda "elt"
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ])
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ])
@@ -101,14 +115,41 @@ module internal JsonParseGenerator =
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
let dictionaryMapper
(propertyName : SynExpr option)
(valueTypeIsNullable : bool)
(key : SynExpr -> SynExpr)
(valueType : SynType)
(value : SynExpr -> SynExpr)
: SynExpr
=
let keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> SynExpr.paren
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.paren
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ]
let value =
if valueTypeIsNullable then
(value (SynExpr.createIdent "value"))
else
let errorMessage =
match propertyName with
| None ->
SynExpr.CreateConst
$"Expected dictionary value of type %s{SynType.toHumanReadableString valueType} to be non-null, but it was null"
| Some propertyName ->
SynExpr.CreateConst
$"Expected dictionary value of type %s{SynType.toHumanReadableString valueType} to be non-null, but it was null, at key %%s"
|> SynExpr.applyFunction (SynExpr.createIdent "sprintf")
|> SynExpr.applyTo propertyName
JsonSerializeGenerator.assertNotNull
(Ident.create "value")
errorMessage
(value (SynExpr.createIdent "value"))
// No need to paren here, we're on the LHS of a `let`
SynExpr.tupleNoParen [ SynExpr.createIdent "key" ; SynExpr.createIdent "value" ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "value" ] [] (value valueArg) ]
SynExpr.tupleNoParen [ SynExpr.createIdent "key" ; value ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "value" ] [] valueArg ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "key" ] [] (key keyArg) ]
|> SynExpr.createLambda "kvp"
@@ -165,10 +206,61 @@ module internal JsonParseGenerator =
))
handler
let rec parseNullableNode
// TODO: unused?!
(propertyName : SynExpr option)
(options : JsonParseOption)
(fieldType : SynType)
(node : SynExpr)
: SynExpr
=
match fieldType with
| OptionType ty ->
match ty with
| OptionType _
| NullableType _ ->
failwith
$"Nested nullable types are not supported, because we can't distinguish between None and Some None. %s{SynType.toHumanReadableString ty}"
| _ ->
let someClause =
parseNonNullableNode None options ty (SynExpr.createIdent "v")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "v" ])
[
SynMatchClause.create (SynPat.named "None") (SynExpr.createIdent "None")
someClause
]
|> SynExpr.createMatch node
| NullableType ty ->
match ty with
| OptionType _
| NullableType _ ->
failwith
$"Nested nullable types are not supported, because we can't distinguish between None and Some None. %s{SynType.toHumanReadableString ty}"
| _ ->
let someClause =
parseNonNullableNode None options ty (SynExpr.createIdent "v")
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ])
|> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "v" ])
[
SynMatchClause.create
(SynPat.named "None")
(SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ]) (SynExpr.CreateConst ()))
someClause
]
|> SynExpr.createMatch node
| _ ->
failwith
$"Encountered type %s{SynType.toHumanReadableString fieldType} which is expected to be nullable, but couldn't identify it"
/// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
/// The property name is used in error messages at runtime to show where a JSON
/// parse error occurred; supply `None` to indicate "don't validate".
let rec parseNode
and parseNonNullableNode
(propertyName : SynExpr option)
(options : JsonParseOption)
(fieldType : SynType)
@@ -177,101 +269,184 @@ module internal JsonParseGenerator =
=
// TODO: parsing format for DateTime etc
match fieldType with
| OptionType _
| NullableType _ ->
failwith
$"Unexpectedly parsing nullable type %s{SynType.toHumanReadableString fieldType} as if it were non-nullable."
// Struct types
| DateOnly ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateOnly" ; "Parse" ])
| Uri ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
| Guid ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
| DateTime ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
| NumberType typeName -> parseNumberType options propertyName node typeName
| Guid ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
// Reference types
| Uri ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
| DateTimeOffset ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTimeOffset" ; "Parse" ])
| NumberType typeName -> parseNumberType options propertyName node typeName
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
| OptionType ty ->
let someClause =
parseNode None options ty (SynExpr.createIdent "v")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynMatchClause.create (SynPat.named "v")
[
SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None")
someClause
]
|> SynExpr.createMatch node
| NullableType ty ->
let someClause =
parseNode None options ty (SynExpr.createIdent "v")
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ])
|> SynMatchClause.create (SynPat.named "v")
[
SynMatchClause.create
SynPat.createNull
(SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ]) (SynExpr.CreateConst ()))
someClause
]
|> SynExpr.createMatch node
| ListType ty ->
parseNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName "List" node
match JsonNodeWithNullability.Identify ty with
| CannotBeNull ->
parseNonNullableNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName ty "List" node
| Nullable ->
parseNullableNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName ty "List" node
| ArrayType ty ->
parseNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName "Array" node
match JsonNodeWithNullability.Identify ty with
| CannotBeNull ->
parseNonNullableNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName ty "Array" node
| Nullable ->
parseNullableNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName ty "Array" node
| IDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "dict")
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
false
(parseKeyString keyType)
valueType
(parseNonNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "dict")
| Nullable ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
true
(parseKeyString keyType)
valueType
(parseNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "dict")
| DictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ])
)
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]
)
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
false
(parseKeyString keyType)
valueType
(parseNonNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ])
)
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]
)
| Nullable ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
true
(parseKeyString keyType)
valueType
(parseNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ])
)
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]
)
| IReadOnlyDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "readOnlyDict")
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
false
(parseKeyString keyType)
valueType
(parseNonNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "readOnlyDict")
| Nullable ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
true
(parseKeyString keyType)
valueType
(parseNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "readOnlyDict")
| MapType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Map" ; "ofSeq" ])
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
false
(parseKeyString keyType)
valueType
(parseNonNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Map" ; "ofSeq" ])
| Nullable ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper
propertyName
true
(parseKeyString keyType)
valueType
(parseNullableNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Map" ; "ofSeq" ])
| BigInt ->
node
|> SynExpr.callMethod "ToJsonString"
@@ -282,7 +457,7 @@ module internal JsonParseGenerator =
|> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
| JsonNode -> node
| UnitType -> SynExpr.CreateConst ()
| _ ->
| fieldType ->
// Let's just hope that we've also got our own type annotation!
let typeName =
match fieldType with
@@ -291,14 +466,45 @@ module internal JsonParseGenerator =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
| Some propertyName -> assertPropertyExists propertyName node
|> typeJsonParse typeName
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding).
let createParseRhs (options : JsonParseOption) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
let objectToParse = SynExpr.createIdent "node" |> SynExpr.index propertyName
parseNode (Some propertyName) options fieldType objectToParse
match JsonNodeWithNullability.Identify fieldType with
| Nullable ->
let objectToParse =
SynExpr.createIdent "node"
|> SynExpr.index propertyName
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
parseNullableNode (Some propertyName) options fieldType objectToParse
| CannotBeNull ->
[
SynMatchClause.create
(SynPat.named "None")
(SynExpr.applyFunction
(SynExpr.createIdent "raise")
(SynExpr.paren (
SynExpr.applyFunction
(SynExpr.createLongIdent
[ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ])
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "Required key '%s' not found on JSON object")
|> SynExpr.applyTo (SynExpr.paren propertyName)
|> SynExpr.paren)
)))
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "node" ])
(parseNonNullableNode None options fieldType (SynExpr.createIdent "node"))
]
|> SynExpr.createMatch (
SynExpr.createIdent "node"
|> SynExpr.index propertyName
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
)
let isJsonNumberHandling (literal : LongIdent) : bool =
match List.rev literal |> List.map (fun ident -> ident.idText) with
@@ -505,7 +711,8 @@ module internal JsonParseGenerator =
|> SynExpr.createLet
[
SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
|> assertNotNull (SynExpr.CreateConst "data")
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
|> assertPropertyExists (SynExpr.CreateConst "data")
|> SynBinding.basic [ Ident.create "node" ] []
]
@@ -553,7 +760,8 @@ module internal JsonParseGenerator =
SynExpr.createIdent "node"
|> SynExpr.index property
|> assertNotNull property
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
|> assertPropertyExists property
|> SynExpr.pipeThroughFunction (
SynExpr.createLambda "v" (SynExpr.callGenericMethod' "GetValue" "string" (SynExpr.createIdent "v"))
)

View File

@@ -10,24 +10,100 @@ type internal JsonSerializeOutputSpec =
ExtensionMethods : bool
}
/// https://github.com/Smaug123/WoofWare.Myriad/issues/364
/// The insane design of System.Text.Json is finally causing us to
/// do vast amounts of coding rather than merely being very annoying.
type internal JsonNodeWithNullability =
| CannotBeNull
| Nullable
static member Identify (ty : SynType) : JsonNodeWithNullability =
match ty with
| OptionType _
| NullableType _ -> JsonNodeWithNullability.Nullable
| _ -> JsonNodeWithNullability.CannotBeNull
[<RequireQualifiedAccess>]
module internal JsonSerializeGenerator =
open Fantomas.FCS.Text.Range
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
// identically equal to null. We have to work around this later, but we might as well just
// be efficient here and whip up the null directly.
let private jsonNull () =
SynExpr.createNull ()
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
// identically equal to null, so it's hard to use that type. We use `None` instead to represent
// the JSON null value.
let private jsonNull () = SynExpr.createIdent "None"
let assertNotNull (boundIdent : Ident) (message : SynExpr) (body : SynExpr) : SynExpr =
let raiseExpr =
message
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
|> SynExpr.paren
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
[
SynMatchClause.create SynPat.createNull raiseExpr
SynMatchClause.create (SynPat.namedI boundIdent) body
]
|> SynExpr.createMatch (SynExpr.createIdent' boundIdent)
|> SynExpr.paren
/// The output of this will be an *optional* JsonNode.
let rec serializeNodeNullable (fieldType : SynType) : SynExpr * bool =
match fieldType with
| NullableType ty ->
// fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null
match JsonNodeWithNullability.Identify ty with
| JsonNodeWithNullability.Nullable ->
failwith
$"We don't support nested nullable types, because we can't tell the difference between None and Some None: %s{SynType.toHumanReadableString ty}"
| JsonNodeWithNullability.CannotBeNull ->
let inner, innerIsJsonNode = serializeNodeNonNullable ty
SynExpr.applyFunction inner (SynExpr.createLongIdent [ "field" ; "Value" ])
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ())
|> SynExpr.createLambda "field"
|> fun e -> e, innerIsJsonNode
| OptionType ty ->
// fun field -> match field with | None -> None | Some v -> {serializeNode ty} field |> Some
match JsonNodeWithNullability.Identify ty with
| JsonNodeWithNullability.Nullable ->
failwith
$"We don't support nested nullable types, because we can't tell the difference between None and Some None: %s{SynType.toHumanReadableString ty}"
| JsonNodeWithNullability.CannotBeNull ->
let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None")
let someClause =
let inner, innerIsJsonNode = serializeNodeNonNullable ty
let target = SynExpr.pipeThroughFunction inner (SynExpr.createIdent "field")
if innerIsJsonNode then
target
else
target
|> SynExpr.paren
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "field" ])
[ noneClause ; someClause ]
|> SynExpr.createMatch (SynExpr.createIdent "field")
|> SynExpr.createLambda "field"
|> fun e -> e, true
| _ -> failwith $"Did not recognise type %s{SynType.toHumanReadableString fieldType} as nullable"
/// Given `input.Ident`, for example, choose how to add it to the ambient `node`.
/// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`.
/// Returns also a bool which is true if the resulting SynExpr represents something of type JsonNode.
let rec serializeNode (fieldType : SynType) : SynExpr * bool =
and serializeNodeNonNullable (fieldType : SynType) : SynExpr * bool =
// TODO: serialization format for DateTime etc
match fieldType with
| OptionType _
| NullableType _ ->
failwith $"Tried to treat the type %s{SynType.toHumanReadableString fieldType} as non-nullable"
| DateOnly
| DateTime
| NumberType _
@@ -36,8 +112,21 @@ module internal JsonSerializeGenerator =
| Guid
| Uri ->
// JsonValue.Create<type>
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
|> SynExpr.typeApp [ fieldType ]
(SynExpr.createIdent "field")
|> assertNotNull
(Ident.create "field")
(SynExpr.CreateConst
$"Expected type %s{SynType.toHumanReadableString fieldType} to be non-null, but received a null value when serialising")
|> SynExpr.createLet
[
SynBinding.basic
[ Ident.create "field" ]
[]
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
|> SynExpr.typeApp [ fieldType ]
|> SynExpr.applyTo (SynExpr.createIdent "field"))
]
|> SynExpr.createLambda "field"
|> fun e -> e, false
| DateTimeOffset ->
// fun field -> field.ToString("o") |> JsonValue.Create<string>
@@ -50,41 +139,17 @@ module internal JsonSerializeGenerator =
|> SynExpr.pipeThroughFunction create
|> SynExpr.createLambda "field"
|> fun e -> e, false
| NullableType ty ->
// fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null
let inner, innerIsJsonNode = serializeNode ty
SynExpr.applyFunction inner (SynExpr.createLongIdent [ "field" ; "Value" ])
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ())
|> SynExpr.createLambda "field"
|> fun e -> e, innerIsJsonNode
| OptionType ty ->
// fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None")
let someClause =
let inner, innerIsJsonNode = serializeNode ty
let target = SynExpr.applyFunction inner (SynExpr.createIdent "field")
if innerIsJsonNode then
target
else
target
|> SynExpr.paren
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "field" ])
[ noneClause ; someClause ]
|> SynExpr.createMatch (SynExpr.createIdent "field")
|> SynExpr.createLambda "field"
|> fun e -> e, true
| ArrayType ty
| ListType ty ->
// fun field ->
// let arr = JsonArray ()
// for mem in field do arr.Add ({serializeNode} mem)
// arr
let isNullableChild =
match JsonNodeWithNullability.Identify ty with
| CannotBeNull -> false
| Nullable -> true
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
@@ -95,7 +160,17 @@ module internal JsonSerializeGenerator =
SynExpr.createIdent "field",
SynExpr.applyFunction
(SynExpr.createLongIdent [ "arr" ; "Add" ])
(SynExpr.paren (SynExpr.applyFunction (fst (serializeNode ty)) (SynExpr.createIdent "mem"))),
(SynExpr.paren (
SynExpr.applyFunction
(fst (
(if isNullableChild then
serializeNodeNullable
else
serializeNodeNonNullable)
ty
))
(SynExpr.createIdent "mem")
)),
range0
)
SynExpr.createIdent "arr"
@@ -109,15 +184,28 @@ module internal JsonSerializeGenerator =
]
|> SynExpr.createLambda "field"
|> fun e -> e, false
| IDictionaryType (_keyType, valueType)
| DictionaryType (_keyType, valueType)
| IReadOnlyDictionaryType (_keyType, valueType)
| MapType (_keyType, valueType) ->
| IDictionaryType (keyType, valueType)
| DictionaryType (keyType, valueType)
| IReadOnlyDictionaryType (keyType, valueType)
| MapType (keyType, valueType) ->
// fun field ->
// let ret = JsonObject ()
// for (KeyValue(key, value)) in field do
// ret.Add (key.ToString (), {serializeNode} value)
// ret
let isNullableValueField =
match JsonNodeWithNullability.Identify valueType with
| CannotBeNull -> false
| Nullable -> true
// TODO: this is a bit dubious, because user-defined types will
// by default have non-null ToString
let keyTypeHasNonNullToString =
match keyType with
| String
| Uri -> true
| _ -> false
[
SynExpr.ForEach (
DebugPointAtFor.Yes range0,
@@ -130,10 +218,33 @@ module internal JsonSerializeGenerator =
(SynExpr.createLongIdent [ "ret" ; "Add" ])
(SynExpr.tuple
[
SynExpr.createLongIdent [ "key" ; "ToString" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
SynExpr.applyFunction (fst (serializeNode valueType)) (SynExpr.createIdent "value")
]),
SynExpr.createIdent "key"
|> if keyTypeHasNonNullToString then
id
else
assertNotNull
(Ident.create "key")
(SynExpr.CreateConst
"A map key unexpectedly yielded null when we `ToString`'ed it. Map keys must yield non-null strings on `ToString`.")
SynExpr.applyFunction
(fst (
(if isNullableValueField then
serializeNodeNullable
else
serializeNodeNonNullable)
valueType
))
(SynExpr.createIdent "value")
])
|> SynExpr.createLet
[
SynBinding.basic
[ Ident.create "key" ]
[]
(SynExpr.createLongIdent [ "key" ; "ToString" ]
|> SynExpr.applyTo (SynExpr.CreateConst ()))
],
range0
)
SynExpr.createIdent "ret"
@@ -166,13 +277,24 @@ module internal JsonSerializeGenerator =
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// `node.Add ({propertyName}, {toJsonNode})`
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
[
propertyName
SynExpr.pipeThroughFunction
(fst (serializeNode fieldType))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
|> SynExpr.paren
]
let isNullableField =
match JsonNodeWithNullability.Identify fieldType with
| CannotBeNull -> false
| Nullable -> true
let serialised =
if isNullableField then
let value =
serializeNodeNullable fieldType
|> fst
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "toObj" ])
SynExpr.pipeThroughFunction value (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
else
let value = serializeNodeNonNullable fieldType |> fst
SynExpr.pipeThroughFunction value (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
[ propertyName ; SynExpr.paren serialised ]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
@@ -278,7 +400,10 @@ module internal JsonSerializeGenerator =
| DictionaryType (String, v) -> v
| _ -> failwith "Expected JsonExtensionData to be a Dictionary<string, something>"
let serialise = fst (serializeNode valType)
let serialise =
match JsonNodeWithNullability.Identify valType with
| CannotBeNull -> fst (serializeNodeNonNullable valType)
| Nullable -> fst (serializeNodeNullable valType)
SynExpr.createIdent "node"
|> SynExpr.callMethodArg
@@ -343,7 +468,15 @@ module internal JsonSerializeGenerator =
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
let node =
SynExpr.applyFunction (fst (serializeNode fieldData.Type)) (SynExpr.createIdent caseName)
match JsonNodeWithNullability.Identify fieldData.Type with
| CannotBeNull ->
SynExpr.applyFunction
(fst (serializeNodeNonNullable fieldData.Type))
(SynExpr.createIdent caseName)
| Nullable ->
SynExpr.applyFunction
(fst (serializeNodeNullable fieldData.Type))
(SynExpr.createIdent caseName)
[ propertyName ; node ]
|> SynExpr.tuple

View File

@@ -21,13 +21,3 @@ module private List =
| Some head :: tail -> go (head :: acc) tail
go [] l
/// Return the first error encountered, or the entire list.
let allOkOrError<'ok, 'err> (l : Result<'ok, 'err> list) : Result<'ok list, 'err> =
let rec go acc l =
match l with
| [] -> Ok (List.rev acc)
| Error e :: _ -> Error e
| Ok o :: rest -> go (o :: acc) rest
go [] l

File diff suppressed because it is too large Load Diff

View File

@@ -198,7 +198,14 @@ and ObjectTypeDefinition =
|> Map.ofSeq
|> Some
let example = asObjOpt node "example"
let example =
match node.["example"] with
| null -> None
| :? JsonObject as o -> Some o
| _ ->
// Gitea returns a stringified and malformed JSON object here.
// Don't throw; just omit.
None
let required = asArrOpt'<string> node "required"
@@ -465,7 +472,7 @@ type HttpMethod =
| HttpMethod.Get -> "Get"
| HttpMethod.Post -> "Post"
| HttpMethod.Delete -> "Delete"
| HttpMethod.Patch -> "Post"
| HttpMethod.Patch -> "Patch"
| HttpMethod.Options -> "Options"
| HttpMethod.Head -> "Head"
| HttpMethod.Put -> "Put"

View File

@@ -1,7 +1,6 @@
namespace WoofWare.Myriad.Plugins
open System.Collections.Generic
open System.IO
open System.Threading
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
@@ -19,6 +18,7 @@ type internal SwaggerClientConfig =
type internal Produces =
// TODO: this will cope with decoding JSON, plain text, etc
| Produces of string
| OctetStream
type internal Endpoint =
{
@@ -47,16 +47,8 @@ type internal Types =
[<RequireQualifiedAccess>]
module internal SwaggerClientGenerator =
let outputFile = FileInfo "/tmp/output.txt"
// do
// use _ = File.Create outputFile.FullName
// ()
let log (line : string) =
// use w = outputFile.AppendText ()
// w.WriteLine line
()
let internal log (_ : string) = ()
let renderType (types : Types) (defn : Definition) : SynType option =
match types.ByDefinition.TryGetValue defn with
@@ -477,6 +469,15 @@ module internal SwaggerClientGenerator =
(SynLongIdent.createS' [ "RestEase" ; "Header" ])
// Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path.
(SynExpr.tuple [ SynExpr.CreateConst "Content-Type" ; SynExpr.CreateConst contentType ])
| Produces.OctetStream ->
SynAttribute.create
(SynLongIdent.createS' [ "RestEase" ; "Header" ])
// Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path.
(SynExpr.tuple
[
SynExpr.CreateConst "Content-Type"
SynExpr.CreateConst "application/octet-stream"
])
]
returnType
@@ -512,6 +513,7 @@ module internal SwaggerClientGenerator =
|> List.singleton
open Myriad.Core
open System.IO
/// Myriad generator that stamps out an interface and class to access a Swagger-specified API.
[<MyriadGenerator("swagger-client")>]
@@ -622,10 +624,11 @@ type SwaggerClientGenerator () =
let produces =
match endpoint.Produces with
| None -> Produces "json"
| None -> Produces.Produces "json"
| Some [] -> failwith $"API specified empty Produces: %s{path} (%O{method})"
| Some [ MimeType "application/json" ] -> Produces "json"
| Some [ MimeType (StartsWith "text/" t) ] -> Produces t
| Some [ MimeType "application/octet-stream" ] -> Produces.OctetStream
| Some [ MimeType "application/json" ] -> Produces.Produces "json"
| Some [ MimeType (StartsWith "text/" t) ] -> Produces.Produces t
| Some [ MimeType s ] ->
failwithf
$"we don't support non-JSON Produces right now, got: %s{s} (%s{path} %O{method})"

View File

@@ -22,7 +22,7 @@
<ItemGroup>
<PackageReference Include="Myriad.Core" Version="0.8.3" />
<PackageReference Include="TypeEquality" Version="0.3.0" />
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.5.1" />
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.6.3" />
<!-- the lowest version allowed by Myriad.Core -->
<PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
</ItemGroup>
@@ -40,8 +40,7 @@
<Compile Include="JsonParseGenerator.fs"/>
<Compile Include="HttpClientGenerator.fs"/>
<Compile Include="CataGenerator.fs" />
<Compile Include="ShibaGenerator.fs" />
<None Include="ArgParserGenerator.fs" />
<Compile Include="ArgParserGenerator.fs" />
<Compile Include="Swagger.fs" />
<Compile Include="SwaggerClientGenerator.fs" />
<None Include="ApacheLicence.txt" />

View File

@@ -1,5 +1,5 @@
{
"version": "4.0",
"version": "7.0",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
@@ -11,4 +11,4 @@
":/README.md",
":/Directory.Build.props"
]
}
}

View File

@@ -10,8 +10,6 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Att
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Myriad.Plugins.Attributes.Test", "WoofWare.Myriad.Plugins.Attributes\Test\WoofWare.Myriad.Plugins.Attributes.Test.fsproj", "{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Playground", "Playground\Playground.fsproj", "{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -38,9 +36,5 @@ Global
{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Debug|Any CPU.Build.0 = Debug|Any CPU
{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.ActiveCfg = Release|Any CPU
{26DC0C94-85F2-45B4-8FA1-1B27201F7AFB}.Release|Any CPU.Build.0 = Release|Any CPU
{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6DF8C756-DE59-4AFF-A4BB-2D05C74192A4}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1744502386,
"narHash": "sha256-QAd1L37eU7ktL2WeLLLTmI6P9moz9+a/ONO8qNBYJgM=",
"lastModified": 1744868846,
"narHash": "sha256-5RJTdUHDmj12Qsv7XOhuospjAjATNiTMElplWnJE9Hs=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "f6db44a8daa59c40ae41ba6e5823ec77fe0d2124",
"rev": "ebe4301cbd8f81c4f8d3244b3632338bbeb6d49c",
"type": "github"
},
"original": {

View File

@@ -381,7 +381,7 @@
},
{
"pname": "WoofWare.Whippet.Fantomas",
"version": "0.5.1",
"hash": "sha256-59CwnOZQAq5ZJoUkd87OiP8KUwx8xYDLMimMMTlKeZA="
"version": "0.6.3",
"hash": "sha256-FkW/HtVp8/HE2k6d7yFpnJcnP3FNNe9kGlkoIWmNgDw="
}
]