mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-11 23:18:43 +00:00
Allow JSON parsing to happen in an extension method (#63)
This commit is contained in:
Patrick Stevens
GitHub
@@ -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
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
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.
|
||||
[<MyriadGenerator("json-parse")>]
|
||||
type JsonParseGenerator () =
|
||||
|
||||
@@ -429,17 +524,37 @@ type JsonParseGenerator () =
|
||||
let namespaceAndRecords =
|
||||
records
|
||||
|> List.choose (fun (ns, types) ->
|
||||
match types |> List.filter Ast.hasAttribute<JsonParseAttribute> with
|
||||
| [] -> None
|
||||
| types -> Some (ns, types)
|
||||
types
|
||||
|> List.choose (fun typeDef ->
|
||||
match Ast.getAttribute<JsonParseAttribute> 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 [<JsonParseAttribute>]. 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
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user