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

@@ -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"/>