Add nullable support to JSON generators (#174)

ConsumePlugin/GeneratedJson.fs

@@ -14,7 +14,7 @@ module internal InternalTypeNotExtensionSerial =
     /// Serialize to a JSON node
     let toJsonNode (input : InternalTypeNotExtensionSerial) : System.Text.Json.Nodes.JsonNode =
         let node = System.Text.Json.Nodes.JsonObject ()
-        do node.Add ((Literals.something), System.Text.Json.Nodes.JsonValue.Create<string> input.InternalThing2)
+        do node.Add ((Literals.something), (input.InternalThing2 |> System.Text.Json.Nodes.JsonValue.Create<string>))
         node :> _
 namespace ConsumePlugin
 
@@ -29,7 +29,7 @@ module internal InternalTypeExtensionJsonSerializeExtension =
         /// Serialize to a JSON node
         static member toJsonNode (input : InternalTypeExtension) : System.Text.Json.Nodes.JsonNode =
             let node = System.Text.Json.Nodes.JsonObject ()
-            do node.Add ((Literals.something), System.Text.Json.Nodes.JsonValue.Create<string> input.ExternalThing)
+            do node.Add ((Literals.something), (input.ExternalThing |> System.Text.Json.Nodes.JsonValue.Create<string>))
             node :> _
 
 namespace ConsumePlugin

ConsumePlugin/GeneratedPureGymDto.fs

@@ -20,21 +20,26 @@ module MemberJsonSerializeExtension =
             let node = System.Text.Json.Nodes.JsonObject ()
 
             do
-                node.Add ("id", System.Text.Json.Nodes.JsonValue.Create<int> input.Id)
+                node.Add ("id", (input.Id |> System.Text.Json.Nodes.JsonValue.Create<int>))
-                node.Add ("compoundMemberId", System.Text.Json.Nodes.JsonValue.Create<string> input.CompoundMemberId)
+
-                node.Add ("firstName", System.Text.Json.Nodes.JsonValue.Create<string> input.FirstName)
+                node.Add (
-                node.Add ("lastName", System.Text.Json.Nodes.JsonValue.Create<string> input.LastName)
+                    "compoundMemberId",
-                node.Add ("homeGymId", System.Text.Json.Nodes.JsonValue.Create<int> input.HomeGymId)
+                    (input.CompoundMemberId |> System.Text.Json.Nodes.JsonValue.Create<string>)
-                node.Add ("homeGymName", System.Text.Json.Nodes.JsonValue.Create<string> input.HomeGymName)
+                )
-                node.Add ("emailAddress", System.Text.Json.Nodes.JsonValue.Create<string> input.EmailAddress)
+
-                node.Add ("gymAccessPin", System.Text.Json.Nodes.JsonValue.Create<string> input.GymAccessPin)
+                node.Add ("firstName", (input.FirstName |> System.Text.Json.Nodes.JsonValue.Create<string>))
-                node.Add ("dateofBirth", System.Text.Json.Nodes.JsonValue.Create<DateOnly> input.DateOfBirth)
+                node.Add ("lastName", (input.LastName |> System.Text.Json.Nodes.JsonValue.Create<string>))
-                node.Add ("mobileNumber", System.Text.Json.Nodes.JsonValue.Create<string> input.MobileNumber)
+                node.Add ("homeGymId", (input.HomeGymId |> System.Text.Json.Nodes.JsonValue.Create<int>))
-                node.Add ("postCode", System.Text.Json.Nodes.JsonValue.Create<string> input.Postcode)
+                node.Add ("homeGymName", (input.HomeGymName |> System.Text.Json.Nodes.JsonValue.Create<string>))
-                node.Add ("membershipName", System.Text.Json.Nodes.JsonValue.Create<string> input.MembershipName)
+                node.Add ("emailAddress", (input.EmailAddress |> System.Text.Json.Nodes.JsonValue.Create<string>))
-                node.Add ("membershipLevel", System.Text.Json.Nodes.JsonValue.Create<int> input.MembershipLevel)
+                node.Add ("gymAccessPin", (input.GymAccessPin |> System.Text.Json.Nodes.JsonValue.Create<string>))
-                node.Add ("suspendedReason", System.Text.Json.Nodes.JsonValue.Create<int> input.SuspendedReason)
+                node.Add ("dateofBirth", (input.DateOfBirth |> System.Text.Json.Nodes.JsonValue.Create<DateOnly>))
-                node.Add ("memberStatus", System.Text.Json.Nodes.JsonValue.Create<int> input.MemberStatus)
+                node.Add ("mobileNumber", (input.MobileNumber |> System.Text.Json.Nodes.JsonValue.Create<string>))
+                node.Add ("postCode", (input.Postcode |> System.Text.Json.Nodes.JsonValue.Create<string>))
+                node.Add ("membershipName", (input.MembershipName |> System.Text.Json.Nodes.JsonValue.Create<string>))
+                node.Add ("membershipLevel", (input.MembershipLevel |> System.Text.Json.Nodes.JsonValue.Create<int>))
+                node.Add ("suspendedReason", (input.SuspendedReason |> System.Text.Json.Nodes.JsonValue.Create<int>))
+                node.Add ("memberStatus", (input.MemberStatus |> System.Text.Json.Nodes.JsonValue.Create<int>))
 
             node :> _
 

ConsumePlugin/GeneratedSerde.fs

@@ -21,24 +21,25 @@ module InnerTypeWithBothJsonSerializeExtension =
             let node = System.Text.Json.Nodes.JsonObject ()
 
             do
-                node.Add (("it's-a-me"), System.Text.Json.Nodes.JsonValue.Create<Guid> input.Thing)
+                node.Add (("it's-a-me"), (input.Thing |> System.Text.Json.Nodes.JsonValue.Create<Guid>))
 
                 node.Add (
                     "map",
-                    (fun field ->
+                    (input.Map
+                     |> (fun field ->
                          let ret = System.Text.Json.Nodes.JsonObject ()
 
                          for (KeyValue (key, value)) in field do
                              ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<Uri> value)
 
                          ret
-                    )
+                     ))
-                        input.Map
                 )
 
                 node.Add (
                     "readOnlyDict",
-                    (fun field ->
+                    (input.ReadOnlyDict
+                     |> (fun field ->
                          let ret = System.Text.Json.Nodes.JsonObject ()
 
                          for (KeyValue (key, value)) in field do
@@ -56,34 +57,33 @@ module InnerTypeWithBothJsonSerializeExtension =
                              )
 
                          ret
-                    )
+                     ))
-                        input.ReadOnlyDict
                 )
 
                 node.Add (
                     "dict",
-                    (fun field ->
+                    (input.Dict
+                     |> (fun field ->
                          let ret = System.Text.Json.Nodes.JsonObject ()
 
                          for (KeyValue (key, value)) in field do
                              ret.Add (key.ToString (), System.Text.Json.Nodes.JsonValue.Create<bool> value)
 
                          ret
-                    )
+                     ))
-                        input.Dict
                 )
 
                 node.Add (
                     "concreteDict",
-                    (fun field ->
+                    (input.ConcreteDict
+                     |> (fun field ->
                          let ret = System.Text.Json.Nodes.JsonObject ()
 
                          for (KeyValue (key, value)) in field do
                              ret.Add (key.ToString (), InnerTypeWithBoth.toJsonNode value)
 
                          ret
-                    )
+                     ))
-                        input.ConcreteDict
                 )
 
             node :> _
@@ -104,61 +104,85 @@ module JsonRecordTypeWithBothJsonSerializeExtension =
             let node = System.Text.Json.Nodes.JsonObject ()
 
             do
-                node.Add ("a", System.Text.Json.Nodes.JsonValue.Create<int> input.A)
+                node.Add ("a", (input.A |> System.Text.Json.Nodes.JsonValue.Create<int>))
-                node.Add ("b", System.Text.Json.Nodes.JsonValue.Create<string> input.B)
+                node.Add ("b", (input.B |> System.Text.Json.Nodes.JsonValue.Create<string>))
 
                 node.Add (
                     "c",
-                    (fun field ->
+                    (input.C
+                     |> (fun field ->
                          let arr = System.Text.Json.Nodes.JsonArray ()
 
                          for mem in field do
                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem)
 
                          arr
-                    )
+                     ))
-                        input.C
                 )
 
-                node.Add ("d", InnerTypeWithBoth.toJsonNode input.D)
+                node.Add ("d", (input.D |> InnerTypeWithBoth.toJsonNode))
 
                 node.Add (
                     "e",
-                    (fun field ->
+                    (input.E
+                     |> (fun field ->
                          let arr = System.Text.Json.Nodes.JsonArray ()
 
                          for mem in field do
                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<string> mem)
 
                          arr
-                    )
+                     ))
-                        input.E
                 )
 
                 node.Add (
                     "arr",
-                    (fun field ->
+                    (input.Arr
+                     |> (fun field ->
                          let arr = System.Text.Json.Nodes.JsonArray ()
 
                          for mem in field do
                              arr.Add (System.Text.Json.Nodes.JsonValue.Create<int> mem)
 
                          arr
-                    )
+                     ))
-                        input.Arr
                 )
 
-                node.Add ("byte", System.Text.Json.Nodes.JsonValue.Create<byte<measure>> input.Byte)
+                node.Add ("byte", (input.Byte |> System.Text.Json.Nodes.JsonValue.Create<byte<measure>>))
-                node.Add ("sbyte", System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>> input.Sbyte)
+                node.Add ("sbyte", (input.Sbyte |> System.Text.Json.Nodes.JsonValue.Create<sbyte<measure>>))
-                node.Add ("i", System.Text.Json.Nodes.JsonValue.Create<int<measure>> input.I)
+                node.Add ("i", (input.I |> System.Text.Json.Nodes.JsonValue.Create<int<measure>>))
-                node.Add ("i32", System.Text.Json.Nodes.JsonValue.Create<int32<measure>> input.I32)
+                node.Add ("i32", (input.I32 |> System.Text.Json.Nodes.JsonValue.Create<int32<measure>>))
-                node.Add ("i64", System.Text.Json.Nodes.JsonValue.Create<int64<measure>> input.I64)
+                node.Add ("i64", (input.I64 |> System.Text.Json.Nodes.JsonValue.Create<int64<measure>>))
-                node.Add ("u", System.Text.Json.Nodes.JsonValue.Create<uint<measure>> input.U)
+                node.Add ("u", (input.U |> System.Text.Json.Nodes.JsonValue.Create<uint<measure>>))
-                node.Add ("u32", System.Text.Json.Nodes.JsonValue.Create<uint32<measure>> input.U32)
+                node.Add ("u32", (input.U32 |> System.Text.Json.Nodes.JsonValue.Create<uint32<measure>>))
-                node.Add ("u64", System.Text.Json.Nodes.JsonValue.Create<uint64<measure>> input.U64)
+                node.Add ("u64", (input.U64 |> System.Text.Json.Nodes.JsonValue.Create<uint64<measure>>))
-                node.Add ("f", System.Text.Json.Nodes.JsonValue.Create<float<measure>> input.F)
+                node.Add ("f", (input.F |> System.Text.Json.Nodes.JsonValue.Create<float<measure>>))
-                node.Add ("f32", System.Text.Json.Nodes.JsonValue.Create<float32<measure>> input.F32)
+                node.Add ("f32", (input.F32 |> System.Text.Json.Nodes.JsonValue.Create<float32<measure>>))
-                node.Add ("single", System.Text.Json.Nodes.JsonValue.Create<single<measure>> input.Single)
+                node.Add ("single", (input.Single |> System.Text.Json.Nodes.JsonValue.Create<single<measure>>))
+
+                node.Add (
+                    "intMeasureOption",
+                    (input.IntMeasureOption
+                     |> (fun field ->
+                         match field with
+                         | None -> null :> System.Text.Json.Nodes.JsonNode
+                         | Some field ->
+                             (System.Text.Json.Nodes.JsonValue.Create<int<measure>> field)
+                             :> System.Text.Json.Nodes.JsonNode
+                     ))
+                )
+
+                node.Add (
+                    "intMeasureNullable",
+                    (input.IntMeasureNullable
+                     |> (fun field ->
+                         if field.HasValue then
+                             System.Text.Json.Nodes.JsonValue.Create<int<measure>> field.Value
+                             :> System.Text.Json.Nodes.JsonNode
+                         else
+                             null :> System.Text.Json.Nodes.JsonNode
+                     ))
+                )
 
             node :> _
 namespace ConsumePlugin
@@ -307,6 +331,22 @@ module JsonRecordTypeWithBothJsonParseExtension =
 
         /// Parse from a JSON node.
         static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonRecordTypeWithBoth =
+            let arg_18 =
+                match node.["intMeasureNullable"] with
+                | null -> System.Nullable ()
+                | v ->
+                    v.AsValue().GetValue<System.Int32> ()
+                    |> LanguagePrimitives.Int32WithMeasure
+                    |> System.Nullable
+
+            let arg_17 =
+                match node.["intMeasureOption"] with
+                | null -> None
+                | v ->
+                    v.AsValue().GetValue<System.Int32> ()
+                    |> LanguagePrimitives.Int32WithMeasure
+                    |> Some
+
             let arg_16 =
                 (match node.["single"] with
                  | null ->
@@ -543,6 +583,8 @@ module JsonRecordTypeWithBothJsonParseExtension =
                 F = arg_14
                 F32 = arg_15
                 Single = arg_16
+                IntMeasureOption = arg_17
+                IntMeasureNullable = arg_18
             }
 namespace ConsumePlugin
 

ConsumePlugin/SerializationAndDeserialization.fs

@@ -40,6 +40,8 @@ type JsonRecordTypeWithBoth =
         F : float<measure>
         F32 : float32<measure>
         Single : single<measure>
+        IntMeasureOption : int<measure> option
+        IntMeasureNullable : int<measure> Nullable
     }
 
 [<WoofWare.Myriad.Plugins.JsonSerialize true>]

WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs

@@ -89,6 +89,8 @@ module TestJsonSerde =
             let! f = Arb.generate |> Gen.filter (fun s -> Double.IsFinite (s / 1.0<measure>))
             let! f32 = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
             let! single = Arb.generate |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f<measure>))
+            let! intMeasureOption = Arb.generate
+            let! intMeasureNullable = Arb.generate
 
             return
                 {
@@ -109,6 +111,8 @@ module TestJsonSerde =
                     F = f
                     F32 = f32
                     Single = single
+                    IntMeasureOption = intMeasureOption
+                    IntMeasureNullable = intMeasureNullable
                 }
         }
 

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -95,17 +95,6 @@ module internal JsonParseGenerator =
         )
         |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ collectionType ; "ofSeq" ])
 
-    /// match {node} with | null -> None | v -> {body} |> Some
-    /// Use the variable `v` to get access to the `Some`.
-    let createParseLineOption (node : SynExpr) (body : SynExpr) : SynExpr =
-        let body = SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") body
-
-        [
-            SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None")
-            SynMatchClause.create (SynPat.named "v") body
-        ]
-        |> SynExpr.createMatch node
-
     let dotParse (typeName : LongIdent) : LongIdent =
         List.append typeName [ Ident.create "Parse" ]
 
@@ -206,8 +195,29 @@ module internal JsonParseGenerator =
         | NumberType typeName -> parseNumberType options propertyName node typeName
         | PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
         | OptionType ty ->
+            let someClause =
                 parseNode None options ty (SynExpr.createIdent "v")
-            |> createParseLineOption node
+                |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
+                |> SynMatchClause.create (SynPat.named "v")
+
+            [
+                SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None")
+                someClause
+            ]
+            |> SynExpr.createMatch node
+        | NullableType ty ->
+            let someClause =
+                parseNode None options ty (SynExpr.createIdent "v")
+                |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ])
+                |> SynMatchClause.create (SynPat.named "v")
+
+            [
+                SynMatchClause.create
+                    SynPat.createNull
+                    (SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Nullable" ]) (SynExpr.CreateConst ()))
+                someClause
+            ]
+            |> SynExpr.createMatch node
         | ListType ty ->
             parseNode None options ty (SynExpr.createIdent "elt")
             |> asArrayMapped propertyName "List" node

WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs

@@ -13,6 +13,14 @@ type internal JsonSerializeOutputSpec =
 module internal JsonSerializeGenerator =
     open Fantomas.FCS.Text.Range
 
+
+    // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
+    // identically equal to null. We have to work around this later, but we might as well just
+    // be efficient here and whip up the null directly.
+    let private jsonNull () =
+        SynExpr.createNull ()
+        |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
+
     /// Given `input.Ident`, for example, choose how to add it to the ambient `node`.
     /// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`.
     let rec serializeNode (fieldType : SynType) : SynExpr =
@@ -35,15 +43,15 @@ module internal JsonSerializeGenerator =
                 range0,
                 range0
             )
+        | NullableType ty ->
+            // fun field -> if field.HasValue then {serializeNode ty} field.Value else JsonValue.Create null
+            SynExpr.applyFunction (serializeNode ty) (SynExpr.createLongIdent [ "field" ; "Value" ])
+            |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
+            |> SynExpr.ifThenElse (SynExpr.createLongIdent [ "field" ; "HasValue" ]) (jsonNull ())
+            |> SynExpr.createLambda "field"
         | OptionType ty ->
             // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field
-            let noneClause =
+            let noneClause = jsonNull () |> SynMatchClause.create (SynPat.named "None")
-                // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"`
-                // identically equal to null. We have to work around this later, but we might as well just
-                // be efficient here and whip up the null directly.
-                SynExpr.createNull ()
-                |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
-                |> SynMatchClause.create (SynPat.named "None")
 
             let someClause =
                 SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field")
@@ -140,9 +148,10 @@ module internal JsonSerializeGenerator =
     let createSerializeRhsRecord (propertyName : SynExpr) (fieldId : Ident) (fieldType : SynType) : SynExpr =
         [
             propertyName
-            SynExpr.applyFunction
+            SynExpr.pipeThroughFunction
                 (serializeNode fieldType)
                 (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ])
+            |> SynExpr.paren
         ]
         |> SynExpr.tuple
         |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])

WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs

@@ -106,15 +106,16 @@ module internal SynExpr =
         | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
         | expr -> expr
 
-    /// {obj}.{meth} {arg}
+    let dotGet (field : string) (obj : SynExpr) : SynExpr =
-    let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
         SynExpr.DotGet (
             obj,
             range0,
-            SynLongIdent.SynLongIdent (id = [ Ident.create meth ], dotRanges = [], trivia = [ None ]),
+            SynLongIdent.SynLongIdent (id = [ Ident.create field ], dotRanges = [], trivia = [ None ]),
             range0
         )
-        |> applyTo arg
+
+    /// {obj}.{meth} {arg}
+    let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = dotGet meth obj |> applyTo arg
 
     /// {obj}.{meth}()
     let callMethod (meth : string) (obj : SynExpr) : SynExpr =

WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs

@@ -70,6 +70,12 @@ module internal SynLongIdent =
         // TODO: consider Microsoft.FSharp.Option or whatever it is
         | _ -> false
 
+    let isNullable (ident : SynLongIdent) : bool =
+        match ident.LongIdent |> List.map _.idText with
+        | [ "System" ; "Nullable" ]
+        | [ "Nullable" ] -> true
+        | _ -> false
+
     let isResponse (ident : SynLongIdent) : bool =
         match ident.LongIdent |> List.map _.idText with
         | [ "Response" ]

WoofWare.Myriad.Plugins/SynExpr/SynType.fs

@@ -59,6 +59,12 @@ module internal SynTypePatterns =
             Some innerType
         | _ -> None
 
+    let (|NullableType|_|) (fieldType : SynType) =
+        match fieldType with
+        | SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isNullable ident ->
+            Some innerType
+        | _ -> None
+
     let (|UnitType|_|) (fieldType : SynType) : unit option =
         match fieldType with
         | SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some ()