Compare commits

..

29 Commits

Author SHA1 Message Date
Smaug123
f686109331 More 2025-04-18 15:08:20 +01:00
Smaug123
7b2c3d2168 Start on the union generator 2025-04-17 21:56:25 +01:00
Smaug123
3ed8d4db00 Add help text placeholder 2025-04-17 21:38:44 +01:00
Smaug123
75ce8c1f64 Fix test 2025-04-17 18:45:57 +01:00
Smaug123
01714aeba0 Fix all but the help text 2025-04-17 18:31:25 +01:00
Smaug123
2f266b052d Fix another test 2025-04-17 16:02:20 +01:00
Smaug123
d3d50cae7c Fix another test 2025-04-17 15:49:12 +01:00
Smaug123
573d410416 Fix another test 2025-04-17 12:47:48 +01:00
Smaug123
a82ece0f6c Plumb through indices 2025-04-17 12:41:55 +01:00
Smaug123
51991cab74 Fix another test 2025-04-17 11:45:34 +01:00
Smaug123
55a3876610 More 2025-04-17 11:13:37 +01:00
Smaug123
c14f89f807 Fix another test 2025-04-17 11:05:08 +01:00
Smaug123
54e3f17d9c It's sort of working 2025-04-17 00:18:53 +01:00
Smaug123
4013271254 More 2025-04-16 23:04:23 +01:00
Smaug123
aa2ef830c3 Add flags 2025-04-16 21:26:30 +01:00
Smaug123
4e62a154c0 Undo accidental revert 2025-04-15 22:51:43 +01:00
Smaug123
751e43eec4 More 2025-04-15 22:50:14 +01:00
Smaug123
fccc981045 WIP 2025-04-15 09:23:24 +01:00
Smaug123
f8a1505b99 Undo build-offline mode 2025-04-14 23:08:40 +01:00
Smaug123
eb25b9ccb8 Merge branch 'main' into du-parser 2025-04-14 23:07:34 +01:00
Smaug123
34587b8dea Merge branch 'main' into du-parser 2025-04-14 23:02:19 +01:00
Smaug123
963a097360 First line of implementation 2025-04-14 22:52:18 +01:00
Smaug123
67eb89cfc0 Getting there 2025-04-14 22:27:57 +01:00
Smaug123
0c5ddf9df7 WIP 2025-04-14 00:01:55 +01:00
Smaug123
8535481e0d Bump Whippet 2025-04-13 21:09:12 +01:00
Smaug123
df6079e763 WIP 2025-04-13 20:34:52 +01:00
Smaug123
4befdb93e5 WIP: define the helper types 2025-04-13 18:43:23 +01:00
Smaug123
17da7317e8 Merge branch 'main' into du-parser 2025-04-13 16:07:59 +01:00
Smaug123
fa022b75ea WIP: complete arg parser 2025-04-13 11:52:17 +01:00
30 changed files with 18589 additions and 31572 deletions

View File

@@ -1,27 +1,5 @@
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,3 +235,9 @@ type FlagsIntoPositionalArgs' =
[<PositionalArgs false>]
DontGrabEverything : string list
}
[<ArgParser true>]
type PassThru =
{
A : ParentRecordChildPos
}

View File

@@ -0,0 +1,35 @@
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,7 +4,6 @@
<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"/>
@@ -13,6 +12,7 @@
<ItemGroup>
<None Include="myriad.toml"/>
<Compile Include="AssemblyInfo.fs" />
<!--
<Compile Include="RecordFile.fs"/>
<Compile Include="GeneratedRecord.fs">
<MyriadFile>RecordFile.fs</MyriadFile>
@@ -67,10 +67,16 @@
<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>
@@ -82,6 +88,7 @@
<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

@@ -0,0 +1,686 @@
//------------------------------------------------------------------------------
// 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,24 +14,7 @@ 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
|> (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)
))
)
do node.Add ((Literals.something), (input.InternalThing2 |> System.Text.Json.Nodes.JsonValue.Create<string>))
node :> _
namespace ConsumePlugin
@@ -46,24 +29,7 @@ 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
|> (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)
))
)
do node.Add ((Literals.something), (input.ExternalThing |> System.Text.Json.Nodes.JsonValue.Create<string>))
node :> _
namespace ConsumePlugin
@@ -74,14 +40,16 @@ module InnerType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
let arg_0 =
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> ()
(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> ()
{
Thing = arg_0
@@ -94,97 +62,79 @@ module JsonRecordType =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
let arg_5 =
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
(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
let arg_4 =
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
(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
let arg_3 =
match node.["d"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
InnerType.jsonParse (
match node.["d"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
)
)
| Some node -> InnerType.jsonParse node
| v -> v
)
let arg_2 =
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
(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
let arg_1 =
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> ()
(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> ()
let arg_0 =
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> ()
(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> ()
{
A = arg_0
@@ -202,14 +152,16 @@ module internal InternalTypeNotExtension =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InternalTypeNotExtension =
let arg_0 =
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> ()
(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> ()
{
InternalThing = arg_0
@@ -225,14 +177,16 @@ 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)] |> 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> ()
(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> ()
{
ExternalThing = arg_0
@@ -247,215 +201,248 @@ module ToGetExtensionMethodJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
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_20 = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ())
let arg_19 =
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> ()
(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> ()
let arg_18 =
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> ()
(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> ()
let arg_17 =
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> ()
(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> ()
let arg_16 =
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> ()
(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> ()
let arg_15 =
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> ()
(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> ()
let arg_14 =
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> ()
(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> ()
let arg_13 =
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> ()
(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> ()
let arg_12 =
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> ()
(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> ()
let arg_11 =
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> ()
(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> ()
let arg_10 =
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> ()
(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> ()
let arg_9 =
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> ()
(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> ()
let arg_8 =
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> ()
(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> ()
let arg_7 =
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> ()
(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> ()
let arg_6 =
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> ()
(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> ()
let arg_5 =
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> ()
(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> ()
let arg_4 =
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> ()
(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> ()
let arg_3 =
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> ()
(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> ()
let arg_2 =
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> ()
(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> ()
let arg_1 =
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
(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
let arg_0 =
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> ()
(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> ()
{
Alpha = arg_0

File diff suppressed because it is too large Load Diff

View File

@@ -48,27 +48,7 @@ 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 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
return jsonNode.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
@@ -102,15 +82,6 @@ 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))
@@ -145,15 +116,6 @@ 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))
@@ -184,15 +146,6 @@ 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))
@@ -226,15 +179,6 @@ 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))
@@ -265,15 +209,6 @@ 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))
@@ -304,15 +239,6 @@ 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))
@@ -340,42 +266,23 @@ module PureGymApi =
foo
|> (fun field ->
match field with
| None -> None
| None -> null :> System.Text.Json.Nodes.JsonNode
| Some field ->
(field
|> (fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
((fun field ->
let ret = System.Text.Json.Nodes.JsonObject ()
for (KeyValue (key, value)) in field do
let key = key.ToString ()
for (KeyValue (key, value)) in field do
ret.Add (
key.ToString (),
System.Text.Json.Nodes.JsonValue.Create<string> value
)
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
))
ret
)
field)
:> 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
@@ -387,25 +294,15 @@ module PureGymApi =
System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct)
|> Async.AwaitTask
let jsonNode = jsonNode |> Option.ofObj
return
match jsonNode with
| None -> None
| Some v ->
| null -> None
| v ->
v.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> ())
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> Map.ofSeq
|> Some
@@ -449,15 +346,6 @@ 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))
@@ -499,15 +387,6 @@ 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))
@@ -667,7 +546,9 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ())
user
|> PureGym.Member.toJsonNode
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -699,18 +580,8 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user
|> (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 ())
|> System.Text.Json.Nodes.JsonValue.Create<Uri>
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -742,18 +613,8 @@ module PureGymApi =
let queryParams =
new System.Net.Http.StringContent (
user
|> (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 ())
|> System.Text.Json.Nodes.JsonValue.Create<int>
|> (fun node -> if isNull node then "null" else node.ToJsonString ())
)
do httpMessage.Content <- queryParams
@@ -1017,15 +878,6 @@ 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,
@@ -1062,15 +914,6 @@ 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,
@@ -1107,15 +950,6 @@ 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,
@@ -1152,15 +986,6 @@ 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

@@ -13,147 +13,139 @@ module JwtVaultAuthResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let arg_10 =
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> ()
(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> ()
let arg_9 =
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> ()
(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> ()
let arg_8 =
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> ()
(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> ()
let arg_7 =
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> ()
(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> ()
let arg_6 =
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> ()
(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> ()
let arg_5 =
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> ()
(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> ()
let arg_4 =
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
(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
let arg_3 =
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
(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
let arg_2 =
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
(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
let arg_1 =
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> ()
(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> ()
let arg_0 =
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> ()
(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> ()
{
ClientToken = arg_0
@@ -176,54 +168,64 @@ module JwtVaultResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let arg_4 =
match node.["auth"] |> Option.ofObj with
| None ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
)
)
| Some node -> JwtVaultAuthResponse.jsonParse node
| v -> v
)
let arg_3 =
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> ()
(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> ()
let arg_2 =
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> ()
(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> ()
let arg_1 =
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> ()
(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> ()
let arg_0 =
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> ()
(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> ()
{
RequestId = arg_0
@@ -240,246 +242,190 @@ module JwtSecretResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let arg_11 =
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
(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
let arg_10 =
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
(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
let arg_9 =
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
(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
let arg_8 =
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
(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
let arg_7 =
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
(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
let arg_6 =
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
(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
let arg_5 =
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
(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
let arg_4 =
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
(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
let arg_3 =
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> ()
(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> ()
let arg_2 =
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> ()
(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> ()
let arg_1 =
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> ()
(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> ()
let arg_0 =
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> ()
(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> ()
{
RequestId = arg_0
@@ -550,15 +496,6 @@ 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))
@@ -595,15 +532,6 @@ 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))
@@ -662,15 +590,6 @@ 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))
@@ -707,15 +626,6 @@ 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))
@@ -777,15 +687,6 @@ 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))
@@ -822,15 +723,6 @@ 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))

47
Playground/Domain.fs Normal file
View File

@@ -0,0 +1,47 @@
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
}

563
Playground/Library.fs Normal file
View File

@@ -0,0 +1,563 @@
//------------------------------------------------------------------------------
// 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

@@ -0,0 +1,19 @@
<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>

10
Playground/Program.fs Normal file
View File

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

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,11 +79,8 @@ module TestArgParser =
exc.Message
|> shouldEqual
"""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"""
"""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"""
[<Test>]
let ``Can supply positional args with key`` () =
@@ -91,7 +88,7 @@ module TestArgParser =
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
""
let property (args : (int * bool) list) (afterDoubleDash : int list option) =
let flatArgs =
@@ -127,7 +124,7 @@ module TestArgParser =
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
""
let args = [ "--foo=3" ; "--rest" ; "7" ; "--bar=4" ; "--baz=true" ; "--rest=8" ]
@@ -150,7 +147,7 @@ module TestArgParser =
let getEnvVar (_ : string) =
Interlocked.Increment envCalls |> ignore<int>
None
""
let args = [ "--foo=3" ; "--foo" ; "9" ; "--bar=4" ; "--baz=true" ; "--baz=false" ]
@@ -171,7 +168,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" ]
@@ -191,7 +188,7 @@ Required argument '--baz' received no value"""
let ``Help text`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some "hi!"
"hi!"
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
@@ -210,7 +207,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>)
@@ -236,7 +233,7 @@ Required argument '--baz' received no value"""
let ``Default values`` () =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some "hi!"
"hi!"
let args =
[
@@ -264,7 +261,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>)
@@ -285,7 +282,7 @@ Required argument '--baz' received no value"""
let getEnvVar (_ : string) =
Interlocked.Increment count |> ignore<int>
None
""
let parsed =
DatesAndTimes.parse'
@@ -318,8 +315,7 @@ 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)
Required argument '--invariant-exact' received no value"""
Input string was not in a correct format. (at arg --invariant-exact=23:59)"""
let exc =
Assert.Throws<exn> (fun () ->
@@ -337,8 +333,7 @@ Required argument '--invariant-exact' received no value"""
exc.Message
|> shouldEqual
"""Errors during parse!
Input string was not in a correct format. (at arg --exact=11:34)
Required argument '--exact' received no value"""
Input string was not in a correct format. (at arg --exact=11:34)"""
count.Value |> shouldEqual 0
@@ -444,11 +439,11 @@ Required argument '--exact' received no value"""
]
|> 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"
Some envValue
envValue
ContainsBoolEnvVar.parse' getEnvVar []
|> shouldEqual
@@ -470,7 +465,7 @@ Required argument '--exact' received no value"""
let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
Some envValue
envValue
let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
@@ -604,7 +599,10 @@ Required argument '--exact' received no value"""
)
exc.Message
|> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
|> shouldEqual
"""Errors during parse!
Required argument '--do-something-else' received no value
Required argument '--turn-it-on' received no value"""
[<Test>]
let ``Long-form args help text`` () =
@@ -692,7 +690,9 @@ Required argument '--exact' received no value"""
)
exc.Message
|> shouldEqual """Unable to process argument --b=false as key --b and value false"""
|> 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"""
let exc =
Assert.Throws<exn> (fun () ->
@@ -703,4 +703,6 @@ Required argument '--exact' received no value"""
// Again perhaps eccentric!
// Again, we don't try to detect that the user has missed out the desired argument to `--a`.
exc.Message
|> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""
|> 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"""

View File

@@ -0,0 +1,21 @@
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,6 +13,7 @@
</PropertyGroup>
<ItemGroup>
<!--
<Compile Include="HttpClient.fs"/>
<Compile Include="PureGymDtos.fs"/>
<Compile Include="TestJsonParse\TestJsonParse.fs" />
@@ -34,10 +35,14 @@
<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,82 +7,6 @@ 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
@@ -114,14 +38,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).
| Branch of
| DescendRecord 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).
| BranchPos of
| DescendRecordPos of
posField : Ident *
fields : ParseTree<HasPositional> *
(Ident * ParseTree<HasNoPositional>) list *
@@ -184,63 +108,6 @@ 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
@@ -1396,7 +1263,7 @@ module internal ArgParserGenerator =
[
SynMatchClause.create
(SynPat.named "None")
SynPat.createNull
(SynExpr.sequential
[
errorMessage
@@ -1406,7 +1273,7 @@ module internal ArgParserGenerator =
unchecked
])
SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "x" ]) parser
SynMatchClause.create (SynPat.named "x") parser
]
|> SynExpr.createMatch result
| ArgumentDefaultSpec.FunctionCall name ->
@@ -1694,7 +1561,7 @@ module internal ArgParserGenerator =
[ Ident.create "parse'" ]
[
SynPat.named "getEnvironmentVariable"
|> SynPat.annotateType (SynType.funFromDomain SynType.string (SynType.option SynType.string))
|> SynPat.annotateType (SynType.funFromDomain SynType.string SynType.string)
argsParam
]
|> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ])
@@ -1708,12 +1575,7 @@ module internal ArgParserGenerator =
let parse =
SynExpr.createLongIdent' parsePrimeCall
|> SynExpr.applyTo (
SynExpr.paren (
SynExpr.createLongIdent [ "System" ; "Environment" ; "GetEnvironmentVariable" ]
|> SynExpr.composeWith (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
)
)
|> SynExpr.applyTo (SynExpr.createLongIdent [ "System" ; "Environment" ; "GetEnvironmentVariable" ])
|> SynExpr.applyTo (SynExpr.createIdent "args")
|> SynBinding.basic [ Ident.create "parse" ] [ argsParam ]
|> SynBinding.withReturnAnnotation (SynType.createLongIdent [ taggedType.Name ])

View File

@@ -1,5 +1,6 @@
namespace WoofWare.Myriad.Plugins
open System.IO
open System.Net.Http
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
@@ -13,6 +14,17 @@ 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
@@ -397,59 +409,30 @@ module internal HttpClientGenerator =
| String -> SynExpr.createIdent "responseString"
| Stream -> SynExpr.createIdent "responseStream"
| RestEaseResponseType contents ->
match JsonNodeWithNullability.Identify contents with
| CannotBeNull ->
let deserialiser =
JsonParseGenerator.parseNonNullableNode
None
JsonParseGenerator.JsonParseOption.None
contents
(SynExpr.createIdent "jsonNode")
|> SynExpr.paren
|> SynExpr.createThunk
let deserialiser =
JsonParseGenerator.parseNode
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
])
// 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
retType
(SynExpr.createIdent "jsonNode")
| CannotBeNull ->
JsonParseGenerator.parseNonNullableNode
None
JsonParseGenerator.JsonParseOption.None
retType
(SynExpr.createIdent "jsonNode")
JsonParseGenerator.parseNode
None
JsonParseGenerator.JsonParseOption.None
retType
(SynExpr.createIdent "jsonNode")
let contentTypeHeader, memberHeaders =
info.Headers
@@ -522,45 +505,23 @@ 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 (
(if isNullable then
JsonSerializeGenerator.serializeNodeNullable
else
JsonSerializeGenerator.serializeNodeNonNullable)
ty
)
)
|> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty))
|> SynExpr.pipeThroughFunction (
SynExpr.createLambda
"node"
(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 ())))
(SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createIdent "isNull")
(SynExpr.createIdent "node"))
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
(SynExpr.CreateConst ()))
(SynExpr.CreateConst "null"))
)
)
)
@@ -607,24 +568,6 @@ 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) ->
@@ -699,7 +642,6 @@ module internal HttpClientGenerator =
yield responseString
yield responseStream
yield jsonNode
yield jsonNodeWithoutNull
| String -> yield responseString
| Stream -> yield responseStream
| UnitType ->
@@ -708,7 +650,6 @@ 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 assertPropertyExists (propertyName : SynExpr) (indexed : SynExpr) =
let assertNotNull (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.named "None") raiseExpr
SynMatchClause.create (SynPat.nameWithArgs "Some" [ SynPat.named "v" ]) (SynExpr.createIdent "v")
SynMatchClause.create SynPat.createNull raiseExpr
SynMatchClause.create (SynPat.named "v") (SynExpr.createIdent "v")
]
|> SynExpr.createMatch indexed
|> SynExpr.paren
/// {node}.AsValue().GetValue<{typeName}> ()
/// If `propertyName` is Some, uses `assertPropertyExists {node}` instead of `{node}`.
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asValueGetValue (propertyName : SynExpr option) (typeName : string) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertPropertyExists propertyName node
| Some propertyName -> assertNotNull 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 -> assertPropertyExists propertyName node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod (SynLongIdent.createS "GetValue") [ SynType.createLongIdent typeName ]
/// {node}.AsObject()
/// If `propertyName` is Some, uses `assertPropertyExists {node}` instead of `{node}`.
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asObject (propertyName : SynExpr option) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertPropertyExists propertyName node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsObject"
/// {type}.jsonParse {node}
@@ -77,12 +77,11 @@ 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`.
/// {assertPropertyExists node}.AsArray()
/// |> Seq.map (fun elt -> {assertNotNull} {body})
/// {assertNotNull node}.AsArray()
/// |> Seq.map (fun elt -> {body})
/// |> {collectionType}.ofSeq
let asArrayMapped
(propertyName : SynExpr option)
(elementType : SynType)
(collectionType : string)
(node : SynExpr)
(body : SynExpr)
@@ -90,23 +89,10 @@ module internal JsonParseGenerator =
=
match propertyName with
| None -> node
| Some propertyName -> assertPropertyExists propertyName node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsArray"
|> SynExpr.pipeThroughFunction (
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.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) (SynExpr.createLambda "elt" body)
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ])
@@ -115,41 +101,14 @@ 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
(propertyName : SynExpr option)
(valueTypeIsNullable : bool)
(key : SynExpr -> SynExpr)
(valueType : SynType)
(value : SynExpr -> SynExpr)
: SynExpr
=
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
let keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> 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"))
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.paren
// No need to paren here, we're on the LHS of a `let`
SynExpr.tupleNoParen [ SynExpr.createIdent "key" ; value ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "value" ] [] valueArg ]
SynExpr.tupleNoParen [ SynExpr.createIdent "key" ; SynExpr.createIdent "value" ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "value" ] [] (value valueArg) ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "key" ] [] (key keyArg) ]
|> SynExpr.createLambda "kvp"
@@ -206,61 +165,10 @@ 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".
and parseNonNullableNode
let rec parseNode
(propertyName : SynExpr option)
(options : JsonParseOption)
(fieldType : SynType)
@@ -269,184 +177,101 @@ 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" ])
| 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" ])
| Guid ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
| DateTime ->
node
|> asValueGetValue propertyName "string"
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
| 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 ->
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
parseNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName "List" node
| ArrayType ty ->
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
parseNode None options ty (SynExpr.createIdent "elt")
|> asArrayMapped propertyName "Array" node
| IDictionaryType (keyType, valueType) ->
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")
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "dict")
| DictionaryType (keyType, valueType) ->
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" ]
)
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" ]
)
| IReadOnlyDictionaryType (keyType, valueType) ->
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")
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "readOnlyDict")
| MapType (keyType, valueType) ->
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" ])
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction
(SynExpr.createLongIdent [ "Seq" ; "map" ])
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
)
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Map" ; "ofSeq" ])
| BigInt ->
node
|> SynExpr.callMethod "ToJsonString"
@@ -457,7 +282,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
@@ -466,45 +291,14 @@ module internal JsonParseGenerator =
match propertyName with
| None -> node
| Some propertyName -> assertPropertyExists propertyName node
| Some propertyName -> assertNotNull 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 =
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 objectToParse = SynExpr.createIdent "node" |> SynExpr.index propertyName
parseNode (Some propertyName) options fieldType objectToParse
let isJsonNumberHandling (literal : LongIdent) : bool =
match List.rev literal |> List.map (fun ident -> ident.idText) with
@@ -711,8 +505,7 @@ module internal JsonParseGenerator =
|> SynExpr.createLet
[
SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
|> assertPropertyExists (SynExpr.CreateConst "data")
|> assertNotNull (SynExpr.CreateConst "data")
|> SynBinding.basic [ Ident.create "node" ] []
]
@@ -760,8 +553,7 @@ module internal JsonParseGenerator =
SynExpr.createIdent "node"
|> SynExpr.index property
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Option" ; "ofObj" ])
|> assertPropertyExists property
|> assertNotNull property
|> SynExpr.pipeThroughFunction (
SynExpr.createLambda "v" (SynExpr.callGenericMethod' "GetValue" "string" (SynExpr.createIdent "v"))
)

View File

@@ -10,100 +10,24 @@ 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, 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"
// 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" ])
/// 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.
and serializeNodeNonNullable (fieldType : SynType) : SynExpr * bool =
let rec serializeNode (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 _
@@ -112,21 +36,8 @@ module internal JsonSerializeGenerator =
| Guid
| Uri ->
// JsonValue.Create<type>
(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"
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]
|> SynExpr.typeApp [ fieldType ]
|> fun e -> e, false
| DateTimeOffset ->
// fun field -> field.ToString("o") |> JsonValue.Create<string>
@@ -139,17 +50,41 @@ 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,
@@ -160,17 +95,7 @@ module internal JsonSerializeGenerator =
SynExpr.createIdent "field",
SynExpr.applyFunction
(SynExpr.createLongIdent [ "arr" ; "Add" ])
(SynExpr.paren (
SynExpr.applyFunction
(fst (
(if isNullableChild then
serializeNodeNullable
else
serializeNodeNonNullable)
ty
))
(SynExpr.createIdent "mem")
)),
(SynExpr.paren (SynExpr.applyFunction (fst (serializeNode ty)) (SynExpr.createIdent "mem"))),
range0
)
SynExpr.createIdent "arr"
@@ -184,28 +109,15 @@ 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,
@@ -218,33 +130,10 @@ module internal JsonSerializeGenerator =
(SynExpr.createLongIdent [ "ret" ; "Add" ])
(SynExpr.tuple
[
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 ()))
],
SynExpr.createLongIdent [ "key" ; "ToString" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
SynExpr.applyFunction (fst (serializeNode valueType)) (SynExpr.createIdent "value")
]),
range0
)
SynExpr.createIdent "ret"
@@ -277,24 +166,13 @@ 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 =
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 ]
[
propertyName
SynExpr.pipeThroughFunction
(fst (serializeNode fieldType))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
|> SynExpr.paren
]
|> SynExpr.tuple
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
@@ -400,10 +278,7 @@ module internal JsonSerializeGenerator =
| DictionaryType (String, v) -> v
| _ -> failwith "Expected JsonExtensionData to be a Dictionary<string, something>"
let serialise =
match JsonNodeWithNullability.Identify valType with
| CannotBeNull -> fst (serializeNodeNonNullable valType)
| Nullable -> fst (serializeNodeNullable valType)
let serialise = fst (serializeNode valType)
SynExpr.createIdent "node"
|> SynExpr.callMethodArg
@@ -468,15 +343,7 @@ module internal JsonSerializeGenerator =
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
let node =
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)
SynExpr.applyFunction (fst (serializeNode fieldData.Type)) (SynExpr.createIdent caseName)
[ propertyName ; node ]
|> SynExpr.tuple

View File

@@ -21,3 +21,13 @@ 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

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

View File

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

View File

@@ -10,6 +10,8 @@ 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
@@ -36,5 +38,9 @@ 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": 1744868846,
"narHash": "sha256-5RJTdUHDmj12Qsv7XOhuospjAjATNiTMElplWnJE9Hs=",
"lastModified": 1744502386,
"narHash": "sha256-QAd1L37eU7ktL2WeLLLTmI6P9moz9+a/ONO8qNBYJgM=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "ebe4301cbd8f81c4f8d3244b3632338bbeb6d49c",
"rev": "f6db44a8daa59c40ae41ba6e5823ec77fe0d2124",
"type": "github"
},
"original": {

View File

@@ -381,7 +381,7 @@
},
{
"pname": "WoofWare.Whippet.Fantomas",
"version": "0.6.2",
"hash": "sha256-nDT/W5eBwM/E+Z2oQ80maAGYrEyRJQXL1unxR9q6ztU="
"version": "0.5.1",
"hash": "sha256-59CwnOZQAq5ZJoUkd87OiP8KUwx8xYDLMimMMTlKeZA="
}
]