diff --git a/ConsumePlugin/GeneratedJson.fs b/ConsumePlugin/GeneratedJson.fs index 16f4e36..8c1486a 100644 --- a/ConsumePlugin/GeneratedJson.fs +++ b/ConsumePlugin/GeneratedJson.fs @@ -108,3 +108,68 @@ module JsonRecordType = E = E F = F } +namespace ConsumePlugin + +/// Module containing JSON parsing extension members for the ToGetExtensionMethod type +[] +module ToGetExtensionMethodJsonParseExtension = + ///Extension methods for JSON parsing + type ToGetExtensionMethod with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod = + let Sailor = + (match node.["sailor"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("sailor") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + let Soldier = + (match node.["soldier"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("soldier") + ) + ) + | v -> v) + .AsValue() + .GetValue () + |> System.Uri + + let Tailor = + (match node.["tailor"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("tailor") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + let Tinker = + (match node.["tinker"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("tinker") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + { + Tinker = Tinker + Tailor = Tailor + Soldier = Soldier + Sailor = Sailor + } diff --git a/ConsumePlugin/JsonRecord.fs b/ConsumePlugin/JsonRecord.fs index 371e2df..b78502c 100644 --- a/ConsumePlugin/JsonRecord.fs +++ b/ConsumePlugin/JsonRecord.fs @@ -28,3 +28,16 @@ type JsonRecordType = E : string array F : int[] } + +[] +type ToGetExtensionMethod = + { + Tinker : string + Tailor : int + Soldier : System.Uri + Sailor : float + } + +[] +module ToGetExtensionMethod = + let thisModuleWouldClash = 3 diff --git a/Directory.Build.props b/Directory.Build.props index e9f58d0..2bc68d8 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -6,8 +6,8 @@ true true true - FS3559 embedded + FS3388,FS3559 diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestExtensionMethod.fs b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestExtensionMethod.fs new file mode 100644 index 0000000..610d003 --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestExtensionMethod.fs @@ -0,0 +1,26 @@ +namespace WoofWare.Myriad.Plugins.Test + +open System +open System.Text.Json.Nodes +open ConsumePlugin +open NUnit.Framework +open FsUnitTyped + +[] +module TestExtensionMethod = + + [] + let ``Parse via extension method`` () = + let json = + """{"tinker": "job", "tailor": 3, "soldier": "https://example.com", "sailor": 3.1}""" + |> JsonNode.Parse + + let expected = + { + Tinker = "job" + Tailor = 3 + Soldier = Uri "https://example.com" + Sailor = 3.1 + } + + ToGetExtensionMethod.jsonParse json |> shouldEqual expected diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs index f8b4009..2cae6ef 100644 --- a/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs +++ b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs @@ -32,3 +32,18 @@ module TestJsonParse = let actual = s |> JsonNode.Parse |> JsonRecordType.jsonParse actual |> shouldEqual expected + + [] + let ``Inner example`` () = + let s = + """{ + "something": "oh hi" +}""" + + let expected = + { + Thing = "oh hi" + } + + let actual = s |> JsonNode.Parse |> InnerType.jsonParse + actual |> shouldEqual expected diff --git a/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs b/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs index 7da125d..612d48e 100644 --- a/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs +++ b/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs @@ -14,6 +14,7 @@ module TestMockGenerator = { PublicTypeMock.Empty with Mem1 = fun (s, count) -> List.replicate count s } + :> _ let _ = Assert.Throws (fun () -> mock.Mem2 "hi" |> ignore) @@ -28,6 +29,7 @@ module TestMockGenerator = Mem2 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s) Mem3 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s) } + :> _ mock.Mem1 3 'a' |> shouldEqual "aaa" mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi" diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index a4c81e6..b6b5910 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -11,6 +11,7 @@ + diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs index 5121add..8756c0a 100644 --- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs @@ -9,11 +9,26 @@ open Myriad.Core /// Attribute indicating a record type to which the "Add JSON parse" Myriad /// generator should apply during build. -/// The purpose of this generator is to create methods of the form +/// The purpose of this generator is to create methods (possibly extension methods) of the form /// `{TypeName}.jsonParse : System.Text.Json.Nodes.JsonNode -> {TypeName}`. -type JsonParseAttribute () = +/// +/// If you supply isExtensionMethod = true, you will get extension methods. +/// These can only be consumed from F#, but the benefit is that they don't use up the module name +/// (since by default we create a module called "{TypeName}"). +type JsonParseAttribute (isExtensionMethod : bool) = inherit Attribute () + /// If changing this, *adjust the documentation strings* + static member internal DefaultIsExtensionMethod = false + + /// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details. + new () = JsonParseAttribute JsonParseAttribute.DefaultIsExtensionMethod + +type internal JsonParseOutputSpec = + { + ExtensionMethods : bool + } + [] module internal JsonParseGenerator = open Fantomas.FCS.Text.Range @@ -227,7 +242,7 @@ module internal JsonParseGenerator = | [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true | _ -> false - let createMaker (typeName : LongIdent) (fields : SynField list) = + let createMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynField list) = let xmlDoc = PreXmlDoc.Create " Parse from a JSON node." let returnInfo = @@ -237,10 +252,26 @@ module internal JsonParseGenerator = let functionName = Ident.Create "jsonParse" let inputVal = + let memberFlags = + if spec.ExtensionMethods then + { + SynMemberFlags.IsInstance = false + SynMemberFlags.IsDispatchSlot = false + SynMemberFlags.IsOverrideOrExplicitImpl = false + SynMemberFlags.IsFinal = false + SynMemberFlags.GetterOrSetterIsCompilerGenerated = false + SynMemberFlags.MemberKind = SynMemberKind.Member + } + |> Some + else + None + + let thisIdOpt = if spec.ExtensionMethods then None else Some inputArg + SynValData.SynValData ( - None, + memberFlags, SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty), - Some inputArg + thisIdOpt ) let assignments = @@ -367,20 +398,60 @@ module internal JsonParseGenerator = range0 ) - let binding = - SynBinding.Let ( - isInline = false, - isMutable = false, - xmldoc = xmlDoc, - returnInfo = returnInfo, - expr = assignments, - valData = inputVal, - pattern = pattern - ) + if spec.ExtensionMethods then + let binding = + SynBinding.SynBinding ( + None, + SynBindingKind.Normal, + false, + false, + [], + xmlDoc, + inputVal, + pattern, + Some returnInfo, + assignments, + range0, + DebugPointAtBinding.NoneAtInvisible, + { + LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0) + InlineKeyword = None + EqualsRange = Some range0 + } + ) - SynModuleDecl.CreateLet [ binding ] + let mem = SynMemberDefn.Member (binding, range0) - let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) = + let containingType = + SynTypeDefn.SynTypeDefn ( + SynComponentInfo.Create (typeName, xmldoc = PreXmlDoc.Create "Extension methods for JSON parsing"), + SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0), + [ mem ], + None, + range0, + { + LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0 + EqualsRange = None + WithKeyword = None + } + ) + + SynModuleDecl.Types ([ containingType ], range0) + else + let binding = + SynBinding.Let ( + isInline = false, + isMutable = false, + xmldoc = xmlDoc, + returnInfo = returnInfo, + expr = assignments, + valData = inputVal, + pattern = pattern + ) + + SynModuleDecl.CreateLet [ binding ] + + let createRecordModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) = let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = typeDefn @@ -390,30 +461,54 @@ module internal JsonParseGenerator = match synTypeDefnRepr with | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) -> - let decls = [ createMaker recordId recordFields ] + let decls = [ createMaker spec recordId recordFields ] let attributes = - [ - SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) - SynAttributeList.Create SynAttribute.compilationRepresentation - ] + if spec.ExtensionMethods then + [ SynAttributeList.Create SynAttribute.autoOpen ] + else + [ + SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) + SynAttributeList.Create SynAttribute.compilationRepresentation + ] let xmlDoc = - recordId - |> Seq.map (fun i -> i.idText) - |> String.concat "." - |> sprintf " Module containing JSON parsing methods for the %s type" + let fullyQualified = recordId |> Seq.map (fun i -> i.idText) |> String.concat "." + + let description = + if spec.ExtensionMethods then + "extension members" + else + "methods" + + $" Module containing JSON parsing %s{description} for the %s{fullyQualified} type" |> PreXmlDoc.Create + let moduleName = + if spec.ExtensionMethods then + match recordId with + | [] -> failwith "unexpectedly got an empty identifier for record name" + | recordId -> + let expanded = + List.last recordId + |> fun i -> i.idText + |> fun s -> s + "JsonParseExtension" + |> Ident.Create + + List.take (List.length recordId - 1) recordId @ [ expanded ] + else + recordId + let info = - SynComponentInfo.Create (recordId, attributes = attributes, xmldoc = xmlDoc) + SynComponentInfo.Create (moduleName, attributes = attributes, xmldoc = xmlDoc) let mdl = SynModuleDecl.CreateNestedModule (info, decls) SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ]) | _ -> failwithf "Not a record type" -/// Myriad generator that provides a JSON parse function for a record type. +/// Myriad generator that provides a method (possibly an extension method) for a record type, +/// containing a JSON parse function. [] type JsonParseGenerator () = @@ -429,17 +524,37 @@ type JsonParseGenerator () = let namespaceAndRecords = records |> List.choose (fun (ns, types) -> - match types |> List.filter Ast.hasAttribute with - | [] -> None - | types -> Some (ns, types) + types + |> List.choose (fun typeDef -> + match Ast.getAttribute typeDef with + | None -> None + | Some attr -> + let arg = + match SynExpr.stripOptionalParen attr.ArgExpr with + | SynExpr.Const (SynConst.Bool value, _) -> value + | SynExpr.Const (SynConst.Unit, _) -> JsonParseAttribute.DefaultIsExtensionMethod + | arg -> + failwith + $"Unrecognised argument %+A{arg} to []. Literals are not supported. Use `true` or `false` (or unit) only." + + let spec = + { + ExtensionMethods = arg + } + + Some (typeDef, spec) + ) + |> function + | [] -> None + | ty -> Some (ns, ty) ) let modules = namespaceAndRecords |> List.collect (fun (ns, records) -> records - |> List.map (fun record -> - let recordModule = JsonParseGenerator.createRecordModule ns record + |> List.map (fun (record, spec) -> + let recordModule = JsonParseGenerator.createRecordModule ns spec record recordModule ) ) diff --git a/WoofWare.Myriad.Plugins/SurfaceBaseline.txt b/WoofWare.Myriad.Plugins/SurfaceBaseline.txt index a035237..7491d1d 100644 --- a/WoofWare.Myriad.Plugins/SurfaceBaseline.txt +++ b/WoofWare.Myriad.Plugins/SurfaceBaseline.txt @@ -7,6 +7,7 @@ WoofWare.Myriad.Plugins.HttpClientGenerator..ctor [constructor]: unit WoofWare.Myriad.Plugins.InterfaceMockGenerator inherit obj, implements Myriad.Core.IMyriadGenerator WoofWare.Myriad.Plugins.InterfaceMockGenerator..ctor [constructor]: unit WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute +WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit WoofWare.Myriad.Plugins.JsonParseGenerator inherit obj, implements Myriad.Core.IMyriadGenerator WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit diff --git a/WoofWare.Myriad.Plugins/SynAttribute.fs b/WoofWare.Myriad.Plugins/SynAttribute.fs index 8d9f2fd..b0958b9 100644 --- a/WoofWare.Myriad.Plugins/SynAttribute.fs +++ b/WoofWare.Myriad.Plugins/SynAttribute.fs @@ -20,3 +20,12 @@ module internal SynAttribute = AppliesToGetterAndSetter = false Range = range0 } + + let internal autoOpen : SynAttribute = + { + TypeName = SynLongIdent.CreateString "AutoOpen" + ArgExpr = SynExpr.CreateConst SynConst.Unit + Target = None + AppliesToGetterAndSetter = false + Range = range0 + } diff --git a/WoofWare.Myriad.Plugins/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr.fs index 968f397..cde2731 100644 --- a/WoofWare.Myriad.Plugins/SynExpr.fs +++ b/WoofWare.Myriad.Plugins/SynExpr.fs @@ -102,9 +102,9 @@ module internal SynExpr = b ) - let stripOptionalParen (expr : SynExpr) : SynExpr = + let rec stripOptionalParen (expr : SynExpr) : SynExpr = match expr with - | SynExpr.Paren (expr, _, _, _) -> expr + | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr | expr -> expr /// Given e.g. "byte", returns "System.Byte". diff --git a/WoofWare.Myriad.Plugins/version.json b/WoofWare.Myriad.Plugins/version.json index 63f3e25..dd79bd9 100644 --- a/WoofWare.Myriad.Plugins/version.json +++ b/WoofWare.Myriad.Plugins/version.json @@ -1,5 +1,5 @@ { - "version": "1.2", + "version": "1.3", "publicReleaseRefSpec": [ "^refs/heads/main$" ],