mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-07 13:08:40 +00:00
JSON parse all primitive types (#139)
This commit is contained in:
@@ -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
|
||||
|
||||
|
@@ -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 =
|
||||
|
@@ -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),
|
||||
|
@@ -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"/>
|
||||
|
Reference in New Issue
Block a user