unit XData.Design.DatasetDesigner;

{$I XData.inc}

interface

uses
  Generics.Collections, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Rtti, StdCtrls, DB, TypInfo,
  CheckLst, Buttons, ComCtrls,
  Aurelius.Bind.Dataset,
  XData.Web.DatasetCommon,
  XData.Model.Classes;

type
  TfmXDataFieldLoader = class(TForm)
    btOk: TButton;
    btCancel: TButton;
    PageControl1: TPageControl;
    tsClass: TTabSheet;
    lvTypes: TListView;
    edSearch: TEdit;
    Label1: TLabel;
    cbServerUrl: TComboBox;
    Label2: TLabel;
    btLoad: TButton;
    procedure btOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btCancelClick(Sender: TObject);
    procedure edSearchEnter(Sender: TObject);
    procedure edSearchExit(Sender: TObject);
    procedure edSearchChange(Sender: TObject);
    procedure lvTypesDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btLoadClick(Sender: TObject);
    procedure cbServerUrlChange(Sender: TObject);
  private
    const RecentUrlSection = 'RecentUrlList';
  private
    FDataset: TDataset;
    FFiltering: boolean;
    FModel: TXDataModel;
    function IDERegistryKey: string;
    procedure FillTypeListView(const TypeToSelect: string = '');
    procedure LoadServerUrlList;
    procedure SaveServerUrlList;
    procedure LoadModel(const ServerUrl: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function Execute(Dataset: TDataset): Boolean;
    class procedure Reload(Dataset: TDataset);
  end;

implementation

uses
  Registry, StrUtils,
  Aurelius.Bind.BaseDataset,
  Aurelius.Mapping.Attributes,
  Aurelius.Mapping.Explorer,
  Sparkle.Http.Client,
  Sparkle.Utils,
  XData.Model.Deserializer;

{$R *.dfm}

type
  TInternalAureliusDataset = class(TBaseAureliusDataset)
  end;

{ TfmXDataFieldLoader }

procedure TfmXDataFieldLoader.btCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfmXDataFieldLoader.btLoadClick(Sender: TObject);
begin
  LoadModel(cbServerUrl.Text);
  FillTypeListView;
  if cbServerUrl.Items.IndexOf(cbServerUrl.Text) < 0 then
    cbServerUrl.Items.Add(cbServerUrl.Text);
  SaveServerUrlList;
end;

procedure TfmXDataFieldLoader.btOkClick(Sender: TObject);
var
  SelectedType: TXDataEntityType;
begin
  if lvTypes.Selected <> nil then
  begin
    SelectedType := TXDataEntityType(lvTypes.Selected.Data);
    InitFieldDefsFromEntityType(FDataset, SelectedType, 0);
    TInternalAureliusDataset(FDataset).DesignClass := SelectedType.QualifiedName;
  end;
  ModalResult := mrOk;
end;

procedure TfmXDataFieldLoader.cbServerUrlChange(Sender: TObject);
begin
  btLoad.Enabled := cbServerUrl.Text <> '';
end;

constructor TfmXDataFieldLoader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModel := TXDataModel.Create;
end;

destructor TfmXDataFieldLoader.Destroy;
begin
  FModel.Destroy;
  inherited;
end;

procedure TfmXDataFieldLoader.edSearchChange(Sender: TObject);
begin
  if FFiltering then
    FillTypeListView;
end;

procedure TfmXDataFieldLoader.edSearchEnter(Sender: TObject);
begin
  if edSearch.Font.Color <> clWindowText then // dirty way to check for the "search" string
  begin
    edSearch.Text := '';
    edSearch.Font.Color := clWindowText;
  end;
  FFiltering := true;
end;

procedure TfmXDataFieldLoader.edSearchExit(Sender: TObject);
begin
  FFiltering := false;
  if edSearch.Text = '' then
  begin
    edSearch.Text := 'Search';
    edSearch.Font.Color := clGray;
  end;
end;

class function TfmXDataFieldLoader.Execute(Dataset: TDataset): boolean;
var
  Form: TfmXDataFieldLoader;
begin
  Form := TfmXDataFieldLoader.Create(Application);
  try
    Form.FDataset := Dataset;
    Result := (Form.ShowModal = mrOk);
  finally
    Form.Free;
  end;
end;

procedure TfmXDataFieldLoader.FillTypeListView(const TypeToSelect: string = '');
var
  ET: TXDataEntityType;
  Item: TListItem;
begin
  if csDestroying in ComponentState then Exit;

  lvTypes.Items.BeginUpdate;
  try
    lvTypes.Clear;
    if FModel.Schemas.Count = 0 then Exit;
    
    for ET in FModel.Schemas[0].EntityTypes do
    begin
      if not FFiltering or (edSearch.Text = '') or (ContainsText(ET.Name, edSearch.Text)) then
      begin
        Item := lvTypes.Items.Add;
        Item.Caption := ET.Name;
        Item.Data := ET;
        Item.SubItems.Add(ET.QualifiedName);
        if SameText(TypeToSelect, ET.Name) then
          lvTypes.Selected := Item;
      end;
    end;
    lvTypes.SortType := TSortType.stText;
  finally
    lvTypes.Items.EndUpdate;
  end;
  if lvTypes.Selected <> nil then
    lvTypes.Selected.MakeVisible(false);
end;

procedure TfmXDataFieldLoader.FormCreate(Sender: TObject);
begin
  edSearch.Text := '';
  edSearchExit(nil);
  cbServerUrl.OnChange(nil);
  LoadServerUrlList;
end;

procedure TfmXDataFieldLoader.FormShow(Sender: TObject);
begin
  FillTypeListView(TInternalAureliusDataset(FDataset).DesignClass);
  PageControl1.ActivePage := tsClass
end;

procedure TfmXDataFieldLoader.LoadModel(const ServerUrl: string);
var
  Client: THttpClient;
  Resp: THttpResponse;
  JsonModel: string;
  Msg: string;
  RequestUrl: string;
begin
  // Get JSON model from server
  Client := THttpClient.Create;
  RequestUrl := TSparkleUtils.CombineUrlFast(ServerUrl, '$model');
  Resp := Client.Get(RequestUrl);
  try
    if Resp.StatusCode <> 200 then
    begin
      Msg := Format('Could not retrieve model from "%s"', [RequestUrl]);
      Msg := Msg + sLineBreak + Format('Status code: %d (%s)', [Resp.StatusCode, Resp.StatusReason]);
      raise Exception.Create(Msg);
    end;
    JsonModel := TEncoding.UTF8.GetString(Resp.ContentAsBytes);
  finally
    Resp.Free;
  end;

  // Deserialize model
  FModel.Schemas.Clear;
  lvTypes.Items.Clear;
  TXDataModelDeserializer.Deserialize(FModel, JsonModel);
end;

procedure TfmXDataFieldLoader.LoadServerUrlList;
var
  R: TRegIniFile;
  Values: TStringList;
  I: integer;
  ServerUrl: string;
  UrlList: TStrings;
begin
  R := TRegIniFile.Create(IDERegistryKey);
  Values := TStringList.Create;
  try
    UrlList := cbServerUrl.Items;
    R.ReadSectionValues(RecentUrlSection, Values);
    UrlList.Clear;
    for I := 0 to Values.Count - 1 do
    begin
      ServerUrl := Values.ValueFromIndex[I];
      if (ServerUrl <> '') and (UrlList.IndexOf(ServerUrl) < 0) then
        UrlList.Add(ServerUrl);
    end;
  finally
    Values.Free;
    R.Free;
  end;
end;

procedure TfmXDataFieldLoader.lvTypesDblClick(Sender: TObject);
begin
  btOkClick(nil);
end;

function TfmXDataFieldLoader.IDERegistryKey: string;
var
  DelphiIDE: string;
begin
  {$IF DEFINED(VER210)}
  DelphiIDE := 'IDE\2010';
  {$ELSEIF Defined(VER220)}
  DelphiIDE := 'IDE\XE';
  {$ELSEIF Defined(VER230)}
  DelphiIDE := 'IDE\XE2';
  {$ELSEIF Defined(VER240)}
  DelphiIDE := 'IDE\XE3';
  {$ELSEIF Defined(VER250)}
  DelphiIDE := 'IDE\XE4';
  {$ELSEIF Defined(VER260)}
  DelphiIDE := 'IDE\XE5';
  {$ELSEIF Defined(VER270)}
  DelphiIDE := 'IDE\XE6';
  {$ELSE}
  DelphiIDE := 'IDE\D' + FloatToStr(System.CompilerVersion);
  {$IFEND}
  Result := Format('Software\TMS Software\Aurelius\%s', [DelphiIDE]);
end;

class procedure TfmXDataFieldLoader.Reload(Dataset: TDataset);
var
  Form: TfmXDataFieldLoader;
begin
  Form := TfmXDataFieldLoader.Create(Application);
  try
    Form.FDataset := Dataset;
    Form.FillTypeListView(TInternalAureliusDataset(Dataset).DesignClass);
    Form.btOkClick(nil);
  finally
    Form.Free;
  end;
end;

procedure TfmXDataFieldLoader.SaveServerUrlList;
var
  R: TRegIniFile;
  I: Integer;
  UrlList: TStrings;
begin
  R := TRegIniFile.Create(IDERegistryKey);
  try
    UrlList := cbServerUrl.Items;
    R.EraseSection(RecentUrlSection);
    for I := 0 to UrlList.Count - 1  do
      R.WriteString(RecentUrlSection, Format('Item%.2d', [I]), UrlList[I]);
  finally
    R.Free;
  end;
end;

end.
