JSON parse all primitive types (#139)

This commit is contained in:
Patrick Stevens
2024-05-24 21:19:04 +01:00
committed by GitHub
parent e80ed51498
commit b9ba07a8a7
8 changed files with 385 additions and 63 deletions

View File

@@ -129,24 +129,230 @@ module ToGetExtensionMethodJsonParseExtension =
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : ToGetExtensionMethod =
let Sailor =
(match node.["sailor"] with
let Whiskey = System.Numerics.BigInteger.Parse (node.["whiskey"].ToJsonString ())
let Victor =
(match node.["victor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("sailor")
sprintf "Required key '%s' not found on JSON object" ("victor")
)
)
| v -> v)
.AsValue()
.GetValue<System.Char> ()
let Uniform =
(match node.["uniform"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("uniform")
)
)
| v -> v)
.AsValue()
.GetValue<System.Decimal> ()
let Tango =
(match node.["tango"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tango")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
let Quebec =
(match node.["quebec"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("quebec")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
let Papa =
(match node.["papa"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("papa")
)
)
| v -> v)
.AsValue()
.GetValue<System.Byte> ()
let Oscar =
(match node.["oscar"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("oscar")
)
)
| v -> v)
.AsValue()
.GetValue<System.SByte> ()
let November =
(match node.["november"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("november")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt16> ()
let Mike =
(match node.["mike"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mike")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int16> ()
let Lima =
(match node.["lima"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lima")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
let Kilo =
(match node.["kilo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("kilo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let Juliette =
(match node.["juliette"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("juliette")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt32> ()
let India =
(match node.["india"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("india")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Hotel =
(match node.["hotel"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("hotel")
)
)
| v -> v)
.AsValue()
.GetValue<System.UInt64> ()
let Golf =
(match node.["golf"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("golf")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int64> ()
let Foxtrot =
(match node.["foxtrot"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("foxtrot")
)
)
| v -> v)
.AsValue()
.GetValue<System.Double> ()
let Echo =
(match node.["echo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("echo")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
let Delta =
(match node.["delta"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("delta")
)
)
| v -> v)
.AsValue()
.GetValue<System.Single> ()
let Charlie =
(match node.["charlie"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("charlie")
)
)
| v -> v)
.AsValue()
.GetValue<float> ()
let Soldier =
(match node.["soldier"] with
let Bravo =
(match node.["bravo"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("soldier")
sprintf "Required key '%s' not found on JSON object" ("bravo")
)
)
| v -> v)
@@ -154,24 +360,12 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> ()
|> System.Uri
let Tailor =
(match node.["tailor"] with
let Alpha =
(match node.["alpha"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tailor")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Tinker =
(match node.["tinker"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("tinker")
sprintf "Required key '%s' not found on JSON object" ("alpha")
)
)
| v -> v)
@@ -179,8 +373,25 @@ module ToGetExtensionMethodJsonParseExtension =
.GetValue<string> ()
{
Tinker = Tinker
Tailor = Tailor
Soldier = Soldier
Sailor = Sailor
Alpha = Alpha
Bravo = Bravo
Charlie = Charlie
Delta = Delta
Echo = Echo
Foxtrot = Foxtrot
Golf = Golf
Hotel = Hotel
India = India
Juliette = Juliette
Kilo = Kilo
Lima = Lima
Mike = Mike
November = November
Oscar = Oscar
Papa = Papa
Quebec = Quebec
Tango = Tango
Uniform = Uniform
Victor = Victor
Whiskey = Whiskey
}

View File

@@ -210,7 +210,7 @@ module InnerTypeWithBothJsonParseExtension =
let value =
(kvp.Value).AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<char> ())
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.Char> ())
|> List.ofSeq
key, value

View File

@@ -32,10 +32,27 @@ type JsonRecordType =
[<WoofWare.Myriad.Plugins.JsonParse true>]
type ToGetExtensionMethod =
{
Tinker : string
Tailor : int
Soldier : System.Uri
Sailor : float
Alpha : string
Bravo : System.Uri
Charlie : float
Delta : float32
Echo : single
Foxtrot : double
Golf : int64
Hotel : uint64
India : int
Juliette : uint
Kilo : int32
Lima : uint32
Mike : int16
November : uint16
Oscar : int8
Papa : uint8
Quebec : byte
Tango : sbyte
Uniform : decimal
Victor : char
Whiskey : bigint
}
[<RequireQualifiedAccess>]

View File

@@ -1,6 +1,7 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open System.Numerics
open System.Text.Json.Nodes
open ConsumePlugin
open NUnit.Framework
@@ -12,15 +13,62 @@ module TestExtensionMethod =
[<Test>]
let ``Parse via extension method`` () =
let json =
"""{"tinker": "job", "tailor": 3, "soldier": "https://example.com", "sailor": 3.1}"""
"""{
"alpha": "hello!",
"bravo": "https://example.com",
"charlie": 0.3341,
"delta": 110033.4,
"echo": -0.000993,
"foxtrot": -999999999999,
"golf": -123456789101112,
"hotel": 18446744073709551615,
"india": 99884,
"juliette": 12223334,
"kilo": -2147483642,
"lima": 4294967293,
"mike": -32767,
"november": 65533,
"oscar": -125,
"papa": 253,
"quebec": 254,
"tango": -3,
"uniform": 1004443.300988393349583009,
"victor": "x",
"whiskey": 123456123456123456123456123456123456123456
}"""
|> JsonNode.Parse
let expected =
{
Tinker = "job"
Tailor = 3
Soldier = Uri "https://example.com"
Sailor = 3.1
Alpha = "hello!"
Bravo = Uri "https://example.com"
Charlie = 0.3341
Delta = 110033.4f
Echo = -0.000993f
Foxtrot = -999999999999.0
Golf = -123456789101112L
Hotel = 18446744073709551615UL
India = 99884
Juliette = 12223334u
Kilo = -2147483642
Lima = 4294967293u
Mike = -32767s
November = 65533us
Oscar = -125y
Papa = 253uy
Quebec = 254uy
Tango = -3y
Uniform = 1004443.300988393349583009m
Victor = 'x'
Whiskey =
let mutable i = BigInteger 0
for _ = 0 to 6 do
i <- i * BigInteger 1000000 + BigInteger 123456
i
}
ToGetExtensionMethod.jsonParse json |> shouldEqual expected
let actual = ToGetExtensionMethod.jsonParse json
actual |> shouldEqual expected

View File

@@ -98,6 +98,30 @@ type internal AdtProduct =
[<RequireQualifiedAccess>]
module internal AstHelper =
/// Given e.g. "byte", returns "System.Byte".
let qualifyPrimitiveType (typeName : string) : LongIdent option =
match typeName with
| "float32"
| "single" -> [ "System" ; "Single" ] |> Some
| "float"
| "double" -> [ "System" ; "Double" ] |> Some
| "byte"
| "uint8" -> [ "System" ; "Byte" ] |> Some
| "sbyte"
| "int8" -> [ "System" ; "SByte" ] |> Some
| "int16" -> [ "System" ; "Int16" ] |> Some
| "int"
| "int32" -> [ "System" ; "Int32" ] |> Some
| "int64" -> [ "System" ; "Int64" ] |> Some
| "uint16" -> [ "System" ; "UInt16" ] |> Some
| "uint"
| "uint32" -> [ "System" ; "UInt32" ] |> Some
| "uint64" -> [ "System" ; "UInt64" ] |> Some
| "char" -> [ "System" ; "Char" ] |> Some
| "decimal" -> [ "System" ; "Decimal" ] |> Some
| _ -> None
|> Option.map (List.map Ident.Create)
let instantiateRecord (fields : (RecordFieldName * SynExpr option) list) : SynExpr =
let fields =
fields
@@ -557,14 +581,23 @@ module internal SynTypePatterns =
Some (key, value)
| _ -> None
/// Returns the string name of the type.
let (|PrimitiveType|_|) (fieldType : SynType) =
let (|BigInt|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map _.idText with
| [ "bigint" ]
| [ "BigInteger" ]
| [ "Numerics" ; "BigInteger" ]
| [ "System" ; "Numerics" ; "BigInteger" ] -> Some ()
| _ -> None
| _ -> None
/// Returns the type, qualified as in e.g. `System.Boolean`.
let (|PrimitiveType|_|) (fieldType : SynType) : LongIdent option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] ->
[ "string" ; "float" ; "int" ; "bool" ; "char" ]
|> List.tryFind (fun s -> s = i.idText)
| [ i ] -> AstHelper.qualifyPrimitiveType i.idText
| _ -> None
| _ -> None

View File

@@ -62,6 +62,13 @@ module internal JsonParseGenerator =
/// {node}.AsValue().GetValue<{typeName}> ()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asValueGetValue (propertyName : SynExpr option) (typeName : string) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod' "GetValue" typeName
let asValueGetValueIdent (propertyName : SynExpr option) (typeName : LongIdent) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
@@ -122,7 +129,12 @@ module internal JsonParseGenerator =
/// Given e.g. "float", returns "System.Double.Parse"
let parseFunction (typeName : string) : LongIdent =
List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ]
let qualified =
match AstHelper.qualifyPrimitiveType typeName with
| Some x -> x
| None -> failwith $"Could not recognise type %s{typeName} as a primitive."
List.append qualified [ Ident.Create "Parse" ]
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
@@ -252,7 +264,7 @@ module internal JsonParseGenerator =
range0
))
handler
| PrimitiveType typeName -> asValueGetValue propertyName typeName node
| PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
| OptionType ty ->
parseNode None options ty (SynExpr.CreateIdentString "v")
|> createParseLineOption node
@@ -312,6 +324,11 @@ module internal JsonParseGenerator =
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
| BigInt ->
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ]),
SynExpr.CreateParen (node |> SynExpr.callMethod "ToJsonString")
)
| _ ->
// Let's just hope that we've also got our own type annotation!
let typeName =

View File

@@ -107,24 +107,6 @@ module internal SynExpr =
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen 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 (
@@ -141,8 +123,22 @@ module internal SynExpr =
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
range0,
[ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ],
[],
Some range0,
range0,
range0
),
SynExpr.CreateConst SynConst.Unit
)
/// {obj}.{meth}<ty>()
let callGenericMethod (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
SynExpr.CreateApp (
SynExpr.TypeApp (
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),

View File

@@ -27,7 +27,7 @@
<Compile Include="List.fs"/>
<Compile Include="Ident.fs" />
<Compile Include="AstHelper.fs"/>
<Compile Include="SynExpr.fs"/>
<Compile Include="SynExpr.fs" />
<Compile Include="SynType.fs"/>
<Compile Include="SynAttribute.fs"/>
<Compile Include="RemoveOptionsGenerator.fs"/>