unit Bcl.Json.NamingStrategies;

{$I bcl.inc}

interface

uses
  Rtti, Bcl.Json.Converters;

type
  TDefaultNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

  TCamelCaseNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

  TSnakeCaseNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

  TIdentityNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

  TIdentityCamelCaseNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

  TIdentitySnakeCaseNamingStrategy = class(TJsonNamingStrategy)
  protected
    function ResolveName(RttiMember: TRttiMember): string; override;
  end;

implementation

uses
  SysUtils, Character,
  Bcl.Utils;

function TranslateFieldName(RttiMember: TRttiMember): string;
begin
  Result := RttiMember.Name;

  // Remove "F" from the field
  if RttiMember is TRttiField then
  begin
    if (Length(Result) > 0) and (Result[1] = 'F') then
      Result := Copy(Result, 2, MaxInt)
  end;
end;

function LowerCamelCase(const S: string): string;
var
  Len: Integer;
  I: Integer;
begin
  Len := Length(S);
  I := 1;
  while (I <= Len) and not TBclUtils.IsLetter(S[I]) do
    Inc(I);
  if I <= Len then
    Result := Copy(S, 1, I - 1) + LowerCase(S[I]) + Copy(S, I + 1, MaxInt)
  else
    Result := S;
end;

function SnakeCase(const S: string): string;
var
  I: Integer;
  Current, Before: Char;
begin
  Result := S;
  I := 2;
  while I <= Length(Result) do
  begin
    Current := Result[I];
    Before := Result[I - 1];
    if TBclUtils.IsUpper(Current) and (Before <> '_') and TBclUtils.IsLower(Before) then
    begin
      Insert('_', Result, I);
      Inc(I, 2);
    end
    else
      Inc(I);
  end;
  Result := LowerCase(Result);
end;

{ TDefaultNamingStrategy }

function TDefaultNamingStrategy.ResolveName(RttiMember: TRttiMember): string;
begin
  Result := TranslateFieldName(RttiMember);
end;

{ TCamelCaseNamingStrategy }

function TCamelCaseNamingStrategy.ResolveName(RttiMember: TRttiMember): string;
begin
  Result := LowerCamelCase(TranslateFieldName(RttiMember));
end;

{ TSnakeCaseNamingStrategy }

function TSnakeCaseNamingStrategy.ResolveName(RttiMember: TRttiMember): string;
begin
  Result := SnakeCase(TranslateFieldName(RttiMember));
end;

{ TIdentityNamingStrategy }

function TIdentityNamingStrategy.ResolveName(RttiMember: TRttiMember): string;
begin
  Result := RttiMember.Name;
end;

{ TIdentityCamelCaseNamingStrategy }

function TIdentityCamelCaseNamingStrategy.ResolveName(
  RttiMember: TRttiMember): string;
begin
  Result := LowerCamelCase(RttiMember.Name);
end;

{ TIdentitySnakeCaseNamingStrategy }

function TIdentitySnakeCaseNamingStrategy.ResolveName(
  RttiMember: TRttiMember): string;
begin
  Result := SnakeCase(RttiMember.Name);
end;

end.
