Not include null and default values.

hafedh-trimeche commented 3 years ago

Hello,

Please how to not include null & default values using TSuperRttiContext?

Best regards.

pult commented 3 years ago

Give an example of use. I will try to adjust.

hafedh-trimeche commented 3 years ago

Hello,

Please note that the default Serializer works only with native types [Integer, Float, string, ...] not with sub-types: TcustomDataTime = type TDateTime.

Sub-types will not be intercepted and will be treated as native ones: TCustomDateTime = TDateTime = Double.

Including only not empty values is illustrated with this example for TDateTime Seriailization:

unit uMarshalSuper;
{$I Defines}
{$IFDEF FPC}
{$Mode delphi}
{$ENDIF}
interface
uses
  Rtti,SysUtils,
  superobject;
type
  Serializer = record
  public
    class function Marshal<T>(const Data:T):string;overload;static;
    class function Unmarshal<T>(Text:string;out Data:T):Boolean;overload;static;
  end;

  TSerialContext=class(TSuperRttiContext)
  public
    constructor Create;override;
  end;

implementation
uses
  TypInfo,DateUtils;
const
  NullDateTime = -328716;

function SerialToDateTime(ctx:TSuperRttiContext;var Value:TValue;const Index:ISuperObject):ISuperObject;
var
  LDateTime : TDateTime;
begin
  LDateTime := Value.AsExtended;
  if (FloatToStr(LDateTime)<>FloatToStr(0)) and (FloatToStr(LDateTime)<>FloatToStr(NullDateTime)) then
  begin
    Result := TSuperObject.Create(DateToISO8601(LDateTime));
  end
  else Result := nil;
end;

function SerialFromDateTime(ctx:TSuperRttiContext;const obj:ISuperObject;var Value:TValue):Boolean;
begin
  Result := True;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////////////
class function Serializer.Marshal<T>(const Data:T):string;
var
  ctx : TSerialContext;
  obj : ISuperObject;
begin
  if @Data=nil then Result := '' else
  begin
    ctx := TSerialContext.Create;
    try
      obj    := ctx.AsJson<T>(Data);
      Result := obj.AsJSon;
    except
      Result := '';
    end;
    FreeAndNil(ctx);
    if Result='' then raise Exception.Create('Serializer.Marshal:');
  end;
end;

class function Serializer.Unmarshal<T>(Text:string;out Data:T):Boolean;
var
  ctx   : TSuperRttiContext;
begin
  while (Text<>'') and (not CharInSet(Text[Length(Text)],['}',']'])) do SetLength(Text,Length(Text)-1);
  if Text='' then Exit(False);
  ctx := TSerialContext.Create;
  try
    Data   := ctx.AsType<T>(SO(Text));
    Result := True;
  except
    Result := False;
    Data   := default(T);
  end;
  FreeAndNil(ctx);
  if not(Result) then raise Exception.Create('Serializer.Unmarshal'+#13#10+Text);
end;

{ TSerialContext }

constructor TSerialContext.Create;
begin
  inherited;
  SerialToJson.Clear;
  SerialToJson.Add(TypeInfo(TDateTime),SerialToDateTime);
end;

end.

Best regards.

pult commented 3 years ago

More mashaling customization: #https://github.com/pult/SuperObject.Delphi/commit/641c2876b608492bf224d92cd092480fa5b5c84f

Modified your sample: see: Demos/MarshalSuper

Warning for "class function Serializer.Unmarshal(..." :

call: JsonSerializer.Unmarshal<T>("2020-12-14T17:30:10.308Z", ...

After call

  while (Text<>'') and (not CharInSet(Text[Length(Text)], ['}',']'])) do
     SetLength(Text, Length(Text)-1);

Text is empty

hafedh-trimeche commented 3 years ago

Dear Pult,

Please note that trimming text if for Json verification: Text must be framed by {} or [].

Please also note this context Wrapper.

For Custom Types the procedure RegisterCustomTypeInfo(CustomType,BaseType:PTypeInfo); method included into uTypeInfo would be used.

Would GetObjectName be declared as protected?

unit uTypeInfo;
{$I Defines}
{$IFDEF FPC}
{$Mode delphi}
{$ENDIF}
interface
uses
  SysUtils,TypInfo,Generics.Collections;
var
  TypeInfoDictionary : TDictionary<Pointer,Pointer>;

procedure RegisterCustomTypeInfo(CustomType,BaseType:PTypeInfo);
function  BaseTypeInfo(CustomType:PTypeInfo):PTypeInfo;

implementation

procedure RegisterCustomTypeInfo(CustomType,BaseType:PTypeInfo);
begin
  TypeInfoDictionary.AddOrSetValue(CustomType,BaseType);
end;

function BaseTypeInfo(CustomType:PTypeInfo):PTypeInfo;
begin
  if not TypeInfoDictionary.TryGetValue(CustomType,Pointer(Result)) then Result := CustomType;
end;

initialization
  TypeInfoDictionary := TDictionary<Pointer,Pointer>.Create;
finalization
  FreeAndNil(TypeInfoDictionary);
end.

unit uMarshalSuper;
{$I Defines}
{$IFDEF FPC}
{$Mode delphi}
{$ENDIF}
interface
uses
  TypInfo,Rtti,SysUtils,
  superobject;
type
  Serializer = record
  public
    class function Marshal<T>(const Data:T):string;overload;static;
    class function Unmarshal<T>(Text:string;out Data:T):Boolean;overload;static;
  end;

  TSerialContext=class(TSuperRttiContext)
  private
    DateTimeTypeInfo ,
    DateTypeInfo     ,
    TimeTypeInfo     ,
    BytesTypeInfo    : PTypeInfo;
    FNullDateTime    ,
    FZero            : string;
    FForceDefault    : Boolean;
    class function Encode(const Bytes:TBytes):string;
    class function Decode(const Value:string):TBytes;
  public
    constructor Create;override;
    function ToJson(var Value:TValue;const Index:ISuperObject):ISuperObject;override;
    function FromJson(ATypeInfo:PTypeInfo;const SuperObject:ISuperObject;var Value:TValue):Boolean;override;
  public
    property ForceDefault : Boolean read FForceDefault write FForceDefault;
  end;

implementation
uses
  uTypeInfo,
  {$IFDEF DCC}
  System.NetEncoding,
  {$ELSE}
  IdCoder, IdCoderMIME, IdGlobal,
  {$ENDIF}
  DateUtils;
const
  NullDateTime = -328716;

class function TSerialContext.Encode(const Bytes:TBytes):string;
begin
  {$IFDEF DCC}
  Result := TNetEncoding.Base64.EncodeBytesToString(Bytes);
  {$ELSE}
  Result := TIdEncoderMIME.EncodeBytes(Bytes);
  {$ENDIF}
end;

class function TSerialContext.Decode(const Value:string):TBytes;
begin
  {$IFDEF DCC}
  try
    Result := TNetEncoding.Base64.DecodeStringToBytes(Value);
  except
    Result := nil;
  end;
  {$ELSE}
  Result := TIdDecoderMIME.DecodeBytes(Value);
  {$ENDIF}
end;

class function Serializer.Marshal<T>(const Data:T):string;
var
  ctx : TSerialContext;
  obj : ISuperObject;
begin
  if @Data=nil then Result := '' else
  begin
    ctx := TSerialContext.Create;
    try
      obj    := ctx.AsJson<T>(Data);
      Result := obj.AsJSon;
    except
      Result := '';
    end;
    FreeAndNil(ctx);
    if Result='' then raise Exception.Create('Serializer.Marshal:');
  end;
end;

class function Serializer.Unmarshal<T>(Text:string;out Data:T):Boolean;
var
  ctx : TSuperRttiContext;
begin
  while (Text<>'') and (not CharInSet(Text[Length(Text)],['}',']'])) do SetLength(Text,Length(Text)-1);
  if Text='' then Exit(False);
  ctx := TSerialContext.Create;
  try
    Data   := ctx.AsType<T>(SO(Text));
    Result := True;
  except
    Result := False;
    Data   := default(T);
  end;
  FreeAndNil(ctx);
  if not(Result) then raise Exception.Create('Serializer.Unmarshal'+#13#10+Text);
end;

{ TSerialContext }

constructor TSerialContext.Create;
 begin
  inherited;
  DateTimeTypeInfo := TypeInfo(TDateTime);
  DateTypeInfo     := TypeInfo(TDate);
  TimeTypeInfo     := TypeInfo(TTime);
  BytesTypeInfo    := TypeInfo(TBytes);
  FNullDateTime    := FloatToStr(NullDateTime);
  FZero            := FloatToStr(0);
  FForceDefault    := False;
end;

function TSerialContext.ToJson(var Value:TValue;const Index:ISuperObject):ISuperObject;
function GetObjectName(r:TRttiNamedObject):string;
var
  A : TCustomAttribute;
begin
  for A in r.GetAttributes do
  begin
    if A.InheritsFrom(SOName) then
    begin
      Result := SOName(A).Name;
      Exit;
    end;
  end;
  Result := r.Name;
end;
////////////////////////////////////////////////////////
function ToEnumeration:ISuperObject;
var
  LValue   : string;
  LEnum    : string;
  TypeData : PTypeData;
begin
  TypeData := Value.TypeInfo.TypeData;
  LValue   := GetEnumName(Value.TypeInfo,Value.AsOrdinal);
  if (TypeData.MinValue=0)                                 and
     (TypeData.MaxValue=1)                                 and
     (SameText(LValue,'True') or SameText(LValue,'False')) then
  begin
    if FForceDefault or SameText(LValue,'True')  then Result := TSuperObject.Create(Value.AsBoolean);
  end
  else
  begin
    LEnum := GetEnumName(Value.TypeInfo,TypeData.MinValue);
    if FForceDefault or (LValue<>LEnum) then Result := TSuperObject.Create(LValue);
  end;
end;
////////////////////////////////////////////////////////
function ToChar:ISuperObject;
var
  LValue : string;
begin
  LValue := Value.AsString;
  if FForceDefault or (LValue>#0) then Result := TSuperObject.Create(LValue[1]);
end;
////////////////////////////////////////////////////////
function ToString:ISuperObject;
begin
  if FForceDefault or (Value.AsString<>'') then Result := inherited;
end;
////////////////////////////////////////////////////////
function ToNumber:ISuperObject;
const
  NullDateTime = -328716;
var
  LValue  : TDateTime;
  LString : string;
  LType   : PTypeInfo;
  LFloat  : string;
begin
  LValue := Value.AsExtended;
  LType  := BaseTypeInfo(Value.TypeInfo);
  LFloat := FloatToStr(LValue);
  if (LType=DateTimeTypeInfo) or (LType=DateTypeInfo) or (LType=TimeTypeInfo)then
  begin
    if ((LFloat=FZero) or (LFloat=FNullDateTime)) and (not FForceDefault) then Exit;
    if LType=TimeTypeInfo then LString := FormatDateTime('hh:nn:ss.zzz',LValue) else
    begin
      LString := DateToISO8601(LValue);
      if LType=DateTypeInfo then LString := Copy(LString,1,Pos('T',LString)-1);
    end;
    Result := TSuperObject.Create(LString);
  end
  else
  begin
    if FForceDefault or (LFloat<>FZero) then Result := inherited;
  end;
end;
////////////////////////////////////////////////////////
function ToArray:ISuperObject;
begin
  if BaseTypeInfo(Value.TypeInfo)=BytesTypeInfo then
  begin
    Result := TSuperObject.Create(Encode(Value.AsType<TBytes>));
  end
  else Result := inherited;
end;
////////////////////////////////////////////////////////
procedure ToRecord;
var
  LField  : TRttiField;
  LValue  : TValue;
  LObject : ISuperObject;
begin
  Result := TSuperObject.Create(stObject);
  for LField in Context.GetType(Value.TypeInfo).GetFields do
  begin
    {$IFDEF USE_REFLECTION}
    //-if (f.GetCustomAttribute<SOIgnore> = nil) then
    if (not IsIgnoredObject(f)) then // https://github.com/hgourvest/superobject/pull/13
    {$ENDIF USE_REFLECTION}
    begin
      {$IFDEF VER210}
      LValue := f.GetValue(IValueData(TValueData(Value).FHeapData).GetReferenceToRawData);
      {$ELSE}
      LValue := LField.GetValue(TValueData(Value).FValueData.GetReferenceToRawData);
      {$ENDIF}
      LObject := ToJson(LValue,Index);
      if LObject<>nil then Result.AsObject[GetObjectName(LField)] := LObject;
    end;
  end;
end;
begin
  Result := nil;
  if Value.IsEmpty and (not FForceDefault) then Exit;
  case Value.Kind of
    tkInteger     ,
    tkInt64       ,
    tkFloat       : Result := ToNumber;

    tkChar        ,
    tkWChar       : Result := ToChar;

    tkEnumeration : Result := ToEnumeration;

    tkString      ,
    tkLString     ,
    tkWString     ,
    tkUString     : Result := ToString;

    tkArray       ,
    tkDynArray    : Result := ToArray;

    tkRecord      : ToRecord;
    else Result := inherited;
  end;
end;

function TSerialContext.FromJson(ATypeInfo:PTypeInfo;const SuperObject:ISuperObject;var Value:TValue):Boolean;
procedure FromNumber;
var
  LValue  : Extended;
  LString : string;
  LType   : PTypeInfo;
begin
  LString := SuperObject.AsString;
  LType   := BaseTypeInfo(ATypeInfo);
  if (LType=DateTimeTypeInfo) or (LType=DateTypeInfo) or (LType=TimeTypeInfo) then
  begin
    if Pos('-',LString)=0 then LString := '2000-01-01T'+LString;
    try
      LValue := ISO8601ToDate(LString);
    except
      Result := False;
      Exit;
    end;
    Value := TValue.From(LValue);
  end
  else Result := inherited;
end;
////////////////////////////////////////////////////////
procedure FromArray;
var
  Bytes : TBytes;
begin
  if BaseTypeInfo(ATypeInfo)=BytesTypeInfo then
  begin
    Bytes := Decode(SuperObject.AsString);
    Value := TValue.From(Bytes);
  end
  else Result := inherited;
end;
begin
  if ATypeInfo=nil then Exit(False);
  Result := True;
  case ATypeInfo.Kind of
    tkFloat    : FromNumber;
    tkArray    ,
    tkDynArray : FromArray;
    else Result := inherited;
  end;
end;

end.

pult commented 3 years ago

GetObjectName

TSuperRttiContext - private reduced to protected https://github.com/pult/SuperObject.Delphi/commit/ca45893c6377ce855f7f2dcc9a6ab927745c9966

Please note that trimming text if for Json verification: Text must be framed by {} or [].

It allow marsahling also value... (without {} [])

RegisterCustomTypeInfo

? I don’t understand what doesn’t work for you? We need a more complete example - what to run, what we expect to get.

Internal methods are virtualized to simplify overrides https://github.com/pult/SuperObject.Delphi/commit/af2ab84a6259094b669b51ad12e39eaec6691803 This should simplify your code for TSerialContext

pult commented 3 years ago

Added ForceDefault, ForceEnumeration (like your idea) Reimplementation marshaling tkEnumeration (like your idea) https://github.com/pult/SuperObject.Delphi/commit/5889c5621cc03e3c68211ef11bbba303869ce544

hafedh-trimeche commented 3 years ago

Dear Pult,

Thank you for the prompt support.

The jToRecord function should be modified to avoid nul value to be assigned to Json value.

Actually, an empty Item is represented as "Item":null, but it should be an empty representation ; which for what the ForceDefault is introduced.

The jToRecord should be as:

function TSerialContext.jToRecord(const Value:TValue;const Index:ISuperObject):ISuperObject;
var
  LField  : TRttiField;
  LValue  : TValue;
  LObject : ISuperObject;
begin
  Result := inherited;
  Exit;
  Result := TSuperObject.Create(stObject);
  for LField in Context.GetType(Value.TypeInfo).GetFields do
  begin
    {$IFDEF USE_REFLECTION}
    //-if (f.GetCustomAttribute<SOIgnore> = nil) then
    if (not IsIgnoredObject(f)) then // https://github.com/hgourvest/superobject/pull/13
    {$ENDIF USE_REFLECTION}
    begin
      {$IFDEF VER210}
      LValue := f.GetValue(IValueData(TValueData(Value).FHeapData).GetReferenceToRawData);
      {$ELSE}
      LValue := LField.GetValue(TValueData(Value).FValueData.GetReferenceToRawData);
      {$ENDIF}
      LObject := ToJson(LValue,Index);
      if LObject<>nil then Result.AsObject[GetObjectName(LField)] := LObject;
    end;
  end;
end;

Please note this test

     LObject := ToJson(LValue,Index);
     if LObject<>nil then Result.AsObject[GetObjectName(LField)] := LObject;

RegisterCustomTypeInfo is introduced to register base custom types as basic ones (root) to avoid write Custom Serializer for each Custom Type (Sub-Type): if BaseTypeInfo(CustomType)=TypeInfo(TDateTime) then ...

type
  TCustomDataTime = type TDateTime;
  TCustoRecord =
  record
    DataTime : TCustomDataTime;
  end;

The DateTime Field will be serialized as Float and not as TDateTime.

The override of then function jToFloat intercepts the eventual conflict caused by TCustomDataTime Is Different from TDateTime;

Instead of registering a Custom Serializer, just register a Custom Type as a Base one RegisterCustomTypeInfo(TCustomDataTime,TypeInfo(TDateTime)) and test Value Type as: if BaseTypeInfo(Value.TypeInfo)=TypeInfo(TDateTime) then ...

function TSerialContext.jToFloat(const Value:TValue;const Index:ISuperObject):ISuperObject;
const
  NullDateTime = -328716;
var
  LValue  : TDateTime;
  LString : string;
  LType   : PTypeInfo;
  LFloat  : string;
begin
  Result := nil;
  LValue := Value.AsExtended;
  LType  := BaseTypeInfo(Value.TypeInfo);
  LFloat := FloatToStr(LValue);
  if (LType=DateTimeTypeInfo) or (LType=DateTypeInfo) or (LType=TimeTypeInfo)then
  begin
    if ((LFloat=FZero) or (LFloat=FNullDateTime)) and (not FForceDefault) then Exit;
    if LType=TimeTypeInfo then LString := FormatDateTime('hh:nn:ss.zzz',LValue) else
    begin
      LString := DateToISO8601(LValue);
      if LType=DateTypeInfo then LString := Copy(LString,1,Pos('T',LString)-1);
    end;
    Result := TSuperObject.Create(LString);
  end
  else
  begin
    if FForceDefault or (LFloat<>FZero) then Result := inherited;
  end;
end;

I'll provide an example illustrating problem caused by type's conflict.

Best regards.

pult commented 3 years ago

Added types mapped dictionary (TypeInfoDictionary) and updated jToRecord, ToJson, FromJson:

(https://github.com/pult/SuperObject.Delphi/commit/ae0cb536063470e14e129843990cc9cfa845a89f) - jToRecord: avoid nul value to be assigned to Json value

(https://github.com/pult/SuperObject.Delphi/commit/21d27276732b6aceb95a046c6e687f3fbc1592dd) - Customize rtti marshaling

(https://github.com/pult/SuperObject.Delphi/commit/7fd144772a8090621716e87448f4910acac38913) - Sample marshaling record (delphi) and Custom Type (Sub-Type)

pult commented 3 years ago

( https://github.com/pult/SuperObject.Delphi/commit/941f9aecd7e1d5bc08f5f6a42933fddc073f9d3f ) - Added customize marshaling by attributes [SOType(TypeInfo(T))]

  TCustomDataTime2 = type TDateTime;

  TCustomRecord = record
    [SOType(TypeInfo(TDateTime))]
    DataTimeField2: TCustomDataTime2;

initialization
  SuperRttiContextDefault.ForceTypeMap := True; // Allow use attributes [SOType(TypeInfo(T))]

hafedh-trimeche commented 3 years ago

Hello Pult,

Thank you for these enhancements.

1- Would FromXXXXX also be set as protected method to be overridden? 2- Would the Parser/Writer (TSuperObject) be modified to be used in a Mluti-Thread context using a lock mechanism at writing level of objects?

Best regards.

pult commented 3 years ago

( https://github.com/pult/SuperObject.Delphi/commit/3084b6727ca4224b349f12d5469f4f22b80d7649 ) FromJson: FromXXXXX
( https://github.com/pult/SuperObject.Delphi/commit/78c1cdce5766619a3e13b9f01cfff08539b7e7fa ) RWSynchronize - multithreaded protected access to rtti object when marshaling. SuperRttiContextDefault.RWSynchronize := True; // Dafault is False

hafedh-trimeche commented 3 years ago

Dear Pult,

It seams that Enumeration is handled as an Integer and caused AV when the Json document includes an Enumeration as string:

    tkEnumeration, tkInteger:
      Result := jFromInt(ATypeInfo, obj, Value);

jFromEnumeration would be implemented as virtual method!

Best regards.

pult commented 3 years ago

jFromEnumeration:

( https://github.com/pult/SuperObject.Delphi/commit/532397e071e6125d030b530373323f1fe9309864 ) Forse/Customize Enumeration, Set. Safe StringToSet.

    tkEnumeration:
      Result := jFromEnumeration(ATypeInfo, obj, Value);
    tkInteger:
      Result := jFromInt(ATypeInfo, obj, Value);
    tkSet:
      Result := jFromSet(ATypeInfo, obj, Value);

Also added customization for Set:

function jToSet(... virtual;
function jFromSet(... virtual;
property ForceSet: Boolean

Sample serialization Enumeration, Set ( https://github.com/pult/SuperObject.Delphi/commit/12654b82f700fda6c8d19a2ffd8dde8f4ca0f1db ) 202012170200_532397e

pult / SuperObject.Delphi

Not include null and default values. #1