Skip to content

Instantly share code, notes, and snippets.

Created December 3, 2017 16:22
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save anonymous/cff26cd4bbaf162159e32a63c525372d to your computer and use it in GitHub Desktop.
// 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