Imports System

Imports System.Linq

Imports System.Collections

Imports System.Collections.Generic

Imports System.Data

Imports System.IO

Imports System.Globalization

Imports System.Reflection

Imports System.ComponentModel.DataAnnotations

Imports System.Threading

​

Imports Newtonsoft.Json

Imports Newtonsoft.Json.Linq

Imports Newtonsoft.Json.Converters

Imports Newtonsoft.Json.Serialization

​

    ' https://stackoverflow.com/questions/56308478/pass-constructor-arguments-when-deserializing-into-a-listof-t#56308478

​

    Class Document

        Public Property MyObjects as List(Of Child) = new List(Of Child)()

    End Class

​

    Class Child

        Private ReadOnly _Parent As Document

​

        Sub New(Parent As Document)

            _Parent = Parent

        End Sub

​

        Property Foo As String

        Property Bar As String

​

        Function GetParent() As Document

            Return _Parent

        End Function

    End Class

​

    Public Class DocumentContractResolver

        Inherits DefaultContractResolver

​

        Private ActiveDocuments As ThreadLocal(Of Stack(Of Document)) = New ThreadLocal(Of Stack(Of Document))(Function() New Stack(Of Document))

​

        Protected Overrides Function CreateContract(ByVal objectType As Type) As JsonContract

            Dim contract = MyBase.CreateContract(objectType)

            Me.CustomizeDocumentContract(contract)

            Me.CustomizeMyObjectContract(contract)

            Return contract

        End Function

​

        Private Sub CustomizeDocumentContract(ByVal contract As JsonContract)

            If GetType(Document).IsAssignableFrom(contract.UnderlyingType) Then

                contract.OnDeserializingCallbacks.Add(Sub(o, c) ActiveDocuments.Value.Push(CType(o, Document)))

                contract.OnDeserializedCallbacks.Add(Sub(o, c) ActiveDocuments.Value.Pop())

            End If

        End Sub

​

        Private Sub CustomizeMyObjectContract(ByVal contract As JsonContract)

            If (GetType(Child) = contract.UnderlyingType) Then

                contract.DefaultCreator = Function() New Child(ActiveDocuments.Value.Peek())

                contract.DefaultCreatorNonPublic = false

            End If

        End Sub

    End Class

​

    Public Module TestClass 

        Friend Sub Test()

​

            Dim inputDoc = New Document()

            inputDoc.MyObjects.Add(New Child(inputDoc) With { .Foo = "foo", .Bar = "bar" })

​

            Dim contractResolver = New DocumentContractResolver() ' Cache this statically somewhere

            Dim settings = New JsonSerializerSettings() With { .ContractResolver = contractResolver }

​

            Dim jsonString = JsonConvert.SerializeObject(inputDoc, Formatting.Indented, settings)

​

            Console.WriteLine(jsonString)

​

            Dim document = JsonConvert.DeserializeObject(Of Document)(jsonString, settings)

            Assert.IsTrue(document.MyObjects.All(Function(o) document.Equals(o.GetParent())))

            Dim json2 = JsonConvert.SerializeObject(document, Formatting.Indented, settings)

​

            Console.WriteLine(json2)

            Assert.IsTrue(JToken.DeepEquals(JToken.Parse(jsonString), JToken.Parse(json2)))

        End Sub 

    End Module

​

    Public Module Module1   

        Public Sub Main()

        Console.WriteLine("Environment version: " & Environment.Version.ToString())

            Console.WriteLine("Json.NET version: " & GetType(JsonSerializer).Assembly.FullName)

            Console.WriteLine("")

​

            Try

​

                TestClass.Test()

​

            Catch ex as Exception

​

                Console.WriteLine("Unhandled exception: ")

                Console.WriteLine(ex)

                Throw

​

            End Try

        End Sub 

    End Module

​

    Public Class AssertionFailedException

        Inherits Exception

        Public Sub New()

        End Sub

        Public Sub New(message As String)

            MyBase.New(message)

        End Sub

        Public Sub New(message As String, inner As Exception)

            MyBase.New(message, inner)

        End Sub

    End Class

    Public Module Assert

        Public Sub IsTrue(value as Boolean, Optional message as String = "failed")

​

            If value = False Then

                Throw New AssertionFailedException(message)

            End If

        End Sub

    End Module