-
May 5th, 2016, 03:47 PM
#1
JSON to XDocument converter
The following code converts JSON data into an XDocument:
Code:
Option Strict On
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text.RegularExpressions
Imports System.Xml
Imports System.Xml.Linq
Public Module JSON
Private Function Scan(ByVal source As String) As Token()
Dim tempSource As String = source
Dim lexedTokens As New List(Of Token)
Dim scanDelegates() As Scan_NonTerminal = {New Scan_NonTerminal(AddressOf Scan_String), New Scan_NonTerminal(AddressOf Scan_Number), New Scan_NonTerminal(AddressOf Scan_Boolean), New Scan_NonTerminal(AddressOf Scan_Literal), New Scan_NonTerminal(AddressOf Scan_Whitespace)}
Dim index As Integer = 0
Dim t As Token
Do
index = 0
Do
t = scanDelegates(index).Invoke(tempSource)
If t IsNot Nothing Then
lexedTokens.Add(t)
End If
index += 1
Loop Until tempSource.Length = 0 OrElse index = scanDelegates.Length
Loop Until tempSource.Length = 0
Return lexedTokens.ToArray()
End Function
Private Delegate Function Scan_NonTerminal(ByRef source As String) As Token
Private Function Scan_String(ByRef source As String) As Token
Dim m As Match = Regex.Match(source, """([^""\\]|\\[""\\\/bfnrt])*""")
Dim t As Token = Nothing
If m.Success AndAlso m.Index = 0 Then
Dim literal As String = m.Value.Remove(0, 1)
literal = literal.Remove(literal.Length - 1)
t = New Token("string", literal)
source = source.Substring(m.Value.Length)
End If
Return t
End Function
Private Function Scan_Number(ByRef source As String) As Token
Dim m As Match = Regex.Match(source, "\d+((\.\d+)?((e|E)[+-]?\d+)?)")
Dim t As Token = Nothing
If m.Success AndAlso m.Index = 0 Then
t = New Token("number", m.Value)
source = source.Substring(m.Value.Length)
End If
Return t
End Function
Private Function Scan_Boolean(ByRef source As String) As Token
Dim t As Token = Nothing
If source.StartsWith("true", StringComparison.OrdinalIgnoreCase) OrElse source.StartsWith("null", StringComparison.OrdinalIgnoreCase) Then
t = New Token("boolean", source.Substring(0, 4))
source = source.Substring(4)
ElseIf source.StartsWith("false", StringComparison.OrdinalIgnoreCase) Then
t = New Token("boolean", source.Substring(0, 5))
source = source.Substring(5)
End If
Return t
End Function
Private Function Scan_Literal(ByRef source As String) As Token
Dim literals() As Char = "[]{}:,".ToCharArray()
Dim t As Token = Nothing
If Array.IndexOf(literals, source(0)) <> -1 Then
t = New Token("literal", source(0))
source = source.Remove(0, 1)
End If
Return t
End Function
Private Function Scan_Whitespace(ByRef source As String) As Token
Dim m As Match = Regex.Match(source, "\s+")
Dim t As Token = Nothing
If m.Success AndAlso m.Index = 0 Then
source = source.Substring(m.Value.Length)
End If
Return t
End Function
Public Function Parse(ByVal source As String) As XDocument
Dim doc As XDocument = Nothing
Dim tokens() As Token = Scan(source)
Dim json As XElement = Parse_Object(tokens)
If json IsNot Nothing Then
json.Name = "json"
doc = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), json)
End If
Return doc
End Function
Private Function Parse_Object(ByRef tokens() As Token) As XElement
Dim x As XElement = Nothing
Dim tempTokens As New Queue(Of Token)(tokens)
If tempTokens.Count >= 2 AndAlso tempTokens.Dequeue().Value = "{" Then
If tempTokens.Peek().Value <> "}" Then
Dim pairs As New List(Of XElement)
Dim key As XElement = Nothing
Dim value As XElement = Nothing
Do
If tempTokens.Peek().Category = "string" Then
key = New XElement("key", tempTokens.Dequeue().Value)
If tempTokens.Peek().Value = ":" Then
tempTokens.Dequeue()
value = Parse_Value(tempTokens)
If value IsNot Nothing Then
pairs.Add(New XElement("pair", {key, value}))
End If
End If
End If
Loop While value IsNot Nothing AndAlso tempTokens.Count > 0 AndAlso tempTokens.Peek.Value <> "}" AndAlso tempTokens.Dequeue.Value = ","
If tempTokens.Peek().Value = "}" Then
tempTokens.Dequeue()
x = New XElement("object")
For Each item As XElement In pairs
value = item.Descendants.ElementAt(1)
value.SetAttributeValue("key", item.Descendants.ElementAt(0).Value)
x.Add(value)
Next
tokens = tempTokens.ToArray()
End If
Else
tempTokens.Dequeue()
x = New XElement("object")
tokens = tempTokens.ToArray()
End If
End If
Return x
End Function
Private Function Parse_Array(ByRef tokens As Queue(Of Token)) As XElement
Dim x As XElement = Nothing
Dim tempTokens As New Queue(Of Token)(tokens)
If tempTokens.Count >= 2 AndAlso tempTokens.Dequeue().Value = "[" Then
If tempTokens.Peek().Value <> "]" Then
Dim pairs As New List(Of XElement)
Dim value As XElement = Nothing
Do
value = Parse_Value(tempTokens)
If value IsNot Nothing Then
pairs.Add(New XElement("item", value))
End If
Loop While value IsNot Nothing AndAlso tempTokens.Count > 0 AndAlso tempTokens.Peek.Value <> "]" AndAlso tempTokens.Dequeue.Value = ","
If tempTokens.Peek().Value = "]" Then
tempTokens.Dequeue()
x = New XElement("array", pairs)
tokens = tempTokens
End If
Else
tempTokens.Dequeue()
x = New XElement("array")
tokens = tempTokens
End If
End If
Return x
End Function
Private Function Parse_Value(ByRef tokens As Queue(Of Token)) As XElement
Dim x As XElement = Nothing
Dim firstToken As Token = tokens.Peek
Dim category As String = firstToken.Category
Dim value As String = firstToken.Value
If category = "number" OrElse category = "boolean" OrElse category = "string" Then
x = New XElement(category, tokens.Dequeue.Value)
Else
Dim tempTokens() As Token = tokens.ToArray()
If value = "{" Then
x = Parse_Object(tempTokens)
If x IsNot Nothing Then
tokens = New Queue(Of Token)(tempTokens)
End If
ElseIf value = "[" Then
x = Parse_Array(tokens)
End If
End If
Return x
End Function
End Module
Public Class Token
Private _category As String
Public Property Category As String
Get
Return _category
End Get
Set(ByVal value As String)
If Not String.Equals(_category, value) Then
_category = value
End If
End Set
End Property
Private _value As String
Public Property Value As String
Get
Return _value
End Get
Set(ByVal value As String)
If Not String.Equals(_value, value) Then
_value = value
End If
End Set
End Property
Protected Overridable Sub OnCategoryChanged()
RaiseEvent CategoryChanged(Me, EventArgs.Empty)
End Sub
Protected Overridable Sub OnValueChanged()
RaiseEvent ValueChanged(Me, EventArgs.Empty)
End Sub
Public Event CategoryChanged(ByVal sender As Object, ByVal e As EventArgs)
Public Event ValueChanged(ByVal sender As Object, ByVal e As EventArgs)
Public Sub New()
_category = String.Empty
_value = String.Empty
End Sub
Public Sub New(ByVal category As String, ByVal value As String)
_category = category
_value = value
End Sub
End Class
Fiddle: https://dotnetfiddle.net/xjykxk
Basically the way that it works is that it first scans the source code using a lexical analyzer to return a collection of Tokens and then uses a recursive descent parser to validate that the tokens are syntactically correct all while building the XDocument.
I hope you enjoy and please let me know if you find a source code that gives an error.
For a scannerless parser see post #11 & #12.
For most up-to-date code, see post #15
Last edited by dday9; Aug 23rd, 2018 at 01:33 PM.
-
May 6th, 2016, 10:07 AM
#2
Re: JSON to XDocument converter
Very nice.
I've tested it with a bunch of JSON - it's slow with large sets of data.
Here's an example of a nice complicated JSON. I've got a couple of questions on why some things are going on - posted right into the XML - just scroll down...
Code:
{
"boottab": ["run"],
"operators": [],
"editkey": "RealParameter",
"awcoptions": {
"nosort": true,
"awcdisplay": true
},
"heading": "Bid Activity (enter Selections below and click the RUN icon to the left)",
"tabcaption": "Bid Activity",
"acs-work": "slickgrid",
"options": {
"editable": true,
"enableAddRow": false,
"enableCellNavigation": true,
"asyncEditorLoading": false
},
"columns": [{
"id": "Parameter",
"name": "Display Parameters",
"field": "Parameter",
"width": "225",
"sortable": "false",
"unselectable": "true",
"unfocusable": "true",
"cssClass": "cell-title"
}, {
"id": "Selection",
"name": "Selection",
"field": "Selection",
"width": "225",
"sortable": "false",
"cssClass": "cell-title",
"editor": "eval('ReportCellEditor')"
}, {
"id": "Validation",
"name": "Validation",
"field": "Validation",
"width": "120",
"sortable": "false",
"unselectable": "true",
"unfocusable": "true",
"cssClass": "cell-title"
}],
"rowcount": "1",
"source": [{
"Parameter": "BidId",
"Selection": "",
"DataType": "varchar",
"ParamMode": "IN",
"MaxLen": "100",
"RealParameter": "@BidId",
"Validation": ""
}]
}
Turns into this XML
Code:
<json>
<object>
<key>boottab</key>
<array>
<item>
<string>"run"</string> <------ Why retain those quotes??
</item>
</array>
</object>
<object>
<key>operators</key>
<array />
</object>
<object>
<key>editkey</key>
<string>"RealParameter"</string>
</object>
<object>
<key>awcoptions</key>
<object> <------ why OBJECT and then another OBJECT?
<object>
<key>nosort</key>
<boolean>true</boolean>
</object>
<object>
<key>awcdisplay</key>
<boolean>true</boolean>
</object>
</object>
</object>
<object>
<key>heading</key>
<string>"Bid Activity (enter Selections below and click the RUN icon to the left)"</string>
</object>
<object>
<key>tabcaption</key>
<string>"Bid Activity"</string>
</object>
<object>
<key>acs-work</key>
<string>"slickgrid"</string>
</object>
<object>
<key>options</key>
<object>
<object>
<key>editable</key>
<boolean>true</boolean>
</object>
<object>
<key>enableAddRow</key>
<boolean>false</boolean>
</object>
<object>
<key>enableCellNavigation</key>
<boolean>true</boolean>
</object>
<object>
<key>asyncEditorLoading</key>
<boolean>false</boolean>
</object>
</object>
</object>
<object>
<key>columns</key>
<array>
<item>
<object>
<object>
<key>id</key>
<string>"Parameter"</string>
</object>
<object>
<key>name</key>
<string>"Display Parameters"</string>
</object>
<object>
<key>field</key>
<string>"Parameter"</string>
</object>
<object>
<key>width</key>
<string>"225"</string>
</object>
<object>
<key>sortable</key>
<string>"false"</string>
</object>
<object>
<key>unselectable</key>
<string>"true"</string>
</object>
<object>
<key>unfocusable</key>
<string>"true"</string>
</object>
<object>
<key>cssClass</key>
<string>"cell-title"</string>
</object>
</object>
</item>
<item>
<object>
<object>
<key>id</key>
<string>"Selection"</string>
</object>
<object>
<key>name</key>
<string>"Selection"</string>
</object>
<object>
<key>field</key>
<string>"Selection"</string>
</object>
<object>
<key>width</key>
<string>"225"</string>
</object>
<object>
<key>sortable</key>
<string>"false"</string>
</object>
<object>
<key>cssClass</key>
<string>"cell-title"</string>
</object>
<object>
<key>editor</key>
<string>"eval('ReportCellEditor')"</string>
</object>
</object>
</item>
<item>
<object>
<object>
<key>id</key>
<string>"Validation"</string>
</object>
<object>
<key>name</key>
<string>"Validation"</string>
</object>
<object>
<key>field</key>
<string>"Validation"</string>
</object>
<object>
<key>width</key>
<string>"120"</string>
</object>
<object>
<key>sortable</key>
<string>"false"</string>
</object>
<object>
<key>unselectable</key>
<string>"true"</string>
</object>
<object>
<key>unfocusable</key>
<string>"true"</string>
</object>
<object>
<key>cssClass</key>
<string>"cell-title"</string>
</object>
</object>
</item>
</array>
</object>
<object>
<key>rowcount</key>
<string>"1"</string>
</object>
<object>
<key>source</key>
<array>
<item>
<object>
<object>
<key>Parameter</key>
<string>"BidId"</string>
</object>
<object>
<key>Selection</key>
<string>""</string>
</object>
<object>
<key>DataType</key>
<string>"varchar"</string>
</object>
<object>
<key>ParamMode</key>
<string>"IN"</string>
</object>
<object>
<key>MaxLen</key>
<string>"100"</string>
</object>
<object>
<key>RealParameter</key>
<string>"@BidId"</string>
</object>
<object>
<key>Validation</key>
<string>""</string>
</object>
</object>
</item>
</array>
</object>
</json>
-
May 6th, 2016, 10:11 AM
#3
Re: JSON to XDocument converter
This one seems to make it blow up
Code:
{
"username": "szlamany",
"toddtype": "misctables",
"choice": 0,
"id": "btn-misctables",
"objReturn": {
"fiscalyr": "2016",
"pp": "2016019",
"reason": "All",
"doctype": "Vendor"
},
"fromddtype": "misc",
"fromwho": "AWCMiscTables_T",
"newkeys": [],
"updkeys": [],
"reload": false,
"editkey": "RowKey",
"addkey": "",
"popupkey": "",
"sguid": "9b11f14b-eb5b-467a-b752-16a21d2a5bf9",
"extrakeys": {},
"source": [{
"MTDescription": "Acctfiles_T",
"MTTable": "Acctfiles_T",
"AllowAdds": "",
"SystemTable": "Y",
"Flag1": "x",
"Flag2": "",
"RowKey": "Acctfiles_T",
"awcRowDirty": "Y"
}]
}
-
May 6th, 2016, 10:38 AM
#4
Re: JSON to XDocument converter
It should not have kept the double quotes in:
Code:
<string>"run"</string>
I located the problem though, in my ParseValue method I am not removing the double quotes if the token is a String. I will be sure to fix that.
However, I do not know why it adds the extra <object> tag for the object with the key awcoptions. That is very odd. I will be sure to step through the code and see what is causing it.
As far as your 3rd post, it is because of this line:
I did not know that you have have an object in JSON without a key/value pair. Could you confirm this and if so then I'll correct it.
-
May 6th, 2016, 10:53 AM
#5
Re: JSON to XDocument converter
Originally Posted by dday9
As far as your 3rd post, it is because of this line:
I did not know that you have have an object in JSON without a key/value pair. Could you confirm this and if so then I'll correct it.
That is correct. Both OBJECTS and ARRAYS (which are really objects internally in JavaScript anyway) can be EMPTY.
These are real back and forth AJAX posts from one of my database clients. And you can always go to JSONLINT.COM to verify the JSON.
-
May 6th, 2016, 10:57 AM
#6
Re: JSON to XDocument converter
You use <JSON> as the PARENT to the initial OBJECT - and then list KVP's (key-value pairs) and put them in <Object> wrappers.
Then you get another OBJECT you make the PARENT be another <OBJECT> and then those children KVP's appear in additional <Object> wrappers.
Is this the reason for <OBJECT> appearing twice like that?
-
May 6th, 2016, 05:10 PM
#7
Re: JSON to XDocument converter
Alright, so I have optimized the lexical analyzer phase to not only be faster than what it previously was but I also remove the opening/closing quotes from string values.
I have also fixed it to accept blank objects/arrays.
The way that objects are handled is that it will create:
Code:
<object>
<pair>
<key>...</key>
<...>...</...>
</pair>
</object>
-
May 7th, 2016, 05:21 AM
#8
Re: JSON to XDocument converter
If it's like a legit XML shouldn't it be
{ "test": "value" }
Code:
<object>
<key name="test">value</key>
</object>
If you think of the railroad diagram which is JSON - the { you represent as <Object> then the next item is some arbitrary key with a name. And that key has data which is the value.
That seems like cleaner one-to-one matching of the JSON to some XML attribute.
As your <item>'s might also want to be <item slot="0">, then <item slot="1"> and <item slot="2"> and so on (although I'm less convinced this is proper)
Last edited by szlamany; May 7th, 2016 at 05:24 AM.
-
May 9th, 2016, 09:45 AM
#9
Re: JSON to XDocument converter
I did change it to where it keeps the value type as the element name but it adds the key as an attribute.
However, I did not add the slot attribute to the array. I don't think that I like that.
-
May 9th, 2016, 11:22 AM
#10
Re: JSON to XDocument converter
Sounds great.
Check out this link - interesting read...
http://www.json.org/fatfree.html
-
May 25th, 2016, 04:56 PM
#11
Re: JSON to XDocument converter
The following is a scannerless parser implementation of the transformer:
Code:
Code:
Option Strict On
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text.RegularExpressions
Imports System.Xml
Imports System.Xml.Linq
Public Module JSON
Public Sub Main()
Console.WriteLine(Parse(Console.REadLine()))
ENd Sub
Public Function Parse(ByVal source As String) As XDocument
Dim d As XDocument = Nothing
Dim t As XElement = Parse_Value(source)
If t IsNot Nothing Then
d = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), t)
End If
Return d
End Function
Private Function Parse_Object(ByRef source As String) As XElement
Dim t As XElement = Nothing
Dim tempSource As String = source.Trim()
If tempSource.Length >= 2 AndAlso tempSource.StartsWith("{") Then
tempSource = tempSource.Remove(0, 1).Trim()
If tempSource.StartsWith("}") Then
t = New XElement("object")
source = tempSource.Remove(0, 1).Trim()
Else
Dim values As New List(Of XElement)
Dim key As XElement = Parse_String(tempSource)
tempSource = tempSource.Trim()
If tempSource.StartsWith(":") Then
tempSource = tempSource.Remove(0, 1).Trim()
Dim value As XElement = Parse_Value(tempSource)
If value IsNot Nothing Then
value.SetAttributeValue("key", key.Value)
values.Add(value)
tempSource = tempSource.Trim()
Do While value IsNot Nothing AndAlso tempSource.Length > 0 AndAlso Not tempSource.StartsWith("}") AndAlso tempSource.StartsWith(",")
tempSource = tempSource.Remove(0, 1).Trim()
key = Parse_String(tempSource)
tempSource = tempSource.Trim()
If tempSource.StartsWith(":") Then
tempSource = tempSource.Remove(0, 1).Trim()
value = Parse_Value(tempSource)
If value IsNot Nothing Then
value.SetAttributeValue("key", key.Value)
values.Add(value)
tempSource = tempSource.Trim()
End If
End If
Loop
tempSource = tempSource.Trim()
If value IsNot Nothing AndAlso tempSource.StartsWith("}") Then
tempSource = tempSource.Remove(0, 1).Trim()
t = New XElement("object", values)
source = New String(tempSource.ToArray())
End If
End If
End If
End If
End If
Return t
End Function
Private Function Parse_Array(ByRef source As String) As XElement
Dim t As XElement = Nothing
Dim tempSource As String = source.Trim()
If tempSource.Length >= 2 AndAlso tempSource.StartsWith("[") Then
tempSource = tempSource.Remove(0, 1).Trim()
If tempSource.StartsWith("]") Then
t = New XElement("array")
source = tempSource.Remove(0, 1).Trim()
Else
Dim values As New List(Of XElement)
Dim value As XElement = Parse_Value(tempSource)
If value IsNot Nothing Then
values.Add(value)
tempSource = tempSource.Trim()
Do While value IsNot Nothing AndAlso tempSource.Length > 0 AndAlso Not tempSource.StartsWith("]") AndAlso tempSource.StartsWith(",")
tempSource = tempSource.Remove(0, 1).Trim()
value = Parse_Value(tempSource)
tempSource = tempSource.Trim()
If value IsNot Nothing Then
values.Add(value)
End If
Loop
tempSource = tempSource.Trim()
If value IsNot Nothing AndAlso tempSource.StartsWith("]") Then
tempSource = tempSource.Remove(0, 1).Trim()
t = New XElement("array", values)
source = New String(tempSource.ToArray())
End If
End If
End If
End If
Return t
End Function
Private Function Parse_Value(ByRef source As String) As XElement
Dim t As XElement = Parse_String(source)
If t Is Nothing Then
t = Parse_Number(source)
If t Is Nothing Then
t = Parse_Boolean(source)
If t Is Nothing Then
t = Parse_Array(source)
If t Is Nothing Then
t = Parse_Object(source)
End If
End If
End If
End If
Return t
End Function
Private Function Parse_String(ByRef source As String) As XElement
Dim m As Match = Regex.Match(source, """([^""\\]|\\[""\\\/bfnrt])*""")
Dim t As XElement = Nothing
If m.Success AndAlso m.Index = 0 Then
Dim literal As String = m.Value.Remove(0, 1)
literal = literal.Remove(literal.Length - 1)
t = New XElement("string", literal)
source = source.Substring(m.Value.Length)
End If
Return t
End Function
Private Function Parse_Number(ByRef source As String) As XElement
Dim m As Match = Regex.Match(source, "-?\d+((\.\d+)?((e|E)[+-]?\d+)?)")
Dim t As XElement = Nothing
If m.Success AndAlso m.Index = 0 Then
t = New XElement("number", m.Value)
source = source.Substring(m.Value.Length)
End If
Return t
End Function
Private Function Parse_Boolean(ByRef source As String) As XElement
Dim t As XElement = Nothing
If source.StartsWith("true", StringComparison.OrdinalIgnoreCase) OrElse source.StartsWith("null", StringComparison.OrdinalIgnoreCase) Then
t = New XElement("boolean", source.Substring(0, 4))
source = source.Substring(4)
ElseIf source.StartsWith("false", StringComparison.OrdinalIgnoreCase) Then
t = New XElement("boolean", source.Substring(0, 5))
source = source.Substring(5)
End If
Return t
End Function
Private Function RemoveWhitespace(ByVal value As String) As String
Do While value.Length > 0 AndAlso String.IsNullOrWhiteSpace(value(0))
value = value.Remove(0, 1)
Loop
Return value
End Function
End Module
Fiddle: https://dotnetfiddle.net/ijk2ud
Example:
Code:
{"keyString": "value", "keyNumber": 1.0, "keyBoolean": true, "keyArray": [1, 2, null], "keyObject": {"emptyArray": []}}
<object>
<string key="keyString">value</string>
<number key="keyNumber">1.0</number>
<boolean key="keyBoolean">true</boolean>
<array key="keyArray">
<number>1</number>
<number>2</number>
<boolean>null</boolean>
</array>
<object key="keyObject">
<array key="emptyArray" />
</object>
</object>
I have started a github project for the scannerless parser too: https://github.com/dday9/.NET-JSON-Transformer
Last edited by dday9; May 25th, 2016 at 06:02 PM.
-
Aug 9th, 2017, 12:51 PM
#12
Re: JSON to XDocument converter
Edit made to the JSON.vb file:
- Edited the code to make much less String manipulations since .NET strings are immutable.
- Heavily commented the code so that it is easier for programmers to follow the logic.
Code:
Option Strict On
Imports System
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Imports System.Xml
Imports System.Xml.Linq
Public Module JSON
''' <summary>Converts a JSON literal into an XDocument.</summary>
''' <param name="literal">The JSON literal to convert.</param>
''' <value>XDocument</value>
''' <returns>XDocument of parsed JSON literal.</returns>
''' <remarks>Returns Nothing if the conversion fails.</remarks>
Public Function Parse(ByVal literal As String) As XDocument
If String.IsNullOrWhitespace(literal) Then Return Nothing
'Declare a document to return
Dim document As XDocument = Nothing
'Declare a value that will make up the document
Dim value As XElement = Parse_Value(literal, 0)
If value IsNot Nothing Then
document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
End If
Return document
End Function
Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
'Skip any whitespace
index = JSON.SkipWhitespace(source, index)
'Go through each available value until one returns something that ain't nothing
Dim node As XElement = JSON.Parse_Null(source, index)
If node Is Nothing Then
node = JSON.Parse_Boolean(source, index)
If node Is Nothing Then
node = JSON.Parse_Number(source, index)
If node Is Nothing Then
node = JSON.Parse_String(source, index)
If node Is Nothing Then
node = JSON.Parse_Array(source, index)
If node Is Nothing Then
node = JSON.Parse_Object(source, index)
End If
End If
End If
End If
End If
Return node
End Function
Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'Match the opening curly bracket
If source(index) = "{"c Then
'Declare collections that will make up the node's key:value
Dim keys,values As New List(Of XElement)
'Declare a temporary index placeholder in case the parsing fails
Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
'Declare a String which would represent the key of key/value pair
Dim key As XElement = Nothing
'Declare an XElement which would represent the value of the key/value pair
Dim item As XElement = Nothing
'Loop until there is a closing curly bracket
Do While tempIndex < source.Length AndAlso source(tempIndex) <> "}"c
'Match a String which should be the key
key = Parse_String(source, tempIndex)
'Ensure that there was a valid key
If key IsNot Nothing Then
'Add the item to the collection that will ultimately represent the key of the key/value pair
keys.Add(key)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator
If source(tempIndex) = ":"c Then
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
item = Parse_Value(source, tempIndex)
'Ensure that there was a valid item
If item IsNot Nothing Then
'Add the item to the collection that will ultimately represent the value of the key/value pair
values.Add(item)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator or ending bracket
If source(tempIndex) = ","c Then
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
ElseIf source(tempIndex) <> ","c AndAlso source(tempIndex) <> "}"c Then
Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a comma to separate Object items.")
End If
Else
Throw New Exception("Invalid item in array at position: " & tempIndex + 1)
End If
Else
Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a colon to separate Array items.")
End If
Else
Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a String to represent the key/value pair of an Object.")
End If
Loop
'Valid parse
If tempIndex < source.Length AndAlso source(tempIndex) = "}"c Then
node = New XElement("object")
For i As Integer = 0 To keys.Count - 1
node.Add(New XElement(keys.Item(i).Value, values.Item(i)))
Next
index = tempIndex + 1
End If
End If
Return node
End Function
Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'Match the opening square bracket
If source(index) = "["c Then
'Declare a collection that will make up the node's value
Dim nodes As List(Of XElement) = New List(Of XElement)
'Declare a temporary index placeholder in case the parsing fails
Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
'Declare an XElement which would represent an item in the array
Dim item As XElement = Nothing
'Loop until there is a closing square bracket
Do While tempIndex < source.Length AndAlso source(tempIndex) <> "]"c
item = Parse_Value(source, tempIndex)
'Ensure that there was a valid item
If item IsNot Nothing Then
'Add the item to the collection that will ultimately represent the node's value
nodes.Add(item)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator or ending bracket
If source(tempIndex) = ","c Then
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
ElseIf source(tempIndex) <> ","c AndAlso source(tempIndex) <> "]"c Then
Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a comma to separate Array items.")
End If
Else
Throw New Exception("Invalid item in array at position: " & tempIndex + 1)
End If
Loop
'Valid parse
If tempIndex < source.Length AndAlso source(tempIndex) = "]"c Then
node = New XElement("array", nodes)
index = tempIndex + 1
End If
End If
Return node
End Function
Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'The pattern to match a number is:
'Double-Quote
'Any unicode character except for (\ or ") or an escaped character zero or more times
'Double-Quote
Dim pattern As Regex = New Regex("""([^""\\]|\\[""\\\/bfnrt])*""", RegexOptions.IgnoreCase)
Dim m As Match = pattern.Match(source, index)
'A match will only be valid if it matches at the beginning of the string
If m.Success AndAlso m.Index = index Then
node = New XElement("string", m.Value.Substring(1, m.Value.Length - 2))
index += m.Value.Length
End If
Return node
End Function
Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'The pattern to match a number is:
'Optional unary negative
'0 or 1-9 followed by zero or more digits
'Optional mantissa followed by one or more digits
'Optional euler's number followed by optional unary operator followed by one or more digits
Dim pattern As Regex = New Regex("-?([1-9]\d*|0)(.\d+)?([eE][-+]?\d+)?")
Dim m As Match = pattern.Match(source, index)
'A match will only be valid if it matches at the beginning of the string
If m.Success AndAlso m.Index = index Then
node = New XElement("number", m.Value)
index += m.Value.Length
End If
Return Node
End Function
Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'Literally match 'true' or 'false'
Dim startSubstring As String = source.Substring(index)
If startSubstring.IndexOf("true", StringComparison.OrdinalIgnoreCase) = 0 Then
node = New XElement("boolean", startSubstring.Substring(0, 4))
index += 4
ElseIf startSubstring.IndexOf("false", StringComparison.OrdinalIgnoreCase) = 0 Then
node = New XElement("boolean", startSubstring.Substring(0, 5))
index += 5
End If
Return node
End Function
Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return (default is Nothing)
Dim node As XElement = Nothing
'Literally match 'null'
If source.Substring(index).IndexOf("null", StringComparison.OrdinalIgnoreCase) = 0 Then
node = New XElement("null")
index += 4
End If
Return node
End Function
Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
index += 1
Loop
Return index
End Function
End Module
Fiddle: https://dotnetfiddle.net/jlZ85u
-
Feb 8th, 2018, 11:26 AM
#13
Re: JSON to XDocument converter
Edit made to the JSON.vb file:
- Replaced [string].Substring with [string].IndexOf to improve performance.
- Removed the RegEx from Parse_Number to improve performance.
Code:
Public Module JSON
''' <summary>Converts a JSON literal into an XDocument.</summary>
''' <param name="literal">The JSON literal to convert.</param>
''' <returns>XDocument of parsed JSON literal.</returns>
''' <remarks>Returns Nothing if the conversion fails.</remarks>
Public Function Parse(ByVal literal As String) As XDocument
If String.IsNullOrWhiteSpace(literal) Then Return Nothing
'Declare a document to return
Dim document As XDocument = Nothing
'Declare a value that will make up the document
Dim value As XElement = Nothing
If Parse_Value(literal, 0, value) Then
document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
End If
Return document
End Function
Private Function Parse_Value(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Skip any whitespace
index = JSON.SkipWhitespace(source, index)
'Go through each available value until one returns something that ain't nothing
If Not Parse_String(source, index, value) AndAlso
Not Parse_Number(source, index, value) AndAlso
Not Parse_Object(source, index, value) AndAlso
Not Parse_Array(source, index, value) AndAlso
Not Parse_Boolean(source, index, value) AndAlso
Not Parse_Null(source, index, value) Then
End If
Return value IsNot Nothing
End Function
Private Function Parse_Object(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Match the opening curly bracket
If source(index) = "{"c Then
'Declare collections that will make up the node's key:value
Dim keys, values As New List(Of XElement)
'Declare a temporary index placeholder in case the parsing fails
Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
'Declare a String which would represent the key of key/value pair
Dim key As XElement = Nothing
'Declare an XElement which would represent the value of the key/value pair
Dim item As XElement = Nothing
'Loop until there is a closing curly bracket
Do While tempIndex < source.Length AndAlso source(tempIndex) <> "}"c
'Reset the key
key = Nothing
'Match a String which should be the key
If Parse_String(source, tempIndex, key) Then
'Add the item to the collection that will ultimately represent the key of the key/value pair
keys.Add(key)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator
If source(tempIndex) = ":"c Then
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
'Reset the value
item = Nothing
If Parse_Value(source, tempIndex, item) Then
'Add the item to the collection that will ultimately represent the value of the key/value pair
values.Add(item)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator or ending bracket
If source(tempIndex) = ","c Then
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
ElseIf source(tempIndex) <> "}"c Then
Return False
End If
Else
Return False
End If
Else
Return False
End If
End If
Loop
'Valid parse
If tempIndex < source.Length AndAlso source(tempIndex) = "}"c Then
value = New XElement("object")
For i As Integer = 0 To keys.Count - 1
value.Add(New XElement(keys.Item(i).Value, values.Item(i)))
Next
index = tempIndex + 1
End If
End If
Return value IsNot Nothing
End Function
Private Function Parse_Array(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Match the opening square bracket
If source(index) = "["c Then
'Declare a collection that will make up the node's value
Dim nodes As List(Of XElement) = New List(Of XElement)
'Declare a temporary index placeholder in case the parsing fails
Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
'Declare an XElement which would represent an item in the array
Dim item As XElement = Nothing
'Loop until there is a closing square bracket
Do While tempIndex < source.Length AndAlso source(tempIndex) <> "]"c
'Reset the value
item = Nothing
If Parse_Value(source, tempIndex, item) Then
'Add the item to the collection that will ultimately represent the node's value
nodes.Add(item)
'Skip any whitespace
tempIndex = JSON.SkipWhitespace(source, tempIndex)
'Ensure a separator or ending bracket
If source(tempIndex) = ","c Then
tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
ElseIf source(tempIndex) <> "]"c Then
Return False
End If
Else
Return False
End If
Loop
'Valid parse
If tempIndex < source.Length AndAlso source(tempIndex) = "]"c Then
value = New XElement("array", nodes)
index = tempIndex + 1
End If
End If
Return value IsNot Nothing
End Function
Private Function Parse_String(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'The pattern to match a number is:
'Double-Quote
'Any unicode character except for (\ or ") or an escaped character zero or more times
'Double-Quote
Dim pattern As Regex = New Regex("""([^""\\]|\\[""\\\/bfnrt])*""", RegexOptions.IgnoreCase)
Dim m As Match = pattern.Match(source, index)
'A match will only be valid if it matches at the beginning of the string
If m.Success AndAlso m.Index = index Then
value = New XElement("string", m.Value.Substring(1, m.Value.Length - 2))
index += m.Value.Length
End If
Return value IsNot Nothing
End Function
Private Function Parse_Number(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Get the current culture information
Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the optional unary operator
If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
temp_index += 1
End If
'Match one or more digits
If temp_index < source.Length AndAlso Char.IsDigit(source(temp_index)) Then
Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
temp_index += 1
Loop
Else
Return False
End If
'Optionally match a mantissa followed by one or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
Char.IsDigit(source(temp_index + 1)) Then
temp_index += 1
Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
temp_index += 1
Loop
End If
'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
If temp_index + 2 < source.Length AndAlso
(source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
Char.IsDigit(source(temp_index + 2)) Then
temp_index += 2
Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
temp_index += 1
Loop
ElseIf temp_index + 1 < source.Length AndAlso Char.IsDigit(source(temp_index + 1)) Then
temp_index += 1
Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
temp_index += 1
Loop
End If
End If
'Convert everything up to the index
value = New XElement("number", source.Substring(index, temp_index - index))
index = temp_index
Return value IsNot Nothing
End Function
Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Literally match 'true' or 'false'
If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", True)
index += 4
ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", False)
index += 5
End If
Return value IsNot Nothing
End Function
Private Function Parse_Null(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
'Literally match 'null' in the source starting at the index
If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("null")
index += 4
End If
Return value IsNot Nothing
End Function
Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
index += 1
Loop
Return index
End Function
End Module
Fiddle: https://dotnetfiddle.net/Gui2tq
-
Aug 23rd, 2018, 01:32 PM
#14
Re: JSON to XDocument converter
Edit made to the JSON.vb file:
- Removed the RegEx from Parse_String to improve performance.
- Methods return an XElement rather than a Boolean which in turn removes the ByRef parameter
Code:
Public Module JSON
Public Function Parse(ByVal source As String) As XDocument
'Remove any whitespace
source = source.Trim()
If String.IsNullOrWhiteSpace(source) Then Return Nothing
'Declare a document to return
Dim document As XDocument = Nothing
'Declare a value that will make up the document
Dim value As XElement = Parse_Value(source, 0)
If value IsNot Nothing Then
document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
End If
Return document
End Function
Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder and skip any whitespace
Dim temp_index As Integer = SkipWhitespace(source, index)
'Go through each available value until one returns something that isn't null
value = Parse_Object(source, temp_index)
If value Is Nothing Then
value = Parse_Array(source, temp_index)
If value Is Nothing Then
value = Parse_String(source, temp_index)
If value Is Nothing Then
value = Parse_Number(source, temp_index)
If value Is Nothing Then
value = Parse_Boolean(source, temp_index)
If value Is Nothing Then
value = Parse_Null(source, temp_index)
End If
End If
End If
End If
End If
'Change the index
index = temp_index
'Return the value
Return value
End Function
Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting opening curly bracket
If source(temp_index).Equals("{"c) Then
'Increment the index
temp_index += 1
'Declare a collection that will make up the nodes' value
Dim nodes As List(Of Tuple(Of String, XElement)) = New List(Of Tuple(Of String, XElement))
'Declare an XElement to store the key (aka - name) of the KeyValuePair
Dim key As XElement = Nothing
'Declare an XElement which will represent the value of the KeyValuePair
Dim item As XElement = Nothing
'Loop until we've reached the end of the source or until we've hit the ending bracket
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("}"c)
'Attempt to parse the String
key = Parse_String(source, temp_index)
'Check if the parse was successful
If key Is Nothing Then
Throw New Exception($"Expected a String instead of a '{source(temp_index)}' at position: {temp_index}.")
Else
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
If temp_index < source.Length Then
'Check if the currently iterated character is a object separator ':'
If source(temp_index) = ":"c Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
If temp_index < source.Length Then
'Assign the item to the parsed value
item = Parse_Value(source, temp_index)
'Check if the parse was successful
If item Is Nothing Then
Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
Else
'Add the item to the collection
nodes.Add(New Tuple(Of String, XElement)(key.Value, item))
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
'Check if we can continue
If temp_index < source.Length Then
'Check if the currently iterated character is either a item separator (comma) or ending curly bracket
If source(temp_index).Equals(","c) Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
ElseIf source(temp_index) <> "}"c Then
Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
End If
End If
Else
Throw New Exception("Expected an Object, Array, String, Number, Boolean, or Null instead I reached the end of the source code.")
End If
Else
Throw New Exception($"Expected a ':' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
Else
Throw New Exception("Expected a ',' instead I reached the end of the source code.")
End If
End If
Loop
'Check if the currently iterated value is an ending curly bracket
If temp_index < source.Length AndAlso source(temp_index) = "}"c Then
'Increment the index
temp_index += 1
'Set the new index
index = temp_index
'Create the Object
value = New XElement("object")
'Iterate through each item in the nodes
For Each n As Tuple(Of String, XElement) In nodes
'Set the name attribute and then add the element to the Object
n.Item2.SetAttributeValue("name", n.Item1)
value.Add(n.Item2)
Next
End If
End If
'Return the value
Return value
End Function
Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting opening bracket
If source(temp_index).Equals("["c) Then
'Increment the index
temp_index += 1
'Declare a collection that will make up the nodes' value
Dim nodes As List(Of XElement) = New List(Of XElement)
'Declare an XElement which will represent the currently iterated item in the array
Dim item As XElement = Nothing
'Loop until we've reached the end of the source or until we've hit the ending bracket
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("]"c)
'Assign the item to the parsed value
item = Parse_Value(source, temp_index)
'Check if the parse was successful
If item Is Nothing Then
Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
Else
'Add the item to the collection
nodes.Add(item)
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
'Check if we can continue
If temp_index < source.Length Then
'Check if the currently iterated character is either a item separator (comma) or ending bracket
If source(temp_index).Equals(","c) Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
ElseIf source(temp_index) <> "]"c Then
Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
End If
End If
Loop
'Check if the currently iterated value is an ending bracket
If temp_index < source.Length AndAlso source(temp_index) = "]"c Then
'Increment the index
temp_index += 1
'Set the new index
index = temp_index
'Create the Array
value = New XElement("array", nodes)
End If
End If
Return value
End Function
Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a CONST to store the double-quote character and escaped characters
Const double_quote As Char = """"c
Const escaped_characters As String = double_quote & "\/bfnrt"
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting double-quote
If source(temp_index).Equals(double_quote) Then
'Increment the index
temp_index += 1
'Loop until we've reached the end of the source or until we've hit the ending double-quote
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals(double_quote)
'Check if we're at an escaped character
If source(temp_index) = "\"c AndAlso
temp_index + 1 < source.Length AndAlso
escaped_characters.IndexOf(source(temp_index + 1)) <> -1 Then
temp_index += 1
ElseIf source(temp_index) = "\"c Then
Throw New Exception("Unescaped backslash in a String. Position: " & index)
End If
'Increment the index
temp_index += 1
Loop
'Check if the currently iterated character is a double-quote
If temp_index < source.Length AndAlso source(temp_index).Equals(double_quote) Then
'Increment the index
temp_index += 1
'Create the String
value = New XElement("string", source.Substring(index + 1, temp_index - index - 2))
'Set the new index
index = temp_index
End If
End If
Return value
End Function
Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
'Get the current culture information
Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the optional unary operator
If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
temp_index += 1
End If
'Match one or more digits
If temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1 Then
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
Else
Return Nothing
End If
'Optionally match a decimal separator followed by one or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
temp_index += 1
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
End If
'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
If temp_index + 2 < source.Length AndAlso
(source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 2).ToString()) <> -1 Then
temp_index += 2
ElseIf temp_index + 1 < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
temp_index += 1
End If
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
End If
'Create the number
Dim value As XElement = New XElement("number", source.Substring(index, temp_index - index))
index = temp_index
Return value
End Function
Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
Dim value As XElement = Nothing
'Literally match 'true' or 'false'
If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", True)
index += 4
ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", False)
index += 5
End If
Return value
End Function
Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
Dim value As XElement = Nothing
'Literally match 'null' in the source starting at the index
If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("null")
index += 4
End If
Return value
End Function
Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
index += 1
Loop
Return index
End Function
End Module
Fiddle: https://dotnetfiddle.net/G707RC
-
Aug 23rd, 2018, 01:32 PM
#15
Re: JSON to XDocument converter
Edit made to the JSON.vb file:
- Removed the RegEx from Parse_String to improve performance.
- Methods return an XElement rather than a Boolean which in turn removes the ByRef parameter
Code:
Public Module JSON
Public Function Parse(ByVal source As String) As XDocument
'Remove any whitespace
source = source.Trim()
If String.IsNullOrWhiteSpace(source) Then Return Nothing
'Declare a document to return
Dim document As XDocument = Nothing
'Declare a value that will make up the document
Dim value As XElement = Parse_Value(source, 0)
If value IsNot Nothing Then
document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
End If
Return document
End Function
Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder and skip any whitespace
Dim temp_index As Integer = SkipWhitespace(source, index)
'Go through each available value until one returns something that isn't null
value = Parse_Object(source, temp_index)
If value Is Nothing Then
value = Parse_Array(source, temp_index)
If value Is Nothing Then
value = Parse_String(source, temp_index)
If value Is Nothing Then
value = Parse_Number(source, temp_index)
If value Is Nothing Then
value = Parse_Boolean(source, temp_index)
If value Is Nothing Then
value = Parse_Null(source, temp_index)
End If
End If
End If
End If
End If
'Change the index
index = temp_index
'Return the value
Return value
End Function
Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting opening curly bracket
If source(temp_index).Equals("{"c) Then
'Increment the index
temp_index += 1
'Declare a collection that will make up the nodes' value
Dim nodes As List(Of Tuple(Of String, XElement)) = New List(Of Tuple(Of String, XElement))
'Declare an XElement to store the key (aka - name) of the KeyValuePair
Dim key As XElement = Nothing
'Declare an XElement which will represent the value of the KeyValuePair
Dim item As XElement = Nothing
'Loop until we've reached the end of the source or until we've hit the ending bracket
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("}"c)
'Attempt to parse the String
key = Parse_String(source, temp_index)
'Check if the parse was successful
If key Is Nothing Then
Throw New Exception($"Expected a String instead of a '{source(temp_index)}' at position: {temp_index}.")
Else
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
If temp_index < source.Length Then
'Check if the currently iterated character is a object separator ':'
If source(temp_index) = ":"c Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
If temp_index < source.Length Then
'Assign the item to the parsed value
item = Parse_Value(source, temp_index)
'Check if the parse was successful
If item Is Nothing Then
Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
Else
'Add the item to the collection
nodes.Add(New Tuple(Of String, XElement)(key.Value, item))
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
'Check if we can continue
If temp_index < source.Length Then
'Check if the currently iterated character is either a item separator (comma) or ending curly bracket
If source(temp_index).Equals(","c) Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
ElseIf source(temp_index) <> "}"c Then
Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
End If
End If
Else
Throw New Exception("Expected an Object, Array, String, Number, Boolean, or Null instead I reached the end of the source code.")
End If
Else
Throw New Exception($"Expected a ':' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
Else
Throw New Exception("Expected a ',' instead I reached the end of the source code.")
End If
End If
Loop
'Check if the currently iterated value is an ending curly bracket
If temp_index < source.Length AndAlso source(temp_index) = "}"c Then
'Increment the index
temp_index += 1
'Set the new index
index = temp_index
'Create the Object
value = New XElement("object")
'Iterate through each item in the nodes
For Each n As Tuple(Of String, XElement) In nodes
'Set the name attribute and then add the element to the Object
n.Item2.SetAttributeValue("name", n.Item1)
value.Add(n.Item2)
Next
End If
End If
'Return the value
Return value
End Function
Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting opening bracket
If source(temp_index).Equals("["c) Then
'Increment the index
temp_index += 1
'Declare a collection that will make up the nodes' value
Dim nodes As List(Of XElement) = New List(Of XElement)
'Declare an XElement which will represent the currently iterated item in the array
Dim item As XElement = Nothing
'Loop until we've reached the end of the source or until we've hit the ending bracket
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("]"c)
'Assign the item to the parsed value
item = Parse_Value(source, temp_index)
'Check if the parse was successful
If item Is Nothing Then
Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
Else
'Add the item to the collection
nodes.Add(item)
'Skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index)
'Check if we can continue
If temp_index < source.Length Then
'Check if the currently iterated character is either a item separator (comma) or ending bracket
If source(temp_index).Equals(","c) Then
'Increment the index and skip any unneeded whitespace
temp_index = SkipWhitespace(source, temp_index + 1)
ElseIf source(temp_index) <> "]"c Then
Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
End If
End If
End If
Loop
'Check if the currently iterated value is an ending bracket
If temp_index < source.Length AndAlso source(temp_index) = "]"c Then
'Increment the index
temp_index += 1
'Set the new index
index = temp_index
'Create the Array
value = New XElement("array", nodes)
End If
End If
Return value
End Function
Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
'Declare a value to return
Dim value As XElement = Nothing
'Declare a CONST to store the double-quote character and escaped characters
Const double_quote As Char = """"c
Const escaped_characters As String = double_quote & "\/bfnrt"
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the starting double-quote
If source(temp_index).Equals(double_quote) Then
'Increment the index
temp_index += 1
'Loop until we've reached the end of the source or until we've hit the ending double-quote
Do While temp_index < source.Length AndAlso Not source(temp_index).Equals(double_quote)
'Check if we're at an escaped character
If source(temp_index) = "\"c AndAlso
temp_index + 1 < source.Length AndAlso
escaped_characters.IndexOf(source(temp_index + 1)) <> -1 Then
temp_index += 1
ElseIf source(temp_index) = "\"c Then
Throw New Exception("Unescaped backslash in a String. Position: " & index)
End If
'Increment the index
temp_index += 1
Loop
'Check if the currently iterated character is a double-quote
If temp_index < source.Length AndAlso source(temp_index).Equals(double_quote) Then
'Increment the index
temp_index += 1
'Create the String
value = New XElement("string", source.Substring(index + 1, temp_index - index - 2))
'Set the new index
index = temp_index
End If
End If
Return value
End Function
Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
'Get the current culture information
Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
'Declare a temporary placeholder
Dim temp_index As Integer = index
'Check for the optional unary operator
If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
temp_index += 1
End If
'Match one or more digits
If temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1 Then
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
Else
Return Nothing
End If
'Optionally match a decimal separator followed by one or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
temp_index += 1
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
End If
'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
If temp_index + 1 < source.Length AndAlso
source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
If temp_index + 2 < source.Length AndAlso
(source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 2).ToString()) <> -1 Then
temp_index += 2
ElseIf temp_index + 1 < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
temp_index += 1
End If
Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
temp_index += 1
Loop
End If
'Create the number
Dim value As XElement = New XElement("number", source.Substring(index, temp_index - index))
index = temp_index
Return value
End Function
Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
Dim value As XElement = Nothing
'Literally match 'true' or 'false'
If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", True)
index += 4
ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("boolean", False)
index += 5
End If
Return value
End Function
Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
Dim value As XElement = Nothing
'Literally match 'null' in the source starting at the index
If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
value = New XElement("null")
index += 4
End If
Return value
End Function
Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
index += 1
Loop
Return index
End Function
End Module
Fiddle: https://dotnetfiddle.net/G707RC
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|