unit XData.Payload.Json.Writer;

interface

uses
  Generics.Collections, System.Rtti, Sparkle.Json.Writer, System.Classes,
  Bcl.Json.BaseObjectConverter,
  Bcl.Json.Converters,
  XData.Aurelius.Model,
  XData.Json.Serializer,
  XData.Json.Solver,
  XData.Model.Classes,
  XData.Payload.Writer,
  XData.Sys.Exceptions;

type
  TXDataJsonPayloadWriter = class(TXDataPayloadWriter)
  strict protected
    function XModel: TXDataAureliusModel;
  end;

  TJsonEntityWriter = class(TXDataJsonPayloadWriter, IEntityWriter)
  strict private
    FWriter: TJsonWriter;
    FSerializer: TXDataJsonServerSerializer;
  protected
    procedure WriteEntityTypeInVJson(const AObject: TObject; BaseClass: TClass);
    property Writer: TJsonWriter read FWriter;
    property Serializer: TXDataJsonServerSerializer read FSerializer;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure WriteEntity(const AObject: TObject; BaseClass: TClass);
    function ContentType: string; override;
    procedure SetExpandLevel(const Value: integer);
    procedure SetExpander(Value: IJsonExpander);
    procedure SetSerializeInstanceRef(Value: TInstanceRefSerialization);
    procedure SetSerializeInstanceType(Value: TInstanceTypeSerialization);
    procedure Flush; override;
  end;

  TJsonEntityCollectionWriter = class(TXDataJsonPayloadWriter, IEntityCollectionWriter)
  strict private
    FEntityWriter: TJsonEntityWriter;
    FStarted: boolean;
    FBaseClass: TClass;
    FUseInlineCount: Boolean;
    FInlineCount: Integer;
    function Writer: TJsonWriter;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure Start(ABaseClass: TClass);
    procedure SerializeItem(const AObject: TObject);
    procedure Finish;
    procedure Flush; override;
    function ContentType: string; override;
    procedure SetExpandLevel(const Value: integer);
    procedure SetExpander(Value: IJsonExpander);
    procedure SetSerializeInstanceRef(Value: TInstanceRefSerialization);
    procedure SetSerializeInstanceType(Value: TInstanceTypeSerialization);
    procedure SetInlineCount(const Value: Integer);
  end;

  TJsonPropertyWriter = class(TXDataJsonPayloadWriter, IPropertyWriter)
  strict private
    FEntityWriter: TJsonEntityWriter;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure WriteProperty(const AObject: TObject; const AProp: TXDataSimpleProperty);
    function ContentType: string; override;
    procedure Flush; override;
  end;

  TJsonServiceDocumentWriter = class(TXDataJsonPayloadWriter, IServiceDocumentWriter)
  public
    procedure WriteDocument;
    function ContentType: string; override;
    procedure Flush; override;
  end;

  TJsonErrorWriter = class(TXDataJsonPayloadWriter, IErrorWriter)
  public
    procedure WriteError(const ErrorCode, ErrorMessage: string);
    function ContentType: string; override;
    procedure Flush; override;
  end;

  TJsonResultWriter = class(TXDataJsonPayloadWriter, IResultWriter)
  strict private
    FJWriter: TJsonWriter;
    FSerializer: TXDataJsonServerSerializer;
    property JWriter: TJsonWriter read FJWriter;
    property Serializer: TXDataJsonServerSerializer read FSerializer;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure WriteResult(const ResultValue: TValue; const Args: TArray<TValue>;
      Action: TXDataAction);
    function ContentType: string; override;
    procedure Flush; override;
    procedure SetExpandLevel(const Value: integer);
    procedure SetExpander(Value: IJsonExpander);
    procedure SetSerializeInstanceRef(Value: TInstanceRefSerialization);
    procedure SetSerializeInstanceType(Value: TInstanceTypeSerialization);
    function WrittenObjects: TEnumerable<TObject>;
  end;

implementation

uses
  Aurelius.Mapping.Explorer,
  Sparkle.Utils,
  XData.Consts,
  XData.Service.Internal;

{ TXDataJsonPayloadWriter }

function TXDataJsonPayloadWriter.XModel: TXDataAureliusModel;
begin
  Result := TXDataAureliusModel(Model);
end;

{ TJsonEntitySetWriter }

procedure TJsonEntityCollectionWriter.AfterConstruction;
begin
  inherited;
  FEntityWriter := TJsonEntityWriter.Create(Stream, Model, BaseUrl);
end;

function TJsonEntityCollectionWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonEntityCollectionWriter.Destroy;
begin
  FEntityWriter.Free;
  inherited;
end;

procedure TJsonEntityCollectionWriter.Finish;
begin
  if not FStarted then Exit;
  FStarted := false;
  Writer.WriteEndArray;
  Writer.WriteEndObject;
  Writer.Close;
end;

procedure TJsonEntityCollectionWriter.Flush;
begin
  Writer.Flush;
end;

procedure TJsonEntityCollectionWriter.SerializeItem(const AObject: TObject);
begin
  FEntityWriter.WriteEntityTypeInVJson(AObject, FBaseClass);
end;

procedure TJsonEntityCollectionWriter.SetExpandLevel(const Value: integer);
begin
  FEntityWriter.Serializer.SetExpandLevel(Value);
end;

procedure TJsonEntityCollectionWriter.SetInlineCount(const Value: Integer);
begin
  FUseInlineCount := True;
  FInlineCount := Value;
end;

procedure TJsonEntityCollectionWriter.SetSerializeInstanceRef(
  Value: TInstanceRefSerialization);
begin
  FEntityWriter.Serializer.SetSerializeInstanceRef(Value);
end;

procedure TJsonEntityCollectionWriter.SetSerializeInstanceType(
  Value: TInstanceTypeSerialization);
begin
  FEntityWriter.Serializer.SetSerializeInstanceType(Value);
end;

procedure TJsonEntityCollectionWriter.SetExpander(Value: IJsonExpander);
begin
  FEntityWriter.Serializer.SetExpander(Value);
end;

procedure TJsonEntityCollectionWriter.Start(ABaseClass: TClass);
begin
  Assert(Model is TXDataAureliusModel);
  if FStarted then Exit;
  FStarted := true;
  FBaseClass := ABaseClass;
  Writer.WriteBeginObject;
  if FUseInlineCount then
  begin
    Writer.WriteName(JsonCollectionInlineCount);
    Writer.WriteInteger(FInlineCount);
  end;
  Writer.WriteName(JsonCollectionValue);
  Writer.WriteBeginArray;
end;

function TJsonEntityCollectionWriter.Writer: TJsonWriter;
begin
  Result := FEntityWriter.Writer;
end;

{ TJsonEntityWriter }

procedure TJsonEntityWriter.AfterConstruction;
begin
  inherited;
  FWriter := TJsonWriter.Create(Self.Stream);
  FWriter.IndentLength := JsonDefaultIndent;
  FSerializer := TXDataJsonServerSerializer.Create(XModel);
end;

function TJsonEntityWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonEntityWriter.Destroy;
begin
  FSerializer.Free;
  FWriter.Free;
  inherited;
end;

procedure TJsonEntityWriter.Flush;
begin
  Writer.Flush;
end;

procedure TJsonEntityWriter.SetExpandLevel(const Value: integer);
begin
  FSerializer.SetExpandLevel(Value);
end;

procedure TJsonEntityWriter.SetSerializeInstanceRef(
  Value: TInstanceRefSerialization);
begin
  FSerializer.SetSerializeInstanceRef(Value);
end;

procedure TJsonEntityWriter.SetSerializeInstanceType(
  Value: TInstanceTypeSerialization);
begin
  FSerializer.SetSerializeInstanceType(Value);
end;

procedure TJsonEntityWriter.SetExpander(Value: IJsonExpander);
begin
  FSerializer.SetExpander(Value);
end;

procedure TJsonEntityWriter.WriteEntity(const AObject: TObject; BaseClass: TClass);
begin
  Assert(Model is TXDataAureliusModel);
  WriteEntityTypeInVJson(AObject, BaseClass);
  FWriter.Close;
end;

procedure TJsonEntityWriter.WriteEntityTypeInVJson(const AObject: TObject; BaseClass: TClass);
begin
  Serializer.Write(AObject, BaseClass, Writer);
end;

{ TJsonPropertyWriter }

procedure TJsonPropertyWriter.AfterConstruction;
begin
  inherited;
  FEntityWriter := TJsonEntityWriter.Create(Stream, Model, BaseUrl);
end;

function TJsonPropertyWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonPropertyWriter.Destroy;
begin
  FEntityWriter.Free;
  inherited;
end;

procedure TJsonPropertyWriter.Flush;
begin
  FEntityWriter.Flush;
end;

procedure TJsonPropertyWriter.WriteProperty(const AObject: TObject;
  const AProp: TXDataSimpleProperty);
var
  Value: TValue;
  Info: TXDataAureliusPropInfo;
begin
  FEntityWriter.Writer
    .WriteBeginObject
    .WriteName(JsonPropertyValue);

  // TODO: Later move this code to the serializer (write a property value)
  // by using the model. Let's keep it duplicated here for now, since
  // it's working and it's not a very used feature
//  FEntityWriter.Serializer.WritePropertyValue(AObject, AProp);
  Info := XModel.GetPropertyInfo(AProp);
  Value := XModel.GetPropertyValue(AObject, AProp);

  FEntityWriter.Serializer.Write(Value, Info.RttiInfo.RealType.Handle, FEntityWriter.Writer);
  FEntityWriter.Writer.WriteEndObject;
end;

{ TJsonServiceDocumentWriter }

function TJsonServiceDocumentWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

procedure TJsonServiceDocumentWriter.Flush;
begin
end;

procedure TJsonServiceDocumentWriter.WriteDocument;
var
  W: TJsonWriter;
  Schema: TXDataSchema;
  Container: TXDataEntityContainer;
  EntitySet: TXDataEntitySet;
begin
  W := TJsonWriter.Create(Stream);
  try
    W.IndentLength := JsonDefaultIndent;
    W.WriteBeginObject;
    W.WriteName('value');
      W.WriteBeginArray;
      for Schema in Model.Schemas do
        for Container in Schema.EntityContainers do
          for EntitySet in Container.EntitySets do
          begin
            W.WriteBeginObject;
            W.WriteName('name');
            W.WriteString(EntitySet.Name);
            W.WriteName('url');
            W.WriteString(TSparkleUtils.PercentEncode(XModel.EntitySetUrl(EntitySet)));
            W.WriteEndObject;
          end;
      W.WriteEndArray;
    W.WriteEndObject;
  finally
    W.Free;
  end;
end;

{ TJsonErrorWriter }

function TJsonErrorWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

procedure TJsonErrorWriter.Flush;
begin
end;

procedure TJsonErrorWriter.WriteError(const ErrorCode, ErrorMessage: string);
var
  Writer: TJsonWriter;
begin
  Writer := TJsonWriter.Create(Stream);
  try
    Writer.IndentLength := JsonDefaultIndent;
    Writer.WriteBeginObject;
    Writer.WriteName('error');
    Writer.WriteBeginObject;
    Writer.WriteName('code');
    Writer.WriteString(ErrorCode);
    Writer.WriteName('message');
    Writer.WriteString(ErrorMessage);
    Writer.WriteEndObject;
    Writer.WriteEndObject;
    Writer.Close;
  finally
    Writer.Free;
  end;
end;

{ TJsonResultWriter }

procedure TJsonResultWriter.AfterConstruction;
begin
  inherited;
  FJWriter := TJsonWriter.Create(Stream);
  FSerializer := TXDataJsonServerSerializer.Create(XModel);
end;

function TJsonResultWriter.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonResultWriter.Destroy;
begin
  FSerializer.Free;
  FJWriter.Free;
  inherited;
end;

procedure TJsonResultWriter.Flush;
begin
  FJWriter.Flush;
end;

procedure TJsonResultWriter.SetExpandLevel(const Value: integer);
begin
  FSerializer.SetExpandLevel(Value);
end;

procedure TJsonResultWriter.SetSerializeInstanceRef(
  Value: TInstanceRefSerialization);
begin
  FSerializer.SetSerializeInstanceRef(Value);
end;

procedure TJsonResultWriter.SetSerializeInstanceType(
  Value: TInstanceTypeSerialization);
begin
  FSerializer.SetSerializeInstanceType(Value);
end;

procedure TJsonResultWriter.SetExpander(Value: IJsonExpander);
begin
  FSerializer.SetExpander(Value);
end;

procedure TJsonResultWriter.WriteResult(const ResultValue: TValue; const Args: TArray<TValue>;
  Action: TXDataAction);
var
  I: Integer;
  ParamDef: TXDataParamDef;
begin
  JWriter.IndentLength := JsonDefaultIndent;
  if Action.IsResultSingleObject and not
    XModel.Explorer.IsValueList(Action.ReturnType.AsInstance.MetaclassType) then
  begin
    // Special case: a single object being returned and it's not a list
    // then serialize the object directly
    // See XData.Client.OnInvoke if you change this
    Serializer.Write(
      ResultValue.AsObject,
      Action.ReturnType.AsInstance.MetaclassType,
      JWriter
    );
  end else
  begin
    JWriter.WriteBeginObject;

    // Write function result value
    if Action.ReturnType <> nil then
    begin
      // Here we do something for backward compatibility: if there are no output params,
      // then we should use the old JsonResultValue as the name of result param ("value").
      // If there are output params (more recent feature), then we use JsonResultParam
      // as the name of result param ("result").
      // We needed to change the name because when we have output parameters, one of the names
      // of the params might be "value". And we can be sure that "result" cannot be used as param name.
      // But we could not change the previous behavior otherwise we would break the server
      if Action.HasOutputParams then
        JWriter.WriteName(JsonResultParam) // "result"
      else
        JWriter.WriteName(JsonResultValue); // "value"
      Serializer.Write(ResultValue, Action.ReturnType.Handle, JWriter);
    end;

    // Write function output parameters (passed by reference)
    for I := 0 to Action.Parameters.Count - 1 do
    begin
      ParamDef := Action.Parameters[I];
      if ParamDef.Output then
      begin
        JWriter.WriteName(ParamDef.Name);
        Serializer.Write(Args[I], ParamDef.RttiType.Handle, JWriter);
      end;
    end;

    JWriter.WriteEndObject;
  end;
end;

function TJsonResultWriter.WrittenObjects: TEnumerable<TObject>;
begin
  Result := Serializer.WrittenObjects;
end;

end.
