mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-07 04:58:41 +00:00
Compare commits
3 Commits
WoofWare.M
...
WoofWare.M
Author | SHA1 | Date | |
---|---|---|---|
|
8e47f39efc | ||
|
6942ba42b9 | ||
|
b98080690d |
@@ -1,5 +1,14 @@
|
|||||||
Notable changes are recorded here.
|
Notable changes are recorded here.
|
||||||
|
|
||||||
|
# WoofWare.Myriad.Plugins 2.1.33
|
||||||
|
|
||||||
|
`JsonParse` can now deserialize the discriminated unions which `JsonSerialize` wrote out.
|
||||||
|
|
||||||
|
# WoofWare.Myriad.Plugins 2.1.32, WoofWare.Myriad.Plugins.Attributes 3.1.4
|
||||||
|
|
||||||
|
`JsonSerialize` can now serialize many discriminated unions.
|
||||||
|
(This operation is inherently opinionated, because JSON does not model discriminated unions.)
|
||||||
|
|
||||||
# WoofWare.Myriad.Plugins 2.1.20, WoofWare.Myriad.Plugins.Attributes 3.0.1
|
# WoofWare.Myriad.Plugins 2.1.20, WoofWare.Myriad.Plugins.Attributes 3.0.1
|
||||||
|
|
||||||
We now bundle copies of the RestEase attributes in `WoofWare.Myriad.Plugins.Attributes`, in case you don't want to take a dependency on RestEase.
|
We now bundle copies of the RestEase attributes in `WoofWare.Myriad.Plugins.Attributes`, in case you don't want to take a dependency on RestEase.
|
||||||
|
@@ -8,8 +8,7 @@
|
|||||||
namespace ConsumePlugin
|
namespace ConsumePlugin
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the InnerType type
|
/// Module containing JSON parsing methods for the InnerType type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module InnerType =
|
module InnerType =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : InnerType =
|
||||||
@@ -31,8 +30,7 @@ module InnerType =
|
|||||||
namespace ConsumePlugin
|
namespace ConsumePlugin
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the JsonRecordType type
|
/// Module containing JSON parsing methods for the JsonRecordType type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module JsonRecordType =
|
module JsonRecordType =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
|
||||||
|
@@ -41,8 +41,7 @@ module MemberJsonSerializeExtension =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the GymOpeningHours type
|
/// Module containing JSON parsing methods for the GymOpeningHours type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module GymOpeningHours =
|
module GymOpeningHours =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymOpeningHours =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymOpeningHours =
|
||||||
@@ -78,8 +77,7 @@ module GymOpeningHours =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the GymAccessOptions type
|
/// Module containing JSON parsing methods for the GymAccessOptions type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module GymAccessOptions =
|
module GymAccessOptions =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAccessOptions =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAccessOptions =
|
||||||
@@ -114,8 +112,7 @@ module GymAccessOptions =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the GymLocation type
|
/// Module containing JSON parsing methods for the GymLocation type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module GymLocation =
|
module GymLocation =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymLocation =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymLocation =
|
||||||
@@ -192,8 +189,7 @@ module GymLocation =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the GymAddress type
|
/// Module containing JSON parsing methods for the GymAddress type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module GymAddress =
|
module GymAddress =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAddress =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAddress =
|
||||||
@@ -259,8 +255,7 @@ module GymAddress =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the Gym type
|
/// Module containing JSON parsing methods for the Gym type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module Gym =
|
module Gym =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Gym =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Gym =
|
||||||
@@ -620,8 +615,7 @@ module MemberJsonParseExtension =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the GymAttendance type
|
/// Module containing JSON parsing methods for the GymAttendance type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module GymAttendance =
|
module GymAttendance =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAttendance =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : GymAttendance =
|
||||||
@@ -743,8 +737,7 @@ module GymAttendance =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the MemberActivityDto type
|
/// Module containing JSON parsing methods for the MemberActivityDto type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module MemberActivityDto =
|
module MemberActivityDto =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : MemberActivityDto =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : MemberActivityDto =
|
||||||
@@ -832,8 +825,7 @@ module MemberActivityDto =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the SessionsAggregate type
|
/// Module containing JSON parsing methods for the SessionsAggregate type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module SessionsAggregate =
|
module SessionsAggregate =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsAggregate =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsAggregate =
|
||||||
@@ -881,8 +873,7 @@ module SessionsAggregate =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the VisitGym type
|
/// Module containing JSON parsing methods for the VisitGym type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module VisitGym =
|
module VisitGym =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : VisitGym =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : VisitGym =
|
||||||
@@ -930,8 +921,7 @@ module VisitGym =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the Visit type
|
/// Module containing JSON parsing methods for the Visit type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module Visit =
|
module Visit =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit =
|
||||||
@@ -993,8 +983,7 @@ module Visit =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the SessionsSummary type
|
/// Module containing JSON parsing methods for the SessionsSummary type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module SessionsSummary =
|
module SessionsSummary =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary =
|
||||||
@@ -1029,8 +1018,7 @@ module SessionsSummary =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the Sessions type
|
/// Module containing JSON parsing methods for the Sessions type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module Sessions =
|
module Sessions =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Sessions =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Sessions =
|
||||||
@@ -1066,8 +1054,7 @@ module Sessions =
|
|||||||
namespace PureGym
|
namespace PureGym
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the UriThing type
|
/// Module containing JSON parsing methods for the UriThing type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module UriThing =
|
module UriThing =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : UriThing =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : UriThing =
|
||||||
|
@@ -17,8 +17,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module PureGymApi =
|
module PureGymApi =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IPureGymApi =
|
let make (client : System.Net.Http.HttpClient) : IPureGymApi =
|
||||||
@@ -1055,8 +1054,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module internal ApiWithoutBaseAddress =
|
module internal ApiWithoutBaseAddress =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IApiWithoutBaseAddress =
|
let make (client : System.Net.Http.HttpClient) : IApiWithoutBaseAddress =
|
||||||
@@ -1107,8 +1105,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module ApiWithBasePath =
|
module ApiWithBasePath =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IApiWithBasePath =
|
let make (client : System.Net.Http.HttpClient) : IApiWithBasePath =
|
||||||
@@ -1159,8 +1156,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module ApiWithBasePathAndAddress =
|
module ApiWithBasePathAndAddress =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAddress =
|
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAddress =
|
||||||
@@ -1205,8 +1201,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module ApiWithHeaders =
|
module ApiWithHeaders =
|
||||||
/// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties.
|
/// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties.
|
||||||
let make
|
let make
|
||||||
@@ -1268,8 +1263,7 @@ open System.Net.Http
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module ApiWithHeaders2 =
|
module ApiWithHeaders2 =
|
||||||
/// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties.
|
/// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties.
|
||||||
let make
|
let make
|
||||||
|
@@ -378,3 +378,83 @@ module JsonRecordTypeWithBothJsonParseExtension =
|
|||||||
E = arg_4
|
E = arg_4
|
||||||
F = arg_5
|
F = arg_5
|
||||||
}
|
}
|
||||||
|
namespace ConsumePlugin
|
||||||
|
|
||||||
|
/// Module containing JSON parsing extension members for the FirstDu type
|
||||||
|
[<AutoOpen>]
|
||||||
|
module FirstDuJsonParseExtension =
|
||||||
|
/// Extension methods for JSON parsing
|
||||||
|
type FirstDu with
|
||||||
|
|
||||||
|
/// Parse from a JSON node.
|
||||||
|
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : FirstDu =
|
||||||
|
let ty =
|
||||||
|
(match node.["type"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("type")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v)
|
||||||
|
|> (fun v -> v.GetValue<string> ())
|
||||||
|
|
||||||
|
match ty with
|
||||||
|
| "emptyCase" -> FirstDu.EmptyCase
|
||||||
|
| "case1" ->
|
||||||
|
let node =
|
||||||
|
(match node.["data"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("data")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v)
|
||||||
|
|
||||||
|
FirstDu.Case1 (
|
||||||
|
(match node.["data"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("data")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v)
|
||||||
|
.AsValue()
|
||||||
|
.GetValue<string> ()
|
||||||
|
)
|
||||||
|
| "case2" ->
|
||||||
|
let node =
|
||||||
|
(match node.["data"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("data")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v)
|
||||||
|
|
||||||
|
FirstDu.Case2 (
|
||||||
|
JsonRecordTypeWithBoth.jsonParse (
|
||||||
|
match node.["record"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("record")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v
|
||||||
|
),
|
||||||
|
(match node.["i"] with
|
||||||
|
| null ->
|
||||||
|
raise (
|
||||||
|
System.Collections.Generic.KeyNotFoundException (
|
||||||
|
sprintf "Required key '%s' not found on JSON object" ("i")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
| v -> v)
|
||||||
|
.AsValue()
|
||||||
|
.GetValue<int> ()
|
||||||
|
)
|
||||||
|
| v -> failwith ("Unrecognised 'type' field value: " + v)
|
||||||
|
@@ -8,8 +8,7 @@
|
|||||||
namespace ConsumePlugin
|
namespace ConsumePlugin
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the JwtVaultAuthResponse type
|
/// Module containing JSON parsing methods for the JwtVaultAuthResponse type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module JwtVaultAuthResponse =
|
module JwtVaultAuthResponse =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
|
||||||
@@ -164,8 +163,7 @@ module JwtVaultAuthResponse =
|
|||||||
namespace ConsumePlugin
|
namespace ConsumePlugin
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the JwtVaultResponse type
|
/// Module containing JSON parsing methods for the JwtVaultResponse type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module JwtVaultResponse =
|
module JwtVaultResponse =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
|
||||||
@@ -239,8 +237,7 @@ module JwtVaultResponse =
|
|||||||
namespace ConsumePlugin
|
namespace ConsumePlugin
|
||||||
|
|
||||||
/// Module containing JSON parsing methods for the JwtSecretResponse type
|
/// Module containing JSON parsing methods for the JwtSecretResponse type
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
|
||||||
module JwtSecretResponse =
|
module JwtSecretResponse =
|
||||||
/// Parse from a JSON node.
|
/// Parse from a JSON node.
|
||||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
|
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
|
||||||
@@ -455,8 +452,7 @@ open System.Threading.Tasks
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module VaultClient =
|
module VaultClient =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IVaultClient =
|
let make (client : System.Net.Http.HttpClient) : IVaultClient =
|
||||||
@@ -553,8 +549,7 @@ open System.Threading.Tasks
|
|||||||
open RestEase
|
open RestEase
|
||||||
|
|
||||||
/// Module for constructing a REST client.
|
/// Module for constructing a REST client.
|
||||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module VaultClientNonExtensionMethod =
|
module VaultClientNonExtensionMethod =
|
||||||
/// Create a REST client.
|
/// Create a REST client.
|
||||||
let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod =
|
let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod =
|
||||||
|
@@ -29,6 +29,7 @@ type JsonRecordTypeWithBoth =
|
|||||||
}
|
}
|
||||||
|
|
||||||
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
|
[<WoofWare.Myriad.Plugins.JsonSerialize true>]
|
||||||
|
[<WoofWare.Myriad.Plugins.JsonParse true>]
|
||||||
type FirstDu =
|
type FirstDu =
|
||||||
| EmptyCase
|
| EmptyCase
|
||||||
| Case1 of data : string
|
| Case1 of data : string
|
||||||
|
@@ -2,10 +2,9 @@ namespace WoofWare.Myriad.Plugins.Test
|
|||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Collections.Generic
|
open System.Collections.Generic
|
||||||
open System.IO
|
|
||||||
open System.Text
|
|
||||||
open System.Text.Json
|
|
||||||
open System.Text.Json.Nodes
|
open System.Text.Json.Nodes
|
||||||
|
open FsCheck.Random
|
||||||
|
open Microsoft.FSharp.Reflection
|
||||||
open NUnit.Framework
|
open NUnit.Framework
|
||||||
open FsCheck
|
open FsCheck
|
||||||
open FsUnitTyped
|
open FsUnitTyped
|
||||||
@@ -124,3 +123,82 @@ module TestJsonSerde =
|
|||||||
|> shouldEqual (
|
|> shouldEqual (
|
||||||
sprintf """{"it\u0027s-a-me":"%s","map":{},"readOnlyDict":{},"dict":{},"concreteDict":{}}""" guidStr
|
sprintf """{"it\u0027s-a-me":"%s","map":{},"readOnlyDict":{},"dict":{},"concreteDict":{}}""" guidStr
|
||||||
)
|
)
|
||||||
|
|
||||||
|
type Generators =
|
||||||
|
static member TestCase () =
|
||||||
|
{ new Arbitrary<InnerTypeWithBoth>() with
|
||||||
|
override x.Generator = innerGen 5
|
||||||
|
}
|
||||||
|
|
||||||
|
let sanitiseInner (r : InnerTypeWithBoth) : InnerTypeWithBoth =
|
||||||
|
{
|
||||||
|
Thing = r.Thing
|
||||||
|
Map = r.Map
|
||||||
|
ReadOnlyDict = r.ReadOnlyDict
|
||||||
|
Dict = r.Dict
|
||||||
|
ConcreteDict = r.ConcreteDict
|
||||||
|
}
|
||||||
|
|
||||||
|
let sanitiseRec (r : JsonRecordTypeWithBoth) : JsonRecordTypeWithBoth =
|
||||||
|
{
|
||||||
|
A = r.A
|
||||||
|
B = if isNull r.B then "<null>" else r.B
|
||||||
|
C =
|
||||||
|
if Object.ReferenceEquals (r.C, (null : obj)) then
|
||||||
|
[]
|
||||||
|
else
|
||||||
|
r.C
|
||||||
|
D = sanitiseInner r.D
|
||||||
|
E = if isNull r.E then [||] else r.E
|
||||||
|
F =
|
||||||
|
if Object.ReferenceEquals (r.F, (null : obj)) then
|
||||||
|
[||]
|
||||||
|
else
|
||||||
|
r.F
|
||||||
|
}
|
||||||
|
|
||||||
|
let duGen =
|
||||||
|
gen {
|
||||||
|
let! case = Gen.choose (0, 2)
|
||||||
|
|
||||||
|
match case with
|
||||||
|
| 0 -> return FirstDu.EmptyCase
|
||||||
|
| 1 ->
|
||||||
|
let! s = Arb.generate<NonNull<string>>
|
||||||
|
return FirstDu.Case1 s.Get
|
||||||
|
| 2 ->
|
||||||
|
let! i = Arb.generate<int>
|
||||||
|
let! record = outerGen
|
||||||
|
return FirstDu.Case2 (record, i)
|
||||||
|
| _ -> return failwith $"unexpected: %i{case}"
|
||||||
|
}
|
||||||
|
|
||||||
|
[<Test>]
|
||||||
|
let ``Discriminated union works`` () =
|
||||||
|
let property (du : FirstDu) : unit =
|
||||||
|
du
|
||||||
|
|> FirstDu.toJsonNode
|
||||||
|
|> fun s -> s.ToJsonString ()
|
||||||
|
|> JsonNode.Parse
|
||||||
|
|> FirstDu.jsonParse
|
||||||
|
|> shouldEqual du
|
||||||
|
|
||||||
|
property |> Prop.forAll (Arb.fromGen duGen) |> Check.QuickThrowOnFailure
|
||||||
|
|
||||||
|
[<Test>]
|
||||||
|
let ``DU generator covers all cases`` () =
|
||||||
|
let rand = Random ()
|
||||||
|
let cases = FSharpType.GetUnionCases typeof<FirstDu>
|
||||||
|
let counts = Array.zeroCreate<int> cases.Length
|
||||||
|
|
||||||
|
let decompose = FSharpValue.PreComputeUnionTagReader typeof<FirstDu>
|
||||||
|
|
||||||
|
Gen.listOf duGen
|
||||||
|
|> Gen.eval 100 (StdGen.StdGen (rand.Next (), rand.Next ()))
|
||||||
|
|> List.iter (fun du ->
|
||||||
|
let tag = decompose du
|
||||||
|
counts.[tag] <- counts.[tag] + 1
|
||||||
|
)
|
||||||
|
|
||||||
|
for i in counts do
|
||||||
|
i |> shouldBeGreaterThan 0
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.SyntaxTrivia
|
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
open Fantomas.FCS.Xml
|
open Fantomas.FCS.Xml
|
||||||
open Myriad.Core.AstExtensions
|
open Myriad.Core.AstExtensions
|
||||||
@@ -98,30 +97,6 @@ type internal AdtProduct =
|
|||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal AstHelper =
|
module internal AstHelper =
|
||||||
|
|
||||||
/// Given e.g. "byte", returns "System.Byte".
|
|
||||||
let qualifyPrimitiveType (typeName : string) : LongIdent option =
|
|
||||||
match typeName with
|
|
||||||
| "float32"
|
|
||||||
| "single" -> [ "System" ; "Single" ] |> Some
|
|
||||||
| "float"
|
|
||||||
| "double" -> [ "System" ; "Double" ] |> Some
|
|
||||||
| "byte"
|
|
||||||
| "uint8" -> [ "System" ; "Byte" ] |> Some
|
|
||||||
| "sbyte"
|
|
||||||
| "int8" -> [ "System" ; "SByte" ] |> Some
|
|
||||||
| "int16" -> [ "System" ; "Int16" ] |> Some
|
|
||||||
| "int"
|
|
||||||
| "int32" -> [ "System" ; "Int32" ] |> Some
|
|
||||||
| "int64" -> [ "System" ; "Int64" ] |> Some
|
|
||||||
| "uint16" -> [ "System" ; "UInt16" ] |> Some
|
|
||||||
| "uint"
|
|
||||||
| "uint32" -> [ "System" ; "UInt32" ] |> Some
|
|
||||||
| "uint64" -> [ "System" ; "UInt64" ] |> Some
|
|
||||||
| "char" -> [ "System" ; "Char" ] |> Some
|
|
||||||
| "decimal" -> [ "System" ; "Decimal" ] |> Some
|
|
||||||
| _ -> None
|
|
||||||
|> Option.map (List.map Ident.Create)
|
|
||||||
|
|
||||||
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
|
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
|
||||||
let fields =
|
let fields =
|
||||||
fields
|
fields
|
||||||
@@ -130,86 +105,17 @@ module internal AstHelper =
|
|||||||
SynExpr.Record (None, None, fields, range0)
|
SynExpr.Record (None, None, fields, range0)
|
||||||
|
|
||||||
let defineRecordType (record : RecordType) : SynTypeDefn =
|
let defineRecordType (record : RecordType) : SynTypeDefn =
|
||||||
let repr =
|
|
||||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, Seq.toList record.Fields, range0), range0)
|
|
||||||
|
|
||||||
let name =
|
let name =
|
||||||
SynComponentInfo.Create (
|
SynComponentInfo.create record.Name
|
||||||
[ record.Name ],
|
|> SynComponentInfo.setAccessibility record.Accessibility
|
||||||
?xmldoc = record.XmlDoc,
|
|> match record.XmlDoc with
|
||||||
?parameters = record.Generics,
|
| None -> id
|
||||||
access = record.Accessibility
|
| Some doc -> SynComponentInfo.withDocString doc
|
||||||
)
|
|> SynComponentInfo.setGenerics record.Generics
|
||||||
|
|
||||||
let trivia : SynTypeDefnTrivia =
|
SynTypeDefnRepr.record (Seq.toList record.Fields)
|
||||||
{
|
|> SynTypeDefn.create name
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
|
||||||
EqualsRange = Some range0
|
|
||||||
WithKeyword = Some range0
|
|
||||||
}
|
|
||||||
|
|
||||||
SynTypeDefn (name, repr, defaultArg record.Members SynMemberDefns.Empty, None, range0, trivia)
|
|
||||||
|
|
||||||
let isOptionIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] when System.String.Equals (i.idText, "option", System.StringComparison.OrdinalIgnoreCase) -> true
|
|
||||||
// TODO: consider Microsoft.FSharp.Option or whatever it is
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isUnitIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] when System.String.Equals (i.idText, "unit", System.StringComparison.OrdinalIgnoreCase) -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isListIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] when System.String.Equals (i.idText, "list", System.StringComparison.OrdinalIgnoreCase) -> true
|
|
||||||
// TODO: consider FSharpList or whatever it is
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isArrayIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] when
|
|
||||||
System.String.Equals (i.idText, "array", System.StringComparison.OrdinalIgnoreCase)
|
|
||||||
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
|
|
||||||
->
|
|
||||||
true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isResponseIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "Response" ]
|
|
||||||
| [ "RestEase" ; "Response" ] -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isMapIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "Map" ] -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isReadOnlyDictionaryIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "IReadOnlyDictionary" ]
|
|
||||||
| [ "Generic" ; "IReadOnlyDictionary" ]
|
|
||||||
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
|
|
||||||
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isDictionaryIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "Dictionary" ]
|
|
||||||
| [ "Generic" ; "Dictionary" ]
|
|
||||||
| [ "Collections" ; "Generic" ; "Dictionary" ]
|
|
||||||
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let isIDictionaryIdent (ident : SynLongIdent) : bool =
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "IDictionary" ]
|
|
||||||
| [ "Generic" ; "IDictionary" ]
|
|
||||||
| [ "Collections" ; "Generic" ; "IDictionary" ]
|
|
||||||
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
|
|
||||||
| _ -> false
|
|
||||||
|
|
||||||
let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
|
let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
|
||||||
moduleDecls
|
moduleDecls
|
||||||
@@ -254,7 +160,7 @@ module internal AstHelper =
|
|||||||
Attributes = []
|
Attributes = []
|
||||||
IsOptional = false
|
IsOptional = false
|
||||||
Id = None
|
Id = None
|
||||||
Type = SynType.Var (typar, range0)
|
Type = SynType.var typar
|
||||||
},
|
},
|
||||||
false
|
false
|
||||||
| _ -> failwithf "expected SignatureParameter, got: %+A" ty
|
| _ -> failwithf "expected SignatureParameter, got: %+A" ty
|
||||||
@@ -356,7 +262,7 @@ module internal AstHelper =
|
|||||||
Attributes = []
|
Attributes = []
|
||||||
IsOptional = false
|
IsOptional = false
|
||||||
Id = None
|
Id = None
|
||||||
Type = SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident)
|
Type = SynType.createLongIdent ident
|
||||||
}
|
}
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
}
|
}
|
||||||
@@ -368,7 +274,7 @@ module internal AstHelper =
|
|||||||
Attributes = []
|
Attributes = []
|
||||||
IsOptional = false
|
IsOptional = false
|
||||||
Id = None
|
Id = None
|
||||||
Type = SynType.Var (typar, range0)
|
Type = SynType.var typar
|
||||||
}
|
}
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
}
|
}
|
||||||
@@ -522,190 +428,3 @@ module internal AstHelper =
|
|||||||
}
|
}
|
||||||
)
|
)
|
||||||
| _ -> failwithf "Failed to get record elements for type that was: %+A" repr
|
| _ -> failwithf "Failed to get record elements for type that was: %+A" repr
|
||||||
|
|
||||||
[<AutoOpen>]
|
|
||||||
module internal SynTypePatterns =
|
|
||||||
let (|OptionType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isOptionIdent ident ->
|
|
||||||
Some innerType
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|UnitType|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident when AstHelper.isUnitIdent ident -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|ListType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isListIdent ident ->
|
|
||||||
Some innerType
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|ArrayType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isArrayIdent ident ->
|
|
||||||
Some innerType
|
|
||||||
| SynType.Array (1, innerType, _) -> Some innerType
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|RestEaseResponseType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when AstHelper.isResponseIdent ident ->
|
|
||||||
Some innerType
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|DictionaryType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isDictionaryIdent ident ->
|
|
||||||
Some (key, value)
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|IDictionaryType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isIDictionaryIdent ident ->
|
|
||||||
Some (key, value)
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
|
|
||||||
AstHelper.isReadOnlyDictionaryIdent ident
|
|
||||||
->
|
|
||||||
Some (key, value)
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|MapType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isMapIdent ident ->
|
|
||||||
Some (key, value)
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|BigInt|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent |> List.map _.idText with
|
|
||||||
| [ "bigint" ]
|
|
||||||
| [ "BigInteger" ]
|
|
||||||
| [ "Numerics" ; "BigInteger" ]
|
|
||||||
| [ "System" ; "Numerics" ; "BigInteger" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
/// Returns the type, qualified as in e.g. `System.Boolean`.
|
|
||||||
let (|PrimitiveType|_|) (fieldType : SynType) : LongIdent option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] -> AstHelper.qualifyPrimitiveType i.idText
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|String|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] ->
|
|
||||||
[ "string" ]
|
|
||||||
|> List.tryFind (fun s -> s = i.idText)
|
|
||||||
|> Option.map ignore<string>
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|Byte|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|Guid|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "Guid" ]
|
|
||||||
| [ "Guid" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "Net" ; "Http" ; "HttpResponseMessage" ]
|
|
||||||
| [ "Net" ; "Http" ; "HttpResponseMessage" ]
|
|
||||||
| [ "Http" ; "HttpResponseMessage" ]
|
|
||||||
| [ "HttpResponseMessage" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|HttpContent|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
|
|
||||||
| [ "Net" ; "Http" ; "HttpContent" ]
|
|
||||||
| [ "Http" ; "HttpContent" ]
|
|
||||||
| [ "HttpContent" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|Stream|_|) (fieldType : SynType) : unit option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "IO" ; "Stream" ]
|
|
||||||
| [ "IO" ; "Stream" ]
|
|
||||||
| [ "Stream" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|NumberType|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent ident ->
|
|
||||||
match ident.LongIdent with
|
|
||||||
| [ i ] -> [ "string" ; "float" ; "int" ; "bool" ] |> List.tryFind (fun s -> s = i.idText)
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|DateOnly|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
|
||||||
match ident |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "DateOnly" ]
|
|
||||||
| [ "DateOnly" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|DateTime|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
|
||||||
match ident |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "DateTime" ]
|
|
||||||
| [ "DateTime" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|Uri|_|) (fieldType : SynType) =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
|
||||||
match ident |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "System" ; "Uri" ]
|
|
||||||
| [ "Uri" ] -> Some ()
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
|
||||||
let (|Task|_|) (fieldType : SynType) : SynType option =
|
|
||||||
match fieldType with
|
|
||||||
| SynType.App (SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)), _, args, _, _, _, _) ->
|
|
||||||
match ident |> List.map (fun i -> i.idText) with
|
|
||||||
| [ "Task" ]
|
|
||||||
| [ "Tasks" ; "Task" ]
|
|
||||||
| [ "Threading" ; "Tasks" ; "Task" ]
|
|
||||||
| [ "System" ; "Threading" ; "Tasks" ; "Task" ] ->
|
|
||||||
match args with
|
|
||||||
| [ arg ] -> Some arg
|
|
||||||
| _ -> failwithf "Expected Task to be applied to exactly one arg, but got: %+A" args
|
|
||||||
| _ -> None
|
|
||||||
| _ -> None
|
|
||||||
|
@@ -136,11 +136,11 @@ module internal CataGenerator =
|
|||||||
|
|
||||||
let userProvidedTyparsForCase =
|
let userProvidedTyparsForCase =
|
||||||
analysis.Typars
|
analysis.Typars
|
||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, ty)) -> SynType.Var (ty, range0))
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, ty)) -> SynType.var ty)
|
||||||
|
|
||||||
let userProvidedTyparsForCata =
|
let userProvidedTyparsForCata =
|
||||||
userProvidedTypars
|
userProvidedTypars
|
||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, ty)) -> SynType.Var (ty, range0))
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, ty)) -> SynType.var ty)
|
||||||
|
|
||||||
let relevantTyparName =
|
let relevantTyparName =
|
||||||
match relevantTypar with
|
match relevantTypar with
|
||||||
@@ -148,48 +148,30 @@ module internal CataGenerator =
|
|||||||
| _ -> failwith "logic error in generator"
|
| _ -> failwith "logic error in generator"
|
||||||
|
|
||||||
let inputObjectType =
|
let inputObjectType =
|
||||||
let baseType =
|
let baseType = SynType.createLongIdent relevantTypeName
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent relevantTypeName)
|
|
||||||
|
|
||||||
if userProvidedTypars.Length = 0 then
|
if userProvidedTypars.Length = 0 then
|
||||||
baseType
|
baseType
|
||||||
else
|
else
|
||||||
SynType.App (
|
SynType.app' baseType userProvidedTyparsForCase
|
||||||
baseType,
|
|
||||||
Some range0,
|
|
||||||
userProvidedTyparsForCase,
|
|
||||||
List.replicate (userProvidedTypars.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
// The object on which we'll run the cata
|
// The object on which we'll run the cata
|
||||||
let inputObject =
|
let inputObject = SynPat.named "x" |> SynPat.annotateType inputObjectType
|
||||||
SynPat.CreateTyped (SynPat.CreateNamed (Ident.Create "x"), inputObjectType)
|
|
||||||
|
|
||||||
let cataObject =
|
let cataObject =
|
||||||
SynPat.CreateTyped (
|
SynPat.named "cata"
|
||||||
SynPat.CreateNamed (Ident.Create "cata"),
|
|> SynPat.annotateType (
|
||||||
SynType.App (
|
SynType.app' (SynType.createLongIdent [ cataName ]) (userProvidedTyparsForCata @ allArtificialTypars)
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ cataName ]),
|
|
||||||
Some range0,
|
|
||||||
userProvidedTyparsForCata @ allArtificialTypars,
|
|
||||||
List.replicate (userProvidedTypars.Length + allArtificialTypars.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
[
|
[
|
||||||
SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction
|
SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction
|
||||||
|> SynExpr.applyTo (SynExpr.CreateLongIdent (SynLongIdent.CreateString "x"))
|
|> SynExpr.applyTo (SynExpr.createLongIdent [ "x" ])
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
||||||
|
|
||||||
// TODO: add the "all other stacks are empty" sanity checks
|
// TODO: add the "all other stacks are empty" sanity checks
|
||||||
SynExpr.CreateIdent (Ident.Create (relevantTyparName.idText + "Stack") |> Ident.lowerFirstLetter)
|
SynExpr.createIdent' (Ident.create (relevantTyparName.idText + "Stack") |> Ident.lowerFirstLetter)
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "exactlyOne" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "exactlyOne" ])
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
@@ -209,26 +191,25 @@ module internal CataGenerator =
|
|||||||
range0
|
range0
|
||||||
),
|
),
|
||||||
expr =
|
expr =
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateApp (SynExpr.CreateIdentString "loop", SynExpr.CreateIdentString "cata"),
|
(SynExpr.applyFunction (SynExpr.createIdent "loop") (SynExpr.createIdent "cata"))
|
||||||
SynExpr.CreateIdentString "instructions"
|
(SynExpr.createIdent "instructions")
|
||||||
)
|
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.CreateIdentString "ResizeArray"
|
SynExpr.createIdent "ResizeArray"
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> SynExpr.applyTo (SynExpr.CreateConst ())
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString "instructions") []
|
|> SynBinding.basic (SynLongIdent.createS "instructions") []
|
||||||
]
|
]
|
||||||
|> SynExpr.typeAnnotate relevantTypar
|
|> SynExpr.typeAnnotate relevantTypar
|
||||||
|> SynBinding.basic
|
|> SynBinding.basic
|
||||||
(SynLongIdent.CreateString ("run" + List.last(relevantTypeName).idText))
|
(SynLongIdent.createS ("run" + List.last(relevantTypeName).idText))
|
||||||
[ SynPat.CreateParen cataObject ; SynPat.CreateParen inputObject ]
|
[ cataObject ; inputObject ]
|
||||||
|> SynBinding.withReturnAnnotation relevantTypar
|
|> SynBinding.withReturnAnnotation relevantTypar
|
||||||
|> SynBinding.withXmlDoc (PreXmlDoc.Create " Execute the catamorphism.")
|
|> SynBinding.withXmlDoc (PreXmlDoc.create "Execute the catamorphism.")
|
||||||
|
|
||||||
let getName (ty : SynTypeDefn) : LongIdent =
|
let getName (ty : SynTypeDefn) : LongIdent =
|
||||||
match ty with
|
match ty with
|
||||||
@@ -280,7 +261,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.Self ty
|
Description = FieldDescription.Self ty
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -290,7 +271,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.NonRecursive ty
|
Description = FieldDescription.NonRecursive ty
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -308,7 +289,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.NonRecursive stripped
|
Description = FieldDescription.NonRecursive stripped
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -318,7 +299,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.ListSelf ty
|
Description = FieldDescription.ListSelf ty
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -329,7 +310,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.NonRecursive stripped
|
Description = FieldDescription.NonRecursive stripped
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -357,7 +338,7 @@ module internal CataGenerator =
|
|||||||
ArgName =
|
ArgName =
|
||||||
match name with
|
match name with
|
||||||
| Some n -> Ident.lowerFirstLetter n
|
| Some n -> Ident.lowerFirstLetter n
|
||||||
| None -> Ident.Create $"arg%s{prefix}"
|
| None -> Ident.create $"arg%s{prefix}"
|
||||||
Description = FieldDescription.NonRecursive ty
|
Description = FieldDescription.NonRecursive ty
|
||||||
RequiredGenerics = typeArgs
|
RequiredGenerics = typeArgs
|
||||||
}
|
}
|
||||||
@@ -391,7 +372,7 @@ module internal CataGenerator =
|
|||||||
let getInstructionCaseName (thisUnionType : SynTypeDefn) (caseName : SynIdent) : Ident =
|
let getInstructionCaseName (thisUnionType : SynTypeDefn) (caseName : SynIdent) : Ident =
|
||||||
match caseName with
|
match caseName with
|
||||||
| SynIdent.SynIdent (ident, _) ->
|
| SynIdent.SynIdent (ident, _) ->
|
||||||
(List.last (getName thisUnionType)).idText + "_" + ident.idText |> Ident.Create
|
(List.last (getName thisUnionType)).idText + "_" + ident.idText |> Ident.create
|
||||||
|
|
||||||
/// Given the input `| Pair of Expr * Expr * PairOpKind`,
|
/// Given the input `| Pair of Expr * Expr * PairOpKind`,
|
||||||
/// strips out any members which contain recursive calls.
|
/// strips out any members which contain recursive calls.
|
||||||
@@ -449,25 +430,15 @@ module internal CataGenerator =
|
|||||||
{
|
{
|
||||||
Name = None
|
Name = None
|
||||||
Type =
|
Type =
|
||||||
let name =
|
let name = SynType.createLongIdent union.ParentTypeName
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent union.ParentTypeName)
|
|
||||||
|
|
||||||
match union.Typars with
|
match union.Typars with
|
||||||
| [] -> name
|
| [] -> name
|
||||||
| typars ->
|
| typars ->
|
||||||
let typars =
|
let typars = typars |> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar)
|
||||||
typars
|
|
||||||
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
|
SynType.app' name typars
|
||||||
|
|
||||||
SynType.App (
|
|
||||||
name,
|
|
||||||
Some range0,
|
|
||||||
typars,
|
|
||||||
List.replicate (typars.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
GenericsOfParent = union.Typars
|
GenericsOfParent = union.Typars
|
||||||
}
|
}
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
@@ -487,7 +458,7 @@ module internal CataGenerator =
|
|||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
|> List.distinct
|
|> List.distinct
|
||||||
|> List.map (fun i ->
|
|> List.map (fun i ->
|
||||||
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))
|
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.create i, TyparStaticReq.None, false))
|
||||||
)
|
)
|
||||||
|
|
||||||
// One union case for each union type, and then
|
// One union case for each union type, and then
|
||||||
@@ -514,13 +485,9 @@ module internal CataGenerator =
|
|||||||
let cases = casesFromProcess @ casesFromCases
|
let cases = casesFromProcess @ casesFromCases
|
||||||
|
|
||||||
let typars =
|
let typars =
|
||||||
let count = analysis |> List.map (fun x -> List.length x.Typars) |> List.max
|
|
||||||
|
|
||||||
if analysis |> List.forall (fun x -> x.Typars.IsEmpty) then
|
if analysis |> List.forall (fun x -> x.Typars.IsEmpty) then
|
||||||
None
|
[]
|
||||||
else
|
else
|
||||||
|
|
||||||
let typars =
|
|
||||||
analysis
|
analysis
|
||||||
|> List.collect _.Typars
|
|> List.collect _.Typars
|
||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
@@ -529,28 +496,12 @@ module internal CataGenerator =
|
|||||||
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))
|
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))
|
||||||
)
|
)
|
||||||
|
|
||||||
Some (SynTyparDecls.PostfixList (typars, [], range0))
|
SynTypeDefnRepr.union cases
|
||||||
|
|> SynTypeDefn.create (
|
||||||
SynTypeDefn.SynTypeDefn (
|
SynComponentInfo.create (Ident.create "Instruction")
|
||||||
SynComponentInfo.SynComponentInfo (
|
|> SynComponentInfo.withGenerics typars
|
||||||
[ SynAttributeList.Create [ SynAttribute.RequireQualifiedAccess () ] ],
|
|> SynComponentInfo.withAccessibility (SynAccess.Private range0)
|
||||||
typars,
|
|> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ]
|
||||||
[],
|
|
||||||
[ Ident.Create "Instruction" ],
|
|
||||||
PreXmlDoc.Empty,
|
|
||||||
false,
|
|
||||||
Some (SynAccess.Private range0),
|
|
||||||
range0
|
|
||||||
),
|
|
||||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0),
|
|
||||||
[],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
EqualsRange = Some range0
|
|
||||||
WithKeyword = None
|
|
||||||
}
|
|
||||||
)
|
)
|
||||||
|
|
||||||
/// Build the cata interfaces, which a user will instantiate to specify a particular
|
/// Build the cata interfaces, which a user will instantiate to specify a particular
|
||||||
@@ -582,133 +533,54 @@ module internal CataGenerator =
|
|||||||
analyses
|
analyses
|
||||||
|> List.map (fun analysis ->
|
|> List.map (fun analysis ->
|
||||||
let componentInfo =
|
let componentInfo =
|
||||||
SynComponentInfo.SynComponentInfo (
|
SynComponentInfo.create analysis.CataTypeName
|
||||||
[],
|
// TODO: better docstring
|
||||||
Some (SynTyparDecls.PostfixList (analysis.Typars @ orderedGenerics, [], range0)),
|
|> SynComponentInfo.withDocString (
|
||||||
[],
|
PreXmlDoc.create "Description of how to combine cases during a fold"
|
||||||
[ analysis.CataTypeName ],
|
|
||||||
// TODO: better docstring
|
|
||||||
PreXmlDoc.Create " Description of how to combine cases during a fold",
|
|
||||||
false,
|
|
||||||
None,
|
|
||||||
range0
|
|
||||||
)
|
)
|
||||||
|
|> SynComponentInfo.withGenerics (analysis.Typars @ orderedGenerics)
|
||||||
|
|
||||||
let slots =
|
analysis.UnionCases
|
||||||
let ourGenericName = generics.[analysis.GenericName.idText]
|
|> List.map (fun case ->
|
||||||
|
let arity =
|
||||||
let flags =
|
SynValInfo.SynValInfo (
|
||||||
{
|
case.Fields |> List.map (fun field -> [ SynArgInfo.Empty ]),
|
||||||
SynMemberFlags.IsInstance = true
|
SynArgInfo.Empty
|
||||||
SynMemberFlags.IsDispatchSlot = true
|
|
||||||
SynMemberFlags.IsOverrideOrExplicitImpl = false
|
|
||||||
SynMemberFlags.IsFinal = false
|
|
||||||
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
|
|
||||||
SynMemberFlags.MemberKind = SynMemberKind.Member
|
|
||||||
}
|
|
||||||
|
|
||||||
analysis.UnionCases
|
|
||||||
|> List.map (fun case ->
|
|
||||||
let arity =
|
|
||||||
SynValInfo.SynValInfo (
|
|
||||||
case.Fields |> List.map (fun field -> [ SynArgInfo.Empty ]),
|
|
||||||
SynArgInfo.Empty
|
|
||||||
)
|
|
||||||
|
|
||||||
let ty =
|
|
||||||
(SynType.Var (ourGenericName, range0), List.rev case.FlattenedFields)
|
|
||||||
||> List.fold (fun acc field ->
|
|
||||||
let place : SynType =
|
|
||||||
match field.Description with
|
|
||||||
| FieldDescription.Self ty -> SynType.Var (generics.[getNameKeyUnion ty], range0)
|
|
||||||
| FieldDescription.ListSelf ty ->
|
|
||||||
SynType.CreateApp (
|
|
||||||
SynType.CreateLongIdent "list",
|
|
||||||
[ SynType.Var (generics.[getNameKeyUnion ty], range0) ],
|
|
||||||
true
|
|
||||||
)
|
|
||||||
| FieldDescription.NonRecursive ty ->
|
|
||||||
match field.RequiredGenerics with
|
|
||||||
| None -> ty
|
|
||||||
| Some generics ->
|
|
||||||
let generics =
|
|
||||||
generics
|
|
||||||
|> List.map (fun i ->
|
|
||||||
let (SynTyparDecl.SynTyparDecl (_, typar)) = analysis.Typars.[i]
|
|
||||||
SynType.Var (typar, range0)
|
|
||||||
)
|
|
||||||
|
|
||||||
SynType.App (
|
|
||||||
ty,
|
|
||||||
Some range0,
|
|
||||||
generics,
|
|
||||||
List.replicate (generics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
SynType.Fun (
|
|
||||||
SynType.SignatureParameter (
|
|
||||||
[],
|
|
||||||
false,
|
|
||||||
field.FieldName |> Option.map Ident.lowerFirstLetter,
|
|
||||||
place,
|
|
||||||
range0
|
|
||||||
),
|
|
||||||
acc,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
ArrowRange = range0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
let slot =
|
|
||||||
SynValSig.SynValSig (
|
|
||||||
[],
|
|
||||||
case.CataMethodIdent,
|
|
||||||
SynValTyparDecls.SynValTyparDecls (None, true),
|
|
||||||
ty,
|
|
||||||
arity,
|
|
||||||
false,
|
|
||||||
false,
|
|
||||||
PreXmlDoc.Create $" How to operate on the %s{List.last(case.Match.LongIdent).idText} case",
|
|
||||||
None,
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
EqualsRange = None
|
|
||||||
WithKeyword = None
|
|
||||||
InlineKeyword = None
|
|
||||||
LeadingKeyword = SynLeadingKeyword.Abstract range0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
SynMemberDefn.AbstractSlot (
|
|
||||||
slot,
|
|
||||||
flags,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
GetSetKeywords = None
|
|
||||||
}
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(SynType.var generics.[analysis.GenericName.idText], List.rev case.FlattenedFields)
|
||||||
|
||> List.fold (fun acc field ->
|
||||||
|
let place : SynType =
|
||||||
|
match field.Description with
|
||||||
|
| FieldDescription.Self ty -> SynType.var generics.[getNameKeyUnion ty]
|
||||||
|
| FieldDescription.ListSelf ty ->
|
||||||
|
SynType.var generics.[getNameKeyUnion ty] |> SynType.appPostfix "list"
|
||||||
|
| FieldDescription.NonRecursive ty ->
|
||||||
|
match field.RequiredGenerics with
|
||||||
|
| None -> ty
|
||||||
|
| Some generics ->
|
||||||
|
generics
|
||||||
|
|> List.map (fun i ->
|
||||||
|
let (SynTyparDecl.SynTyparDecl (_, typar)) = analysis.Typars.[i]
|
||||||
|
SynType.var typar
|
||||||
|
)
|
||||||
|
|> SynType.app' ty
|
||||||
|
|
||||||
|
let domain =
|
||||||
|
field.FieldName
|
||||||
|
|> Option.map Ident.lowerFirstLetter
|
||||||
|
|> SynType.signatureParamOfType place
|
||||||
|
|
||||||
|
acc |> SynType.funFromDomain domain
|
||||||
)
|
)
|
||||||
|
|> SynMemberDefn.abstractMember
|
||||||
let repr = SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Unspecified, slots, range0)
|
case.CataMethodIdent
|
||||||
|
None
|
||||||
SynTypeDefn.SynTypeDefn (
|
arity
|
||||||
componentInfo,
|
(PreXmlDoc.create $"How to operate on the %s{List.last(case.Match.LongIdent).idText} case")
|
||||||
repr,
|
|
||||||
[],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
EqualsRange = Some range0
|
|
||||||
WithKeyword = None
|
|
||||||
}
|
|
||||||
)
|
)
|
||||||
|
|> SynTypeDefnRepr.interfaceType
|
||||||
|
|> SynTypeDefn.create componentInfo
|
||||||
)
|
)
|
||||||
|
|
||||||
/// Build a record which contains one of every cata type.
|
/// Build a record which contains one of every cata type.
|
||||||
@@ -727,28 +599,20 @@ module internal CataGenerator =
|
|||||||
let nameForDoc = List.last(analysis.ParentTypeName).idText
|
let nameForDoc = List.last(analysis.ParentTypeName).idText
|
||||||
|
|
||||||
let doc =
|
let doc =
|
||||||
PreXmlDoc.Create $" How to perform a fold (catamorphism) over the type %s{nameForDoc}"
|
PreXmlDoc.create $"How to perform a fold (catamorphism) over the type %s{nameForDoc}"
|
||||||
|
|
||||||
let artificialGenerics = generics |> List.map (fun v -> SynType.Var (v, range0))
|
let artificialGenerics = generics |> List.map SynType.var
|
||||||
|
|
||||||
let userInputGenerics =
|
let userInputGenerics =
|
||||||
analysis.Typars
|
analysis.Typars
|
||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
|> List.distinct
|
|> List.distinct
|
||||||
|> List.map (fun i ->
|
|> List.map (fun i -> SynType.var (SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false)))
|
||||||
SynType.Var (SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false), range0)
|
|
||||||
)
|
|
||||||
|
|
||||||
let ty =
|
let ty =
|
||||||
SynType.App (
|
SynType.app'
|
||||||
SynType.LongIdent (SynLongIdent.CreateFromLongIdent [ analysis.CataTypeName ]),
|
(SynType.createLongIdent [ analysis.CataTypeName ])
|
||||||
Some range0,
|
(userInputGenerics @ artificialGenerics)
|
||||||
userInputGenerics @ artificialGenerics,
|
|
||||||
List.replicate (generics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
SynField.SynField (
|
SynField.SynField (
|
||||||
[],
|
[],
|
||||||
@@ -772,36 +636,18 @@ module internal CataGenerator =
|
|||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
|> List.distinct
|
|> List.distinct
|
||||||
|> List.map (fun i ->
|
|> List.map (fun i ->
|
||||||
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))
|
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.create i, TyparStaticReq.None, false))
|
||||||
)
|
)
|
||||||
|
|
||||||
let genericsFromCata =
|
let genericsFromCata =
|
||||||
generics |> List.map (fun ty -> SynTyparDecl.SynTyparDecl ([], ty))
|
generics |> List.map (fun ty -> SynTyparDecl.SynTyparDecl ([], ty))
|
||||||
|
|
||||||
let componentInfo =
|
let componentInfo =
|
||||||
SynComponentInfo.SynComponentInfo (
|
SynComponentInfo.create cataName
|
||||||
[],
|
|> SynComponentInfo.withGenerics (genericsFromUserInput @ genericsFromCata)
|
||||||
Some (SynTyparDecls.PostfixList (genericsFromUserInput @ genericsFromCata, [], range0)),
|
|> SynComponentInfo.withDocString doc
|
||||||
[],
|
|
||||||
[ cataName ],
|
|
||||||
doc,
|
|
||||||
false,
|
|
||||||
None,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
SynTypeDefn.SynTypeDefn (
|
SynTypeDefnRepr.record fields |> SynTypeDefn.create componentInfo
|
||||||
componentInfo,
|
|
||||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0),
|
|
||||||
[],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
WithKeyword = None
|
|
||||||
EqualsRange = Some range0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
let makeUnionAnalyses
|
let makeUnionAnalyses
|
||||||
(cataVarName : Ident)
|
(cataVarName : Ident)
|
||||||
@@ -852,7 +698,7 @@ module internal CataGenerator =
|
|||||||
Accessibility = access
|
Accessibility = access
|
||||||
StackName =
|
StackName =
|
||||||
List.last(getName unionType).idText + "Stack"
|
List.last(getName unionType).idText + "Stack"
|
||||||
|> Ident.Create
|
|> Ident.create
|
||||||
|> Ident.lowerFirstLetter
|
|> Ident.lowerFirstLetter
|
||||||
UnionCases =
|
UnionCases =
|
||||||
cases
|
cases
|
||||||
@@ -867,33 +713,30 @@ module internal CataGenerator =
|
|||||||
InstructionName = instructionName
|
InstructionName = instructionName
|
||||||
Fields = analysis
|
Fields = analysis
|
||||||
CaseName = name
|
CaseName = name
|
||||||
CataMethodName =
|
CataMethodName = SynLongIdent.create (cataVarName :: unionTypeName @ [ unionCaseName ])
|
||||||
SynLongIdent.CreateFromLongIdent (cataVarName :: unionTypeName @ [ unionCaseName ])
|
|
||||||
CataMethodIdent = SynIdent.SynIdent (unionCaseName, None)
|
CataMethodIdent = SynIdent.SynIdent (unionCaseName, None)
|
||||||
AssociatedInstruction =
|
AssociatedInstruction =
|
||||||
SynLongIdent.CreateFromLongIdent [ Ident.Create "Instruction" ; instructionName ]
|
SynLongIdent.create [ Ident.create "Instruction" ; instructionName ]
|
||||||
Match = SynLongIdent.CreateFromLongIdent (unionTypeName @ [ unionCaseName ])
|
Match = SynLongIdent.create (unionTypeName @ [ unionCaseName ])
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
AssociatedProcessInstruction =
|
AssociatedProcessInstruction =
|
||||||
SynLongIdent.Create
|
SynLongIdent.createS'
|
||||||
[
|
[
|
||||||
"Instruction"
|
"Instruction"
|
||||||
// such jank!
|
// such jank!
|
||||||
"Process__" + List.last(unionTypeName).idText
|
"Process__" + List.last(unionTypeName).idText
|
||||||
]
|
]
|
||||||
ParentTypeName = getName unionType
|
ParentTypeName = getName unionType
|
||||||
GenericName = getName unionType |> List.map _.idText |> String.concat "" |> Ident.Create
|
GenericName = getName unionType |> List.map _.idText |> String.concat "" |> Ident.create
|
||||||
CataTypeName = List.last(getName unionType).idText + "CataCase" |> Ident.Create
|
CataTypeName = List.last(getName unionType).idText + "CataCase" |> Ident.create
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
let callCataAndPushResult (resultStackName : Ident) (unionCase : RenderedUnionCase) : SynExpr =
|
let callCataAndPushResult (resultStackName : Ident) (unionCase : RenderedUnionCase) : SynExpr =
|
||||||
(SynExpr.CreateLongIdent unionCase.CataMethodName, unionCase.FlattenedFields)
|
(SynExpr.CreateLongIdent unionCase.CataMethodName, unionCase.FlattenedFields)
|
||||||
||> List.fold (fun body caseDesc -> SynExpr.CreateApp (body, SynExpr.CreateIdent caseDesc.ArgName))
|
||> List.fold (fun body caseDesc -> SynExpr.applyFunction body (SynExpr.createIdent' caseDesc.ArgName))
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' (resultStackName :: [ Ident.Create "Add" ]))
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (resultStackName :: [ Ident.Create "Add" ]))
|
|
||||||
)
|
|
||||||
|
|
||||||
/// Create the state-machine matches which deal with receiving the instruction
|
/// Create the state-machine matches which deal with receiving the instruction
|
||||||
/// to "process one of the user-specified DU cases, pushing recursion instructions onto
|
/// to "process one of the user-specified DU cases, pushing recursion instructions onto
|
||||||
@@ -934,21 +777,20 @@ module internal CataGenerator =
|
|||||||
listSelfArgs
|
listSelfArgs
|
||||||
|> List.map (fun (i, argName, _) ->
|
|> List.map (fun (i, argName, _) ->
|
||||||
i,
|
i,
|
||||||
SynExpr.CreateParen (
|
SynExpr.paren (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "List" ; "length" ]),
|
(SynExpr.createLongIdent [ "List" ; "length" ])
|
||||||
SynExpr.CreateIdent argName
|
(SynExpr.createIdent' argName)
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|> List.append (
|
|> List.append (
|
||||||
nonRecursiveArgs |> List.map (fun (i, arg, _) -> i, SynExpr.CreateIdent arg)
|
nonRecursiveArgs |> List.map (fun (i, arg, _) -> i, SynExpr.createIdent' arg)
|
||||||
)
|
)
|
||||||
|> List.sortBy fst
|
|> List.sortBy fst
|
||||||
|> List.map snd
|
|> List.map snd
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateLongIdent unionCase.AssociatedInstruction)
|
|> SynExpr.applyFunction (SynExpr.CreateLongIdent unionCase.AssociatedInstruction)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
||||||
|
|
||||||
[
|
[
|
||||||
@@ -967,34 +809,30 @@ module internal CataGenerator =
|
|||||||
DebugPointAtInOrTo.Yes range0,
|
DebugPointAtInOrTo.Yes range0,
|
||||||
SeqExprOnly.SeqExprOnly false,
|
SeqExprOnly.SeqExprOnly false,
|
||||||
true,
|
true,
|
||||||
SynPat.CreateNamed (SynIdent.SynIdent (Ident.Create "elt", None)),
|
SynPat.named "elt",
|
||||||
SynExpr.CreateIdent caseDesc.ArgName,
|
SynExpr.createIdent' caseDesc.ArgName,
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "instructions" ; "Add" ]),
|
(SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
||||||
SynExpr.CreateParen (
|
(SynExpr.paren (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction,
|
(SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction)
|
||||||
SynExpr.CreateIdentString "elt"
|
(SynExpr.createIdent "elt")
|
||||||
)
|
)),
|
||||||
)
|
|
||||||
),
|
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
| Self synType ->
|
| Self synType ->
|
||||||
// And push the instruction to process each recursive call
|
// And push the instruction to process each recursive call
|
||||||
// onto the stack.
|
// onto the stack.
|
||||||
yield
|
yield
|
||||||
SynExpr.CreateLongIdent (
|
// TODO: use an AssociatedProcessInstruction instead
|
||||||
// TODO: use an AssociatedProcessInstruction instead
|
SynExpr.createLongIdent
|
||||||
SynLongIdent.Create
|
[
|
||||||
[
|
"Instruction"
|
||||||
"Instruction"
|
// TODO wonky domain
|
||||||
// TODO wonky domain
|
"Process" + "__" + List.last(getNameUnion(synType).Value).idText
|
||||||
"Process" + "__" + List.last(getNameUnion(synType).Value).idText
|
]
|
||||||
]
|
|> SynExpr.applyTo (SynExpr.createIdent' caseDesc.ArgName)
|
||||||
)
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyTo (SynExpr.CreateIdent caseDesc.ArgName)
|
|
||||||
|> SynExpr.CreateParen
|
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ])
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
@@ -1038,14 +876,14 @@ module internal CataGenerator =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
let bodyMatch = SynExpr.CreateMatch (SynExpr.CreateIdentString "x", matchCases)
|
let bodyMatch = SynExpr.createMatch (SynExpr.createIdent "x") matchCases
|
||||||
|
|
||||||
SynMatchClause.SynMatchClause (
|
SynMatchClause.SynMatchClause (
|
||||||
SynPat.LongIdent (
|
SynPat.LongIdent (
|
||||||
analysis.AssociatedProcessInstruction,
|
analysis.AssociatedProcessInstruction,
|
||||||
None,
|
None,
|
||||||
None,
|
None,
|
||||||
SynArgPats.create [ Ident.Create "x" ],
|
SynArgPats.create [ Ident.create "x" ],
|
||||||
None,
|
None,
|
||||||
range0
|
range0
|
||||||
),
|
),
|
||||||
@@ -1119,22 +957,20 @@ module internal CataGenerator =
|
|||||||
// TODO: this is jank
|
// TODO: this is jank
|
||||||
let stackName = inputStacks.[List.last(getNameUnion(synType).Value).idText]
|
let stackName = inputStacks.[List.last(getNameUnion(synType).Value).idText]
|
||||||
|
|
||||||
SynExpr.minusN (SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ]) 1
|
SynExpr.minusN (SynLongIdent.create [ stackName ; Ident.create "Count" ]) 1
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (
|
|> SynExpr.applyFunction (
|
||||||
SynExpr.createLongIdent' [ stackName ; Ident.Create "RemoveAt" ]
|
SynExpr.createLongIdent' [ stackName ; Ident.create "RemoveAt" ]
|
||||||
)
|
)
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.DotIndexedGet (
|
SynExpr.DotIndexedGet (
|
||||||
SynExpr.CreateIdent stackName,
|
SynExpr.createIdent' stackName,
|
||||||
SynExpr.minusN
|
SynExpr.minusN (SynLongIdent.create [ stackName ; Ident.create "Count" ]) 1,
|
||||||
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
|
|
||||||
1,
|
|
||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ field.ArgName ]) []
|
|> SynBinding.basic (SynLongIdent.createI field.ArgName) []
|
||||||
]
|
]
|
||||||
|> Some
|
|> Some
|
||||||
| ListSelf synType ->
|
| ListSelf synType ->
|
||||||
@@ -1147,20 +983,18 @@ module internal CataGenerator =
|
|||||||
SynExpr.For (
|
SynExpr.For (
|
||||||
DebugPointAtFor.Yes range0,
|
DebugPointAtFor.Yes range0,
|
||||||
DebugPointAtInOrTo.Yes range0,
|
DebugPointAtInOrTo.Yes range0,
|
||||||
Ident.Create "i",
|
Ident.create "i",
|
||||||
Some range0,
|
Some range0,
|
||||||
SynExpr.minusN
|
SynExpr.minusN (SynLongIdent.create [ stackName ; Ident.create "Count" ]) 1,
|
||||||
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
|
|
||||||
1,
|
|
||||||
false,
|
false,
|
||||||
SynExpr.minus
|
SynExpr.minus
|
||||||
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
|
(SynLongIdent.create [ stackName ; Ident.create "Count" ])
|
||||||
(SynExpr.CreateIdent field.ArgName),
|
(SynExpr.createIdent' field.ArgName),
|
||||||
SynExpr.YieldOrReturn (
|
SynExpr.YieldOrReturn (
|
||||||
(true, false),
|
(true, false),
|
||||||
SynExpr.DotIndexedGet (
|
SynExpr.DotIndexedGet (
|
||||||
SynExpr.CreateIdent stackName,
|
SynExpr.createIdent' stackName,
|
||||||
SynExpr.CreateIdentString "i",
|
SynExpr.createIdent "i",
|
||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
),
|
),
|
||||||
@@ -1170,44 +1004,36 @@ module internal CataGenerator =
|
|||||||
),
|
),
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateIdentString "seq")
|
|> SynExpr.applyFunction (SynExpr.createIdent "seq")
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ])
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ])
|
||||||
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ field.ArgName ]) []
|
|> SynBinding.basic (SynLongIdent.createI field.ArgName) []
|
||||||
|
|
||||||
let shadowedIdent = Ident.Create (field.ArgName.idText + "_len")
|
let shadowedIdent = Ident.create (field.ArgName.idText + "_len")
|
||||||
|
|
||||||
[
|
[
|
||||||
SynExpr.minus
|
SynExpr.minus
|
||||||
(SynLongIdent.CreateFromLongIdent [ stackName ; Ident.Create "Count" ])
|
(SynLongIdent.create [ stackName ; Ident.create "Count" ])
|
||||||
(SynExpr.CreateIdent shadowedIdent)
|
(SynExpr.createIdent' shadowedIdent)
|
||||||
SynExpr.CreateIdent shadowedIdent
|
SynExpr.createIdent' shadowedIdent
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (
|
|> SynExpr.applyFunction (
|
||||||
SynExpr.createLongIdent' [ stackName ; Ident.Create "RemoveRange" ]
|
SynExpr.createLongIdent' [ stackName ; Ident.create "RemoveRange" ]
|
||||||
)
|
)
|
||||||
|> SynExpr.createLet [ vals ]
|
|> SynExpr.createLet [ vals ]
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynBinding.basic
|
SynBinding.basic
|
||||||
(SynLongIdent.CreateFromLongIdent [ shadowedIdent ])
|
(SynLongIdent.createI shadowedIdent)
|
||||||
[]
|
[]
|
||||||
(SynExpr.CreateIdent field.ArgName)
|
(SynExpr.createIdent' field.ArgName)
|
||||||
]
|
]
|
||||||
|> Some
|
|> Some
|
||||||
)
|
)
|
||||||
|
|
||||||
SynMatchClause.SynMatchClause (
|
(populateArgs @ [ callCataAndPushResult analysis.StackName unionCase ])
|
||||||
pat,
|
|> SynExpr.CreateSequential
|
||||||
None,
|
|> SynMatchClause.create pat
|
||||||
SynExpr.CreateSequential (populateArgs @ [ callCataAndPushResult analysis.StackName unionCase ]),
|
|
||||||
range0,
|
|
||||||
DebugPointAtTarget.Yes,
|
|
||||||
{
|
|
||||||
ArrowRange = Some range0
|
|
||||||
BarRange = Some range0
|
|
||||||
}
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -1217,60 +1043,29 @@ module internal CataGenerator =
|
|||||||
|> List.collect _.Typars
|
|> List.collect _.Typars
|
||||||
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
|> List.distinct
|
|> List.distinct
|
||||||
|> List.map (fun i -> SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))
|
|> List.map (fun i -> SynTypar.SynTypar (Ident.create i, TyparStaticReq.None, false))
|
||||||
|
|
||||||
let instructionsArrType =
|
let instructionsArrType =
|
||||||
if not userSuppliedGenerics.IsEmpty then
|
if not userSuppliedGenerics.IsEmpty then
|
||||||
SynType.App (
|
userSuppliedGenerics |> List.map SynType.var |> SynType.app "Instruction"
|
||||||
SynType.CreateLongIdent "Instruction",
|
|
||||||
Some range0,
|
|
||||||
userSuppliedGenerics |> List.map (fun x -> SynType.Var (x, range0)),
|
|
||||||
List.replicate (userSuppliedGenerics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
else
|
else
|
||||||
SynType.CreateLongIdent "Instruction"
|
SynType.named "Instruction"
|
||||||
|
|
||||||
let cataGenerics =
|
let cataGenerics =
|
||||||
[
|
[
|
||||||
for generic in userSuppliedGenerics do
|
for generic in userSuppliedGenerics do
|
||||||
yield SynType.Var (generic, range0)
|
yield SynType.var generic
|
||||||
for case in analysis do
|
for case in analysis do
|
||||||
yield SynType.Var (SynTypar.SynTypar (case.GenericName, TyparStaticReq.None, false), range0)
|
yield SynType.var (SynTypar.SynTypar (case.GenericName, TyparStaticReq.None, false))
|
||||||
]
|
]
|
||||||
|
|
||||||
let args =
|
let args =
|
||||||
[
|
[
|
||||||
SynPat.CreateParen (
|
SynPat.namedI cataVarName
|
||||||
SynPat.CreateTyped (
|
|> SynPat.annotateType (SynType.app' (SynType.createLongIdent [ cataTypeName ]) cataGenerics)
|
||||||
SynPat.CreateNamed cataVarName,
|
|
||||||
SynType.App (
|
SynPat.named "instructions"
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent [ cataTypeName ]),
|
|> SynPat.annotateType (SynType.app "ResizeArray" [ instructionsArrType ])
|
||||||
Some range0,
|
|
||||||
cataGenerics,
|
|
||||||
List.replicate (cataGenerics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
SynPat.CreateParen (
|
|
||||||
SynPat.CreateTyped (
|
|
||||||
SynPat.CreateNamed (Ident.Create "instructions"),
|
|
||||||
SynType.App (
|
|
||||||
SynType.CreateLongIdent "ResizeArray",
|
|
||||||
Some range0,
|
|
||||||
[ instructionsArrType ],
|
|
||||||
[],
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
]
|
]
|
||||||
|
|
||||||
let baseMatchClauses = analysis |> List.map createBaseMatchClause
|
let baseMatchClauses = analysis |> List.map createBaseMatchClause
|
||||||
@@ -1278,39 +1073,35 @@ module internal CataGenerator =
|
|||||||
let recMatchClauses = createRecursiveMatchClauses analysis
|
let recMatchClauses = createRecursiveMatchClauses analysis
|
||||||
|
|
||||||
let matchStatement =
|
let matchStatement =
|
||||||
SynExpr.CreateMatch (SynExpr.CreateIdentString "currentInstruction", baseMatchClauses @ recMatchClauses)
|
SynExpr.createMatch (SynExpr.createIdent "currentInstruction") (baseMatchClauses @ recMatchClauses)
|
||||||
|
|
||||||
let body =
|
let body =
|
||||||
[
|
[
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "instructions" ; "RemoveAt" ],
|
(SynExpr.createLongIdent [ "instructions" ; "RemoveAt" ])
|
||||||
SynExpr.CreateParen (SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1)
|
(SynExpr.paren (SynExpr.minusN (SynLongIdent.createS' [ "instructions" ; "Count" ]) 1))
|
||||||
)
|
|
||||||
matchStatement
|
matchStatement
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.DotIndexedGet (
|
SynExpr.DotIndexedGet (
|
||||||
SynExpr.CreateIdentString "instructions",
|
SynExpr.createIdent "instructions",
|
||||||
SynExpr.minusN (SynLongIdent.Create [ "instructions" ; "Count" ]) 1,
|
SynExpr.minusN (SynLongIdent.createS' [ "instructions" ; "Count" ]) 1,
|
||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString "currentInstruction") []
|
|> SynBinding.basic (SynLongIdent.createS "currentInstruction") []
|
||||||
]
|
]
|
||||||
|
|
||||||
let body =
|
let body =
|
||||||
SynExpr.CreateSequential
|
SynExpr.CreateSequential
|
||||||
[
|
[
|
||||||
SynExpr.While (
|
SynExpr.createWhile
|
||||||
DebugPointAtWhile.Yes range0,
|
(SynExpr.greaterThan
|
||||||
SynExpr.greaterThan
|
(SynExpr.CreateConst 0)
|
||||||
(SynExpr.CreateConst (SynConst.Int32 0))
|
(SynExpr.createLongIdent [ "instructions" ; "Count" ]))
|
||||||
(SynExpr.createLongIdent [ "instructions" ; "Count" ]),
|
body
|
||||||
body,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
SynExpr.CreateTuple (
|
SynExpr.CreateTuple (
|
||||||
analysis
|
analysis
|
||||||
|> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent')
|
|> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent')
|
||||||
@@ -1324,25 +1115,22 @@ module internal CataGenerator =
|
|||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.TypeApp (
|
SynExpr.TypeApp (
|
||||||
SynExpr.CreateIdent (Ident.Create "ResizeArray"),
|
SynExpr.createIdent "ResizeArray",
|
||||||
range0,
|
range0,
|
||||||
[
|
[
|
||||||
SynType.Var (
|
SynType.var (SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false))
|
||||||
SynTypar.SynTypar (unionCase.GenericName, TyparStaticReq.None, false),
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
],
|
],
|
||||||
[],
|
[],
|
||||||
Some range0,
|
Some range0,
|
||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> SynExpr.applyTo (SynExpr.CreateConst ())
|
||||||
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ unionCase.StackName ]) []
|
|> SynBinding.basic (SynLongIdent.createI unionCase.StackName) []
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
|
|
||||||
SynBinding.basic (SynLongIdent.CreateString "loop") args body
|
SynBinding.basic (SynLongIdent.createS "loop") args body
|
||||||
|> SynBinding.withAccessibility (Some (SynAccess.Private range0))
|
|> SynBinding.withAccessibility (Some (SynAccess.Private range0))
|
||||||
|
|
||||||
let createModule
|
let createModule
|
||||||
@@ -1355,22 +1143,20 @@ module internal CataGenerator =
|
|||||||
=
|
=
|
||||||
let cataName =
|
let cataName =
|
||||||
match cataName |> SynExpr.stripOptionalParen with
|
match cataName |> SynExpr.stripOptionalParen with
|
||||||
| SynExpr.Const (SynConst.String (name, _, _), _) -> Ident.Create name
|
| SynExpr.Const (SynConst.String (name, _, _), _) -> Ident.create name
|
||||||
| _ -> failwith "Cata name in attribute must be literally a string, sorry"
|
| _ -> failwith "Cata name in attribute must be literally a string, sorry"
|
||||||
|
|
||||||
let parentName = List.last (getName taggedType) |> _.idText
|
let parentName = List.last (getName taggedType) |> _.idText
|
||||||
let moduleName : LongIdent = parentName + "Cata" |> Ident.Create |> List.singleton
|
let moduleName = parentName + "Cata" |> Ident.create
|
||||||
|
|
||||||
let attribs = [ SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) ]
|
|
||||||
|
|
||||||
let modInfo =
|
let modInfo =
|
||||||
SynComponentInfo.Create (
|
SynComponentInfo.create (parentName + "Cata" |> Ident.create)
|
||||||
moduleName,
|
|> SynComponentInfo.withDocString (
|
||||||
attributes = attribs,
|
PreXmlDoc.Create $" Methods to perform a catamorphism over the type %s{parentName}"
|
||||||
xmldoc = PreXmlDoc.Create $" Methods to perform a catamorphism over the type %s{parentName}"
|
|
||||||
)
|
)
|
||||||
|
|> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ]
|
||||||
|
|
||||||
let cataVarName = Ident.Create "cata"
|
let cataVarName = Ident.create "cata"
|
||||||
let analysis = makeUnionAnalyses cataVarName allRecordTypes allUnionTypes
|
let analysis = makeUnionAnalyses cataVarName allRecordTypes allUnionTypes
|
||||||
|
|
||||||
let allTypars =
|
let allTypars =
|
||||||
@@ -1378,9 +1164,9 @@ module internal CataGenerator =
|
|||||||
|> List.map (fun unionType ->
|
|> List.map (fun unionType ->
|
||||||
List.last (getName unionType)
|
List.last (getName unionType)
|
||||||
|> fun x -> x.idText + "Ret"
|
|> fun x -> x.idText + "Ret"
|
||||||
|> Ident.Create
|
|> Ident.create
|
||||||
|> fun x -> SynTypar.SynTypar (x, TyparStaticReq.None, false)
|
|> fun x -> SynTypar.SynTypar (x, TyparStaticReq.None, false)
|
||||||
|> fun x -> SynType.Var (x, range0)
|
|> SynType.var
|
||||||
)
|
)
|
||||||
|
|
||||||
let userProvidedGenerics =
|
let userProvidedGenerics =
|
||||||
@@ -1389,7 +1175,7 @@ module internal CataGenerator =
|
|||||||
|> List.map (fun (SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
|> List.map (fun (SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText)
|
||||||
|> List.distinct
|
|> List.distinct
|
||||||
|> List.map (fun x ->
|
|> List.map (fun x ->
|
||||||
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create x, TyparStaticReq.None, false))
|
SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.create x, TyparStaticReq.None, false))
|
||||||
)
|
)
|
||||||
|
|
||||||
let runFunctions =
|
let runFunctions =
|
||||||
@@ -1405,8 +1191,8 @@ module internal CataGenerator =
|
|||||||
let loopFunction = createLoopFunction cataName cataVarName analysis
|
let loopFunction = createLoopFunction cataName cataVarName analysis
|
||||||
|
|
||||||
let recordDoc =
|
let recordDoc =
|
||||||
PreXmlDoc.Create
|
PreXmlDoc.create
|
||||||
$" Specifies how to perform a fold (catamorphism) over the type %s{parentName} and its friends."
|
$"Specifies how to perform a fold (catamorphism) over the type %s{parentName} and its friends."
|
||||||
|
|
||||||
let cataRecord =
|
let cataRecord =
|
||||||
SynModuleDecl.Types ([ createCataRecord cataName recordDoc analysis ], range0)
|
SynModuleDecl.Types ([ createCataRecord cataName recordDoc analysis ], range0)
|
||||||
|
@@ -213,11 +213,7 @@ module internal HttpClientGenerator =
|
|||||||
|
|
||||||
let argType =
|
let argType =
|
||||||
if arg.IsOptional then
|
if arg.IsOptional then
|
||||||
SynType.CreateApp (
|
SynType.appPostfix "option" arg.Type
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateString "option"),
|
|
||||||
[ arg.Type ],
|
|
||||||
isPostfix = true
|
|
||||||
)
|
|
||||||
else
|
else
|
||||||
arg.Type
|
arg.Type
|
||||||
|
|
||||||
@@ -241,7 +237,7 @@ module internal HttpClientGenerator =
|
|||||||
let thisIdent = if variableHeaders.IsEmpty then "_" else "this"
|
let thisIdent = if variableHeaders.IsEmpty then "_" else "this"
|
||||||
|
|
||||||
SynPat.LongIdent (
|
SynPat.LongIdent (
|
||||||
SynLongIdent.CreateFromLongIdent [ Ident.Create thisIdent ; info.Identifier ],
|
SynLongIdent.create [ Ident.create thisIdent ; info.Identifier ],
|
||||||
None,
|
None,
|
||||||
None,
|
None,
|
||||||
argPats,
|
argPats,
|
||||||
@@ -271,7 +267,7 @@ module internal HttpClientGenerator =
|
|||||||
"Replace"
|
"Replace"
|
||||||
(SynExpr.CreateParenedTuple
|
(SynExpr.CreateParenedTuple
|
||||||
[
|
[
|
||||||
SynExpr.CreateConstString ("{" + substituteId + "}")
|
SynExpr.CreateConst ("{" + substituteId + "}")
|
||||||
SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName)
|
SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName)
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||||
@@ -314,30 +310,27 @@ module internal HttpClientGenerator =
|
|||||||
let urlSeparator =
|
let urlSeparator =
|
||||||
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
|
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
|
||||||
let questionMark =
|
let questionMark =
|
||||||
SynExpr.CreateConst (SynConst.Int32 63)
|
SynExpr.CreateConst 63
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateIdentString "char")
|
|> SynExpr.applyFunction (SynExpr.createIdent "char")
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|
|
||||||
let containsQuestion =
|
let containsQuestion =
|
||||||
info.UrlTemplate
|
info.UrlTemplate
|
||||||
|> SynExpr.callMethodArg "IndexOf" questionMark
|
|> SynExpr.callMethodArg "IndexOf" questionMark
|
||||||
|> SynExpr.greaterThanOrEqual (SynExpr.CreateConst (SynConst.Int32 0))
|
|> SynExpr.greaterThanOrEqual (SynExpr.CreateConst 0)
|
||||||
|
|
||||||
SynExpr.ifThenElse
|
SynExpr.ifThenElse containsQuestion (SynExpr.CreateConst "?") (SynExpr.CreateConst "&")
|
||||||
containsQuestion
|
|> SynExpr.paren
|
||||||
(SynExpr.CreateConst (SynConst.CreateString "?"))
|
|
||||||
(SynExpr.CreateConst (SynConst.CreateString "&"))
|
|
||||||
|> SynExpr.CreateParen
|
|
||||||
|
|
||||||
let prefix =
|
let prefix =
|
||||||
SynExpr.CreateIdent firstValueId
|
SynExpr.createIdent' firstValueId
|
||||||
|> SynExpr.toString firstValue.Type
|
|> SynExpr.toString firstValue.Type
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ])
|
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||||
)
|
)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.plus (SynExpr.plus urlSeparator (SynExpr.CreateConstString (firstKey + "=")))
|
|> SynExpr.plus (SynExpr.plus urlSeparator (SynExpr.CreateConst (firstKey + "=")))
|
||||||
|
|
||||||
(prefix, queryParams)
|
(prefix, queryParams)
|
||||||
||> List.fold (fun uri (paramKey, paramValue) ->
|
||> List.fold (fun uri (paramKey, paramValue) ->
|
||||||
@@ -346,16 +339,16 @@ module internal HttpClientGenerator =
|
|||||||
| None -> failwith "Unable to get parameter variable name from anonymous parameter"
|
| None -> failwith "Unable to get parameter variable name from anonymous parameter"
|
||||||
| Some id -> id
|
| Some id -> id
|
||||||
|
|
||||||
SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId)
|
SynExpr.toString paramValue.Type (SynExpr.createIdent' paramValueId)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||||
)
|
)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConstString ("&" + paramKey + "=")))
|
|> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConst ("&" + paramKey + "=")))
|
||||||
)
|
)
|
||||||
|> SynExpr.plus requestUriTrailer
|
|> SynExpr.plus requestUriTrailer
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|
|
||||||
let requestUri =
|
let requestUri =
|
||||||
let uriIdent = SynExpr.createLongIdent [ "System" ; "Uri" ]
|
let uriIdent = SynExpr.createLongIdent [ "System" ; "Uri" ]
|
||||||
@@ -370,20 +363,20 @@ module internal HttpClientGenerator =
|
|||||||
match info.BaseAddress with
|
match info.BaseAddress with
|
||||||
| None ->
|
| None ->
|
||||||
[
|
[
|
||||||
SynExpr.CreateApp (SynExpr.CreateIdentString "nameof", SynExpr.CreateParen baseAddress)
|
SynExpr.applyFunction (SynExpr.createIdent "nameof") (SynExpr.paren baseAddress)
|
||||||
SynExpr.CreateConstString
|
SynExpr.CreateConst
|
||||||
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
|
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ])
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
|
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
|
||||||
| Some expr -> SynExpr.CreateApp (uriIdent, expr)
|
| Some expr -> SynExpr.applyFunction uriIdent expr
|
||||||
)
|
)
|
||||||
SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, SynExpr.CreateIdentString "v")
|
SynMatchClause.Create (SynPat.named "v", None, SynExpr.createIdent "v")
|
||||||
]
|
]
|
||||||
|> SynExpr.createMatch baseAddress
|
|> SynExpr.createMatch baseAddress
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|
|
||||||
SynExpr.App (
|
SynExpr.App (
|
||||||
ExprAtomicFlag.Atomic,
|
ExprAtomicFlag.Atomic,
|
||||||
@@ -436,56 +429,43 @@ module internal HttpClientGenerator =
|
|||||||
let httpReqMessageConstructor =
|
let httpReqMessageConstructor =
|
||||||
[
|
[
|
||||||
SynExpr.equals
|
SynExpr.equals
|
||||||
(SynExpr.CreateIdentString "Method")
|
(SynExpr.createIdent "Method")
|
||||||
(SynExpr.createLongIdent
|
(SynExpr.createLongIdent
|
||||||
[ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ])
|
[ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ])
|
||||||
SynExpr.equals (SynExpr.CreateIdentString "RequestUri") (SynExpr.CreateIdentString "uri")
|
SynExpr.equals (SynExpr.createIdent "RequestUri") (SynExpr.createIdent "uri")
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateTuple
|
||||||
|
|
||||||
let returnExpr =
|
let returnExpr =
|
||||||
match info.TaskReturnType with
|
match info.TaskReturnType with
|
||||||
| HttpResponseMessage -> SynExpr.CreateIdentString "response"
|
| HttpResponseMessage -> SynExpr.createIdent "response"
|
||||||
| String -> SynExpr.CreateIdentString "responseString"
|
| String -> SynExpr.createIdent "responseString"
|
||||||
| Stream -> SynExpr.CreateIdentString "responseStream"
|
| Stream -> SynExpr.createIdent "responseStream"
|
||||||
| RestEaseResponseType contents ->
|
| RestEaseResponseType contents ->
|
||||||
let deserialiser =
|
let deserialiser =
|
||||||
SynExpr.CreateLambda (
|
JsonParseGenerator.parseNode
|
||||||
[ SynPat.CreateConst SynConst.Unit ],
|
None
|
||||||
SynExpr.CreateParen (
|
JsonParseGenerator.JsonParseOption.None
|
||||||
JsonParseGenerator.parseNode
|
contents
|
||||||
None
|
(SynExpr.createIdent "jsonNode")
|
||||||
JsonParseGenerator.JsonParseOption.None
|
|> SynExpr.paren
|
||||||
contents
|
|> SynExpr.createThunk
|
||||||
(SynExpr.CreateIdentString "jsonNode")
|
|
||||||
)
|
|
||||||
)
|
|
||||||
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
|
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
|
||||||
SynExpr.New (
|
SynExpr.createNew
|
||||||
false,
|
(SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ])
|
||||||
SynType.App (
|
(SynExpr.CreateTuple
|
||||||
SynType.CreateLongIdent (SynLongIdent.Create [ "RestEase" ; "Response" ]),
|
|
||||||
Some range0,
|
|
||||||
[ SynType.Anon range0 ],
|
|
||||||
[],
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
),
|
|
||||||
SynExpr.CreateParenedTuple
|
|
||||||
[
|
[
|
||||||
SynExpr.CreateIdentString "responseString"
|
SynExpr.createIdent "responseString"
|
||||||
SynExpr.CreateIdentString "response"
|
SynExpr.createIdent "response"
|
||||||
SynExpr.CreateParen deserialiser
|
deserialiser
|
||||||
],
|
])
|
||||||
range0
|
|
||||||
)
|
|
||||||
| retType ->
|
| retType ->
|
||||||
JsonParseGenerator.parseNode
|
JsonParseGenerator.parseNode
|
||||||
None
|
None
|
||||||
JsonParseGenerator.JsonParseOption.None
|
JsonParseGenerator.JsonParseOption.None
|
||||||
retType
|
retType
|
||||||
(SynExpr.CreateIdentString "jsonNode")
|
(SynExpr.createIdent "jsonNode")
|
||||||
|
|
||||||
let handleBodyParams =
|
let handleBodyParams =
|
||||||
match bodyParam with
|
match bodyParam with
|
||||||
@@ -498,20 +478,15 @@ module internal HttpClientGenerator =
|
|||||||
[
|
[
|
||||||
Let (
|
Let (
|
||||||
"queryParams",
|
"queryParams",
|
||||||
SynExpr.New (
|
SynExpr.createNew
|
||||||
false,
|
(SynType.createLongIdent'
|
||||||
SynType.CreateLongIdent (
|
[ "System" ; "Net" ; "Http" ; (bodyParamType : BodyParamMethods).ToString () ])
|
||||||
SynLongIdent.Create
|
(SynExpr.createIdent' bodyParamName)
|
||||||
[ "System" ; "Net" ; "Http" ; (bodyParamType : BodyParamMethods).ToString () ]
|
|
||||||
),
|
|
||||||
SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName),
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
Do (
|
Do (
|
||||||
SynExpr.LongIdentSet (
|
SynExpr.LongIdentSet (
|
||||||
SynLongIdent.Create [ "httpMessage" ; "Content" ],
|
SynLongIdent.createS' [ "httpMessage" ; "Content" ],
|
||||||
SynExpr.CreateIdentString "queryParams",
|
SynExpr.createIdent "queryParams",
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -520,8 +495,8 @@ module internal HttpClientGenerator =
|
|||||||
[
|
[
|
||||||
Do (
|
Do (
|
||||||
SynExpr.LongIdentSet (
|
SynExpr.LongIdentSet (
|
||||||
SynLongIdent.Create [ "httpMessage" ; "Content" ],
|
SynLongIdent.createS' [ "httpMessage" ; "Content" ],
|
||||||
SynExpr.CreateIdent bodyParamName,
|
SynExpr.createIdent' bodyParamName,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -530,38 +505,27 @@ module internal HttpClientGenerator =
|
|||||||
[
|
[
|
||||||
Let (
|
Let (
|
||||||
"queryParams",
|
"queryParams",
|
||||||
SynExpr.New (
|
SynExpr.createNew
|
||||||
false,
|
(SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ])
|
||||||
SynType.CreateLongIdent (
|
(SynExpr.createIdent' bodyParamName
|
||||||
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
|
|> SynExpr.pipeThroughFunction (JsonSerializeGenerator.serializeNode ty)
|
||||||
),
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateParen (
|
SynExpr.createLambda
|
||||||
SynExpr.CreateIdent bodyParamName
|
"node"
|
||||||
|> SynExpr.pipeThroughFunction (JsonSerializeGenerator.serializeNode ty)
|
(SynExpr.ifThenElse
|
||||||
|> SynExpr.pipeThroughFunction (
|
(SynExpr.applyFunction
|
||||||
SynExpr.createLambda
|
(SynExpr.createIdent "isNull")
|
||||||
"node"
|
(SynExpr.createIdent "node"))
|
||||||
(SynExpr.ifThenElse
|
(SynExpr.applyFunction
|
||||||
(SynExpr.CreateApp (
|
(SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
|
||||||
SynExpr.CreateIdentString "isNull",
|
(SynExpr.CreateConst ()))
|
||||||
SynExpr.CreateIdentString "node"
|
(SynExpr.CreateConst "null"))
|
||||||
))
|
))
|
||||||
(SynExpr.CreateApp (
|
|
||||||
SynExpr.CreateLongIdent (
|
|
||||||
SynLongIdent.Create [ "node" ; "ToJsonString" ]
|
|
||||||
),
|
|
||||||
SynExpr.CreateConst SynConst.Unit
|
|
||||||
))
|
|
||||||
(SynExpr.CreateConst (SynConst.CreateString "null")))
|
|
||||||
)
|
|
||||||
),
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
Do (
|
Do (
|
||||||
SynExpr.LongIdentSet (
|
SynExpr.LongIdentSet (
|
||||||
SynLongIdent.Create [ "httpMessage" ; "Content" ],
|
SynLongIdent.createS' [ "httpMessage" ; "Content" ],
|
||||||
SynExpr.CreateIdent (Ident.Create "queryParams"),
|
SynExpr.createIdent "queryParams",
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -572,10 +536,9 @@ module internal HttpClientGenerator =
|
|||||||
LetBang (
|
LetBang (
|
||||||
"responseString",
|
"responseString",
|
||||||
SynExpr.awaitTask (
|
SynExpr.awaitTask (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStringAsync" ],
|
(SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStringAsync" ])
|
||||||
SynExpr.CreateIdentString "ct"
|
(SynExpr.createIdent "ct")
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -583,10 +546,9 @@ module internal HttpClientGenerator =
|
|||||||
LetBang (
|
LetBang (
|
||||||
"responseStream",
|
"responseStream",
|
||||||
SynExpr.awaitTask (
|
SynExpr.awaitTask (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStreamAsync" ],
|
(SynExpr.createLongIdent [ "response" ; "Content" ; "ReadAsStreamAsync" ])
|
||||||
SynExpr.CreateIdentString "ct"
|
(SynExpr.createIdent "ct")
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -594,47 +556,39 @@ module internal HttpClientGenerator =
|
|||||||
LetBang (
|
LetBang (
|
||||||
"jsonNode",
|
"jsonNode",
|
||||||
SynExpr.awaitTask (
|
SynExpr.awaitTask (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ],
|
(SynExpr.createLongIdent
|
||||||
SynExpr.CreateParenedTuple
|
[ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ])
|
||||||
|
(SynExpr.CreateParenedTuple
|
||||||
[
|
[
|
||||||
SynExpr.CreateIdentString "responseStream"
|
SynExpr.createIdent "responseStream"
|
||||||
SynExpr.equals
|
SynExpr.equals (SynExpr.createIdent "cancellationToken") (SynExpr.createIdent "ct")
|
||||||
(SynExpr.CreateIdentString "cancellationToken")
|
])
|
||||||
(SynExpr.CreateIdentString "ct")
|
|
||||||
]
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
let setVariableHeaders =
|
let setVariableHeaders =
|
||||||
variableHeaders
|
variableHeaders
|
||||||
|> List.map (fun (headerName, callToGetValue) ->
|
|> List.map (fun (headerName, callToGetValue) ->
|
||||||
Do (
|
[
|
||||||
SynExpr.CreateApp (
|
headerName
|
||||||
SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateParenedTuple
|
(SynExpr.createLongIdent'
|
||||||
[
|
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ])
|
||||||
headerName
|
(SynExpr.CreateConst ())
|
||||||
SynExpr.CreateApp (
|
]
|
||||||
SynExpr.createLongIdent'
|
|> SynExpr.CreateParenedTuple
|
||||||
[ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ],
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ])
|
||||||
SynExpr.CreateConst SynConst.Unit
|
|> Do
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
let setConstantHeaders =
|
let setConstantHeaders =
|
||||||
constantHeaders
|
constantHeaders
|
||||||
|> List.map (fun (headerName, headerValue) ->
|
|> List.map (fun (headerName, headerValue) ->
|
||||||
Do (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateApp (
|
(SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ])
|
||||||
SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ],
|
(SynExpr.CreateParenedTuple [ headerName ; headerValue ])
|
||||||
SynExpr.CreateParenedTuple [ headerName ; headerValue ]
|
|> Do
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
[
|
[
|
||||||
@@ -643,14 +597,9 @@ module internal HttpClientGenerator =
|
|||||||
yield
|
yield
|
||||||
Use (
|
Use (
|
||||||
"httpMessage",
|
"httpMessage",
|
||||||
SynExpr.New (
|
SynExpr.createNew
|
||||||
false,
|
(SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "HttpRequestMessage" ])
|
||||||
SynType.CreateLongIdent (
|
httpReqMessageConstructor
|
||||||
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpRequestMessage" ]
|
|
||||||
),
|
|
||||||
httpReqMessageConstructor,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
yield! handleBodyParams
|
yield! handleBodyParams
|
||||||
@@ -662,21 +611,19 @@ module internal HttpClientGenerator =
|
|||||||
LetBang (
|
LetBang (
|
||||||
"response",
|
"response",
|
||||||
SynExpr.awaitTask (
|
SynExpr.awaitTask (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "client" ; "SendAsync" ],
|
(SynExpr.createLongIdent [ "client" ; "SendAsync" ])
|
||||||
SynExpr.CreateParenedTuple
|
(SynExpr.CreateParenedTuple
|
||||||
[ SynExpr.CreateIdentString "httpMessage" ; SynExpr.CreateIdentString "ct" ]
|
[ SynExpr.createIdent "httpMessage" ; SynExpr.createIdent "ct" ])
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
if info.EnsureSuccessHttpCode then
|
if info.EnsureSuccessHttpCode then
|
||||||
yield
|
yield
|
||||||
Let (
|
Let (
|
||||||
"response",
|
"response",
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "response" ; "EnsureSuccessStatusCode" ],
|
(SynExpr.createLongIdent [ "response" ; "EnsureSuccessStatusCode" ])
|
||||||
SynExpr.CreateConst SynConst.Unit
|
(SynExpr.CreateConst ())
|
||||||
)
|
|
||||||
)
|
)
|
||||||
match info.TaskReturnType with
|
match info.TaskReturnType with
|
||||||
| HttpResponseMessage -> ()
|
| HttpResponseMessage -> ()
|
||||||
@@ -691,7 +638,7 @@ module internal HttpClientGenerator =
|
|||||||
yield jsonNode
|
yield jsonNode
|
||||||
]
|
]
|
||||||
|> SynExpr.createCompExpr "async" returnExpr
|
|> SynExpr.createCompExpr "async" returnExpr
|
||||||
|> SynExpr.startAsTask (SynLongIdent.CreateFromLongIdent [ cancellationTokenArg ])
|
|> SynExpr.startAsTask (SynLongIdent.createI cancellationTokenArg)
|
||||||
|
|
||||||
SynBinding.SynBinding (
|
SynBinding.SynBinding (
|
||||||
None,
|
None,
|
||||||
@@ -904,15 +851,11 @@ module internal HttpClientGenerator =
|
|||||||
SynValInfo.SynValInfo ([ [ SynArgInfo.Empty ] ; [] ], SynArgInfo.Empty),
|
SynValInfo.SynValInfo ([ [ SynArgInfo.Empty ] ; [] ], SynArgInfo.Empty),
|
||||||
None
|
None
|
||||||
),
|
),
|
||||||
SynPat.CreateLongIdent (
|
SynPat.CreateLongIdent (SynLongIdent.create [ Ident.create "_" ; pi.Identifier ], []),
|
||||||
SynLongIdent.CreateFromLongIdent [ Ident.Create "_" ; pi.Identifier ],
|
|
||||||
[]
|
|
||||||
),
|
|
||||||
Some (SynBindingReturnInfo.Create pi.Type),
|
Some (SynBindingReturnInfo.Create pi.Type),
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ],
|
(SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ])
|
||||||
SynExpr.CreateConst SynConst.Unit
|
(SynExpr.CreateConst ()),
|
||||||
),
|
|
||||||
range0,
|
range0,
|
||||||
DebugPointAtBinding.Yes range0,
|
DebugPointAtBinding.Yes range0,
|
||||||
{
|
{
|
||||||
@@ -932,12 +875,12 @@ module internal HttpClientGenerator =
|
|||||||
"Extension methods"
|
"Extension methods"
|
||||||
else
|
else
|
||||||
"Module")
|
"Module")
|
||||||
|> sprintf " %s for constructing a REST client."
|
|> sprintf "%s for constructing a REST client."
|
||||||
|> PreXmlDoc.Create
|
|> PreXmlDoc.create
|
||||||
|
|
||||||
let interfaceImpl =
|
let interfaceImpl =
|
||||||
SynExpr.ObjExpr (
|
SynExpr.ObjExpr (
|
||||||
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name),
|
SynType.createLongIdent interfaceType.Name,
|
||||||
None,
|
None,
|
||||||
Some range0,
|
Some range0,
|
||||||
[],
|
[],
|
||||||
@@ -950,28 +893,22 @@ module internal HttpClientGenerator =
|
|||||||
let headerArgs =
|
let headerArgs =
|
||||||
properties
|
properties
|
||||||
|> List.map (fun (_, pi) ->
|
|> List.map (fun (_, pi) ->
|
||||||
SynPat.CreateTyped (
|
SynPat.namedI (Ident.lowerFirstLetter pi.Identifier)
|
||||||
SynPat.CreateNamed (Ident.lowerFirstLetter pi.Identifier),
|
|> SynPat.annotateType (SynType.funFromDomain (SynType.named "unit") pi.Type)
|
||||||
SynType.CreateFun (SynType.CreateLongIdent "unit", pi.Type)
|
|
||||||
)
|
|
||||||
|> SynPat.CreateParen
|
|
||||||
)
|
)
|
||||||
|
|
||||||
let clientCreationArg =
|
let clientCreationArg =
|
||||||
SynPat.CreateTyped (
|
SynPat.named "client"
|
||||||
SynPat.CreateNamed (Ident.Create "client"),
|
|> SynPat.annotateType (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "HttpClient" ])
|
||||||
SynType.CreateLongIdent (SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpClient" ])
|
|
||||||
)
|
|
||||||
|> SynPat.CreateParen
|
|
||||||
|
|
||||||
let xmlDoc =
|
let xmlDoc =
|
||||||
if properties.IsEmpty then
|
if properties.IsEmpty then
|
||||||
" Create a REST client."
|
"Create a REST client."
|
||||||
else
|
else
|
||||||
" Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties."
|
"Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties."
|
||||||
|> PreXmlDoc.Create
|
|> PreXmlDoc.create
|
||||||
|
|
||||||
let functionName = Ident.Create "client"
|
let functionName = Ident.create "client"
|
||||||
|
|
||||||
let valData =
|
let valData =
|
||||||
let memberFlags =
|
let memberFlags =
|
||||||
@@ -994,10 +931,9 @@ module internal HttpClientGenerator =
|
|||||||
None
|
None
|
||||||
)
|
)
|
||||||
|
|
||||||
let pattern = SynLongIdent.CreateString "make"
|
let pattern = SynLongIdent.createS "make"
|
||||||
|
|
||||||
let returnInfo =
|
let returnInfo = SynType.createLongIdent interfaceType.Name
|
||||||
SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
|
|
||||||
|
|
||||||
let nameWithoutLeadingI =
|
let nameWithoutLeadingI =
|
||||||
List.last interfaceType.Name
|
List.last interfaceType.Name
|
||||||
@@ -1011,64 +947,49 @@ module internal HttpClientGenerator =
|
|||||||
let createFunc =
|
let createFunc =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
let binding =
|
let binding =
|
||||||
SynBinding.basic
|
SynBinding.basic (SynLongIdent.createS "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl
|
||||||
(SynLongIdent.CreateString "make")
|
|
||||||
(headerArgs @ [ clientCreationArg ])
|
|
||||||
interfaceImpl
|
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.makeStaticMember
|
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|
|> SynMemberDefn.staticMember
|
||||||
|
|
||||||
let mem = SynMemberDefn.Member (binding, range0)
|
let componentInfo =
|
||||||
|
SynComponentInfo.create (Ident.create nameWithoutLeadingI)
|
||||||
|
|> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for HTTP clients")
|
||||||
|
|
||||||
let containingType =
|
let containingType =
|
||||||
SynTypeDefn.SynTypeDefn (
|
SynTypeDefnRepr.augmentation ()
|
||||||
SynComponentInfo.Create (
|
|> SynTypeDefn.create componentInfo
|
||||||
[ Ident.Create nameWithoutLeadingI ],
|
|> SynTypeDefn.withMemberDefns [ binding ]
|
||||||
xmldoc = PreXmlDoc.Create " Extension methods for HTTP clients"
|
|
||||||
),
|
|
||||||
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
|
|
||||||
[ mem ],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
EqualsRange = None
|
|
||||||
WithKeyword = None
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
SynModuleDecl.Types ([ containingType ], range0)
|
SynModuleDecl.Types ([ containingType ], range0)
|
||||||
|
|
||||||
else
|
else
|
||||||
SynBinding.basic (SynLongIdent.CreateString "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl
|
SynBinding.basic (SynLongIdent.createS "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
|> SynModuleDecl.CreateLet
|
|> SynModuleDecl.CreateLet
|
||||||
|
|
||||||
let moduleName : LongIdent =
|
let moduleName =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
[ Ident.Create (nameWithoutLeadingI + "HttpClientExtension") ]
|
Ident.create (nameWithoutLeadingI + "HttpClientExtension")
|
||||||
else
|
else
|
||||||
[ Ident.Create nameWithoutLeadingI ]
|
Ident.create nameWithoutLeadingI
|
||||||
|
|
||||||
let attribs =
|
let attribs =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
[ SynAttributeList.Create SynAttribute.autoOpen ]
|
[ SynAttribute.autoOpen ]
|
||||||
else
|
else
|
||||||
[
|
[
|
||||||
SynAttributeList.Create SynAttribute.compilationRepresentation
|
SynAttribute.compilationRepresentation
|
||||||
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
|
SynAttribute.RequireQualifiedAccess ()
|
||||||
]
|
]
|
||||||
|
|
||||||
let modInfo =
|
let modInfo =
|
||||||
SynComponentInfo.Create (
|
SynComponentInfo.create moduleName
|
||||||
moduleName,
|
|> SynComponentInfo.withDocString docString
|
||||||
attributes = attribs,
|
|> SynComponentInfo.addAttributes attribs
|
||||||
xmldoc = docString,
|
|> SynComponentInfo.setAccessibility interfaceType.Accessibility
|
||||||
access = interfaceType.Accessibility
|
|
||||||
)
|
|
||||||
|
|
||||||
SynModuleOrNamespace.CreateNamespace (
|
SynModuleOrNamespace.CreateNamespace (
|
||||||
ns,
|
ns,
|
||||||
|
@@ -48,9 +48,9 @@ module internal InterfaceMockGenerator =
|
|||||||
|
|
||||||
let failwithFun =
|
let failwithFun =
|
||||||
SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
|
SynExpr.createLongIdent [ "System" ; "NotImplementedException" ]
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConstString "Unimplemented mock function")
|
|> SynExpr.applyTo (SynExpr.CreateConst "Unimplemented mock function")
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.CreateParen
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
|
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
|
||||||
|> SynExpr.createLambda "_"
|
|> SynExpr.createLambda "_"
|
||||||
|
|
||||||
let constructorReturnType =
|
let constructorReturnType =
|
||||||
@@ -60,38 +60,28 @@ module internal InterfaceMockGenerator =
|
|||||||
|
|
||||||
let generics =
|
let generics =
|
||||||
generics.TyparDecls
|
generics.TyparDecls
|
||||||
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
|
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar)
|
||||||
|
|
||||||
SynType.App (
|
SynType.app name generics
|
||||||
SynType.CreateLongIdent name,
|
|
||||||
Some range0,
|
|
||||||
generics,
|
|
||||||
List.replicate (generics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
let constructorFields =
|
let constructorFields =
|
||||||
let extras =
|
let extras =
|
||||||
if inherits.Contains KnownInheritance.IDisposable then
|
if inherits.Contains KnownInheritance.IDisposable then
|
||||||
let unitFun = SynExpr.createLambda "_" SynExpr.CreateUnit
|
let unitFun = SynExpr.createLambda "_" SynExpr.CreateUnit
|
||||||
|
|
||||||
[
|
[ (SynLongIdent.createS "Dispose", true), Some unitFun ]
|
||||||
(SynLongIdent.CreateFromLongIdent [ Ident.Create "Dispose" ], true), Some unitFun
|
|
||||||
]
|
|
||||||
else
|
else
|
||||||
[]
|
[]
|
||||||
|
|
||||||
let nonExtras =
|
let nonExtras =
|
||||||
fields
|
fields
|
||||||
|> List.map (fun field -> (SynLongIdent.CreateFromLongIdent [ getName field ], true), Some failwithFun)
|
|> List.map (fun field -> (SynLongIdent.createI (getName field), true), Some failwithFun)
|
||||||
|
|
||||||
extras @ nonExtras
|
extras @ nonExtras
|
||||||
|
|
||||||
let constructor =
|
let constructor =
|
||||||
SynBinding.basic
|
SynBinding.basic
|
||||||
(SynLongIdent.CreateString "Empty")
|
(SynLongIdent.createS "Empty")
|
||||||
(if interfaceType.Generics.IsNone then
|
(if interfaceType.Generics.IsNone then
|
||||||
[]
|
[]
|
||||||
else
|
else
|
||||||
@@ -184,7 +174,7 @@ module internal InterfaceMockGenerator =
|
|||||||
|
|
||||||
let headPat =
|
let headPat =
|
||||||
SynPat.LongIdent (
|
SynPat.LongIdent (
|
||||||
SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ],
|
SynLongIdent.create [ Ident.Create "this" ; memberInfo.Identifier ],
|
||||||
None,
|
None,
|
||||||
None,
|
None,
|
||||||
SynArgPats.Pats headArgs,
|
SynArgPats.Pats headArgs,
|
||||||
@@ -199,8 +189,8 @@ module internal InterfaceMockGenerator =
|
|||||||
args.Args
|
args.Args
|
||||||
|> List.mapi (fun j arg ->
|
|> List.mapi (fun j arg ->
|
||||||
match arg.Type with
|
match arg.Type with
|
||||||
| UnitType -> SynExpr.CreateConst SynConst.Unit
|
| UnitType -> SynExpr.CreateConst ()
|
||||||
| _ -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}"
|
| _ -> SynExpr.createIdent $"arg_%i{i}_%i{j}"
|
||||||
)
|
)
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
)
|
)
|
||||||
@@ -240,8 +230,7 @@ module internal InterfaceMockGenerator =
|
|||||||
)
|
)
|
||||||
|
|
||||||
let interfaceName =
|
let interfaceName =
|
||||||
let baseName =
|
let baseName = SynType.createLongIdent interfaceType.Name
|
||||||
SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)
|
|
||||||
|
|
||||||
match interfaceType.Generics with
|
match interfaceType.Generics with
|
||||||
| None -> baseName
|
| None -> baseName
|
||||||
@@ -251,17 +240,9 @@ module internal InterfaceMockGenerator =
|
|||||||
| SynTyparDecls.PostfixList (decls, _, _) -> decls
|
| SynTyparDecls.PostfixList (decls, _, _) -> decls
|
||||||
| SynTyparDecls.PrefixList (decls, _) -> decls
|
| SynTyparDecls.PrefixList (decls, _) -> decls
|
||||||
| SynTyparDecls.SinglePrefix (decl, _) -> [ decl ]
|
| SynTyparDecls.SinglePrefix (decl, _) -> [ decl ]
|
||||||
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.Var (typar, range0))
|
|> List.map (fun (SynTyparDecl (_, typar)) -> SynType.var typar)
|
||||||
|
|
||||||
SynType.App (
|
SynType.app' baseName generics
|
||||||
baseName,
|
|
||||||
Some range0,
|
|
||||||
generics,
|
|
||||||
List.replicate (generics.Length - 1) range0,
|
|
||||||
Some range0,
|
|
||||||
false,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
SynMemberDefn.Interface (interfaceName, Some range0, Some members, range0)
|
SynMemberDefn.Interface (interfaceName, Some range0, Some members, range0)
|
||||||
|
|
||||||
@@ -281,7 +262,7 @@ module internal InterfaceMockGenerator =
|
|||||||
| KnownInheritance.IDisposable ->
|
| KnownInheritance.IDisposable ->
|
||||||
let binding =
|
let binding =
|
||||||
SynBinding.basic
|
SynBinding.basic
|
||||||
(SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; Ident.Create "Dispose" ])
|
(SynLongIdent.createS' [ "this" ; "Dispose" ])
|
||||||
[ SynPat.CreateConst SynConst.Unit ]
|
[ SynPat.CreateConst SynConst.Unit ]
|
||||||
(SynExpr.CreateApp (SynExpr.createLongIdent [ "this" ; "Dispose" ], SynExpr.CreateUnit))
|
(SynExpr.CreateApp (SynExpr.createLongIdent [ "this" ; "Dispose" ], SynExpr.CreateUnit))
|
||||||
|> SynBinding.withReturnAnnotation (SynType.Unit ())
|
|> SynBinding.withReturnAnnotation (SynType.Unit ())
|
||||||
@@ -290,7 +271,7 @@ module internal InterfaceMockGenerator =
|
|||||||
let mem = SynMemberDefn.Member (binding, range0)
|
let mem = SynMemberDefn.Member (binding, range0)
|
||||||
|
|
||||||
SynMemberDefn.Interface (
|
SynMemberDefn.Interface (
|
||||||
SynType.CreateLongIdent (SynLongIdent.Create [ "System" ; "IDisposable" ]),
|
SynType.CreateLongIdent (SynLongIdent.createS' [ "System" ; "IDisposable" ]),
|
||||||
Some range0,
|
Some range0,
|
||||||
Some [ mem ],
|
Some [ mem ],
|
||||||
range0
|
range0
|
||||||
@@ -314,7 +295,7 @@ module internal InterfaceMockGenerator =
|
|||||||
|
|
||||||
let private buildType (x : ParameterInfo) : SynType =
|
let private buildType (x : ParameterInfo) : SynType =
|
||||||
if x.IsOptional then
|
if x.IsOptional then
|
||||||
SynType.App (SynType.CreateLongIdent "option", Some range0, [ x.Type ], [], Some range0, false, range0)
|
SynType.app "option" [ x.Type ]
|
||||||
else
|
else
|
||||||
x.Type
|
x.Type
|
||||||
|
|
||||||
|
@@ -30,30 +30,23 @@ module internal JsonParseGenerator =
|
|||||||
/// (match {indexed} with | null -> raise (System.Collections.Generic.KeyNotFoundException ()) | v -> v)
|
/// (match {indexed} with | null -> raise (System.Collections.Generic.KeyNotFoundException ()) | v -> v)
|
||||||
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
|
let assertNotNull (propertyName : SynExpr) (indexed : SynExpr) =
|
||||||
let raiseExpr =
|
let raiseExpr =
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateApp (
|
(SynExpr.createIdent "sprintf")
|
||||||
SynExpr.CreateIdentString "sprintf",
|
(SynExpr.CreateConst "Required key '%s' not found on JSON object")
|
||||||
SynExpr.CreateConstString "Required key '%s' not found on JSON object"
|
|> SynExpr.applyTo (SynExpr.paren propertyName)
|
||||||
),
|
|> SynExpr.paren
|
||||||
SynExpr.CreateParen propertyName
|
|
||||||
)
|
|
||||||
|> SynExpr.CreateParen
|
|
||||||
|> SynExpr.applyFunction (
|
|> SynExpr.applyFunction (
|
||||||
SynExpr.CreateLongIdent (
|
SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ]
|
||||||
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyNotFoundException" ]
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (SynExpr.CreateIdentString "raise")
|
|> SynExpr.applyFunction (SynExpr.createIdent "raise")
|
||||||
|
|
||||||
SynExpr.CreateMatch (
|
[
|
||||||
indexed,
|
SynMatchClause.create SynPat.CreateNull raiseExpr
|
||||||
[
|
SynMatchClause.create (SynPat.named "v") (SynExpr.createIdent "v")
|
||||||
SynMatchClause.Create (SynPat.CreateNull, None, raiseExpr)
|
]
|
||||||
SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, SynExpr.CreateIdentString "v")
|
|> SynExpr.createMatch indexed
|
||||||
]
|
|> SynExpr.paren
|
||||||
)
|
|
||||||
|> SynExpr.CreateParen
|
|
||||||
|
|
||||||
/// {node}.AsValue().GetValue<{typeName}> ()
|
/// {node}.AsValue().GetValue<{typeName}> ()
|
||||||
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
|
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
|
||||||
@@ -81,10 +74,8 @@ module internal JsonParseGenerator =
|
|||||||
|
|
||||||
/// {type}.jsonParse {node}
|
/// {type}.jsonParse {node}
|
||||||
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
|
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
|
||||||
SynExpr.CreateApp (
|
node
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (typeName @ [ Ident.Create "jsonParse" ])),
|
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ Ident.create "jsonParse" ]))
|
||||||
node
|
|
||||||
)
|
|
||||||
|
|
||||||
/// collectionType is e.g. "List"; we'll be calling `ofSeq` on it.
|
/// collectionType is e.g. "List"; we'll be calling `ofSeq` on it.
|
||||||
/// body is the body of a lambda which takes a parameter `elt`.
|
/// body is the body of a lambda which takes a parameter `elt`.
|
||||||
@@ -103,51 +94,40 @@ module internal JsonParseGenerator =
|
|||||||
| Some propertyName -> assertNotNull propertyName node
|
| Some propertyName -> assertNotNull propertyName node
|
||||||
|> SynExpr.callMethod "AsArray"
|
|> SynExpr.callMethod "AsArray"
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "map" ]) (SynExpr.createLambda "elt" body)
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
|
||||||
SynExpr.createLambda "elt" body
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ collectionType ; "ofSeq" ]))
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ])
|
||||||
|
|
||||||
/// match {node} with | null -> None | v -> {body} |> Some
|
/// match {node} with | null -> None | v -> {body} |> Some
|
||||||
/// Use the variable `v` to get access to the `Some`.
|
/// Use the variable `v` to get access to the `Some`.
|
||||||
let createParseLineOption (node : SynExpr) (body : SynExpr) : SynExpr =
|
let createParseLineOption (node : SynExpr) (body : SynExpr) : SynExpr =
|
||||||
let body = SynExpr.pipeThroughFunction (SynExpr.CreateIdentString "Some") body
|
let body = SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") body
|
||||||
|
|
||||||
SynExpr.CreateMatch (
|
[
|
||||||
node,
|
SynMatchClause.create SynPat.CreateNull (SynExpr.createIdent "None")
|
||||||
[
|
SynMatchClause.create (SynPat.named "v") body
|
||||||
SynMatchClause.Create (SynPat.CreateNull, None, SynExpr.CreateIdent (Ident.Create "None"))
|
]
|
||||||
SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, body)
|
|> SynExpr.createMatch node
|
||||||
]
|
|
||||||
)
|
|
||||||
|
|
||||||
/// Given e.g. "float", returns "System.Double.Parse"
|
/// Given e.g. "float", returns "System.Double.Parse"
|
||||||
let parseFunction (typeName : string) : LongIdent =
|
let parseFunction (typeName : string) : LongIdent =
|
||||||
let qualified =
|
let qualified =
|
||||||
match AstHelper.qualifyPrimitiveType typeName with
|
match Primitives.qualifyType typeName with
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None -> failwith $"Could not recognise type %s{typeName} as a primitive."
|
| None -> failwith $"Could not recognise type %s{typeName} as a primitive."
|
||||||
|
|
||||||
List.append qualified [ Ident.Create "Parse" ]
|
List.append qualified [ Ident.create "Parse" ]
|
||||||
|
|
||||||
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
|
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
|
||||||
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
|
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
|
||||||
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
|
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
|
||||||
let keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> SynExpr.CreateParen
|
let keyArg = SynExpr.createLongIdent [ "kvp" ; "Key" ] |> SynExpr.paren
|
||||||
|
|
||||||
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.CreateParen
|
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.paren
|
||||||
|
|
||||||
SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ]
|
SynExpr.CreateTuple [ SynExpr.createIdent "key" ; SynExpr.createIdent "value" ]
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet [ SynBinding.Let (pattern = SynPat.named "value", expr = value valueArg) ]
|
||||||
[
|
|> SynExpr.createLet [ SynBinding.Let (pattern = SynPat.named "key", expr = key keyArg) ]
|
||||||
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
|
|
||||||
]
|
|
||||||
|> SynExpr.createLet
|
|
||||||
[
|
|
||||||
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "key"), expr = key keyArg)
|
|
||||||
]
|
|
||||||
|> SynExpr.createLambda "kvp"
|
|> SynExpr.createLambda "kvp"
|
||||||
|
|
||||||
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
|
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
|
||||||
@@ -157,7 +137,7 @@ module internal JsonParseGenerator =
|
|||||||
| String -> key
|
| String -> key
|
||||||
| Uri ->
|
| Uri ->
|
||||||
key
|
key
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]))
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
|
||||||
| _ ->
|
| _ ->
|
||||||
failwithf
|
failwithf
|
||||||
$"Unable to parse the key type %+A{desiredType} of a JSON object. Keys are strings, and this plugin does not know how to convert to that from a string."
|
$"Unable to parse the key type %+A{desiredType} of a JSON object. Keys are strings, and this plugin does not know how to convert to that from a string."
|
||||||
@@ -197,15 +177,8 @@ module internal JsonParseGenerator =
|
|||||||
| None -> basic
|
| None -> basic
|
||||||
| Some option ->
|
| Some option ->
|
||||||
let cond =
|
let cond =
|
||||||
SynExpr.DotGet (
|
SynExpr.DotGet (SynExpr.createIdent "exc", range0, SynLongIdent.createS "Message", range0)
|
||||||
SynExpr.CreateIdentString "exc",
|
|> SynExpr.callMethodArg "Contains" (SynExpr.CreateConst "cannot be converted to")
|
||||||
range0,
|
|
||||||
SynLongIdent.CreateString "Message",
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|> SynExpr.callMethodArg
|
|
||||||
"Contains"
|
|
||||||
(SynExpr.CreateConst (SynConst.CreateString "cannot be converted to"))
|
|
||||||
|
|
||||||
let handler =
|
let handler =
|
||||||
asValueGetValue propertyName "string" node
|
asValueGetValue propertyName "string" node
|
||||||
@@ -213,91 +186,82 @@ module internal JsonParseGenerator =
|
|||||||
|> SynExpr.ifThenElse
|
|> SynExpr.ifThenElse
|
||||||
(SynExpr.equals
|
(SynExpr.equals
|
||||||
option
|
option
|
||||||
(SynExpr.CreateLongIdent (
|
(SynExpr.createLongIdent
|
||||||
SynLongIdent.Create
|
[
|
||||||
[
|
"System"
|
||||||
"System"
|
"Text"
|
||||||
"Text"
|
"Json"
|
||||||
"Json"
|
"Serialization"
|
||||||
"Serialization"
|
"JsonNumberHandling"
|
||||||
"JsonNumberHandling"
|
"AllowReadingFromString"
|
||||||
"AllowReadingFromString"
|
]))
|
||||||
]
|
|
||||||
)))
|
|
||||||
SynExpr.reraise
|
SynExpr.reraise
|
||||||
|> SynExpr.ifThenElse cond SynExpr.reraise
|
|> SynExpr.ifThenElse cond SynExpr.reraise
|
||||||
|
|
||||||
basic
|
basic
|
||||||
|> SynExpr.pipeThroughTryWith
|
|> SynExpr.pipeThroughTryWith
|
||||||
(SynPat.IsInst (
|
(SynPat.IsInst (
|
||||||
SynType.LongIdent (SynLongIdent.Create [ "System" ; "InvalidOperationException" ]),
|
SynType.LongIdent (SynLongIdent.createS' [ "System" ; "InvalidOperationException" ]),
|
||||||
range0
|
range0
|
||||||
))
|
))
|
||||||
handler
|
handler
|
||||||
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
|
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
|
||||||
| OptionType ty ->
|
| OptionType ty ->
|
||||||
parseNode None options ty (SynExpr.CreateIdentString "v")
|
parseNode None options ty (SynExpr.createIdent "v")
|
||||||
|> createParseLineOption node
|
|> createParseLineOption node
|
||||||
| ListType ty ->
|
| ListType ty ->
|
||||||
parseNode None options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|
parseNode None options ty (SynExpr.createIdent "elt")
|
||||||
|> asArrayMapped propertyName "List" node
|
|> asArrayMapped propertyName "List" node
|
||||||
| ArrayType ty ->
|
| ArrayType ty ->
|
||||||
parseNode None options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|
parseNode None options ty (SynExpr.createIdent "elt")
|
||||||
|> asArrayMapped propertyName "Array" node
|
|> asArrayMapped propertyName "Array" node
|
||||||
| IDictionaryType (keyType, valueType) ->
|
| IDictionaryType (keyType, valueType) ->
|
||||||
node
|
node
|
||||||
|> asObject propertyName
|
|> asObject propertyName
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
(SynExpr.createLongIdent [ "Seq" ; "map" ])
|
||||||
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
|
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "dict" ]))
|
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "dict")
|
||||||
| DictionaryType (keyType, valueType) ->
|
| DictionaryType (keyType, valueType) ->
|
||||||
node
|
node
|
||||||
|> asObject propertyName
|
|> asObject propertyName
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
(SynExpr.createLongIdent [ "Seq" ; "map" ])
|
||||||
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
|
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
(SynExpr.createLongIdent [ "Seq" ; "map" ])
|
||||||
SynExpr.CreateLongIdent (
|
(SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ])
|
||||||
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ]
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
|
SynExpr.createLongIdent [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]
|
||||||
)
|
)
|
||||||
| IReadOnlyDictionaryType (keyType, valueType) ->
|
| IReadOnlyDictionaryType (keyType, valueType) ->
|
||||||
node
|
node
|
||||||
|> asObject propertyName
|
|> asObject propertyName
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
(SynExpr.createLongIdent [ "Seq" ; "map" ])
|
||||||
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
|
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "readOnlyDict" ]))
|
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "readOnlyDict")
|
||||||
| MapType (keyType, valueType) ->
|
| MapType (keyType, valueType) ->
|
||||||
node
|
node
|
||||||
|> asObject propertyName
|
|> asObject propertyName
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
|
(SynExpr.createLongIdent [ "Seq" ; "map" ])
|
||||||
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
|
(dictionaryMapper (parseKeyString keyType) (parseNode None options valueType))
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Map" ; "ofSeq" ])
|
||||||
| BigInt ->
|
| BigInt ->
|
||||||
node
|
node
|
||||||
|> SynExpr.callMethod "ToJsonString"
|
|> SynExpr.callMethod "ToJsonString"
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ])
|
||||||
| _ ->
|
| _ ->
|
||||||
// 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!
|
||||||
@@ -314,9 +278,8 @@ module internal JsonParseGenerator =
|
|||||||
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
|
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
|
||||||
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding).
|
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding).
|
||||||
let createParseRhs (options : JsonParseOption) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
|
let createParseRhs (options : JsonParseOption) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
|
||||||
SynExpr.CreateIdentString "node"
|
let objectToParse = SynExpr.createIdent "node" |> SynExpr.index propertyName
|
||||||
|> SynExpr.index propertyName
|
parseNode (Some propertyName) options fieldType objectToParse
|
||||||
|> parseNode (Some propertyName) options fieldType
|
|
||||||
|
|
||||||
let isJsonNumberHandling (literal : LongIdent) : bool =
|
let isJsonNumberHandling (literal : LongIdent) : bool =
|
||||||
match List.rev literal |> List.map (fun ident -> ident.idText) with
|
match List.rev literal |> List.map (fun ident -> ident.idText) with
|
||||||
@@ -332,51 +295,69 @@ module internal JsonParseGenerator =
|
|||||||
/// That is, we give you access to a `JsonNode` called `node`,
|
/// That is, we give you access to a `JsonNode` called `node`,
|
||||||
/// and you must return a `typeName`.
|
/// and you must return a `typeName`.
|
||||||
let scaffolding (spec : JsonParseOutputSpec) (typeName : LongIdent) (functionBody : SynExpr) : SynModuleDecl =
|
let scaffolding (spec : JsonParseOutputSpec) (typeName : LongIdent) (functionBody : SynExpr) : SynModuleDecl =
|
||||||
let xmlDoc = PreXmlDoc.Create " Parse from a JSON node."
|
let xmlDoc = PreXmlDoc.create "Parse from a JSON node."
|
||||||
|
|
||||||
let returnInfo = SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName)
|
let returnInfo = SynType.createLongIdent typeName
|
||||||
|
|
||||||
let inputArg = Ident.Create "node"
|
let inputArg = "node"
|
||||||
let functionName = Ident.Create "jsonParse"
|
let functionName = Ident.create "jsonParse"
|
||||||
|
|
||||||
let arg =
|
let arg =
|
||||||
SynPat.CreateNamed inputArg
|
SynPat.named inputArg
|
||||||
|> SynPat.annotateType (
|
|> SynPat.annotateType (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|
||||||
SynType.LongIdent (SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|
|
||||||
)
|
|
||||||
|
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
let binding =
|
let binding =
|
||||||
SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
|
SynBinding.basic (SynLongIdent.createI functionName) [ arg ] functionBody
|
||||||
|> SynBinding.makeStaticMember
|
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|
|> SynMemberDefn.staticMember
|
||||||
|
|
||||||
let mem = SynMemberDefn.Member (binding, range0)
|
let componentInfo =
|
||||||
|
SynComponentInfo.createLong typeName
|
||||||
|
|> SynComponentInfo.withDocString (PreXmlDoc.Create " Extension methods for JSON parsing")
|
||||||
|
|
||||||
let containingType =
|
let containingType =
|
||||||
SynTypeDefn.SynTypeDefn (
|
SynTypeDefnRepr.augmentation ()
|
||||||
SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create " Extension methods for JSON parsing"),
|
|> SynTypeDefn.create componentInfo
|
||||||
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
|
|> SynTypeDefn.withMemberDefns [ binding ]
|
||||||
[ mem ],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
EqualsRange = None
|
|
||||||
WithKeyword = None
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
SynModuleDecl.Types ([ containingType ], range0)
|
SynModuleDecl.Types ([ containingType ], range0)
|
||||||
else
|
else
|
||||||
SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ arg ] functionBody
|
SynBinding.basic (SynLongIdent.createI functionName) [ arg ] functionBody
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
|> SynModuleDecl.CreateLet
|
|> SynModuleDecl.CreateLet
|
||||||
|
|
||||||
let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynFieldData<Ident> list) =
|
let getParseOptions (fieldAttrs : SynAttribute list) =
|
||||||
|
(JsonParseOption.None, fieldAttrs)
|
||||||
|
||> List.fold (fun options attr ->
|
||||||
|
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
|
||||||
|
let qualifiedEnumValue =
|
||||||
|
match SynExpr.stripOptionalParen attr.ArgExpr with
|
||||||
|
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when isJsonNumberHandling ident ->
|
||||||
|
// Make sure it's fully qualified
|
||||||
|
SynExpr.createLongIdent
|
||||||
|
[
|
||||||
|
"System"
|
||||||
|
"Text"
|
||||||
|
"Json"
|
||||||
|
"Serialization"
|
||||||
|
"JsonNumberHandling"
|
||||||
|
"AllowReadingFromString"
|
||||||
|
]
|
||||||
|
| _ -> attr.ArgExpr
|
||||||
|
|
||||||
|
{
|
||||||
|
JsonNumberHandlingArg = Some qualifiedEnumValue
|
||||||
|
}
|
||||||
|
else
|
||||||
|
options
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
let createRecordMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynFieldData<Ident> list) =
|
||||||
let assignments =
|
let assignments =
|
||||||
fields
|
fields
|
||||||
|> List.mapi (fun i fieldData ->
|
|> List.mapi (fun i fieldData ->
|
||||||
@@ -386,79 +367,112 @@ module internal JsonParseGenerator =
|
|||||||
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
|
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
|
||||||
)
|
)
|
||||||
|
|
||||||
let options =
|
let options = getParseOptions fieldData.Attrs
|
||||||
(JsonParseOption.None, fieldData.Attrs)
|
|
||||||
||> List.fold (fun options attr ->
|
|
||||||
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
|
|
||||||
let qualifiedEnumValue =
|
|
||||||
match SynExpr.stripOptionalParen attr.ArgExpr with
|
|
||||||
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
|
|
||||||
isJsonNumberHandling ident
|
|
||||||
->
|
|
||||||
// Make sure it's fully qualified
|
|
||||||
SynExpr.createLongIdent
|
|
||||||
[
|
|
||||||
"System"
|
|
||||||
"Text"
|
|
||||||
"Json"
|
|
||||||
"Serialization"
|
|
||||||
"JsonNumberHandling"
|
|
||||||
"AllowReadingFromString"
|
|
||||||
]
|
|
||||||
| _ -> attr.ArgExpr
|
|
||||||
|
|
||||||
{
|
|
||||||
JsonNumberHandlingArg = Some qualifiedEnumValue
|
|
||||||
}
|
|
||||||
else
|
|
||||||
options
|
|
||||||
)
|
|
||||||
|
|
||||||
let propertyName =
|
let propertyName =
|
||||||
match propertyNameAttr with
|
match propertyNameAttr with
|
||||||
| None ->
|
| None ->
|
||||||
let sb = StringBuilder fieldData.Ident.idText.Length
|
let sb = StringBuilder fieldData.Ident.idText.Length
|
||||||
sb.Append (Char.ToLowerInvariant fieldData.Ident.idText.[0]) |> ignore
|
|
||||||
|
sb.Append (Char.ToLowerInvariant fieldData.Ident.idText.[0])
|
||||||
|
|> ignore<StringBuilder>
|
||||||
|
|
||||||
if fieldData.Ident.idText.Length > 1 then
|
if fieldData.Ident.idText.Length > 1 then
|
||||||
sb.Append fieldData.Ident.idText.[1..] |> ignore
|
sb.Append (fieldData.Ident.idText.Substring 1) |> ignore<StringBuilder>
|
||||||
|
|
||||||
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
|
sb.ToString () |> SynExpr.CreateConst
|
||||||
| Some name -> name.ArgExpr
|
| Some name -> name.ArgExpr
|
||||||
|
|
||||||
createParseRhs options propertyName fieldData.Type
|
createParseRhs options propertyName fieldData.Type
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString $"arg_%i{i}") []
|
|> SynBinding.basic (SynLongIdent.createS $"arg_%i{i}") []
|
||||||
)
|
)
|
||||||
|
|
||||||
let finalConstruction =
|
let finalConstruction =
|
||||||
fields
|
fields
|
||||||
|> List.mapi (fun i fieldData ->
|
|> List.mapi (fun i fieldData ->
|
||||||
(SynLongIdent.CreateFromLongIdent [ fieldData.Ident ], true),
|
(SynLongIdent.createI fieldData.Ident, true), Some (SynExpr.createIdent $"arg_%i{i}")
|
||||||
Some (SynExpr.CreateLongIdent (SynLongIdent.CreateString $"arg_%i{i}"))
|
|
||||||
)
|
)
|
||||||
|> AstHelper.instantiateRecord
|
|> AstHelper.instantiateRecord
|
||||||
|
|
||||||
let assignments =
|
(finalConstruction, assignments)
|
||||||
(finalConstruction, assignments)
|
||> List.fold (fun final assignment -> SynExpr.createLet [ assignment ] final)
|
||||||
||> List.fold (fun final assignment -> SynExpr.createLet [ assignment ] final)
|
|
||||||
|
|
||||||
assignments |> scaffolding spec typeName
|
let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
|
||||||
|
fields
|
||||||
|
|> List.map (fun case ->
|
||||||
|
let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
|
||||||
|
|
||||||
(*
|
let body =
|
||||||
|
if case.Fields.IsEmpty then
|
||||||
|
SynExpr.createLongIdent' (typeName @ [ case.Ident ])
|
||||||
|
else
|
||||||
|
case.Fields
|
||||||
|
|> List.map (fun field ->
|
||||||
|
let propertyName = JsonSerializeGenerator.getPropertyName field.Ident field.Attrs
|
||||||
|
let options = getParseOptions field.Attrs
|
||||||
|
createParseRhs options propertyName field.Type
|
||||||
|
)
|
||||||
|
|> SynExpr.CreateParenedTuple
|
||||||
|
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
|
||||||
|
|> SynExpr.createLet
|
||||||
|
[
|
||||||
|
SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
|
||||||
|
|> assertNotNull (SynExpr.CreateConst "data")
|
||||||
|
|> SynBinding.basic (SynLongIdent.createS "node") []
|
||||||
|
]
|
||||||
|
|
||||||
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : FirstDu =
|
match propertyName with
|
||||||
let ty =
|
| SynExpr.Const (synConst, _) ->
|
||||||
match node.["type"] with
|
SynMatchClause.SynMatchClause (
|
||||||
| null -> raise (System.Collections.Generic.KeyNotFoundException ())
|
SynPat.CreateConst synConst,
|
||||||
| v -> v.GetValue<string> ()
|
None,
|
||||||
match ty with
|
body,
|
||||||
| "emptyCase" -> FirstDu.EmptyCase
|
range0,
|
||||||
| "case1" ->
|
DebugPointAtTarget.Yes,
|
||||||
FirstDu.Case1
|
{
|
||||||
| "case2" -> FirstDu.Case2
|
ArrowRange = Some range0
|
||||||
| _ -> failwithf "Unrecognised case name: %s" ty
|
BarRange = Some range0
|
||||||
*)
|
}
|
||||||
|
)
|
||||||
|
| _ ->
|
||||||
|
SynMatchClause.create (SynPat.named "x") body
|
||||||
|
|> SynMatchClause.withWhere (SynExpr.equals (SynExpr.createIdent "x") propertyName)
|
||||||
|
)
|
||||||
|
|> fun l ->
|
||||||
|
l
|
||||||
|
@ [
|
||||||
|
let fail =
|
||||||
|
SynExpr.plus (SynExpr.CreateConst "Unrecognised 'type' field value: ") (SynExpr.createIdent "v")
|
||||||
|
|> SynExpr.paren
|
||||||
|
|> SynExpr.applyFunction (SynExpr.createIdent "failwith")
|
||||||
|
|
||||||
|
SynMatchClause.SynMatchClause (
|
||||||
|
SynPat.named "v",
|
||||||
|
None,
|
||||||
|
fail,
|
||||||
|
range0,
|
||||||
|
DebugPointAtTarget.Yes,
|
||||||
|
{
|
||||||
|
ArrowRange = Some range0
|
||||||
|
BarRange = Some range0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
]
|
||||||
|
|> SynExpr.createMatch (SynExpr.createIdent "ty")
|
||||||
|
|> SynExpr.createLet
|
||||||
|
[
|
||||||
|
let property = SynExpr.CreateConst "type"
|
||||||
|
|
||||||
|
SynExpr.createIdent "node"
|
||||||
|
|> SynExpr.index property
|
||||||
|
|> assertNotNull property
|
||||||
|
|> SynExpr.pipeThroughFunction (
|
||||||
|
SynExpr.createLambda
|
||||||
|
"v"
|
||||||
|
(SynExpr.callGenericMethod "GetValue" [ Ident.create "string" ] (SynExpr.createIdent "v"))
|
||||||
|
)
|
||||||
|
|> SynBinding.basic (SynLongIdent.createS "ty") []
|
||||||
|
]
|
||||||
|
|
||||||
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
|
let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) =
|
||||||
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
|
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
|
||||||
@@ -469,11 +483,11 @@ module internal JsonParseGenerator =
|
|||||||
|
|
||||||
let attributes =
|
let attributes =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
[ SynAttributeList.Create SynAttribute.autoOpen ]
|
[ SynAttribute.autoOpen ]
|
||||||
else
|
else
|
||||||
[
|
[
|
||||||
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
|
SynAttribute.RequireQualifiedAccess ()
|
||||||
SynAttributeList.Create SynAttribute.compilationRepresentation
|
SynAttribute.compilationRepresentation
|
||||||
]
|
]
|
||||||
|
|
||||||
let xmlDoc =
|
let xmlDoc =
|
||||||
@@ -497,27 +511,39 @@ module internal JsonParseGenerator =
|
|||||||
List.last ident
|
List.last ident
|
||||||
|> fun i -> i.idText
|
|> fun i -> i.idText
|
||||||
|> fun s -> s + "JsonParseExtension"
|
|> fun s -> s + "JsonParseExtension"
|
||||||
|> Ident.Create
|
|> Ident.create
|
||||||
|
|
||||||
List.take (List.length ident - 1) ident @ [ expanded ]
|
List.take (List.length ident - 1) ident @ [ expanded ]
|
||||||
else
|
else
|
||||||
ident
|
ident
|
||||||
|
|
||||||
let info =
|
let info =
|
||||||
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
|
SynComponentInfo.createLong moduleName
|
||||||
|
|> SynComponentInfo.withDocString xmlDoc
|
||||||
|
|> SynComponentInfo.addAttributes attributes
|
||||||
|
|
||||||
let decls =
|
let decl =
|
||||||
match synTypeDefnRepr with
|
match synTypeDefnRepr with
|
||||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, fields, _range), _) ->
|
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, fields, _range), _) ->
|
||||||
let fields = fields |> List.map SynField.extractWithIdent
|
let fields = fields |> List.map SynField.extractWithIdent
|
||||||
[ createMaker spec ident fields ]
|
createRecordMaker spec ident fields
|
||||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, cases, _range), _) ->
|
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, cases, _range), _) ->
|
||||||
let cases = cases |> List.map SynUnionCase.extract
|
let optionGet (i : Ident option) =
|
||||||
// [ createMaker spec ident cases ]
|
match i with
|
||||||
failwith "Unions are not yet supported"
|
| None -> failwith "WoofWare.Myriad requires union cases to have identifiers on each field."
|
||||||
|
| Some i -> i
|
||||||
|
|
||||||
|
let cases =
|
||||||
|
cases
|
||||||
|
|> List.map SynUnionCase.extract
|
||||||
|
|> List.map (UnionCase.mapIdentFields optionGet)
|
||||||
|
|
||||||
|
createUnionMaker spec ident cases
|
||||||
| _ -> failwithf "Not a record or union type"
|
| _ -> failwithf "Not a record or union type"
|
||||||
|
|
||||||
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
|
let mdl =
|
||||||
|
[ scaffolding spec ident decl ]
|
||||||
|
|> fun d -> SynModuleDecl.CreateNestedModule (info, d)
|
||||||
|
|
||||||
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
|
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ])
|
||||||
|
|
||||||
|
@@ -42,35 +42,27 @@ module internal JsonSerializeGenerator =
|
|||||||
// fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
|
// fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
|
||||||
[
|
[
|
||||||
SynMatchClause.Create (
|
SynMatchClause.Create (
|
||||||
SynPat.CreateLongIdent (SynLongIdent.CreateString "None", []),
|
SynPat.CreateLongIdent (SynLongIdent.createS "None", []),
|
||||||
None,
|
None,
|
||||||
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
|
// The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
|
||||||
// identically equal to null. We have to work around this later, but we might as well just
|
// identically equal to null. We have to work around this later, but we might as well just
|
||||||
// be efficient here and whip up the null directly.
|
// be efficient here and whip up the null directly.
|
||||||
SynExpr.CreateNull
|
SynExpr.CreateNull
|
||||||
|> SynExpr.upcast' (
|
|> SynExpr.upcast' (
|
||||||
SynType.CreateLongIdent (
|
SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
||||||
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
SynMatchClause.Create (
|
SynMatchClause.Create (
|
||||||
SynPat.CreateLongIdent (
|
SynPat.CreateLongIdent (SynLongIdent.createS "Some", [ SynPat.named "field" ]),
|
||||||
SynLongIdent.CreateString "Some",
|
|
||||||
[ SynPat.CreateNamed (Ident.Create "field") ]
|
|
||||||
),
|
|
||||||
None,
|
None,
|
||||||
SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "field")
|
SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field")
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.paren
|
||||||
|> SynExpr.upcast' (
|
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|
||||||
SynType.CreateLongIdent (
|
|
||||||
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|> SynExpr.createMatch (SynExpr.CreateIdentString "field")
|
|> SynExpr.createMatch (SynExpr.createIdent "field")
|
||||||
|> SynExpr.createLambda "field"
|
|> SynExpr.createLambda "field"
|
||||||
| ArrayType ty
|
| ArrayType ty
|
||||||
| ListType ty ->
|
| ListType ty ->
|
||||||
@@ -84,22 +76,21 @@ module internal JsonSerializeGenerator =
|
|||||||
DebugPointAtInOrTo.Yes range0,
|
DebugPointAtInOrTo.Yes range0,
|
||||||
SeqExprOnly.SeqExprOnly false,
|
SeqExprOnly.SeqExprOnly false,
|
||||||
true,
|
true,
|
||||||
SynPat.CreateNamed (Ident.Create "mem"),
|
SynPat.named "mem",
|
||||||
SynExpr.CreateIdent (Ident.Create "field"),
|
SynExpr.createIdent "field",
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "arr" ; "Add" ]),
|
(SynExpr.CreateLongIdent (SynLongIdent.createS' [ "arr" ; "Add" ]))
|
||||||
SynExpr.CreateParen (SynExpr.CreateApp (serializeNode ty, SynExpr.CreateIdentString "mem"))
|
(SynExpr.CreateParen (SynExpr.CreateApp (serializeNode ty, SynExpr.createIdent "mem"))),
|
||||||
),
|
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
SynExpr.CreateIdentString "arr"
|
SynExpr.createIdent "arr"
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ]
|
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ]
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> SynExpr.applyTo (SynExpr.CreateConst ())
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString "arr") []
|
|> SynBinding.basic (SynLongIdent.createS "arr") []
|
||||||
]
|
]
|
||||||
|> SynExpr.createLambda "field"
|
|> SynExpr.createLambda "field"
|
||||||
| IDictionaryType (_keyType, valueType)
|
| IDictionaryType (_keyType, valueType)
|
||||||
@@ -119,7 +110,7 @@ module internal JsonSerializeGenerator =
|
|||||||
true,
|
true,
|
||||||
SynPat.CreateParen (
|
SynPat.CreateParen (
|
||||||
SynPat.CreateLongIdent (
|
SynPat.CreateLongIdent (
|
||||||
SynLongIdent.CreateString "KeyValue",
|
SynLongIdent.createS "KeyValue",
|
||||||
[
|
[
|
||||||
SynPat.CreateParen (
|
SynPat.CreateParen (
|
||||||
SynPat.Tuple (
|
SynPat.Tuple (
|
||||||
@@ -142,21 +133,21 @@ module internal JsonSerializeGenerator =
|
|||||||
[
|
[
|
||||||
SynExpr.CreateApp (
|
SynExpr.CreateApp (
|
||||||
SynExpr.createLongIdent [ "key" ; "ToString" ],
|
SynExpr.createLongIdent [ "key" ; "ToString" ],
|
||||||
SynExpr.CreateConst SynConst.Unit
|
SynExpr.CreateConst ()
|
||||||
)
|
)
|
||||||
SynExpr.CreateApp (serializeNode valueType, SynExpr.CreateIdentString "value")
|
SynExpr.CreateApp (serializeNode valueType, SynExpr.createIdent "value")
|
||||||
]
|
]
|
||||||
),
|
),
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
SynExpr.CreateIdentString "ret"
|
SynExpr.createIdent "ret"
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> SynExpr.applyTo (SynExpr.CreateConst ())
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString "ret") []
|
|> SynBinding.basic (SynLongIdent.createS "ret") []
|
||||||
]
|
]
|
||||||
|> SynExpr.createLambda "field"
|
|> SynExpr.createLambda "field"
|
||||||
| _ ->
|
| _ ->
|
||||||
@@ -173,7 +164,9 @@ module internal JsonSerializeGenerator =
|
|||||||
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
|
let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
|
||||||
[
|
[
|
||||||
propertyName
|
propertyName
|
||||||
SynExpr.CreateApp (serializeNode fieldType, SynExpr.createLongIdent' [ Ident.Create "input" ; fieldId ])
|
SynExpr.applyFunction
|
||||||
|
(serializeNode fieldType)
|
||||||
|
(SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
||||||
@@ -191,7 +184,7 @@ module internal JsonSerializeGenerator =
|
|||||||
if fieldId.idText.Length > 1 then
|
if fieldId.idText.Length > 1 then
|
||||||
sb.Append fieldId.idText.[1..] |> ignore
|
sb.Append fieldId.idText.[1..] |> ignore
|
||||||
|
|
||||||
sb.ToString () |> SynConst.CreateString |> SynExpr.CreateConst
|
sb.ToString () |> SynExpr.CreateConst
|
||||||
| Some name -> name.ArgExpr
|
| Some name -> name.ArgExpr
|
||||||
|
|
||||||
/// `populateNode` will be inserted before we return the `node` variable.
|
/// `populateNode` will be inserted before we return the `node` variable.
|
||||||
@@ -207,67 +200,60 @@ module internal JsonSerializeGenerator =
|
|||||||
(populateNode : SynExpr)
|
(populateNode : SynExpr)
|
||||||
: SynModuleDecl
|
: SynModuleDecl
|
||||||
=
|
=
|
||||||
let xmlDoc = PreXmlDoc.Create " Serialize to a JSON node"
|
let xmlDoc = PreXmlDoc.create "Serialize to a JSON node"
|
||||||
|
|
||||||
let returnInfo =
|
let returnInfo =
|
||||||
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
SynLongIdent.createS' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
||||||
|> SynType.LongIdent
|
|> SynType.LongIdent
|
||||||
|
|
||||||
let functionName = Ident.Create "toJsonNode"
|
let functionName = Ident.create "toJsonNode"
|
||||||
|
|
||||||
let assignments =
|
let assignments =
|
||||||
[
|
[
|
||||||
populateNode
|
populateNode
|
||||||
SynExpr.Upcast (SynExpr.CreateIdentString "node", SynType.Anon range0, range0)
|
SynExpr.Upcast (SynExpr.createIdent "node", SynType.Anon range0, range0)
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> SynExpr.applyTo (SynExpr.CreateConst ())
|
||||||
|> SynBinding.basic (SynLongIdent.CreateString "node") []
|
|> SynBinding.basic (SynLongIdent.createS "node") []
|
||||||
]
|
]
|
||||||
|
|
||||||
let pattern =
|
let pattern =
|
||||||
SynPat.CreateNamed inputArgName
|
SynPat.CreateNamed inputArgName
|
||||||
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.CreateFromLongIdent typeName))
|
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName))
|
||||||
|
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
let binding =
|
let componentInfo =
|
||||||
|
SynComponentInfo.createLong typeName
|
||||||
|
|> SynComponentInfo.withDocString (PreXmlDoc.Create " Extension methods for JSON parsing")
|
||||||
|
|
||||||
|
let memberDef =
|
||||||
assignments
|
assignments
|
||||||
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ pattern ]
|
|> SynBinding.basic (SynLongIdent.createI functionName) [ pattern ]
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|> SynBinding.makeStaticMember
|
|> SynMemberDefn.staticMember
|
||||||
|
|
||||||
let mem = SynMemberDefn.Member (binding, range0)
|
|
||||||
|
|
||||||
let containingType =
|
let containingType =
|
||||||
SynTypeDefn.SynTypeDefn (
|
SynTypeDefnRepr.augmentation ()
|
||||||
SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create " Extension methods for JSON parsing"),
|
|> SynTypeDefn.create componentInfo
|
||||||
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0),
|
|> SynTypeDefn.withMemberDefns [ memberDef ]
|
||||||
[ mem ],
|
|
||||||
None,
|
|
||||||
range0,
|
|
||||||
{
|
|
||||||
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
|
||||||
EqualsRange = None
|
|
||||||
WithKeyword = None
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
SynModuleDecl.Types ([ containingType ], range0)
|
SynModuleDecl.Types ([ containingType ], range0)
|
||||||
else
|
else
|
||||||
let binding =
|
let binding =
|
||||||
assignments
|
assignments
|
||||||
|> SynBinding.basic (SynLongIdent.CreateFromLongIdent [ functionName ]) [ pattern ]
|
|> SynBinding.basic (SynLongIdent.createI functionName) [ pattern ]
|
||||||
|> SynBinding.withReturnAnnotation returnInfo
|
|> SynBinding.withReturnAnnotation returnInfo
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|
|
||||||
SynModuleDecl.CreateLet [ binding ]
|
SynModuleDecl.CreateLet [ binding ]
|
||||||
|
|
||||||
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
|
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
|
||||||
let inputArg = Ident.Create "input"
|
let inputArg = Ident.create "input"
|
||||||
let fields = fields |> List.map SynField.extractWithIdent
|
let fields = fields |> List.map SynField.extractWithIdent
|
||||||
|
|
||||||
fields
|
fields
|
||||||
@@ -280,20 +266,20 @@ module internal JsonSerializeGenerator =
|
|||||||
|> scaffolding spec typeName inputArg
|
|> scaffolding spec typeName inputArg
|
||||||
|
|
||||||
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
|
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
|
||||||
let inputArg = Ident.Create "input"
|
let inputArg = Ident.create "input"
|
||||||
let fields = cases |> List.map SynUnionCase.extract
|
let fields = cases |> List.map SynUnionCase.extract
|
||||||
|
|
||||||
fields
|
fields
|
||||||
|> List.map (fun unionCase ->
|
|> List.map (fun unionCase ->
|
||||||
let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
|
let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
|
||||||
|
|
||||||
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> Ident.Create $"arg%i{i}")
|
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> Ident.create $"arg%i{i}")
|
||||||
|
|
||||||
let argPats = SynArgPats.create caseNames
|
let argPats = SynArgPats.create caseNames
|
||||||
|
|
||||||
let pattern =
|
let pattern =
|
||||||
SynPat.LongIdent (
|
SynPat.LongIdent (
|
||||||
SynLongIdent.CreateFromLongIdent (typeName @ [ unionCase.Ident ]),
|
SynLongIdent.create (typeName @ [ unionCase.Ident ]),
|
||||||
None,
|
None,
|
||||||
None,
|
None,
|
||||||
argPats,
|
argPats,
|
||||||
@@ -303,25 +289,21 @@ module internal JsonSerializeGenerator =
|
|||||||
|
|
||||||
let typeLine =
|
let typeLine =
|
||||||
[
|
[
|
||||||
SynExpr.CreateConstString "type"
|
SynExpr.CreateConst "type"
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ],
|
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ])
|
||||||
propertyName
|
propertyName
|
||||||
)
|
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
||||||
|
|
||||||
let dataNode =
|
let dataNode =
|
||||||
SynBinding.Let (
|
SynBinding.Let (
|
||||||
pattern = SynPat.CreateNamed (Ident.Create "dataNode"),
|
pattern = SynPat.named "dataNode",
|
||||||
expr =
|
expr =
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (
|
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ])
|
||||||
SynLongIdent.Create [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
(SynExpr.CreateConst ())
|
||||||
),
|
|
||||||
SynExpr.CreateConst SynConst.Unit
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
let dataBindings =
|
let dataBindings =
|
||||||
@@ -331,7 +313,7 @@ module internal JsonSerializeGenerator =
|
|||||||
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
|
let propertyName = getPropertyName (Option.get fieldData.Ident) fieldData.Attrs
|
||||||
|
|
||||||
let node =
|
let node =
|
||||||
SynExpr.CreateApp (serializeNode fieldData.Type, SynExpr.CreateIdent caseName)
|
SynExpr.applyFunction (serializeNode fieldData.Type) (SynExpr.createIdent' caseName)
|
||||||
|
|
||||||
[ propertyName ; node ]
|
[ propertyName ; node ]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
@@ -339,7 +321,7 @@ module internal JsonSerializeGenerator =
|
|||||||
)
|
)
|
||||||
|
|
||||||
let assignToNode =
|
let assignToNode =
|
||||||
[ SynExpr.CreateConstString "data" ; SynExpr.CreateIdentString "dataNode" ]
|
[ SynExpr.CreateConst "data" ; SynExpr.createIdent "dataNode" ]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
|
||||||
|
|
||||||
@@ -355,9 +337,9 @@ module internal JsonSerializeGenerator =
|
|||||||
]
|
]
|
||||||
|> SynExpr.CreateSequential
|
|> SynExpr.CreateSequential
|
||||||
|
|
||||||
SynMatchClause.Create (pattern, None, action)
|
SynMatchClause.create pattern action
|
||||||
)
|
)
|
||||||
|> fun clauses -> SynExpr.CreateMatch (SynExpr.CreateIdent inputArg, clauses)
|
|> SynExpr.createMatch (SynExpr.createIdent' inputArg)
|
||||||
|> scaffolding spec typeName inputArg
|
|> scaffolding spec typeName inputArg
|
||||||
|
|
||||||
let createModule
|
let createModule
|
||||||
@@ -374,11 +356,11 @@ module internal JsonSerializeGenerator =
|
|||||||
|
|
||||||
let attributes =
|
let attributes =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
[ SynAttributeList.Create SynAttribute.autoOpen ]
|
[ SynAttribute.autoOpen ]
|
||||||
else
|
else
|
||||||
[
|
[
|
||||||
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
|
SynAttribute.RequireQualifiedAccess ()
|
||||||
SynAttributeList.Create SynAttribute.compilationRepresentation
|
SynAttribute.compilationRepresentation
|
||||||
]
|
]
|
||||||
|
|
||||||
let xmlDoc =
|
let xmlDoc =
|
||||||
@@ -390,8 +372,8 @@ module internal JsonSerializeGenerator =
|
|||||||
else
|
else
|
||||||
"methods"
|
"methods"
|
||||||
|
|
||||||
$" Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|
$"Module containing JSON serializing %s{description} for the %s{fullyQualified} type"
|
||||||
|> PreXmlDoc.Create
|
|> PreXmlDoc.create
|
||||||
|
|
||||||
let moduleName =
|
let moduleName =
|
||||||
if spec.ExtensionMethods then
|
if spec.ExtensionMethods then
|
||||||
@@ -402,14 +384,16 @@ module internal JsonSerializeGenerator =
|
|||||||
List.last ident
|
List.last ident
|
||||||
|> fun i -> i.idText
|
|> fun i -> i.idText
|
||||||
|> fun s -> s + "JsonSerializeExtension"
|
|> fun s -> s + "JsonSerializeExtension"
|
||||||
|> Ident.Create
|
|> Ident.create
|
||||||
|
|
||||||
List.take (List.length ident - 1) ident @ [ expanded ]
|
List.take (List.length ident - 1) ident @ [ expanded ]
|
||||||
else
|
else
|
||||||
ident
|
ident
|
||||||
|
|
||||||
let info =
|
let info =
|
||||||
SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc)
|
SynComponentInfo.createLong moduleName
|
||||||
|
|> SynComponentInfo.addAttributes attributes
|
||||||
|
|> SynComponentInfo.withDocString xmlDoc
|
||||||
|
|
||||||
let decls =
|
let decls =
|
||||||
match synTypeDefnRepr with
|
match synTypeDefnRepr with
|
||||||
|
30
WoofWare.Myriad.Plugins/Primitives.fs
Normal file
30
WoofWare.Myriad.Plugins/Primitives.fs
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal Primitives =
|
||||||
|
/// Given e.g. "byte", returns "System.Byte".
|
||||||
|
let qualifyType (typeName : string) : LongIdent option =
|
||||||
|
match typeName with
|
||||||
|
| "float32"
|
||||||
|
| "single" -> [ "System" ; "Single" ] |> Some
|
||||||
|
| "float"
|
||||||
|
| "double" -> [ "System" ; "Double" ] |> Some
|
||||||
|
| "byte"
|
||||||
|
| "uint8" -> [ "System" ; "Byte" ] |> Some
|
||||||
|
| "sbyte"
|
||||||
|
| "int8" -> [ "System" ; "SByte" ] |> Some
|
||||||
|
| "int16" -> [ "System" ; "Int16" ] |> Some
|
||||||
|
| "int"
|
||||||
|
| "int32" -> [ "System" ; "Int32" ] |> Some
|
||||||
|
| "int64" -> [ "System" ; "Int64" ] |> Some
|
||||||
|
| "uint16" -> [ "System" ; "UInt16" ] |> Some
|
||||||
|
| "uint"
|
||||||
|
| "uint32" -> [ "System" ; "UInt32" ] |> Some
|
||||||
|
| "uint64" -> [ "System" ; "UInt64" ] |> Some
|
||||||
|
| "char" -> [ "System" ; "Char" ] |> Some
|
||||||
|
| "decimal" -> [ "System" ; "Decimal" ] |> Some
|
||||||
|
| _ -> None
|
||||||
|
|> Option.map (List.map (fun i -> (Ident (i, range0))))
|
@@ -47,7 +47,7 @@ module internal RemoveOptionsGenerator =
|
|||||||
(fields : SynField list)
|
(fields : SynField list)
|
||||||
=
|
=
|
||||||
let fields : SynField list = fields |> List.map removeOption
|
let fields : SynField list = fields |> List.map removeOption
|
||||||
let name = Ident.Create "Short"
|
let name = Ident.create "Short"
|
||||||
|
|
||||||
let record =
|
let record =
|
||||||
{
|
{
|
||||||
@@ -64,20 +64,10 @@ module internal RemoveOptionsGenerator =
|
|||||||
SynModuleDecl.Types ([ typeDecl ], range0)
|
SynModuleDecl.Types ([ typeDecl ], range0)
|
||||||
|
|
||||||
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
|
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
|
||||||
let xmlDoc = PreXmlDoc.Create " Remove the optional members of the input."
|
let xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
|
||||||
|
|
||||||
let returnInfo =
|
let inputArg = Ident.create "input"
|
||||||
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent withOptionsType))
|
let functionName = Ident.create "shorten"
|
||||||
|
|
||||||
let inputArg = Ident.Create "input"
|
|
||||||
let functionName = Ident.Create "shorten"
|
|
||||||
|
|
||||||
let inputVal =
|
|
||||||
SynValData.SynValData (
|
|
||||||
None,
|
|
||||||
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
|
|
||||||
Some inputArg
|
|
||||||
)
|
|
||||||
|
|
||||||
let body =
|
let body =
|
||||||
fields
|
fields
|
||||||
@@ -93,8 +83,8 @@ module internal RemoveOptionsGenerator =
|
|||||||
let body =
|
let body =
|
||||||
match fieldData.Type with
|
match fieldData.Type with
|
||||||
| OptionType _ ->
|
| OptionType _ ->
|
||||||
SynExpr.CreateApp (
|
SynExpr.applyFunction
|
||||||
SynExpr.CreateAppInfix (
|
(SynExpr.CreateAppInfix (
|
||||||
SynExpr.LongIdent (
|
SynExpr.LongIdent (
|
||||||
false,
|
false,
|
||||||
SynLongIdent.SynLongIdent (
|
SynLongIdent.SynLongIdent (
|
||||||
@@ -106,50 +96,29 @@ module internal RemoveOptionsGenerator =
|
|||||||
range0
|
range0
|
||||||
),
|
),
|
||||||
accessor
|
accessor
|
||||||
),
|
))
|
||||||
SynExpr.CreateApp (
|
(SynExpr.applyFunction
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.CreateString "Option.defaultWith"),
|
(SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
|
||||||
SynExpr.CreateLongIdent (
|
(SynExpr.createLongIdent' (
|
||||||
SynLongIdent.CreateFromLongIdent (
|
withoutOptionsType
|
||||||
withoutOptionsType
|
@ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
|
||||||
@ [ Ident.Create (sprintf "Default%s" fieldData.Ident.idText) ]
|
)))
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
| _ -> accessor
|
| _ -> accessor
|
||||||
|
|
||||||
(SynLongIdent.CreateFromLongIdent [ fieldData.Ident ], true), Some body
|
(SynLongIdent.createI fieldData.Ident, true), Some body
|
||||||
)
|
)
|
||||||
|> AstHelper.instantiateRecord
|
|> AstHelper.instantiateRecord
|
||||||
|
|
||||||
let pattern =
|
|
||||||
SynPat.LongIdent (
|
|
||||||
SynLongIdent.CreateFromLongIdent [ functionName ],
|
|
||||||
None,
|
|
||||||
None,
|
|
||||||
SynArgPats.Pats
|
|
||||||
[
|
|
||||||
SynPat.CreateTyped (
|
|
||||||
SynPat.CreateNamed inputArg,
|
|
||||||
SynType.LongIdent (SynLongIdent.CreateFromLongIdent withoutOptionsType)
|
|
||||||
)
|
|
||||||
|> SynPat.CreateParen
|
|
||||||
],
|
|
||||||
None,
|
|
||||||
range0
|
|
||||||
)
|
|
||||||
|
|
||||||
let binding =
|
let binding =
|
||||||
SynBinding.Let (
|
SynBinding.basic
|
||||||
isInline = false,
|
(SynLongIdent.createI functionName)
|
||||||
isMutable = false,
|
[
|
||||||
xmldoc = xmlDoc,
|
SynPat.named inputArg.idText
|
||||||
returnInfo = returnInfo,
|
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
|
||||||
expr = body,
|
]
|
||||||
valData = inputVal,
|
body
|
||||||
pattern = pattern
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
)
|
|> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
|
||||||
|
|
||||||
SynModuleDecl.CreateLet [ binding ]
|
SynModuleDecl.CreateLet [ binding ]
|
||||||
|
|
||||||
@@ -167,24 +136,21 @@ module internal RemoveOptionsGenerator =
|
|||||||
let decls =
|
let decls =
|
||||||
[
|
[
|
||||||
createType (Some doc) accessibility typeParams fields
|
createType (Some doc) accessibility typeParams fields
|
||||||
createMaker [ Ident.Create "Short" ] recordId fieldData
|
createMaker [ Ident.create "Short" ] recordId fieldData
|
||||||
]
|
|
||||||
|
|
||||||
let attributes =
|
|
||||||
[
|
|
||||||
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
|
|
||||||
SynAttributeList.Create SynAttribute.compilationRepresentation
|
|
||||||
]
|
]
|
||||||
|
|
||||||
let xmlDoc =
|
let xmlDoc =
|
||||||
recordId
|
recordId
|
||||||
|> Seq.map (fun i -> i.idText)
|
|> Seq.map (fun i -> i.idText)
|
||||||
|> String.concat "."
|
|> String.concat "."
|
||||||
|> sprintf " Module containing an option-truncated version of the %s type"
|
|> sprintf "Module containing an option-truncated version of the %s type"
|
||||||
|> PreXmlDoc.Create
|
|> PreXmlDoc.create
|
||||||
|
|
||||||
let info =
|
let info =
|
||||||
SynComponentInfo.Create (recordId, attributes = attributes, xmldoc = xmlDoc)
|
SynComponentInfo.createLong recordId
|
||||||
|
|> SynComponentInfo.withDocString xmlDoc
|
||||||
|
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|
||||||
|
|> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ]
|
||||||
|
|
||||||
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
|
let mdl = SynModuleDecl.CreateNestedModule (info, decls)
|
||||||
|
|
||||||
|
49
WoofWare.Myriad.Plugins/SynExpr/CompExpr.fs
Normal file
49
WoofWare.Myriad.Plugins/SynExpr/CompExpr.fs
Normal file
@@ -0,0 +1,49 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
|
||||||
|
type internal CompExprBinding =
|
||||||
|
| LetBang of varName : string * rhs : SynExpr
|
||||||
|
| Let of varName : string * rhs : SynExpr
|
||||||
|
| Use of varName : string * rhs : SynExpr
|
||||||
|
| Do of body : SynExpr
|
||||||
|
|
||||||
|
(*
|
||||||
|
Potential API!
|
||||||
|
type internal CompExprBindings =
|
||||||
|
private
|
||||||
|
{
|
||||||
|
/// These are stored in reverse.
|
||||||
|
Bindings : CompExprBinding list
|
||||||
|
CompExprName : string
|
||||||
|
}
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal CompExprBindings =
|
||||||
|
let make (name : string) : CompExprBindings =
|
||||||
|
{
|
||||||
|
Bindings = []
|
||||||
|
CompExprName = name
|
||||||
|
}
|
||||||
|
|
||||||
|
let thenDo (body : SynExpr) (bindings : CompExprBindings) =
|
||||||
|
{ bindings with
|
||||||
|
Bindings = (Do body :: bindings.Bindings)
|
||||||
|
}
|
||||||
|
|
||||||
|
let thenLet (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
|
||||||
|
{ bindings with
|
||||||
|
Bindings = (Let (varName, value) :: bindings.Bindings)
|
||||||
|
}
|
||||||
|
|
||||||
|
let thenLetBang (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
|
||||||
|
{ bindings with
|
||||||
|
Bindings = (LetBang (varName, value) :: bindings.Bindings)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let thenUse (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
|
||||||
|
{ bindings with
|
||||||
|
Bindings = (LetBang (varName, value) :: bindings.Bindings)
|
||||||
|
}
|
||||||
|
*)
|
@@ -3,12 +3,14 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open System
|
open System
|
||||||
open System.Text
|
open System.Text
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Myriad.Core
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal Ident =
|
module internal Ident =
|
||||||
|
let inline create (s : string) = Ident (s, 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
|
||||||
result.Append x.idText.[1..] |> ignore
|
result.Append x.idText.[1..] |> ignore
|
||||||
Ident.Create ((result : StringBuilder).ToString ())
|
create ((result : StringBuilder).ToString ())
|
9
WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
Normal file
9
WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Xml
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal PreXmlDoc =
|
||||||
|
let create (s : string) : PreXmlDoc =
|
||||||
|
PreXmlDoc.Create ([| " " + s |], range0)
|
@@ -8,11 +8,11 @@ open Myriad.Core
|
|||||||
module internal SynAttribute =
|
module internal SynAttribute =
|
||||||
let internal compilationRepresentation : SynAttribute =
|
let internal compilationRepresentation : SynAttribute =
|
||||||
{
|
{
|
||||||
TypeName = SynLongIdent.CreateString "CompilationRepresentation"
|
TypeName = SynLongIdent.createS "CompilationRepresentation"
|
||||||
ArgExpr =
|
ArgExpr =
|
||||||
SynExpr.CreateLongIdent (
|
SynExpr.CreateLongIdent (
|
||||||
false,
|
false,
|
||||||
SynLongIdent.Create [ "CompilationRepresentationFlags" ; "ModuleSuffix" ],
|
SynLongIdent.createS' [ "CompilationRepresentationFlags" ; "ModuleSuffix" ],
|
||||||
None
|
None
|
||||||
)
|
)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.CreateParen
|
||||||
@@ -23,7 +23,7 @@ module internal SynAttribute =
|
|||||||
|
|
||||||
let internal autoOpen : SynAttribute =
|
let internal autoOpen : SynAttribute =
|
||||||
{
|
{
|
||||||
TypeName = SynLongIdent.CreateString "AutoOpen"
|
TypeName = SynLongIdent.createS "AutoOpen"
|
||||||
ArgExpr = SynExpr.CreateConst SynConst.Unit
|
ArgExpr = SynExpr.CreateConst SynConst.Unit
|
||||||
Target = None
|
Target = None
|
||||||
AppliesToGetterAndSetter = false
|
AppliesToGetterAndSetter = false
|
||||||
|
50
WoofWare.Myriad.Plugins/SynExpr/SynComponentInfo.fs
Normal file
50
WoofWare.Myriad.Plugins/SynExpr/SynComponentInfo.fs
Normal file
@@ -0,0 +1,50 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.Xml
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynComponentInfo =
|
||||||
|
let inline createLong (name : LongIdent) =
|
||||||
|
SynComponentInfo.SynComponentInfo ([], None, [], name, PreXmlDoc.Empty, false, None, range0)
|
||||||
|
|
||||||
|
let inline create (name : Ident) = createLong [ name ]
|
||||||
|
|
||||||
|
let inline withDocString (doc : PreXmlDoc) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
match i with
|
||||||
|
| SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, _, postfix, access, range) ->
|
||||||
|
SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range)
|
||||||
|
|
||||||
|
let inline setGenerics (typars : SynTyparDecls option) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
match i with
|
||||||
|
| SynComponentInfo.SynComponentInfo (attrs, _, constraints, name, doc, postfix, access, range) ->
|
||||||
|
SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range)
|
||||||
|
|
||||||
|
let inline withGenerics (typars : SynTyparDecl list) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
let inner =
|
||||||
|
if typars.IsEmpty then
|
||||||
|
None
|
||||||
|
else
|
||||||
|
Some (SynTyparDecls.PostfixList (typars, [], range0))
|
||||||
|
|
||||||
|
setGenerics inner i
|
||||||
|
|
||||||
|
let inline setAccessibility (acc : SynAccess option) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
match i with
|
||||||
|
| SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, _, range) ->
|
||||||
|
SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, acc, range)
|
||||||
|
|
||||||
|
let inline withAccessibility (acc : SynAccess) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
setAccessibility (Some acc) i
|
||||||
|
|
||||||
|
let inline addAttributes (attrs : SynAttribute list) (i : SynComponentInfo) : SynComponentInfo =
|
||||||
|
match i with
|
||||||
|
| SynComponentInfo.SynComponentInfo (oldAttrs, typars, constraints, name, doc, postfix, acc, range) ->
|
||||||
|
let attrs =
|
||||||
|
{
|
||||||
|
SynAttributeList.Attributes = attrs
|
||||||
|
SynAttributeList.Range = range0
|
||||||
|
}
|
||||||
|
|
||||||
|
SynComponentInfo.SynComponentInfo ((attrs :: oldAttrs), typars, constraints, name, doc, postfix, acc, range)
|
@@ -3,14 +3,18 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.SyntaxTrivia
|
open Fantomas.FCS.SyntaxTrivia
|
||||||
open Myriad.Core
|
open Myriad.Core
|
||||||
open Myriad.Core.Ast
|
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
type internal CompExprBinding =
|
[<AutoOpen>]
|
||||||
| LetBang of varName : string * rhs : SynExpr
|
module internal SynExprExtensions =
|
||||||
| Let of varName : string * rhs : SynExpr
|
type SynExpr with
|
||||||
| Use of varName : string * rhs : SynExpr
|
static member CreateConst (s : string) : SynExpr =
|
||||||
| Do of body : SynExpr
|
SynExpr.Const (SynConst.String (s, SynStringKind.Regular, range0), range0)
|
||||||
|
|
||||||
|
static member CreateConst () : SynExpr = SynExpr.Const (SynConst.Unit, range0)
|
||||||
|
|
||||||
|
static member CreateConst (i : int32) : SynExpr =
|
||||||
|
SynExpr.Const (SynConst.Int32 i, range0)
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal SynExpr =
|
module internal SynExpr =
|
||||||
@@ -58,7 +62,7 @@ module internal SynExpr =
|
|||||||
/// try {body} with | {exc} as exc -> {handler}
|
/// try {body} with | {exc} as exc -> {handler}
|
||||||
let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr =
|
let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr =
|
||||||
let clause =
|
let clause =
|
||||||
SynMatchClause.Create (SynPat.As (exc, SynPat.CreateNamed (Ident.Create "exc"), range0), None, handler)
|
SynMatchClause.create (SynPat.As (exc, SynPat.named "exc", range0)) handler
|
||||||
|
|
||||||
SynExpr.TryWith (
|
SynExpr.TryWith (
|
||||||
body,
|
body,
|
||||||
@@ -119,24 +123,24 @@ module internal SynExpr =
|
|||||||
|
|
||||||
/// {obj}.{meth}()
|
/// {obj}.{meth}()
|
||||||
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
|
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
|
||||||
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
|
callMethodArg meth (SynExpr.CreateConst ()) obj
|
||||||
|
|
||||||
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
|
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
|
||||||
SynExpr.TypeApp (
|
SynExpr.TypeApp (
|
||||||
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
|
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0),
|
||||||
range0,
|
range0,
|
||||||
[ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ],
|
[ SynType.LongIdent (SynLongIdent.create ty) ],
|
||||||
[],
|
[],
|
||||||
Some range0,
|
Some range0,
|
||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> 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.TypeApp (
|
SynExpr.TypeApp (
|
||||||
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
|
SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0),
|
||||||
range0,
|
range0,
|
||||||
[ SynType.CreateLongIdent ty ],
|
[ SynType.CreateLongIdent ty ],
|
||||||
[],
|
[],
|
||||||
@@ -144,14 +148,14 @@ module internal SynExpr =
|
|||||||
range0,
|
range0,
|
||||||
range0
|
range0
|
||||||
)
|
)
|
||||||
|> applyTo (SynExpr.CreateConst SynConst.Unit)
|
|> applyTo (SynExpr.CreateConst ())
|
||||||
|
|
||||||
let index (property : SynExpr) (obj : SynExpr) : SynExpr =
|
let index (property : SynExpr) (obj : SynExpr) : SynExpr =
|
||||||
SynExpr.DotIndexedGet (obj, property, range0, range0)
|
SynExpr.DotIndexedGet (obj, property, range0, range0)
|
||||||
|
|
||||||
/// (fun {varName} -> {body})
|
/// (fun {varName} -> {body})
|
||||||
let createLambda (varName : string) (body : SynExpr) : SynExpr =
|
let createLambda (varName : string) (body : SynExpr) : SynExpr =
|
||||||
let parsedDataPat = [ SynPat.CreateNamed (Ident.Create varName) ]
|
let parsedDataPat = [ SynPat.named varName ]
|
||||||
|
|
||||||
SynExpr.Lambda (
|
SynExpr.Lambda (
|
||||||
false,
|
false,
|
||||||
@@ -166,38 +170,66 @@ module internal SynExpr =
|
|||||||
)
|
)
|
||||||
|> SynExpr.CreateParen
|
|> SynExpr.CreateParen
|
||||||
|
|
||||||
let reraise : SynExpr =
|
let createThunk (body : SynExpr) : SynExpr =
|
||||||
SynExpr.CreateIdent (Ident.Create "reraise")
|
let parsedDataPat = [ SynPat.Const (SynConst.Unit, range0) ]
|
||||||
|> applyTo (SynExpr.CreateConst SynConst.Unit)
|
|
||||||
|
SynExpr.Lambda (
|
||||||
|
false,
|
||||||
|
false,
|
||||||
|
SynSimplePats.Create [],
|
||||||
|
body,
|
||||||
|
Some (parsedDataPat, body),
|
||||||
|
range0,
|
||||||
|
{
|
||||||
|
ArrowRange = Some range0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> SynExpr.CreateParen
|
||||||
|
|
||||||
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
|
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
|
||||||
let startAsTask (ct : SynLongIdent) (body : SynExpr) =
|
let startAsTask (ct : SynLongIdent) (body : SynExpr) =
|
||||||
let lambda =
|
let lambda =
|
||||||
[
|
[
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
|
SynExpr.CreateLongIdent (SynLongIdent.createS "a")
|
||||||
equals
|
equals
|
||||||
(SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
|
(SynExpr.LongIdent (true, SynLongIdent.createS "cancellationToken", None, range0))
|
||||||
(SynExpr.CreateLongIdent ct)
|
(SynExpr.CreateLongIdent ct)
|
||||||
]
|
]
|
||||||
|> SynExpr.CreateParenedTuple
|
|> SynExpr.CreateParenedTuple
|
||||||
|> applyFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]))
|
|> applyFunction (SynExpr.CreateLongIdent (SynLongIdent.createS' [ "Async" ; "StartAsTask" ]))
|
||||||
|> createLambda "a"
|
|> createLambda "a"
|
||||||
|
|
||||||
pipeThroughFunction lambda body
|
pipeThroughFunction lambda body
|
||||||
|
|
||||||
let createLongIdent (ident : string list) : SynExpr =
|
let inline createIdent (s : string) : SynExpr = SynExpr.Ident (Ident (s, range0))
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.Create ident)
|
|
||||||
|
|
||||||
let createLongIdent' (ident : Ident list) : SynExpr =
|
let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i
|
||||||
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident)
|
|
||||||
|
|
||||||
let createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
|
let inline createLongIdent (ident : string list) : SynExpr =
|
||||||
|
SynExpr.CreateLongIdent (SynLongIdent.createS' ident)
|
||||||
|
|
||||||
|
let inline createLongIdent' (ident : Ident list) : SynExpr =
|
||||||
|
SynExpr.CreateLongIdent (SynLongIdent.create ident)
|
||||||
|
|
||||||
|
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 createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = SynExpr.CreateMatch (matchOn, cases)
|
let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr =
|
||||||
|
SynExpr.CreateMatch (matchOn, cases)
|
||||||
|
|
||||||
let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.CreateTyped (expr, ty)
|
let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.CreateTyped (expr, ty)
|
||||||
|
|
||||||
|
let inline paren (e : SynExpr) : SynExpr =
|
||||||
|
SynExpr.Paren (e, range0, Some range0, range0)
|
||||||
|
|
||||||
|
let inline createNew (ty : SynType) (args : SynExpr) : SynExpr =
|
||||||
|
SynExpr.New (false, ty, paren args, range0)
|
||||||
|
|
||||||
|
let inline createWhile (cond : SynExpr) (body : SynExpr) : SynExpr =
|
||||||
|
SynExpr.While (DebugPointAtWhile.Yes range0, cond, body, range0)
|
||||||
|
|
||||||
|
let reraise : SynExpr = createIdent "reraise" |> applyTo (SynExpr.CreateConst ())
|
||||||
|
|
||||||
/// {compExpr} { {lets} ; return {ret} }
|
/// {compExpr} { {lets} ; return {ret} }
|
||||||
let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
|
let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
|
||||||
let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
|
let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
|
||||||
@@ -211,7 +243,7 @@ module internal SynExpr =
|
|||||||
DebugPointAtBinding.Yes range0,
|
DebugPointAtBinding.Yes range0,
|
||||||
false,
|
false,
|
||||||
true,
|
true,
|
||||||
SynPat.CreateNamed (Ident.Create lhs),
|
SynPat.named lhs,
|
||||||
rhs,
|
rhs,
|
||||||
[],
|
[],
|
||||||
state,
|
state,
|
||||||
@@ -220,13 +252,12 @@ module internal SynExpr =
|
|||||||
EqualsRange = Some range0
|
EqualsRange = Some range0
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
| Let (lhs, rhs) ->
|
| Let (lhs, rhs) -> createLet [ SynBinding.basic (SynLongIdent.createS lhs) [] rhs ] state
|
||||||
createLet [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ] state
|
|
||||||
| Use (lhs, rhs) ->
|
| Use (lhs, rhs) ->
|
||||||
SynExpr.LetOrUse (
|
SynExpr.LetOrUse (
|
||||||
false,
|
false,
|
||||||
true,
|
true,
|
||||||
[ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
|
[ SynBinding.basic (SynLongIdent.createS lhs) [] rhs ],
|
||||||
state,
|
state,
|
||||||
range0,
|
range0,
|
||||||
{
|
{
|
||||||
@@ -243,17 +274,14 @@ module internal SynExpr =
|
|||||||
|
|
||||||
/// {expr} |> Async.AwaitTask
|
/// {expr} |> Async.AwaitTask
|
||||||
let awaitTask (expr : SynExpr) : SynExpr =
|
let awaitTask (expr : SynExpr) : SynExpr =
|
||||||
expr
|
expr |> pipeThroughFunction (createLongIdent [ "Async" ; "AwaitTask" ])
|
||||||
|> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ]))
|
|
||||||
|
|
||||||
/// {ident}.ToString ()
|
/// {ident}.ToString ()
|
||||||
/// with special casing for some types like DateTime
|
/// with special casing for some types like DateTime
|
||||||
let toString (ty : SynType) (ident : SynExpr) =
|
let toString (ty : SynType) (ident : SynExpr) =
|
||||||
match ty with
|
match ty with
|
||||||
| DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
|
| DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConst "yyyy-MM-dd")
|
||||||
| DateTime ->
|
| DateTime -> ident |> callMethodArg "ToString" (SynExpr.CreateConst "yyyy-MM-ddTHH:mm:ss")
|
||||||
ident
|
|
||||||
|> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
|
|
||||||
| _ -> callMethod "ToString" ident
|
| _ -> callMethod "ToString" ident
|
||||||
|
|
||||||
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
|
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
|
||||||
@@ -275,8 +303,7 @@ module internal SynExpr =
|
|||||||
)
|
)
|
||||||
|
|
||||||
/// {ident} - {n}
|
/// {ident} - {n}
|
||||||
let minusN (ident : SynLongIdent) (n : int) : SynExpr =
|
let minusN (ident : SynLongIdent) (n : int) : SynExpr = minus ident (SynExpr.CreateConst n)
|
||||||
minus ident (SynExpr.CreateConst (SynConst.Int32 n))
|
|
||||||
|
|
||||||
/// {y} > {x}
|
/// {y} > {x}
|
||||||
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
|
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||||
|
83
WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs
Normal file
83
WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynLongIdent =
|
||||||
|
|
||||||
|
let create (ident : LongIdent) : SynLongIdent =
|
||||||
|
let commas =
|
||||||
|
match ident with
|
||||||
|
| [] -> []
|
||||||
|
| _ :: commas -> commas |> List.map (fun _ -> range0)
|
||||||
|
|
||||||
|
SynLongIdent.SynLongIdent (ident, commas, List.replicate ident.Length None)
|
||||||
|
|
||||||
|
let inline createI (i : Ident) : SynLongIdent = create [ i ]
|
||||||
|
|
||||||
|
let inline createS (s : string) : SynLongIdent = createI (Ident (s, range0))
|
||||||
|
|
||||||
|
let inline createS' (s : string list) : SynLongIdent =
|
||||||
|
create (s |> List.map (fun i -> Ident (i, range0)))
|
||||||
|
|
||||||
|
let isUnit (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] when System.String.Equals (i.idText, "unit", System.StringComparison.OrdinalIgnoreCase) -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isList (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] when System.String.Equals (i.idText, "list", System.StringComparison.OrdinalIgnoreCase) -> true
|
||||||
|
// TODO: consider FSharpList or whatever it is
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isArray (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] when
|
||||||
|
System.String.Equals (i.idText, "array", System.StringComparison.OrdinalIgnoreCase)
|
||||||
|
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
|
||||||
|
->
|
||||||
|
true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isOption (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] when System.String.Equals (i.idText, "option", System.StringComparison.OrdinalIgnoreCase) -> true
|
||||||
|
// TODO: consider Microsoft.FSharp.Option or whatever it is
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isResponse (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "Response" ]
|
||||||
|
| [ "RestEase" ; "Response" ] -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isMap (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "Map" ] -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isReadOnlyDictionary (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "IReadOnlyDictionary" ]
|
||||||
|
| [ "Generic" ; "IReadOnlyDictionary" ]
|
||||||
|
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
|
||||||
|
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isDictionary (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "Dictionary" ]
|
||||||
|
| [ "Generic" ; "Dictionary" ]
|
||||||
|
| [ "Collections" ; "Generic" ; "Dictionary" ]
|
||||||
|
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
let isIDictionary (ident : SynLongIdent) : bool =
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "IDictionary" ]
|
||||||
|
| [ "Generic" ; "IDictionary" ]
|
||||||
|
| [ "Collections" ; "Generic" ; "IDictionary" ]
|
||||||
|
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
|
||||||
|
| _ -> false
|
24
WoofWare.Myriad.Plugins/SynExpr/SynMatchClause.fs
Normal file
24
WoofWare.Myriad.Plugins/SynExpr/SynMatchClause.fs
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynMatchClause =
|
||||||
|
let create (lhs : SynPat) (rhs : SynExpr) : SynMatchClause =
|
||||||
|
SynMatchClause.SynMatchClause (
|
||||||
|
lhs,
|
||||||
|
None,
|
||||||
|
rhs,
|
||||||
|
range0,
|
||||||
|
DebugPointAtTarget.Yes,
|
||||||
|
{
|
||||||
|
ArrowRange = Some range0
|
||||||
|
BarRange = Some range0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
let withWhere (where : SynExpr) (m : SynMatchClause) : SynMatchClause =
|
||||||
|
match m with
|
||||||
|
| SynMatchClause (synPat, _, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia) ->
|
||||||
|
SynMatchClause (synPat, Some where, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia)
|
61
WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs
Normal file
61
WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs
Normal file
@@ -0,0 +1,61 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.SyntaxTrivia
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
open Fantomas.FCS.Xml
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynMemberDefn =
|
||||||
|
let private interfaceMemberSlotFlags =
|
||||||
|
{
|
||||||
|
SynMemberFlags.IsInstance = true
|
||||||
|
SynMemberFlags.IsDispatchSlot = true
|
||||||
|
SynMemberFlags.IsOverrideOrExplicitImpl = false
|
||||||
|
SynMemberFlags.IsFinal = false
|
||||||
|
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
|
||||||
|
SynMemberFlags.MemberKind = SynMemberKind.Member
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let abstractMember
|
||||||
|
(ident : SynIdent)
|
||||||
|
(typars : SynTyparDecls option)
|
||||||
|
(arity : SynValInfo)
|
||||||
|
(xmlDoc : PreXmlDoc)
|
||||||
|
(returnType : SynType)
|
||||||
|
: SynMemberDefn
|
||||||
|
=
|
||||||
|
let slot =
|
||||||
|
SynValSig.SynValSig (
|
||||||
|
[],
|
||||||
|
ident,
|
||||||
|
SynValTyparDecls.SynValTyparDecls (typars, true),
|
||||||
|
returnType,
|
||||||
|
arity,
|
||||||
|
false,
|
||||||
|
false,
|
||||||
|
xmlDoc,
|
||||||
|
None,
|
||||||
|
None,
|
||||||
|
range0,
|
||||||
|
{
|
||||||
|
EqualsRange = None
|
||||||
|
WithKeyword = None
|
||||||
|
InlineKeyword = None
|
||||||
|
LeadingKeyword = SynLeadingKeyword.Abstract range0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
SynMemberDefn.AbstractSlot (
|
||||||
|
slot,
|
||||||
|
interfaceMemberSlotFlags,
|
||||||
|
range0,
|
||||||
|
{
|
||||||
|
GetSetKeywords = None
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
let staticMember (binding : SynBinding) : SynMemberDefn =
|
||||||
|
let binding = SynBinding.makeStaticMember binding
|
||||||
|
SynMemberDefn.Member (binding, range0)
|
@@ -8,3 +8,9 @@ module internal SynPat =
|
|||||||
|
|
||||||
let annotateType (ty : SynType) (pat : SynPat) =
|
let annotateType (ty : SynType) (pat : SynPat) =
|
||||||
SynPat.Paren (SynPat.Typed (pat, ty, range0), range0)
|
SynPat.Paren (SynPat.Typed (pat, ty, range0), range0)
|
||||||
|
|
||||||
|
let named (s : string) : SynPat =
|
||||||
|
SynPat.Named (SynIdent.SynIdent (Ident (s, range0), None), false, None, range0)
|
||||||
|
|
||||||
|
let namedI (i : Ident) : SynPat =
|
||||||
|
SynPat.Named (SynIdent.SynIdent (i, None), false, None, range0)
|
||||||
|
@@ -1,6 +1,7 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal SynType =
|
module internal SynType =
|
||||||
@@ -8,3 +9,224 @@ module internal SynType =
|
|||||||
match ty with
|
match ty with
|
||||||
| SynType.Paren (ty, _) -> stripOptionalParen ty
|
| SynType.Paren (ty, _) -> stripOptionalParen ty
|
||||||
| ty -> ty
|
| ty -> ty
|
||||||
|
|
||||||
|
let inline createLongIdent (ident : LongIdent) : SynType =
|
||||||
|
SynType.LongIdent (SynLongIdent.create ident)
|
||||||
|
|
||||||
|
let inline createLongIdent' (ident : string list) : SynType =
|
||||||
|
SynType.LongIdent (SynLongIdent.createS' ident)
|
||||||
|
|
||||||
|
let inline named (name : string) = createLongIdent' [ name ]
|
||||||
|
|
||||||
|
let inline app' (name : SynType) (args : SynType list) : SynType =
|
||||||
|
if args.IsEmpty then
|
||||||
|
failwith "Type cannot be applied to no arguments"
|
||||||
|
|
||||||
|
SynType.App (name, Some range0, args, List.replicate (args.Length - 1) range0, Some range0, false, range0)
|
||||||
|
|
||||||
|
let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
|
||||||
|
|
||||||
|
let inline appPostfix (name : string) (arg : SynType) : SynType =
|
||||||
|
SynType.App (named name, None, [ arg ], [], None, true, range0)
|
||||||
|
|
||||||
|
let inline funFromDomain (domain : SynType) (range : SynType) : SynType =
|
||||||
|
SynType.Fun (
|
||||||
|
domain,
|
||||||
|
range,
|
||||||
|
range0,
|
||||||
|
{
|
||||||
|
ArrowRange = range0
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType =
|
||||||
|
SynType.SignatureParameter ([], false, name, ty, range0)
|
||||||
|
|
||||||
|
let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
|
||||||
|
|
||||||
|
[<AutoOpen>]
|
||||||
|
module internal SynTypePatterns =
|
||||||
|
let (|OptionType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isOption ident ->
|
||||||
|
Some innerType
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|UnitType|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|ListType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isList ident ->
|
||||||
|
Some innerType
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|ArrayType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isArray ident ->
|
||||||
|
Some innerType
|
||||||
|
| SynType.Array (1, innerType, _) -> Some innerType
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|RestEaseResponseType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isResponse ident ->
|
||||||
|
Some innerType
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|DictionaryType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isDictionary ident ->
|
||||||
|
Some (key, value)
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|IDictionaryType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isIDictionary ident ->
|
||||||
|
Some (key, value)
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
|
||||||
|
SynLongIdent.isReadOnlyDictionary ident
|
||||||
|
->
|
||||||
|
Some (key, value)
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|MapType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isMap ident ->
|
||||||
|
Some (key, value)
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|BigInt|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent |> List.map _.idText with
|
||||||
|
| [ "bigint" ]
|
||||||
|
| [ "BigInteger" ]
|
||||||
|
| [ "Numerics" ; "BigInteger" ]
|
||||||
|
| [ "System" ; "Numerics" ; "BigInteger" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
/// Returns the type, qualified as in e.g. `System.Boolean`.
|
||||||
|
let (|PrimitiveType|_|) (fieldType : SynType) : LongIdent option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] -> Primitives.qualifyType i.idText
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|String|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] ->
|
||||||
|
[ "string" ]
|
||||||
|
|> List.tryFind (fun s -> s = i.idText)
|
||||||
|
|> Option.map ignore<string>
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|Byte|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|Guid|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "Guid" ]
|
||||||
|
| [ "Guid" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "Net" ; "Http" ; "HttpResponseMessage" ]
|
||||||
|
| [ "Net" ; "Http" ; "HttpResponseMessage" ]
|
||||||
|
| [ "Http" ; "HttpResponseMessage" ]
|
||||||
|
| [ "HttpResponseMessage" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|HttpContent|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
|
||||||
|
| [ "Net" ; "Http" ; "HttpContent" ]
|
||||||
|
| [ "Http" ; "HttpContent" ]
|
||||||
|
| [ "HttpContent" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|Stream|_|) (fieldType : SynType) : unit option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "IO" ; "Stream" ]
|
||||||
|
| [ "IO" ; "Stream" ]
|
||||||
|
| [ "Stream" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|NumberType|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent ident ->
|
||||||
|
match ident.LongIdent with
|
||||||
|
| [ i ] -> [ "string" ; "float" ; "int" ; "bool" ] |> List.tryFind (fun s -> s = i.idText)
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|DateOnly|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
||||||
|
match ident |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "DateOnly" ]
|
||||||
|
| [ "DateOnly" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|DateTime|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
||||||
|
match ident |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "DateTime" ]
|
||||||
|
| [ "DateTime" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|Uri|_|) (fieldType : SynType) =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
|
||||||
|
match ident |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "System" ; "Uri" ]
|
||||||
|
| [ "Uri" ] -> Some ()
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let (|Task|_|) (fieldType : SynType) : SynType option =
|
||||||
|
match fieldType with
|
||||||
|
| SynType.App (SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)), _, args, _, _, _, _) ->
|
||||||
|
match ident |> List.map (fun i -> i.idText) with
|
||||||
|
| [ "Task" ]
|
||||||
|
| [ "Tasks" ; "Task" ]
|
||||||
|
| [ "Threading" ; "Tasks" ; "Task" ]
|
||||||
|
| [ "System" ; "Threading" ; "Tasks" ; "Task" ] ->
|
||||||
|
match args with
|
||||||
|
| [ arg ] -> Some arg
|
||||||
|
| _ -> failwithf "Expected Task to be applied to exactly one arg, but got: %+A" args
|
||||||
|
| _ -> None
|
||||||
|
| _ -> None
|
||||||
|
27
WoofWare.Myriad.Plugins/SynExpr/SynTypeDefn.fs
Normal file
27
WoofWare.Myriad.Plugins/SynExpr/SynTypeDefn.fs
Normal file
@@ -0,0 +1,27 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.SyntaxTrivia
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynTypeDefn =
|
||||||
|
|
||||||
|
let inline create (componentInfo : SynComponentInfo) (repr : SynTypeDefnRepr) : SynTypeDefn =
|
||||||
|
SynTypeDefn.SynTypeDefn (
|
||||||
|
componentInfo,
|
||||||
|
repr,
|
||||||
|
[],
|
||||||
|
None,
|
||||||
|
range0,
|
||||||
|
{
|
||||||
|
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
|
||||||
|
EqualsRange = Some range0
|
||||||
|
WithKeyword = None
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
let inline withMemberDefns (members : SynMemberDefn list) (r : SynTypeDefn) : SynTypeDefn =
|
||||||
|
match r with
|
||||||
|
| SynTypeDefn (typeInfo, typeRepr, _, ctor, range, trivia) ->
|
||||||
|
SynTypeDefn.SynTypeDefn (typeInfo, typeRepr, members, ctor, range, trivia)
|
20
WoofWare.Myriad.Plugins/SynExpr/SynTypeDefnRepr.fs
Normal file
20
WoofWare.Myriad.Plugins/SynExpr/SynTypeDefnRepr.fs
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynTypeDefnRepr =
|
||||||
|
|
||||||
|
let inline interfaceType (mems : SynMemberDefns) : SynTypeDefnRepr =
|
||||||
|
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Unspecified, mems, range0)
|
||||||
|
|
||||||
|
/// Indicates the body of a `type Foo with {body}` extension type declaration.
|
||||||
|
let inline augmentation () : SynTypeDefnRepr =
|
||||||
|
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
|
||||||
|
|
||||||
|
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
|
||||||
|
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
|
||||||
|
|
||||||
|
let inline record (fields : SynField list) : SynTypeDefnRepr =
|
||||||
|
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
|
@@ -9,6 +9,15 @@ type internal UnionCase<'Ident> =
|
|||||||
Ident : Ident
|
Ident : Ident
|
||||||
}
|
}
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal UnionCase =
|
||||||
|
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
|
||||||
|
{
|
||||||
|
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
|
||||||
|
Attrs = unionCase.Attrs
|
||||||
|
Ident = unionCase.Ident
|
||||||
|
}
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal SynUnionCase =
|
module internal SynUnionCase =
|
||||||
let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
|
let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
|
||||||
|
@@ -25,17 +25,26 @@
|
|||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Compile Include="List.fs"/>
|
<Compile Include="List.fs"/>
|
||||||
<Compile Include="Ident.fs" />
|
<Compile Include="Primitives.fs" />
|
||||||
<Compile Include="AstHelper.fs"/>
|
<Compile Include="SynExpr\PreXmlDoc.fs" />
|
||||||
|
<Compile Include="SynExpr\Ident.fs" />
|
||||||
|
<Compile Include="SynExpr\SynLongIdent.fs" />
|
||||||
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
|
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
|
||||||
<Compile Include="SynExpr\SynBinding.fs" />
|
<Compile Include="SynExpr\SynBinding.fs" />
|
||||||
<Compile Include="SynExpr\SynExpr.fs" />
|
|
||||||
<Compile Include="SynExpr\SynType.fs" />
|
<Compile Include="SynExpr\SynType.fs" />
|
||||||
|
<Compile Include="SynExpr\SynMatchClause.fs" />
|
||||||
|
<Compile Include="SynExpr\SynPat.fs" />
|
||||||
|
<Compile Include="SynExpr\CompExpr.fs" />
|
||||||
|
<Compile Include="SynExpr\SynExpr.fs" />
|
||||||
<Compile Include="SynExpr\SynAttribute.fs" />
|
<Compile Include="SynExpr\SynAttribute.fs" />
|
||||||
<Compile Include="SynExpr\SynArgPats.fs" />
|
<Compile Include="SynExpr\SynArgPats.fs" />
|
||||||
<Compile Include="SynExpr\SynField.fs" />
|
<Compile Include="SynExpr\SynField.fs" />
|
||||||
<Compile Include="SynExpr\SynUnionCase.fs" />
|
<Compile Include="SynExpr\SynUnionCase.fs" />
|
||||||
<Compile Include="SynExpr\SynPat.fs" />
|
<Compile Include="SynExpr\SynTypeDefnRepr.fs" />
|
||||||
|
<Compile Include="SynExpr\SynTypeDefn.fs" />
|
||||||
|
<Compile Include="SynExpr\SynComponentInfo.fs" />
|
||||||
|
<Compile Include="SynExpr\SynMemberDefn.fs" />
|
||||||
|
<Compile Include="AstHelper.fs" />
|
||||||
<Compile Include="RemoveOptionsGenerator.fs"/>
|
<Compile Include="RemoveOptionsGenerator.fs"/>
|
||||||
<Compile Include="InterfaceMockGenerator.fs"/>
|
<Compile Include="InterfaceMockGenerator.fs"/>
|
||||||
<Compile Include="JsonSerializeGenerator.fs"/>
|
<Compile Include="JsonSerializeGenerator.fs"/>
|
||||||
|
@@ -7,6 +7,7 @@
|
|||||||
":/",
|
":/",
|
||||||
":^WoofWare.Myriad.Plugins.Test/",
|
":^WoofWare.Myriad.Plugins.Test/",
|
||||||
":^WoofWare.Myriad.Plugins.Attributes/Test/",
|
":^WoofWare.Myriad.Plugins.Attributes/Test/",
|
||||||
":^/.github/"
|
":^/.github/",
|
||||||
|
":^/CHANGELOG.md"
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
Reference in New Issue
Block a user