Improved support for HATEOAS in renders

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

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 @@   TUserRolesSerializer = class(TInterfacedObject, IMVCTypeSerializer)
     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 @@   TNullableAliasSerializer = class(TInterfacedObject, IMVCTypeSerializer)
     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 @@ procedure TNullableAliasSerializer.SerializeAttribute(const AElementValue: TValu
 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;

samples/renders/RenderSampleControllerU.pas

@@ -66,6 +66,11 @@   TRenderSampleController = class(TMVCController)
     [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 @@ procedure TRenderSampleController.GetDataSetWithMetadata;
   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 @@ procedure TRenderSampleController.GetPeople_AsObjectList;
   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;

sources/MVCFramework.Commons.pas

@@ -133,6 +133,7 @@   TMVCConfigKey = record
     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 @@   TMVCStringDictionary = class
     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 @@ procedure TMVCConfig.SaveToFile(const AFileName: string);
 
 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 @@ function TMVCConfig.ToString: string;
 
 { TMVCStringDictionary }
 
-function TMVCStringDictionary.AddProperty(const Name, Value: string): TMVCStringDictionary;
+function TMVCStringDictionary.Add(const Name, Value: string): TMVCStringDictionary;
 begin
   FDict.AddOrSetValue(name, Value);
   Result := Self;

sources/MVCFramework.Serializer.Commons.pas

@@ -59,7 +59,8 @@ interface
 
   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,19 +174,22 @@   TMVCSerializerHelper = record
     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 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 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;
 
     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 @@   TMVCSerializerHelper = record
     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 @@ function ISOTimeStampToDateTime(const ADateTime: string): TDateTime;
 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 @@ function ISOTimeToTime(const ATime: string): TTime;
 
 { 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 @@ class procedure TMVCSerializerHelper.DeSerializeBase64StringStream(
   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 @@ class function TMVCSerializerHelper.GetKeyName(const AField: TRttiField; const A
     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 @@ class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray
   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 @@ class function TMVCSerializerHelper.CreateObject(const AQualifiedClassName: stri
     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 @@ class procedure TMVCSerializerHelper.DecodeStream(AInput, AOutput: TStream);
   Soap.EncdDecd.DecodeStream(AInput, AOutput);
 
 {$ENDIF}
-
 end;
 
 class function TMVCSerializerHelper.DecodeString(const AInput: string): string;
@@ -413,7 +421,6 @@ class function TMVCSerializerHelper.DecodeString(const AInput: string): string;
   Result := Soap.EncdDecd.DecodeString(AInput);
 
 {$ENDIF}
-
 end;
 
 class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream);
@@ -426,7 +433,6 @@ class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream);
   Soap.EncdDecd.EncodeStream(AInput, AOutput);
 
 {$ENDIF}
-
 end;
 
 class function TMVCSerializerHelper.EncodeString(const AInput: string): string;
@@ -439,7 +445,6 @@ class function TMVCSerializerHelper.EncodeString(const AInput: string): string;
   Result := Soap.EncdDecd.EncodeString(AInput);
 
 {$ENDIF}
-
 end;
 
 class function TMVCSerializerHelper.GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string;
@@ -507,8 +512,7 @@ class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiNamedObj
     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;

sources/MVCFramework.Serializer.Intf.pas

@@ -49,7 +49,8 @@ interface
     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 @@ interface
     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(