Compare commits

..

6 Commits

Author SHA1 Message Date
Patrick Stevens
0a1783d6ed Support [<BasePath>] (#263) 2024-09-15 17:38:03 +00:00
Patrick Stevens
9a3ebbf28f Cope with unit type in JSON (#262) 2024-09-15 14:37:50 +00:00
Patrick Stevens
e22525c200 Interpret JsonExtensionData (#261) 2024-09-15 11:13:22 +01:00
Patrick Stevens
09b7109c84 Extract some utilities from http-client branch (#260) 2024-09-14 22:02:32 +00:00
Patrick Stevens
693b95106a Also pipe through parser in PositionalArgs true (#259) 2024-09-13 16:11:53 +00:00
Patrick Stevens
49ecfbf5e5 Fix includeFlagLike when arg doesn't have an equals (#257) 2024-09-12 22:10:08 +00:00
31 changed files with 1833 additions and 155 deletions

View File

@@ -1,5 +1,14 @@
Notable changes are recorded here. Notable changes are recorded here.
# WoofWare.Myriad.Plugins 3.0.1
Semantics of `HttpClient`'s URI component composition changed:
we now implicitly insert `/` characters after `[<BaseAddress>]` and `[<BasePath>]`, so that URI composition doesn't silently drop the last component if you didn't put a slash there.
# WoofWare.Myriad.Plugins 2.3.9
`JsonParse` and `JsonSerialize` now interpret `[<JsonExtensionData>]`, which must be on a `Dictionary<string, _>`; this collects any extra components that were present on the JSON object.
# WoofWare.Myriad.Plugins 2.2.1, WoofWare.Myriad.Plugins.Attributes 3.2.1 # WoofWare.Myriad.Plugins 2.2.1, WoofWare.Myriad.Plugins.Attributes 3.2.1
New generator: `ArgParser`, a basic reflection-free argument parser. New generator: `ArgParser`, a basic reflection-free argument parser.

View File

@@ -204,6 +204,30 @@ type FlagsIntoPositionalArgs =
GrabEverything : string list GrabEverything : string list
} }
[<ArgParser true>]
type FlagsIntoPositionalArgsChoice =
{
A : string
[<PositionalArgs true>]
GrabEverything : Choice<string, string> list
}
[<ArgParser true>]
type FlagsIntoPositionalArgsInt =
{
A : string
[<PositionalArgs true>]
GrabEverything : int list
}
[<ArgParser true>]
type FlagsIntoPositionalArgsIntChoice =
{
A : string
[<PositionalArgs true>]
GrabEverything : Choice<int, int> list
}
[<ArgParser true>] [<ArgParser true>]
type FlagsIntoPositionalArgs' = type FlagsIntoPositionalArgs' =
{ {

View File

@@ -3635,6 +3635,9 @@ module FlagsIntoPositionalArgsArgParse =
| Error exc -> | Error exc ->
if setFlagValue key then if setFlagValue key then
go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args) go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args)
else if true then
key |> (fun x -> x) |> arg_1.Add
go ParseState_FlagsIntoPositionalArgs.AwaitingKey (arg :: args)
else else
match exc with match exc with
| None -> | None ->
@@ -3672,6 +3675,498 @@ open System
open System.IO open System.IO
open WoofWare.Myriad.Plugins open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type FlagsIntoPositionalArgsChoice
[<AutoOpen>]
module FlagsIntoPositionalArgsChoiceArgParse =
type private ParseState_FlagsIntoPositionalArgsChoice =
/// 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
/// Extension methods for argument parsing
type FlagsIntoPositionalArgsChoice with
static member parse'
(getEnvironmentVariable : string -> string)
(args : string list)
: FlagsIntoPositionalArgsChoice
=
let ArgParser_errors = ResizeArray ()
let helpText () =
[
(sprintf "%s string%s%s" (sprintf "--%s" "a") "" "")
(sprintf
"%s string%s%s"
(sprintf "--%s" "grab-everything")
" (positional args) (can be repeated)"
"")
]
|> String.concat "\n"
let arg_1 : Choice<string, string> ResizeArray = ResizeArray ()
let mutable arg_0 : string option = 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.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "a")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (
key,
sprintf "--%s" "grab-everything",
System.StringComparison.OrdinalIgnoreCase
)
then
value |> (fun x -> x) |> Choice1Of2 |> arg_1.Add
() |> Ok
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool = false
let rec go (state : ParseState_FlagsIntoPositionalArgsChoice) (args : string list) =
match args with
| [] ->
match state with
| ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey -> ()
| ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> x) |> Seq.map Choice2Of2)
| arg :: args ->
match state with
| ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
| Error x ->
if true then
arg |> (fun x -> x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
else
match x with
| None ->
failwithf
"Unable to process argument %s as key %s and value %s"
arg
key
value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
else
arg |> (fun x -> x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
| ParseState_FlagsIntoPositionalArgsChoice.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args)
else if true then
key |> (fun x -> x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf
"Unable to process supplied arg %s. Help text follows.\n%s"
key
(helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsChoice.AwaitingKey args
let arg_1 = arg_1 |> Seq.toList
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "a")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
A = arg_0
GrabEverything = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
static member parse (args : string list) : FlagsIntoPositionalArgsChoice =
FlagsIntoPositionalArgsChoice.parse' System.Environment.GetEnvironmentVariable args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type FlagsIntoPositionalArgsInt
[<AutoOpen>]
module FlagsIntoPositionalArgsIntArgParse =
type private ParseState_FlagsIntoPositionalArgsInt =
/// 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
/// Extension methods for argument parsing
type FlagsIntoPositionalArgsInt with
static member parse'
(getEnvironmentVariable : string -> string)
(args : string list)
: FlagsIntoPositionalArgsInt
=
let ArgParser_errors = ResizeArray ()
let helpText () =
[
(sprintf "%s string%s%s" (sprintf "--%s" "a") "" "")
(sprintf
"%s int32%s%s"
(sprintf "--%s" "grab-everything")
" (positional args) (can be repeated)"
"")
]
|> String.concat "\n"
let arg_1 : int ResizeArray = ResizeArray ()
let mutable arg_0 : string option = 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.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "a")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (
key,
sprintf "--%s" "grab-everything",
System.StringComparison.OrdinalIgnoreCase
)
then
value |> (fun x -> System.Int32.Parse x) |> arg_1.Add
() |> Ok
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool = false
let rec go (state : ParseState_FlagsIntoPositionalArgsInt) (args : string list) =
match args with
| [] ->
match state with
| ParseState_FlagsIntoPositionalArgsInt.AwaitingKey -> ()
| ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x))
| arg :: args ->
match state with
| ParseState_FlagsIntoPositionalArgsInt.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_FlagsIntoPositionalArgsInt.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
| Error x ->
if true then
arg |> (fun x -> System.Int32.Parse x) |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
else
match x with
| None ->
failwithf
"Unable to process argument %s as key %s and value %s"
arg
key
value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
else
arg |> (fun x -> System.Int32.Parse x) |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
| ParseState_FlagsIntoPositionalArgsInt.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args)
else if true then
key |> (fun x -> System.Int32.Parse x) |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf
"Unable to process supplied arg %s. Help text follows.\n%s"
key
(helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsInt.AwaitingKey args
let arg_1 = arg_1 |> Seq.toList
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "a")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
A = arg_0
GrabEverything = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
static member parse (args : string list) : FlagsIntoPositionalArgsInt =
FlagsIntoPositionalArgsInt.parse' System.Environment.GetEnvironmentVariable args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type FlagsIntoPositionalArgsIntChoice
[<AutoOpen>]
module FlagsIntoPositionalArgsIntChoiceArgParse =
type private ParseState_FlagsIntoPositionalArgsIntChoice =
/// 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
/// Extension methods for argument parsing
type FlagsIntoPositionalArgsIntChoice with
static member parse'
(getEnvironmentVariable : string -> string)
(args : string list)
: FlagsIntoPositionalArgsIntChoice
=
let ArgParser_errors = ResizeArray ()
let helpText () =
[
(sprintf "%s string%s%s" (sprintf "--%s" "a") "" "")
(sprintf
"%s int32%s%s"
(sprintf "--%s" "grab-everything")
" (positional args) (can be repeated)"
"")
]
|> String.concat "\n"
let arg_1 : Choice<int, int> ResizeArray = ResizeArray ()
let mutable arg_0 : string option = 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.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "a", System.StringComparison.OrdinalIgnoreCase) then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "a")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (
key,
sprintf "--%s" "grab-everything",
System.StringComparison.OrdinalIgnoreCase
)
then
value |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add
() |> Ok
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool = false
let rec go (state : ParseState_FlagsIntoPositionalArgsIntChoice) (args : string list) =
match args with
| [] ->
match state with
| ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey -> ()
| ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> arg_1.AddRange (rest |> Seq.map (fun x -> System.Int32.Parse x) |> Seq.map Choice2Of2)
| arg :: args ->
match state with
| ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
| Error x ->
if true then
arg |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
else
match x with
| None ->
failwithf
"Unable to process argument %s as key %s and value %s"
arg
key
value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
else
arg |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
| ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args)
else if true then
key |> (fun x -> System.Int32.Parse x) |> Choice1Of2 |> arg_1.Add
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf
"Unable to process supplied arg %s. Help text follows.\n%s"
key
(helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_FlagsIntoPositionalArgsIntChoice.AwaitingKey args
let arg_1 = arg_1 |> Seq.toList
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "a")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
A = arg_0
GrabEverything = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
static member parse (args : string list) : FlagsIntoPositionalArgsIntChoice =
FlagsIntoPositionalArgsIntChoice.parse' System.Environment.GetEnvironmentVariable args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type FlagsIntoPositionalArgs' /// Methods to parse arguments for the type FlagsIntoPositionalArgs'
[<AutoOpen>] [<AutoOpen>]
module FlagsIntoPositionalArgs'ArgParse = module FlagsIntoPositionalArgs'ArgParse =
@@ -3796,6 +4291,9 @@ module FlagsIntoPositionalArgs'ArgParse =
| Error exc -> | Error exc ->
if setFlagValue key then if setFlagValue key then
go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args) go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args)
else if false then
key |> (fun x -> x) |> arg_1.Add
go ParseState_FlagsIntoPositionalArgs'.AwaitingKey (arg :: args)
else else
match exc with match exc with
| None -> | None ->

View File

@@ -29,7 +29,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri (("v1/gyms/"), System.UriKind.Relative) System.Uri (("v1/gyms/"), System.UriKind.Relative)
) )
@@ -59,7 +59,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
"v1/gyms/{gym_id}/attendance" "v1/gyms/{gym_id}/attendance"
@@ -93,7 +93,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
"v1/gyms/{gym_id}/attendance" "v1/gyms/{gym_id}/attendance"
@@ -127,7 +127,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("v1/member", System.UriKind.Relative) System.Uri ("v1/member", System.UriKind.Relative)
) )
@@ -157,7 +157,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
"v1/gyms/{gym}" "v1/gyms/{gym}"
@@ -191,7 +191,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("v1/member/activity", System.UriKind.Relative) System.Uri ("v1/member/activity", System.UriKind.Relative)
) )
@@ -221,7 +221,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("some/url", System.UriKind.Relative) System.Uri ("some/url", System.UriKind.Relative)
) )
@@ -251,7 +251,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("some/url", System.UriKind.Relative) System.Uri ("some/url", System.UriKind.Relative)
) )
@@ -317,7 +317,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
("/v2/gymSessions/member" ("/v2/gymSessions/member"
@@ -358,7 +358,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
("/v2/gymSessions/member?foo=1" ("/v2/gymSessions/member?foo=1"
@@ -399,7 +399,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -426,7 +426,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -453,7 +453,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -480,7 +480,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -507,7 +507,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -534,7 +534,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -567,7 +567,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -600,7 +600,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -633,7 +633,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("users/new", System.UriKind.Relative) System.Uri ("users/new", System.UriKind.Relative)
) )
@@ -659,7 +659,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ( System.Uri (
"endpoint/{param}" "endpoint/{param}"
@@ -688,7 +688,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -713,7 +713,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -738,7 +738,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -763,7 +763,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -787,7 +787,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -811,7 +811,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -835,7 +835,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -859,7 +859,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -895,7 +895,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -931,7 +931,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -967,7 +967,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -1003,7 +1003,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -1026,7 +1026,7 @@ module PureGymApi =
let uri = let uri =
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/"
| v -> v), | v -> v),
System.Uri ("endpoint", System.UriKind.Relative) System.Uri ("endpoint", System.UriKind.Relative)
) )
@@ -1115,6 +1115,7 @@ module ApiWithBasePath =
let! ct = Async.CancellationToken let! ct = Async.CancellationToken
let uri = let uri =
System.Uri (
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> | null ->
@@ -1125,6 +1126,8 @@ module ApiWithBasePath =
) )
) )
| v -> v), | v -> v),
System.Uri ("foo/", System.UriKind.Relative)
),
System.Uri ( System.Uri (
"endpoint/{param}" "endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode), .Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
@@ -1166,10 +1169,13 @@ module ApiWithBasePathAndAddress =
let! ct = Async.CancellationToken let! ct = Async.CancellationToken
let uri = let uri =
System.Uri (
System.Uri ( System.Uri (
(match client.BaseAddress with (match client.BaseAddress with
| null -> System.Uri "https://whatnot.com" | null -> System.Uri "https://whatnot.com/thing/"
| v -> v), | v -> v),
System.Uri ("foo/", System.UriKind.Relative)
),
System.Uri ( System.Uri (
"endpoint/{param}" "endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode), .Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
@@ -1200,6 +1206,312 @@ open System.Net
open System.Net.Http open System.Net.Http
open RestEase open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithAbsoluteBasePath =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithAbsoluteBasePath =
{ new IApiWithAbsoluteBasePath with
member _.GetPathParam (parameter : string, cancellationToken : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("/foo/", System.UriKind.Relative)
),
System.Uri (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = cancellationToken))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithAbsoluteBasePathAndAddress =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithAbsoluteBasePathAndAddress =
{ new IApiWithAbsoluteBasePathAndAddress with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com/thing/"
| v -> v),
System.Uri ("/foo/", System.UriKind.Relative)
),
System.Uri (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithBasePathAndAbsoluteEndpoint =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAbsoluteEndpoint =
{ new IApiWithBasePathAndAbsoluteEndpoint with
member _.GetPathParam (parameter : string, cancellationToken : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("foo/", System.UriKind.Relative)
),
System.Uri (
"/endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = cancellationToken))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithBasePathAndAddressAndAbsoluteEndpoint =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAddressAndAbsoluteEndpoint =
{ new IApiWithBasePathAndAddressAndAbsoluteEndpoint with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com/thing/"
| v -> v),
System.Uri ("foo/", System.UriKind.Relative)
),
System.Uri (
"/endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithAbsoluteBasePathAndAbsoluteEndpoint =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithAbsoluteBasePathAndAbsoluteEndpoint =
{ new IApiWithAbsoluteBasePathAndAbsoluteEndpoint with
member _.GetPathParam (parameter : string, cancellationToken : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("/foo/", System.UriKind.Relative)
),
System.Uri (
"/endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = cancellationToken))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
{ new IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com/thing/"
| v -> v),
System.Uri ("/foo/", System.UriKind.Relative)
),
System.Uri (
"/endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return responseString
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client. /// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>] [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module ApiWithHeaders = module ApiWithHeaders =

View File

@@ -210,6 +210,8 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
|> (fun field -> field.ToString "o" |> System.Text.Json.Nodes.JsonValue.Create<string>)) |> (fun field -> field.ToString "o" |> System.Text.Json.Nodes.JsonValue.Create<string>))
) )
node.Add ("unit", (input.Unit |> (fun value -> System.Text.Json.Nodes.JsonObject ())))
node :> _ node :> _
namespace ConsumePlugin namespace ConsumePlugin
@@ -291,6 +293,60 @@ module FooJsonSerializeExtension =
) )
node :> _ node :> _
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the CollectRemaining type
[<AutoOpen>]
module CollectRemainingJsonSerializeExtension =
/// Extension methods for JSON parsing
type CollectRemaining with
/// Serialize to a JSON node
static member toJsonNode (input : CollectRemaining) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do
node.Add (
"message",
(input.Message
|> (fun field ->
match field with
| None -> null :> System.Text.Json.Nodes.JsonNode
| Some field -> HeaderAndValue.toJsonNode field
))
)
for KeyValue (key, value) in input.Rest do
node.Add (key, id value)
node :> _
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
/// Module containing JSON serializing extension members for the OuterCollectRemaining type
[<AutoOpen>]
module OuterCollectRemainingJsonSerializeExtension =
/// Extension methods for JSON parsing
type OuterCollectRemaining with
/// Serialize to a JSON node
static member toJsonNode (input : OuterCollectRemaining) : System.Text.Json.Nodes.JsonNode =
let node = System.Text.Json.Nodes.JsonObject ()
do
for KeyValue (key, value) in input.Others do
node.Add (key, System.Text.Json.Nodes.JsonValue.Create<int> value)
node.Add ("remaining", (input.Remaining |> CollectRemaining.toJsonNode))
node :> _
namespace ConsumePlugin namespace ConsumePlugin
@@ -424,6 +480,8 @@ module JsonRecordTypeWithBothJsonParseExtension =
/// Parse from a JSON node. /// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth = static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
let arg_21 = ()
let arg_20 = let arg_20 =
(match node.["timestamp"] with (match node.["timestamp"] with
| null -> | null ->
@@ -705,6 +763,7 @@ module JsonRecordTypeWithBothJsonParseExtension =
IntMeasureNullable = arg_18 IntMeasureNullable = arg_18
Enum = arg_19 Enum = arg_19
Timestamp = arg_20 Timestamp = arg_20
Unit = arg_21
} }
namespace ConsumePlugin namespace ConsumePlugin
@@ -842,3 +901,83 @@ module FooJsonParseExtension =
{ {
Message = arg_0 Message = arg_0
} }
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the CollectRemaining type
[<AutoOpen>]
module CollectRemainingJsonParseExtension =
/// Extension methods for JSON parsing
type CollectRemaining with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : CollectRemaining =
let arg_1 =
let result =
System.Collections.Generic.Dictionary<string, System.Text.Json.Nodes.JsonNode> ()
let node = node.AsObject ()
for KeyValue (key, value) in node do
if key = "message" then () else result.Add (key, node.[key])
result
let arg_0 =
match node.["message"] with
| null -> None
| v -> HeaderAndValue.jsonParse v |> Some
{
Message = arg_0
Rest = arg_1
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the OuterCollectRemaining type
[<AutoOpen>]
module OuterCollectRemainingJsonParseExtension =
/// Extension methods for JSON parsing
type OuterCollectRemaining with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : OuterCollectRemaining =
let arg_1 =
CollectRemaining.jsonParse (
match node.["remaining"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("remaining")
)
)
| v -> v
)
let arg_0 =
let result = System.Collections.Generic.Dictionary<string, int> ()
let node = node.AsObject ()
for KeyValue (key, value) in node do
if key = "remaining" then
()
else
result.Add (
key,
(match node.[key] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" (key)
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
)
result
{
Others = arg_0
Remaining = arg_1
}

View File

@@ -122,8 +122,6 @@ type internal IApiWithoutBaseAddress =
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
// TODO: implement BasePath support
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">] [<BasePath "foo">]
type IApiWithBasePath = type IApiWithBasePath =
@@ -132,12 +130,54 @@ type IApiWithBasePath =
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com">] [<BaseAddress "https://whatnot.com/thing">]
[<BasePath "foo">] [<BasePath "foo">]
type IApiWithBasePathAndAddress = type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePath =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Myriad.Plugins.RestEase.Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">]
type IApiWithBasePathAndAbsoluteEndpoint =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Myriad.Plugins.RestEase.Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "foo">]
type IApiWithBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAbsoluteEndpoint =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Myriad.Plugins.RestEase.Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>] [<WoofWare.Myriad.Plugins.HttpClient>]
[<Header("Header-Name", "Header-Value")>] [<Header("Header-Name", "Header-Value")>]
type IApiWithHeaders = type IApiWithHeaders =

View File

@@ -50,6 +50,7 @@ type JsonRecordTypeWithBoth =
IntMeasureNullable : int<measure> Nullable IntMeasureNullable : int<measure> Nullable
Enum : SomeEnum Enum : SomeEnum
Timestamp : DateTimeOffset Timestamp : DateTimeOffset
Unit : unit
} }
[<WoofWare.Myriad.Plugins.JsonSerialize true>] [<WoofWare.Myriad.Plugins.JsonSerialize true>]
@@ -73,3 +74,21 @@ type Foo =
{ {
Message : HeaderAndValue option Message : HeaderAndValue option
} }
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type CollectRemaining =
{
Message : HeaderAndValue option
[<JsonExtensionData>]
Rest : Dictionary<string, System.Text.Json.Nodes.JsonNode>
}
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
[<WoofWare.Myriad.Plugins.JsonParse true>]
type OuterCollectRemaining =
{
[<JsonExtensionData>]
Others : Dictionary<string, int>
Remaining : CollectRemaining
}

View File

@@ -45,6 +45,9 @@ module RestEase =
/// Indicates that this interface represents a REST client which accesses an API whose paths are /// Indicates that this interface represents a REST client which accesses an API whose paths are
/// all relative to the given address. /// all relative to the given address.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
type BaseAddressAttribute (addr : string) = type BaseAddressAttribute (addr : string) =
inherit Attribute () inherit Attribute ()
@@ -61,3 +64,21 @@ module RestEase =
inherit Attribute () inherit Attribute ()
new (path : string) = PathAttribute (Some path) new (path : string) = PathAttribute (Some path)
new () = PathAttribute None new () = PathAttribute None
/// Indicates that this argument to a method is passed to the remote API by being serialised into the request
/// body.
type BodyAttribute () =
inherit Attribute ()
/// This is interpolated into every URL, between the BaseAddress and the path specified by e.g. [<Get>].
/// Note that if the [<Get>]-specified path starts with a slash, the BasePath is ignored, because then [<Get>]
/// is considered to be relative to the URL root (i.e. the host part of the BaseAddress).
/// Similarly, if the [<BasePath>] starts with a slash, then any path component of the BaseAddress is ignored.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
///
/// Can contain {placeholders}; hopefully your methods define values for those placeholders with [<Path>]
/// attributes!
type BasePathAttribute (path : string) =
inherit Attribute ()

View File

@@ -49,6 +49,10 @@ WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RestEase inherit obj WoofWare.Myriad.Plugins.RestEase inherit obj
WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute inherit System.Attribute WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute..ctor [constructor]: string WoofWare.Myriad.Plugins.RestEase+BaseAddressAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+BasePathAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BasePathAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+BodyAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+BodyAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.RestEase+DeleteAttribute inherit System.Attribute WoofWare.Myriad.Plugins.RestEase+DeleteAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.RestEase+DeleteAttribute..ctor [constructor]: string WoofWare.Myriad.Plugins.RestEase+DeleteAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.RestEase+GetAttribute inherit System.Attribute WoofWare.Myriad.Plugins.RestEase+GetAttribute inherit System.Attribute

View File

@@ -1,5 +1,5 @@
{ {
"version": "3.5", "version": "3.6",
"publicReleaseRefSpec": [ "publicReleaseRefSpec": [
"^refs/heads/main$" "^refs/heads/main$"
], ],

View File

@@ -623,30 +623,71 @@ Required argument '--exact' received no value"""
let ``Can collect *all* non-help args into positional args with includeFlagLike`` () = let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
let getEnvVar (_ : string) = failwith "do not call" let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual |> shouldEqual
{ {
A = "foo" A = "foo"
GrabEverything = [ "--b=false" ; "--c=hi" ; "--help" ] GrabEverything = [ "--b=false" ; "--c" ; "hi" ; "--help" ]
} }
// Users might consider this eccentric! // Users might consider this eccentric!
// But we're only a simple arg parser; we don't look around to see whether this is "almost" // But we're only a simple arg parser; we don't look around to see whether this is "almost"
// a valid parse. // a valid parse.
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual |> shouldEqual
{ {
A = "--b=false" A = "--b=false"
GrabEverything = [ "--c=hi" ; "--help" ] GrabEverything = [ "--c" ; "hi" ; "--help" ]
} }
[<Test>] [<Test>]
let ``Can refuse to collect non-help args`` () = let ``Can collect non-help args into positional args with Choice`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsChoice.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> shouldEqual
{
A = "foo"
GrabEverything =
[
Choice1Of2 "--b=false"
Choice1Of2 "--c"
Choice1Of2 "hi"
Choice2Of2 "--help"
]
}
[<Test>]
let ``Can collect non-help args into positional args, and we parse on the way`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsInt.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|> shouldEqual
{
A = "foo"
GrabEverything = [ 3 ; 5 ; 98 ]
}
[<Test>]
let ``Can collect non-help args into positional args with Choice, and we parse on the way`` () =
let getEnvVar (_ : string) = failwith "do not call"
FlagsIntoPositionalArgsIntChoice.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|> shouldEqual
{
A = "foo"
GrabEverything = [ Choice1Of2 3 ; Choice1Of2 5 ; Choice2Of2 98 ]
}
[<Test>]
let ``Can refuse to collect non-help args with PositionalArgs false`` () =
let getEnvVar (_ : string) = failwith "do not call" let getEnvVar (_ : string) = failwith "do not call"
let exc = let exc =
Assert.Throws<exn> (fun () -> Assert.Throws<exn> (fun () ->
FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ] FlagsIntoPositionalArgs'.parse'
getEnvVar
[ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|> ignore<FlagsIntoPositionalArgs'> |> ignore<FlagsIntoPositionalArgs'>
) )

View File

@@ -9,9 +9,7 @@ open FsUnitTyped
[<TestFixture>] [<TestFixture>]
module TestBasePath = module TestBasePath =
[<Test>] let replyWithUrl (message : HttpRequestMessage) : HttpResponseMessage Async =
let ``Base address is respected`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async { async {
message.Method |> shouldEqual HttpMethod.Get message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ()) let content = new StringContent (message.RequestUri.ToString ())
@@ -20,7 +18,9 @@ module TestBasePath =
return resp return resp
} }
use client = HttpClientMock.makeNoUri proc [<Test>]
let ``Base address is respected`` () =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = PureGymApi.make client let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result let observedUri = api.GetPathParam("param").Result
@@ -28,38 +28,28 @@ module TestBasePath =
[<Test>] [<Test>]
let ``Without a base address attr but with BaseAddress on client, request goes through`` () = let ``Without a base address attr but with BaseAddress on client, request goes through`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async = use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (System.Uri "https://baseaddress.com") proc
let api = ApiWithoutBaseAddress.make client let api = ApiWithoutBaseAddress.make client
let observedUri = api.GetPathParam("param").Result let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param" observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>] [<Test>]
let ``Without a base address attr or BaseAddress on client, request throws`` () = let ``Base address on client takes precedence`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async = use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl
async { let api = PureGymApi.make client
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Without a base address attr or BaseAddress on client, request throws`` () =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithoutBaseAddress.make client let api = ApiWithoutBaseAddress.make client
let observedExc = let observedExc =
async { async {
let! result = api.GetPathParam ("param") |> Async.AwaitTask |> Async.Catch let! result = api.GetPathParam "param" |> Async.AwaitTask |> Async.Catch
match result with match result with
| Choice1Of2 _ -> return failwith "test failure" | Choice1Of2 _ -> return failwith "test failure"
@@ -78,3 +68,103 @@ module TestBasePath =
observedExc.Message observedExc.Message
|> shouldEqual |> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')" "No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
[<Test>]
let ``Relative base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Relative base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithAbsoluteBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Relative base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Relative base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = ApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = ApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"

View File

@@ -117,6 +117,7 @@ module TestJsonSerde =
IntMeasureNullable = intMeasureNullable IntMeasureNullable = intMeasureNullable
Enum = enum<SomeEnum> someEnum Enum = enum<SomeEnum> someEnum
Timestamp = timestamp Timestamp = timestamp
Unit = ()
} }
} }
@@ -168,6 +169,7 @@ module TestJsonSerde =
IntMeasureNullable = Nullable -883<measure> IntMeasureNullable = Nullable -883<measure>
Enum = enum<SomeEnum> 1 Enum = enum<SomeEnum> 1
Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0) Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0)
Unit = ()
} }
let expected = let expected =
@@ -198,7 +200,8 @@ module TestJsonSerde =
"intMeasureOption": 981, "intMeasureOption": 981,
"intMeasureNullable": -883, "intMeasureNullable": -883,
"enum": 1, "enum": 1,
"timestamp": "2024-07-01T17:54:00.0000000\u002B01:00" "timestamp": "2024-07-01T17:54:00.0000000\u002B01:00",
"unit": {}
} }
""" """
|> fun s -> s.ToCharArray () |> fun s -> s.ToCharArray ()
@@ -306,3 +309,166 @@ module TestJsonSerde =
for i in counts do for i in counts do
i |> shouldBeGreaterThan 0 i |> shouldBeGreaterThan 0
let dict<'a, 'b when 'a : equality> (xs : ('a * 'b) seq) : Dictionary<'a, 'b> =
let result = Dictionary ()
for k, v in xs do
result.Add (k, v)
result
let inline makeJsonArr< ^t, ^u when ^u : (static member op_Implicit : ^t -> JsonNode) and ^u :> JsonNode>
(arr : ^t seq)
: JsonNode
=
let result = JsonArray ()
for a in arr do
result.Add a
result :> JsonNode
let normalise (d : Dictionary<'a, 'b>) : ('a * 'b) list =
d |> Seq.map (fun (KeyValue (a, b)) -> a, b) |> Seq.toList |> List.sortBy fst
[<Test>]
let ``Can collect extension data`` () =
let str =
"""{
"message": { "header": "hi", "value": "bye" },
"something": 3,
"arr": ["egg", "toast"],
"str": "whatnot"
}"""
|> JsonNode.Parse
let expected =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
let actual = CollectRemaining.jsonParse str
actual.Message |> shouldEqual expected.Message
normalise actual.Rest
|> List.map (fun (k, v) -> k, v.ToJsonString ())
|> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
[<Test>]
let ``Can write out extension data`` () =
let expected =
"""{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}"""
let toWrite =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
let actual = CollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
actual |> shouldEqual expected
[<Test>]
let ``Can collect extension data, nested`` () =
let str =
"""{
"thing": 99,
"baz": -123,
"remaining": {
"message": { "header": "hi", "value": "bye" },
"something": 3,
"arr": ["egg", "toast"],
"str": "whatnot"
}
}"""
|> JsonNode.Parse
let expected : OuterCollectRemaining =
{
Remaining =
{
Message =
Some
{
Header = "hi"
Value = "bye"
}
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
}
Others = [ "thing", 99 ; "baz", -123 ] |> dict
}
let actual = OuterCollectRemaining.jsonParse str
normalise actual.Others |> shouldEqual (normalise expected.Others)
let actual = actual.Remaining
let expected = expected.Remaining
actual.Message |> shouldEqual expected.Message
normalise actual.Rest
|> List.map (fun (k, v) -> k, v.ToJsonString ())
|> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()))
[<Test>]
let ``Can write out extension data, nested`` () =
let expected =
"""{"thing":99,"baz":-123,"remaining":{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}}"""
let toWrite : OuterCollectRemaining =
{
Others = [ "thing", 99 ; "baz", -123 ] |> dict
Remaining =
{
Rest =
[
"something", JsonNode.op_Implicit 3
"arr", makeJsonArr [| "egg" ; "toast" |]
"str", JsonNode.op_Implicit "whatnot"
]
|> dict
Message =
Some
{
Header = "hi"
Value = "bye"
}
}
}
let actual = OuterCollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString ()
actual |> shouldEqual expected

View File

@@ -1019,12 +1019,12 @@ module internal ArgParserGenerator =
recurseKey recurseKey
] ]
let notMatched =
let posAttr = let posAttr =
match leftoverArgAcc with match leftoverArgAcc with
| ChoicePositional.Choice a | ChoicePositional.Choice a
| ChoicePositional.Normal a -> a | ChoicePositional.Normal a -> a
let notMatched =
let handleFailure = let handleFailure =
[ [
SynMatchClause.create (SynPat.named "None") fail SynMatchClause.create (SynPat.named "None") fail
@@ -1113,6 +1113,8 @@ module internal ArgParserGenerator =
let processValue = let processValue =
// During failure, we've received an optional exception message that happened when we tried to parse // During failure, we've received an optional exception message that happened when we tried to parse
// the value; it's in the variable `exc`. // the value; it's in the variable `exc`.
// `fail` is for the case where we're genuinely emitting an error.
// If we're in `PositionalArgs true` mode, though, we won't call `fail`.
let fail = let fail =
[ [
SynExpr.createIdent "failwithf" SynExpr.createIdent "failwithf"
@@ -1132,6 +1134,27 @@ module internal ArgParserGenerator =
] ]
|> SynExpr.createMatch (SynExpr.createIdent "exc") |> SynExpr.createMatch (SynExpr.createIdent "exc")
let onFailure =
match posAttr with
| None -> fail
| Some includeFlagLike ->
[
SynExpr.createIdent "key"
|> SynExpr.pipeThroughFunction leftoverArgParser
|> fun i ->
match leftoverArgAcc with
| ChoicePositional.Choice _ ->
i |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
| ChoicePositional.Normal _ -> i
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
SynExpr.createIdent "go"
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))
]
|> SynExpr.sequential
|> SynExpr.ifThenElse includeFlagLike fail
[ [
SynMatchClause.create SynMatchClause.create
(SynPat.nameWithArgs "Ok" [ SynPat.unit ]) (SynPat.nameWithArgs "Ok" [ SynPat.unit ])
@@ -1144,7 +1167,7 @@ module internal ArgParserGenerator =
(SynPat.nameWithArgs "Error" [ SynPat.named "exc" ]) (SynPat.nameWithArgs "Error" [ SynPat.named "exc" ])
(SynExpr.ifThenElse (SynExpr.ifThenElse
(SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key")) (SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key"))
fail onFailure
(SynExpr.createIdent "go" (SynExpr.createIdent "go"
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ]) |> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args")))) |> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))))

View File

@@ -564,11 +564,12 @@ module internal CataGenerator =
let domain = let domain =
field.FieldName field.FieldName
|> Option.map Ident.lowerFirstLetter |> Option.map Ident.lowerFirstLetter
|> SynType.signatureParamOfType place |> SynType.signatureParamOfType [] place false
acc |> SynType.funFromDomain domain acc |> SynType.funFromDomain domain
) )
|> SynMemberDefn.abstractMember |> SynMemberDefn.abstractMember
[]
case.CataMethodIdent case.CataMethodIdent
None None
arity arity

View File

@@ -321,8 +321,26 @@ module internal HttpClientGenerator =
|> SynExpr.createMatch baseAddress |> SynExpr.createMatch baseAddress
|> SynExpr.paren |> SynExpr.paren
let baseAddress =
match info.BasePath with
| None -> baseAddress
| Some basePath ->
[ [
baseAddress yield baseAddress
yield
SynExpr.applyFunction
uriIdent
(SynExpr.tuple
[ basePath ; SynExpr.createLongIdent [ "System" ; "UriKind" ; "Relative" ] ])
]
|> SynExpr.tuple
|> SynExpr.applyFunction uriIdent
[
yield baseAddress
yield
SynExpr.applyFunction SynExpr.applyFunction
uriIdent uriIdent
(SynExpr.tuple (SynExpr.tuple
@@ -647,6 +665,15 @@ module internal HttpClientGenerator =
| _ -> None | _ -> None
) )
let insertTrailingSlash (path : SynExpr) : SynExpr =
match path |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, _, _), _) ->
if s.EndsWith '/' then
path
else
SynExpr.CreateConst (s + "/")
| _ -> SynExpr.plus (SynExpr.paren path) (SynExpr.CreateConst "/")
let createModule let createModule
(opens : SynOpenDeclTarget list) (opens : SynOpenDeclTarget list)
(ns : LongIdent) (ns : LongIdent)
@@ -676,8 +703,17 @@ module internal HttpClientGenerator =
"Expected constant header parameters to be of the form [<Header (key, value)>], but got more than two args" "Expected constant header parameters to be of the form [<Header (key, value)>], but got more than two args"
) )
let baseAddress = extractBaseAddress interfaceType.Attributes let baseAddress =
let basePath = extractBasePath interfaceType.Attributes extractBaseAddress interfaceType.Attributes
// We artificially insert a trailing slash because this is almost certainly
// not meant to be an endpoint itself.
|> Option.map insertTrailingSlash
let basePath =
extractBasePath interfaceType.Attributes
// We artificially insert a trailing slash because this is almost certainly
// not meant to be an endpoint itself.
|> Option.map insertTrailingSlash
let properties = let properties =
interfaceType.Properties interfaceType.Properties

View File

@@ -228,14 +228,11 @@ module internal InterfaceMockGenerator =
x.Type x.Type
let private constructMemberSinglePlace (tuple : TupledArg) : SynType = let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
match tuple.Args |> List.rev |> List.map buildType with tuple.Args
| [] -> failwith "no-arg functions not supported yet" |> List.map buildType
| [ x ] -> x |> SynType.tupleNoParen
| last :: rest -> |> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet")
([ SynTupleTypeSegment.Type last ], rest) |> if tuple.HasParen then SynType.paren else id
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
let constructMember (mem : MemberInfo) : SynField = let constructMember (mem : MemberInfo) : SynField =
let inputType = mem.Args |> List.map constructMemberSinglePlace let inputType = mem.Args |> List.map constructMemberSinglePlace

View File

@@ -59,7 +59,7 @@ module internal JsonParseGenerator =
| None -> node | None -> node
| Some propertyName -> assertNotNull propertyName node | Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsValue" |> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod "GetValue" typeName |> SynExpr.callGenericMethod (SynLongIdent.createS "GetValue") [ SynType.createLongIdent typeName ]
/// {node}.AsObject() /// {node}.AsObject()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`. /// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
@@ -279,6 +279,8 @@ module internal JsonParseGenerator =
| Measure (_measure, primType) -> | Measure (_measure, primType) ->
parseNumberType options propertyName node primType parseNumberType options propertyName node primType
|> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType) |> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
| JsonNode -> node
| Unit -> SynExpr.CreateConst ()
| _ -> | _ ->
// Let's just hope that we've also got our own type annotation! // Let's just hope that we've also got our own type annotation!
let typeName = let typeName =
@@ -375,9 +377,9 @@ module internal JsonParseGenerator =
) )
let createRecordMaker (spec : JsonParseOutputSpec) (fields : SynFieldData<Ident> list) = let createRecordMaker (spec : JsonParseOutputSpec) (fields : SynFieldData<Ident> list) =
let assignments = let propertyFields =
fields fields
|> List.mapi (fun i fieldData -> |> List.map (fun fieldData ->
let propertyNameAttr = let propertyNameAttr =
fieldData.Attrs fieldData.Attrs
|> List.tryFind (fun attr -> |> List.tryFind (fun attr ->
@@ -385,7 +387,12 @@ module internal JsonParseGenerator =
.EndsWith ("JsonPropertyName", StringComparison.Ordinal) .EndsWith ("JsonPropertyName", StringComparison.Ordinal)
) )
let options = getParseOptions fieldData.Attrs let extensionDataAttr =
fieldData.Attrs
|> List.tryFind (fun attr ->
(SynLongIdent.toString attr.TypeName)
.EndsWith ("JsonExtensionData", StringComparison.Ordinal)
)
let propertyName = let propertyName =
match propertyNameAttr with match propertyNameAttr with
@@ -401,8 +408,77 @@ module internal JsonParseGenerator =
sb.ToString () |> SynExpr.CreateConst sb.ToString () |> SynExpr.CreateConst
| Some name -> name.ArgExpr | Some name -> name.ArgExpr
propertyName, extensionDataAttr
)
let namedPropertyFields =
propertyFields
|> List.choose (fun (name, extension) ->
match extension with
| Some _ -> None
| None -> Some name
)
let isNamedPropertyField =
match namedPropertyFields with
| [] -> SynExpr.CreateConst false
| _ ->
namedPropertyFields
|> List.map (fun fieldName -> SynExpr.equals (SynExpr.createIdent "key") fieldName)
|> List.reduce SynExpr.booleanOr
let assignments =
List.zip fields propertyFields
|> List.mapi (fun i (fieldData, (propertyName, extensionDataAttr)) ->
let options = getParseOptions fieldData.Attrs
let accIdent = Ident.create $"arg_%i{i}"
match extensionDataAttr with
| Some _ ->
// Can't go through the usual parse logic here, because that will try and identify the node that's
// been labelled. The whole point of JsonExtensionData is that there is no such node!
let valType =
match fieldData.Type with
| DictionaryType (String, v) -> v
| _ -> failwith "Expected JsonExtensionData to be Dictionary<string, _>"
SynExpr.ifThenElse
isNamedPropertyField
(SynExpr.callMethodArg
"Add"
(SynExpr.tuple
[
SynExpr.createIdent "key"
createParseRhs options (SynExpr.createIdent "key") valType
])
(SynExpr.createIdent "result"))
(SynExpr.CreateConst ())
|> SynExpr.createForEach
(SynPat.nameWithArgs "KeyValue" [ SynPat.named "key" ; SynPat.named "value" ])
(SynExpr.createIdent "node")
|> fun forEach -> [ forEach ; SynExpr.createIdent "result" ]
|> SynExpr.sequential
|> SynExpr.createLet
[
SynBinding.basic
[ Ident.create "result" ]
[]
(SynExpr.typeApp
[ SynType.string ; valType ]
(SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
|> SynExpr.applyTo (SynExpr.CreateConst ()))
SynBinding.basic
[ Ident.create "node" ]
[]
(SynExpr.createIdent "node" |> SynExpr.callMethod "AsObject")
]
|> SynBinding.basic [ accIdent ] []
| None ->
createParseRhs options propertyName fieldData.Type createParseRhs options propertyName fieldData.Type
|> SynBinding.basic [ Ident.create $"arg_%i{i}" ] [] |> SynBinding.basic [ accIdent ] []
) )
let finalConstruction = let finalConstruction =
@@ -483,9 +559,7 @@ module internal JsonParseGenerator =
|> SynExpr.index property |> SynExpr.index property
|> assertNotNull property |> assertNotNull property
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.createLambda SynExpr.createLambda "v" (SynExpr.callGenericMethod' "GetValue" "string" (SynExpr.createIdent "v"))
"v"
(SynExpr.callGenericMethod "GetValue" [ Ident.create "string" ] (SynExpr.createIdent "v"))
) )
|> SynBinding.basic [ Ident.create "ty" ] [] |> SynBinding.basic [ Ident.create "ty" ] []
] ]

View File

@@ -146,6 +146,13 @@ module internal JsonSerializeGenerator =
] ]
|> SynExpr.createLambda "field" |> SynExpr.createLambda "field"
|> fun e -> e, false |> fun e -> e, false
| JsonNode -> SynExpr.createIdent "id", true
| Unit ->
SynExpr.createLambda
"value"
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())),
false
| _ -> | _ ->
// {type}.toJsonNode // {type}.toJsonNode
let typeName = let typeName =
@@ -187,6 +194,14 @@ module internal JsonSerializeGenerator =
sb.ToString () |> SynExpr.CreateConst sb.ToString () |> SynExpr.CreateConst
| Some name -> name.ArgExpr | Some name -> name.ArgExpr
let getIsJsonExtension (attrs : SynAttribute list) : bool =
attrs
|> List.tryFind (fun attr ->
(SynLongIdent.toString attr.TypeName)
.EndsWith ("JsonExtensionData", StringComparison.Ordinal)
)
|> Option.isSome
/// `populateNode` will be inserted before we return the `node` variable. /// `populateNode` will be inserted before we return the `node` variable.
/// ///
/// That is, we give you access to a `JsonObject` called `node`, /// That is, we give you access to a `JsonObject` called `node`,
@@ -256,6 +271,30 @@ module internal JsonSerializeGenerator =
fields fields
|> List.map (fun fieldData -> |> List.map (fun fieldData ->
let propertyName = getPropertyName fieldData.Ident fieldData.Attrs let propertyName = getPropertyName fieldData.Ident fieldData.Attrs
let isJsonExtension = getIsJsonExtension fieldData.Attrs
if isJsonExtension then
let valType =
match fieldData.Type with
| DictionaryType (String, v) -> v
| _ -> failwith "Expected JsonExtensionData to be a Dictionary<string, something>"
let serialise = fst (serializeNode valType)
SynExpr.createIdent "node"
|> SynExpr.callMethodArg
"Add"
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction serialise (SynExpr.createIdent "value")
])
|> SynExpr.createForEach
(SynPat.identWithArgs
[ Ident.create "KeyValue" ]
(SynArgPats.create [ SynPat.named "key" ; SynPat.named "value" ]))
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldData.Ident ])
else
createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type
) )
|> SynExpr.sequential |> SynExpr.sequential

View File

@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
open System open System
open System.Text open System.Text
open System.Text.RegularExpressions
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
@@ -9,6 +10,54 @@ open Fantomas.FCS.Text.Range
module internal Ident = module internal Ident =
let inline create (s : string) = Ident (s, range0) let inline create (s : string) = Ident (s, range0)
/// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical
/// apart from the ranges?
/// Awful hack: here is a function that does this sort of thing.
let createSanitisedParamName (s : string) =
match s with
| "type" -> create "type'"
| "private" -> create "private'"
| _ ->
let result = StringBuilder ()
for i = 0 to s.Length - 1 do
if Char.IsLetter s.[i] then
result.Append s.[i] |> ignore<StringBuilder>
elif Char.IsNumber s.[i] then
if result.Length > 0 then
result.Append s.[i] |> ignore<StringBuilder>
elif s.[i] = '_' || s.[i] = '-' then
result.Append '_' |> ignore<StringBuilder>
else
failwith $"could not convert to ident: %s{s}"
create (result.ToString ())
let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$"
let createSanitisedTypeName (s : string) =
let result = StringBuilder ()
let mutable capitalize = true
for i = 0 to s.Length - 1 do
if Char.IsLetter s.[i] then
if capitalize then
result.Append (Char.ToUpperInvariant s.[i]) |> ignore<StringBuilder>
capitalize <- false
else
result.Append s.[i] |> ignore<StringBuilder>
elif Char.IsNumber s.[i] then
if result.Length > 0 then
result.Append s.[i] |> ignore<StringBuilder>
elif s.[i] = '_' then
capitalize <- true
if result.Length = 0 then
failwith $"String %s{s} was not suitable as a type identifier"
Ident (result.ToString (), range0)
let lowerFirstLetter (x : Ident) : Ident = let lowerFirstLetter (x : Ident) : Ident =
let result = StringBuilder x.idText.Length let result = StringBuilder x.idText.Length
result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore

View File

@@ -6,7 +6,12 @@ open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal PreXmlDoc = module internal PreXmlDoc =
let create (s : string) : PreXmlDoc = let create (s : string) : PreXmlDoc =
PreXmlDoc.Create ([| " " + s |], range0) let s = s.Split "\n"
for i = 0 to s.Length - 1 do
s.[i] <- " " + s.[i]
PreXmlDoc.Create (s, range0)
let create' (s : string seq) : PreXmlDoc = let create' (s : string seq) : PreXmlDoc =
PreXmlDoc.Create (Array.ofSeq s, range0) PreXmlDoc.Create (Array.ofSeq s, range0)

View File

@@ -9,12 +9,12 @@ module internal SynArgPats =
match caseNames.Length with match caseNames.Length with
| 0 -> SynArgPats.Pats [] | 0 -> SynArgPats.Pats []
| 1 -> | 1 ->
SynPat.Named (SynIdent.SynIdent (Ident.create caseNames.[0], None), false, None, range0) SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0)
|> List.singleton |> List.singleton
|> SynArgPats.Pats |> SynArgPats.Pats
| len -> | len ->
caseNames caseNames
|> List.map (fun name -> SynPat.Named (SynIdent.SynIdent (Ident.create name, None), false, None, range0)) |> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0))
|> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0) |> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0)
|> fun t -> SynPat.Paren (t, range0) |> fun t -> SynPat.Paren (t, range0)
|> List.singleton |> List.singleton

View File

@@ -5,32 +5,23 @@ open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal SynAttribute = module internal SynAttribute =
let internal compilationRepresentation : SynAttribute = let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute =
{ {
TypeName = SynLongIdent.createS "CompilationRepresentation" TypeName = typeName
ArgExpr = ArgExpr = arg
Target = None
AppliesToGetterAndSetter = false
Range = range0
}
let internal compilationRepresentation : SynAttribute =
[ "CompilationRepresentationFlags" ; "ModuleSuffix" ] [ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
|> SynExpr.createLongIdent |> SynExpr.createLongIdent
|> SynExpr.paren |> SynExpr.paren
Target = None |> create (SynLongIdent.createS "CompilationRepresentation")
AppliesToGetterAndSetter = false
Range = range0
}
let internal requireQualifiedAccess : SynAttribute = let internal requireQualifiedAccess : SynAttribute =
{ create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ())
TypeName = SynLongIdent.createS "RequireQualifiedAccess"
ArgExpr = SynExpr.CreateConst ()
Target = None
AppliesToGetterAndSetter = false
Range = range0
}
let internal autoOpen : SynAttribute = let internal autoOpen : SynAttribute =
{ create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ())
TypeName = SynLongIdent.createS "AutoOpen"
ArgExpr = SynExpr.CreateConst ()
Target = None
AppliesToGetterAndSetter = false
Range = range0
}

View File

@@ -85,6 +85,11 @@ module internal SynExpr =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a) SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a)
|> applyTo b |> applyTo b
/// {a} || {b}
let booleanOr (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanOr, a)
|> applyTo b
/// {a} + {b} /// {a} + {b}
let plus (a : SynExpr) (b : SynExpr) = let plus (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix ( SynExpr.CreateAppInfix (
@@ -136,16 +141,15 @@ module internal SynExpr =
let typeApp (types : SynType list) (operand : SynExpr) = let typeApp (types : SynType list) (operand : SynExpr) =
SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0) SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0)
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr = /// {obj}.{meth}<types,...>()
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0) let callGenericMethod (meth : SynLongIdent) (types : SynType list) (obj : SynExpr) : SynExpr =
|> typeApp [ SynType.LongIdent (SynLongIdent.create ty) ] SynExpr.DotGet (obj, range0, meth, range0)
|> typeApp types
|> applyTo (SynExpr.CreateConst ()) |> applyTo (SynExpr.CreateConst ())
/// {obj}.{meth}<ty>() /// {obj}.{meth}<ty>()
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr = let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0) callGenericMethod (SynLongIdent.createS meth) [ SynType.createLongIdent' [ ty ] ] obj
|> typeApp [ SynType.createLongIdent' [ ty ] ]
|> applyTo (SynExpr.CreateConst ())
let inline index (property : SynExpr) (obj : SynExpr) : SynExpr = let inline index (property : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (obj, property, range0, range0) SynExpr.DotIndexedGet (obj, property, range0, range0)
@@ -237,6 +241,8 @@ module internal SynExpr =
let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr = let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty) SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty)
let inline createDo (body : SynExpr) : SynExpr = SynExpr.Do (body, range0)
let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr =
SynExpr.Match ( SynExpr.Match (
DebugPointAtBinding.Yes range0, DebugPointAtBinding.Yes range0,

View File

@@ -0,0 +1,10 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>]
module internal SynIdent =
let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None)
let inline createS (i : string) : SynIdent =
SynIdent.SynIdent (Ident.create i, None)

View File

@@ -36,6 +36,9 @@ module internal SynLongIdent =
let booleanAnd = let booleanAnd =
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ]) SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
let booleanOr =
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanOr" ], [], [ Some (IdentTrivia.OriginalNotation "||") ])
let pipe = let pipe =
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ]) SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])

View File

@@ -17,8 +17,8 @@ module internal SynMemberDefn =
SynMemberFlags.MemberKind = SynMemberKind.Member SynMemberFlags.MemberKind = SynMemberKind.Member
} }
let abstractMember let abstractMember
(attrs : SynAttribute list)
(ident : SynIdent) (ident : SynIdent)
(typars : SynTyparDecls option) (typars : SynTyparDecls option)
(arity : SynValInfo) (arity : SynValInfo)
@@ -28,7 +28,13 @@ module internal SynMemberDefn =
= =
let slot = let slot =
SynValSig.SynValSig ( SynValSig.SynValSig (
[], attrs
|> List.map (fun attr ->
{
Attributes = [ attr ]
Range = range0
}
),
ident, ident,
SynValTyparDecls.SynValTyparDecls (typars, true), SynValTyparDecls.SynValTyparDecls (typars, true),
returnType, returnType,

View File

@@ -181,6 +181,29 @@ module internal SynTypePatterns =
_) -> Some (ident, outer) _) -> Some (ident, outer)
| _ -> None | _ -> None
let (|JsonNode|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
| [ "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
| [ "Json" ; "Nodes" ; "JsonNode" ]
| [ "Nodes" ; "JsonNode" ]
| [ "JsonNode" ] -> Some ()
| _ -> None
| _ -> None
let (|Unit|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText.ToLowerInvariant ()) with
| [ "microsoft" ; "fsharp" ; "core" ; "unit" ]
| [ "fsharp" ; "core" ; "unit" ]
| [ "core" ; "unit" ]
| [ "unit" ] -> Some ()
| _ -> None
| _ -> None
let (|DateOnly|_|) (fieldType : SynType) = let (|DateOnly|_|) (fieldType : SynType) =
match fieldType with match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
@@ -267,6 +290,8 @@ module internal SynType =
| SynType.Paren (ty, _) -> stripOptionalParen ty | SynType.Paren (ty, _) -> stripOptionalParen ty
| ty -> ty | ty -> ty
let inline paren (ty : SynType) : SynType = SynType.Paren (ty, range0)
let inline createLongIdent (ident : LongIdent) : SynType = let inline createLongIdent (ident : LongIdent) : SynType =
SynType.LongIdent (SynLongIdent.create ident) SynType.LongIdent (SynLongIdent.create ident)
@@ -283,6 +308,17 @@ module internal SynType =
let inline app (name : string) (args : SynType list) : SynType = app' (named name) args let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
/// Returns None if the input list was empty.
let inline tupleNoParen (ty : SynType list) : SynType option =
match List.rev ty with
| [] -> None
| [ t ] -> Some t
| t :: rest ->
([ SynTupleTypeSegment.Type t ], rest)
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> Some
let inline appPostfix (name : string) (arg : SynType) : SynType = let inline appPostfix (name : string) (arg : SynType) : SynType =
SynType.App (named name, None, [ arg ], [], None, true, range0) SynType.App (named name, None, [ arg ], [], None, true, range0)
@@ -299,16 +335,54 @@ module internal SynType =
} }
) )
let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType = let inline signatureParamOfType
SynType.SignatureParameter ([], false, name, ty, range0) (attrs : SynAttribute list)
(ty : SynType)
(optional : bool)
(name : Ident option)
: SynType
=
SynType.SignatureParameter (
attrs
|> List.map (fun attr ->
{
Attributes = [ attr ]
Range = range0
}
),
optional,
name,
ty,
range0
)
let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0) let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
let unit : SynType = named "unit" let unit : SynType = named "unit"
let obj : SynType = named "obj"
let bool : SynType = named "bool"
let int : SynType = named "int" let int : SynType = named "int"
let array (elt : SynType) : SynType = SynType.Array (1, elt, range0)
let list (elt : SynType) : SynType =
SynType.App (named "list", None, [ elt ], [], None, true, range0)
let option (elt : SynType) : SynType =
SynType.App (named "option", None, [ elt ], [], None, true, range0)
let anon : SynType = SynType.Anon range0 let anon : SynType = SynType.Anon range0
let task (elt : SynType) : SynType =
SynType.App (
createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "Task" ],
None,
[ elt ],
[],
None,
true,
range0
)
let string : SynType = named "string" let string : SynType = named "string"
/// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret. /// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.

View File

@@ -44,7 +44,7 @@ module internal SynUnionCase =
SynUnionCase.SynUnionCase ( SynUnionCase.SynUnionCase (
SynAttributes.ofAttrs case.Attributes, SynAttributes.ofAttrs case.Attributes,
SynIdent.SynIdent (case.Name, None), SynIdent.createI case.Name,
SynUnionCaseKind.Fields fields, SynUnionCaseKind.Fields fields,
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty, case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
case.Access, case.Access,

View File

@@ -30,6 +30,7 @@
<Compile Include="SynExpr\SynAttributes.fs" /> <Compile Include="SynExpr\SynAttributes.fs" />
<Compile Include="SynExpr\PreXmlDoc.fs" /> <Compile Include="SynExpr\PreXmlDoc.fs" />
<Compile Include="SynExpr\Ident.fs" /> <Compile Include="SynExpr\Ident.fs" />
<Compile Include="SynExpr\SynIdent.fs" />
<Compile Include="SynExpr\SynLongIdent.fs" /> <Compile Include="SynExpr\SynLongIdent.fs" />
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" /> <Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
<Compile Include="SynExpr\SynArgPats.fs" /> <Compile Include="SynExpr\SynArgPats.fs" />

View File

@@ -1,5 +1,5 @@
{ {
"version": "2.3", "version": "3.0",
"publicReleaseRefSpec": [ "publicReleaseRefSpec": [
"^refs/heads/main$" "^refs/heads/main$"
], ],