From 67d870002e8ed9a9e8f8a36aa4ce255d5055dfd9 Mon Sep 17 00:00:00 2001
From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com>
Date: Thu, 28 Dec 2023 19:46:52 +0000
Subject: [PATCH] HTTP clients (#21)
---
ConsumePlugin/ConsumePlugin.fsproj | 6 +-
ConsumePlugin/GeneratedRestClient.fs | 178 +++++
ConsumePlugin/RestApiExample.fs | 53 +-
README.md | 80 ++-
WoofWare.Myriad.Plugins/AstHelper.fs | 36 +-
.../HttpClientGenerator.fs | 678 +++++++++++++++++-
WoofWare.Myriad.Plugins/JsonParseGenerator.fs | 17 +-
.../RemoveOptionsGenerator.fs | 17 +-
WoofWare.Myriad.Plugins/SurfaceBaseline.txt | 4 +
WoofWare.Myriad.Plugins/SynAttribute.fs | 22 +
WoofWare.Myriad.Plugins/SynExpr.fs | 96 +++
.../WoofWare.Myriad.Plugins.fsproj | 3 +-
WoofWare.Myriad.Plugins/version.json | 4 +-
13 files changed, 1091 insertions(+), 103 deletions(-)
create mode 100644 WoofWare.Myriad.Plugins/SynAttribute.fs
diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj
index c2c8fc4..6e9c951 100644
--- a/ConsumePlugin/ConsumePlugin.fsproj
+++ b/ConsumePlugin/ConsumePlugin.fsproj
@@ -22,10 +22,10 @@
PureGymDto.fs
-
-
+
+
RestApiExample.fs
-
+
runmyriad.sh
diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs
index 72a92a8..a6ef677 100644
--- a/ConsumePlugin/GeneratedRestClient.fs
+++ b/ConsumePlugin/GeneratedRestClient.fs
@@ -2,3 +2,181 @@
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
+
+
+namespace PureGym
+
+open System
+open System.Threading
+open System.Threading.Tasks
+open RestEase
+
+/// Module for constructing a REST client.
+[]
+[]
+module PureGymApi =
+ /// Create a REST client.
+ let make (client : System.Net.Http.HttpClient) : IPureGymApi =
+ { new IPureGymApi with
+ member _.GetGyms (ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString () + "/v1/gyms/" |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return node.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ member _.GetGymAttendance (gymId : int, ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString ()
+ + "/v1/gyms/{gym_id}/attendance".Replace ("{gym_id}", gymId.ToString ())
+ |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return GymAttendance.jsonParse node
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ member _.GetMember (ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString () + "/v1/member"
+ |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return Member.jsonParse node
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ member _.GetGym (gymId : int, ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString ()
+ + "/v1/gyms/{gym_id}".Replace ("{gym_id}", gymId.ToString ())
+ |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return Gym.jsonParse node
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ member _.GetMemberActivity (ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString () + "/v1/member/activity"
+ |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return MemberActivityDto.jsonParse node
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ member _.GetSessions (fromDate : DateTime, toDate : DateTime, ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri =
+ System.Uri (
+ client.BaseAddress.ToString ()
+ + ("/v2/gymSessions/member"
+ + "?fromDate="
+ + fromDate.ToString ()
+ + "&toDate="
+ + toDate.ToString ())
+ |> System.Web.HttpUtility.UrlEncode
+ )
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return Sessions.jsonParse node
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+ }
diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs
index 577adfd..950c1d0 100644
--- a/ConsumePlugin/RestApiExample.fs
+++ b/ConsumePlugin/RestApiExample.fs
@@ -5,6 +5,7 @@ open System.Threading
open System.Threading.Tasks
open RestEase
+[]
type IPureGymApi =
[]
abstract GetGyms : ?ct : CancellationToken -> Task
@@ -12,57 +13,15 @@ type IPureGymApi =
[]
abstract GetGymAttendance : [] gymId : int * ?ct : CancellationToken -> Task
-(*
[]
- abstract GetMember : unit -> Task
+ abstract GetMember : ?ct : CancellationToken -> Task
[]
- abstract GetGym : [] gymId : int -> Task
+ abstract GetGym : [] gymId : int * ?ct : CancellationToken -> Task
[]
- abstract GetMemberActivity : unit -> Task
+ abstract GetMemberActivity : ?ct : CancellationToken -> Task
[]
- abstract GetSessions : [] fromDate : DateTime -> [] toDate : DateTime -> Task
- *)
-
-module Foo =
- let make (client : System.Net.Http.HttpClient) =
- { new IPureGymApi with
- member _.GetGyms (ct : CancellationToken option) =
- async {
- let! ct = Async.CancellationToken
- let! response = client.GetAsync (client.BaseAddress.ToString () + "v1/gyms/") |> Async.AwaitTask
- let response = response.EnsureSuccessStatusCode ()
- let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
-
- let! node =
- System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
- |> Async.AwaitTask
-
- return
- node.AsArray ()
- |> Seq.map (fun elt -> elt.AsValue () |> Gym.jsonParse)
- |> List.ofSeq
- }
- |> fun a -> Async.StartAsTask (a, ?cancellationToken = ct)
-
- member _.GetGymAttendance (gym_id : int, ct : CancellationToken option) =
- async {
- let! ct = Async.CancellationToken
-
- let! response =
- client.GetAsync (client.BaseAddress.ToString () + $"v1/gyms/{gym_id}/attendance")
- |> Async.AwaitTask
-
- let response = response.EnsureSuccessStatusCode ()
- let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
-
- let! node =
- System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
- |> Async.AwaitTask
-
- return GymAttendance.jsonParse node
- }
- |> fun a -> Async.StartAsTask (a, ?cancellationToken = ct)
- }
+ abstract GetSessions :
+ [] fromDate : DateTime * [] toDate : DateTime * ?ct : CancellationToken -> Task
diff --git a/README.md b/README.md
index 4d2ceb3..b77bcde 100644
--- a/README.md
+++ b/README.md
@@ -10,6 +10,7 @@ The `RemoveOptions` generator in particular is extremely half-baked.
Currently implemented:
* `JsonParse` (to stamp out `jsonParse : JsonNode -> 'T` methods);
* `RemoveOptions` (to strip `option` modifiers from a type).
+* `HttpClient` (to stamp out a [RestEase](https://github.com/canton7/RestEase)-style HTTP client).
## `JsonParse`
@@ -41,7 +42,6 @@ type JsonRecordType =
and stamps out parsing methods like this:
```fsharp
-
/// Module containing JSON parsing methods for the InnerType type
[]
[]
@@ -126,6 +126,84 @@ This generator is *far* from where I want it, because I haven't really spent any
* It needs some sort of attribute to mark a field as *not* receiving this treatment.
* What do we do about discriminated unions?
+## `HttpClient`
+
+Takes a type like this:
+
+```fsharp
+[]
+type IPureGymApi =
+ []
+ abstract GetGyms : ?ct : CancellationToken -> Task
+
+ []
+ abstract GetGymAttendance : [] gymId : int * ?ct : CancellationToken -> Task
+
+ []
+ abstract GetMember : ?ct : CancellationToken -> Task
+
+ []
+ abstract GetGym : [] gymId : int * ?ct : CancellationToken -> Task
+
+ []
+ abstract GetMemberActivity : ?ct : CancellationToken -> Task
+
+ []
+ abstract GetSessions :
+ [] fromDate : DateTime * [] toDate : DateTime * ?ct : CancellationToken -> Task
+```
+
+and stamps out a type like this:
+
+```fsharp
+/// Module for constructing a REST client.
+[]
+[]
+module PureGymApi =
+ /// Create a REST client.
+ let make (client : System.Net.Http.HttpClient) : IPureGymApi =
+ { new IPureGymApi with
+ member _.GetGyms (ct : CancellationToken option) =
+ async {
+ let! ct = Async.CancellationToken
+
+ let httpMessage =
+ new System.Net.Http.HttpRequestMessage (
+ Method = System.Net.Http.HttpMethod.Get,
+ RequestUri = System.Uri (client.BaseAddress.ToString () + "v1/gyms/")
+ )
+
+ let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
+ let response = response.EnsureSuccessStatusCode ()
+ let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
+
+ let! node =
+ System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
+ |> Async.AwaitTask
+
+ return node.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
+ }
+ |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
+
+ // (more methods here)
+ }
+```
+
+### What's the point?
+
+The motivating example is again ahead-of-time compilation: we wish to avoid the reflection which RestEase does.
+
+### Limitations
+
+RestEase is complex, and handles a lot of different stuff.
+* As of this writing, `[]` is explicitly unsupported (it throws with a TODO).
+* Parameters are serialised solely with `ToString`, and there's no control over this; nor is there control over encoding in any sense.
+* Deserialisation follows the same logic as the `JsonParse` generator, and it generally assumes you're using types which `JsonParse` is applied to.
+* Headers are not yet supported.
+* I haven't yet worked out how to integrate this with a mocked HTTP client; you can always mock up an `HttpClient`, but I prefer to use a mock which defines a single member `SendAsync`.
+* Anonymous parameters are currently forbidden.
+* Every function must take an optional `CancellationToken` (which is good practice anyway); so arguments are forced to be tupled. This is a won't-fix for as long as F# requires tupled arguments if any of the args are optional.
+
# Detailed examples
See the tests.
diff --git a/WoofWare.Myriad.Plugins/AstHelper.fs b/WoofWare.Myriad.Plugins/AstHelper.fs
index f8e3ff1..6db8f7c 100644
--- a/WoofWare.Myriad.Plugins/AstHelper.fs
+++ b/WoofWare.Myriad.Plugins/AstHelper.fs
@@ -115,24 +115,32 @@ module internal SynTypePatterns =
let (|DateOnly|_|) (fieldType : SynType) =
match fieldType with
- | SynType.LongIdent ident ->
- match ident.LongIdent with
- | [ i ] ->
- if i.idText = "System.DateOnly" || i.idText = "DateOnly" then
- Some ()
- else
- None
+ | 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 ident ->
- match ident.LongIdent with
- | [ i ] ->
- if i.idText = "System.DateTime" || i.idText = "DateTime" then
- Some ()
- else
- None
+ | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
+ match ident |> List.map (fun i -> i.idText) with
+ | [ "System" ; "DateTime" ]
+ | [ "DateTime" ] -> 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
diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs
index 80eb600..03f9832 100644
--- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs
+++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs
@@ -1,7 +1,7 @@
namespace WoofWare.Myriad.Plugins
open System
-open System.Text
+open System.Net.Http
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
@@ -17,7 +17,670 @@ module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
- let createModule (ns : LongIdent) (interfaceType : SynTypeDefn) : SynModuleOrNamespace = failwith ""
+ type HttpAttribute =
+ // TODO: Format parameter to these attrs
+ | Query of string option
+ | Path of string
+ | Body
+
+ type Parameter =
+ {
+ Attributes : HttpAttribute list
+ IsOptional : bool
+ Id : Ident option
+ Type : SynType
+ }
+
+ let synBindingTriviaZero (isMember : bool) =
+ {
+ SynBindingTrivia.EqualsRange = Some range0
+ InlineKeyword = None
+ LeadingKeyword =
+ if isMember then
+ SynLeadingKeyword.Member range0
+ else
+ SynLeadingKeyword.Let range0
+ }
+
+ type MemberInfo =
+ {
+ /// E.g. HttpMethod.Get
+ HttpMethod : HttpMethod
+ /// E.g. "v1/gyms/{gym_id}/attendance"
+ UrlTemplate : string
+ ReturnType : SynType
+ Arity : SynArgInfo list
+ Args : Parameter list
+ Identifier : Ident
+ }
+
+ let httpMethodString (m : HttpMethod) : string =
+ if m = HttpMethod.Get then "Get"
+ elif m = HttpMethod.Post then "Post"
+ elif m = HttpMethod.Delete then "Delete"
+ elif m = HttpMethod.Patch then "Post"
+ elif m = HttpMethod.Options then "Options"
+ elif m = HttpMethod.Head then "Head"
+ elif m = HttpMethod.Put then "Put"
+ elif m = HttpMethod.Trace then "Trace"
+ else failwith $"Unrecognised method: %+A{m}"
+
+ /// E.g. converts `[]` to (HttpMethod.Get, "blah")
+ let extractHttpInformation (attrs : SynAttribute list) : HttpMethod * string =
+ let matchingAttrs =
+ attrs
+ |> List.choose (fun attr ->
+ match attr.TypeName.AsString with
+ | "Get"
+ | "GetAttribute"
+ | "RestEase.Get"
+ | "RestEase.GetAttribute" -> Some (HttpMethod.Get, attr.ArgExpr)
+ | "Post"
+ | "PostAttribute"
+ | "RestEase.Post"
+ | "RestEase.PostAttribute" -> Some (HttpMethod.Post, attr.ArgExpr)
+ | "Put"
+ | "PutAttribute"
+ | "RestEase.Put"
+ | "RestEase.PutAttribute" -> Some (HttpMethod.Put, attr.ArgExpr)
+ | "Delete"
+ | "DeleteAttribute"
+ | "RestEase.Delete"
+ | "RestEase.DeleteAttribute" -> Some (HttpMethod.Delete, attr.ArgExpr)
+ | "Head"
+ | "HeadAttribute"
+ | "RestEase.Head"
+ | "RestEase.HeadAttribute" -> Some (HttpMethod.Head, attr.ArgExpr)
+ | "Options"
+ | "OptionsAttribute"
+ | "RestEase.Options"
+ | "RestEase.OptionsAttribute" -> Some (HttpMethod.Options, attr.ArgExpr)
+ | "Patch"
+ | "PatchAttribute"
+ | "RestEase.Patch"
+ | "RestEase.PatchAttribute" -> Some (HttpMethod.Patch, attr.ArgExpr)
+ | "Trace"
+ | "TraceAttribute"
+ | "RestEase.Trace"
+ | "RestEase.TraceAttribute" -> Some (HttpMethod.Trace, attr.ArgExpr)
+ | _ -> None
+ )
+
+ match matchingAttrs with
+ | [ (meth, arg) ] ->
+ match arg with
+ | SynExpr.Const (SynConst.String (text, SynStringKind.Regular, _), _) -> meth, text
+ | arg ->
+ failwithf "Unrecognised AST member in attribute argument. Only regular strings are supported: %+A" arg
+ | [] -> failwith "Required exactly one recognised RestEase attribute on member, but got none"
+ | matchingAttrs ->
+ failwithf "Required exactly one recognised RestEase attribute on member, but got %i" matchingAttrs.Length
+
+ let constructMember (info : MemberInfo) : SynMemberDefn =
+ let valInfo =
+ SynValInfo.SynValInfo (
+ [
+ [ SynArgInfo.Empty ]
+ [
+ for arg in info.Args do
+ match arg.Id with
+ | None -> yield SynArgInfo.CreateIdString (failwith "TODO: create an arg name")
+ | Some id -> yield SynArgInfo.CreateId id
+ ]
+ ],
+ SynArgInfo.Empty
+ )
+
+ let valData =
+ SynValData (
+ Some
+ {
+ IsInstance = true
+ IsDispatchSlot = false
+ IsOverrideOrExplicitImpl = true
+ IsFinal = false
+ GetterOrSetterIsCompilerGenerated = false
+ MemberKind = SynMemberKind.Member
+ },
+ valInfo,
+ None
+ )
+
+ let argPats =
+ let args =
+ info.Args
+ |> List.map (fun arg ->
+ let argName =
+ match arg.Id with
+ | None -> failwith "TODO: create an arg name"
+ | Some id -> id
+
+ let argType =
+ if arg.IsOptional then
+ SynType.CreateApp (
+ SynType.CreateLongIdent (SynLongIdent.CreateString "option"),
+ [ arg.Type ],
+ isPostfix = true
+ )
+ else
+ arg.Type
+
+ SynPat.CreateTyped (SynPat.CreateNamed argName, argType)
+ )
+
+ SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
+ |> SynPat.CreateParen
+ |> List.singleton
+ |> SynArgPats.Pats
+
+ let headPat =
+ SynPat.LongIdent (
+ SynLongIdent.CreateFromLongIdent [ Ident.Create "_" ; info.Identifier ],
+ None,
+ None,
+ argPats,
+ None,
+ range0
+ )
+
+ let requestUriTrailer =
+ // TODO: more principled treatment of the slash
+ (SynExpr.CreateConstString ("/" + info.UrlTemplate.TrimStart '/'), info.Args)
+ ||> List.fold (fun template arg ->
+ (template, arg.Attributes)
+ ||> List.fold (fun template attr ->
+ match attr with
+ | HttpAttribute.Path s ->
+ let varName =
+ match arg.Id with
+ | None -> failwith "TODO: anonymous args"
+ | Some id -> id
+
+ template
+ |> SynExpr.callMethodArg
+ "Replace"
+ (SynExpr.CreateParenedTuple
+ [
+ SynExpr.CreateConstString ("{" + s + "}")
+ SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName)
+ ])
+ | _ -> template
+ )
+ )
+
+ /// List of (query-param-key, parameter-which-provides-value)
+ let queryParams =
+ info.Args
+ |> List.collect (fun arg ->
+ arg.Attributes
+ |> List.choose (fun attr ->
+ match attr with
+ | Query None ->
+ let name =
+ match arg.Id with
+ | None ->
+ failwith
+ "Expected a name for the argument we're trying to use as an anonymous query parameter"
+ | Some name -> name.idText
+
+ Some (name, arg)
+ | Query (Some name) -> Some (name, arg)
+ | _ -> None
+ )
+ )
+
+ let requestUriTrailer =
+ match queryParams with
+ | [] -> requestUriTrailer
+ | (firstKey, firstValue) :: queryParams ->
+ let firstValueId =
+ match firstValue.Id with
+ | None -> failwith "Unable to get parameter variable name from anonymous parameter"
+ | Some id -> id
+
+ let toString (ident : SynExpr) (ty : SynType) =
+ match ty with
+ | DateOnly ->
+ ident
+ |> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
+ | DateTime ->
+ ident
+ |> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
+ | _ -> SynExpr.callMethod "ToString" ident
+
+ let prefix =
+ toString (SynExpr.CreateIdent firstValueId) firstValue.Type
+ |> SynExpr.CreateParen
+ |> SynExpr.pipeThroughFunction (
+ SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ])
+ )
+ |> SynExpr.CreateParen
+ |> SynExpr.plus (SynExpr.CreateConstString ("?" + firstKey + "="))
+
+ (prefix, queryParams)
+ ||> List.fold (fun uri (paramKey, paramValue) ->
+ let paramValueId =
+ match paramValue.Id with
+ | None -> failwith "Unable to get parameter variable name from anonymous parameter"
+ | Some id -> id
+
+ toString (SynExpr.CreateIdent paramValueId) paramValue.Type
+ |> SynExpr.CreateParen
+ |> SynExpr.pipeThroughFunction (
+ SynExpr.CreateLongIdent (
+ SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
+ )
+ )
+ |> SynExpr.CreateParen
+ |> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConstString ("&" + paramKey + "=")))
+ )
+ |> SynExpr.plus requestUriTrailer
+ |> SynExpr.CreateParen
+
+ let requestUri =
+ SynExpr.App (
+ ExprAtomicFlag.Atomic,
+ false,
+ SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]),
+ SynExpr.CreateParen (
+ SynExpr.plus
+ (SynExpr.App (
+ ExprAtomicFlag.Atomic,
+ false,
+ SynExpr.CreateLongIdent (
+ SynLongIdent.SynLongIdent (
+ [ Ident.Create "client" ; Ident.Create "BaseAddress" ; Ident.Create "ToString" ],
+ [ range0 ; range0 ],
+ [ None ; None ; None ]
+ )
+ ),
+ SynExpr.CreateConst SynConst.Unit,
+ range0
+ ))
+ requestUriTrailer
+ ),
+ range0
+ )
+
+ let bodyParams =
+ info.Args
+ |> List.collect (fun arg ->
+ arg.Attributes
+ |> List.choose (fun attr ->
+ match attr with
+ | Body -> Some arg
+ | _ -> None
+ )
+ )
+
+ if not bodyParams.IsEmpty then
+ failwith "[] is not yet supported"
+
+ let httpReqMessageConstructor =
+ [
+ SynExpr.equals
+ (SynExpr.CreateIdentString "Method")
+ (SynExpr.CreateLongIdent (
+ SynLongIdent.Create
+ [ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ]
+ ))
+ SynExpr.equals (SynExpr.CreateIdentString "RequestUri") requestUri
+ ]
+ |> SynExpr.CreateParenedTuple
+
+ let returnExpr =
+ JsonParseGenerator.parseNode
+ JsonParseGenerator.JsonParseOption.None
+ info.ReturnType
+ (SynExpr.CreateIdentString "node")
+
+ let implementation =
+ [
+ yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ]))
+ yield
+ Use (
+ "httpMessage",
+ SynExpr.New (
+ false,
+ SynType.CreateLongIdent (
+ SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpRequestMessage" ]
+ ),
+ httpReqMessageConstructor,
+ range0
+ )
+ )
+ (*
+ if not bodyParams.IsEmpty then
+ yield
+ Use (
+ "queryParams",
+ SynExpr.New (
+ false,
+ SynType.CreateLongIdent (
+ SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
+ ),
+ SynExpr.CreateParen (failwith "TODO"),
+ range0
+ )
+ )
+
+ yield
+ Do (
+ SynExpr.LongIdentSet (
+ SynLongIdent.Create [ "httpMessage" ; "Content" ],
+ SynExpr.CreateIdentString "queryParams",
+ range0
+ )
+ )
+ *)
+ yield
+ LetBang (
+ "response",
+ SynExpr.awaitTask (
+ SynExpr.CreateApp (
+ SynExpr.CreateLongIdent (SynLongIdent.Create [ "client" ; "SendAsync" ]),
+ SynExpr.CreateParenedTuple
+ [ SynExpr.CreateIdentString "httpMessage" ; SynExpr.CreateIdentString "ct" ]
+ )
+ )
+ )
+ yield
+ Let (
+ "response",
+ SynExpr.CreateApp (
+ SynExpr.CreateLongIdent (SynLongIdent.Create [ "response" ; "EnsureSuccessStatusCode" ]),
+ SynExpr.CreateConst SynConst.Unit
+ )
+ )
+ yield
+ LetBang (
+ "stream",
+ SynExpr.awaitTask (
+ SynExpr.CreateApp (
+ SynExpr.CreateLongIdent (
+ SynLongIdent.Create [ "response" ; "Content" ; "ReadAsStreamAsync" ]
+ ),
+ SynExpr.CreateIdentString "ct"
+ )
+ )
+ )
+ yield
+ LetBang (
+ "node",
+ SynExpr.awaitTask (
+ SynExpr.CreateApp (
+ SynExpr.CreateLongIdent (
+ SynLongIdent.Create
+ [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ]
+ ),
+ SynExpr.CreateParenedTuple
+ [
+ SynExpr.CreateIdentString "stream"
+ SynExpr.equals
+ (SynExpr.CreateIdentString "cancellationToken")
+ (SynExpr.CreateIdentString "ct")
+ ]
+ )
+ )
+ )
+ ]
+ |> SynExpr.createCompExpr "async" returnExpr
+ |> SynExpr.startAsTask
+
+ SynMemberDefn.Member (
+ SynBinding.SynBinding (
+ None,
+ SynBindingKind.Normal,
+ false,
+ false,
+ [],
+ PreXmlDoc.Empty,
+ valData,
+ headPat,
+ None,
+ implementation,
+ range0,
+ DebugPointAtBinding.Yes range0,
+ synBindingTriviaZero true
+ ),
+ range0
+ )
+
+ let rec convertSigParam (ty : SynType) : Parameter =
+ match ty with
+ | SynType.Paren (inner, _) -> convertSigParam inner
+ | SynType.SignatureParameter (attrs, opt, id, usedType, _) ->
+ let attrs =
+ attrs
+ |> List.collect (fun attrs ->
+ attrs.Attributes
+ |> List.choose (fun attr ->
+ match attr.TypeName.AsString with
+ | "Query"
+ | "QueryAttribute" ->
+ match attr.ArgExpr with
+ | SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Query None)
+ | SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
+ Some (HttpAttribute.Query (Some s))
+ | SynExpr.Const (a, _) ->
+ failwithf "unrecognised constant arg to the Query attribute: %+A" a
+ | _ -> None
+ | "Path"
+ | "PathAttribute" ->
+ match attr.ArgExpr with
+ | SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) ->
+ Some (HttpAttribute.Path s)
+ | SynExpr.Const (a, _) ->
+ failwithf "unrecognised constant arg to the Path attribute: %+A" a
+ | _ -> None
+ | "Body"
+ | "BodyAttribute" ->
+ match attr.ArgExpr with
+ | SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Body)
+ | SynExpr.Const (a, _) ->
+ failwithf "unrecognised constant arg to the Body attribute: %+A" a
+ | _ -> None
+ | _ -> None
+ )
+ )
+
+ {
+ Attributes = attrs
+ IsOptional = opt
+ Id = id
+ Type = usedType
+ }
+ | _ -> failwithf "expected SignatureParameter, got: %+A" ty
+
+ let rec extractTypes (tupleType : SynTupleTypeSegment list) : Parameter list =
+ match tupleType with
+ | [] -> []
+ | [ SynTupleTypeSegment.Type param ] -> [ convertSigParam param ]
+ | SynTupleTypeSegment.Type param :: SynTupleTypeSegment.Star _ :: rest ->
+ convertSigParam param :: extractTypes rest
+ | _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType
+
+ let createModule
+ (opens : SynOpenDeclTarget list)
+ (ns : LongIdent)
+ (interfaceType : SynTypeDefn)
+ : SynModuleOrNamespace
+ =
+ let (SynTypeDefn (SynComponentInfo (_, _, _, interfaceName, _, _, _, _), synTypeDefnRepr, _, _, _, _)) =
+ interfaceType
+
+ let members =
+ match synTypeDefnRepr with
+ | SynTypeDefnRepr.ObjectModel (_kind, members, _) ->
+ members
+ |> List.map (fun defn ->
+ match defn with
+ | SynMemberDefn.AbstractSlot (slotSig, flags, _, _) ->
+ match flags.MemberKind with
+ | SynMemberKind.Member -> ()
+ | kind -> failwithf "Unrecognised member kind: %+A" kind
+
+ if not flags.IsInstance then
+ failwith "member was not an instance member"
+
+ match slotSig with
+ | SynValSig (attrs,
+ SynIdent.SynIdent (ident, _),
+ _typeParams,
+ synType,
+ arity,
+ isInline,
+ isMutable,
+ _xmlDoc,
+ accessibility,
+ synExpr,
+ _,
+ _) ->
+ if isInline then
+ failwith "inline members not supported"
+
+ if isMutable then
+ failwith "mutable members not supported"
+
+ match accessibility with
+ | Some (SynAccess.Internal _)
+ | Some (SynAccess.Private _) -> failwith "only public members are supported"
+ | _ -> ()
+
+ match synExpr with
+ | Some _ -> failwith "literal members are not supported"
+ | None -> ()
+
+ let attrs = attrs |> List.collect (fun a -> a.Attributes)
+
+ let arity =
+ match arity with
+ | SynValInfo ([ curriedArgs ], SynArgInfo ([], false, _)) -> curriedArgs
+ | SynValInfo (curriedArgs, SynArgInfo ([], false, _)) ->
+ failwithf "only tupled arguments are supported, but got: %+A" curriedArgs
+ | SynValInfo (_, info) ->
+ failwithf
+ "only bare return values like `Task` are supported, but got: %+A"
+ info
+
+ let args, ret =
+ match synType with
+ | SynType.Fun (argType, Task returnType, _, _) -> argType, returnType
+ | _ ->
+ failwithf
+ "Expected a return type of a generic Task; bad signature was: %+A"
+ synType
+
+ let args =
+ match args with
+ | SynType.SignatureParameter _ -> [ convertSigParam args ]
+ | SynType.Tuple (false, path, _) -> extractTypes path
+ | _ -> failwithf "Unrecognised args in interface method declaration: %+A" args
+
+ let httpMethod, url = extractHttpInformation attrs
+
+ {
+ HttpMethod = httpMethod
+ UrlTemplate = url
+ ReturnType = ret
+ Arity = arity
+ Args = args
+ Identifier = ident
+ }
+ | _ -> failwithf "Unrecognised member definition: %+A" defn
+ )
+ | _ -> failwithf "Unrecognised SynTypeDefnRepr: %+A" synTypeDefnRepr
+
+ let constructed = members |> List.map constructMember
+ let docString = PreXmlDoc.Create " Module for constructing a REST client."
+
+ let interfaceImpl =
+ SynExpr.ObjExpr (
+ SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceName),
+ None,
+ Some range0,
+ [],
+ constructed,
+ [],
+ range0,
+ range0
+ )
+
+ let createFunc =
+ SynBinding.SynBinding (
+ None,
+ SynBindingKind.Normal,
+ false,
+ false,
+ [],
+ PreXmlDoc.Create " Create a REST client.",
+ SynValData.SynValData (
+ None,
+ SynValInfo.SynValInfo (
+ [ [ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "client")) ] ],
+ SynArgInfo.Empty
+ ),
+ None
+ ),
+ SynPat.CreateLongIdent (
+ SynLongIdent.CreateString "make",
+ [
+ SynPat.CreateParen (
+ SynPat.CreateTyped (
+ SynPat.CreateNamed (Ident.Create "client"),
+ SynType.CreateLongIdent (
+ SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "HttpClient" ]
+ )
+ )
+ )
+ ]
+ ),
+ Some (SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceName))),
+ interfaceImpl,
+ range0,
+ DebugPointAtBinding.NoneAtLet,
+ synBindingTriviaZero false
+ )
+ |> List.singleton
+ |> SynModuleDecl.CreateLet
+
+ let moduleName : LongIdent =
+ List.last interfaceName
+ |> fun ident -> ident.idText
+ |> fun s ->
+ if s.StartsWith 'I' then
+ s.[1..]
+ else
+ failwithf "Expected interface type to start with 'I', but was: %s" s
+ |> Ident.Create
+ |> List.singleton
+
+ let attribs =
+ [
+ SynAttributeList.Create SynAttribute.compilationRepresentation
+ SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
+ ]
+
+ let modInfo =
+ SynComponentInfo.Create (moduleName, attributes = attribs, xmldoc = docString)
+
+ SynModuleOrNamespace.CreateNamespace (
+ ns,
+ decls =
+ [
+ for openStatement in opens do
+ yield SynModuleDecl.CreateOpen openStatement
+ yield SynModuleDecl.CreateNestedModule (modInfo, [ createFunc ])
+ ]
+ )
+
+ let rec extractOpens (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
+ moduleDecls
+ |> List.choose (fun moduleDecl ->
+ match moduleDecl with
+ | SynModuleDecl.Open (target, _) -> Some target
+ | other -> None
+ )
/// Myriad generator that provides an HTTP client for an interface type using RestEase annotations.
[]
@@ -32,6 +695,15 @@ type HttpClientGenerator () =
let types = Ast.extractTypeDefn ast
+ let opens =
+ match ast with
+ | ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
+ modules
+ |> List.collect (fun (SynModuleOrNamespace (nsId, _, _, decls, _, _, _, _, _)) ->
+ HttpClientGenerator.extractOpens decls
+ )
+ | _ -> []
+
let namespaceAndTypes =
types
|> List.choose (fun (ns, types) ->
@@ -45,7 +717,7 @@ type HttpClientGenerator () =
|> List.collect (fun (ns, types) ->
types
|> List.map (fun interfaceType ->
- let clientModule = HttpClientGenerator.createModule ns interfaceType
+ let clientModule = HttpClientGenerator.createModule opens ns interfaceType
clientModule
)
)
diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs
index bbe5736..fc8bc01 100644
--- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs
+++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs
@@ -333,25 +333,10 @@ module internal JsonParseGenerator =
let decls = [ createMaker recordId recordFields ]
- let compilationRepresentation : SynAttribute =
- {
- TypeName = SynLongIdent.CreateString "CompilationRepresentation"
- ArgExpr =
- SynExpr.CreateLongIdent (
- false,
- SynLongIdent.Create [ "CompilationRepresentationFlags" ; "ModuleSuffix" ],
- None
- )
- |> SynExpr.CreateParen
- Target = None
- AppliesToGetterAndSetter = false
- Range = range0
- }
-
let attributes =
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
- SynAttributeList.Create compilationRepresentation
+ SynAttributeList.Create SynAttribute.compilationRepresentation
]
let xmlDoc =
diff --git a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs
index ea5cdc1..699718b 100644
--- a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs
+++ b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs
@@ -162,25 +162,10 @@ module internal RemoveOptionsGenerator =
createMaker [ Ident.Create "Short" ] recordId recordFields
]
- let compilationRepresentation : SynAttribute =
- {
- TypeName = SynLongIdent.CreateString "CompilationRepresentation"
- ArgExpr =
- SynExpr.CreateLongIdent (
- false,
- SynLongIdent.Create [ "CompilationRepresentationFlags" ; "ModuleSuffix" ],
- None
- )
- |> SynExpr.CreateParen
- Target = None
- AppliesToGetterAndSetter = false
- Range = range0
- }
-
let attributes =
[
SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
- SynAttributeList.Create compilationRepresentation
+ SynAttributeList.Create SynAttribute.compilationRepresentation
]
let xmlDoc =
diff --git a/WoofWare.Myriad.Plugins/SurfaceBaseline.txt b/WoofWare.Myriad.Plugins/SurfaceBaseline.txt
index cc20d17..4c171fc 100644
--- a/WoofWare.Myriad.Plugins/SurfaceBaseline.txt
+++ b/WoofWare.Myriad.Plugins/SurfaceBaseline.txt
@@ -1,3 +1,7 @@
+WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute
+WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit
+WoofWare.Myriad.Plugins.HttpClientGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
+WoofWare.Myriad.Plugins.HttpClientGenerator..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.JsonParseGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
diff --git a/WoofWare.Myriad.Plugins/SynAttribute.fs b/WoofWare.Myriad.Plugins/SynAttribute.fs
new file mode 100644
index 0000000..8d9f2fd
--- /dev/null
+++ b/WoofWare.Myriad.Plugins/SynAttribute.fs
@@ -0,0 +1,22 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.Syntax
+open Fantomas.FCS.Text.Range
+open Myriad.Core
+
+[]
+module internal SynAttribute =
+ let internal compilationRepresentation : SynAttribute =
+ {
+ TypeName = SynLongIdent.CreateString "CompilationRepresentation"
+ ArgExpr =
+ SynExpr.CreateLongIdent (
+ false,
+ SynLongIdent.Create [ "CompilationRepresentationFlags" ; "ModuleSuffix" ],
+ None
+ )
+ |> SynExpr.CreateParen
+ Target = None
+ AppliesToGetterAndSetter = false
+ Range = range0
+ }
diff --git a/WoofWare.Myriad.Plugins/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr.fs
index d1194a8..dafc6c7 100644
--- a/WoofWare.Myriad.Plugins/SynExpr.fs
+++ b/WoofWare.Myriad.Plugins/SynExpr.fs
@@ -6,6 +6,12 @@ open Myriad.Core
open Myriad.Core.Ast
open Fantomas.FCS.Text.Range
+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
+
[]
module internal SynExpr =
@@ -80,6 +86,22 @@ module internal SynExpr =
b
)
+ /// {a} + {b}
+ let plus (a : SynExpr) (b : SynExpr) =
+ SynExpr.CreateApp (
+ SynExpr.CreateAppInfix (
+ SynExpr.CreateLongIdent (
+ SynLongIdent.SynLongIdent (
+ Ident.CreateLong "op_Addition",
+ [],
+ [ Some (IdentTrivia.OriginalNotation "+") ]
+ )
+ ),
+ a
+ ),
+ b
+ )
+
let stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with
| SynExpr.Paren (expr, _, _, _) -> expr
@@ -156,3 +178,77 @@ module internal SynExpr =
let reraise : SynExpr =
SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit)
+
+ /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
+ let startAsTask (body : SynExpr) =
+ let lambda =
+ SynExpr.CreateApp (
+ SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]),
+ SynExpr.CreateParenedTuple
+ [
+ SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
+ equals
+ (SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
+ (SynExpr.CreateLongIdent (SynLongIdent.CreateString "ct"))
+ ]
+ )
+ |> createLambda "a"
+
+ pipeThroughFunction lambda body
+
+ /// {compExpr} { {lets} ; return {ret} }
+ let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
+ let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
+
+ let contents : SynExpr =
+ (retStatement, List.rev lets)
+ ||> List.fold (fun state binding ->
+ match binding with
+ | LetBang (lhs, rhs) ->
+ SynExpr.LetOrUseBang (
+ DebugPointAtBinding.Yes range0,
+ false,
+ true,
+ SynPat.CreateNamed (Ident.Create lhs),
+ rhs,
+ [],
+ state,
+ range0,
+ {
+ EqualsRange = Some range0
+ }
+ )
+ | Let (lhs, rhs) ->
+ SynExpr.LetOrUse (
+ false,
+ false,
+ [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
+ state,
+ range0,
+ {
+ SynExprLetOrUseTrivia.InKeyword = None
+ }
+ )
+ | Use (lhs, rhs) ->
+ SynExpr.LetOrUse (
+ false,
+ true,
+ [ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
+ state,
+ range0,
+ {
+ SynExprLetOrUseTrivia.InKeyword = None
+ }
+ )
+ | Do body -> SynExpr.Do (body, range0)
+ )
+
+ SynExpr.CreateApp (
+ SynExpr.CreateIdent (Ident.Create compExpr),
+ SynExpr.ComputationExpr (false, contents, range0)
+ )
+
+ /// {expr} |> Async.AwaitTask
+ let awaitTask (expr : SynExpr) : SynExpr =
+ expr
+ |> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ]))
diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
index 02994a1..af09f6e 100644
--- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
+++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
@@ -26,9 +26,10 @@
+
-
+
diff --git a/WoofWare.Myriad.Plugins/version.json b/WoofWare.Myriad.Plugins/version.json
index 5b7dc86..6b85091 100644
--- a/WoofWare.Myriad.Plugins/version.json
+++ b/WoofWare.Myriad.Plugins/version.json
@@ -1,7 +1,7 @@
{
- "version": "1.0",
+ "version": "1.1",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
"pathFilters": null
-}
+}
\ No newline at end of file