questions/53193503/pass-additional-data-to-jsonconverter

VbNet · Console

/Program.vb

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 Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Imports Newtonsoft.Json.Converters
Imports Newtonsoft.Json.Serialization

Imports NUnit.Framework

	' https://stackoverflow.com/questions/53193503/pass-additional-data-to-jsonconverter

	' Generics and interfaces

	Public Interface ISerializationContext
		Function TryGetNameTable(Of T)(ByRef table as INameTable(Of T)) as Boolean
	End Interface

	Public Interface INameTable(Of T)
		Function TryGetName(value As T, ByRef name as String) As Boolean	
		Function TryGetValue(name as String, ByRef value as T) As Boolean
	End Interface
	
	Public Class NameTable(Of T) :  Implements INameTable(Of T)
		Public Property Dictionary as Dictionary(Of String, T) = New Dictionary(Of String, T)()

		Public Property ReverseDictionary as Dictionary(Of T, String) = New Dictionary(Of T, String)()

		Public Function Add(value as T, name as String) as T
			Dictionary.Add(name, value)
			ReverseDictionary.Add(value, name)				
			Return value
		End Function

		Public Function TryGetName(value As T, ByRef name as String) As Boolean	Implements INameTable(Of T).TryGetName
			Return ReverseDictionary.TryGetValue(value, name)
		End Function

		Function TryGetValue(name as String, ByRef value as T) As Boolean Implements INameTable(Of T).TryGetValue
			Return Dictionary.TryGetValue(name, value)
		End Function
	End Class

	Public Class ObjectToNameConverter(Of T)
		Inherits JsonConverter

		Public Overrides Function CanConvert(objectType As Type) As Boolean
			Return GetType(T) = objectType
		End Function

		Public Overrides Sub WriteJson(writer As JsonWriter, value As Object, serializer As JsonSerializer)
			Dim tValue = CType(value, T)
			Dim context as ISerializationContext = CType(serializer.Context.Context, ISerializationContext)
			If context Is Nothing
				Throw New JsonSerializationException("No ISerializationContext.")
			End If

			Dim nameTable as INameTable(Of T) = Nothing
			If (Not context.TryGetNameTable(Of T)(nameTable))
				Throw New JsonSerializationException("No NameTable.")
			End If

			Dim name as String = Nothing
			if (Not nameTable.TryGetName(tValue, name))
				Throw New JsonSerializationException("No Name.")
			End If

			writer.WriteValue(name)
		End Sub

		Public Overrides Function ReadJson(reader As JsonReader, objectType As Type, existingValue As Object, serializer As JsonSerializer) As Object
			Dim context as ISerializationContext = CType(serializer.Context.Context, ISerializationContext)
			If context Is Nothing
				Throw New JsonSerializationException("No ISerializationContext.")
			End If

			Dim nameTable as INameTable(Of T) = Nothing
			If (Not context.TryGetNameTable(Of T)(nameTable))
				Throw New JsonSerializationException("No NameTable.")
			End If

			Dim name As String = serializer.Deserialize(Of String)(reader)
			If name Is Nothing Then
				Return Nothing
			End If

			dim tValue as T = Nothing
			nameTable.TryGetValue(name, tValue)
			return tValue
		End Function
	End Class

	' Concrete implementations

	Public Class RootObject
		<JsonConverter(GetType(ObjectToNameConverter(Of SomePropertyClass)))> _
		Public Property SomeProperty As SomePropertyClass	
	End Class

	Public Class SomePropertyClass
	End Class

	Public Class MySerializationContext : Implements ISerializationContext

		Public Function Add(value as SomePropertyClass, name as String) as SomePropertyClass
			Return SomePropertyNameTable.Add(value, name)
		End Function

		Property SomePropertyNameTable as NameTable(Of SomePropertyClass) = New NameTable(Of SomePropertyClass)

		Public Function TryGetNameTable(Of T)(ByRef table as INameTable(Of T)) as Boolean Implements ISerializationContext.TryGetNameTable
			if (GetType(T) Is GetType(SomePropertyClass))
				table = SomePropertyNameTable
				return True
			End If

			table = Nothing
			return False
		End Function
	End Class	
		
	' Test Code
		
	Public Module TestClass	
		Friend Sub Test()
		    Dim context as MySerializationContext = New MySerializationContext()
		    Dim someProperty as SomePropertyClass = context.Add(New SomePropertyClass(), "My Name")
		    Dim root as RootObject = New RootObject With { .SomeProperty = someProperty }
		    Dim settings = new JsonSerializerSettings With _
		    { _
			    .Context = New System.Runtime.Serialization.StreamingContext(System.Runtime.Serialization.StreamingContextStates.All, context)
		    }
		    Dim json as String = JsonConvert.SerializeObject(root, settings)
			Console.WriteLine(json) ' Prints {"SomeProperty":"My Name"}
		    dim root2 as RootObject = JsonConvert.DeserializeObject(Of RootObject)(json, settings)
			' Assert that the same instance of SomeProperty was used during deserialization
		    Assert.IsTrue(root2.SomeProperty Is root.SomeProperty) 
			Assert.IsTrue(json.Equals("{""SomeProperty"":""My Name""}"))
		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