IXmlSerializable Dictionary problem - vb.net

I was trying to create a generic Dictionary that implements IXmlSerializable (credit to Charles Feduke).
Here is my trial:
Sub Main()
Dim z As New SerializableDictionary(Of String, String)
z.Add("asdf", "asd")
Console.WriteLine(z.Serialize)
End Sub
Result:
<?xml version="1.0" encoding="utf-16"?><Entry key="asdf" value="asd" />
I placed a breakpoint on top of the WriteXml method and I see that when it stops, the writer contains no data at all, and IMHO it should contain the root element and the xml declaration.
<Serializable()> _
Public Class SerializableDictionary(Of TKey, TValue) : Inherits Dictionary(Of TKey, TValue) : Implements IXmlSerializable
Private Const EntryString As String = "Entry"
Private Const KeyString As String = "key"
Private Const ValueString As String = "value"
Private Shared ReadOnly AttributableTypes As Type() = New Type() {GetType(Boolean), GetType(Byte), GetType(Char), GetType(DateTime), GetType(Decimal), GetType(Double), GetType([Enum]), GetType(Guid), GetType(Int16), GetType(Int32), GetType(Int64), GetType(SByte), GetType(Single), GetType(String), GetType(TimeSpan), GetType(UInt16), GetType(UInt32), GetType(UInt64)}
Private Shared ReadOnly GetIsAttributable As Predicate(Of Type) = Function(t) AttributableTypes.Contains(t)
Private Shared ReadOnly IsKeyAttributable As Boolean = GetIsAttributable(GetType(TKey))
Private Shared ReadOnly IsValueAttributable As Boolean = GetIsAttributable(GetType(TValue))
Private Shared ReadOnly GetElementName As Func(Of Boolean, String) = Function(isKey) If(isKey, KeyString, ValueString)
Public Function GetSchema() As System.Xml.Schema.XmlSchema Implements System.Xml.Serialization.IXmlSerializable.GetSchema
Return Nothing
End Function
Public Sub WriteXml(ByVal writer As XmlWriter) Implements IXmlSerializable.WriteXml
For Each entry In Me
writer.WriteStartElement(EntryString)
WriteData(IsKeyAttributable, writer, True, entry.Key)
WriteData(IsValueAttributable, writer, False, entry.Value)
writer.WriteEndElement()
Next
End Sub
Private Sub WriteData(Of T)(ByVal attributable As Boolean, ByVal writer As XmlWriter, ByVal isKey As Boolean, ByVal value As T)
Dim name = GetElementName(isKey)
If attributable Then
writer.WriteAttributeString(name, value.ToString)
Else
Dim serializer As New XmlSerializer(GetType(T))
writer.WriteStartElement(name)
serializer.Serialize(writer, value)
writer.WriteEndElement()
End If
End Sub
Public Sub ReadXml(ByVal reader As XmlReader) Implements IXmlSerializable.ReadXml
Dim empty = reader.IsEmptyElement
reader.Read()
If empty Then Exit Sub
Clear()
While reader.NodeType <> XmlNodeType.EndElement
While reader.NodeType = XmlNodeType.Whitespace
reader.Read()
Dim key = ReadData(Of TKey)(IsKeyAttributable, reader, True)
Dim value = ReadData(Of TValue)(IsValueAttributable, reader, False)
Add(key, value)
If Not IsKeyAttributable AndAlso Not IsValueAttributable Then reader.ReadEndElement() Else reader.Read()
While reader.NodeType = XmlNodeType.Whitespace
reader.Read()
End While
End While
reader.ReadEndElement()
End While
End Sub
Private Function ReadData(Of T)(ByVal attributable As Boolean, ByVal reader As XmlReader, ByVal isKey As Boolean) As T
Dim name = GetElementName(isKey)
Dim type = GetType(T)
If attributable Then
Return Convert.ChangeType(reader.GetAttribute(name), type)
Else
Dim serializer As New XmlSerializer(type)
While reader.Name <> name
reader.Read()
End While
reader.ReadStartElement(name)
Dim value = serializer.Deserialize(reader)
reader.ReadEndElement()
Return value
End If
End Function
Public Shared Function Serialize(ByVal dictionary As SerializableDictionary(Of TKey, TValue)) As String
Dim sb As New StringBuilder(1024)
Dim sw As New StringWriter(sb)
Dim xs As New XmlSerializer(GetType(SerializableDictionary(Of TKey, TValue)))
xs.Serialize(sw, dictionary)
sw.Dispose()
Return sb.ToString
End Function
Public Shared Function Deserialize(ByVal xml As String) As SerializableDictionary(Of TKey, TValue)
Dim xs As New XmlSerializer(GetType(SerializableDictionary(Of TKey, TValue)))
Dim xr As New XmlTextReader(xml, XmlNodeType.Document, Nothing)
xr.Close()
Return xs.Deserialize(xr)
End Function
Public Function Serialize() As String
Dim sb As New StringBuilder
Dim xw = XmlWriter.Create(sb)
WriteXml(xw)
xw.Close()
Return sb.ToString
End Function
Public Sub Parse(ByVal xml As String)
Dim xr As New XmlTextReader(xml, XmlNodeType.Document, Nothing)
ReadXml(xr)
xr.Close()
End Sub
End Class

Why would it contain a root? You aren't adding one in Serialize, where you create the XmlWriter... I wonder if you should have something more like (C#, sorry):
public string Serialize() {
StringBuilder sb = new StringBuilder();
XmlSerializer ser = new XmlSerializer(
typeof(SerializableDictionary<TKey, TValue>));
using (XmlWriter writer = XmlWriter.Create(sb)) {
ser.Serialize(writer, this);
}
return sb.ToString();
}
This uses the regular XmlSerializer core for things like writing the outer element(s). Alternatively, change Serialize to include an outer element of your choosing.

Not an answer, but I found 2 bugs in Shimmy's code (thanks by the way) and one gotcha for those trying to use this against .Net 2.0
The bugs are related to each other. The calls to:
WriteData(IsKeyAttributable, writer, True, entry.Key)
WriteData(IsValueAttributable, writer, False, entry.Value)
should be
WriteData(IsKeyAttributable, writer, True, DirectCast(entry.Key, TKey))
WriteData(IsValueAttributable AndAlso IsKeyAttributable, writer, False, CType(entry.Value, TValue))
i.e If the Key is not able to be an XML attribute, then the value cannot be an XML attribute. Also, need to cast the entry.Key and entry.Value to it's TKey/TValue, otherwise the XMLSerializer complains later on.
Also
Similarly the call
Dim value = ReadData(Of TValue)(IsValueAttributable, reader, False)
should be
Dim value = ReadData(Of TValue)(IsValueAttributable AndAlso IsKeyAttributable, reader, False)
i.e Agin check that the key is attributale if the value is attributable
And for those targetting .Net runtime 2.0 you will need the GetIsAttributable predicate declared as
Private Shared ReadOnly GetIsAttributable As Predicate(Of Type) = Function(t) DirectCast(AttributableTypes, IList).Contains(t)

Related

VB.NET Group by two columns and write results to an array

I need to group csv data to new csv by column values. I can do it by only one column, but unfortunately it is not enough, because I got duplicates and not achieve my goal. Here is my csv example, there is about 50 columns and last here is column(29) in my input csv:
603;10453;2.12.2020;88,69
603;10453;2.12.2020;88,69
603;10453;4.12.2020;72,69
605;10441;3.12.2020;39,51
605;10441;8.12.2020;25,85
605;10441;9.12.2020;52,91
605;10441;10.12.2020;66,31
605;10441;10.12.2020;66,31
606;10453;11.12.2020;72,69
606;10453;11.12.2020;72,69
607;11202;1.12.2020;250,98
607;11202;1.12.2020;250,98
607;11202;1.12.2020;250,98
607;11202;1.12.2020;250,98
607;11202;1.12.2020;250,98
607;11202;2.12.2020;274,02
607;11202;2.12.2020;274,02
607;11202;2.12.2020;274,02
607;11202;2.12.2020;274,02
607;11202;2.12.2020;274,02
607;11202;2.12.2020;274,02
607;11202;3.12.2020;165,29
607;11202;3.12.2020;165,29
607;11202;3.12.2020;165,29
607;11202;3.12.2020;165,29
607;11202;4.12.2020;75,87
607;11202;5.12.2020;123,24
607;11202;5.12.2020;123,24
607;11202;5.12.2020;123,24
607;11202;7.12.2020;88,69
607;11202;7.12.2020;88,69
And here is my code, where I group values by last column:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim inputFile = "input.csv"
Dim outputFile = "output.csv"
IO.File.WriteAllLines(outputFile, IO.File.ReadLines(inputFile).
Select(Function(x) x.Split(";"c)).
GroupBy(Function(x) {x(0), x(3)}).
Select(Function(x)
Return String.Format(
"{0};{1};{2};{3}",
x.Select(Function(y) y(0)).First,
x.Select(Function(y) y(1)).First,
x.Select(Function(y) y(2)).First,
x.Select(Function(y) y(3)).First)
End Function).ToArray)
End Sub
As you can see in the last column duplicate values and I need group this file by two keys, one of them column(0) or column(1) values and second one is column(3). But I can't figure out how I can I do it with my code.
Desiret outout file have to looks like this:
603;10453;2.12.2020;88,69
603;10453;4.12.2020;72,69
605;10441;3.12.2020;39,51
605;10441;8.12.2020;25,85
605;10441;9.12.2020;52,91
605;10441;10.12.2020;66,31
606;10453;11.12.2020;72,69
607;11202;1.12.2020;250,98
607;11202;2.12.2020;274,02
607;11202;3.12.2020;165,29
607;11202;4.12.2020;75,87
607;11202;5.12.2020;123,24
607;11202;7.12.2020;88,69
Usualy I have to remove duplicates if column(0) and column(2) if they has match.
Thanks for help!
I would use an object oriented approach. Make a wrapper object around each line that does the parsing and provides properties for each value, and then group the result as desired (I choose again the object oriented approach with an equality comparer and distinct).
As I don't know the meaning of the columns I simply assumed something: OrderNo, CustomerNo, OrderDate and Value.
Here's the code for the wrapper class:
Private Class Record
'Constructors
Public Sub New(lineNo As Int32, line As String)
Const expectedColumnCount As Int32 = 4
Const delimiter As String = ";"
If (lineNo < 1) Then Throw New ArgumentOutOfRangeException(NameOf(lineNo), lineNo, "The line number must be positive!")
If (line Is Nothing) Then Throw New ArgumentNullException(NameOf(line))
Dim tokens As String() = Split(line, delimiter, expectedColumnCount + 1, CompareMethod.Binary)
If (tokens.Length <> expectedColumnCount) Then Throw New ArgumentException($"Line {lineNo}: Invalid data row! {expectedColumnCount} '{delimiter}'-delimitered columns expected.")
Me.Tokens = tokens
End Sub
'Public Properties
Public ReadOnly Property OrderNo As String
Get
Return Tokens(0)
End Get
End Property
Public ReadOnly Property CustomerNo As String
Get
Return Tokens(1)
End Get
End Property
Public ReadOnly Property OrderDate As String
Get
Return Tokens(2)
End Get
End Property
Public ReadOnly Property Value As String
Get
Return Tokens(3)
End Get
End Property
'Private Properties
Private ReadOnly Property Tokens As String()
End Class
And this is the comparer that does the grouping:
Private Class RecordComparer
Implements IEqualityComparer(Of Record)
Private Sub New()
End Sub
Public Shared ReadOnly Property Singleton As New RecordComparer()
Public Function Equals(x As Record, y As Record) As Boolean Implements IEqualityComparer(Of Record).Equals
If (Object.ReferenceEquals(x, y)) Then Return True
If (x Is Nothing) OrElse (y Is Nothing) Then Return False
Return Comparer.Equals(x.OrderNo, y.OrderNo) AndAlso Comparer.Equals(x.CustomerNo, y.CustomerNo) AndAlso Comparer.Equals(x.Value, y.Value)
End Function
Public Function GetHashCode(obj As Record) As Integer Implements IEqualityComparer(Of Record).GetHashCode
If (obj Is Nothing) Then Return 42
Return Comparer.GetHashCode(obj.OrderNo) Xor Comparer.GetHashCode(obj.CustomerNo) Xor Comparer.GetHashCode(obj.Value)
End Function
Private Shared ReadOnly Comparer As IEqualityComparer(Of String) = StringComparer.Ordinal
End Class
and finally the usage:
'Convert input lines to simple objects
Dim i As Int32 = 1
Dim dataRows As New List(Of Record)()
For Each line As String In File.ReadLines(inputFile)
Dim data As New Record(i, line)
dataRows.Add(data)
i += 1
Next
'Group by the 3 columns (the DateTime is kind of random, no guarantee which object wins)
Dim consolidatedRows As IEnumerable(Of Record) = dataRows.Distinct(SimpleInputDataComparer.Singleton)
'Convert and export lines
Dim outputLines As IEnumerable(Of String) = consolidatedRows.Select(Function(e) $"{e.OrderNo};{e.CustomerNo};{e.OrderDate};{e.Value}")
File.WriteAllLines(outputFile, outputLines)
I got it work. For my goal I used Christoph example. Finaly my code looks like this:
Public Class TempClass
Public Property ID As String
Public Property day As String
Public Property OriginalStr As String
End Class
Public Class TempIDComparer
Implements IEqualityComparer(Of TempClass)
Private Function IEqualityComparer_Equals(x As TempClass, y As TempClass) As Boolean Implements IEqualityComparer(Of TempClass).Equals
If ReferenceEquals(x, y) Then
Return True
End If
If ReferenceEquals(x, Nothing) OrElse ReferenceEquals(y, Nothing) Then
Return False
End If
Return x.ID = y.ID AndAlso x.day = y.day
End Function
Private Function IEqualityComparer_GetHashCode(obj As TempClass) As Integer Implements IEqualityComparer(Of TempClass).GetHashCode
If obj Is Nothing Then Return 0
Return obj.ID.GetHashCode()
End Function
End Class
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim inputFile = "input.csv"
Dim outputFile = "output.csv"
Dim list As List(Of TempClass) = New List(Of TempClass)()
Dim ls As List(Of String()) = New List(Of String())()
Dim fileReader As StreamReader = New StreamReader(inputFile)
Dim strLine As String = ""
While strLine IsNot Nothing
strLine = fileReader.ReadLine()
If strLine IsNot Nothing AndAlso strLine.Length > 0 Then
Dim t As TempClass = New TempClass() With {
.ID = strLine.Split(";"c)(0),
.day = strLine.Split(";"c)(3),
.OriginalStr = strLine
}
list.Add(t)
End If
End While
fileReader.Close()
Dim tempList = list.Distinct(New TempIDComparer())
Dim fileWriter As StreamWriter = New StreamWriter(outputFile, False, System.Text.Encoding.Default)
For Each item In tempList.ToList()
fileWriter.WriteLine(item.OriginalStr)
Next
fileWriter.Flush()
fileWriter.Close()
End Sub

Populate class from query on VB Net

Help translate C# code from this link Simplest way to populate class from query in C# to VB Net.
Option Infer On
Imports System.Reflection
Private Sub Main()
Dim connectionString = "..."
Dim records = (New Query(connectionString)).SqlQuery(Of TVChannel)("select top 10 * from TVChannel")
End Sub
Private Class TVChannel
Public Property number() As String
Public Property title() As String
Public Property favoriteChannel() As String
Public Property description() As String
Public Property packageid() As String
Public Property format() As String
End Class
Public Class Query
Private ReadOnly _connectionString As String
Public Sub New(ByVal connectionString As String)
_connectionString = connectionString
End Sub
Public Function SqlQuery(Of T)(ByVal query As String) As List(Of T)
Dim result = New List(Of T)()
Using connection = New SqlConnection(_connectionString)
connection.Open()
Using command = connection.CreateCommand()
command.CommandText = query
Using reader = command.ExecuteReader()
Dim columns = Enumerable.Range(0, reader.FieldCount).Select(Function(f) reader.GetName(f)).ToArray()
Dim properties = GetType(T).GetProperties()
Do While reader.Read()
Dim data = New Object(reader.FieldCount - 1){}
reader.GetValues(data)
Dim instance = DirectCast(Activator.CreateInstance(GetType(T)), T)
For i = 0 To data.Length - 1
If data(i) Is DBNull.Value Then
data(i) = Nothing
End If
Dim [property] = properties.SingleOrDefault(Function(x) x.Name.Equals(columns(i), StringComparison.InvariantCultureIgnoreCase))
If [property] IsNot Nothing Then
[property].SetValue(instance, Convert.ChangeType(data(i), [property].PropertyType))
End If
Next i
result.Add(instance)
Loop
End Using
End Using
End Using
Return result
End Function
End Class
but, I got error on this line
Dim instance = DirectCast(Activator.CreateInstance(GetType(T)), T)
System.MissingMethodException: 'No parameterless constructor defined for this object.'
This is a much better pattern to follow. It addresses at least four issues in the original code (sql injection, Nothing vs null, constructor access, unnecessary allocations):
Public Module SQL
Private ReadOnly _connectionString As String = "..."
Public Iterator Function Query(Of T)(ByVal query As String, translate As Func(IDataRecord, T), ParamArray data() As SqlParameter) As IEnumerable(Of T)
Using connection As New SqlConnection(_connectionString), _
command As New SqlCommand(query, connection)
If data IsNot Nothing Then command.Parameters.AddRange(data)
connection.Open()
Using reader As SqlDataReader = command.ExecuteReader()
While reader.Read()
Yield translate(reader)
End While
reader.Close()
End Using
End Using
End Function
End Module
Call it like this:
Private Sub Main()
Dim records = SQL.Query("select top 10 * from TVChannel",
Function(r)
'Yes, you're doing the mapping manually now for each query.
'But this lets you properly account for things NULL, column name mismatches, computed properties, etc.
Return New TVChannel With {
.number = r["number"],
.title = r["title"],
.favoriteChannel = r["favoriteChannel"],
.description = r["description"],
.packageid = r["packageid"],
.format = r["format"]
}
End Function,
Nothing)
For Each channel As TVChannel In records
Console.WriteLine($"Channel {channel.number}, {channel.title}")
Next
End Sub

Pass additional data to JsonConverter

I deserialize object where one of the properties is a foreign key (eg an identity value from a database table). During deserialization I would like to use a JsonConverter to retrieve the corresponding object from a collection.
I know how to write a use custom JsonConverters. I don't know how to pass the collection to the JsonConverter, because the converter is specified at design time (like below), but the collection obviously only exists at runtime:
<JsonConverter(GetType(JSonCustomConverter))>
Public Property SomeProperty As SomePropertyClass
So the JSonCustomConverter's ReadJson should look this:
Public Overrides Function ReadJson(reader As JsonReader, objectType As Type, existingValue As Object, serializer As JsonSerializer) As Object
If reader.Value Is Nothing Then Return False
Dim value As String = reader.Value.ToString().Trim()
retun MagicallyGetMyCollectionValue(value)
End Function
So the silly function name MagicallyGetMyCollectionValue is just a placeholder to show you where I am stuck. I don't want to access the collection through a global variable, but I don't know how to pass the collection to the ReadJson either.
I would be happy, if someone could point me in the right direction.
Edit: Let me try to give a better example.
Suppose I have the following class:
class ParentObject
<JssonConverter(GetType(JsonCustomConverter))>
Property SomeProperty As SomePropertyClass
end class
I would deserialize my json data like this:
dim result = JsonConvert.DeserializeObject(jsonData, GetType(ParentObject))
Now assume, that the json data doesn't contain the complete representation of an instance of the SomePropertyClass, but only a key value e.g. an key as string. Suppose I have a collection like this:
dim cache as Dictionary(of string, SomePropertyClass)
That cache shall contain all the instances that I need. So my JSonCustomConverter should have a ReadJson Function like this:
Public Overrides Function ReadJson(reader As JsonReader, objectType As Type, existingValue As Object, serializer As JsonSerializer) As Object
If reader.Value Is Nothing Then Return nothing
Dim value As String = reader.Value.ToString().Trim()
Dim cachedObject as SomePropertyClass = nothing
if cache.TryGetValue(value, cachedObject) then return cachedObject
retun Nothing ' or new SomePropertyClass(value)
End Function
So I want the ReadJson to lookup the instance based on the key value.
How would I pass the cache-Dictionary into the ReadJson function? I could use a singelton class that contains the cache an som getInstance-method to retrieve it, but I wouldn't want to do this.
You can pass additional data to your custom JsonConverter using StreamingContext.Context via JsonSerializer.Context. Using this mechanism it becomes possible to map class instances to names in a generic manner.
First, define the following interfaces and generic converter:
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
Next, define the following 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
Now, you can replace instances of SomePropertyClass with their names during deserialization as follows:
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""}"))
Notes:
ISerializationContext.TryGetNameTable(Of T)(ByRef table as INameTable(Of T)) is generic so that object-to-name replacement can be supported for multiple types of objects simultaneously without the converters interfering with each other.
The concrete implementation need not be so generic, however. Here MySerializationContext only supports name replacement for instances of SomePropertyClass. Others could be added as needed.
As stated in Does Json.NET cache types' serialization information?, Newtonsoft recommends caching instances of DefaultContractResolver and its subtypes for best performance. Thus it may be preferable to pass additional data via StreamingContext.Context rather than via freshly allocated instances of subclasses of DefaultContractResolver.
Sample working .Net fiddle #1 here.
As an alternative, while the design above works, in my opinion it would be simpler to remove <JsonConverter(GetType(ObjectToNameConverter(Of SomePropertyClass)))> from SomeProperty and instead pass an appropriately initialized ObjectToNameConverter(Of SomePropertyClass), containing a local reference to some INameTable(Of SomePropertyClass), in JsonSerializerSettings.Converters.
Define the converter and interfaces like so. Notice that ObjectToNameConverter(Of T) now has a parameterized constructor and that ISerializationContext is no longer required:
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
Then serialize as follows:
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""}"))
Doing things this way eliminates the dependence of static serialization methods on runtime code that is present in the first solution. Now all name replacement logic is handled in runtime in one location.
Sample fiddle #2 here.
As requested by #doom87er I will share the code, that worked for me. The solution is based on the comment by #dbc, with some changes. Please treat below code more like a conceptual code: I had to change some of the names and leave out some logik, that isn't required for this proof of concept. So there might be typos in it.
The main solution is to subclass the DefaultContractResolver and add the the cache-dictionary to that class. Something like this:
Public Class CacheContractResolver
Inherits DefaultContractResolver
Public Cache As Dictionary(of string, SomePropertyClass)
Public Sub New(preFilledCache As Dictionary(of string, SomePropertyClass)
Me.Cache = preFilledCache
End Sub
End Class
Then you pass the custom contract resolver using the JsonSerializerSettings like this:
Dim settings = New JsonSerializerSettings
settings.ContractResolver = New SupportControllerContractResolver(prefilledCache)
Dim result = JsonConvert.DeserializeObject(Of ParentObject)(jsonData, settings)
where prefilledCache is an instance of a dictionary containing the SomePropertyClass-objects.
The last step is to retrieve the cache in my JsonConverter's ReadJson function (that I attached to the SomeProperty as shown in the original post's sample code):
Public Overrides Function ReadJson(reader As JsonReader, objectType As Type, existingValue As Object, serializer As JsonSerializer) As Object
Dim cacheResolver = TryCast(serializer.ContractResolver, CacheContractResolver)
if cacheResolver is nothing return nothing ' add some better null handling here
Dim value As String = reader.Value.ToString().Trim()
Dim cachedObject as SomePropertyClass = nothing
if cacheResolver.Cache.TryGetValue(value, cachedObject) then return cachedObject
retun Nothing ' or new SomePropertyClass(value)
End Function
I tried it and it seems to work.
So in a nut shell:
Subclass the DefaultContractResolver and include all the additional data, that you need.
Pass an instance of you custom contract resolver with the additional data in the JsonSerializerSettings.
In your JsonConverter trycast the passed contract resolver back to your custom contract resolver and there you have your additional data.
I would be happy if you comment on any catches that I might miss, but I think this should be solution that I can live with.
Thanks for you coments and help.
Sascha

Create Custom Class Dynamically

I am working on a project where I need to create a multitude of custom classes to interact properly with an API (While I know there might be questions on why, and such, but the short is it has to be this way).
Is there a way to create a complete custom class dynamically on the fly? So instead of
class person
Private _Height
Property Height As Integer
Get
Return _Height
End Get
Set(value As Integer)
_Height = value
End Set
End Property
'Continue for all properties of person
I would like to be able to create a new object and through other input create this dynamically.
dim NewClass as object
dim NewProperty as property
NewProperty.name="Height"
NewProperty.datatype=string
NewClass.AddProperty(NewProperty)
Is this possible? It would save me a lot of time if it is.
I don't like late binding but there are options (I like my option strict on). Like using the DynamicObject or the ExpandoObject class. Your question is vague so I have no idea if it can work.
Sub Main()
Dim test As Object = New SampleDynamicClass()
test.SomeProperty = "123"
Console.WriteLine(test.SomeProperty)
Console.ReadLine()
End Sub
Public Class SampleDynamicClass
Inherits DynamicObject
Private _values As New Dictionary(Of String, String)
Public Sub New()
End Sub
Public Function GetPropertyValue(ByVal propertyName As String) As String
Return _values(propertyName)
End Function
Public Function SetPropertyValue(ByVal propertyName As String, ByVal value As Object) As Boolean
If _values.ContainsKey(propertyName) Then
_values(propertyName) = value.ToString()
Else
_values.Add(propertyName, value.ToString())
End If
Return True
End Function
Public Overrides Function TryGetMember(ByVal binder As GetMemberBinder,
ByRef result As Object) As Boolean
result = GetPropertyValue(binder.Name)
Return If(result Is Nothing, False, True)
End Function
Public Overrides Function TryInvokeMember(ByVal binder As InvokeMemberBinder,
ByVal args() As Object,
ByRef result As Object) As Boolean
result = GetPropertyValue(binder.Name)
Return If(result Is Nothing, False, True)
End Function
Public Overrides Function TrySetMember(binder As SetMemberBinder, value As Object) As Boolean
Return SetPropertyValue(binder.Name, value)
End Function
Dim person = New With {Key .Height = 12}
Dim personTypes = New With {Key .Happy = 1, .Sad = 2}
Dim personsAndTypes = New With {Key .Person = person, .Type = personTypes}
The question is kind of vague, but if you have no need for other fields and methods, or reuse Anonymous Types

LongListSelector not working (not navigating to other pages)

I have implemented a LongListSelector for my Windows Phone 7 app. However when I tap an item it doesn't navigate to the desired page. Does anyone know why and how this can be fixed? Below is my code. Each page has it's own uri and I want to navigate to different pages.
All help would be very much appreciated.
Many thanks
Code:
Imports System.Linq
Imports Microsoft.Phone.Controls
Partial Public Class Victoria_line
Inherits PhoneApplicationPage
Public Sub New()
InitializeComponent()
Dim source As New List(Of JumpDemo)()
source.Add(New JumpDemo() With { _
.Name = "Blackhorse Road", _
.FareZone = "Fare zone 3", _
.GroupBy = "b", _
.Link = "/Lines and Stations/Victoria/Blackhorse_Road_(Victoria).xaml" _
})
source.Add(New JumpDemo() With { _
.Name = "Warren Street", _
.FareZone = "Fare zone 1", _
.GroupBy = "w", _
.Link = "/Lines and Stations/Victoria/Warren_Street_(Victoria).xaml" _
})
Dim MygroupBy = From jumpdemo In source _
Group jumpdemo By jumpdemo.GroupBy Into c = Group _
Order By GroupBy _
Select New _
Group(Of JumpDemo)(GroupBy, c)
Me.Victoria_line.ItemsSource = MygroupBy
End Sub
Private Sub Victoria_line_SelectionChanged(ByVal sender As Object, ByVal e As SelectionChangedEventArgs)
If Victoria_line.SelectedItem = Nothing Then
Return
End If
Dim addressString As String = "/StationPage.xaml"
Dim pageUri As Uri = New Uri(addressString, UriKind.Relative)
NavigationService.Navigate(pageUri)
' Reset selected item to -1 (no selection)
Victoria_line.SelectedItem = Nothing
End Sub
End Class
Public Class Group(Of T)
Implements IEnumerable(Of T)
Public Sub New(name As String, items As IEnumerable(Of T))
Me.Title = name
Me.Items = New List(Of T)(items)
End Sub
Public Overrides Function Equals(obj As Object) As Boolean
Dim that As Group(Of T) = TryCast(obj, Group(Of T))
Return (that IsNot Nothing) AndAlso (Me.Title.Equals(that.Title))
End Function
Public Property Title() As String
Get
Return m_Title
End Get
Set(value As String)
m_Title = value
End Set
End Property
Private m_Title As String
Public Property Items() As IList(Of T)
Get
Return m_Items
End Get
Set(value As IList(Of T))
m_Items = value
End Set
End Property
Private m_Items As IList(Of T)
Public Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
Return Me.Items.GetEnumerator()
End Function
Private Function System_Collections_IEnumerable_GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return Me.Items.GetEnumerator()
End Function
End Class
Public Class Victoria
Public Property Name() As String
Get
Return m_Name
End Get
Set(value As String)
m_Name = value
End Set
End Property
Private m_Name As String
Public Property FareZone() As String
Get
Return m_FareZone
End Get
Set(value As String)
m_FareZone = value
End Set
End Property
Private m_FareZone As String
Public Property GroupBy() As String
Get
Return m_GroupBy
End Get
Set(value As String)
m_GroupBy = value
End Set
End Property
Private m_GroupBy As String
Public Property Link() As Uri
Get
Return m_Link
End Get
Set(value As Uri)
m_Link = value
End Set
End Property
Private m_Link As Uri
End Class
If what you are trying to achieve is navigate to another page when you tap on an item you should just register for the Tap event inside your Item DataTemplate and in the event handler do something like this:
Private Sub Item_Tap(sender As Object, e As GestureEventArgs)
Dim element As FrameworkElement = TryCast(sender, FrameworkElement)
Dim item As JumpDemo = TryCast(element.DataContext, JumpDemo)
Dim addressString As String = item.Link
Dim pageUri As Uri = New Uri(addressString, UriKind.Relative)
NavigationService.Navigate(pageUri)
End Sub