Improved support for HATEOAS in renders

2024-11-15 07:45:54 +01:00 · 2019-03-08 09:33:41 +01:00 · 2019-03-08 09:33:41 +01:00 · beb059a0e3
commit beb059a0e3
parent 98d4b353f4
13 changed files with 326 additions and 154 deletions
--- a/README.md
+++ b/README.md
@ -66,6 +66,16 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma

 ### DelphiMVCFramework 3.1.1-beryllium (currently in `RC` phase)
 - New! Added SQLGenerator and RQL compiler for PostgreSQL (in addition to MySQL, MariaDB, Firebird and Interbase)
+- Improved! Greatly improved support for [HATEOAS](https://en.wikipedia.org/wiki/HATEOAS) in renders. Check `TRenderSampleController.GetPeople_AsObjectList_HATEOS` in `renders.dproj` sample)
+```delphi
+    //Now is really easy to add "_links" property automatically for each collection element while rendering
+	  Render<TPerson>(People, True,
+		procedure(const Person: TPerson; const Dict: TMVCStringDictionary)
+		begin
+		  Dict['x-ref'] := '/api/people/' + Person.ID;
+		  Dict['x-child-ref'] := '/api/people/' + Person.ID + '/child';
+		end);
+```		
 - Better packages organization (check `packages` folder)
 - New! `TMVCActiveRecord.Count` method (e.g. `TMVCActiveRecord.Count(TCustomer)` returns the number of records for the entity mapped by the class `TCustomer`)
 - Change! `TMVCACtiveRecord.GetByPK<T>` raises an exception if the record is not found
--- a/samples/renders/CustomTypesSerializersU.pas
+++ b/samples/renders/CustomTypesSerializersU.pas
@ -30,7 +30,7 @@ interface

 uses
  MVCFramework.Serializer.Intf,
-  System.Rtti;
+  System.Rtti, MVCFramework.Serializer.Commons;

 type
  // Custom serializer for TUserRoles type
@ -43,7 +43,8 @@ type
    procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
      const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
    procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
-      const AAttributes: System.TArray<System.TCustomAttribute>);
+      const AAttributes: System.TArray<System.TCustomAttribute>;
+      const ASerializationAction: TMVCSerializationAction = nil);
    procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
      const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
    procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
@ -60,7 +61,8 @@ type
    procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
      const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
    procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
-      const AAttributes: System.TArray<System.TCustomAttribute>);
+      const AAttributes: System.TArray<System.TCustomAttribute>;
+      const ASerializationAction: TMVCSerializationAction);
    procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
      const ASerializerObject: TObject; const AAttributes: System.TArray<System.TCustomAttribute>);
    procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
@ -71,7 +73,7 @@ implementation

 uses
  JsonDataObjects, CustomTypesU, MVCFramework.Serializer.JsonDataObjects,
-  System.SysUtils, MVCFramework.Serializer.Commons;
+  System.SysUtils;

 { TUserPasswordSerializer }

@ -145,13 +147,14 @@ begin
 end;

 procedure TNullableAliasSerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
-  const AAttributes: System.TArray<System.TCustomAttribute>);
+      const AAttributes: System.TArray<System.TCustomAttribute>;
+      const ASerializationAction: TMVCSerializationAction);
 begin
  raise EMVCSerializationException.CreateFmt('%s cannot be used as root object', [ClassName]);
 end;

 procedure TUserRolesSerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
-  const AAttributes: System.TArray<System.TCustomAttribute>);
+  const AAttributes: System.TArray<System.TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
 begin
  raise EMVCSerializationException.CreateFmt('%s cannot be used as root object', [ClassName]);
 end;
--- a/samples/renders/RenderSampleControllerU.pas
+++ b/samples/renders/RenderSampleControllerU.pas
@ -66,6 +66,11 @@ type
    [MVCProduces('application/json')]
    procedure GetPeople_AsObjectList;

+    [MVCHTTPMethod([httpGET])]
+    [MVCPath('/people/hateos')]
+    [MVCProduces('application/json')]
+    procedure GetPeople_AsObjectList_HATEOS;
+
    [MVCHTTPMethod([httpGET])]
    [MVCPath('/people/withtiming')]
    [MVCProduces('application/json')]
@ -253,8 +258,8 @@ begin
  try
    lDM.qryCustomers.Open;
    lHolder := TDataSetHolder.Create(lDM.qryCustomers);
-    lHolder.Metadata.AddProperty('page', '1');
-    lHolder.Metadata.AddProperty('count', lDM.qryCustomers.RecordCount.ToString);
+    lHolder.Metadata.Add('page', '1');
+    lHolder.Metadata.Add('count', lDM.qryCustomers.RecordCount.ToString);
    Render(lHolder);
  finally
    lDM.Free;
@ -419,6 +424,44 @@ begin
  Render<TPerson>(People);
 end;

+procedure TRenderSampleController.GetPeople_AsObjectList_HATEOS;
+var
+  p: TPerson;
+  People: TObjectList<TPerson>;
+begin
+  People := TObjectList<TPerson>.Create(True);
+
+{$REGION 'Fake data'}
+  p := TPerson.Create;
+  p.FirstName := 'Daniele';
+  p.LastName := 'Teti';
+  p.DOB := EncodeDate(1979, 11, 4);
+  p.Married := True;
+  People.Add(p);
+
+  p := TPerson.Create;
+  p.FirstName := 'John';
+  p.LastName := 'Doe';
+  p.DOB := EncodeDate(1879, 10, 2);
+  p.Married := False;
+  People.Add(p);
+
+  p := TPerson.Create;
+  p.FirstName := 'Jane';
+  p.LastName := 'Doe';
+  p.DOB := EncodeDate(1883, 1, 5);
+  p.Married := True;
+  People.Add(p);
+
+{$ENDREGION}
+  Render<TPerson>(People, True,
+    procedure(const APerson: TPerson; const Dict: TMVCStringDictionary)
+    begin
+      Dict['ref'] := '/api/people/' + APerson.LastName;
+      Dict['x-ref'] := '/api/people/' + APerson.LastName;
+    end);
+end;
+
 procedure TRenderSampleController.GetPersonJSON;
 var
  p: TJSONObject;
--- a/sources/MVCFramework.Commons.pas
+++ b/sources/MVCFramework.Commons.pas
@ -133,6 +133,7 @@ type
    FallbackResource = 'fallback_resource';
    MaxEntitiesRecordCount = 'max_entities_record_count';
    MaxRequestSize = 'max_request_size'; // bytes
+    HATEOSPropertyName = 'hateos';
  end;

  // http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
@ -354,7 +355,7 @@ type
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
-    function AddProperty(const Name, Value: string): TMVCStringDictionary;
+    function Add(const Name, Value: string): TMVCStringDictionary;
    function TryGetValue(const Name: string; out Value: string): Boolean; overload;
    function TryGetValue(const Name: string; out Value: Integer): Boolean; overload;
    function Count: Integer;
@ -732,7 +733,7 @@ end;

 procedure TMVCConfig.SetValue(const AIndex, AValue: string);
 begin
-  FConfig.AddProperty(AIndex, AValue);
+  FConfig.Add(AIndex, AValue);
 end;

 function TMVCConfig.ToString: string;
@ -749,7 +750,7 @@ end;

 { TMVCStringDictionary }

-function TMVCStringDictionary.AddProperty(const Name, Value: string): TMVCStringDictionary;
+function TMVCStringDictionary.Add(const Name, Value: string): TMVCStringDictionary;
 begin
  FDict.AddOrSetValue(name, Value);
  Result := Self;
--- a/sources/MVCFramework.Serializer.Commons.pas
+++ b/sources/MVCFramework.Serializer.Commons.pas
@ -59,7 +59,8 @@ type

  TMVCIgnoredList = array of string;

-  TMVCSerializationAction = TProc<TObject, TMVCStringDictionary>;
+  TMVCSerializationAction<T: class> = reference to procedure(const AObject: T; const ADictionary: TMVCStringDictionary);
+  TMVCSerializationAction = reference to procedure(const AObject: TObject; const ADictionary: TMVCStringDictionary);

  EMVCSerializationException = class(EMVCException)
  end;
@ -173,11 +174,13 @@ type
    class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static;

    class function HasAttribute<T: class>(const AMember: TRttiNamedObject): boolean; overload; static;
-    class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): boolean; overload; static;
-
-    class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T): boolean;
+    class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): boolean;
+      overload; static;
+
+    class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T)
+      : boolean; overload; static;
+    class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): boolean;
      overload; static;
-    class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): boolean; overload; static;

    class procedure EncodeStream(AInput, AOutput: TStream); static;
    class procedure DecodeStream(AInput, AOutput: TStream); static;
@ -185,7 +188,8 @@ type
    class function EncodeString(const AInput: string): string; static;
    class function DecodeString(const AInput: string): string; static;

-    class procedure DeSerializeStringStream(AStream: TStream; const ASerializedString: string; const AEncoding: string); static;
+    class procedure DeSerializeStringStream(AStream: TStream; const ASerializedString: string;
+      const AEncoding: string); static;
    class procedure DeSerializeBase64StringStream(AStream: TStream; const ABase64SerializedString: string); static;

    class function GetTypeKindAsString(const ATypeKind: TTypeKind): string; static;
@ -197,6 +201,8 @@ type
    class function IsAPropertyToSkip(const aPropName: string): boolean; static;
  end;

+  TMVCLinksCallback = reference to procedure(const Links: TMVCStringDictionary);
+
 function DateTimeToISOTimeStamp(const ADateTime: TDateTime): string;
 function DateToISODate(const ADate: TDateTime): string;
 function TimeToISOTime(const ATime: TTime): string;
@ -242,7 +248,8 @@ var
 begin
  lDateTime := ADateTime;
  if lDateTime.Length < 19 then
-    raise Exception.CreateFmt('Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)',
+    raise Exception.CreateFmt
+      ('Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)',
      [ADateTime]);

  if lDateTime.Chars[10] = ' ' then
@ -266,8 +273,8 @@ end;

 { TMVCSerializerHelper }

-class procedure TMVCSerializerHelper.DeSerializeBase64StringStream(
-  AStream: TStream; const ABase64SerializedString: string);
+class procedure TMVCSerializerHelper.DeSerializeBase64StringStream(AStream: TStream;
+  const ABase64SerializedString: string);
 var
  SS: TStringStream;
 begin
@ -281,7 +288,8 @@ begin
  end;
 end;

-class procedure TMVCSerializerHelper.DeSerializeStringStream(AStream: TStream; const ASerializedString: string; const AEncoding: string);
+class procedure TMVCSerializerHelper.DeSerializeStringStream(AStream: TStream; const ASerializedString: string;
+  const AEncoding: string);
 var
  Encoding: TEncoding;
  SS: TStringStream;
@ -326,7 +334,8 @@ begin
    end;
 end;

-class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T): boolean;
+class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>;
+  out AAttribute: T): boolean;
 var
  Att: TCustomAttribute;
 begin
@ -340,8 +349,7 @@ begin
  Result := (AAttribute <> nil);
 end;

-class function TMVCSerializerHelper.AttributeExists<T>(
-  const AAttributes: TArray<TCustomAttribute>): boolean;
+class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>): boolean;
 var
  Att: TCustomAttribute;
 begin
@ -384,7 +392,8 @@ begin
    if Assigned(ObjectType) then
      Result := CreateObject(ObjectType)
    else
-      raise Exception.CreateFmt('Cannot find Rtti for %s. Hint: Is the specified classtype linked in the module?', [AQualifiedClassName]);
+      raise Exception.CreateFmt('Cannot find Rtti for %s. Hint: Is the specified classtype linked in the module?',
+        [AQualifiedClassName]);
  finally
    Context.Free;
  end;
@ -400,7 +409,6 @@ begin
  Soap.EncdDecd.DecodeStream(AInput, AOutput);

 {$ENDIF}
-
 end;

 class function TMVCSerializerHelper.DecodeString(const AInput: string): string;
@ -413,7 +421,6 @@ begin
  Result := Soap.EncdDecd.DecodeString(AInput);

 {$ENDIF}
-
 end;

 class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream);
@ -426,7 +433,6 @@ begin
  Soap.EncdDecd.EncodeStream(AInput, AOutput);

 {$ENDIF}
-
 end;

 class function TMVCSerializerHelper.EncodeString(const AInput: string): string;
@ -439,7 +445,6 @@ begin
  Result := Soap.EncdDecd.EncodeString(AInput);

 {$ENDIF}
-
 end;

 class function TMVCSerializerHelper.GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string;
@ -507,8 +512,7 @@ begin
    end;
 end;

-class function TMVCSerializerHelper.IsAPropertyToSkip(
-  const aPropName: string): boolean;
+class function TMVCSerializerHelper.IsAPropertyToSkip(const aPropName: string): boolean;
 begin
  Result := (aPropName = 'RefCount') or (aPropName = 'Disposed');
 end;
--- a/sources/MVCFramework.Serializer.Intf.pas
+++ b/sources/MVCFramework.Serializer.Intf.pas
@ -49,7 +49,8 @@ type
    procedure SerializeRoot(
      const AObject: TObject;
      out ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
+      const AAttributes: TArray<TCustomAttribute>;
+      const ASerializationAction: TMVCSerializationAction = nil
      );

    procedure DeserializeAttribute(
@ -80,19 +81,22 @@ type
    function SerializeCollection(
      const AList: TObject;
      const AType: TMVCSerializationType = stDefault;
-      const AIgnoredAttributes: TMVCIgnoredList = []
+      const AIgnoredAttributes: TMVCIgnoredList = [];
+      const ASerializationAction: TMVCSerializationAction = nil
      ): string;

    function SerializeDataSet(
      const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = [];
-      const ANameCase: TMVCNameCase = ncAsIs
+      const ANameCase: TMVCNameCase = ncAsIs;
+      const ASerializationAction: TMVCSerializationAction = nil
      ): string;

    function SerializeDataSetRecord(
      const ADataSet: TDataSet;
      const AIgnoredFields: TMVCIgnoredList = [];
-      const ANameCase: TMVCNameCase = ncAsIs
+      const ANameCase: TMVCNameCase = ncAsIs;
+      const ASerializationAction: TMVCSerializationAction = nil
      ): string;

    procedure DeserializeObject(
--- a/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
+++ b/sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
@ -43,27 +43,15 @@ type
  protected
    // procedure Serialize(const AElementValue: TValue; var ASerializerObject: TObject;
    // const AAttributes: TArray<TCustomAttribute>);
-    procedure SerializeAttribute(
-      const AElementValue: TValue;
-      const APropertyName: string;
-      const ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
-    procedure SerializeRoot(
-      const AObject: TObject;
-      out ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
+    procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
+      const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
+    procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
+      const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);

-    procedure DeserializeAttribute(
-      var AElementValue: TValue;
-      const APropertyName: string;
-      const ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
+    procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
+      const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);

-    procedure DeserializeRoot(
-      const ASerializerObject: TObject; const AObject: TObject;
+    procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
      const AAttributes: TArray<TCustomAttribute>);

  public
@ -72,29 +60,15 @@ type

  TMVCStringDictionarySerializer = class(TInterfacedObject, IMVCTypeSerializer)
  public
-    procedure SerializeAttribute(
-      const AElementValue: TValue;
-      const APropertyName: string;
-      const ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
-    procedure SerializeRoot(
-      const AObject: TObject;
-      out ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
-    procedure DeserializeAttribute(
-      var AElementValue: TValue;
-      const APropertyName: string;
-      const ASerializerObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
+    procedure SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
+      const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
+    procedure SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
+      const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
+    procedure DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
+      const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);

-    procedure DeserializeRoot(
-      const ASerializerObject: TObject;
-      const AObject: TObject;
-      const AAttributes: TArray<TCustomAttribute>
-      );
+    procedure DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
+      const AAttributes: TArray<TCustomAttribute>);
  end;

 implementation
@ -106,12 +80,8 @@ uses
  System.Generics.Collections,
  JsonDataObjects;

-procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute(
-  var AElementValue: TValue;
-  const APropertyName: string;
-  const ASerializerObject: TObject;
-  const AAttributes: TArray<TCustomAttribute>
-  );
+procedure TMVCStreamSerializerJsonDataObject.DeserializeAttribute(var AElementValue: TValue;
+  const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
 var
  lStream: TStream;
  SS: TStringStream;
@ -142,8 +112,7 @@ begin
  end;
 end;

-procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot(
-  const ASerializerObject: TObject; const AObject: TObject;
+procedure TMVCStreamSerializerJsonDataObject.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
  const AAttributes: TArray<TCustomAttribute>);
 var
  lValue: TValue;
@ -152,10 +121,8 @@ begin
  DeserializeAttribute(lValue, 'data', ASerializerObject, AAttributes);
 end;

-procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute(
-  const AElementValue: TValue; const APropertyName: string;
-  const ASerializerObject: TObject;
-  const AAttributes: TArray<TCustomAttribute>);
+procedure TMVCStreamSerializerJsonDataObject.SerializeAttribute(const AElementValue: TValue;
+  const APropertyName: string; const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
 var
  Stream: TStream;
  SS: TStringStream;
@ -185,8 +152,8 @@ begin
  end;
 end;

-procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject;
-  out ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
+procedure TMVCStreamSerializerJsonDataObject.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
+  const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
 var
  lSerializerObject: TJsonObject;
 begin
@ -201,12 +168,8 @@ end;

 { TMVCStringDictionarySerializer }

-procedure TMVCStringDictionarySerializer.DeserializeAttribute(
-  var AElementValue: TValue;
-  const APropertyName: string;
-  const ASerializerObject: TObject;
-  const AAttributes: TArray<TCustomAttribute>
-  );
+procedure TMVCStringDictionarySerializer.DeserializeAttribute(var AElementValue: TValue; const APropertyName: string;
+  const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
 var
  lStringDict: TMVCStringDictionary;
  lJSON: TJDOJsonObject;
@ -216,15 +179,12 @@ begin
  lJSON := ASerializerObject as TJDOJsonObject;
  for i := 0 to lJSON.O[APropertyName].Count - 1 do
  begin
-    lStringDict.AddProperty(lJSON.Names[i], lJSON.S[lJSON.Names[i]])
+    lStringDict.Add(lJSON.Names[i], lJSON.S[lJSON.Names[i]])
  end;
 end;

-procedure TMVCStringDictionarySerializer.DeserializeRoot(
-  const ASerializerObject: TObject;
-  const AObject: TObject;
-  const AAttributes: TArray<TCustomAttribute>
-  );
+procedure TMVCStringDictionarySerializer.DeserializeRoot(const ASerializerObject: TObject; const AObject: TObject;
+  const AAttributes: TArray<TCustomAttribute>);
 var
  lStringDict: TMVCStringDictionary;
  lJSON: TJDOJsonObject;
@ -234,14 +194,12 @@ begin
  lJSON := ASerializerObject as TJDOJsonObject;
  for i := 0 to lJSON.Count - 1 do
  begin
-    lStringDict.AddProperty(lJSON.Names[i], lJSON.S[lJSON.Names[i]])
+    lStringDict.Add(lJSON.Names[i], lJSON.S[lJSON.Names[i]])
  end;
 end;

-procedure TMVCStringDictionarySerializer.SerializeAttribute(
-  const AElementValue: TValue; const APropertyName: string;
-  const ASerializerObject: TObject;
-  const AAttributes: TArray<TCustomAttribute>);
+procedure TMVCStringDictionarySerializer.SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
+  const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
 var
  lStringDict: TMVCStringDictionary;
  lPair: TPair<string, string>;
@ -261,8 +219,8 @@ begin
  end;
 end;

-procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject;
-  out ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
+procedure TMVCStringDictionarySerializer.SerializeRoot(const AObject: TObject; out ASerializerObject: TObject;
+  const AAttributes: TArray<TCustomAttribute>; const ASerializationAction: TMVCSerializationAction = nil);
 var
  lStringDict: TMVCStringDictionary;
  lPair: TPair<string, string>;
--- a/sources/MVCFramework.Serializer.JsonDataObjects.pas
+++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas
@ -44,15 +44,22 @@ uses
  MVCFramework.Serializer.Commons,
  MVCFramework.DuckTyping,
  System.JSON,
-  JsonDataObjects;
+  JsonDataObjects, MVCFramework.Commons;

 type
  TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
+  private
+    fStringDictionarySerializer: IMVCTypeSerializer;
  public
    procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject;
      const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
+    procedure InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject;
+      const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
+      const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary;
+      const Serializer: IMVCTypeSerializer);
    procedure ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray;
-      const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
+      const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
+      const ASerializationAction: TMVCSerializationAction = nil);
    procedure AttributeToJsonDataValue(const AJsonObject: TJDOJsonObject; const AName: string; const AValue: TValue;
      const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
      const ACustomAttributes: TArray<TCustomAttribute>);
@ -80,13 +87,14 @@ type
      const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject;

    function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault;
-      const AIgnoredAttributes: TMVCIgnoredList = []): string;
+      const AIgnoredAttributes: TMVCIgnoredList = [];
+      const ASerializationAction: TMVCSerializationAction = nil): string;

    function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
-      const ANameCase: TMVCNameCase = ncAsIs): string;
+      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCSerializationAction = nil): string;

    function SerializeDataSetRecord(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = [];
-      const ANameCase: TMVCNameCase = ncAsIs): string;
+      const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCSerializationAction = nil): string;

    procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []);
@ -115,7 +123,6 @@ implementation

 uses
  MVCFramework.Serializer.JsonDataObjects.CustomTypes,
-  MVCFramework.Commons,
  MVCFramework.Logger,
  System.SysUtils;

@ -131,6 +138,7 @@ begin
  GetTypeSerializers.Add(TypeInfo(TStringStream), lStreamSerializer);
  GetTypeSerializers.Add(TypeInfo(TFileStream), lStreamSerializer);
  GetTypeSerializers.Add(TypeInfo(TMemoryStream), lStreamSerializer);
+  fStringDictionarySerializer := TMVCStringDictionarySerializer.Create;
  GetTypeSerializers.Add(TypeInfo(TMVCStringDictionary), TMVCStringDictionarySerializer.Create);
 end;

@ -228,8 +236,12 @@ begin
            begin
              ChildJsonArray := AJsonObject.A[AName];
              for Obj in ChildList do
+              begin
                if Assigned(Obj) then
+                begin
                  ObjectToJsonObject(Obj, ChildJsonArray.AddObject, GetSerializationType(Obj, AType), AIgnored);
+                end;
+              end;
            end
            else
            begin
@ -810,20 +822,47 @@ begin
 end;

 procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray;
-  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
+  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
+  const ASerializationAction: TMVCSerializationAction);
 var
  I: Integer;
+  lDict: TMVCStringDictionary;
+  lSer: IMVCTypeSerializer;
 begin
  if not Assigned(AList) then
    raise EMVCSerializationException.Create('List not assigned');
+  if Assigned(ASerializationAction) then
+  begin
+    lDict := TMVCStringDictionary.Create;
+    try
      for I := 0 to Pred(AList.Count) do
      begin
-    ObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes);
+        InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes,
+          ASerializationAction, lDict, lSer);
+      end;
+    finally
+      lDict.Free;
+    end;
+  end
+  else
+  begin
+    for I := 0 to Pred(AList.Count) do
+    begin
+      InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, nil, nil, nil);
+    end;
  end;
 end;

 procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject;
  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
+begin
+  InternalObjectToJsonObject(AObject, AJsonObject, AType, AIgnoredAttributes, nil, nil, nil);
+end;
+
+procedure TMVCJsonDataObjectsSerializer.InternalObjectToJsonObject(const AObject: TObject;
+  const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
+  const ASerializationAction: TMVCSerializationAction; const Dict: TMVCStringDictionary;
+  const Serializer: IMVCTypeSerializer);
 var
  ObjType: TRttiType;
  Prop: TRttiProperty;
@ -857,6 +896,13 @@ begin
              AType, AIgnoredAttributes, Fld.GetAttributes);
      end;
  end;
+
+  if Assigned(ASerializationAction) then
+  begin
+    Dict.Clear;
+    ASerializationAction(AObject, Dict);
+    Serializer.SerializeAttribute(Dict, '_links', AJsonObject, []);
+  end;
 end;

 class function TMVCJsonDataObjectsSerializer.Parse<T>(const AString: string): T;
@ -877,11 +923,13 @@ begin
 end;

 function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType;
-  const AIgnoredAttributes: TMVCIgnoredList): string;
+  const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string;
 var
  JsonArray: TJDOJsonArray;
  ObjList: IMVCList;
  Obj: TObject;
+  lLinks: TMVCStringDictionary;
+  lSer: IMVCTypeSerializer;
 begin
  Result := EmptyStr;

@ -895,10 +943,29 @@ begin
  if Assigned(ObjList) then
  begin
    JsonArray := TJDOJsonArray.Create;
+    try
+      if Assigned(ASerializationAction) then
+      begin
+        if not GetTypeSerializers.TryGetValue(TypeInfo(TMVCStringDictionary), lSer) then
+        begin
+          raise EMVCSerializationException.Create
+            ('Cannot serialize _links without TMVCStringDictionary custom serializer');
+        end;
+
+        lLinks := TMVCStringDictionary.Create;
        try
          for Obj in ObjList do
          begin
-        if Assigned(Obj) then
+            InternalObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes,
+              ASerializationAction, lLinks, lSer);
+          end;
+        finally
+          lLinks.Free;
+        end;
+      end
+      else
+      begin
+        for Obj in ObjList do
        begin
          ObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes);
        end;
@ -911,7 +978,7 @@ begin
 end;

 function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList;
-  const ANameCase: TMVCNameCase): string;
+  const ANameCase: TMVCNameCase; const ASerializationAction: TMVCSerializationAction): string;
 var
  JsonArray: TJDOJsonArray;
  BookMark: TBookmark;
@ -942,7 +1009,8 @@ begin
 end;

 function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const ADataSet: TDataSet;
-  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase): string;
+  const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase;
+  const ASerializationAction: TMVCSerializationAction): string;
 var
  JsonObject: TJDOJsonObject;
 begin
@ -965,6 +1033,7 @@ function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; c
 var
  JsonObject: TJDOJsonObject;
  ObjType: TRttiType;
+  lDict: TMVCStringDictionary;
 begin
  Result := EmptyStr;

@ -995,7 +1064,21 @@ begin

  JsonObject := TJDOJsonObject.Create;
  try
-    ObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
+    if Assigned(ASerializationAction) then
+    begin
+      lDict := TMVCStringDictionary.Create;
+      try
+        InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes,
+          ASerializationAction, lDict, fStringDictionarySerializer);
+      finally
+        lDict.Free;
+      end;
+    end
+    else
+    begin
+      InternalObjectToJsonObject(AObject, JsonObject, GetSerializationType(AObject, AType), AIgnoredAttributes, nil,
+        nil, nil);
+    end;
    Result := JsonObject.ToJSON(True);
  finally
    JsonObject.Free;
--- a/sources/MVCFramework.pas
+++ b/sources/MVCFramework.pas
@ -456,10 +456,12 @@ type
    procedure Render(const AObject: TObject); overload;
    procedure Render(const AObject: TObject; const AOwns: Boolean); overload;
    procedure Render(const AObject: TObject; const AOwns: Boolean; const AType: TMVCSerializationType); overload;
-    procedure Render<T: class>(const ACollection: TObjectList<T>); overload;
-    procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean); overload;
+    procedure Render<T: class>(const ACollection: TObjectList<T>;
+      const ASerializationAction: TMVCSerializationAction<T> = nil); overload;
    procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
-      const AType: TMVCSerializationType); overload;
+      const ASerializationAction: TMVCSerializationAction<T> = nil); overload;
+    procedure Render<T: class>(const ACollection: TObjectList<T>; const AOwns: Boolean;
+      const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction<T> = nil); overload;
    procedure Render(const ACollection: IMVCList); overload;
    procedure Render(const ACollection: IMVCList; const AType: TMVCSerializationType); overload;
    procedure Render(const ADataSet: TDataSet); overload;
@ -1609,6 +1611,7 @@ begin
  Config[TMVCConfigKey.IndexDocument] := 'index.html';
  Config[TMVCConfigKey.MaxEntitiesRecordCount] := '20';
  Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
+  Config[TMVCConfigKey.HATEOSPropertyName] := '_links';

  FMediaTypes.Add('.html', TMVCMediaType.TEXT_HTML);
  FMediaTypes.Add('.htm', TMVCMediaType.TEXT_HTML);
@ -2602,9 +2605,10 @@ begin
  end;
 end;

-procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean);
+procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
+const ASerializationAction: TMVCSerializationAction<T>);
 begin
-  Self.Render<T>(ACollection, AOwns, stDefault);
+  Self.Render<T>(ACollection, AOwns, stDefault, ASerializationAction);
 end;

 procedure TMVCRenderer.ResponseStatus(const AStatusCode: Integer; const AReasonString: string);
@ -2752,12 +2756,25 @@ begin
 end;

 procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>; const AOwns: Boolean;
-const AType: TMVCSerializationType);
+const AType: TMVCSerializationType; const ASerializationAction: TMVCSerializationAction<T>);
+var
+  lSerializationAction: TMVCSerializationAction;
 begin
  if Assigned(ACollection) then
  begin
    try
-      Render(Serializer(GetContentType).SerializeCollection(ACollection, AType));
+      if Assigned(ASerializationAction) then
+      begin
+        lSerializationAction := procedure(const AObject: TObject; const Dict: TMVCStringDictionary)
+          begin
+            ASerializationAction(T(AObject), Dict);
+          end;
+      end
+      else
+      begin
+        lSerializationAction := nil;
+      end;
+      Render(Serializer(GetContentType).SerializeCollection(ACollection, AType, [], lSerializationAction));
    finally
      if AOwns then
        ACollection.Free;
@ -2791,9 +2808,10 @@ begin
  end;
 end;

-procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>);
+procedure TMVCRenderer.Render<T>(const ACollection: TObjectList<T>;
+const ASerializationAction: TMVCSerializationAction<T>);
 begin
-  Self.Render<T>(ACollection, True);
+  Self.Render<T>(ACollection, True, ASerializationAction);
 end;

 procedure TMVCRenderer.RenderResponseStream;
--- a/unittests/general/Several/DMVCFrameworkTests.dpr
+++ b/unittests/general/Several/DMVCFrameworkTests.dpr
@ -22,8 +22,7 @@ uses
  BOs in 'BOs.pas',
  TestServerControllerU in '..\TestServer\TestServerControllerU.pas',
  RESTAdapterTestsU in 'RESTAdapterTestsU.pas',
-  MVCFramework.Tests.WebModule2
-    in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule} ,
+  MVCFramework.Tests.WebModule2 in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule},
  MVCFramework.Tests.StandaloneServer in '..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas',
  MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule},
  MVCFramework.Tests.RESTClient in '..\RESTClient\MVCFramework.Tests.RESTClient.pas',
@ -35,7 +34,8 @@ uses
  JSONRPCTestsU in 'JSONRPCTestsU.pas',
  MVCFramework.JSONRPC in '..\..\..\sources\MVCFramework.JSONRPC.pas',
  RandomUtilsU in '..\..\..\samples\commons\RandomUtilsU.pas',
-  MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas';
+  MVCFramework.Serializer.JsonDataObjects in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas',
+  JsonDataObjects in '..\..\..\sources\JsonDataObjects.pas';

 {$R *.RES}
 {$IFDEF CONSOLE_TESTRUNNER}
--- a/unittests/general/Several/DMVCFrameworkTests.dproj
+++ b/unittests/general/Several/DMVCFrameworkTests.dproj
@ -144,7 +144,6 @@
        <DCC_Define>_CONSOLE_TESTRUNNER;GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Cfg_3_Win32)'!=''">
-        <DCC_Define>GUI_TESTRUNNER;$(DCC_Define)</DCC_Define>
        <VerInfo_Locale>1033</VerInfo_Locale>
        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
    </PropertyGroup>
@ -188,9 +187,10 @@
        <DCCReference Include="..\..\..\sources\MVCFramework.JSONRPC.pas"/>
        <DCCReference Include="..\..\..\samples\commons\RandomUtilsU.pas"/>
        <DCCReference Include="..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.pas"/>
-        <BuildConfiguration Include="CI">
-            <Key>Cfg_5</Key>
-            <CfgParent>Cfg_4</CfgParent>
+        <DCCReference Include="..\..\..\sources\JsonDataObjects.pas"/>
+        <BuildConfiguration Include="Release">
+            <Key>Cfg_2</Key>
+            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
@ -199,9 +199,9 @@
            <Key>Cfg_4</Key>
            <CfgParent>Cfg_1</CfgParent>
        </BuildConfiguration>
-        <BuildConfiguration Include="Release">
-            <Key>Cfg_2</Key>
-            <CfgParent>Base</CfgParent>
+        <BuildConfiguration Include="CI">
+            <Key>Cfg_5</Key>
+            <CfgParent>Cfg_4</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Debug">
            <Key>Cfg_1</Key>
@ -294,12 +294,24 @@
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
+                <DeployFile LocalName="Win32\GUI\DMVCFrameworkTests.exe" Configuration="GUI" Class="ProjectOutput">
+                    <Platform Name="Win32">
+                        <RemoteName>DMVCFrameworkTests.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
                <DeployFile LocalName="Win32\Debug\DMVCFrameworkTests.rsm" Configuration="Debug" Class="DebugSymbols">
                    <Platform Name="Win32">
                        <RemoteName>DMVCFrameworkTests.rsm</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
+                <DeployFile LocalName="Win32\GUI\DMVCFrameworkTests.rsm" Configuration="GUI" Class="DebugSymbols">
+                    <Platform Name="Win32">
+                        <RemoteName>DMVCFrameworkTests.rsm</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
                <DeployClass Name="AdditionalDebugSymbols">
                    <Platform Name="OSX32">
                        <Operation>1</Operation>
--- a/unittests/general/Several/LiveServerTestU.pas
+++ b/unittests/general/Several/LiveServerTestU.pas
@ -106,6 +106,8 @@ type
    [Test]
    procedure TestRenderWrappedList;
    [Test]
+    procedure TestRenderActionInCollections;
+    [Test]
    procedure TestRenderWrappedListWithCompression;
    [Test]
    procedure TestRenderStreamAndFreeWithOwnerFalse;
@ -685,6 +687,26 @@ begin
  }
 end;

+procedure TServerTest.TestRenderActionInCollections;
+var
+  lRes: IRESTResponse;
+  lJArr: TJDOJsonArray;
+  I: Integer;
+begin
+  lRes := RESTClient.doGET('/people/renderaction', []);
+  lJArr := TJsonBaseObject.Parse(lRes.BodyAsString) as TJDOJsonArray;
+  try
+    for I := 0 to lJArr.Count - 1 do
+    begin
+      Assert.isFalse(lJArr[I].O['_links'].IsNull, '_links doesn''t exists');
+      Assert.isFalse(lJArr[I].O['_links']['x-ref-lastname'].IsNull, '_links.x-ref-lastname doesn''t exists');
+      Assert.isFalse(lJArr[I].O['_links']['x-ref-firstname'].IsNull, '_links.x-ref-firstname doesn''t exists');
+    end;
+  finally
+    lJArr.Free;
+  end;
+end;
+
 procedure TServerTest.TestRenderStreamAndFreeWithOwnerFalse;
 var
  lRes: IRESTResponse;
@ -726,7 +748,7 @@ end;
 procedure TServerTest.TestRenderWrappedListWithCompression;
 var
  lRes: IRESTResponse;
-  lJSONArr: TJDOJSONArray;
+  lJSONArr: TJDOJsonArray;
  I: Integer;
  lCompType: string;
  j: Integer;
@ -1377,7 +1399,7 @@ procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_A;
 var
  lReq: IJSONRPCRequest;
  lRPCResp: IJSONRPCResponse;
-  lArr: TJDOJSONArray;
+  lArr: TJDOJsonArray;
  I: Integer;
  x: Integer;
 begin
@ -1388,7 +1410,7 @@ begin
  lReq.RequestID := 1234;

  lRPCResp := FExecutor.ExecuteRequest(lReq);
-  lArr := TJDOJSONArray(lRPCResp.Result.AsObject);
+  lArr := TJDOJsonArray(lRPCResp.Result.AsObject);
  x := 1;
  for I := 0 to lArr.Count - 1 do
  begin
@ -1397,7 +1419,7 @@ begin
  end;

  lRPCResp := FExecutor2.ExecuteRequest(lReq);
-  lArr := TJDOJSONArray(lRPCResp.Result.AsObject);
+  lArr := TJDOJsonArray(lRPCResp.Result.AsObject);
  x := 1;
  for I := 0 to lArr.Count - 1 do
  begin
--- a/unittests/general/TestServer/TestServerControllerU.pas
+++ b/unittests/general/TestServer/TestServerControllerU.pas
@ -103,6 +103,10 @@ type
    [MVCProduces('application/json', 'utf-8')]
    procedure TestConsumeJSON;

+    [MVCPath('/people/renderaction')]
+    [MVCHTTPMethod([httpGET])]
+    procedure TestGetPersonsHateos;
+
    [MVCPath('/people/($id)')]
    [MVCHTTPMethod([httpGET])]
    procedure TestGetPersonByID;
@ -434,6 +438,16 @@ begin

 end;

+procedure TTestServerController.TestGetPersonsHateos;
+begin
+  Render<TPerson>(TPerson.GetList, True,
+    procedure(const Person: TPerson; const Links: TMVCStringDictionary)
+    begin
+      Links['x-ref-firstname'] := '/api/people/' + Person.FirstName;
+      Links['x-ref-lastname'] := '/api/people/' + Person.LastName;
+    end);
+end;
+
 procedure TTestServerController.TestGetWrappedPeople;
 var
  LWrappedList: IWrappedList;