unit Keyman.System.BuildLangTags;

interface

type
  TBuildLangTags = class
    class procedure Build(const LangTagsFile, DestinationFile: string);
  end;

implementation

uses
  System.Classes,
  System.Generics.Collections,
  System.JSON,
  System.StrUtils,
  System.SysUtils,

  JsonUtil;

{ TBuildLangTags }

class procedure TBuildLangTags.Build(const LangTagsFile,
  DestinationFile: string);
var
  stream: TMemoryStream;
  FResult: TStringList;
  i, j: Integer;
  s: string;
  FLangTag: TJSONObject;
  FLangTags: TJSONArray;
  versionDate: string;
  versionApi: string;
  comma: string;
  PreviousField: Boolean;
  FTagMapCount: Integer;
  Tags: TJSONArray;
  full, base: string;

  function Escape(const s: string): string;
  begin
    Result := s.Replace('''', '''''', [rfReplaceAll]);
  end;

  function Field(fieldname: string): string;
  var
    v: TJSONValue;
  begin
    Result := '';
    v := FLangTag.Values[fieldname];
    if Assigned(v) then
    begin
      if PreviousField then Result := '; ';
      PreviousField := True;
      Result := Result + fieldname+': '''+Escape(v.Value)+'''';
    end;
  end;

  function BooleanField(fieldname: string): string;
  var
    v: TJSONValue;
  begin
    Result := '';
    v := FLangTag.Values[fieldname];
    if Assigned(v) and (v is TJSONTrue) then
    begin
      if PreviousField then Result := '; ';
      PreviousField := True;
      Result := Result + fieldname+': true';
    end;
  end;

  function AddAllTag(const comma, tag, base: string): string;
  begin
    Result := Format('%s (tag: ''%s''; base: ''%s'')', [comma, tag, base]);
  end;

begin
  stream := TMemoryStream.Create; //(LangTagsFile, fmOpenRead);
  try
    stream.LoadFromFile(LangTagsFile);
    FLangTags := TJSONObject.ParseJSONValue(PByte(stream.Memory), 0, stream.Size, [TJSONObject.TJSONParseOption.IsUTF8, TJSONObject.TJSONParseOption.RaiseExc]) as TJSONArray;
  finally
    stream.Free;
  end;

  try
    for i := 0 to 2 do
    begin
      if (FLangTags.Items[i] as TJSONObject).Values['tag'].Value = '_version' then
      begin
        versionApi := (FLangTags.Items[i] as TJSONObject).Values['api'].Value;
        versionDate := (FLangTags.Items[i] as TJSONObject).Values['date'].Value;
      end;
    end;

    FResult := TStringList.Create;
    try
      // Note, field that we don't currently use are excluded from the record
      FResult.Add('unit Keyman.System.Standards.LangTagsRegistry;');
      FResult.Add('');
      FResult.Add('interface');
      FResult.Add('');
      FResult.Add('// File-Date: '+FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));
      FResult.Add(Format('// Extracted from https://ldml.api.sil.org/langtags.json. Version %s, generated %s', [versionApi, versionDate]));
      FResult.Add('// Generated by build_standards_data');
      FResult.Add('');
      FResult.Add('uses');
      FResult.Add('  System.Generics.Collections;');
      FResult.Add('');
      FResult.Add('type');
      FResult.Add('  TLangTag = record');
      FResult.Add('    tag: string;');
      FResult.Add('    full: string;');
      //FResult.Add('    tags: TArray<string>;');
      //FResult.Add('    variants: TArray<string>;');
      FResult.Add('    iso639_3: string;');
      FResult.Add('    region: string;');
      //FResult.Add('    regions: TArray<string>;');
      //FResult.Add('    regionname: string;');
      //FResult.Add('    iana: TArray<string>;');
      FResult.Add('    name: string;');
      //FResult.Add('    names: TArray<string>;');
      //FResult.Add('    // localname: deprecated');
      //FResult.Add('    sldr: Boolean;');
      //FResult.Add('    nophonvars: Boolean;');
      FResult.Add('    script: string;');
      //FResult.Add('    localnames: TArray<string>;');
      //FResult.Add('    latnnames: TArray<string>;');
      //FResult.Add('    rod: string;');
      FResult.Add('    suppress: Boolean;');
      FResult.Add('    windows: string;');
      //FResult.Add('    obsolete, unwritten: Boolean;');
      FResult.Add('  end;');
      FResult.Add('');
      FResult.Add('');
      FResult.Add('  TLangTagsMap = class');
      FResult.Add('  private');
      FResult.Add('    type TLangTagsDictionary = TDictionary<string,TLangTag>;');
      FResult.Add('    type TAllTagsDictionary = TDictionary<string,string>;');
      FResult.Add('    class var FLangTags: TLangTagsDictionary;');
      FResult.Add('    class var FAllTags: TAllTagsDictionary;');
      FResult.Add('    class function GetLangTags: TLangTagsDictionary; static;');
      FResult.Add('    class function GetAllTags: TAllTagsDictionary; static;');
      FResult.Add('  private');
      FResult.Add('  private');
      FResult.Add('  public');
      FResult.Add('    class property LangTags: TLangTagsDictionary read GetLangTags;');
      FResult.Add('    class property AllTags: TAllTagsDictionary read GetAllTags;');
      FResult.Add('  end;');
      FResult.Add('');
      FResult.Add('implementation');
      FResult.Add('');
      FResult.Add('{ TLangTagsMap }');
      FResult.Add('');
      FResult.Add(Format('const CLangTags: array[0..%d] of TLangTag = (', [FLangTags.Count - 4]));

      comma := ',';
      FTagMapCount := 0;
      for i := 3 to FLangTags.Count - 1 do
      begin
        if i = FLangTags.Count - 1 then comma := '';
        FLangTag := FLangTags.Items[i] as TJSONObject;
        PreviousField := False;
        FResult.Add('  ('+
          Field('tag')+
          Field('full')+
          Field('iso639_3')+
          Field('region')+
          Field('name')+
          Field('script')+
          BooleanField('suppress')+
          Field('windows')+
          ')'+comma);

        base := FLangTag.Values['tag'].Value;
        full := FLangTag.Values['full'].Value;

        Inc(FTagMapCount); // base
        if full <> base then Inc(FTagMapCount); // full

        if FLangTag.Values['tags'] <> nil then
        begin
          Tags := FLangTag.Values['tags'] as TJSONArray;
          for j := 0 to Tags.Count - 1 do
            if (Tags.Items[j].Value <> full) and (Tags.Items[j].Value <> base) then
              Inc(FTagMapCount);
        end;
      end;

      FResult.Add(');');
      FResult.Add('');
      FResult.Add('type TStringMap = record tag, base: string; end;');
      FResult.Add(Format('const CAllTags: array[0..%d] of TStringMap = (', [FTagMapCount-1]));

      comma := '';
      for i := 3 to FLangTags.Count - 1 do
      begin
        FLangTag := FLangTags.Items[i] as TJSONObject;

        base := FLangTag.Values['tag'].Value;
        full := FLangTag.Values['full'].Value;

        s := '  ' + AddAllTag(comma, base, base);
        comma := ',';
        if full <> base then s := s + AddAllTag(comma, full, base);

        if FLangTag.Values['tags'] <> nil then
        begin
          Tags := FLangTag.Values['tags'] as TJSONArray;
          for j := 0 to Tags.Count - 1 do
            if (Tags.Items[j].Value <> full) and (Tags.Items[j].Value <> base) then
              s := s + AddAllTag(comma, Tags.Items[j].Value, base);
        end;
        FResult.Add(s);
      end;
      FResult.Add(');');
      FResult.Add('');

      FResult.Add('class function TLangTagsMap.GetLangTags: TLangTagsDictionary;');
      FResult.Add('var');
      FResult.Add('  i: Integer;');
      FResult.Add('begin');
      FResult.Add('  if not Assigned(FLangTags) then');
      FResult.Add('  begin');
      FResult.Add('    FLangTags := TLangTagsDictionary.Create;');
      FResult.Add('    for i := 0 to High(CLangTags) do');
      FResult.Add('      FLangTags.Add(CLangTags[i].tag, CLangTags[i]);');
      FResult.Add('  end;');
      FResult.Add('  Result := FLangTags;');
      FResult.Add('end;');
      FResult.Add('');

      FResult.Add('class function TLangTagsMap.GetAllTags: TAllTagsDictionary;');
      FResult.Add('var');
      FResult.Add('  i: Integer;');
      FResult.Add('begin');
      FResult.Add('  if not Assigned(FAllTags) then');
      FResult.Add('  begin');
      FResult.Add('    FAllTags := TAllTagsDictionary.Create;');
      FResult.Add('    for i := 0 to High(CAllTags) do');
      FResult.Add('      FAllTags.Add(CAllTags[i].tag, CAllTags[i].Base);');
      FResult.Add('  end;');
      FResult.Add('  Result := FAllTags;');
      FResult.Add('end;');

      FResult.Add('end.');

      FResult.SaveToFile(DestinationFile, TEncoding.UTF8);
    finally
      FResult.Free;
    end;
  finally
    FLangTags.Free;
  end;
end;

end.
