Delphi create JSON

Question

I'm on Delphi XE6 and I search the best way for create JSON and for parse JSON.

I try to work with REST.Json unit and this method : TJson.ObjectToJsonString

TContrat = class
private
  FdDateDeb: TDate;
public
   property dDateDeb: TDate read FdDateDeb write FdDateDeb;
end;

TApprenant = class
private
   FsNom   : string;
   [JSONName('ListContrat')]
   FListContrat: TObjectList<TContrat>;
public
   property sNom   : string read FsNom write FsNom;
   property ListContrat: TObjectList<TContrat> read FListContrat write FListContrat;
end;

...
procedure TForm3.Button2Click(Sender: TObject);
var
   apprenant : TApprenant;
   contrat : TContrat;
begin
   Memo1.Clear;

   apprenant := TApprenant.Create;
   apprenant.sNom := 'JEAN';

   contrat := TContrat.Create;
   contrat.dDateDeb := StrToDate('01/01/2015');
   apprenant.ListContrat.Add(contrat);

   contrat := TContrat.Create;
   contrat.dDateDeb := StrToDate('01/01/2016');
   apprenant.ListContrat.Add(contrat);

   Memo1.Lines.Add(TJson.ObjectToJsonString(apprenant));
end;

the result is

{
    "sNom": "JEAN",
    "ListContrat": {
        "ownsObjects": true,
        "items": [{
            "dDateDeb": 42005,
        }, {
            "dDateDeb": 42370,
        }],
        "count": 2,
        "arrayManager": {}
    }
}

In the result I have some property of TObjectList<> (ex "ownsObjects").

Is it the best way to create a JSON ? I must use a framework ? Have you a good tutorial ?

Sorry, I have search on forum but not found a good way.

Answer 1

If the JSON is just for Serializing/Deserializing (most cases) the you should deal with JSON only on the bounderies of your application.

Contracts

Define your contract(s) for the outside and use them to transport the data from inside to outside and vice versa.

First the contract unit which is designed for a convenient de-/serialization

unit whatever.ApiJson.v1;

// this is the contract definition for version 1    

interface

uses
  System.SysUtils,
  REST.Json.Types,
  Commons.JsonContract;

type
  TApprenantJSON = class;
  TContratJSON   = class;

  TContratJSON = class( TJsonContractBase )
  private
    [ JSONName( 'date_deb' ) ]
    FDateDeb: TDateTime;
  public
    property DateDeb: TDateTime read FDateDeb write FDateDeb;
  public
    class function FromJson( const aJsonStr: string ): TContratJSON;
  end;

  TApprenantJSON = class( TJsonContractBase )
  private
    [ JSONName( 'nom' ) ]
    FNom: string;
    [ JSONName( 'contrats' ) ]
    FContrats: TArray<TContratJSON>;
  public
    property Nom     : string read FNom write FNom;
    property Contrats: TArray<TContratJSON> read FContrats write FContrats;
  public
    destructor Destroy; override;
  public
    class function FromJson( const aJsonStr: string ): TApprenantJSON;
  end;

implementation

{ TApprenantJSON }

destructor TApprenantJSON.Destroy;
begin
  DisposeObjectArray<TContratJSON>( FContrats );
  inherited;
end;

class function TApprenantJSON.FromJson( const aJsonStr: string ): TApprenantJSON;
begin
  Result := _FromJson( aJsonStr ) as TApprenantJSON;
end;

{ TContratJSON }

class function TContratJSON.FromJson( const aJsonStr: string ): TContratJSON;
begin
  Result := _FromJson( aJsonStr ) as TContratJSON;
end;

end.

As you can see I use arrays and classes. To manage these arrays with classes I have a base class dealing with that

unit Commons.JsonContract;

interface

type
  TJsonContractBase = class abstract
  protected
    procedure DisposeObjectArray<T: class>( var arr: TArray<T> );
    class function _FromJson( const aJsonStr: string ): TObject; overload;
    class procedure _FromJson( aResult: TObject; const aJsonStr: string ); overload;
  public
    function ToJson( ): string; virtual;
  end;

implementation

uses
  System.Sysutils,
  System.JSON,
  REST.JSON;

{ TJsonContractBase }

procedure TJsonContractBase.DisposeObjectArray<T>( var arr: TArray<T> );
var
  I: Integer;
begin
  for I := low( arr ) to high( arr ) do
    FreeAndNil( arr[ I ] );
  SetLength( arr, 0 );
end;

class function TJsonContractBase._FromJson( const aJsonStr: string ): TObject;
begin
  Result := Self.Create;
  try
    _FromJson( Result, aJsonStr );
  except
    Result.Free;
    raise;
  end;
end;

class procedure TJsonContractBase._FromJson( aResult: TObject; const aJsonStr: string );
var
  lJson: TJsonObject;
begin
  lJson := TJsonObject.ParseJSONValue( aJsonStr ) as TJsonObject;
  try
    TJson.JsonToObject( aResult, lJson );
  finally
    lJson.Free;
  end;
end;

function TJsonContractBase.ToJson: string;
begin
  Result := TJson.ObjectToJsonString( Self );
end;

end.

Business Objects

For the application itself we use this classes only for de-/serialization. The internal business objects/entities are separated from them.

unit whatever.DataObjects;

interface

uses
  System.Generics.Collections;

type
  TApprenant = class;
  TContrat   = class;

  TApprenant = class
  private
    FNom     : string;
    FContrats: TObjectList<TContrat>;
  public
    property Nom     : string read FNom write FNom;
    property Contrats: TObjectList<TContrat> read FContrats;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TContrat = class
  private
    FDateDeb: TDateTime;
  public
    property DateDeb: TDateTime read FDateDeb write FDateDeb;
  end;

implementation

{ TApprenant }

constructor TApprenant.Create;
begin
  inherited;
  FContrats := TObjectList<TContrat>.Create( true );
end;

destructor TApprenant.Destroy;
begin
  FContrats.Free;
  inherited;
end;

end.

What is the benefit declare everything twice?

Well, now you can change the business objects or contracts without infecting each other. You can have different types, names in both and your internal classes are not tight bound to any contract to the outside.

See: Single Responsibility Principle

Mapping

For an easy mapping between the business objects and the contract use a mapper

unit Commons.Mappings;

interface

uses
  System.Generics.Collections,
  System.Rtti,
  System.SysUtils,
  System.TypInfo;

type
  TMapKey = record
    Source: PTypeInfo;
    Target: PTypeInfo;
    class function Create<TSource, TTarget>( ): TMapKey; static;
  end;

  TMapper = class
  private
    FMappings: TDictionary<TMapKey, TFunc<TValue, TValue>>;
  public
    procedure Add<TSource, TTarget>( aConverter: TFunc<TSource, TTarget> ); overload;
    procedure Add<TSource, TTarget>( aConverter: TFunc<TSource, TTarget>; aReverter: TFunc<TTarget, TSource> ); overload;
  public
    constructor Create;
    destructor Destroy; override;

    function Map<TSource, TTarget>( const aSource: TSource ): TTarget; overload;
    procedure Map<TSource, TTarget>( const aSource: TSource; out aTarget: TTarget ); overload;
    function MapCollection<TSource, TTarget>( const aCollection: TEnumerable<TSource> ): TArray<TTarget>; overload;
    function MapCollection<TSource, TTarget>( const aCollection: array of TSource ): TArray<TTarget>; overload;
  end;

implementation

{ TMapper }

procedure TMapper.Add<TSource, TTarget>( aConverter: TFunc<TSource, TTarget> );
var
  lKey: TMapKey;
begin
  lKey := TMapKey.Create<TSource, TTarget>( );
  FMappings.Add( lKey,
    function( Source: TValue ): TValue
    begin
      Result := TValue.From<TTarget>( aConverter( Source.AsType<TSource>( ) ) );
    end );
end;

procedure TMapper.Add<TSource, TTarget>(
  aConverter: TFunc<TSource, TTarget>;
  aReverter : TFunc<TTarget, TSource> );
begin
  Add<TSource, TTarget>( aConverter );
  Add<TTarget, TSource>( aReverter );
end;

constructor TMapper.Create;
begin
  inherited;
  FMappings := TDictionary < TMapKey, TFunc < TValue, TValue >>.Create;
end;

destructor TMapper.Destroy;
begin
  FMappings.Free;
  inherited;
end;

function TMapper.Map<TSource, TTarget>( const aSource: TSource ): TTarget;
var
  lKey: TMapKey;
begin
  lKey   := TMapKey.Create<TSource, TTarget>( );
  Result := FMappings[ lKey ]( TValue.From<TSource>( aSource ) ).AsType<TTarget>( );
end;

procedure TMapper.Map<TSource, TTarget>(
  const aSource: TSource;
  out aTarget  : TTarget );
begin
  aTarget := Map<TSource, TTarget>( aSource );
end;

function TMapper.MapCollection<TSource, TTarget>( const aCollection: array of TSource ): TArray<TTarget>;
var
  lCollection: TList<TSource>;
begin
  lCollection := TList<TSource>.Create( );
  try
    lCollection.AddRange( aCollection );
    Result := MapCollection<TSource, TTarget>( lCollection );
  finally
    lCollection.Free;
  end;
end;

function TMapper.MapCollection<TSource, TTarget>( const aCollection: TEnumerable<TSource> ): TArray<TTarget>;
var
  lKey       : TMapKey;
  lMapHandler: TFunc<TValue, TValue>;
  lResult    : TList<TTarget>;
  lSourceItem: TSource;
begin
  lKey        := TMapKey.Create<TSource, TTarget>( );
  lMapHandler := FMappings[ lKey ];

  lResult := TList<TTarget>.Create;
  try
    for lSourceItem in aCollection do
      begin
        lResult.Add( lMapHandler( TValue.From<TSource>( lSourceItem ) ).AsType<TTarget>( ) );
      end;

    Result := lResult.ToArray( );
  finally
    lResult.Free;
  end;
end;

{ TMapKey }

class function TMapKey.Create<TSource, TTarget>: TMapKey;
begin
  Result.Source := TypeInfo( TSource );
  Result.Target := TypeInfo( TTarget );
end;

end.

Putting all together

program so_37659536;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Commons.Mappings in 'Commons.Mappings.pas',
  Commons.JsonContract in 'Commons.JsonContract.pas',
  whatever.DataObjects in 'whatever.DataObjects.pas',
  whatever.ApiJson.v1 in 'whatever.ApiJson.v1.pas',
  whatever.ApiJson.v2 in 'whatever.ApiJson.v2.pas';

procedure DemoMapV1( aMapper: TMapper );
var
  lApprenant: TApprenant;
  lContrat  : TContrat;

  lApprenantJSON: whatever.ApiJson.v1.TApprenantJSON;

  lApprenantJSONStr: string;
begin
  WriteLn;
  WriteLn( 'V1' );
  WriteLn;
{$REGION 'Serialize'}
  lApprenantJSON := nil;
  try
    lApprenant := TApprenant.Create;
    try

      lApprenant.Nom   := 'JEAN';
      lContrat         := TContrat.Create;
      lContrat.DateDeb := EncodeDate( 2015, 1, 1 );
      lApprenant.Contrats.Add( lContrat );

      aMapper.Map( lApprenant, lApprenantJSON );

    finally
      lApprenant.Free;
    end;

    lApprenantJSONStr := lApprenantJSON.ToJson( );
  finally
    lApprenantJSON.Free;
  end;
{$ENDREGION 'Serialize'}
  WriteLn( lApprenantJSONStr );

{$REGION 'Deserialize'}
  lApprenant     := nil;
  lApprenantJSON := whatever.ApiJson.v1.TApprenantJSON.FromJson( lApprenantJSONStr );
  try
    aMapper.Map( lApprenantJSON, lApprenant );
    try

      WriteLn( 'Nom: ', lApprenant.Nom );
      WriteLn( 'Contrats:' );
      for lContrat in lApprenant.Contrats do
        begin
          WriteLn( '- ', DateToStr( lContrat.DateDeb ) );
        end;

    finally
      lApprenant.Free;
    end;
  finally
    lApprenantJSON.Free;
  end;
{$ENDREGION 'Deserialize'}
end;

var
  Mapper: TMapper;

begin
  try
    Mapper := TMapper.Create;
    try

{$REGION 'Define Mapping'}
{$REGION 'v1'}
      Mapper.Add<TApprenant, whatever.ApiJson.v1.TApprenantJSON>(
        function( s: TApprenant ): whatever.ApiJson.v1.TApprenantJSON
        begin
          Result := whatever.ApiJson.v1.TApprenantJSON.Create;
          Result.Nom := s.Nom;
          Result.Contrats := Mapper.MapCollection<TContrat, whatever.ApiJson.v1.TContratJSON>( s.Contrats );
        end,
        function( s: whatever.ApiJson.v1.TApprenantJSON ): TApprenant
        begin
          Result := TApprenant.Create;
          Result.Nom := s.Nom;
          Result.Contrats.AddRange( Mapper.MapCollection<whatever.ApiJson.v1.TContratJSON, TContrat>( s.Contrats ) );
        end );

      Mapper.Add<TContrat, whatever.ApiJson.v1.TContratJSON>(
        function( s: TContrat ): whatever.ApiJson.v1.TContratJSON
        begin
          Result := whatever.ApiJson.v1.TContratJSON.Create;
          Result.DateDeb := s.DateDeb;
        end,
        function( s: whatever.ApiJson.v1.TContratJSON ): TContrat
        begin
          Result := TContrat.Create;
          Result.DateDeb := s.DateDeb;
        end );
{$ENDREGION 'v1'}

{$REGION 'v2'}
// mapping for v2
{$ENDREGION 'v2'}

{$ENDREGION 'Define Mapping'}
      DemoMapV1( Mapper );

    finally
      Mapper.Free;
    end;
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Note This is tested on Delphi Seattle - you may have to change some of the units to get this running on XE6