Created
December 3, 2017 16:22
Star
You must be signed in to star a gist
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
// https://synopse.info/forum/viewtopic.php?id=2887 | |
// How to customize JSON serializer for nested record array from text ? | |
program Project1; | |
{$APPTYPE CONSOLE} | |
uses | |
FastMM4, | |
SynCommons, SynLog, SynTests, SynSQLite3, SynSQLite3Static, mORMot, mORMotSQLite3, | |
Contnrs, SysUtils; | |
type | |
{$M+} | |
TNestedRecord = packed record | |
(* | |
The record must have managed/refcounted field to have RTTI. | |
For example, if TNestedRecord only has DummyInt, we will get compilation error "No type info for TNestedRecord". | |
*) | |
// DummyInt: Integer; | |
DummyString: RawUTF8; | |
end; | |
TNestedRecordArray = array of TNestedRecord; | |
const | |
__TNestedRecord = 'DummyString: RawUTF8'; | |
(* | |
__TNestedRecord must be used for both TNestedRecord and TNestedRecordArray, e.g.: | |
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TNestedRecord), __TNestedRecord); | |
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TNestedRecordArray), __TNestedRecord); | |
As a matter of fact, we cannot register custom JSON serializer for a record array type. | |
We can only register custom JSON serializer for a record type, which will be used for isolated instances and arrays. | |
function TJSONCustomParsers.DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo: pointer; | |
AddIfNotExisting: boolean): Integer; | |
... | |
for result := 0 to fParsersCount-1 do | |
with fParser[result] do | |
if (DynArrayTypeInfo=aDynArrayTypeInfo) or <------ | |
(RecordTypeInfo=aRecordTypeInfo) then begin <------ | |
fLastDynArrayIndex := result; | |
fLastRecordIndex := result; | |
exit; | |
end; | |
function TJSONCustomParsers.TryToGetFromRTTI(aDynArrayTypeInfo, | |
aRecordTypeInfo: pointer): integer; | |
... | |
info := GetTypeInfo(aRecordTypeInfo,tkRecordTypeOrSet); | |
if info=nil then | |
exit; // not enough RTTI | |
Reg.RecordTypeInfo := aRecordTypeInfo; | |
Reg.DynArrayTypeInfo := aDynArrayTypeInfo; | |
TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName); | |
if Reg.RecordTypeName='' then | |
exit; // we need a type name! | |
RegRoot := TJSONCustomParserRTTI.CreateFromTypeName('',Reg.RecordTypeName); <------ Our JSON serializer will be registered under record type (not record array type). | |
*) | |
// __TNestedRecordArray = '[DummyString: RawUTF8]'; | |
type | |
{$M+} | |
TOuterRecord = packed record | |
NestedRecordArray: TNestedRecordArray; | |
end; | |
TOuterRecordArray = array of TOuterRecord; | |
const | |
(* | |
As commented above, we cannot register custom JSON serializer for a record array type. | |
We can only register custom JSON serializer for a record type, which will be used for isolated instances and arrays. | |
*) | |
// __TOuterRecord = 'NestedRecordArray: TNestedRecordArray'; | |
__TOuterRecord = 'NestedRecordArray: array of TNestedRecord'; | |
type | |
{$M+} | |
TSQLMainRecord = class(TSQLRecord) | |
private | |
FOuterRecordArray: TOuterRecordArray; | |
published | |
property OuterRecordArray: TOuterRecordArray read FOuterRecordArray write FOuterRecordArray; | |
end; | |
TTestManipulateNestedRecordArray = class(TSynTestCase) | |
published | |
procedure Test; | |
end; | |
TTestSuite = class(TSynTests) | |
published | |
procedure MyTestSuite; | |
end; | |
procedure TTestManipulateNestedRecordArray.Test; | |
var | |
ILog: ISynLog; | |
DateTime: TDateTime; | |
DateTimeStr: string; | |
DBFileName: string; | |
Model: TSQLModel; | |
Rest: TSQLRest; | |
Rec: TSQLMainRecord; | |
RecID: TID; | |
NestedRecord: TNestedRecord; | |
OuterRecord: TOuterRecord; | |
GroupA: TDynArray; | |
begin | |
ILog := TSynLog.Enter; | |
DateTime := Now; | |
DateTimeStr := FormatDateTime('yyyy_mm_dd_hh_nn_ss_zzz', DateTime); | |
DBFileName := ExeVersion.ProgramFileName + '.' + DateTimeStr + '.db3'; | |
Model := TSQLModel.Create([TSQLMainRecord]); | |
try | |
Rest := TSQLRestClientDB.Create(Model, nil, DBFileName, TSQLRestServerDB, False); | |
try | |
TSQLRestClientDB(Rest).Server.CreateMissingTables; | |
Rec := TSQLMainRecord.Create; | |
try | |
RecordClear(OuterRecord, TypeInfo(TOuterRecord)); | |
GroupA.Init(TypeInfo(TNestedRecordArray), OuterRecord.NestedRecordArray); | |
RecordClear(NestedRecord, TypeInfo(TNestedRecord)); | |
NestedRecord.DummyString := 'NestedRecord 1'; | |
GroupA.Add(NestedRecord); | |
RecordClear(NestedRecord, TypeInfo(TNestedRecord)); | |
NestedRecord.DummyString := 'NestedRecord 2'; | |
GroupA.Add(NestedRecord); | |
Rec.DynArray('OuterRecordArray').Add(OuterRecord); | |
RecID := Rest.Add(Rec, True); | |
Assert(RecID > 0, 'Error adding the data'); | |
SynCommons.FileFromString(ObjectToJSON(Rec, [woHumanReadable, woObjectListWontStoreClassName]), 'Project1.json'); | |
finally | |
Rec.Free; | |
end; | |
Rec := TSQLMainRecord.Create(Rest, RecID); | |
try | |
Check(Rec.DynArray('OuterRecordArray').Count = 1); | |
Check(Length(Rec.OuterRecordArray[0].NestedRecordArray) = 2); | |
Check(Rec.OuterRecordArray[0].NestedRecordArray[0].DummyString = 'NestedRecord 1'); | |
Check(Rec.OuterRecordArray[0].NestedRecordArray[1].DummyString = 'NestedRecord 2'); | |
finally | |
Rec.Free; | |
end; | |
finally | |
Rest.Free; | |
end; | |
finally | |
Model.Free; | |
end; | |
end; | |
procedure TTestSuite.MyTestSuite; | |
begin | |
AddCase([TTestManipulateNestedRecordArray]); | |
end; | |
begin | |
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TNestedRecord), __TNestedRecord); | |
// makes no difference | |
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TNestedRecordArray), __TNestedRecord); | |
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TOuterRecord), __TOuterRecord); | |
with TSynLog.Family do | |
begin | |
Level := LOG_VERBOSE; | |
PerThreadLog := ptIdentifiedInOnFile; | |
RotateFileCount := 5; | |
RotateFileSizeKB := 20*1024; // rotate by 20 MB logs | |
end; | |
with TTestSuite.Create do | |
begin | |
try | |
Run; | |
readln; | |
finally | |
Free; | |
end; | |
end; | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment