unit ce_dubproject;

{$I ce_defines.inc}

interface

uses
  Classes, SysUtils, fpjson, jsonparser, jsonscanner, process, strutils,
  LazFileUtils, RegExpr, fgl,
  ce_common, ce_interfaces, ce_observer, ce_dialogs, ce_processes,
  ce_writableComponent, ce_compilers, ce_semver, ce_stringrange;

type

  TDubLinkMode = (dlmSeparate, dlmAllAtOnce, dlmSingleFile);

  TDubDependencyCheck = (dcStandard, dcOffline, dcNo);

  TDubVerbosity = (default, quiet, verbose, veryVerbose, onlyWarnAndError, onlyError);

  TDubArchOverride = (auto, x86, x86_64);

  PDubLocalPackage = ^TDubLocalPackage;

  TSemVerList = specialize TFPGList<PSemVer>;

  TDubLocalPackage = class
  strict private
    fName : string;
    fVersions: TSemVerList;
  public
    constructor create;
    destructor destroy; override;
    procedure addVersion(const value: string);
    function findVersion(constref value: TSemVer): PSemVer;
    function highestInInterval(constref lo, hi: TSemVer): PSemVer;
    function highest: PSemVer;
    property name: string read fName write fName;
  end;

  TDubLocalPackages = class
  strict private
    class var fLocalPackages: array of TDubLocalPackage;
    class var fDoneFirstUpdate: boolean;
  public
    class procedure deinit;
    class procedure update;
    class function find(const name: string; out package: PDubLocalPackage): boolean; overload;
    class function find(const name, op: string; constref opVer: TSemVer;
      out package: PDubLocalPackage): PSemver; overload;
  end;

  (**
   * Stores the build options, always applied when a project is build
   *)
  TCEDubBuildOptionsBase = class(TWritableLfmTextComponent)
  strict private
    fParallel: boolean;
    fForceRebuild: boolean;
    fLinkMode: TDubLinkMode;
    fCombined: boolean;
    fDepCheck: TDubDependencyCheck;
    fVerbosity: TDubVerbosity;
    fArchOverride: TDubArchOverride;
    fOther: string;
    fCompiler: DCompiler;
    fShowConsole: boolean;
    fAutoFetch: boolean;
    fAutoSelectTestConfig: boolean;
    procedure setLinkMode(value: TDubLinkMode);
    procedure setCompiler(value: DCompiler);
    function getCompiler: DCompiler;
  published
    property showConsole: boolean read fShowConsole write fShowConsole default false;
    property compiler: DCompiler read getCompiler write setCompiler;
    property parallel: boolean read fParallel write fParallel;
    property forceRebuild: boolean read fForceRebuild write fForceRebuild;
    property linkMode: TDubLinkMode read fLinkMode write setLinkMode;
    property combined: boolean read fCombined write fCombined;
    property other: string read fOther write fOther;
    property dependenciesCheck: TDubDependencyCheck read fDepCheck write fDepCheck;
    property verbosity: TDubVerbosity read fVerbosity write fVerbosity default default;
    property archOverride: TDubArchOverride read fArchOverride write fArchOverride default auto;
    property autoFetch: boolean read fAutoFetch write fAutoFetch default false;
    property autoSelectTestConfig: boolean read fAutoSelectTestConfig write fAutoSelectTestConfig default true;
  public
    procedure assign(source: TPersistent); override;
    procedure getOpts(options: TStrings);
  end;

  (**
   * Make the build options editable
   *)
  TCEDubBuildOptions = class(TCEDubBuildOptionsBase, ICEEditableOptions)
  strict private
    fBackup: TCEDubBuildOptionsBase;
    function optionedWantCategory(): string;
    function optionedWantEditorKind: TOptionEditorKind;
    function optionedWantContainer: TPersistent;
    procedure optionedEvent(event: TOptionEditorEvent);
    function optionedOptionsModified: boolean;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
  end;

  TDubCommand = (dcBuild, dcRun, dcTest);

  TCEDubProject = class(TComponent, ICECommonProject)
  private
    fIsSdl: boolean;
    fInGroup: boolean;
    fDubProc: TCEProcess;
    fPreCompilePath: string;
    fPackageName: string;
    fFilename: string;
    fModified: boolean;
    fJSON: TJSONObject;
    fSrcs: TStringList;
    fProjectSubject: TCEProjectSubject;
    fConfigsCount: integer;
    fImportPaths: TStringList;
    fBuildTypes: TStringList;
    fConfigs: TStringList;
    fBuiltTypeIx: integer;
    fConfigIx: integer;
    fBinKind: TProjectBinaryKind;
    fBasePath: string;
    fModificationCount: integer;
    fOutputFileName: string;
    fSaveAsUtf8: boolean;
    fCompiled: boolean;
    fMsgs: ICEMessagesDisplay;
    fNextTerminatedCommand: TDubCommand;
    fAsProjectItf: ICECommonProject;
    procedure doModified;
    procedure updateFields;
    procedure updatePackageNameFromJson;
    procedure udpateConfigsFromJson;
    procedure updateSourcesFromJson;
    procedure updateTargetKindFromJson;
    procedure updateImportPathsFromJson;
    procedure updateOutputNameFromJson;
    function findTargetKindInd(value: TJSONObject): boolean;
    procedure dubProcOutput(proc: TObject);
    procedure dubProcTerminated(proc: TObject);
    function getCurrentCustomConfig: TJSONObject;
    procedure executeDub(command: TDubCommand; const runArgs: string = '');
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    //
    procedure beginModification;
    procedure endModification;
    //
    function filename: string;
    function basePath: string;
    procedure loadFromFile(const fname: string);
    procedure saveToFile(const fname: string);
    //
    procedure updateSourcesList;
    procedure activate;
    function inGroup: boolean;
    procedure inGroup(value: boolean);
    function getFormat: TCEProjectFormat;
    function getProject: TObject;
    function modified: boolean;
    function binaryKind: TProjectBinaryKind;
    function getCommandLine: string;
    function outputFilename: string;
    procedure reload;
    procedure stopCompilation;
    //
    function isSource(const fname: string): boolean;
    function sourcesCount: integer;
    function sourceRelative(index: integer): string;
    function sourceAbsolute(index: integer): string;
    function importsPathCount: integer;
    function importPath(index: integer): string;
    //
    function configurationCount: integer;
    function getActiveConfigurationIndex: integer;
    procedure setActiveConfigurationIndex(index: integer);
    function configurationName(index: integer): string;
    //
    procedure compile;
    function compiled: boolean;
    procedure run(const runArgs: string = '');
    procedure test;
    function targetUpToDate: boolean;
    //
    property json: TJSONObject read fJSON;
    property packageName: string read fPackageName;
    property isSDL: boolean read fIsSdl;
  end;

  // these 9 built types always exist
  TDubBuildType = (plain, debug, release, releaseDebug, releaseNoBounds, unittest,
    docs, ddox, profile, cov, unittestcov);

  // returns true if filename is a valid dub project. Only json format is supported.
  function isValidDubProject(const filename: string): boolean;

  // converts a sdl description to json, returns the json
  function sdl2json(const filename: string): TJSONObject;

  function getDubCompiler: DCompiler;
  procedure setDubCompiler(value: DCompiler);

var
  DubCompiler: DCompiler = dmd;
  DubCompilerFilename: string = 'dmd';
  Lfm: ICELifetimeManager = nil;

const
  DubSdlWarning = 'this feature is deactivated in DUB projects with the SDL format';

implementation

var
  dubBuildOptions: TCEDubBuildOptions;

const

  optFname = 'dubbuild.txt';

  DubBuiltTypeName: array[TDubBuildType] of string = ('plain', 'debug', 'release',
    'release-debug', 'release-nobounds', 'unittest', 'docs', 'ddox', 'profile',
    'cov', 'unittest-cov'
  );

  DubDefaultConfigName = '(default config)';

  dubCmd2Arg: array[TDubCommand] of string = ('build', 'run', 'test');
  dubCmd2PreMsg: array[TDubCommand] of string = ('compiling ', 'running ', 'testing ');
  dubCmd2PostMsg: array[TDubCommand] of string = ('compiled', 'executed', 'tested');

procedure getPackagesLocations(loc: TStringList);
var
  p: string;
  j: TJSONParser;
  m: TMemoryStream;
  a: TJSONArray;
  o: TJSONObject = nil;
  d: TJSONData;
  r: TJSONData;
  i: integer;
begin
  {$IFDEF WINDOWS}
  p := GetEnvironmentVariable('APPDATA') + '\dub\packages\';
  {$ELSE}
  p := GetEnvironmentVariable('HOME') + '/.dub/packages/';
  {$ENDIF}
  if p.dirExists then
    loc.Add(p);
  p += 'local-packages.json';
  if not p.fileExists then
    exit;

  m := TMemoryStream.Create;
  try
    m.LoadFromFile(p);
    j := TJSONParser.Create(m, [joIgnoreTrailingComma, joUTF8]);
    try
      r := j.Parse;
    finally
      j.Free;
    end;
    if r.JSONType = jtArray then
    begin
      a := TJSONArray(r);
      for i := 0 to a.Count-1 do
      begin
        o := a.Objects[i];
        if not o.findAny('path', d) then
          continue;
        p := d.AsString;
        if (p.length <> 0) and (p[p.length] <> DirectorySeparator) then
          p += DirectorySeparator;
        if DirectoryExistsUTF8(p) then
          loc.Add(p);
      end;
    end;
  finally
    m.Free;
    if r.isNotNil then
      r.Free;
  end;
end;

{$REGION TDubLocalPackages -----------------------------------------------------}
constructor TDubLocalPackage.create;
begin
  fVersions := TSemVerList.create;
end;

destructor TDubLocalPackage.destroy;
var
  i: integer;
begin
  for i := 0 to fVersions.Count-1 do
    dispose(fVersions.Items[i]);
  fVersions.Free;
  inherited;
end;

procedure TDubLocalPackage.addVersion(const value: string);
var
  v: PSemVer;
  i: integer;
begin
  v := new(PSemVer);
  if value = 'vmaster' then
    v^.init('v0.0.0-master')
  else try
    v^.init(value);
  except
    dispose(v);
    exit;
  end;
  for i := 0 to fVersions.Count-1 do
  begin
    if fVersions[i]^ = v^ then
      exit;
    if (i < fVersions.Count-1) and (fVersions[i+1]^ > v^) and (fVersions[i]^ < v^ ) then
    begin
      fVersions.Insert(i, v);
      exit;
    end;
  end;
  fVersions.Add(v);
end;

function TDubLocalPackage.highest: PSemVer;
begin
  result := fVersions.Last;
end;

function TDubLocalPackage.highestInInterval(constref lo, hi: TSemVer): PSemVer;
var
  i: integer;
begin
  result := nil;
  for i := 0 to fVersions.Count-1 do
  begin
    if fVersions[i]^ < lo then
      continue;
    if fVersions[i]^ < hi then
      result := fVersions[i];
    if (fVersions[i]^ > hi) then
      break;
  end;
end;

function TDubLocalPackage.findVersion(constref value: TSemVer): PSemVer;
var
  i: integer;
begin
  result := nil;
  for i:= 0 to fVersions.Count-1 do
    if fVersions.Items[i]^ = value then
      exit(fVersions.Items[i]);
end;

class procedure TDubLocalPackages.deinit;
var
  i: integer;
begin
  for i:= 0 to high(fLocalPackages) do
    fLocalPackages[i].Free;
  inherited;
end;

class procedure TDubLocalPackages.update;
var
  p: TStringList;
  r: TStringList;
  s: string;
  n: string;
  v: string = '';
  i: integer;
  j: integer = 0;
  k: integer;
  d: PDubLocalPackage = nil;
  h: TStringRange = (ptr: nil; pos: 0; len: 0);
  x: string;

begin

  if not assigned(Lfm) then
    Lfm := getLifeTimeManager;
  if not assigned(Lfm) or not (Lfm.getLifetimeStatus = lfsLoaded) then
  begin
    if fDoneFirstUpdate then
      exit;
  end;
  fDoneFirstUpdate := true;

  for i := 0 to high(fLocalPackages) do
    fLocalPackages[i].Free;
  setLength(fLocalPackages, 0);
  r := TStringList.Create;
  getPackagesLocations(r);

  try for k := 0 to r.Count -1 do
  begin
    x := r[k];
    p := TStringList.Create;
    try
      listFolders(p, x);
      for i := 0 to p.Count-1 do
      begin
        j := 0;
        s := p[i];
        h.init(s);
        while true do
        begin
          h.popUntil('-');
          if h.empty then
            break;
          if (h.popFront^.front in ['0'..'9']) or
              h.endsWith('master') then
          begin
            j := h.position;
            break;
          end;
        end;
        if (j = 0) then
          continue;

        n := s[1..j-1];
        n := n.extractFileName;
        if not find(n, d) then
        begin
          setLength(fLocalPackages, length(fLocalPackages) + 1);
          fLocalPackages[high(fLocalPackages)] := TDubLocalPackage.create;
          d := @fLocalPackages[high(fLocalPackages)];
          d^.name := n;
        end;
        v := 'v' + s[j+1 .. length(s)];
        d^.addVersion(v);

      end;
    finally
      p.Free;
    end;
  end;
  finally
    r.Free;
  end;

end;

class function TDubLocalPackages.find(const name: string; out package: PDubLocalPackage): boolean;
var
  i: integer;
begin
  result := false;
  package:= nil;
  for i := 0 to high(fLocalPackages) do
    if fLocalPackages[i].name = name then
  begin
    result := true;
    package := @fLocalPackages[i];
    break;
  end;
end;

class function TDubLocalPackages.find(const name, op: string; constref opVer: TSemVer;
  out package: PDubLocalPackage): PSemVer;
var
  hi: TSemVer;
begin
  result := nil;
  if op = '=' then
  begin
    if find(name, package) then
      result := package^.findVersion(opVer);
  end
  else if op = '>=' then
  begin
    if find(name, package) then
    begin
      result := package^.highest;
      if result^ < opVer then
        result := nil;
    end;
  end
  else if op = '>' then
  begin
    if find(name, package) then
    begin
      result := package^.highest;
      if (result^ < opVer) or (result^ = opVer) then
        result := nil;
    end;
  end
  else if op = '~>' then
  begin
    if find(name, package) then
    begin
      hi := opVer;
      hi.minor := hi.minor + 1;
      hi.patch := 0;
      hi.additional :='';
      result := package^.highestInInterval(opVer, hi);
      result := result;
    end;
  end
  else
  begin
    if find(name, package) then
      result := package^.highest;
  end;
end;
{$ENDREGION}

{$REGION Options ---------------------------------------------------------------}
procedure TCEDubBuildOptionsBase.setLinkMode(value: TDubLinkMode);
begin
  if fLinkMode = value then
    exit;
  if not (value in [low(TDubLinkMode)..high(TDubLinkMode)]) then
    value := low(TDubLinkMode);
  fLinkMode:=value;
end;

procedure TCEDubBuildOptionsBase.setCompiler(value: DCompiler);
begin
  fCompiler := value;
  setDubCompiler(fCompiler);
end;

function TCEDubBuildOptionsBase.getCompiler: DCompiler;
begin
  result := fCompiler;
end;

procedure TCEDubBuildOptionsBase.assign(source: TPersistent);
var
  opts: TCEDubBuildOptionsBase;
begin
  if source is TCEDubBuildOptionsBase then
  begin
    opts := TCEDubBuildOptionsBase(source);
    parallel:=opts.parallel;
    forceRebuild:=opts.forceRebuild;
    combined:=opts.combined;
    linkMode:=opts.linkMode;
    other:=opts.other;
    dependenciesCheck:=opts.dependenciesCheck;
    compiler:=opts.compiler;
    verbosity:=opts.verbosity;
    archOverride:=opts.archOverride;
    autoFetch:=opts.autoFetch;
    fAutoSelectTestConfig:=opts.fAutoSelectTestConfig;
  end
  else inherited;
end;

procedure TCEDubBuildOptionsBase.getOpts(options: TStrings);
const
  vb: array[TDubVerbosity] of string = (
  '',           //auto,
  '--vquiet',   //quiet,
  '-v',         //verbose,
  '--vverbose', //veryVerbose,
  '-q',         //onlyWarnAndError,
  '--verror');  //vError
  ao: array [TDubArchOverride] of string = (
  '',
  '--arch=x86',
  '--arch=x86_64'
  );
begin
  if parallel then
    options.Add('--parallel');
  if forceRebuild then
    options.Add('--force');
  if combined then
    options.Add('--combined');
  case linkMode of
    dlmAllAtOnce: options.Add('--build-mode=allAtOnce');
    dlmSingleFile: options.Add('--build-mode=singleFile');
  end;
  case dependenciesCheck of
    dcNo: options.Add('--skip-registry=all');
    dcOffline: options.Add('--skip-registry=standard');
  end;
  if fVerbosity <> TDubVerbosity.default then
    options.Add(vb[fVerbosity]);
  if fArchOverride <> TDubArchOverride.auto then
    options.Add(ao[fArchOverride]);
  if other.isNotEmpty then
    CommandToList(other, options);
end;

constructor TCEDubBuildOptions.create(aOwner: TComponent);
var
  fname: string;
begin
  inherited;
  fBackup := TCEDubBuildOptionsBase.Create(nil);
  EntitiesConnector.addObserver(self);
  autoSelectTestConfig := true;
  fname := getDocPath + optFname;
  if fname.fileExists then
    loadFromFile(fname);
end;

destructor TCEDubBuildOptions.destroy;
begin
  saveToFile(getDocPath + optFname);
  EntitiesConnector.removeObserver(self);
  fBackup.free;
  inherited;
end;

function TCEDubBuildOptions.optionedWantCategory(): string;
begin
  exit('DUB build');
end;

function TCEDubBuildOptions.optionedWantEditorKind: TOptionEditorKind;
begin
  exit(oekGeneric);
end;

function TCEDubBuildOptions.optionedWantContainer: TPersistent;
begin
  exit(self);
  fBackup.assign(self);
end;

procedure TCEDubBuildOptions.optionedEvent(event: TOptionEditorEvent);
begin
  case event of
    oeeAccept: fBackup.assign(self);
    oeeCancel: self.assign(fBackup);
    oeeSelectCat:fBackup.assign(self);
  end;
end;

function TCEDubBuildOptions.optionedOptionsModified: boolean;
begin
  exit(false);
end;
{$ENDREGION}

{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCEDubProject.create(aOwner: TComponent);
begin
  inherited;
  fAsProjectItf := self as ICECommonProject;
  fSaveAsUtf8 := true;
  fJSON := TJSONObject.Create();
  fProjectSubject := TCEProjectSubject.Create;
  fMsgs:= getMessageDisplay;
  fBuildTypes := TStringList.Create;
  fConfigs := TStringList.Create;
  fSrcs := TStringList.Create;
  fSrcs.Sorted:=true;
  fSrcs.Duplicates:=dupIgnore;
  fImportPaths := TStringList.Create;
  fImportPaths.Sorted:=true;
  fImportPaths.Duplicates:=dupIgnore;

  json.Add('name', '');
  endModification;
  subjProjNew(fProjectSubject, self);
  doModified;
  fModified:=false;

  TDubLocalPackages.update;
end;

destructor TCEDubProject.destroy;
begin
  killProcess(fDubProc);
  subjProjClosing(fProjectSubject, self);
  fProjectSubject.free;

  fJSON.Free;
  fBuildTypes.Free;
  fConfigs.Free;
  fSrcs.Free;
  fImportPaths.Free;
  inherited;
end;
{$ENDREGION --------------------------------------------------------------------}

{$REGION ICECommonProject: project props ---------------------------------------}
procedure TCEDubProject.activate;
begin
  subjProjFocused(fProjectSubject, fAsProjectItf);
end;

function TCEDubProject.inGroup: boolean;
begin
  exit(fInGroup);
end;

procedure TCEDubProject.inGroup(value: boolean);
begin
  fInGroup:=value;
end;


function TCEDubProject.getFormat: TCEProjectFormat;
begin
  exit(pfDUB);
end;

function TCEDubProject.getProject: TObject;
begin
  exit(self);
end;

function TCEDubProject.modified: boolean;
begin
  exit(fModified);
end;

function TCEDubProject.filename: string;
begin
  exit(fFilename);
end;

function TCEDubProject.basePath: string;
begin
  exit(fBasePath);
end;

procedure TCEDubProject.reload;
begin
  if fFilename.fileExists then
    loadFromFile(fFilename);
end;

procedure TCEDubProject.loadFromFile(const fname: string);
var
  loader: TMemoryStream;
  parser : TJSONParser;
  ext: string;
  bom: dword = 0;
begin
  fFilename := fname;
  if not FilenameIsAbsolute(fFilename) then
    fFilename := ExpandFileName(fFilename);
  ext := fFilename.extractFileExt.upperCase;
  fBasePath := fFilename.extractFilePath;
  fSaveAsUtf8 := false;
  fIsSdl := false;
  if ext = '.JSON' then
  begin
    loader := TMemoryStream.Create;
    try
      loader.LoadFromFile(fFilename);
      // skip BOMs, they crash the parser
      loader.Read(bom, 4);
      if (bom and $BFBBEF) = $BFBBEF then
      begin
        loader.Position:= 3;
        fSaveAsUtf8 := true;
      end
      else if (bom = $FFFE0000) or (bom = $FEFF) then
      begin
        // UCS-4 LE/BE not handled by DUB
        loader.clear;
        loader.WriteByte(byte('{'));
        loader.WriteByte(byte('}'));
        loader.Position:= 0;
        fFilename := '';
      end
      else if ((bom and $FEFF) = $FEFF) or ((bom and $FFFE) = $FFFE) then
      begin
        // UCS-2 LE/BE not handled by DUB
        loader.clear;
        loader.WriteByte(byte('{'));
        loader.WriteByte(byte('}'));
        loader.Position:= 0;
        fFilename := '';
      end
      else
        loader.Position:= 0;
      //
      FreeAndNil(fJSON);
      parser := TJSONParser.Create(loader, [joIgnoreTrailingComma, joUTF8]);
      try
        try
          fJSON := parser.Parse as TJSONObject;
        except
          if assigned(fJSON) then
            FreeAndNil(fJSON);
          fFilename := '';
        end;
      finally
        parser.Free;
      end;
    finally
      loader.Free;
    end;
  end
  else if ext = '.SDL' then
  begin
    FreeAndNil(fJSON);
    fJSON := sdl2json(fFilename);
    if fJSON.isNil then
      fFilename := ''
    else
      fIsSdl := true;
  end;

  if not assigned(fJSON) then
    fJson := TJSONObject.Create(['name','invalid json']);

  updateFields;
  subjProjChanged(fProjectSubject, self);
  fModified := false;
end;

procedure TCEDubProject.saveToFile(const fname: string);
var
  saver: TMemoryStream;
  str: string;
begin
  if fname <> fFilename then
    inGroup(false);
  saver := TMemoryStream.Create;
  try
    fFilename := fname;
    str := fJSON.FormatJSON;
    if fSaveAsUtf8 then
    begin
      saver.WriteDWord($00BFBBEF);
      saver.Position:=saver.Position-1;
    end;
    saver.Write(str[1], str.length);
    saver.SaveToFile(fFilename);
  finally
    saver.Free;
    fModified := false;
  end;
end;

function TCEDubProject.binaryKind: TProjectBinaryKind;
begin
  exit(fBinKind);
end;

function TCEDubProject.getCommandLine: string;
var
  str: TStringList;
begin
  str := TStringList.Create;
  try
    str.Add('dub' + exeExt);
    str.Add('build');
    str.Add('--build=' + fBuildTypes[fBuiltTypeIx]);
    if (fConfigs.Count <> 1) and (fConfigs[0] <> DubDefaultConfigName) then
      str.Add('--config=' + fConfigs[fConfigIx]);
    str.Add('--compiler=' + DubCompilerFilename);
    dubBuildOptions.getOpts(str);
    result := str.Text;
  finally
    str.Free;
  end;
end;

function TCEDubProject.outputFilename: string;
begin
  exit(fOutputFileName);
end;
{$ENDREGION --------------------------------------------------------------------}

{$REGION ICECommonProject: sources ---------------------------------------------}
function TCEDubProject.isSource(const fname: string): boolean;
var
  str: string;
begin
  str := fname;
  if str.fileExists then
    str := ExtractRelativepath(fBasePath, str);
  result := fSrcs.IndexOf(str) <> -1;
end;

function TCEDubProject.sourcesCount: integer;
begin
  exit(fSrcs.Count);
end;

function TCEDubProject.sourceRelative(index: integer): string;
begin
  exit(fSrcs[index]);
end;

function TCEDubProject.sourceAbsolute(index: integer): string;
var
  fname: string;
begin
  fname := fSrcs[index];
  if FilenameIsAbsolute(fname) then
    result := fname
  else
    result := expandFilenameEx(fBasePath, fname);
end;

function TCEDubProject.importsPathCount: integer;
begin
  result := fImportPaths.Count;
end;

function TCEDubProject.importPath(index: integer): string;
begin
  result := expandFilenameEx(fBasePath, fImportPaths[index]);
end;
{$ENDREGION --------------------------------------------------------------------}

{$REGION ICECommonProject: configs ---------------------------------------------}
function TCEDubProject.configurationCount: integer;
begin
  exit(fConfigsCount);
end;

function TCEDubProject.getActiveConfigurationIndex: integer;
begin
  exit(fBuiltTypeIx * fConfigs.Count + fConfigIx);
end;

procedure TCEDubProject.setActiveConfigurationIndex(index: integer);
begin
  fBuiltTypeIx := index div fConfigs.Count;
  fConfigIx := index mod fConfigs.Count;
  doModified;
  // DUB does not store an active config
  fModified:=false;
end;

function TCEDubProject.configurationName(index: integer): string;
begin
  result := fBuildTypes[index div fConfigs.Count] + ' - ' +
    fConfigs[index mod fConfigs.Count];
end;
{$ENDREGION --------------------------------------------------------------------}

{$REGION ICECommonProject: actions ---------------------------------------------}
procedure TCEDubProject.stopCompilation;
begin
  if fDubProc.isNotNil and fDubProc.Running then
    fDubProc.Terminate(1);
end;

procedure TCEDubProject.dubProcOutput(proc: TObject);
var
  lst: TStringList;
  str: string;
begin
  lst := TStringList.Create;
  try
    fDubProc.getFullLines(lst);
    for str in lst do
      fMsgs.message(str, fAsProjectItf, amcProj, amkAuto);
  finally
    lst.Free;
  end;
end;

procedure TCEDubProject.dubProcTerminated(proc: TObject);
var
  n: string;
begin
  dubProcOutput(proc);
  n := shortenPath(filename);
  if fNextTerminatedCommand = dcBuild then
    fCompiled := fDubProc.ExitStatus = 0;
  // note: fCompiled is also used to indicate if there's something produced
  // so the 'or' RHS is there for fNextTerminatedCommand <> dcBuild;
  if fCompiled or (fDubProc.ExitStatus = 0) then
  begin
    fMsgs.message(n + ' has been successfully ' +
      dubCmd2PostMsg[fNextTerminatedCommand], fAsProjectItf, amcProj, amkInf)
  end
  else
  begin
    fMsgs.message(n + ' has not been successfully ' +
      dubCmd2PostMsg[fNextTerminatedCommand], fAsProjectItf, amcProj, amkWarn);
    fMsgs.message(format('error: DUB has returned the status %s',
      [prettyReturnStatus(fDubProc)]), fAsProjectItf, amcProj, amkErr);
  end;
  subjProjCompiled(fProjectSubject, fAsProjectItf, fCompiled);
  SetCurrentDirUTF8(fPreCompilePath);
end;

procedure TCEDubProject.executeDub(command: TDubCommand; const runArgs: string = '');
var
  olddir: string;
  prjname: string;
  rargs: TStringList;
begin
  if fDubProc.isNotNil and fDubProc.Active then
  begin
    fMsgs.message('the project is already being processed by DUB', fAsProjectItf, amcProj, amkWarn);
    exit;
  end;
  killProcess(fDubProc);
  fCompiled := false;
  if not fFilename.fileExists then
  begin
    dlgOkInfo('The project must be saved before being ' +
      dubCmd2PreMsg[command] + 'by DUB !');
    exit;
  end;
  fNextTerminatedCommand := command;
  fMsgs.clearByData(fAsProjectItf);
  prjname := shortenPath(fFilename);
  fDubProc:= TCEProcess.Create(nil);
  olddir  := GetCurrentDir;
  try
    subjProjCompiling(fProjectSubject, fAsProjectItf);
    fMsgs.message(dubCmd2PreMsg[command] + prjname, fAsProjectItf, amcProj, amkInf);
    if modified then
      saveToFile(fFilename);
    chDir(fFilename.extractFilePath);
    fDubProc.Executable := 'dub' + exeExt;
    if not dubBuildOptions.showConsole then
    begin
      fDubProc.Options := fDubProc.Options + [poStderrToOutPut, poUsePipes];
      fDubProc.OnReadData:= @dubProcOutput;
      fDubProc.ShowWindow := swoHIDE;
    end
    else
    begin
      fDubProc.Options := fDubProc.Options + [poWaitOnExit, poNewConsole];
    end;
    fDubProc.CurrentDirectory := fFilename.extractFilePath;
    fDubProc.XTermProgram:=consoleProgram;
    fDubProc.Parameters.Add(dubCmd2Arg[command]);
    fDubProc.OnTerminate:= @dubProcTerminated;
    if (command <> dcTest) or not dubBuildOptions.autoSelectTestConfig then
    begin
      fDubProc.Parameters.Add('--build=' + fBuildTypes[fBuiltTypeIx]);
      if (fConfigs.Count <> 1) and (fConfigs[0] <> DubDefaultConfigName) then
        fDubProc.Parameters.Add('--config=' + fConfigs[fConfigIx]);
    end;
    fDubProc.Parameters.Add('--compiler=' + DubCompilerFilename);
    dubBuildOptions.getOpts(fDubProc.Parameters);
    if (command <> dcBuild) and runArgs.isNotEmpty then
    begin
      fDubProc.Parameters.Add('--');
      rargs := TStringList.Create;
      try
        CommandToList(runArgs, rargs);
        fDubProc.Parameters.AddStrings(rargs);
      finally
        rargs.Free;
      end;
    end;
    fDubProc.Execute;
  finally
    SetCurrentDirUTF8(olddir);
  end;
end;

procedure TCEDubProject.compile;
begin
  fPreCompilePath := GetCurrentDirUTF8;
  executeDub(dcBuild);
end;

function TCEDubProject.compiled: boolean;
begin
  exit(fCompiled);
end;

procedure TCEDubProject.run(const runArgs: string = '');
begin
  executeDub(dcRun, runArgs);
end;

procedure TCEDubProject.test;
begin
  executeDub(dcTest);
end;

function TCEDubProject.targetUpToDate: boolean;
begin
  // rebuilding is done automatically when the command is 'run'
  result := true;
end;
{$ENDREGION --------------------------------------------------------------------}

{$REGION JSON to internal fields -----------------------------------------------}
function TCEDubProject.getCurrentCustomConfig: TJSONObject;
var
  confs: TJSONArray;
begin
  result := nil;
  if fJSON.findArray('configurations', confs) and (fConfigIx < confs.Count) then
    result := confs.Objects[fConfigIx];
end;

procedure TCEDubProject.updatePackageNameFromJson;
var
  value: TJSONData;
begin
  if fJSON.isNil then
    exit;
  if not fJSON.findAny('name', value) then
    fPackageName := ''
  else
      fPackageName := value.AsString;
end;

procedure TCEDubProject.udpateConfigsFromJson;
var
  i: integer;
  dat: TJSONData;
  arr: TJSONArray = nil;
  item: TJSONObject = nil;
  obj: TJSONObject = nil;
  itemname: string;
begin
  fBuildTypes.Clear;
  fConfigs.Clear;
  if fJSON.isNil then
    exit;
  // the CE interface for dub doesn't make the difference between build type
  //and config, instead each possible combination type + build is generated.
  if fJSON.findArray('configurations', arr) and (arr.Count > 0) then
  begin
    for i:= 0 to arr.Count-1 do
    begin
      item := TJSONObject(arr.Items[i]);
      if item.findAny('name', dat) then
        fConfigs.Add(dat.AsString);
    end;
  end else
  begin
    fConfigs.Add(DubDefaultConfigName);
    // default = what dub set as 'application' or 'library'
    // in this case dexed will pass only the type to DUB: 'DUB --build=release'
  end;

  fBuildTypes.AddStrings(DubBuiltTypeName);
  if fJSON.findObject('buildTypes', obj) then for i := 0 to obj.Count-1 do
  begin
    itemname := obj.Names[i];
    // defaults build types can be overridden
    if fBuildTypes.IndexOf(itemname) <> -1 then
      continue;
    fBuildTypes.Add(itemname);
  end;

  deleteDups(fConfigs);
  deleteDups(fBuildTypes);
  fConfigsCount := fConfigs.Count * fBuildTypes.Count;
end;

procedure TCEDubProject.updateSourcesList;
begin
  updateSourcesFromJson;
end;

procedure TCEDubProject.updateSourcesFromJson;
var
  lst: TStringList;
  item: TJSONData;
  conf: TJSONObject;
  arr: TJSONArray;
  i{, j}: integer;
procedure getExclusion(from: TJSONObject);
var
  i: integer;
begin
  if from.findArray('excludedSourceFiles', arr) then
    for i := 0 to arr.Count-1 do
      lst.Add(patchPlateformPath(arr.Strings[i]));
end;
procedure tryAddRelOrAbsFile(const fname: string);
begin
  if not isDlangCompilable(fname.extractFileExt) then
    exit;
  if fname.fileExists and FilenameIsAbsolute(fname) then
  begin
    fSrcs.Add(patchPlateformPath(ExtractRelativepath(fBasePath, fname)))
  end
  else if patchPlateformPath(expandFilenameEx(fBasePath, fname)).fileExists then
    fSrcs.Add(patchPlateformPath(fname));
end;
procedure tryAddFromFolder(const pth: string);
var
  abs: string;
begin
  if pth.dirExists then
  begin
    lst.Clear;
    listFiles(lst, pth, true);
    for abs in lst do
      if isDlangCompilable(abs.extractFileExt) then
        fSrcs.Add(patchPlateformPath(ExtractRelativepath(fBasePath, abs)));
  end;
end;
var
  pth: string;
  //glb: TRegExpr;
begin
  fSrcs.Clear;
  if not assigned(fJSON) then
    exit;
  lst := TStringList.Create;
  try
    // auto folders & files
    if fJSON.findAny('mainSourceFile', item) then
    begin
      pth := item.AsString;
      if pth.fileExists then
        fSrcs.Add(patchPlateformPath(ExtractRelativepath(fBasePath, pth)))
      else if expandFilenameEx(fBasePath, pth).fileExists then
        fSrcs.Add(patchPlateformPath(pth));
    end;
    tryAddFromFolder(fBasePath + 'src');
    tryAddFromFolder(fBasePath + 'source');
    // custom folders
    if fJSON.findArray('sourcePaths', arr) then for i := 0 to arr.Count-1 do
    begin
      pth := TrimRightSet(arr.Strings[i], ['/','\']);
      if pth.dirExists and FilenameIsAbsolute(pth) then
        tryAddFromFolder(pth)
      else
        tryAddFromFolder(expandFilenameEx(fBasePath, pth));
    end;
    // custom files
    if fJSON.findArray('sourceFiles', arr) then for i := 0 to arr.Count-1 do
      tryAddRelOrAbsFile(arr.Strings[i]);
    conf := getCurrentCustomConfig;
    if conf.isNotNil then
    begin
      if conf.findAny('mainSourceFile', item) then
      begin
        pth := item.AsString;
        if pth.fileExists then
          fSrcs.Add(patchPlateformPath(ExtractRelativepath(fBasePath, pth)))
        else if expandFilenameEx(fBasePath, pth).fileExists then
          fSrcs.Add(patchPlateformPath(pth));
      end;
      // custom folders in current config
      if conf.findArray('sourcePaths', arr) then for i := 0 to arr.Count-1 do
      begin
        pth := TrimRightSet(arr.Strings[i], ['/','\']);
        if pth.dirExists and FilenameIsAbsolute(pth) then
          tryAddFromFolder(pth)
        else
          tryAddFromFolder(expandFilenameEx(fBasePath, pth));
      end;
      // custom files in current config
      if conf.findArray('sourceFiles', arr) then for i := 0 to arr.Count-1 do
        tryAddRelOrAbsFile(arr.Strings[i]);
    end;
    // exclusions : not managed anymore because of other IDE features that rely
    // on the full list (scan TODOs, <CPFS>, search in project, etc)
    {lst.Clear;
    getExclusion(fJSON);
      conf := getCurrentCustomConfig;
    if conf.isNotNil then
      getExclusion(conf);
    if lst.Count > 0 then
    begin
      glb := TRegExpr.Create;
      try
        for j := 0 to lst.Count-1 do
        begin
          try
            glb.Expression := globToReg(lst[j]);
            glb.Compile;
            for i := fSrcs.Count-1 downto 0 do
              if glb.Exec(fSrcs[i]) then
                fSrcs.Delete(i);
          except
            continue;
          end;
        end;
      finally
        glb.Free;
      end;
    end;}
  finally
    lst.Free;
  end;
  deleteDups(fSrcs);
end;

function TCEDubProject.findTargetKindInd(value: TJSONObject): boolean;
var
  tt: TJSONData;
begin
  result := true;
  if value.Find('mainSourceFile').isNotNil then
    fBinKind := executable
  else if value.findAny('targetType', tt) then
  begin
    case tt.AsString of
      'executable': fBinKind := executable;
      'staticLibrary', 'library' : fBinKind := staticlib;
      'dynamicLibrary' : fBinKind := sharedlib;
      'autodetect': result := false;
      else fBinKind := executable;
    end;
  end
  else result := false;
end;

procedure TCEDubProject.updateTargetKindFromJson;
var
  found: boolean = false;
  conf: TJSONObject;
  src: string;
begin
  fBinKind := executable;
  if fJSON.isNil then exit;
  // note: this is only used to known if output can be launched
  found := findTargetKindInd(fJSON);
  conf := getCurrentCustomConfig;
  if conf.isNotNil then
    found := found or findTargetKindInd(conf);
  if not found then
  begin
    for src in fSrcs do
    begin
      if (src = 'source' + DirectorySeparator + 'app.d')
        or (src = 'src' + DirectorySeparator + 'app.d')
        or (src = 'source' + DirectorySeparator + 'main.d')
        or (src = 'src' + DirectorySeparator + 'main.d')
        or (src = 'source' + DirectorySeparator + fPackageName + DirectorySeparator + 'app.d')
        or (src = 'src' + DirectorySeparator + fPackageName + DirectorySeparator + 'app.d')
        or (src = 'source' + DirectorySeparator + fPackageName + DirectorySeparator + 'main.d')
        or (src = 'src' + DirectorySeparator + fPackageName + DirectorySeparator + 'main.d')
      then
      begin
        fBinKind:= executable;
        break;
      end
      else
        fBinKind:= staticlib;
    end;
  end;
end;

procedure TCEDubProject.updateImportPathsFromJson;

  procedure addFrom(obj: TJSONObject);
  var
    arr: TJSONArray;
    pth: string;
    i: integer;
  begin
    if obj.findArray('importPaths', arr) then for i := 0 to arr.Count-1 do
    begin
      pth := TrimRightSet(arr.Strings[i], ['/','\']);
      if pth.dirExists and FilenameIsAbsolute(pth) then
        fImportPaths.Add(pth)
      else
        fImportPaths.Add(expandFilenameEx(fBasePath, pth));
    end;
  end;

  // note: dependencies are added as import to allow DCD completion
  // see TCEDcdWrapper.projChanged()
  procedure addDepsFrom(obj: TJSONObject; const suffix: string = '');
  var
    deps: TJSONObject;
    pck: PDubLocalPackage;
    j: TJSONData;
    p: string;
    s: string;
    v: string;
    n: string;
    o: string;
    r: TStringRange = (ptr: nil; pos: 0; len: 0);
    q: TSemVer;
    u: PSemVer;
    i: integer;
    k: integer;
    c: TJSONObject;
    b: TStringList;
  begin
    if obj.findObject('dependencies' + suffix, deps) then
    begin

      b := TStringList.Create;
      getPackagesLocations(b);

      try for i := 0 to deps.Count-1 do
      begin
        n := deps.Names[i];

        // local path specified
        if deps.findObject(n, c) and c.findAny('path', j) then
        begin
          s := expandFilenameEx(fBasePath, j.AsString);
          if (s + 'source').dirExists then
            fImportPaths.Add(s)
          else if (s + 'src').dirExists then
            fImportPaths.Add(s);
          continue;
        end;

        // Try to fetch if not present at all
        if not TDubLocalPackages.find(n, pck) and dubBuildOptions.autoFetch then
        begin
          with TProcess.Create(nil) do
          try
            Executable := exeFullName('dub' + exeExt);
            Options := Options + [poUsePipes];
            ShowWindow:= swoHIDE;
            Parameters.Add('fetch');
            Parameters.Add(n);
            Execute;
            while Running do ;
            if ExitStatus = 0 then
              TDubLocalPackages.update();
          finally
            free;
          end;
        end;

        if TDubLocalPackages.find(n, pck) then
        begin

          j := deps.Items[i];
          if j.JSONType <> TJSONtype.jtString then
            continue;

          //split version operator and version number
          v := j.AsString;
          r.init(v);
          o := r.takeUntil(['0'..'9']).yield;
          p := r.takeUntil(#0).yield;
          if p = '*' then
          begin
            o := '>=';
            p := '0.0.0';
          end
          else if (p = 'master') or (v = '~master') then
            q.init('v0.0.0-master')
          else
            q.init('v' + p);

          // Finds a match for the version in the local packages list.
          u := TDubLocalPackages.find(n, o, q, pck);

          // Try to fetch the right version if no match
          if not assigned(u) and dubBuildOptions.autoFetch then
          begin
            with TProcess.Create(nil) do
            try
              Executable := exeFullName('dub' + exeExt);
              Options := Options + [poUsePipes];
              ShowWindow:= swoHIDE;
              Parameters.Add('fetch');
              Parameters.Add(n);
              Parameters.Add('--version=' + p);
              Execute;
              while Running do ;
              if ExitStatus = 0 then
              begin
                TDubLocalPackages.update();
                u := TDubLocalPackages.find(n, o, q, pck);
              end;
            finally
              free;
            end;
          end;

          // Set the imports, used in particular by DCD
          if assigned(u) then
          begin
            for k := 0 to b.Count-1 do
            begin
              s := b[k] + n;
              p :=  s + '-' + u^.asString + DirectorySeparator + n + DirectorySeparator;
              if (p + 'source').dirExists then
              begin
                fImportPaths.Add(p + 'source')  ;
                break;
              end
              else if (p + 'src').dirExists then
              begin
                fImportPaths.Add(p + 'src');
                break;
              end;
            end;
          end;
        end;
      end;
      finally
        b.Free;
      end;
    end;
  end;

var
  conf: TJSONObject;
begin
  if fJSON.isNil then
    exit;

  addFrom(fJSON);
  addDepsFrom(fJSON);
  {$IFDEF WINDOWS}
  addDepsFrom(fJSON, '-windows');
  {$ENDIF}
  {$IFDEF LINUX}
  addDepsFrom(fJSON, '-linux');
  {$ENDIF}
  {$IFDEF DARWIN}
  addDepsFrom(fJSON, '-osx');
  {$ENDIF}
  {$IFDEF UNIX}
  addDepsFrom(fJSON, '-posix');
  {$ENDIF}

  conf := getCurrentCustomConfig;
  if conf.isNotNil then
  begin
    addFrom(conf);
    addDepsFrom(conf);
    {$IFDEF WINDOWS}
    addDepsFrom(conf, '-windows');
    {$ENDIF}
    {$IFDEF LINUX}
    addDepsFrom(conf, '-linux');
    {$ENDIF}
    {$IFDEF DARWIN}
    addDepsFrom(conf, '-osx');
    {$ENDIF}
    {$IFDEF UNIX}
    addDepsFrom(conf, '-posix');
    {$ENDIF}
  end;
end;

procedure TCEDubProject.updateOutputNameFromJson;
var
  conf: TJSONObject;
  item: TJSONData;
  namePart, pathPart: string;
  procedure setFrom(obj: TJSONObject);
  var
    n,p: TJSONData;
  begin
    if obj.findAny('targetPath', p) then
      pathPart := p.AsString;
    if obj.FindAny('targetName', n) then
      namePart := n.AsString;
  end;
begin
  fOutputFileName := '';
  if fJSON.isNil or not fJSON.findAny('name', item) then
    exit;

  namePart := item.AsString;
  pathPart := fBasePath;
  setFrom(fJSON);
  conf := getCurrentCustomConfig;
  if conf.isNotNil then
    setFrom(conf);
  pathPart := TrimRightSet(pathPart, ['/','\']);
  {$IFNDEF WINDOWS}
  if fBinKind in [staticlib, sharedlib] then
    namePart := 'lib' + namePart;
  {$ENDIF}
  fOutputFileName:= pathPart + DirectorySeparator + namePart;
  patchPlateformPath(fOutputFileName);
  fOutputFileName := expandFilenameEx(fBasePath, fOutputFileName);
  case fBinKind of
    executable: fOutputFileName += exeExt;
    staticlib: fOutputFileName += libExt;
    obj: fOutputFileName += objExt;
    sharedlib: fOutputFileName += dynExt;
  end;
end;

procedure TCEDubProject.updateFields;
begin
  updatePackageNameFromJson;
  udpateConfigsFromJson;
  updateSourcesFromJson;
  updateTargetKindFromJson;
  updateImportPathsFromJson;
  updateOutputNameFromJson;
end;

procedure TCEDubProject.beginModification;
begin
  fModificationCount += 1;
end;

procedure TCEDubProject.endModification;
begin
  fModificationCount -=1;
  if fModificationCount <= 0 then
    doModified;
end;

procedure TCEDubProject.doModified;
begin
  fModificationCount := 0;
  fModified:=true;
  updateFields;
  subjProjChanged(fProjectSubject, fAsProjectItf);
end;
{$ENDREGION}

{$REGION Miscellaneous DUB free functions --------------------------------------}
function sdl2json(const filename: string): TJSONObject;
var
  dub: TProcess;
  str: TStringList;
  jsn: TJSONData;
  prs: TJSONParser;
  old: string;
begin
  result := nil;
  dub := TProcess.Create(nil);
  str := TStringList.Create;
  old := GetCurrentDirUTF8;
  try
    SetCurrentDirUTF8(filename.extractFilePath);
    dub.Executable := 'dub' + exeExt;
    dub.Options := [poUsePipes{$IFDEF WINDOWS}, poNewConsole{$ENDIF}];
    dub.ShowWindow := swoHIDE;
    dub.CurrentDirectory:= filename.extractFilePath;
    dub.Parameters.Add('convert');
    dub.Parameters.Add('-s');
    dub.Parameters.Add('-f');
    dub.Parameters.Add('json');
    dub.Execute;
    processOutputToStrings(dub, str);
    while dub.Running do;
    prs := TJSONParser.Create(str.Text, [joIgnoreTrailingComma, joUTF8]);
    try
      try
        jsn := prs.Parse;
        try
          if jsn.isNotNil then
            result := TJSONObject(jsn.Clone)
          else
            result := nil;
        finally
          jsn.free;
        end;
      finally
        prs.Free
      end;
    except
      result := nil;
    end;
  finally
    SetCurrentDirUTF8(old);
    dub.free;
    str.Free;
  end;
end;

function isValidDubProject(const filename: string): boolean;
var
  maybe: TCEDubProject;
  ext: string;
begin
  ext := filename.extractFileExt.upperCase;
  if (ext <> '.JSON') and (ext <> '.SDL') then
    exit(false);
  result := true;
  // avoid the project to notify the observers, current project is not replaced
  EntitiesConnector.beginUpdate;
  maybe := TCEDubProject.create(nil);
  try
    try
      maybe.loadFromFile(filename);
      if maybe.json.isNil or maybe.filename.isEmpty then
        result := false
      else if maybe.json.Find('name').isNil then
        result := false;
    except
      result := false;
    end;
  finally
    maybe.Free;
    EntitiesConnector.endUpdate;
  end;
end;

function getDubCompiler: DCompiler;
begin
  exit(DubCompiler);
end;

procedure setDubCompiler(value: DCompiler);
var
  sel: ICECompilerSelector;
begin
  sel := getCompilerSelector;
  DubCompiler := value;
  if not sel.isCompilerValid(DubCompiler) then
    DubCompiler := dmd;
  DubCompilerFilename:=sel.getCompilerPath(DubCompiler);
end;
{$ENDREGION}

initialization
  setDubCompiler(dmd);
  dubBuildOptions:= TCEDubBuildOptions.create(nil);
finalization
  dubBuildOptions.free;
  TDubLocalPackages.deinit;
end.