mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-08 13:38:39 +00:00
Parse numbers from strings, implement general recursion (#12)
This commit is contained in:
Patrick Stevens
GitHub
@@ -24,15 +24,24 @@ namespace ConsumePlugin
|
||||
module JsonRecordType =
|
||||
/// Parse from a JSON node.
|
||||
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordType =
|
||||
let F =
|
||||
node.["f"].AsArray ()
|
||||
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|
||||
|> Array.ofSeq
|
||||
|
||||
let E =
|
||||
node.["e"].AsArray ()
|
||||
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|
||||
|> Array.ofSeq
|
||||
|
||||
let D = InnerType.jsonParse node.["d"]
|
||||
|
||||
let C =
|
||||
node.["hi"].AsArray ()
|
||||
|> Seq.map (fun elt -> elt.GetValue<int> ())
|
||||
|> Seq.map (fun elt -> elt.AsValue().GetValue<int> ())
|
||||
|> List.ofSeq
|
||||
|
||||
let B2 = node.["another-thing"].AsValue ()
|
||||
let B = B2.GetValue<string> ()
|
||||
let B = node.["another-thing"].AsValue().GetValue<string> ()
|
||||
let A = node.["a"].AsValue().GetValue<int> ()
|
||||
|
||||
{
|
||||
@@ -40,4 +49,6 @@ module JsonRecordType =
|
||||
B = B
|
||||
C = C
|
||||
D = D
|
||||
E = E
|
||||
F = F
|
||||
}
|
||||
|
||||
@@ -25,4 +25,6 @@ type JsonRecordType =
|
||||
[<System.Text.Json.Serialization.JsonPropertyName "hi">]
|
||||
C : int list
|
||||
D : InnerType
|
||||
E : string array
|
||||
F : int[]
|
||||
}
|
||||
|
||||
@@ -12,7 +12,8 @@ module TestJsonParse =
|
||||
let s =
|
||||
"""
|
||||
{
|
||||
"a": 3, "another-thing": "hello", "hi": [6, 1], "d": {"something": "oh hi"}
|
||||
"a": 3, "another-thing": "hello", "hi": [6, 1], "d": {"something": "oh hi"},
|
||||
"e": ["something", "else"], "f": []
|
||||
}
|
||||
"""
|
||||
|
||||
@@ -25,6 +26,8 @@ module TestJsonParse =
|
||||
{
|
||||
Thing = "oh hi"
|
||||
}
|
||||
E = [| "something" ; "else" |]
|
||||
F = [||]
|
||||
}
|
||||
|
||||
let actual = s |> JsonNode.Parse |> JsonRecordType.jsonParse
|
||||
|
||||
@@ -62,6 +62,19 @@ module internal AstHelper =
|
||||
// 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
|
||||
// TODO: consider FSharpList or whatever it is
|
||||
| [ i ] ->
|
||||
printfn $"Not array: %s{i.idText}"
|
||||
false
|
||||
| _ -> false
|
||||
|
||||
[<AutoOpen>]
|
||||
module internal SynTypePatterns =
|
||||
let (|OptionType|_|) (fieldType : SynType) =
|
||||
@@ -76,11 +89,50 @@ module internal SynTypePatterns =
|
||||
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
|
||||
|
||||
/// Returns the string name of the type.
|
||||
let (|PrimitiveType|_|) (fieldType : SynType) =
|
||||
match fieldType with
|
||||
| SynType.LongIdent ident ->
|
||||
match ident.LongIdent with
|
||||
| [ i ] -> [ "string" ; "float" ; "int" ] |> List.tryFind (fun s -> s = i.idText)
|
||||
| [ i ] -> [ "string" ; "float" ; "int" ; "bool" ] |> List.tryFind (fun s -> s = i.idText)
|
||||
| _ -> 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 ident ->
|
||||
match ident.LongIdent with
|
||||
| [ i ] ->
|
||||
if i.idText = "System.DateOnly" || i.idText = "DateOnly" then
|
||||
Some ()
|
||||
else
|
||||
None
|
||||
| _ -> 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
|
||||
| _ -> None
|
||||
| _ -> None
|
||||
|
||||
@@ -17,23 +17,33 @@ module internal JsonParseGenerator =
|
||||
open Fantomas.FCS.Text.Range
|
||||
open Myriad.Core.Ast
|
||||
|
||||
let createParseLineValue (propertyName : SynExpr) (typeName : string) : SynExpr =
|
||||
// node.["town"].AsValue().GetValue<string> ()
|
||||
let indexed =
|
||||
type JsonParseOption =
|
||||
{
|
||||
JsonNumberHandlingArg : SynExpr option
|
||||
}
|
||||
|
||||
static member None =
|
||||
{
|
||||
JsonNumberHandlingArg = None
|
||||
}
|
||||
|
||||
/// {node}.AsValue().GetValue<{typeName}> ()
|
||||
let asValueGetValue (typeName : string) (node : SynExpr) : SynExpr =
|
||||
let asValue =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.DotGet (
|
||||
SynExpr.DotIndexedGet (SynExpr.Ident (Ident.Create "node"), propertyName, range0, range0),
|
||||
node,
|
||||
range0,
|
||||
SynLongIdent.SynLongIdent (id = [ Ident.Create "AsValue" ], dotRanges = [], trivia = [ None ]),
|
||||
range0
|
||||
),
|
||||
SynExpr.CreateConst (SynConst.Unit)
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
)
|
||||
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.TypeApp (
|
||||
SynExpr.DotGet (
|
||||
indexed,
|
||||
asValue,
|
||||
range0,
|
||||
SynLongIdent.SynLongIdent (id = [ Ident.Create "GetValue" ], dotRanges = [], trivia = [ None ]),
|
||||
range0
|
||||
@@ -52,27 +62,98 @@ module internal JsonParseGenerator =
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
)
|
||||
|
||||
let createParseLineCallThrough (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
|
||||
// Type.jsonParse node.["town"]
|
||||
let typeName =
|
||||
match fieldType with
|
||||
| SynType.LongIdent ident -> ident.LongIdent
|
||||
| _ -> failwith $"Unrecognised type: %+A{fieldType}"
|
||||
|
||||
/// {type}.jsonParse {node}
|
||||
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateLongIdent (SynLongIdent.CreateFromLongIdent (typeName @ [ Ident.Create "jsonParse" ])),
|
||||
SynExpr.DotIndexedGet (SynExpr.CreateIdentString "node", propertyName, range0, range0)
|
||||
node
|
||||
)
|
||||
|
||||
/// collectionType is e.g. "List"; we'll be calling `ofSeq` on it.
|
||||
let createParseLineList (collectionType : string) (propertyName : SynExpr) (elementType : string) : SynExpr =
|
||||
// node.["openingHours"].AsArray()
|
||||
// |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|
||||
// |> List.ofSeq
|
||||
|
||||
/// body is the body of a lambda which takes a parameter `elt`.
|
||||
/// {node}.AsArray()
|
||||
/// |> Seq.map (fun elt -> {body})
|
||||
/// |> {collectionType}.ofSeq
|
||||
let asArrayMapped (collectionType : string) (node : SynExpr) (body : SynExpr) : SynExpr =
|
||||
let parsedDataPat = [ SynPat.CreateNamed (Ident.Create "elt") ]
|
||||
|
||||
let parsedData =
|
||||
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" ])
|
||||
)
|
||||
|
||||
/// match {node} with | null -> None | v -> Some {body}
|
||||
/// 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"
|
||||
)
|
||||
|
||||
SynExpr.CreateMatch (
|
||||
node,
|
||||
[
|
||||
SynMatchClause.Create (SynPat.CreateNull, None, SynExpr.CreateIdent (Ident.Create "None"))
|
||||
SynMatchClause.Create (SynPat.CreateNamed (Ident.Create "v"), None, body)
|
||||
]
|
||||
)
|
||||
|
||||
let eltGetValue (elementType : string) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.TypeApp (
|
||||
SynExpr.DotGet (
|
||||
@@ -91,95 +172,185 @@ module internal JsonParseGenerator =
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
)
|
||||
|
||||
/// {expr} |> DateOnly.Parse
|
||||
let pipeThroughFunction (ident : SynLongIdent) (expr : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.LongIdent (
|
||||
false,
|
||||
SynExpr.CreateLongIdent (
|
||||
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 (
|
||||
SynExpr.DotIndexedGet (
|
||||
SynExpr.CreateIdent (Ident.Create "node"),
|
||||
propertyName,
|
||||
range0,
|
||||
range0
|
||||
),
|
||||
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") ],
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.TypeApp (
|
||||
SynExpr.DotGet (
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"),
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
expr
|
||||
),
|
||||
range0,
|
||||
SynLongIdent.CreateString "GetValue",
|
||||
range0
|
||||
),
|
||||
range0,
|
||||
[ SynType.CreateLongIdent (SynLongIdent.CreateString elementType) ],
|
||||
[],
|
||||
None,
|
||||
range0,
|
||||
range0
|
||||
),
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
),
|
||||
Some (parsedDataPat, parsedData),
|
||||
range0,
|
||||
{
|
||||
ArrowRange = Some range0
|
||||
}
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ collectionType ; "ofSeq" ])
|
||||
SynExpr.CreateLongIdent ident
|
||||
)
|
||||
|
||||
/// propertyName is probably a string literal, but it could be a [<Literal>] variable
|
||||
let createParseRhs (varName : string) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
|
||||
/// 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"
|
||||
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
|
||||
|
||||
/// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
|
||||
let rec parseNode (options : JsonParseOption) (fieldType : SynType) (node : SynExpr) : SynExpr =
|
||||
// TODO: parsing format for DateTime etc
|
||||
match fieldType with
|
||||
| OptionType ty -> failwith "TODO: options"
|
||||
| PrimitiveType typeName -> createParseLineValue propertyName typeName
|
||||
| ListType (PrimitiveType typeName) -> createParseLineList "List" propertyName typeName
|
||||
// TODO: support recursive lists
|
||||
| DateOnly ->
|
||||
asValueGetValue "string" node
|
||||
|> pipeThroughFunction (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
|
||||
| DateTime ->
|
||||
asValueGetValue "string" node
|
||||
|> pipeThroughFunction (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")
|
||||
)
|
||||
|
||||
let trueBranch =
|
||||
ifThenElse
|
||||
(equals
|
||||
option
|
||||
(SynExpr.CreateLongIdent (
|
||||
SynLongIdent.Create
|
||||
[
|
||||
"System"
|
||||
"Text"
|
||||
"Json"
|
||||
"Serialization"
|
||||
"JsonNumberHandling"
|
||||
"AllowReadingFromString"
|
||||
]
|
||||
)))
|
||||
(asValueGetValue "string" node
|
||||
|> pipeThroughFunction (SynLongIdent.CreateFromLongIdent (parseFunction typeName)))
|
||||
reraise
|
||||
|
||||
let handler = ifThenElse cond trueBranch reraise
|
||||
|
||||
basic
|
||||
|> pipeThroughTryWith
|
||||
(SynPat.IsInst (
|
||||
SynType.LongIdent (SynLongIdent.Create [ "System" ; "InvalidOperationException" ]),
|
||||
range0
|
||||
))
|
||||
handler
|
||||
| PrimitiveType typeName -> asValueGetValue typeName node
|
||||
| OptionType ty ->
|
||||
parseNode options ty (SynExpr.CreateIdentString "v")
|
||||
|> createParseLineOption node
|
||||
| ListType ty ->
|
||||
parseNode options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|
||||
|> asArrayMapped "List" node
|
||||
| ArrayType ty ->
|
||||
parseNode options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|
||||
|> asArrayMapped "Array" node
|
||||
| _ ->
|
||||
// Let's just hope that we've also got our own type annotation!
|
||||
createParseLineCallThrough propertyName fieldType
|
||||
let typeName =
|
||||
match fieldType with
|
||||
| SynType.LongIdent ident -> ident.LongIdent
|
||||
| _ -> failwith $"Unrecognised type: %+A{fieldType}"
|
||||
|
||||
typeJsonParse typeName node
|
||||
|
||||
/// 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)
|
||||
|> 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" ]
|
||||
| [ _ ; "JsonNumberHandling" ; "Serialization" ]
|
||||
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ]
|
||||
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ]
|
||||
| [ _ ; "JsonNumberHandling" ; "Serialization" ; "Json" ; "Text" ; "System" ] -> true
|
||||
| _ -> false
|
||||
|
||||
let createMaker (typeName : LongIdent) (fields : SynField list) =
|
||||
let xmlDoc = PreXmlDoc.Create " Parse from a JSON node."
|
||||
@@ -205,13 +376,44 @@ module internal JsonParseGenerator =
|
||||
| None -> failwith "didn't get an ID on field"
|
||||
| Some id -> id
|
||||
|
||||
let attrs = attrs |> List.collect (fun l -> l.Attributes)
|
||||
|
||||
let propertyNameAttr =
|
||||
attrs
|
||||
|> List.collect (fun l -> l.Attributes)
|
||||
|> List.tryFind (fun attr ->
|
||||
attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)
|
||||
)
|
||||
|
||||
let options =
|
||||
(JsonParseOption.None, attrs)
|
||||
||> List.fold (fun options attr ->
|
||||
if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then
|
||||
let qualifiedEnumValue =
|
||||
match stripOptionalParen attr.ArgExpr with
|
||||
| SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when
|
||||
isJsonNumberHandling ident
|
||||
->
|
||||
// Make sure it's fully qualified
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.Create
|
||||
[
|
||||
"System"
|
||||
"Text"
|
||||
"Json"
|
||||
"Serialization"
|
||||
"JsonNumberHandling"
|
||||
"AllowReadingFromString"
|
||||
]
|
||||
)
|
||||
| _ -> attr.ArgExpr
|
||||
|
||||
{
|
||||
JsonNumberHandlingArg = Some qualifiedEnumValue
|
||||
}
|
||||
else
|
||||
options
|
||||
)
|
||||
|
||||
let propertyName =
|
||||
match propertyNameAttr with
|
||||
| None ->
|
||||
@@ -237,7 +439,7 @@ module internal JsonParseGenerator =
|
||||
SynBinding.Let (
|
||||
isInline = false,
|
||||
isMutable = false,
|
||||
expr = createParseRhs (id.ToString ()) propertyName fieldType,
|
||||
expr = createParseRhs options propertyName fieldType,
|
||||
valData = inputVal,
|
||||
pattern = pattern
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user