unit XData.Aurelius.Model;

{$I XData.Inc}

interface

uses
  Generics.Collections, System.SysUtils, System.Rtti, System.TypInfo, System.Classes,
  Bcl.Json.Attributes,
  Aurelius.Mapping.Explorer,
  Aurelius.Mapping.Optimization,
  Aurelius.Types.Blob,
  XData.Model.Classes,
  XData.Service.Common,
  XData.Service.Internal,
  XData.Sys.Exceptions;

type
  TXDataAureliusPropInfo = class
  private
    FRttiInfo: TRttiOptimization;
  public
    destructor Destroy; override;
    property RttiInfo: TRttiOptimization read FRttiInfo write FRttiInfo;
  end;

  EXDataEntityTypeFromClassNotFound = class(EXDataException)
  public
    constructor Create(AClass: TClass);
  end;

  ECannotReadNonBlobProperty = class(EXDataException)
  public
    constructor Create(AProp: TXDataSimpleProperty);
  end;

  ECannotWriteNonBlobProperty = class(EXDataException)
  public
    constructor Create(AProp: TXDataSimpleProperty);
  end;

  EListNotAccessible = class(EXDataException)
  public
    constructor Create(ANavProp: TXDataNavigationProperty);
  end;

  EPropertyIsNotList = class(EXDataException)
  public
    constructor Create(ANavProp: TXDataNavigationProperty);
  end;

  TXDataAureliusModel = class;

  TXDataModelManager = class
  strict private
    FModels: TDictionary<string, TXDataAureliusModel>;
  public
    constructor Create;
    destructor Destroy; override;
    function Get(ModelName: string): TXDataAureliusModel;
    procedure Replace(ModelName: string; AModel: TXDataAureliusModel);
  end;

  TXDataAureliusModel = class(TXDataModel)
  strict private
    class var
      FModelManager: TXDataModelManager;
  strict private
    [JsonIgnore]
    FExplorer: TMappingExplorer;
    [JsonIgnore]
    FOwnsExplorer: boolean;
    function GetNavPropValue(Entity: TValue; Prop: TXDataNavigationProperty): TValue;
    function GetPropValue(Entity: TValue; Prop: TXDataSimpleProperty): TValue;
  protected
    class function ModelManager: TXDataModelManager;
  public
    // class functions to deal with global instances
    class function Get(const ModelName: string): TXDataAureliusModel; static;
    class procedure Replace(const ModelName: string; AModel: TXDataAureliusModel); static;
    class function Default: TXDataAureliusModel; static;
    class procedure ReplaceDefault(AModel: TXDataAureliusModel); static;
    class destructor Destroy;
  public
    // Todo: move to protected
    function GetPropertyInfo(const Prop: TXDataSimpleProperty): TXDataAureliusPropInfo;
    function GetNavPropInfo(const Prop: TXDataNavigationProperty): TRttiOptimization;
    function GetEntityTypeClass(const EntityType: TXDataEntityType): TClass;
    function FindControllerByInterface(IntfType: PTypeInfo): TXDataController;
  public
    function CanonicalUrl(const AObject: TObject): string; overload;
    function CanonicalUrl(AClass: TClass; Id: TValue): string; overload;
    function CanonicalUrl(const AObject: TObject; const APropName: string): TArray<string>; overload;

    procedure ParseCanonicalUrl(const RelativeUrl: string; var AClass: TClass; var IdValue: Variant);

    function KeyPredicateToId(const ALiteral: string; AType: TXDataEntityType): Variant;

    function GetPropertyValue(Entity: TObject; Prop: TXDataSimpleProperty): TValue;
    function GetNavigationPropertyValue(const AObject: TObject; const Prop: TXDataNavigationProperty;
      AForceProxyLoad: boolean): TObject;

    function GetNavigationPropertyAsList(const AObject: TObject; const Prop: TXDataNavigationProperty;
      AForceProxyLoad: boolean): IObjectList;
    function GetPropertyBlobValue(const AObject: TObject; const Prop: TXDataSimpleProperty): TBlob;

    procedure SetPropertyValue(const AObject: TObject; const Prop: TXDataSimpleProperty; const Value: TValue);
    procedure SetNavigationPropertyValue(const AObject: TObject; const Prop: TXDataNavigationProperty; const Value: TObject);
    procedure SetPropertyBlobValue(const AObject: TObject; const Prop: TXDataSimpleProperty; const BlobValue: TBlob);
  public
    constructor Create; overload;
    constructor Create(AExplorer: TMappingExplorer); overload;
    destructor Destroy; override;

    function FindEntityTypeByClass(AClass: TClass): TXDataEntityType;
    function GetEntityTypeByClass(AClass: TClass): TXDataEntityType;
    function GetCollectionType(AClass: TClass): TXDataEntityCollectionType;
    property Explorer: TMappingExplorer read FExplorer;
    property OwnsExplorer: boolean read FOwnsExplorer write FOwnsExplorer;
  end;

implementation

uses
  Variants, StrUtils,
  Bcl.Rtti.Utils,
  XData.Aurelius.ModelBuilder,
  XData.Utils;

{ Exceptions }

type
  EReferenceEntitySetNotFound = class(EXDataException)
  public
    constructor Create(const Ref, Name: string);
  end;

  EReferenceInvalidFormat = class(EXDataException)
  public
    constructor Create(const Ref: string);
  end;

{ EReferenceEntitySetNotFound }

constructor EReferenceEntitySetNotFound.Create(const Ref, Name: string);
begin
  inherited CreateFmt('Could not find entity set "%s" from reference "%s"', [Name, Ref]);
end;

{ EReferenceInvalidFormat }

constructor EReferenceInvalidFormat.Create(const Ref: string);
begin
  inherited CreateFmt('Invalid format for reference "%s"', [Ref]);
end;

{ EXDataEntityTypeFromClassNotFound }

constructor EXDataEntityTypeFromClassNotFound.Create(AClass: TClass);
begin
  inherited CreateFmt('Entity type not found for class "%s"', [AClass.ClassName]);
end;

{ ECannotReadNonBlobProperty }

constructor ECannotReadNonBlobProperty.Create(AProp: TXDataSimpleProperty);
begin
  inherited CreateFmt('Cannot retrieve blob value. Property %s is not a blob', [AProp.QualifiedName]);
end;

{ ECannotWriteNonBlobProperty }

constructor ECannotWriteNonBlobProperty.Create(AProp: TXDataSimpleProperty);
begin
  inherited CreateFmt('Cannot write blob value. Property %s is not a blob', [AProp.QualifiedName]);
end;

{ TXDataAureliusModel }

function TXDataAureliusModel.CanonicalUrl(const AObject: TObject): string;
begin
  Result := CanonicalUrlFromEntity(GetEntityTypeByClass(AObject.ClassType), AObject,
    GetPropValue, GetNavPropValue);
end;

function TXDataAureliusModel.CanonicalUrl(const AObject: TObject; const APropName: string): TArray<string>;
begin
  SetLength(Result, 2);
  Result[0] := CanonicalUrl(AObject);
  Result[1] := APropName;
end;

constructor TXDataAureliusModel.Create;
begin
  Create(TMappingExplorer.DefaultInstance);
end;

function TXDataAureliusModel.CanonicalUrl(AClass: TClass; Id: TValue): string;
begin
  Result := CanonicalUrlFromId(GetEntityTypeByClass(AClass), Id);
end;

constructor TXDataAureliusModel.Create(AExplorer: TMappingExplorer);
begin
  inherited Create;
  FExplorer := AExplorer;
end;

class function TXDataAureliusModel.Default: TXDataAureliusModel;
begin
  Result := ModelManager.Get(TMappingExplorer.DefaultModelName);
end;

class destructor TXDataAureliusModel.Destroy;
begin
  FModelManager.Free;
end;

destructor TXDataAureliusModel.Destroy;
begin
  if FOwnsExplorer then
    FExplorer.Free;
  inherited;
end;

function TXDataAureliusModel.GetNavPropInfo(
  const Prop: TXDataNavigationProperty): TRttiOptimization;
begin
  Result := Prop.Data.AsType<TRttiOptimization>;
  Assert(Result <> nil, 'Navprop info not assigned');
end;

function TXDataAureliusModel.GetNavPropValue(Entity: TValue;
  Prop: TXDataNavigationProperty): TValue;
begin
  Result := GetNavigationPropertyValue(Entity.AsObject, Prop, True);
end;

function TXDataAureliusModel.GetPropertyBlobValue(const AObject: TObject;
  const Prop: TXDataSimpleProperty): TBlob;
var
  Value: TValue;
begin
  Value := GetPropertyValue(AObject, Prop);
  if Value.IsType<TBlob> then
    Result := Value.AsType<TBlob>
  else
    raise ECannotReadNonBlobProperty.Create(Prop);
end;

function TXDataAureliusModel.GetNavigationPropertyAsList(const AObject: TObject;
  const Prop: TXDataNavigationProperty; AForceProxyLoad: boolean): IObjectList;
var
  ListObj: TObject;
begin
  ListObj := GetNavigationPropertyValue(AObject, Prop, AForceProxyLoad);
  if ListObj = nil then
    raise EListNotAccessible.Create(Prop);
  if not Explorer.IsObjectList(ListObj.ClassType) then
    raise EPropertyIsNotList.Create(Prop);
  Result := Explorer.AsObjectList(ListObj)
end;

function TXDataAureliusModel.GetNavigationPropertyValue(const AObject: TObject;
  const Prop: TXDataNavigationProperty; AForceProxyLoad: boolean): TObject;
var
  RttiInfo: TRttiOptimization;
begin
  RttiInfo := GetNavPropInfo(Prop);
  if AForceProxyLoad then
    Explorer.ForceProxyLoad(AObject, RttiInfo);
  Result := Explorer.GetMemberValue(AObject, RttiInfo).AsObject;
end;

function TXDataAureliusModel.GetPropertyInfo(
  const Prop: TXDataSimpleProperty): TXDataAureliusPropInfo;
begin
  Result := Prop.Data.AsType<TXDataAureliusPropInfo>;
  Assert(Result <> nil, 'Prop info not assigned');
end;

function TXDataAureliusModel.GetPropertyValue(Entity: TObject; Prop: TXDataSimpleProperty): TValue;
begin
  Result := GetPropValue(Entity, Prop);
end;

function TXDataAureliusModel.GetPropValue(Entity: TValue;
  Prop: TXDataSimpleProperty): TValue;
var
  Info: TXDataAureliusPropInfo;
begin
  Info := GetPropertyInfo(Prop);
  Result := Explorer.GetMemberValue(Entity.AsObject, Info.RttiInfo);
end;

class function TXDataAureliusModel.Get(const ModelName: string): TXDataAureliusModel;
begin
  Result := ModelManager.Get(ModelName);
end;

function TXDataAureliusModel.GetCollectionType(AClass: TClass): TXDataEntityCollectionType;
begin
  Result := GetEntityTypeByClass(TRttiUtils.GetInstance.GetSurroundedClass(AClass)).Collection;
end;

function TXDataAureliusModel.GetEntityTypeClass(
  const EntityType: TXDataEntityType): TClass;
begin
  if EntityType = nil then
    Exit(nil);
  Result := EntityType.Data.AsType<TClass>;
end;

function TXDataAureliusModel.KeyPredicateToId(const ALiteral: string; AType: TXDataEntityType): Variant;
var
  Info: TXDataAureliusPropInfo;
  KeyValue: TValue;
  P, J: integer;
  Name, Value, NameValue: string;
  KeyFound: boolean;
  Idx: integer;
  SimpleKey: TXDataSimpleProperty;
  KeyProps: TXDataSimplePropertyArray;
  KeyPropCount: Integer;
begin
  AType := FindRootType(AType);
  if AType.Key.Count = 0 then
    Exit(Null);

  if (AType.Key.Count = 1) and (AType.Key[0].IsSimple) then
  begin
    // single predicate
    SimpleKey := TXDataSimpleProperty(AType.Key[0]);
    Info := GetPropertyInfo(SimpleKey);
    KeyValue := SimpleKey.UrlConverter.UrlToValue(ALiteral, nil);
    Result := Explorer.ValueToVariant(KeyValue, Info.RttiInfo);
  end
  else
  begin
    // composite predicate
    KeyProps := GetKeyScalarProperties(AType);
    KeyPropCount := Length(KeyProps);
    Result := VarArrayCreate([0, KeyPropCount - 1], varVariant);

    // do a quick parse in the key predicate. Not critical code
    Idx := 0;
    for NameValue in SplitString(ALiteral, ',') do
    begin
      P := Pos('=', NameValue);
      Name := Copy(NameValue, 1, P - 1);
      Value := Copy(NameValue, P + 1, MaxInt);
      if Name = '' then
      begin
        Assert(Idx < KeyPropCount);
        Info := GetPropertyInfo(KeyProps[Idx]);
        KeyValue := KeyProps[Idx].UrlConverter.UrlToValue(Value, nil);
        Result[Idx] := Explorer.ValueToVariant(KeyValue, Info.RttiInfo);
      end
      else
      begin
        KeyFound := false;
        for J := 0 to KeyPropCount - 1 do
          if SameText(KeyProps[J].Name, Name) then
          begin
            KeyFound := true;
            SimpleKey := TXDataSimpleProperty(AType.Key[J]);
            Info := GetPropertyInfo(SimpleKey);
            KeyValue := SimpleKey.UrlConverter.UrlToValue(Value, nil);
            Result[J] := Explorer.ValueToVariant(KeyValue, Info.RttiInfo);
            break;
          end;
        if not KeyFound then Exit(Null); // error
      end;
      Inc(Idx);
    end;
  end;
end;

class function TXDataAureliusModel.ModelManager: TXDataModelManager;
begin
  if FModelManager = nil then
    FModelManager := TXDataModelManager.Create;
  Result := FModelManager;
end;

procedure TXDataAureliusModel.ParseCanonicalUrl(const RelativeUrl: string; var AClass: TClass;
  var IdValue: Variant);
var
  Name, Key: string;
  EntitySet: TXDataEntitySet;
begin
  if TXDataUtils.GetNameAndKey(RelativeUrl, Name, Key) then
  begin
    EntitySet := FindEntitySet(Name);
    if EntitySet <> nil then
    begin
      IdValue := KeyPredicateToId(Key, EntitySet.EntityType);
      AClass := GetEntityTypeClass(EntitySet.EntityType);
    end else
      raise EReferenceEntitySetNotFound.Create(RelativeUrl, Name);
  end else
    raise EReferenceInvalidFormat.Create(RelativeUrl);
end;

class procedure TXDataAureliusModel.Replace(const ModelName: string; AModel: TXDataAureliusModel);
begin
  ModelManager.Replace(ModelName, AModel);
end;

class procedure TXDataAureliusModel.ReplaceDefault(AModel: TXDataAureliusModel);
begin
  ModelManager.Replace(TMappingExplorer.DefaultModelName, AModel);
end;

procedure TXDataAureliusModel.SetNavigationPropertyValue(const AObject: TObject;
  const Prop: TXDataNavigationProperty; const Value: TObject);
begin
  Explorer.SetMemberValue(AObject, GetNavPropInfo(Prop), Value);
end;

procedure TXDataAureliusModel.SetPropertyBlobValue(const AObject: TObject;
  const Prop: TXDataSimpleProperty; const BlobValue: TBlob);
var
  Value: TValue;
  Info: TXDataAureliusPropInfo;
begin
  Info := GetPropertyInfo(Prop);
  if Info.RttiInfo.RealType.Handle = TypeInfo(TBlob) then
  begin
    Value := TValue.From<TBlob>(BlobValue);
    SetPropertyValue(AObject, Prop, Value);
  end
  else
    raise ECannotWriteNonBlobProperty.Create(Prop);
end;

procedure TXDataAureliusModel.SetPropertyValue(const AObject: TObject;
  const Prop: TXDataSimpleProperty; const Value: TValue);
var
  Info: TXDataAureliusPropInfo;
begin
  Info := GetPropertyInfo(Prop);
  Explorer.SetMemberValue(AObject, Info.RttiInfo, Value);
end;

function TXDataAureliusModel.FindControllerByInterface(IntfType: PTypeInfo): TXDataController;
var
  Controller: TXDataController;
begin
  // TODO: using Schemas[0] here is ok because we dont use schemas
  // but would be better to improve this
  for Controller in Schemas[0].Controllers do
    if IntfType = Controller.InterfaceType then
      Exit(Controller);
  Result := nil;
end;

function TXDataAureliusModel.FindEntityTypeByClass(AClass: TClass): TXDataEntityType;
var
  Schema: TXDataSchema;
  EntityType: TXDataEntityType;
begin
  // optimize this later, if needed.
  for Schema in Self.Schemas do
    for EntityType in Schema.EntityTypes do
      if EntityType.Data.AsType<TClass> = AClass then
        Exit(EntityType);
  Result := nil;
end;

function TXDataAureliusModel.GetEntityTypeByClass(AClass: TClass): TXDataEntityType;
begin
  Result := FindEntityTypeByClass(AClass);
  if Result = nil then
    raise EXDataEntityTypeFromClassNotFound.Create(AClass);
end;

{ TXDataAureliusPropInfo }

destructor TXDataAureliusPropInfo.Destroy;
begin
  FRttiInfo.Free;
  inherited;
end;

{ EListNotAccessible }

constructor EListNotAccessible.Create(ANavProp: TXDataNavigationProperty);
begin
  inherited CreateFmt('List not accessible in property "%s"', [ANavProp.QualifiedName]);
end;

{ EPropertyIsNotList }

constructor EPropertyIsNotList.Create(ANavProp: TXDataNavigationProperty);
begin
  inherited CreateFmt('Property "%s" cannot be read as a list', [ANavProp.QualifiedName]);
end;

{ TXDataModelManager }

constructor TXDataModelManager.Create;
begin
  FModels := TObjectDictionary<string, TXDataAureliusModel>.Create([doOwnsValues]);
end;

destructor TXDataModelManager.Destroy;
begin
  FModels.Free;
  inherited;
end;

function TXDataModelManager.Get(ModelName: string): TXDataAureliusModel;
var
  Builder: TXDataModelBuilder;
begin
  ModelName := LowerCase(ModelName);
  if FModels.TryGetValue(ModelName, Result) then Exit;

  Result := TXDataAureliusModel.Create(TMappingExplorer.Get(ModelName));
  FModels.Add(ModelName, Result);
  Builder := TXDataModelBuilder.Create(Result);
  try
    Builder.Build;
  finally
    Builder.Free;
  end;
end;

procedure TXDataModelManager.Replace(ModelName: string; AModel: TXDataAureliusModel);
begin
  ModelName := LowerCase(ModelName);
  if AModel <> nil then
    FModels.AddOrSetValue(ModelName, AModel)
  else
    FModels.Remove(ModelName);
end;

end.
