patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-05 12:08:46 +00:00
Code Issues Packages Projects Releases Wiki Activity

No-op refactor of SynExpr helpers (#20)

Browse Source
This commit is contained in:
Patrick Stevens
2023-12-28 11:17:05 +00:00
committed by GitHub
parent b2477dc0b4
commit 146554df72
7 changed files with 332 additions and 226 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ConsumePlugin/ConsumePlugin.fsproj
View File

@@ -22,12 +22,17 @@
<Compile Include="GeneratedPureGymDto.fs">
<MyriadFile>PureGymDto.fs</MyriadFile> <!--2-->
</Compile>
<None Include="RestApiExample.fs" />
<None Include="GeneratedRestClient.fs">
<MyriadFile>RestApiExample.fs</MyriadFile> <!--2-->
</None>
<None Include="..\runmyriad.sh">
<Link>runmyriad.sh</Link>
</None>
</ItemGroup>
<ItemGroup>
<PackageReference Include="RestEase" Version="1.6.4" />
<ProjectReference Include="..\WoofWare.Myriad.Plugins\WoofWare.Myriad.Plugins.fsproj" />
<PackageReference Include="Myriad.Sdk" Version="0.8.3" />
<PackageReference Include="Myriad.Core" Version="0.8.3" />

4
ConsumePlugin/GeneratedRestClient.fs Normal file
View File

@@ -0,0 +1,4 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------

68
ConsumePlugin/RestApiExample.fs Normal file
View File

@@ -0,0 +1,68 @@
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open RestEase
type IPureGymApi =
[<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
(*
[<Get "v1/member">]
abstract GetMember : unit -> Task<Member>
[<Get "v1/gyms/{gym_id}">]
abstract GetGym : [<Path "gym_id">] gymId : int -> Task<Gym>
[<Get "v1/member/activity">]
abstract GetMemberActivity : unit -> Task<MemberActivityDto>
[<Get "v2/gymSessions/member">]
abstract GetSessions : [<Query>] fromDate : DateTime -> [<Query>] toDate : DateTime -> Task<Sessions>
*)
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)
}

53
WoofWare.Myriad.Plugins/HttpClientGenerator.fs Normal file
View File

@@ -0,0 +1,53 @@
namespace WoofWare.Myriad.Plugins
open System
open System.Text
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
/// Attribute indicating a record type to which the "create HTTP client" Myriad
/// generator should apply during build.
type HttpClientAttribute () =
inherit Attribute ()
[<RequireQualifiedAccess>]
module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
let createModule (ns : LongIdent) (interfaceType : SynTypeDefn) : SynModuleOrNamespace = failwith ""
/// Myriad generator that provides an HTTP client for an interface type using RestEase annotations.
[<MyriadGenerator("http-client")>]
type HttpClientGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let types = Ast.extractTypeDefn ast
let namespaceAndTypes =
types
|> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<HttpClientAttribute> with
| [] -> None
| types -> Some (ns, types)
)
let modules =
namespaceAndTypes
|> List.collect (fun (ns, types) ->
types
|> List.map (fun interfaceType ->
let clientModule = HttpClientGenerator.createModule ns interfaceType
clientModule
)
)
Output.Ast modules

268
WoofWare.Myriad.Plugins/JsonParseGenerator.fs
View File

@@ -29,38 +29,9 @@ module internal JsonParseGenerator =
/// {node}.AsValue().GetValue<{typeName}> ()
let asValueGetValue (typeName : string) (node : SynExpr) : SynExpr =
let asValue =
SynExpr.CreateApp (
SynExpr.DotGet (
node,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.Create "AsValue" ], dotRanges = [], trivia = [ None ]),
range0
),
SynExpr.CreateConst SynConst.Unit
)
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (
asValue,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.Create "GetValue" ], dotRanges = [], trivia = [ None ]),
range0
),
range0,
[
SynType.LongIdent (
SynLongIdent.SynLongIdent (id = [ Ident.Create typeName ], dotRanges = [], trivia = [ None ])
)
],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
)
node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod "GetValue" typeName
/// {type}.jsonParse {node}
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
@@ -75,75 +46,20 @@ module internal JsonParseGenerator =
/// |> Seq.map (fun elt -> {body})
/// |> {collectionType}.ofSeq
let asArrayMapped (collectionType : string) (node : SynExpr) (body : SynExpr) : SynExpr =
let parsedDataPat = [ SynPat.CreateNamed (Ident.Create "elt") ]
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.LongIdent (
false,
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
),
None,
range0
),
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.LongIdent (
false,
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
),
None,
range0
),
SynExpr.CreateApp (
SynExpr.DotGet (node, range0, SynLongIdent.CreateString "AsArray", range0),
SynExpr.CreateConst SynConst.Unit
)
),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
SynExpr.CreateParen (
SynExpr.Lambda (
false,
false,
SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create "elt") ],
body,
Some (parsedDataPat, body),
range0,
{
ArrowRange = Some range0
}
)
)
)
)
),
SynExpr.CreateLongIdent (SynLongIdent.Create [ collectionType ; "ofSeq" ])
node
|> SynExpr.callMethod "AsArray"
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
SynExpr.createLambda "elt" body
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ collectionType ; "ofSeq" ]))
/// match {node} with | null -> None | v -> Some {body}
/// match {node} with | null -> None | v -> {body} |> Some
/// Use the variable `v` to get access to the `Some`.
let createParseLineOption (node : SynExpr) (body : SynExpr) : SynExpr =
let body =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
)
),
body
),
SynExpr.CreateIdentString "Some"
)
let body = SynExpr.pipeThroughFunction (SynExpr.CreateIdentString "Some") body
SynExpr.CreateMatch (
node,
@@ -153,112 +69,9 @@ module internal JsonParseGenerator =
]
)
let eltGetValue (elementType : string) : SynExpr =
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (
SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"),
range0,
SynLongIdent.Create [ "GetValue" ],
range0
),
range0,
[ SynType.CreateLongIdent elementType ],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
)
/// {expr} |> DateOnly.Parse
let pipeThroughFunction (ident : SynLongIdent) (expr : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
)
),
expr
),
SynExpr.CreateLongIdent ident
)
/// if {cond} then {trueBranch} else {falseBranch}
let ifThenElse (cond : SynExpr) (trueBranch : SynExpr) (falseBranch : SynExpr) : SynExpr =
SynExpr.IfThenElse (
cond,
trueBranch,
Some falseBranch,
DebugPointAtBinding.Yes range0,
false,
range0,
{
IfKeyword = range0
IsElif = false
ThenKeyword = range0
ElseKeyword = Some range0
IfToThenRange = range0
}
)
/// try {body} with | {exc} as exc -> {handler}
let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr =
let clause =
SynMatchClause.Create (SynPat.As (exc, SynPat.CreateNamed (Ident.Create "exc"), range0), None, handler)
SynExpr.TryWith (
body,
[ clause ],
range0,
DebugPointAtTry.Yes range0,
DebugPointAtWith.Yes range0,
{
TryKeyword = range0
TryToWithRange = range0
WithKeyword = range0
WithToEndRange = range0
}
)
/// {a} = {b}
let equals (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Equality",
[],
[ Some (IdentTrivia.OriginalNotation "=") ]
)
),
a
),
b
)
/// Given e.g. "float", returns "Double.Parse"
/// Given e.g. "float", returns "System.Double.Parse"
let parseFunction (typeName : string) : LongIdent =
match typeName with
| "float32" -> [ "System" ; "Single" ]
| "float" -> [ "System" ; "Double" ]
| "byte"
| "uint8" -> [ "System" ; "Byte" ]
| "sbyte" -> [ "System" ; "SByte" ]
| "int16" -> [ "System" ; "Int16" ]
| "int" -> [ "System" ; "Int32" ]
| "int64" -> [ "System" ; "Int64" ]
| "uint16" -> [ "System" ; "UInt16" ]
| "uint"
| "uint32" -> [ "System" ; "UInt32" ]
| "uint64" -> [ "System" ; "UInt64" ]
| _ -> failwith $"Unable to identify a parsing function `string -> %s{typeName}`"
|> fun a -> List.append a [ "Parse" ]
|> List.map Ident.Create
List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ]
/// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
let rec parseNode (options : JsonParseOption) (fieldType : SynType) (node : SynExpr) : SynExpr =
@@ -266,28 +79,38 @@ module internal JsonParseGenerator =
match fieldType with
| DateOnly ->
asValueGetValue "string" node
|> pipeThroughFunction (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
)
| DateTime ->
asValueGetValue "string" node
|> pipeThroughFunction (SynLongIdent.Create [ "System" ; "DateTime" ; "Parse" ])
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "DateTime" ; "Parse" ])
)
| NumberType typeName ->
let basic = asValueGetValue typeName node
match options.JsonNumberHandlingArg with
| None -> basic
| Some option ->
let reraise =
(SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit))
let cond =
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "exc" ; "Message" ; "Contains" ]),
SynExpr.CreateConst (SynConst.CreateString "cannot be converted to")
SynExpr.DotGet (
SynExpr.CreateIdentString "exc",
range0,
SynLongIdent.CreateString "Message",
range0
)
|> SynExpr.callMethodArg
"Contains"
(SynExpr.CreateConst (SynConst.CreateString "cannot be converted to"))
let trueBranch =
ifThenElse
(equals
let handler =
asValueGetValue "string" node
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (parseFunction typeName))
)
|> SynExpr.ifThenElse
(SynExpr.equals
option
(SynExpr.CreateLongIdent (
SynLongIdent.Create
@@ -300,14 +123,11 @@ module internal JsonParseGenerator =
"AllowReadingFromString"
]
)))
(asValueGetValue "string" node
|> pipeThroughFunction (SynLongIdent.CreateFromLongIdent (parseFunction typeName)))
reraise
let handler = ifThenElse cond trueBranch reraise
SynExpr.reraise
|> SynExpr.ifThenElse cond SynExpr.reraise
basic
|> pipeThroughTryWith
|> SynExpr.pipeThroughTryWith
(SynPat.IsInst (
SynType.LongIdent (SynLongIdent.Create [ "System" ; "InvalidOperationException" ]),
range0
@@ -335,14 +155,10 @@ module internal JsonParseGenerator =
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding).
let createParseRhs (options : JsonParseOption) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
SynExpr.DotIndexedGet (SynExpr.CreateIdentString "node", propertyName, range0, range0)
SynExpr.CreateIdentString "node"
|> SynExpr.index propertyName
|> parseNode options fieldType
let stripOptionalParen (expr : SynExpr) =
match expr with
| SynExpr.Paren (expr, _, _, _) -> expr
| expr -> expr
let isJsonNumberHandling (literal : LongIdent) : bool =
match List.rev literal |> List.map (fun ident -> ident.idText) with
| [ _ ; "JsonNumberHandling" ]
@@ -389,7 +205,7 @@ module internal JsonParseGenerator =
||> List.fold (fun options attr ->
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
let qualifiedEnumValue =
match stripOptionalParen attr.ArgExpr with
match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
isJsonNumberHandling ident
->

158
WoofWare.Myriad.Plugins/SynExpr.fs Normal file
View File

@@ -0,0 +1,158 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Myriad.Core
open Myriad.Core.Ast
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynExpr =
/// {expr} |> {func}
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
)
),
expr
),
func
)
/// if {cond} then {trueBranch} else {falseBranch}
/// Note that this function puts the trueBranch last, for pipelining convenience:
/// we assume that the `else` branch is more like an error case and is less interesting.
let ifThenElse (cond : SynExpr) (falseBranch : SynExpr) (trueBranch : SynExpr) : SynExpr =
SynExpr.IfThenElse (
cond,
trueBranch,
Some falseBranch,
DebugPointAtBinding.Yes range0,
false,
range0,
{
IfKeyword = range0
IsElif = false
ThenKeyword = range0
ElseKeyword = Some range0
IfToThenRange = range0
}
)
/// try {body} with | {exc} as exc -> {handler}
let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr =
let clause =
SynMatchClause.Create (SynPat.As (exc, SynPat.CreateNamed (Ident.Create "exc"), range0), None, handler)
SynExpr.TryWith (
body,
[ clause ],
range0,
DebugPointAtTry.Yes range0,
DebugPointAtWith.Yes range0,
{
TryKeyword = range0
TryToWithRange = range0
WithKeyword = range0
WithToEndRange = range0
}
)
/// {a} = {b}
let equals (a : SynExpr) (b : SynExpr) =
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Equality",
[],
[ Some (IdentTrivia.OriginalNotation "=") ]
)
),
a
),
b
)
let stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with
| SynExpr.Paren (expr, _, _, _) -> expr
| expr -> expr
/// Given e.g. "byte", returns "System.Byte".
let qualifyPrimitiveType (typeName : string) : LongIdent =
match typeName with
| "float32" -> [ "System" ; "Single" ]
| "float" -> [ "System" ; "Double" ]
| "byte"
| "uint8" -> [ "System" ; "Byte" ]
| "sbyte" -> [ "System" ; "SByte" ]
| "int16" -> [ "System" ; "Int16" ]
| "int" -> [ "System" ; "Int32" ]
| "int64" -> [ "System" ; "Int64" ]
| "uint16" -> [ "System" ; "UInt16" ]
| "uint"
| "uint32" -> [ "System" ; "UInt32" ]
| "uint64" -> [ "System" ; "UInt64" ]
| _ -> failwith $"Unable to identify a parsing function `string -> %s{typeName}`"
|> List.map Ident.Create
/// {obj}.{meth} {arg}
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.DotGet (
obj,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]),
range0
),
arg
)
/// {obj}.{meth}()
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
/// {obj}.{meth}<ty>()
let callGenericMethod (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
range0,
[ SynType.CreateLongIdent ty ],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
)
let index (property : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (obj, property, range0, range0)
/// (fun {varName} -> {body})
let createLambda (varName : string) (body : SynExpr) : SynExpr =
let parsedDataPat = [ SynPat.CreateNamed (Ident.Create varName) ]
SynExpr.Lambda (
false,
false,
SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create varName) ],
body,
Some (parsedDataPat, body),
range0,
{
ArrowRange = Some range0
}
)
|> SynExpr.CreateParen
let reraise : SynExpr =
SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit)

2
WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
View File

@@ -25,8 +25,10 @@
<ItemGroup>
<Compile Include="AstHelper.fs" />
<Compile Include="SynExpr.fs" />
<Compile Include="RemoveOptionsGenerator.fs" />
<Compile Include="JsonParseGenerator.fs" />
<None Include="HttpClientGenerator.fs" />
<None Include="version.json" />
<EmbeddedResource Include="SurfaceBaseline.txt" />
<None Include="..\README.md">