one key point of the JSON data format is, that the data are both machine readable and human readable.
However, there is a serious problem:
A JSON object by definition is an unordered collection of name/value pairs. And PureBasic's built-in function SaveJSON() saves the members of objects in an unpredictable way, it's not possible to control their order. This can make the generated JSON files hard to read for humans. I, for instance, not seldom want to compare 2 JSON files visually, using a program such as the built-in file compare tool. This only makes sense, if the "fields" in both files are in the same order.
This "JSave" module solves the problem. It works on all platforms supported by PureBasic (thanks to davido for testing on Mac!). It can be easily used in a simple way and also in more advanced ways.
In the simplest case, just write
Code: Select all
JSave::Save(jsonId, outFile$)
Or use
Code: Select all
JSave::Save(jsonId, "")
The code
Code: Select all
InitUnknown(#PB_Sort_Descending)
JSave::Save(jsonId, outFile$)
Using InitObject() or InitObjectStr(), you can for each object define the names of known members. This defines the order in which these members will be saved (see demo code of the module). All unknown members will still be sorted according to the sorting mode applied to that object. You can even choose to ignore unknown members.
Any constructive feedback will be appreciated.
Enjoy!
Code: Select all
; -- Save (or show with Debug) JSON data pretty-printed, with object
; members individually arranged or sorted according to their names
; (array elements are not affected).
; ==> can replace the built-in function SaveJSON()
; <https://www.purebasic.fr/english/viewtopic.php?t=69100>
; Version 1.21, 2020-06-26, by Little John
;
; successfully tested with
; [v] PB 5.50 on Mac OS X (thanks to davido)
; [v] PB 5.70 LTS x86 and x64 on Windows 10
; [v] PB 6.02 LTS x64 on Windows 11 – both ASM and C backend
; [v] PB 6.03 beta 4 x64 on Linux Mint 20.3 – both ASM and C backend
CompilerIf #PB_Compiler_Version < 540
CompilerError "PureBasic version 5.40 or newer required"
CompilerEndIf
DeclareModule JSave
; -- optional procedures
Declare.i InitObject (objectName$, List memberName$(), sortUnknown.i=#PB_Sort_Ascending|#PB_Sort_NoCase)
Declare.i InitObjectStr (objectName$, memberList$, sortUnknown.i=#PB_Sort_Ascending|#PB_Sort_NoCase)
Declare InitUnknown (sortUnknown.i)
Declare InitClear()
Declare.i StoreOrder (prefFile$, comment$="")
Declare.i LoadOrder (prefFile$)
; -- main procedure
Declare.i Save (json.i, dataFile$)
EndDeclareModule
Module JSave
EnableExplicit
Structure Object
SortUnknownMembers.i
Map KnownMember.i()
List *pKnownMember.String()
EndStructure
NewMap s_KnownObject.Object()
Define s_SortUnknownObjects = #PB_Sort_Ascending|#PB_Sort_NoCase
Define s_Ofn.i
Procedure.i InitObject (objectName$, List memberName$(), sortUnknown.i=#PB_Sort_Ascending|#PB_Sort_NoCase)
; -- For each wanted object, define the order in which its members should be saved to a JSON file
; (optional function).
; in : objectName$ : name of regarding object
; - "" refers to members at the basic level.
; - * matches any object that is not explicitly specified
; in another call of InitObject() or InitObjectStr().
; memberName$(): list of names of known members for this object;
; This list defines the order of the members.
; Can be empty, if only 'sortUnknown' is to be changed.
; sortUnknown : object specific setting for sorting unknown members
; (any PureBasic sort options for strings,
; or -1 for ignoring unknown members)
; out: return value : 1 on success,
; 0 on error
Shared s_KnownObject()
If FindMapElement(s_KnownObject(), objectName$)
ProcedureReturn 0 ; error
EndIf
AddMapElement(s_KnownObject(), objectName$, #PB_Map_NoElementCheck)
With s_KnownObject()
ForEach memberName$()
AddElement(\pKnownMember()) ; Add an element to the list of the new object,
\pKnownMember() = AddMapElement(\KnownMember(), memberName$()) - SizeOf(Integer) ; and store the pointer to the new mapkey there.
Next
\SortUnknownMembers = sortUnknown
EndWith
ProcedureReturn 1 ; success
EndProcedure
Procedure.i InitObjectStr (objectName$, memberList$, sortUnknown.i=#PB_Sort_Ascending|#PB_Sort_NoCase)
; -- Wrapper for function InitObject(), for convenience
; (optional function).
; in : objectName$ : name of regarding object
; - "" refers to members at the basic level.
; - * matches any object that is not explicitly specified
; in another call of InitObject() or InitObjectStr().
; memberList$ : list of names of known members for this object, separated by ',' ;
; This list defines the order of the members.
; Can be "", if only 'sortUnknown' is to be changed.
; sortUnknown : object specific setting for sorting unknown members
; (any PureBasic sort options for strings,
; or -1 for ignoring unknown members)
; out: return value: 1 on success,
; 0 on error
Protected numFields.i, i.i
Protected NewList memberName$()
If Asc(Trim(memberList$)) <> 0
numFields = CountString(memberList$, ",") + 1
For i = 1 To numFields
AddElement(memberName$())
memberName$() = Trim(StringField(memberList$, i, ","))
Next
EndIf
ProcedureReturn InitObject(objectName$, memberName$(), sortUnknown)
EndProcedure
Procedure InitUnknown (sortUnknown.i)
; -- Change how members of unknown objects are sorted
; (optional function).
; in: sortUnknown: setting for sorting the members of unknown objects
; (any PureBasic sort options for strings,
; or -1 for ignoring unknown objects)
Shared s_SortUnknownObjects
s_SortUnknownObjects = sortUnknown
EndProcedure
Procedure InitClear()
; -- Reset all settings (optional function).
Shared s_SortUnknownObjects, s_KnownObject()
s_SortUnknownObjects = #PB_Sort_Ascending|#PB_Sort_NoCase
ClearMap(s_KnownObject())
EndProcedure
;------------------------------------------------------------------------
#Group_General$ = "General"
#KeyName_Signature$ = "Signature"
#KeyValue_Signature$ = "-- Order of JSON object members --"
#KeyName_UnknownObjects$ = "Sort unknown objects"
#Group_KnownObjects$ = "Sort known objects"
Macro WritePreferenceGroup (_name_)
WriteStringN(ofn, "[" + _name_ + "]")
EndMacro
Macro WritePreferenceKey (_name_, _value_)
WriteStringN(ofn, _name_ + " = " + _value_)
EndMacro
Procedure.i StoreOrder (prefFile$, comment$="")
; -- Write wanted order of object members to a preference file
; in : prefFile$: name of file for writing the order information
; comment$ : comment that will be written as first line of the file
; out: return value: 1 on success, 0 on error
Shared s_SortUnknownObjects, s_KnownObject()
Protected memberList$, ofn.i, numMembers.i, i.i
ofn = CreateFile(#PB_Any, prefFile$, #PB_UTF8)
If ofn = 0
ProcedureReturn 0 ; error
EndIf
WriteStringFormat(ofn, #PB_UTF8)
If Asc(comment$) <> 0
WriteStringN(ofn, "; " + comment$)
WriteStringN(ofn, "")
EndIf
WritePreferenceGroup(#Group_General$)
WritePreferenceKey(#KeyName_Signature$, #KeyValue_Signature$)
WritePreferenceKey(#KeyName_UnknownObjects$, s_SortUnknownObjects)
WriteStringN(ofn, "")
WritePreferenceGroup(#Group_KnownObjects$)
ForEach s_KnownObject()
memberList$ = ""
numMembers = ListSize(s_KnownObject()\pKnownMember())
i = 1
ForEach s_KnownObject()\pKnownMember()
memberList$ + s_KnownObject()\pKnownMember()\s
If i < numMembers
memberList$ + ", "
EndIf
i + 1
Next
WritePreferenceKey(MapKey(s_KnownObject()) + "_Known", memberList$)
WritePreferenceKey(MapKey(s_KnownObject()) + "_Unknown", s_KnownObject()\SortUnknownMembers)
Next
CloseFile(ofn)
ProcedureReturn 1 ; success
EndProcedure
Procedure.i LoadOrder (prefFile$)
; -- Read wanted order of object members from a preference file
; in : prefFile$: name of file for reading the order information
; out: return value: 1 on success, 0 on error
Shared s_SortUnknownObjects, s_KnownObject()
Protected keyName$, objectName$, memberList$, f.i, sortUnknown.i
If OpenPreferences(prefFile$) = 0
ProcedureReturn 0 ; error
EndIf
PreferenceGroup(#Group_General$)
If ReadPreferenceString(#KeyName_Signature$, "") <> #KeyValue_Signature$
ClosePreferences()
ProcedureReturn 0 ; error
EndIf
s_SortUnknownObjects = ReadPreferenceInteger(#KeyName_UnknownObjects$, #PB_Sort_Ascending|#PB_Sort_NoCase)
ClearMap(s_KnownObject())
If PreferenceGroup(#Group_KnownObjects$) = 0 Or ExaminePreferenceKeys() = 0
ClosePreferences()
ProcedureReturn 0 ; error
EndIf
While NextPreferenceKey()
keyName$ = PreferenceKeyName()
f = FindString(keyName$, "_")
If f = 0
ClosePreferences()
ProcedureReturn 0 ; error
EndIf
Select Mid(keyName$, f+1)
Case "Known"
objectName$ = Left(keyName$, f-1)
memberList$ = PreferenceKeyValue()
Case "Unknown"
If objectName$ <> Left(keyName$, f-1)
ClosePreferences()
ProcedureReturn 0 ; error
EndIf
sortUnknown = Val(PreferenceKeyValue())
If InitObjectStr(objectName$, memberList$, sortUnknown) = 0
ClosePreferences()
ProcedureReturn 0 ; error
EndIf
Default
ClosePreferences()
ProcedureReturn 0 ; error
EndSelect
Wend
ClosePreferences()
ProcedureReturn 1 ; success
EndProcedure
;------------------------------------------------------------------------
Macro _WriteLine (_key_, _right_)
If Asc(_key_) = 0
line$ = pre$ + _right_
Else
line$ = pre$ + LSet(#DQUOTE$ + _key_ + #DQUOTE$, keyWidth) + ": " + _right_
EndIf
If s_Ofn
WriteStringN(s_Ofn, line$)
Else
Debug line$
EndIf
EndMacro
Procedure _TraverseJSON (v.i, level.i, prevKey$="", key$="", keyWidth.i=0, comma$="")
; in: v : JSON value
; level : level of the given JSON value
; prevKey$: JSON member key of previous level (can be "")
; key$ : JSON member key of current level (can be "")
; keyWidth: number of characters of a field for 'key$'
; comma$ : "," or ""
Shared s_Ofn, s_SortUnknownObjects, s_KnownObject()
Protected NewList unknownMember$()
Protected.i i, last, pad, validMembers, knownObject
Protected tmp$, line$, pre$ = Space(3 * level)
Select JSONType(v)
Case #PB_JSON_Object
If JSONObjectSize(v) = 0
_WriteLine(key$, "{}" + comma$)
Else
; -- initially examine all members of this object
If ExamineJSONMembers(v)
If Asc(key$) <> 0
prevKey$ = key$
EndIf
knownObject = FindMapElement(s_KnownObject(), prevKey$)
If knownObject = 0
knownObject = FindMapElement(s_KnownObject(), "*")
EndIf
pad = 0
validMembers = 0
If knownObject
While NextJSONMember(v)
If FindMapElement(s_KnownObject()\KnownMember(), JSONMemberKey(v))
If pad < Len(JSONMemberKey(v))
pad = Len(JSONMemberKey(v))
EndIf
validMembers + 1
ElseIf s_KnownObject()\SortUnknownMembers > -1
If pad < Len(JSONMemberKey(v))
pad = Len(JSONMemberKey(v))
EndIf
validMembers + 1
AddElement(unknownMember$()) : unknownMember$() = JSONMemberKey(v)
EndIf
Wend
ElseIf s_SortUnknownObjects > -1
While NextJSONMember(v)
If pad < Len(JSONMemberKey(v))
pad = Len(JSONMemberKey(v))
EndIf
validMembers + 1
AddElement(unknownMember$()) : unknownMember$() = JSONMemberKey(v)
Wend
EndIf
pad + 2
EndIf
_WriteLine(key$, "{")
i = 1
; -- write known members
If knownObject
ResetList(s_KnownObject()\pKnownMember())
While (i <= validMembers) And NextElement(s_KnownObject()\pKnownMember())
If GetJSONMember(v, s_KnownObject()\pKnownMember()\s)
If i < validMembers : tmp$ = "," : Else : tmp$ = "" : EndIf
PushListPosition(s_KnownObject()\pKnownMember())
PushMapPosition(s_KnownObject())
_TraverseJSON(JSONMemberValue(v), level+1, "", JSONMemberKey(v), pad, tmp$)
PopMapPosition(s_KnownObject())
PopListPosition(s_KnownObject()\pKnownMember())
i + 1
EndIf
Wend
EndIf
; -- write unknown members
If ListSize(unknownMember$()) > 0
If knownObject
SortList(unknownMember$(), s_KnownObject()\SortUnknownMembers)
Else
SortList(unknownMember$(), s_SortUnknownObjects)
EndIf
ForEach unknownMember$()
GetJSONMember(v, unknownMember$())
If i < validMembers : tmp$ = "," : Else : tmp$ = "" : EndIf
_TraverseJSON(JSONMemberValue(v), level+1, "", JSONMemberKey(v), pad, tmp$)
i + 1
Next
EndIf
_WriteLine("", "}" + comma$)
EndIf
Case #PB_JSON_Array
last = JSONArraySize(v) - 1
If last < 0
_WriteLine(key$, "[]" + comma$)
Else
_WriteLine(key$, "[")
For i = 0 To last-1
_TraverseJSON(GetJSONElement(v, i), level+1, key$, "", 0, ",")
Next
_TraverseJSON(GetJSONElement(v, last), level+1, key$)
_WriteLine("", "]" + comma$)
EndIf
Case #PB_JSON_String
_WriteLine(key$, #DQUOTE$ + EscapeString(GetJSONString(v)) + #DQUOTE$ + comma$)
Case #PB_JSON_Number
_WriteLine(key$, GetJSONDouble(v) + comma$)
Case #PB_JSON_Boolean
If GetJSONBoolean(v) : tmp$ = "true" : Else : tmp$ = "false" : EndIf
_WriteLine(key$, tmp$ + comma$)
Case #PB_JSON_Null
_WriteLine(key$, "null" + comma$)
EndSelect
EndProcedure
Procedure.i Save (json.i, dataFile$)
; -- Save JSON data to a file in the proper format (UTF-8 without BOM);
; pretty-printed, with object members individually arranged or sorted
; according to their names
; in : json : ID of JSON data
; dataFile$: name of destination file,
; or "" for output with Debug
; out: return value: 1: file successfully saved,
; 0: dataFile$ = "", or error
Shared s_Ofn
If IsJSON(json)
If Asc(dataFile$) <> 0
s_Ofn = CreateFile(#PB_Any, dataFile$, #PB_UTF8)
If s_Ofn
_TraverseJSON(JSONValue(json), 0)
CloseFile(s_Ofn)
ProcedureReturn 1
EndIf
Else
CompilerIf #PB_Compiler_Debugger = #False
CompilerWarning "Enable the Debugger, in order to see the output"
CompilerEndIf
s_Ofn = 0
_TraverseJSON(JSONValue(json), 0)
EndIf
EndIf
ProcedureReturn 0
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
; -- Module demo
EnableExplicit
Define.i jn, i, last=5
Dim input$(last)
input$(0) = "'Hello \'world\''"
input$(1) = "null"
input$(2) = "2.7"
input$(3) = "true"
input$(4) = "[[4, 3], [1, 2], [5, 6]]"
input$(5) = "{" +
"'Given name': 'Mary'," +
"'Family name': 'Smith'," +
"'Age': 30," +
"'Children': {" +
"'Peter': 6," +
"'Tom': 2," +
"'Laura': 5" +
"}," +
"'Address': {" +
"'Country': 'Germany'," +
"'City': 'Berlin'," +
"'E-mail': 'mary@smith.de'" +
"}" +
"}"
For i = 0 To last
ReplaceString(input$(i), "'", #DQUOTE$, #PB_String_InPlace)
jn = ParseJSON(#PB_Any, input$(i))
If IsJSON(jn) = #False
Debug "Error, invalid JSON data: " + input$(i)
End
EndIf
Debug ComposeJSON(jn, #PB_JSON_PrettyPrint)
If i = last
Debug ~"--------- For each object, all member keys sorted ascending ---------"
EndIf
JSave::Save(jn, "")
Debug ""
If i < last
FreeJSON(jn)
EndIf
Next
Debug "--------- All member keys at basic level individually arranged ---------"
JSave::InitObjectStr("", "Given name, Family name, Age, Children, Address")
JSave::Save(jn, "")
Debug ~"--------- Additionally all member keys of objects \"Children\" and \"Address\" individually arranged ---------"
JSave::InitObjectStr("Children", "Laura, Tom, Peter")
JSave::InitObjectStr("Address", "Country, City, E-mail")
JSave::Save(jn, "")
CompilerEndIf
-------------------------------------------------
My best tricks & tips from 15+ years
Create arrays elegantly
Extended date library
Save JSON data with object members well-arranged
Evaluate and process math expressions
Functions for sets
Statistics with R
Thue-Morse sequence
Natural sorting
Sort array indexes and parallel arrays
Time profiling
VectorIcons