unit XData.Aurelius.ModelBuilder;

{$I XData.Inc}

interface

uses
  Generics.Collections, System.SysUtils, System.Rtti, System.TypInfo,
  System.Classes, System.Types,
  {$IFNDEF GENERICS}System.Contnrs,{$ENDIF}
  Aurelius.Mapping.Explorer,
  Aurelius.Mapping.Metadata,
  Aurelius.Mapping.Optimization,
  XData.Aurelius.Model,
  XData.Json.Converters,
  XData.Model.Attributes,
  XData.Model.Classes,
  XData.Sys.Exceptions;

type
  TXDataModelBuilder = class
  strict private
    FModel: TXDataAureliusModel;
    FSchema: TXDataSchema;
    FContainer: TXDataEntityContainer;
    FClasses: TDictionary<TClass, TXDataEntityType>;
    FUseOriginalClassNames: boolean;
    FUseOriginalFieldNames: boolean;
    FUseOriginalContractNames: boolean;
    FRtti: TRttiContext;
    FConverters: TXDataJsonConverters;
    FTypeMap: TDictionary<PTypeInfo, TXDataScalarType>;
    FPrepared: Boolean;
    function Explorer: TMappingExplorer;
    function DefineEnumType(RttiType: TRttiOrdinalType): TXDataEnumType;
    function IsEntity(AClass: TClass): Boolean;
    function DefineEntityType(AClass: TClass): TXDataEntityType;
    procedure BuildEntityType(AType: TXDataEntityType; AClass: TClass);
    function DefineEntitySet(AType: TXDataEntityType): TXDataEntitySet;
    procedure ImportServiceContracts;
    procedure AddServiceContract(InterfaceType: TRttiInterfaceType);
    function AddNavigationProperty(AType: TXDataEntityType;
      ARttiInfo: TRttiOptimization): TXDataNavigationProperty;
    procedure TryAddProperty(AType: TXDataEntityType; ARttiMember: TRttiMember);
    function FindOrDefineScalarType(RttiType: TRttiType): TXDataScalarType;
    procedure AddDefaultTypeMap;
  strict protected
    function EntityTypeName(AClass: TClass): string;
    function PropertyName(const AMember: TRttiOptimization): string;
    function EnumName(const ATypeName: string): string;
    function EntitySetName(const AType: TXDataEntityType): string;
    function ControllerName(const AType: TRttiInterfaceType): string;
  public
    constructor Create(AModel: TXDataAureliusModel);
    destructor Destroy; override;
    procedure Build;
    procedure Finish;

    function AddSimpleProperty(AType: TXDataEntityType;
      ARttiInfo: TRttiOptimization): TXDataSimpleProperty;

    function AddEntitySet(AClass: TClass): TXDataEntitySet;
    procedure AddService<T>;
    procedure RemoveEntitySet(AClass: TClass);
    class procedure BuildModel(AModel: TXDataAureliusModel);
    property UseOriginalClassNames: boolean read FUseOriginalClassNames write FUseOriginalClassNames;
    property UseOriginalFieldNames: boolean read FUseOriginalFieldNames write FUseOriginalFieldNames;
    property UseOriginalContractNames: boolean read FUseOriginalContractNames write FUseOriginalContractNames;
  end;

  EMultipleColumnsMemberException = class(Exception)
  public
    constructor Create(AInfo: TRttiOptimization);
  end;

  ECannotFindPropertyKey = class(Exception)
  public
    constructor Create(AInfo: TRttiOptimization);
  end;

  EAssociationNotFound = class(Exception)
  public
    constructor Create(AInfo: TRttiOptimization);
  end;

  EAssociationPartnerNotFound = class(Exception)
  public
    constructor Create(A: TAssociation);
  end;

  EUnsupportedActionResultType = class(EXDataException)
  public
    constructor Create(AAction: TXDataAction; AMethod: TRttiMethod);
  end;

  EParamByRefNotSupported = class(EXDataException)
  public
    constructor Create(AAction: TXDataAction; AParam: TRttiParameter);
  end;

  EParamTypeNotSpecified = class(EXDataException)
  public
    constructor Create(AAction: TXDataAction; AParam: TRttiParameter);
  end;

  EUnsupportedActionParamType = class(EXDataException)
  public
    constructor Create(AAction: TXDataAction; AParam: TRttiParameter);
  end;

  EInvalidDefaultvalue = class(EXDataException)
  public
    constructor Create(AAction: TXDataAction; AParam: TRttiParameter);
  end;

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

  EPrimitiveCollectionNotSupported = class(EXDataException)
  public
    constructor Create(APrimitiveName: string);
  end;

implementation

uses
  Aurelius.Mapping.MappedClasses,
  Aurelius.Types.Blob,
  Bcl.Rtti.Utils,
  Bcl.Json.Converters,
  XData.Model.Types,
  XData.Service.Common,
  XData.Service.Internal;

{ EMultipleColumnsMemberException }

constructor EMultipleColumnsMemberException.Create(
  AInfo: TRttiOptimization);
begin
  inherited CreateFmt('Property "%s.%s" is mapped to more than one database columns.',
    [AInfo.MemberRef.Parent.Name, AInfo.MemberName]);
end;

{ ECannotFindPropertyKey }

constructor ECannotFindPropertyKey.Create(
  AInfo: TRttiOptimization);
begin
  inherited CreateFmt('Property "%s.%s" could not be defined as key in entity type',
    [AInfo.MemberRef.Parent.Name, AInfo.MemberName]);
end;

{ EAssociationNotFound }

constructor EAssociationNotFound.Create(
  AInfo: TRttiOptimization);
begin
  inherited CreateFmt('Association not found for member "%s.%s"',
    [AInfo.MemberRef.Parent.Name, AInfo.MemberName]);
end;

{ EAssociationPartnerNotFound }

constructor EAssociationPartnerNotFound.Create(
  A: TAssociation);
begin
  inherited CreateFmt('Could not find member "%s.%s" mapped by association "%s.%s"',
    [A.Target.ClassName, A.MappedBy, A.Optimization.MemberRef.Parent.Name,
     A.Optimization.MemberName]);
end;

{ EParamByRefNotSupported }

constructor EParamByRefNotSupported.Create(AAction: TXDataAction; AParam: TRttiParameter);
begin
  inherited CreateFmt('Cannot define action "%s": Param "%s" cannot be passed as reference', [AAction.Name, AParam.Name]);
end;

constructor EParamTypeNotSpecified.Create(AAction: TXDataAction; AParam: TRttiParameter);
begin
  inherited CreateFmt('Cannot define action "%s": Param "%s" does not have a type', [AAction.Name, AParam.Name]);
end;

{ EUnsupportedActionResultType }

constructor EUnsupportedActionResultType.Create(AAction: TXDataAction; AMethod: TRttiMethod);
var
  MethodName: string;
  ResultTypeName: string;
begin
  if AMethod.Parent <> nil then
    MethodName := AMethod.Parent.Name + '.' + AMethod.Name
  else
    MethodName := AMethod.Name;

  if AMethod.ReturnType <> nil then
    ResultTypeName := AMethod.ReturnType.Name
  else
    ResultTypeName := '';

  inherited CreateFmt('Cannot define action: Invalid result type "%s" in method "%s"', [ResultTypeName, MethodName]);
end;

{ EUnsupportedActionParamType }

constructor EUnsupportedActionParamType.Create(AAction: TXDataAction; AParam: TRttiParameter);
var
  ParamTypeName: string;
begin
  if AParam.ParamType <> nil then
    ParamTypeName := AParam.ParamType.Name
  else
    ParamTypeName := '';

  inherited CreateFmt('Cannot define action "%s": Invalid type "%s" for param "%s"',
    [AAction.Name, ParamTypeName, AParam.Name]);
end;

{ EInvalidDefaultValue }

constructor EInvalidDefaultValue.Create(AAction: TXDataAction;
  AParam: TRttiParameter);
begin
  inherited CreateFmt('Cannot define action "%s": Invalid default value for param "%s"',
    [AAction.Name, AParam.Name]);
end;

{ EEntityTypeFromClassNotMapped }

constructor EEntityTypeFromClassNotMapped.Create(AClass: TClass);
begin
  inherited CreateFmt('Cannot create entity type from class %s. Class is not mapped', [AClass.ClassName]);
end;

{ EPrimitiveCollectionNotSupported }

constructor EPrimitiveCollectionNotSupported.Create(APrimitiveName: string);
begin
  inherited CreateFmt('Collection of primitive types (%s) not allowed', [APrimitiveName]);
end;

{ TXDataModelBuilder }

procedure TXDataModelBuilder.AddDefaultTypeMap;
var
  Defaults: TXDataPrimitiveTypes;
begin
  Defaults := TXDataPrimitiveTypes.Instance;

  // Integer types
  FTypeMap.AddOrSetValue(TypeInfo(Integer), Defaults.Int32Type);
  FTypeMap.AddOrSetValue(TypeInfo(Longint), Defaults.Int32Type);
  FTypeMap.AddOrSetValue(TypeInfo(Cardinal), Defaults.Int64Type);
  FTypeMap.AddOrSetValue(TypeInfo(Longword), Defaults.Int64Type);
  FTypeMap.AddOrSetValue(TypeInfo(Word), Defaults.Int32Type);
  FTypeMap.AddOrSetValue(TypeInfo(Shortint), Defaults.Int16Type);
  FTypeMap.AddOrSetValue(TypeInfo(Byte), Defaults.Int16Type);
  FTypeMap.AddOrSetValue(TypeInfo(SmallInt), Defaults.Int16Type);
  FTypeMap.AddOrSetValue(TypeInfo(Int64), Defaults.Int64Type);

  // Boolean types
  FTypeMap.AddOrSetValue(TypeInfo(Boolean), Defaults.BooleanType);

  // Float types
  FTypeMap.AddOrSetValue(TypeInfo(Double), Defaults.DoubleType);
  FTypeMap.AddOrSetValue(TypeInfo(Real), Defaults.DoubleType);
  FTypeMap.AddOrSetValue(TypeInfo(Single), Defaults.DoubleType);
  FTypeMap.AddOrSetValue(TypeInfo(Extended), Defaults.DoubleType);
  FTypeMap.AddOrSetValue(TypeInfo(Currency), Defaults.CurrencyType);

  // Date time types
  FTypeMap.AddOrSetValue(TypeInfo(TDateTime), Defaults.DateTimeType);
  FTypeMap.AddOrSetValue(TypeInfo(TDate), Defaults.DateType);
  FTypeMap.AddOrSetValue(TypeInfo(TTime), Defaults.TimeType);

  // Blob types
  FTypeMap.AddOrSetValue(TypeInfo(TBlob), Defaults.StreamType);
  FTypeMap.AddOrSetValue(TypeInfo(TBytes), Defaults.BinaryType);
  FTypeMap.AddOrSetValue(TypeInfo(TArray<byte>), Defaults.BinaryType);

  // String types
  FTypeMap.AddOrSetValue(TypeInfo(string), Defaults.StringType);
  {$IFNDEF NEXTGEN}
  FTypeMap.AddOrSetValue(TypeInfo(AnsiString), Defaults.StringType);
  FTypeMap.AddOrSetValue(TypeInfo(WideString), Defaults.StringType);
  {$ENDIF}

  // Char types
  FTypeMap.AddOrSetValue(TypeInfo(Char), Defaults.StringType);
  {$IFNDEF NEXTGEN}
  FTypeMap.AddOrSetValue(TypeInfo(AnsiChar), Defaults.StringType);
  FTypeMap.AddOrSetValue(TypeInfo(WideChar), Defaults.StringType);
  {$ENDIF}

  // Guid types
  FTypeMap.AddOrSetValue(TypeInfo(TGuid), Defaults.GuidType);

  // Variant
  FTypeMap.AddOrSetValue(TypeInfo(Variant), Defaults.VariantType);
end;

function TXDataModelBuilder.AddEntitySet(AClass: TClass): TXDataEntitySet;
begin
  FPrepared := False;
  Result := DefineEntitySet(DefineEntityType(AClass));
end;

function TXDataModelBuilder.AddNavigationProperty(AType: TXDataEntityType;
  ARttiInfo: TRttiOptimization): TXDataNavigationProperty;
begin
  Result := TXDataNavigationProperty.Create;
  AType.NavigationProperties.Add(Result);
  Result.Data := ARttiInfo.Clone;
  Result.OwnsDataObject := True;
  Result.Name := PropertyName(ARttiInfo);
  Result.Description := Explorer.GetMemberDescription(ARttiInfo.MemberRef);
  if Explorer.IsObjectList(ARttiInfo.MemberClass) then
    Result.Target := DefineEntityType(ARttiInfo.SurroundedClass).Collection
  else
    Result.Target := DefineEntityType(ARttiInfo.MemberClass);
end;

procedure TXDataModelBuilder.AddService<T>;
var
  Info: PTypeInfo;
  TypeData: PTypeData;
  RttiType: TRttiType;
begin
  FPrepared := False;
  Info := TypeInfo(T);
  if Info.Kind <> tkInterface then
    raise EXDataInvalidServiceType.Create(Info);

  TypeData := GetTypeData(Info);
  if not (ifHasGuid in TypeData.IntfFlags) then
    raise EXDataServiceInterfaceWithoutGuid.Create(Info);

  RttiType := FRtti.GetType(Info);
  if not (RttiType is TRttiInterfaceType) then
    raise EXDataInvalidServiceType.Create(Info);

  AddServiceContract(TRttiInterfaceType(RttiType));
end;

procedure TXDataModelBuilder.AddServiceContract(InterfaceType: TRttiInterfaceType);
var
  Controller: TXDataController;
  Meth: TRttiMethod;
  Action: TXDataAction;
  ParamDef: TXDataParamDef;
  MethParam: TRttiParameter;
  A: TCustomAttribute;
  TempDefaultValue: TValue;
begin
  Controller := TXDataController.Create;
  FSchema.Controllers.Add(Controller);
  Controller.Name := ControllerName(InterfaceType);
  Controller.OwnsDataObject := true;
  Controller.InterfaceType := InterfaceType.Handle;

  for Meth in InterfaceType.GetMethods do
  begin
    // no need to check method kind or visibility here because it's an interface, but let's add extra checks anyway
    // in case we move/copy this code somewhere else
    if not (Meth.MethodKind in [TMethodKind.mkProcedure, TMethodKind.mkFunction]) then
      Continue;
    if not (Meth.Visibility in [TMemberVisibility.mvPublic, TMemberVisibility.mvPublished]) then
      Continue;

    // create action object
    Action := TXDataAction.Create;
    Controller.Actions.Add(Action);
    Action.OwnsDataObject := true;
    Action.RttiMethod := Meth;

    // Set action name
    Action.Name := Meth.Name;

    // Override action settings if attributes are present
    for A in Meth.GetAttributes do
    begin
      if A is URIPathSegmentAttribute then
        Action.Name := URIPathSegmentAttribute(A).Segment;
      if A is HttpMethodAttribute then
        Action.HttpMethod := HttpMethodAttribute(A).HttpMethod;
    end;

    // Define return type
    if (Meth.ReturnType <> nil) then
    begin
      if not Action.IsResultStream and not Action.IsResultCriteria then
      begin
        // check JSON
        if FConverters.Find(Meth.ReturnType.Handle) = nil then
          raise EUnsupportedActionResultType.Create(Action, Meth);

        // check JSON Schema
//          if FGenerators.Find(Meth.ReturnType.Handle) = nil then
//            raise EUnsupportedActionResultType.Create(Action, Meth);
      end;
    end;

    // add params
    if Action.IsParamStream then
    begin
      ParamDef := TXDataParamDef.Create;
      Action.Parameters.Add(ParamDef);
      MethParam := Meth.GetParameters[0];
      ParamDef.Name := MethParam.Name;
      ParamDef.BindingMode := TBindingMode.FromBody;
      ParamDef.RttiType := MethParam.ParamType;
    end
    else
    begin
      for MethParam in Meth.GetParameters do
      begin
        ParamDef := TXDataParamDef.Create;
        Action.Parameters.Add(ParamDef);
        ParamDef.Name := MethParam.Name;

        // param modifier
        ParamDef.Output := (MethParam.Flags * [pfVar, pfOut]) <> [];
        ParamDef.Input := not (pfOut in MethParam.Flags);

        if ParamDef.Output and (Action.IsResultStream or Action.IsResultCriteria) then
          raise EParamByRefNotSupported.Create(Action, MethParam);
        if ParamDef.Output and ParamDef.RttiType.IsInstance then
          raise EParamByRefNotSupported.Create(Action, MethParam);

        // default param binding mode:
        // FromURI if it's a GET request, FromBody otherwise
        if Action.HttpMethod = 'GET' then
          ParamDef.BindingMode := TBindingMode.FromURI
        else
          ParamDef.BindingMode := TBindingMode.FromBody;

        ParamDef.OwnsDataObject := true;
        if MethParam.ParamType <> nil then
        begin
          ParamDef.RttiType := MethParam.ParamType;

          // check JSON
          if FConverters.Find(MethParam.ParamType.Handle) = nil then
            raise EUnsupportedActionParamType.Create(Action, MethParam);
          // check JSON Schema
  //        if FGenerators.Find(MethParam.ParamType.Handle) = nil then
  //          raise EUnsupportedActionParamType.Create(Action, MethParam);


          // Checks
          if (ParamDef.BindingMode = TBindingMode.FromURI) then
          begin
            ParamDef.ParamType := FindOrDefineScalarType(MethParam.ParamType);
          end;

          // Default value
          for A in MethParam.GetAttributes do
            if A is BaseDefaultAttribute then
            begin
              if not TValue.FromVariant(BaseDefaultAttribute(A).Value).TryCast(
                MethParam.ParamType.Handle, TempDefaultValue) then
                raise EInvalidDefaultValue.Create(Action, MethParam);
              ParamDef.DefaultValue := TempDefaultValue;
              Break;
            end;
        end
        else
          raise EParamTypeNotSpecified.Create(Action, MethParam);
      end;
    end;
  end;
end;

function TXDataModelBuilder.AddSimpleProperty(AType: TXDataEntityType;
  ARttiInfo: TRttiOptimization): TXDataSimpleProperty;
var
  PropInfo: TXDataAureliusPropInfo;
begin
  Result := TXDataSimpleProperty.Create;
  AType.Properties.Add(Result);
  Result.Name := PropertyName(ARttiInfo);
  Result.Description := Explorer.GetMemberDescription(ARttiInfo.MemberRef);
  Result.PropertyType := FindOrDefineScalarType(ARttiInfo.RealType);
  PropInfo := TXDataAureliusPropInfo.Create;
  Result.Data := PropInfo;
  Result.OwnsDataObject := true;
  PropInfo.RttiInfo := ARttiInfo.Clone;
  FPrepared := False;
end;

procedure TXDataModelBuilder.Build;
var
  C: TClass;
  EntityType: TXDataEntityType;
begin
  FPrepared := False;
  for C in Explorer.Hierarchy.Classes do
    DefineEntityType(C);
  for EntityType in FSchema.EntityTypes do
    DefineEntitySet(EntityType);
  ImportServiceContracts;
  Finish;
end;

procedure TXDataModelBuilder.BuildEntityType(AType: TXDataEntityType;
  AClass: TClass);
var
  O: TRttiOptimization;
  Prop: TXDataSimpleProperty;
  NavProp: TXDataNavigationProperty;
  Columns: TArray<TColumn>;
  Col: TColumn;
  Association: TAssociation;
  KeyProp: TXDataProperty;
  KeyMember: TRttiOptimization;
  RttiField: TRttiField;
  RttiProp: TRttiProperty;
begin
  AType.Name := EntityTypeName(AClass);

  if Explorer.Hierarchy.Contains(AClass.ClassParent) then
    AType.BaseType := DefineEntityType(AClass.ClassParent);

  // create properties and navigation properties
  for O in Explorer.GetClassStateMembers(AClass, false, false) do
  begin
    if O.IsDynamic then
      Continue;
    if TRttiUtils.GetInstance.GetAttribute(O.MemberRef, XDataExcludePropertyAttribute) <> nil then
      Continue;

    if O.RealType.IsInstance then
    begin
      Association := Explorer.GetAssociationByMember(O.MemberRef);
      if Association = nil then
        raise EAssociationNotFound.Create(O);

      NavProp := AddNavigationProperty(AType, O);

      // Set specific properties based on Aurelius mapping
      NavProp.Required := TAssociationProp.Required in Association.Properties;
    end else
    begin
      // scalar property
      Columns := Explorer.GetColumnsFromMember(O.MemberRef);
      if Length(Columns) <> 1 then
        raise EMultipleColumnsMemberException.Create(O);
      Col := Columns[0];

      Prop := AddSimpleProperty(AType, O);

      // Set specific properties based on Aurelius mapping
      Prop.Length := Col.Length;
      Prop.Precision := Col.Precision;
      Prop.Scale := Col.Scale;
      Prop.Required := TColumnProp.Required in Col.Properties;
    end;
  end;

  // Iterate through regular fields/properties to add members mapped
  // with XDataProperty attribute
  for RttiField in FRtti.GetType(AClass).GetDeclaredFields do
    if TRttiUtils.GetInstance.GetAttribute(RttiField, XDataPropertyAttribute) <> nil then
      TryAddProperty(AType, RttiField);
  for RttiProp in FRtti.GetType(AClass).GetDeclaredProperties do
    if TRttiUtils.GetInstance.GetAttribute(RttiProp, XDataPropertyAttribute) <> nil then
      TryAddProperty(AType, RttiProp);

  // set keys - not for inherited types
  if AType.BaseType = nil then
    for KeyMember in Explorer.GetId(AClass).Members do
    begin
      KeyProp := AType.FindProperty(PropertyName(KeyMember));
      if KeyProp = nil then
        KeyProp := AType.FindNavigationProperty(PropertyName(KeyMember));

      if KeyProp = nil then
        raise ECannotFindPropertyKey.Create(KeyMember);
      AType.Key.Add(KeyProp);
    end;
end;

class procedure TXDataModelBuilder.BuildModel(AModel: TXDataAureliusModel);
var
  Builder: TXDataModelBuilder;
begin
  Builder := TXDataModelBuilder.Create(AModel);
  try
    Builder.Build;
  finally
    Builder.Free;
  end;
end;

function TXDataModelBuilder.ControllerName(const AType: TRttiInterfaceType): string;
var
  A: TCustomAttribute;
begin
  Result := AType.Name;
  if not UseOriginalContractNames then
  begin
    if (Length(Result) > 1) and (Result[1] = 'I') then
      Result := Copy(Result, 2, MaxInt)
  end;
  for A in AType.GetAttributes do
    if A is URIPathSegmentAttribute then
      Result := URIPathSegmentAttribute(A).Segment;
end;

constructor TXDataModelBuilder.Create(AModel: TXDataAureliusModel);
begin
  FClasses := TDictionary<TClass, TXDataEntityType>.Create;
  FTypeMap := TDictionary<PTypeInfo, TXDataScalarType>.Create;
  AddDefaultTypeMap;
  FModel := AModel;
  FRtti := TRttiContext.Create;
  FClasses.Clear;
  if FModel.Schemas.Count = 0 then
    FModel.Schemas.Add(TXDataSchema.Create);
  FSchema := FModel.Schemas[0];
  FSchema.Namespace := 'XData.Default';
  FSchema.Alias := '';
  if FSchema.EntityContainers.Count = 0 then
    FSchema.EntityContainers.Add(TXDataEntityContainer.Create);
  FContainer := FSchema.EntityContainers[0];
  FContainer.Name := 'Default';
  FConverters := TXDataJsonConverters.Create(AModel);
  FPrepared := False;
end;

function TXDataModelBuilder.DefineEntitySet(
  AType: TXDataEntityType): TXDataEntitySet;
begin
  Result := FModel.DefaultEntitySet(AType);
  if Result = nil then
  begin
    Result := TXDataEntitySet.Create;
    FContainer.EntitySets.Add(Result);
    Result.EntityType := AType;
    FModel.DefineDefaultEntitySet(AType, Result);
    Result.Name := EntitySetName(AType);
  end;
end;

function TXDataModelBuilder.DefineEntityType(AClass: TClass): TXDataEntityType;
begin
  if FClasses.TryGetValue(AClass, Result) then Exit;
  if not IsEntity(AClass) then
    raise EEntityTypeFromClassNotMapped.Create(AClass);
  
  Result := TXDataEntityType.Create;
  Result.Data := AClass;
  FSchema.EntityTypes.Add(Result);
  FClasses.Add(AClass, Result);
  BuildEntityType(Result, AClass);
end;

function TXDataModelBuilder.DefineEnumType(RttiType: TRttiOrdinalType): TXDataEnumType;
var
  I: integer;
begin
  Result := FSchema.FindEnumType(EnumName(RttiType.Name));
  if Result <> nil then
    Exit;
  Result := TXDataEnumType.Create;
  FSchema.EnumTypes.Add(Result);
  Result.Name := EnumName(RttiType.Name);
  Result.Data := RttiType;
  for I := RttiType.MinValue to RttiType.MaxValue do
    Result.AddMember(GetEnumName(RttiType.Handle, I), I);
end;

destructor TXDataModelBuilder.Destroy;
begin
  try
    if not FPrepared then
      Finish;
  finally
    FClasses.Free;
    FRtti.Free;
    FConverters.Free;
    FTypeMap.Free;
    inherited;
  end;
end;

function TXDataModelBuilder.EnumName(const ATypeName: string): string;
begin
  Result := ATypeName;
end;

function TXDataModelBuilder.Explorer: TMappingExplorer;
begin
  Result := FModel.Explorer;
end;

function TXDataModelBuilder.FindOrDefineScalarType(
  RttiType: TRttiType): TXDataScalarType;
begin
  Result := nil;
  if not FTypeMap.TryGetValue(RttiType.Handle, Result) then
  begin
    if RttiType.TypeKind = tkEnumeration then
    begin
      Result := DefineEnumType(RttiType.AsOrdinal);
      FTypeMap.Add(RttiType.Handle, Result);
    end;
  end;
end;

procedure TXDataModelBuilder.Finish;
begin
  if not FPrepared then
  begin
    FModel.Prepare;
    FPrepared := True;
  end;
end;

procedure TXDataModelBuilder.ImportServiceContracts;
var
  RttiType: TRttiType;
  A: TCustomAttribute;
begin
  for RttiType in FRtti.GetTypes do
    if RttiType is TRttiInterfaceType then
      for A in RttiType.GetAttributes do
        if A is ServiceContractAttribute then
          if not Explorer.CustomSetup and TMappedClasses.BelongsToModel(RttiType, Explorer.ModelName) then
          begin
            AddServiceContract(TRttiInterfaceType(RttiType));
            break;
          end;
end;

function TXDataModelBuilder.IsEntity(AClass: TClass): Boolean;
begin
  Result := Explorer.Hierarchy.Contains(AClass);
end;

function TXDataModelBuilder.PropertyName(const AMember: TRttiOptimization): string;
begin
  Result := AMember.MemberName;
  if (AMember.MemberKind = TMemberKind.Field) and not UseOriginalFieldNames and not AMember.IsDynamic then
  begin
    if (Length(Result) > 1) and (Result[1] = 'F') then
      Result := Copy(Result, 2, MaxInt)
  end;
end;

procedure TXDataModelBuilder.RemoveEntitySet(AClass: TClass);
var
  EntityType: TXDataEntityType;
  EntitySet: TXDataEntitySet;
begin
  FPrepared := False;
  if not FClasses.TryGetValue(AClass, EntityType) then Exit;
  EntitySet := FModel.DefaultEntitySet(EntityType);
  if EntitySet <> nil then
    FContainer.EntitySets.Remove(EntitySet);
end;

procedure TXDataModelBuilder.TryAddProperty(AType: TXDataEntityType;
  ARttiMember: TRttiMember);
var
  RttiInfo: TRttiOptimization;
begin
  if not (ARttiMember is TRttiField) and not (ARttiMember is TRttiProperty) then Exit;
  RttiInfo := Explorer.GetOptimization(ARttiMember);
  try
    if AType.FindProperty(PropertyName(RttiInfo)) <> nil then Exit;
    if RttiInfo.RealType.IsInstance then
      AddNavigationProperty(AType, RttiInfo)
    else
      AddSimpleProperty(AType, RttiInfo);
  finally
    RttiInfo.Free;
  end;
end;

function TXDataModelBuilder.EntitySetName(
  const AType: TXDataEntityType): string;
begin
  Result := AType.Name
end;

function TXDataModelBuilder.EntityTypeName(AClass: TClass): string;
begin
  Result := AClass.ClassName;
  if not UseOriginalClassNames then
  begin
    if (Length(Result) > 1) and (Result[1] = 'T') then
      Result := Copy(Result, 2, MaxInt)
  end;
end;

end.
