[Fork] 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 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
		
		Private Property NameTable as INameTable(Of T)
		
		Public Sub New(nameTable as INameTable(Of T))
			If nameTable Is Nothing 
				Throw new ArgumentNullException("nameTable")
			End If
			Me.NameTable = nameTable
		End Sub

		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 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 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
		Public Property SomeProperty As SomePropertyClass	
	End Class

	Public Class SomePropertyClass
	End Class

	' Test Code
		
	Public Module TestClass	
		Friend Sub Test()
			dim nameTable = new NameTable(Of SomePropertyClass)()
		    Dim someProperty as SomePropertyClass = nameTable.Add(New SomePropertyClass(), "My Name")
		    Dim root as RootObject = New RootObject With { .SomeProperty = someProperty }
		    Dim settings = new JsonSerializerSettings()
			settings.Converters.Add(new ObjectToNameConverter(Of SomePropertyClass)(nameTable))
						
		    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