Parse numbers from strings, implement general recursion (#12)

ConsumePlugin/GeneratedJson.fs

@@ -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 = node.["another-thing"].AsValue().GetValue<string> ()
-        let B = B2.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
         }

ConsumePlugin/JsonRecord.fs

@@ -25,4 +25,6 @@ type JsonRecordType =
         [<System.Text.Json.Serialization.JsonPropertyName "hi">]
         C : int list
         D : InnerType
+        E : string array
+        F : int[]
     }

MyriadPlugin.Test/TestJsonParse.fs

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

MyriadPlugin/AstHelper.fs

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

MyriadPlugin/JsonParseGenerator.fs

@@ -17,23 +17,33 @@ module internal JsonParseGenerator =
     open Fantomas.FCS.Text.Range
     open Myriad.Core.Ast
 
-    let createParseLineValue (propertyName : SynExpr) (typeName : string) : SynExpr =
+    type JsonParseOption =
-        // node.["town"].AsValue().GetValue<string> ()
+        {
-        let indexed =
+            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,45 +62,21 @@ module internal JsonParseGenerator =
             SynExpr.CreateConst SynConst.Unit
         )
 
-    let createParseLineCallThrough (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
+    /// {type}.jsonParse {node}
-        // Type.jsonParse node.["town"]
+    let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
-        let typeName =
-            match fieldType with
-            | SynType.LongIdent ident -> ident.LongIdent
-            | _ -> failwith $"Unrecognised type: %+A{fieldType}"
-
         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 =
+    /// body is the body of a lambda which takes a parameter `elt`.
-        // node.["openingHours"].AsArray()
+    /// {node}.AsArray()
-        // |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
+    /// |> Seq.map (fun elt -> {body})
-        // |> List.ofSeq
+    /// |> {collectionType}.ofSeq
-
+    let asArrayMapped (collectionType : string) (node : SynExpr) (body : SynExpr) : SynExpr =
         let parsedDataPat = [ SynPat.CreateNamed (Ident.Create "elt") ]
 
-        let parsedData =
-            SynExpr.CreateApp (
-                SynExpr.TypeApp (
-                    SynExpr.DotGet (
-                        SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"),
-                        range0,
-                        SynLongIdent.Create [ "GetValue" ],
-                        range0
-                    ),
-                    range0,
-                    [ SynType.CreateLongIdent elementType ],
-                    [],
-                    Some range0,
-                    range0,
-                    range0
-                ),
-                SynExpr.CreateConst SynConst.Unit
-            )
-
         SynExpr.CreateApp (
             SynExpr.CreateAppInfix (
                 SynExpr.LongIdent (
@@ -116,17 +102,7 @@ module internal JsonParseGenerator =
                             range0
                         ),
                         SynExpr.CreateApp (
-                            SynExpr.DotGet (
+                            SynExpr.DotGet (node, range0, SynLongIdent.CreateString "AsArray", range0),
-                                SynExpr.DotIndexedGet (
-                                    SynExpr.CreateIdent (Ident.Create "node"),
-                                    propertyName,
-                                    range0,
-                                    range0
-                                ),
-                                range0,
-                                SynLongIdent.CreateString "AsArray",
-                                range0
-                            ),
                             SynExpr.CreateConst SynConst.Unit
                         )
                     ),
@@ -137,27 +113,8 @@ module internal JsonParseGenerator =
                                 false,
                                 false,
                                 SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create "elt") ],
-                                SynExpr.CreateApp (
+                                body,
-                                    SynExpr.TypeApp (
+                                Some (parsedDataPat, body),
-                                        SynExpr.DotGet (
-                                            SynExpr.CreateApp (
-                                                SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"),
-                                                SynExpr.CreateConst SynConst.Unit
-                                            ),
-                                            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
@@ -170,16 +127,230 @@ module internal JsonParseGenerator =
             SynExpr.CreateLongIdent (SynLongIdent.Create [ collectionType ; "ofSeq" ])
         )
 
-    /// propertyName is probably a string literal, but it could be a [<Literal>] variable
+    /// match {node} with | null -> None | v -> Some {body}
-    let createParseRhs (varName : string) (propertyName : SynExpr) (fieldType : SynType) : SynExpr =
+    /// 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 (
+                    SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"),
+                    range0,
+                    SynLongIdent.Create [ "GetValue" ],
+                    range0
+                ),
+                range0,
+                [ SynType.CreateLongIdent elementType ],
+                [],
+                Some range0,
+                range0,
+                range0
+            ),
+            SynExpr.CreateConst SynConst.Unit
+        )
+
+    /// {expr} |> DateOnly.Parse
+    let pipeThroughFunction (ident : SynLongIdent) (expr : SynExpr) : SynExpr =
+        SynExpr.CreateApp (
+            SynExpr.CreateAppInfix (
+                SynExpr.CreateLongIdent (
+                    SynLongIdent.SynLongIdent (
+                        [ Ident.Create "op_PipeRight" ],
+                        [],
+                        [ Some (IdentTrivia.OriginalNotation "|>") ]
+                    )
+                ),
+                expr
+            ),
+            SynExpr.CreateLongIdent ident
+        )
+
+    /// 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"
+        | DateOnly ->
-        | PrimitiveType typeName -> createParseLineValue propertyName typeName
+            asValueGetValue "string" node
-        | ListType (PrimitiveType typeName) -> createParseLineList "List" propertyName typeName
+            |> pipeThroughFunction (SynLongIdent.Create [ "System" ; "DateOnly" ; "Parse" ])
-        // TODO: support recursive lists
+        | 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
                 )