namespace WoofWare.Myriad.Plugins.Test open System open System.Collections.Generic open System.Text.Json.Nodes open FsCheck.FSharp open Microsoft.FSharp.Reflection open NUnit.Framework open FsCheck open FsUnitTyped open ConsumePlugin [] module TestJsonSerde = let uriGen : Gen = gen { let! suffix = ArbMap.generate ArbMap.defaults return Uri $"https://example.com/%i{suffix}" } let rec innerGen (count : int) : Gen = gen { let! guid = ArbMap.generate ArbMap.defaults let! mapKeys = Gen.listOf (ArbMap.generate> ArbMap.defaults) let mapKeys = mapKeys |> List.map _.Get |> List.distinct let! mapValues = Gen.listOfLength mapKeys.Length uriGen let map = List.zip mapKeys mapValues |> Map.ofList let! concreteDictKeys = if count > 0 then Gen.listOf (ArbMap.generate> ArbMap.defaults) else Gen.constant [] let concreteDictKeys = concreteDictKeys |> List.map _.Get |> List.distinct |> fun x -> List.take (min 3 x.Length) x let! concreteDictValues = if count > 0 then Gen.listOfLength concreteDictKeys.Length (innerGen (count - 1)) else Gen.constant [] let concreteDict = List.zip concreteDictKeys concreteDictValues |> List.map KeyValuePair |> Dictionary let! readOnlyDictKeys = Gen.listOf (ArbMap.generate> ArbMap.defaults) let readOnlyDictKeys = readOnlyDictKeys |> List.map _.Get |> List.distinct let! readOnlyDictValues = Gen.listOfLength readOnlyDictKeys.Length (Gen.listOf (ArbMap.generate ArbMap.defaults)) let readOnlyDict = List.zip readOnlyDictKeys readOnlyDictValues |> readOnlyDict let! dictKeys = Gen.listOf uriGen let! dictValues = Gen.listOfLength dictKeys.Length (ArbMap.generate ArbMap.defaults) let dict = List.zip dictKeys dictValues |> dict return { Thing = guid Map = map ReadOnlyDict = readOnlyDict Dict = dict ConcreteDict = concreteDict } } let outerGen : Gen = gen { let! a = ArbMap.generate ArbMap.defaults let! b = ArbMap.generate> ArbMap.defaults let! c = Gen.listOf (ArbMap.generate ArbMap.defaults) let! depth = Gen.choose (0, 2) let! d = innerGen depth let! e = Gen.arrayOf (ArbMap.generate> ArbMap.defaults) let! arr = Gen.arrayOf (ArbMap.generate ArbMap.defaults) let! byte = ArbMap.generate ArbMap.defaults let! sbyte = ArbMap.generate ArbMap.defaults let! i = ArbMap.generate ArbMap.defaults let! i32 = ArbMap.generate ArbMap.defaults let! i64 = ArbMap.generate ArbMap.defaults let! u = ArbMap.generate ArbMap.defaults let! u32 = ArbMap.generate ArbMap.defaults let! u64 = ArbMap.generate ArbMap.defaults let! f = ArbMap.generate ArbMap.defaults |> Gen.filter (fun s -> Double.IsFinite (s / 1.0)) let! f32 = ArbMap.generate ArbMap.defaults |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f)) let! single = ArbMap.generate ArbMap.defaults |> Gen.filter (fun s -> Single.IsFinite (s / 1.0f)) let! intMeasureOption = ArbMap.generate ArbMap.defaults let! intMeasureNullable = ArbMap.generate ArbMap.defaults let! someEnum = Gen.choose (0, 1) let! timestamp = ArbMap.generate ArbMap.defaults return { A = a B = b.Get C = c D = d E = e |> Array.map _.Get Arr = arr Byte = byte Sbyte = sbyte I = i I32 = i32 I64 = i64 U = u U32 = u32 U64 = u64 F = f F32 = f32 Single = single IntMeasureOption = intMeasureOption IntMeasureNullable = intMeasureNullable Enum = enum someEnum Timestamp = timestamp Unit = () } } [] let ``It just works`` () = let property (o : JsonRecordTypeWithBoth) : bool = o |> JsonRecordTypeWithBoth.toJsonNode |> fun s -> s.ToJsonString () |> JsonNode.Parse |> JsonRecordTypeWithBoth.jsonParse |> shouldEqual o true property |> Prop.forAll (Arb.fromGen outerGen) |> Check.QuickThrowOnFailure [] let ``Single example of big record`` () = let guid = Guid.Parse "dfe24db5-9f8d-447b-8463-4c0bcf1166d5" let data = { A = 3 B = "hello!" C = [ 1 ; -9 ] D = { Thing = guid Map = Map.ofList [] ReadOnlyDict = readOnlyDict [] Dict = dict [] ConcreteDict = Dictionary () } E = [| "I'm-a-string" |] Arr = [| -18883 ; 9100 |] Byte = 87uy Sbyte = 89y I = 199993345 I32 = -485832 I64 = -13458625689L U = 458582u U32 = 857362147u U64 = 1234567892123414596UL F = 8833345667.1 F32 = 1000.98f Single = 0.334f IntMeasureOption = Some 981 IntMeasureNullable = Nullable -883 Enum = enum 1 Timestamp = DateTimeOffset (2024, 07, 01, 17, 54, 00, TimeSpan.FromHours 1.0) Unit = () } let expected = """{ "a": 3, "b": "hello!", "c": [1, -9], "d": { "it\u0027s-a-me": "dfe24db5-9f8d-447b-8463-4c0bcf1166d5", "map": {}, "readOnlyDict": {}, "dict": {}, "concreteDict": {} }, "e": ["I\u0027m-a-string"], "arr": [-18883, 9100], "byte": 87, "sbyte": 89, "i": 199993345, "i32": -485832, "i64": -13458625689, "u": 458582, "u32": 857362147, "u64": 1234567892123414596, "f": 8833345667.1, "f32": 1000.98, "single": 0.334, "intMeasureOption": 981, "intMeasureNullable": -883, "enum": 1, "timestamp": "2024-07-01T17:54:00.0000000\u002B01:00", "unit": {} } """ |> fun s -> s.ToCharArray () |> Array.filter (fun c -> not (Char.IsWhiteSpace c)) |> fun s -> new String (s) JsonRecordTypeWithBoth.toJsonNode(data).ToJsonString () |> shouldEqual expected JsonRecordTypeWithBoth.jsonParse (JsonNode.Parse expected) |> shouldEqual data [] let ``Guids are treated just like strings`` () = let guidStr = "b1e7496e-6e79-4158-8579-a01de355d3b2" let guid = Guid.Parse guidStr let node = { Thing = guid Map = Map.empty ReadOnlyDict = readOnlyDict [] Dict = dict [] ConcreteDict = Dictionary () } |> InnerTypeWithBoth.toJsonNode node.ToJsonString () |> shouldEqual ( sprintf """{"it\u0027s-a-me":"%s","map":{},"readOnlyDict":{},"dict":{},"concreteDict":{}}""" guidStr ) type Generators = static member TestCase () = { new Arbitrary() with override x.Generator = innerGen 5 } let sanitiseInner (r : InnerTypeWithBoth) : InnerTypeWithBoth = { Thing = r.Thing Map = r.Map ReadOnlyDict = r.ReadOnlyDict Dict = r.Dict ConcreteDict = r.ConcreteDict } let sanitiseRec (r : JsonRecordTypeWithBoth) : JsonRecordTypeWithBoth = { r with B = if isNull r.B then "" else r.B C = if Object.ReferenceEquals (r.C, (null : obj)) then [] else r.C D = sanitiseInner r.D E = if isNull r.E then [||] else r.E Arr = if Object.ReferenceEquals (r.Arr, (null : obj)) then [||] else r.Arr } let duGen = gen { let! case = Gen.choose (0, 2) match case with | 0 -> return FirstDu.EmptyCase | 1 -> let! s = ArbMap.generate> ArbMap.defaults return FirstDu.Case1 s.Get | 2 -> let! i = ArbMap.generate ArbMap.defaults let! record = outerGen return FirstDu.Case2 (record, i) | _ -> return failwith $"unexpected: %i{case}" } [] let ``Discriminated union works`` () = let property (du : FirstDu) : unit = du |> FirstDu.toJsonNode |> fun s -> s.ToJsonString () |> JsonNode.Parse |> FirstDu.jsonParse |> shouldEqual du property |> Prop.forAll (Arb.fromGen duGen) |> Check.QuickThrowOnFailure [] let ``DU generator covers all cases`` () = let cases = FSharpType.GetUnionCases typeof let counts = Array.zeroCreate cases.Length let decompose = FSharpValue.PreComputeUnionTagReader typeof let mutable i = 0 let property (du : FirstDu) = let tag = decompose du counts.[tag] <- counts.[tag] + 1 i <- i + 1 true Check.One (Config.Quick, Prop.forAll (Arb.fromGen duGen) property) for i in counts do i |> shouldBeGreaterThan 0 let dict<'a, 'b when 'a : equality> (xs : ('a * 'b) seq) : Dictionary<'a, 'b> = let result = Dictionary () for k, v in xs do result.Add (k, v) result let inline makeJsonArr< ^t, ^u when ^u : (static member op_Implicit : ^t -> JsonNode) and ^u :> JsonNode> (arr : ^t seq) : JsonNode = let result = JsonArray () for a in arr do result.Add a result :> JsonNode let normalise (d : Dictionary<'a, 'b>) : ('a * 'b) list = d |> Seq.map (fun (KeyValue (a, b)) -> a, b) |> Seq.toList |> List.sortBy fst [] let ``Can collect extension data`` () = let str = """{ "message": { "header": "hi", "value": "bye" }, "something": 3, "arr": ["egg", "toast"], "str": "whatnot" }""" |> JsonNode.Parse let expected = { Rest = [ "something", JsonNode.op_Implicit 3 "arr", makeJsonArr [| "egg" ; "toast" |] "str", JsonNode.op_Implicit "whatnot" ] |> dict Message = Some { Header = "hi" Value = "bye" } } let actual = CollectRemaining.jsonParse str actual.Message |> shouldEqual expected.Message normalise actual.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()) |> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ())) [] let ``Can write out extension data`` () = let expected = """{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}""" let toWrite = { Rest = [ "something", JsonNode.op_Implicit 3 "arr", makeJsonArr [| "egg" ; "toast" |] "str", JsonNode.op_Implicit "whatnot" ] |> dict Message = Some { Header = "hi" Value = "bye" } } let actual = CollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString () actual |> shouldEqual expected [] let ``Can collect extension data, nested`` () = let str = """{ "thing": 99, "baz": -123, "remaining": { "message": { "header": "hi", "value": "bye" }, "something": 3, "arr": ["egg", "toast"], "str": "whatnot" } }""" |> JsonNode.Parse let expected : OuterCollectRemaining = { Remaining = { Message = Some { Header = "hi" Value = "bye" } Rest = [ "something", JsonNode.op_Implicit 3 "arr", makeJsonArr [| "egg" ; "toast" |] "str", JsonNode.op_Implicit "whatnot" ] |> dict } Others = [ "thing", 99 ; "baz", -123 ] |> dict } let actual = OuterCollectRemaining.jsonParse str normalise actual.Others |> shouldEqual (normalise expected.Others) let actual = actual.Remaining let expected = expected.Remaining actual.Message |> shouldEqual expected.Message normalise actual.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ()) |> shouldEqual (normalise expected.Rest |> List.map (fun (k, v) -> k, v.ToJsonString ())) [] let ``Can write out extension data, nested`` () = let expected = """{"thing":99,"baz":-123,"remaining":{"message":{"header":"hi","value":"bye"},"something":3,"arr":["egg","toast"],"str":"whatnot"}}""" let toWrite : OuterCollectRemaining = { Others = [ "thing", 99 ; "baz", -123 ] |> dict Remaining = { Rest = [ "something", JsonNode.op_Implicit 3 "arr", makeJsonArr [| "egg" ; "toast" |] "str", JsonNode.op_Implicit "whatnot" ] |> dict Message = Some { Header = "hi" Value = "bye" } } } let actual = OuterCollectRemaining.toJsonNode toWrite |> fun s -> s.ToJsonString () actual |> shouldEqual expected