Skip to content

Commit fc68433

Browse files
timhalltimhall
committed
Add pretty print support
- Pass whitespace string / number as second parameter to ConvertToJson Fixes #19
1 parent a31a092 commit fc68433

File tree

2 files changed

+172
-15
lines changed

2 files changed

+172
-15
lines changed

‎JsonConverter.bas‎

Lines changed: 94 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -178,9 +178,10 @@ End Function
178178
'
179179
' @method ConvertToJson
180180
' @param {Variant} json_DictionaryCollectionOrArray (Dictionary, Collection, or Array)
181+
' @param {Integer|String} json_Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string
181182
' @return {String}
182183
''
183-
Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant) As String
184+
Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant, Optional ByVal json_Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String
184185
Dim json_buffer As String
185186
Dim json_BufferPosition As Long
186187
Dim json_BufferLength As Long
@@ -197,13 +198,17 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
197198
Dim json_DateStr As String
198199
Dim json_Converted As String
199200
Dim json_SkipItem As Boolean
201+
Dim json_PrettyPrint As Boolean
202+
Dim json_Indentation As String
203+
Dim json_InnerIndentation As String
200204

201205
json_LBound = -1
202206
json_UBound = -1
203207
json_IsFirstItem = True
204208
json_LBound2D = -1
205209
json_UBound2D = -1
206210
json_IsFirstItem2D = True
211+
json_PrettyPrint = Not IsMissing(json_Whitespace)
207212

208213
Select Case VBA.VarType(json_DictionaryCollectionOrArray)
209214
Case VBA.vbNull
@@ -227,6 +232,16 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
227232
ConvertToJson = "false"
228233
End If
229234
Case VBA.vbArray To VBA.vbArray + VBA.vbByte
235+
If json_PrettyPrint Then
236+
If VBA.VarType(json_Whitespace) = VBA.vbString Then
237+
json_Indentation = VBA.String$(json_CurrentIndentation + 1, json_Whitespace)
238+
json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, json_Whitespace)
239+
Else
240+
json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * json_Whitespace)
241+
json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * json_Whitespace)
242+
End If
243+
End If
244+
230245
' Array
231246
json_BufferAppend json_buffer, "[", json_BufferPosition, json_BufferLength
232247

@@ -242,11 +257,16 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
242257
If json_IsFirstItem Then
243258
json_IsFirstItem = False
244259
Else
260+
' Append comma to previous line
245261
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
246262
End If
247263

248264
If json_LBound2D >= 0 And json_UBound2D >= 0 Then
249-
json_BufferAppend json_buffer, "[", json_BufferPosition, json_BufferLength
265+
' 2D Array
266+
If json_PrettyPrint Then
267+
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
268+
End If
269+
json_BufferAppend json_buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength
250270

251271
For json_Index2D = json_LBound2D To json_UBound2D
252272
If json_IsFirstItem2D Then
@@ -255,7 +275,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
255275
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
256276
End If
257277

258-
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Index, json_Index2D))
278+
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Index, json_Index2D), json_Whitespace, json_CurrentIndentation + 2)
259279

260280
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
261281
If json_Converted = "" Then
@@ -265,13 +285,22 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
265285
End If
266286
End If
267287

288+
If json_PrettyPrint Then
289+
json_Converted = vbNewLine & json_InnerIndentation & json_Converted
290+
End If
291+
268292
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
269293
Next json_Index2D
270294

271-
json_BufferAppend json_buffer, "]", json_BufferPosition, json_BufferLength
295+
If json_PrettyPrint Then
296+
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
297+
End If
298+
299+
json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
272300
json_IsFirstItem2D = True
273301
Else
274-
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Index))
302+
' 1D Array
303+
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Index), json_Whitespace, json_CurrentIndentation + 1)
275304

276305
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
277306
If json_Converted = "" Then
@@ -280,6 +309,10 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
280309
json_Converted = "null"
281310
End If
282311
End If
312+
313+
If json_PrettyPrint Then
314+
json_Converted = vbNewLine & json_Indentation & json_Converted
315+
End If
283316

284317
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
285318
End If
@@ -288,18 +321,36 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
288321

289322
On Error GoTo 0
290323

291-
json_BufferAppend json_buffer, "]", json_BufferPosition, json_BufferLength
324+
If json_PrettyPrint Then
325+
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
326+
327+
If VBA.VarType(json_Whitespace) = VBA.vbString Then
328+
json_Indentation = VBA.String$(json_CurrentIndentation, json_Whitespace)
329+
Else
330+
json_Indentation = VBA.Space$(json_CurrentIndentation * json_Whitespace)
331+
End If
332+
End If
333+
334+
json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
292335

293336
ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
294337

295338
' Dictionary or Collection
296339
Case VBA.vbObject
340+
If json_PrettyPrint Then
341+
If VBA.VarType(json_Whitespace) = VBA.vbString Then
342+
json_Indentation = VBA.String$(json_CurrentIndentation + 1, json_Whitespace)
343+
Else
344+
json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * json_Whitespace)
345+
End If
346+
End If
347+
297348
' Dictionary
298349
If VBA.TypeName(json_DictionaryCollectionOrArray) = "Dictionary" Then
299350
json_BufferAppend json_buffer, "{", json_BufferPosition, json_BufferLength
300351
For Each json_Key In json_DictionaryCollectionOrArray.Keys
301352
' For Objects, undefined (Empty/Nothing) is not added to object
302-
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Key))
353+
json_Converted = ConvertToJson(json_DictionaryCollectionOrArray(json_Key), json_Whitespace, json_CurrentIndentation + 1)
303354
If json_Converted = "" Then
304355
json_SkipItem = json_IsUndefined(json_DictionaryCollectionOrArray(json_Key))
305356
Else
@@ -313,10 +364,27 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
313364
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
314365
End If
315366

316-
json_BufferAppend json_buffer, """" & json_Key & """:" & json_Converted, json_BufferPosition, json_BufferLength
367+
If json_PrettyPrint Then
368+
json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted
369+
Else
370+
json_Converted = """" & json_Key & """:" & json_Converted
371+
End If
372+
373+
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
317374
End If
318375
Next json_Key
319-
json_BufferAppend json_buffer, "}", json_BufferPosition, json_BufferLength
376+
377+
If json_PrettyPrint Then
378+
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
379+
380+
If VBA.VarType(json_Whitespace) = VBA.vbString Then
381+
json_Indentation = VBA.String$(json_CurrentIndentation, json_Whitespace)
382+
Else
383+
json_Indentation = VBA.Space$(json_CurrentIndentation * json_Whitespace)
384+
End If
385+
End If
386+
387+
json_BufferAppend json_buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength
320388

321389
' Collection
322390
ElseIf VBA.TypeName(json_DictionaryCollectionOrArray) = "Collection" Then
@@ -328,7 +396,7 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
328396
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
329397
End If
330398

331-
json_Converted = ConvertToJson(json_Value)
399+
json_Converted = ConvertToJson(json_Value, json_Whitespace, json_CurrentIndentation + 1)
332400

333401
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
334402
If json_Converted = "" Then
@@ -338,9 +406,24 @@ Public Function ConvertToJson(ByVal json_DictionaryCollectionOrArray As Variant)
338406
End If
339407
End If
340408

409+
If json_PrettyPrint Then
410+
json_Converted = vbNewLine & json_Indentation & json_Converted
411+
End If
412+
341413
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
342414
Next json_Value
343-
json_BufferAppend json_buffer, "]", json_BufferPosition, json_BufferLength
415+
416+
If json_PrettyPrint Then
417+
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
418+
419+
If VBA.VarType(json_Whitespace) = VBA.vbString Then
420+
json_Indentation = VBA.String$(json_CurrentIndentation, json_Whitespace)
421+
Else
422+
json_Indentation = VBA.Space$(json_CurrentIndentation * json_Whitespace)
423+
End If
424+
End If
425+
426+
json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
344427
End If
345428

346429
ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)

‎specs/Specs.bas‎

Lines changed: 78 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,11 +7,14 @@ Public Function Specs() As SpecSuite
77

88
Dim JsonString As String
99
Dim JsonObject As Object
10+
Dim NestedObject As Object
1011
Dim EmptyVariant As Variant
1112
Dim NothingObject As Object
1213

14+
Dim MultiDimensionalArray(1, 1) As Variant
15+
1316
' ============================================= '
14-
' Parse JSON
17+
' ParseJson
1518
' ============================================= '
1619

1720
With Specs.It("should parse object string")
@@ -159,7 +162,7 @@ Public Function Specs() As SpecSuite
159162
End With
160163

161164
' ============================================= '
162-
' ConvertTOJSON
165+
' ConvertToJson
163166
' ============================================= '
164167

165168
With Specs.It("should convert object to string")
@@ -224,12 +227,10 @@ Public Function Specs() As SpecSuite
224227

225228
With Specs.It("should convert 2D arrays")
226229
' Checks https://code.google.com/p/vba-json/issues/detail?id=8
227-
Dim MultiDimensionalArray(1, 1) As Variant
228230
MultiDimensionalArray(0, 0) = 1
229231
MultiDimensionalArray(0, 1) = 2
230232
MultiDimensionalArray(1, 0) = 3
231233
MultiDimensionalArray(1, 1) = 4
232-
233234
JsonString = JsonConverter.ConvertToJson(MultiDimensionalArray)
234235
.Expect(JsonString).ToEqual "[[1,2],[3,4]]"
235236
End With
@@ -303,6 +304,79 @@ Public Function Specs() As SpecSuite
303304
.Expect(JsonString).ToEqual "{""a"":""a"",""z"":""z""}"
304305
End With
305306

307+
With Specs.It("should use whitespace number/string")
308+
' Nested, plain array + 2
309+
JsonString = JsonConverter.ConvertToJson(Array(1, Array(2, Array(3))), 2)
310+
.Expect(JsonString).ToEqual _
311+
"[" & vbNewLine & _
312+
" 1," & vbNewLine & _
313+
" [" & vbNewLine & _
314+
" 2," & vbNewLine & _
315+
" [" & vbNewLine & _
316+
" 3" & vbNewLine & _
317+
" ]" & vbNewLine & _
318+
" ]" & vbNewLine & _
319+
"]"
320+
321+
' Nested Dictionary + Tab
322+
Set JsonObject = New Dictionary
323+
JsonObject.Add "a", Array(1, 2, 3)
324+
JsonObject.Add "b", "c"
325+
Set NestedObject = New Dictionary
326+
NestedObject.Add "d", "e"
327+
JsonObject.Add "nested", NestedObject
328+
329+
JsonString = JsonConverter.ConvertToJson(JsonObject, VBA.vbTab)
330+
.Expect(JsonString).ToEqual _
331+
"{" & vbNewLine & _
332+
vbTab & """a"": [" & vbNewLine & _
333+
vbTab & vbTab & "1," & vbNewLine & _
334+
vbTab & vbTab & "2," & vbNewLine & _
335+
vbTab & vbTab & "3" & vbNewLine & _
336+
vbTab & "]," & vbNewLine & _
337+
vbTab & """b"": ""c""," & vbNewLine & _
338+
vbTab & """nested"": {" & vbNewLine & _
339+
vbTab & vbTab & """d"": ""e""" & vbNewLine & _
340+
vbTab & "}" & vbNewLine & _
341+
"}"
342+
343+
' Multi-dimensional array + 4
344+
MultiDimensionalArray(0, 0) = 1
345+
MultiDimensionalArray(0, 1) = 2
346+
MultiDimensionalArray(1, 0) = Array(1, 2, 3)
347+
MultiDimensionalArray(1, 1) = 4
348+
JsonString = JsonConverter.ConvertToJson(MultiDimensionalArray, 4)
349+
.Expect(JsonString).ToEqual _
350+
"[" & vbNewLine & _
351+
" [" & vbNewLine & _
352+
" 1," & vbNewLine & _
353+
" 2" & vbNewLine & _
354+
" ]," & vbNewLine & _
355+
" [" & vbNewLine & _
356+
" [" & vbNewLine & _
357+
" 1," & vbNewLine & _
358+
" 2," & vbNewLine & _
359+
" 3" & vbNewLine & _
360+
" ]," & vbNewLine & _
361+
" 4" & vbNewLine & _
362+
" ]" & vbNewLine & _
363+
"]"
364+
365+
' Collection + "-"
366+
Set JsonObject = New Collection
367+
JsonObject.Add Array(1, 2, 3)
368+
369+
JsonString = JsonConverter.ConvertToJson(JsonObject, "-")
370+
.Expect(JsonString).ToEqual _
371+
"[" & vbNewLine & _
372+
"-[" & vbNewLine & _
373+
"--1," & vbNewLine & _
374+
"--2," & vbNewLine & _
375+
"--3" & vbNewLine & _
376+
"-]" & vbNewLine & _
377+
"]"
378+
End With
379+
306380
' ============================================= '
307381
' Errors
308382
' ============================================= '

0 commit comments

Comments
 (0)