fastway-plugin-sdk/dbapi_dialect.pas

{
  dbapi_dialect.pas — Core interfaces and spec types for the DBAPI
  framework.

  Defines:
    - TDBAColumnSpec / TDBATableSpec / TDBAIndexSpec — declarative schema
    - TDBACriterion hierarchy — WHERE clause builder (Compare + Compound)
    - TDBASelectSpec — structured SELECT spec
    - IDBADialect — interface every backend dialect implements
    - TDBADialectBase — abstract base class with shared helpers; concrete
      dialects inherit from this to get lifecycle, hooks, param handling

  A concrete dialect (SQLite/MariaDB/Postgres) lives in its own unit and
  overrides the emitter and execution methods. Consumers never touch a
  concrete class after construction — they hold an IDBADialect and the
  refcount handles cleanup.

  No Fastway-specific dependencies: only FPC RTL + fpjson + sqldb.
}
unit dbapi_dialect;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpjson, sqldb, db,
  dbapi_consts, dbapi_hooks;

type
  { What happens to child rows when the parent is deleted. }
  TDBAOnDeleteAction = (
    doaNoAction,    { Default per-backend; typically rejects }
    doaCascade,     { Delete child rows too }
    doaSetNull,     { Null out the FK column }
    doaRestrict,    { Explicit reject; fail the delete }
    doaSetDefault   { Set FK column back to its default }
  );

  { Foreign key descriptor embedded in a column spec. RefTable empty
    means no FK on this column. }
  TDBAForeignKey = record
    RefTable: string;
    RefColumn: string;
    OnDelete: TDBAOnDeleteAction;
  end;

  { Single column definition. Use MakeColumn for common cases, or
    construct the record directly to set ForeignKey / CaseInsensitive. }
  TDBAColumnSpec = record
    Name: string;
    ColType: TDBAColumnType;
    Length: Integer;            { For dctVarchar; 0 = dialect default }
    Nullable: Boolean;
    DefaultExpr: string;        { Literal SQL fragment; empty = no default }
    PrimaryKey: Boolean;        { Single-column PK shortcut }
    Unique: Boolean;
    AutoIncrement: Boolean;     { Only honored when PrimaryKey and Integer/BigInt }
    CaseInsensitive: Boolean;   { Emits backend-appropriate collation }
    ForeignKey: TDBAForeignKey; { Zero-value = no FK }
  end;

  { Multi-column index. Unique flag marks it as a UNIQUE index.
    Indexes created separately from the table via CREATE INDEX. }
  TDBAIndexSpec = record
    Name: string;
    Columns: array of string;
    Unique: Boolean;
  end;

  { Composite UNIQUE constraint inside the CREATE TABLE statement.
    Unlike TDBAIndexSpec, this is part of the table schema (not a
    separate index), which is how SQLite requires it for INSERT OR
    IGNORE / ON CONFLICT semantics to work. }
  TDBAUniqueConstraint = record
    Name: string;                { Optional; dialect may synthesize }
    Columns: array of string;
  end;

  { Full table definition. PrimaryKeyColumns is used when the PK spans
    multiple columns; if empty, any column with PrimaryKey=True becomes
    the PK. }
  TDBATableSpec = record
    Name: string;
    Columns: array of TDBAColumnSpec;
    Indexes: array of TDBAIndexSpec;
    UniqueConstraints: array of TDBAUniqueConstraint;
    PrimaryKeyColumns: array of string;
  end;

  { --- Criteria (WHERE clause tree) ---

    Abstract base + two concrete subclasses. Classes (not records)
    because the tree is polymorphic: a Compound node holds children
    that can be Compare or more Compound.

    Ownership: the criterion tree is consumer-owned. A compound node
    takes ownership of its children when Add is called — freeing the
    root frees the whole tree. }
  TDBACriterion = class
  public
    { Dialect-agnostic. Concrete dialects translate via WhereToSQL. }
  end;

  TDBACompareCriterion = class(TDBACriterion)
  private
    FColumn: string;
    FOp: TDBACompareOp;
    FValue: TJSONData;        { Owned if FOwnsValue; may be nil for IsNull/IsNotNull }
    FOwnsValue: Boolean;
  public
    constructor Create(const AColumn: string; AOp: TDBACompareOp);
    constructor CreateCmp(const AColumn: string; AOp: TDBACompareOp;
                          AValue: TJSONData; AOwnsValue: Boolean = True);
    destructor Destroy; override;
    property Column: string read FColumn;
    property Op: TDBACompareOp read FOp;
    property Value: TJSONData read FValue;
  end;

  TDBACompoundCriterion = class(TDBACriterion)
  private
    FOp: TDBABoolOp;
    FChildren: TList;  { Owned TDBACriterion references }
  public
    constructor Create(AOp: TDBABoolOp);
    destructor Destroy; override;
    procedure Add(AChild: TDBACriterion);     { Takes ownership }
    function ChildCount: Integer;
    function Child(AIndex: Integer): TDBACriterion;
    property BoolOp: TDBABoolOp read FOp;
  end;

  { One ORDER BY element. }
  TDBAOrderSpec = record
    Column: string;
    Direction: TDBAOrderDir;
  end;

  { Full SELECT spec. Columns empty = SELECT *. Where nil = no WHERE.
    Limit 0 = no limit. Offset 0 = no offset. }
  TDBASelectSpec = record
    Table: string;
    Columns: array of string;
    Where: TDBACriterion;    { Consumer-owned, not freed by dialect }
    OrderBy: array of TDBAOrderSpec;
    Limit: Integer;
    Offset: Integer;
  end;

  { Public interface. Consumer code holds IDBADialect, refcount manages
    instance lifetime. }
  IDBADialect = interface
    ['{3F1E4A20-5B7C-4D18-9B2A-7E3A6C8D1F01}']
    function Backend: TDBABackend;
    function ServerFlavor: string;
    function Hooks: TDBAHookRegistry;
    function Connection: TSQLConnection;
    function Owned: Boolean;
    function IsConnected: Boolean;

    procedure Connect;
    procedure Disconnect;

    function QuoteIdent(const AName: string): string;
    function NowExpr: string;
    function DateAddExpr(AAmount: Integer; AUnit: TDBADateUnit): string;
    function AutoIncPrimaryKey(AType: TDBAColumnType): string;
    function SqlType(AType: TDBAColumnType; ALength: Integer): string;
    function BooleanLiteral(AValue: Boolean): string;
    function UpsertStmt(const ATable: string; const AAllCols, AKeyCols: array of string): string;
    function InsertReturningIdClause: string;
    function WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string;

    { Collation clause fragment for a case-sensitive vs case-insensitive
      column. Returns an empty string for sensitive, or a backend-
      appropriate clause like ' COLLATE NOCASE'. The leading space is
      included so callers can concatenate directly. }
    function CollationClause(ACaseInsensitive: Boolean): string;

    { Text rendering of an ON DELETE clause for an FK (e.g. 'CASCADE',
      'SET NULL'). Returns empty string for doaNoAction. }
    function OnDeleteAction(AAction: TDBAOnDeleteAction): string;

    { Emit a statement that inserts a row, silently ignoring uniqueness
      conflicts. Backend-specific: INSERT OR IGNORE (SQLite),
      INSERT IGNORE (MariaDB), INSERT ... ON CONFLICT DO NOTHING (PG). }
    function InsertOrIgnoreStmt(const ATable: string; const ACols: array of string): string;

    procedure ExecSQL(const ASQL: string; AParams: TJSONArray);
    function QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray;
    function GetLastInsertID: Int64;

    function TableExists(const AName: string): Boolean;
    function GetColumns(const ATable: string): TJSONArray;
  end;

  { Abstract base class. Concrete dialects inherit. Implements IDBADialect
    via the class, so descendants only override what they need. }
  TDBADialectBase = class(TInterfacedObject, IDBADialect)
  protected
    FConnection: TSQLConnection;
    FTransaction: TSQLTransaction;
    FOwnsConnection: Boolean;
    FHooks: TDBAHookRegistry;
    FServerFlavor: string;
    FConnected: Boolean;

    procedure AttachConnection(AConn: TSQLConnection; AOwns: Boolean);
    procedure FireQueryLog(const ASQL: string; ADurationMS: Int64;
                           AParams: TJSONArray; ARowsAffected: Integer);
  public
    constructor Create;
    destructor Destroy; override;

    function Backend: TDBABackend; virtual; abstract;
    function ServerFlavor: string;
    function Hooks: TDBAHookRegistry;
    function Connection: TSQLConnection;
    function Owned: Boolean;
    function IsConnected: Boolean;

    procedure Connect; virtual;
    procedure Disconnect; virtual;

    function QuoteIdent(const AName: string): string; virtual; abstract;
    function NowExpr: string; virtual; abstract;
    function DateAddExpr(AAmount: Integer; AUnit: TDBADateUnit): string; virtual; abstract;
    function AutoIncPrimaryKey(AType: TDBAColumnType): string; virtual; abstract;
    function SqlType(AType: TDBAColumnType; ALength: Integer): string; virtual; abstract;
    function BooleanLiteral(AValue: Boolean): string; virtual; abstract;
    function UpsertStmt(const ATable: string; const AAllCols, AKeyCols: array of string): string; virtual; abstract;
    function InsertReturningIdClause: string; virtual;

    function WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string; virtual;

    function CollationClause(ACaseInsensitive: Boolean): string; virtual;
    function OnDeleteAction(AAction: TDBAOnDeleteAction): string; virtual;
    function InsertOrIgnoreStmt(const ATable: string; const ACols: array of string): string; virtual;

    procedure ExecSQL(const ASQL: string; AParams: TJSONArray); virtual;
    function QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray; virtual;
    function GetLastInsertID: Int64; virtual; abstract;

    function TableExists(const AName: string): Boolean; virtual; abstract;
    function GetColumns(const ATable: string): TJSONArray; virtual; abstract;
  end;

{ --- Spec builder helpers.

  Records can't have constructors in mode objfpc, so we provide free
  functions for ergonomic construction. Consumer code reads naturally:

    Spec.Columns := [
      MakeColumn('id', dctBigInt, 0, False, '', True, True, True),
      MakeColumn('name', dctVarchar, 255, False),
      MakeColumn('created_at', dctDateTime, 0, False)
    ]; }

function MakeColumn(const AName: string; AType: TDBAColumnType;
                    ALength: Integer = 0; ANullable: Boolean = True;
                    const ADefault: string = ''; APrimaryKey: Boolean = False;
                    AUnique: Boolean = False; AAutoIncrement: Boolean = False): TDBAColumnSpec;

function MakeIndex(const AName: string; const AColumns: array of string;
                   AUnique: Boolean = False): TDBAIndexSpec;

function MakeOrder(const AColumn: string; ADir: TDBAOrderDir = dodAsc): TDBAOrderSpec;

{ Build a foreign key descriptor. Attach it to a column's ForeignKey
  field. Example:
    Col := MakeColumn('user_id', dctInteger, 0, True);
    Col.ForeignKey := MakeFK('users', 'id', doaSetNull); }
function MakeFK(const ARefTable, ARefColumn: string;
                AOnDelete: TDBAOnDeleteAction = doaNoAction): TDBAForeignKey;

{ Build a composite UNIQUE constraint. }
function MakeUnique(const AName: string; const AColumns: array of string): TDBAUniqueConstraint;

{ --- Criteria builder helpers. }

function Cmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData): TDBACompareCriterion;
function CmpStr(const AColumn: string; AOp: TDBACompareOp; const AValue: string): TDBACompareCriterion;
function CmpInt(const AColumn: string; AOp: TDBACompareOp; AValue: Int64): TDBACompareCriterion;
function CmpBool(const AColumn: string; AOp: TDBACompareOp; AValue: Boolean): TDBACompareCriterion;
function IsNull(const AColumn: string): TDBACompareCriterion;
function IsNotNull(const AColumn: string): TDBACompareCriterion;

{ Build a compound. Pass children; builder takes ownership. }
function AndOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion;
function OrOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion;

implementation

uses
  DateUtils;

{ --- Spec builders --- }

function MakeColumn(const AName: string; AType: TDBAColumnType;
                    ALength: Integer; ANullable: Boolean;
                    const ADefault: string; APrimaryKey: Boolean;
                    AUnique: Boolean; AAutoIncrement: Boolean): TDBAColumnSpec;
begin
  Result.Name := AName;
  Result.ColType := AType;
  Result.Length := ALength;
  Result.Nullable := ANullable;
  Result.DefaultExpr := ADefault;
  Result.PrimaryKey := APrimaryKey;
  Result.Unique := AUnique;
  Result.AutoIncrement := AAutoIncrement;
  Result.CaseInsensitive := False;
  Result.ForeignKey.RefTable := '';
  Result.ForeignKey.RefColumn := '';
  Result.ForeignKey.OnDelete := doaNoAction;
end;

function MakeIndex(const AName: string; const AColumns: array of string;
                   AUnique: Boolean): TDBAIndexSpec;
var
  I: Integer;
begin
  Result.Name := AName;
  SetLength(Result.Columns, Length(AColumns));
  for I := 0 to High(AColumns) do
    Result.Columns[I] := AColumns[I];
  Result.Unique := AUnique;
end;

function MakeOrder(const AColumn: string; ADir: TDBAOrderDir): TDBAOrderSpec;
begin
  Result.Column := AColumn;
  Result.Direction := ADir;
end;

function MakeFK(const ARefTable, ARefColumn: string; AOnDelete: TDBAOnDeleteAction): TDBAForeignKey;
begin
  Result.RefTable := ARefTable;
  Result.RefColumn := ARefColumn;
  Result.OnDelete := AOnDelete;
end;

function MakeUnique(const AName: string; const AColumns: array of string): TDBAUniqueConstraint;
var
  I: Integer;
begin
  Result.Name := AName;
  SetLength(Result.Columns, Length(AColumns));
  for I := 0 to High(AColumns) do
    Result.Columns[I] := AColumns[I];
end;

{ --- Criteria builders --- }

function Cmp(const AColumn: string; AOp: TDBACompareOp; AValue: TJSONData): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, AValue, True);
end;

function CmpStr(const AColumn: string; AOp: TDBACompareOp; const AValue: string): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONString.Create(AValue), True);
end;

function CmpInt(const AColumn: string; AOp: TDBACompareOp; AValue: Int64): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONInt64Number.Create(AValue), True);
end;

function CmpBool(const AColumn: string; AOp: TDBACompareOp; AValue: Boolean): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.CreateCmp(AColumn, AOp, TJSONBoolean.Create(AValue), True);
end;

function IsNull(const AColumn: string): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.Create(AColumn, dcoIsNull);
end;

function IsNotNull(const AColumn: string): TDBACompareCriterion;
begin
  Result := TDBACompareCriterion.Create(AColumn, dcoIsNotNull);
end;

function AndOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion;
var
  I: Integer;
begin
  Result := TDBACompoundCriterion.Create(dboAnd);
  for I := 0 to High(AChildren) do
    Result.Add(AChildren[I]);
end;

function OrOf(const AChildren: array of TDBACriterion): TDBACompoundCriterion;
var
  I: Integer;
begin
  Result := TDBACompoundCriterion.Create(dboOr);
  for I := 0 to High(AChildren) do
    Result.Add(AChildren[I]);
end;

{ --- TDBACompareCriterion --- }

constructor TDBACompareCriterion.Create(const AColumn: string; AOp: TDBACompareOp);
begin
  inherited Create;
  FColumn := AColumn;
  FOp := AOp;
  FValue := nil;
  FOwnsValue := False;
end;

constructor TDBACompareCriterion.CreateCmp(const AColumn: string; AOp: TDBACompareOp;
                                           AValue: TJSONData; AOwnsValue: Boolean);
begin
  inherited Create;
  FColumn := AColumn;
  FOp := AOp;
  FValue := AValue;
  FOwnsValue := AOwnsValue;
end;

destructor TDBACompareCriterion.Destroy;
begin
  if FOwnsValue and Assigned(FValue) then
    FValue.Free;
  inherited Destroy;
end;

{ --- TDBACompoundCriterion --- }

constructor TDBACompoundCriterion.Create(AOp: TDBABoolOp);
begin
  inherited Create;
  FOp := AOp;
  FChildren := TList.Create;
end;

destructor TDBACompoundCriterion.Destroy;
var
  I: Integer;
begin
  for I := 0 to FChildren.Count - 1 do
    TDBACriterion(FChildren[I]).Free;
  FChildren.Free;
  inherited Destroy;
end;

procedure TDBACompoundCriterion.Add(AChild: TDBACriterion);
begin
  if Assigned(AChild) then
    FChildren.Add(AChild);
end;

function TDBACompoundCriterion.ChildCount: Integer;
begin
  Result := FChildren.Count;
end;

function TDBACompoundCriterion.Child(AIndex: Integer): TDBACriterion;
begin
  Result := TDBACriterion(FChildren[AIndex]);
end;

{ --- TDBADialectBase --- }

constructor TDBADialectBase.Create;
begin
  inherited Create;
  FHooks := TDBAHookRegistry.Create;
  FConnection := nil;
  FTransaction := nil;
  FOwnsConnection := False;
  FConnected := False;
end;

destructor TDBADialectBase.Destroy;
begin
  if FConnected then
  begin
    try
      Disconnect;
    except
      { Swallow — destructor must not raise. }
    end;
  end;
  if FOwnsConnection then
  begin
    if Assigned(FTransaction) then FTransaction.Free;
    if Assigned(FConnection) then FConnection.Free;
  end;
  FHooks.Free;
  inherited Destroy;
end;

procedure TDBADialectBase.AttachConnection(AConn: TSQLConnection; AOwns: Boolean);
begin
  FConnection := AConn;
  FOwnsConnection := AOwns;
  if AOwns then
  begin
    FTransaction := TSQLTransaction.Create(nil);
    FTransaction.Database := FConnection;
    FConnection.Transaction := FTransaction;
  end
  else
  begin
    { Adopt mode: consumer manages transactions. Use whatever transaction
      is attached to the connection, if any. If none, share a transaction
      but don't own it. }
    FTransaction := FConnection.Transaction as TSQLTransaction;
  end;
end;

function TDBADialectBase.ServerFlavor: string;
begin
  Result := FServerFlavor;
end;

function TDBADialectBase.Hooks: TDBAHookRegistry;
begin
  Result := FHooks;
end;

function TDBADialectBase.Connection: TSQLConnection;
begin
  Result := FConnection;
end;

function TDBADialectBase.Owned: Boolean;
begin
  Result := FOwnsConnection;
end;

function TDBADialectBase.IsConnected: Boolean;
begin
  Result := FConnected and Assigned(FConnection) and FConnection.Connected;
end;

procedure TDBADialectBase.Connect;
var
  Q: TSQLQuery;
begin
  if FConnected then Exit;
  if not Assigned(FConnection) then
    raise EDatabaseError.Create('dbapi: dialect has no connection attached');
  if FOwnsConnection then
    FConnection.Open;
  FConnected := True;

  { Detect server flavor. Each backend has its own way to get a version
    string; the generic approach works for all three (SELECT VERSION()
    on MariaDB/PG; SELECT sqlite_version() on SQLite handled by override). }
  Q := TSQLQuery.Create(nil);
  try
    Q.Database := FConnection;
    Q.Transaction := FTransaction;
    try
      Q.SQL.Text := 'SELECT VERSION()';
      Q.Open;
      if not Q.EOF then
        FServerFlavor := Q.Fields[0].AsString;
      Q.Close;
    except
      { SQLite doesn't implement VERSION() — descendants override Connect
        for backend-specific version detection. Silence this attempt. }
      FServerFlavor := '';
    end;
  finally
    Q.Free;
  end;

  FHooks.FireConnect(FServerFlavor);
end;

procedure TDBADialectBase.Disconnect;
begin
  if not FConnected then Exit;
  FConnected := False;
  if FOwnsConnection and Assigned(FConnection) and FConnection.Connected then
    FConnection.Close;
  FHooks.FireDisconnect('requested');
end;

function TDBADialectBase.InsertReturningIdClause: string;
begin
  { Default: no RETURNING. Postgres overrides. }
  Result := '';
end;

function TDBADialectBase.CollationClause(ACaseInsensitive: Boolean): string;
begin
  { Default: no collation. Concrete dialects override. }
  Result := '';
end;

function TDBADialectBase.OnDeleteAction(AAction: TDBAOnDeleteAction): string;
begin
  { Default: ANSI-compliant keywords. All three backends accept these. }
  case AAction of
    doaCascade:    Result := 'CASCADE';
    doaSetNull:    Result := 'SET NULL';
    doaRestrict:   Result := 'RESTRICT';
    doaSetDefault: Result := 'SET DEFAULT';
  else
    Result := '';  { doaNoAction — emit nothing }
  end;
end;

function TDBADialectBase.InsertOrIgnoreStmt(const ATable: string;
                                            const ACols: array of string): string;
var
  ColList, ValList: string;
  I: Integer;
begin
  { Default uses the PG-style ON CONFLICT DO NOTHING which requires a
    unique constraint match. Concrete dialects override for SQLite/MariaDB
    which have shorter syntax (INSERT OR IGNORE / INSERT IGNORE). }
  ColList := '';
  ValList := '';
  for I := 0 to High(ACols) do
  begin
    if ColList <> '' then
    begin
      ColList := ColList + ', ';
      ValList := ValList + ', ';
    end;
    ColList := ColList + QuoteIdent(ACols[I]);
    ValList := ValList + ':p' + IntToStr(I + 1);
  end;
  Result := 'INSERT INTO ' + QuoteIdent(ATable) +
            ' (' + ColList + ') VALUES (' + ValList + ') ON CONFLICT DO NOTHING';
end;

procedure TDBADialectBase.FireQueryLog(const ASQL: string; ADurationMS: Int64;
                                       AParams: TJSONArray; ARowsAffected: Integer);
begin
  FHooks.FireAfterQuery(ASQL, AParams, ADurationMS, ARowsAffected);
end;

{ Bind TJSONArray positional parameters to a TSQLQuery using ?1, ?2, etc.
  Caller is responsible for param count matching SQL placeholders. }
procedure BindJsonParams(AQuery: TSQLQuery; AParams: TJSONArray);
var
  I: Integer;
  PName: string;
  V: TJSONData;
begin
  if not Assigned(AParams) then Exit;
  for I := 0 to AParams.Count - 1 do
  begin
    PName := 'p' + IntToStr(I + 1);
    if AQuery.Params.FindParam(PName) = nil then Continue;
    V := AParams.Items[I];
    if (V = nil) or (V.JSONType = jtNull) then
      AQuery.Params.ParamByName(PName).Clear
    else
      case V.JSONType of
        jtString:  AQuery.Params.ParamByName(PName).AsString := V.AsString;
        jtNumber:
          if V is TJSONFloatNumber then
            AQuery.Params.ParamByName(PName).AsFloat := V.AsFloat
          else
            AQuery.Params.ParamByName(PName).AsLargeInt := V.AsInt64;
        jtBoolean: AQuery.Params.ParamByName(PName).AsBoolean := V.AsBoolean;
      else
        AQuery.Params.ParamByName(PName).AsString := V.AsJSON;
      end;
  end;
end;

procedure TDBADialectBase.ExecSQL(const ASQL: string; AParams: TJSONArray);
var
  Q: TSQLQuery;
  StartTick: QWord;
  Cancel, Handled: Boolean;
  RowsAffected: Integer;
begin
  Cancel := False;
  FHooks.FireBeforeQuery(ASQL, AParams, Cancel);
  if Cancel then Exit;

  StartTick := GetTickCount64;
  Q := TSQLQuery.Create(nil);
  try
    Q.Database := FConnection;
    Q.Transaction := FTransaction;
    Q.SQL.Text := ASQL;
    BindJsonParams(Q, AParams);
    try
      Q.ExecSQL;
      RowsAffected := Q.RowsAffected;
      if FOwnsConnection then FTransaction.CommitRetaining;
    except
      on E: Exception do
      begin
        Handled := False;
        FHooks.FireError(ASQL, E.Message, Handled);
        if not Handled then raise;
        RowsAffected := -1;
      end;
    end;
    FireQueryLog(ASQL, Int64(GetTickCount64 - StartTick), AParams, RowsAffected);
  finally
    Q.Free;
  end;
end;

function TDBADialectBase.QuerySQL(const ASQL: string; AParams: TJSONArray): TJSONArray;
var
  Q: TSQLQuery;
  Row: TJSONObject;
  StartTick: QWord;
  Cancel, Handled: Boolean;
  I: Integer;
  F: TField;
begin
  Result := TJSONArray.Create;
  Cancel := False;
  FHooks.FireBeforeQuery(ASQL, AParams, Cancel);
  if Cancel then Exit;

  StartTick := GetTickCount64;
  Q := TSQLQuery.Create(nil);
  try
    Q.Database := FConnection;
    Q.Transaction := FTransaction;
    Q.SQL.Text := ASQL;
    BindJsonParams(Q, AParams);
    try
      Q.Open;
      while not Q.EOF do
      begin
        Row := TJSONObject.Create;
        for I := 0 to Q.FieldCount - 1 do
        begin
          F := Q.Fields[I];
          if F.IsNull then
            Row.Add(F.FieldName, TJSONNull.Create)
          else
            case F.DataType of
              ftSmallint, ftInteger, ftAutoInc, ftWord:
                Row.Add(F.FieldName, F.AsInteger);
              ftLargeint:
                Row.Add(F.FieldName, F.AsLargeInt);
              ftFloat, ftCurrency, ftBCD:
                Row.Add(F.FieldName, F.AsFloat);
              ftBoolean:
                Row.Add(F.FieldName, F.AsBoolean);
              ftDate, ftTime, ftDateTime, ftTimeStamp:
                Row.Add(F.FieldName, F.AsString);
            else
              Row.Add(F.FieldName, F.AsString);
            end;
        end;
        Result.Add(Row);
        Q.Next;
      end;
      Q.Close;
    except
      on E: Exception do
      begin
        Handled := False;
        FHooks.FireError(ASQL, E.Message, Handled);
        if not Handled then
        begin
          Result.Free;
          Result := nil;
          raise;
        end;
      end;
    end;
    FireQueryLog(ASQL, Int64(GetTickCount64 - StartTick), AParams, -1);
  finally
    Q.Free;
  end;
end;

function TDBADialectBase.WhereToSQL(ACriterion: TDBACriterion; AParams: TJSONArray): string;

  function EmitCompare(C: TDBACompareCriterion): string;
  var
    PIdx: Integer;
    VStr: string;
    InArr: TJSONArray;
    I: Integer;
    FirstCol: string;
  begin
    FirstCol := QuoteIdent(C.Column);
    case C.Op of
      dcoIsNull:    Result := FirstCol + ' IS NULL';
      dcoIsNotNull: Result := FirstCol + ' IS NOT NULL';
      dcoIn, dcoNotIn:
        begin
          if not (C.Value is TJSONArray) then
          begin
            Result := '1=0';
            Exit;
          end;
          InArr := TJSONArray(C.Value);
          if InArr.Count = 0 then
          begin
            if C.Op = dcoIn then Result := '1=0' else Result := '1=1';
            Exit;
          end;
          VStr := '';
          for I := 0 to InArr.Count - 1 do
          begin
            if VStr <> '' then VStr := VStr + ', ';
            AParams.Add(InArr.Items[I].Clone);
            PIdx := AParams.Count;
            VStr := VStr + ':p' + IntToStr(PIdx);
          end;
          if C.Op = dcoIn then
            Result := FirstCol + ' IN (' + VStr + ')'
          else
            Result := FirstCol + ' NOT IN (' + VStr + ')';
        end;
      dcoILike:
        begin
          { Default: case-insensitive via LOWER(). PG overrides with ILIKE. }
          AParams.Add(C.Value.Clone);
          PIdx := AParams.Count;
          Result := 'LOWER(' + FirstCol + ') LIKE LOWER(:p' + IntToStr(PIdx) + ')';
        end;
    else
      AParams.Add(C.Value.Clone);
      PIdx := AParams.Count;
      VStr := ':p' + IntToStr(PIdx);
      case C.Op of
        dcoEq:   Result := FirstCol + ' = ' + VStr;
        dcoNeq:  Result := FirstCol + ' <> ' + VStr;
        dcoLt:   Result := FirstCol + ' < ' + VStr;
        dcoLe:   Result := FirstCol + ' <= ' + VStr;
        dcoGt:   Result := FirstCol + ' > ' + VStr;
        dcoGe:   Result := FirstCol + ' >= ' + VStr;
        dcoLike: Result := FirstCol + ' LIKE ' + VStr;
      else
        Result := '1=0';
      end;
    end;
  end;

  function EmitCompound(C: TDBACompoundCriterion): string;
  var
    I: Integer;
    Sep, Part: string;
  begin
    if C.ChildCount = 0 then
    begin
      Result := '1=1';
      Exit;
    end;
    if C.BoolOp = dboAnd then Sep := ' AND ' else Sep := ' OR ';
    Result := '';
    for I := 0 to C.ChildCount - 1 do
    begin
      Part := WhereToSQL(C.Child(I), AParams);
      if Part = '' then Continue;
      if Result <> '' then Result := Result + Sep;
      Result := Result + '(' + Part + ')';
    end;
    if Result = '' then Result := '1=1';
  end;

begin
  if ACriterion = nil then
  begin
    Result := '';
    Exit;
  end;
  if ACriterion is TDBACompareCriterion then
    Result := EmitCompare(TDBACompareCriterion(ACriterion))
  else if ACriterion is TDBACompoundCriterion then
    Result := EmitCompound(TDBACompoundCriterion(ACriterion))
  else
    Result := '';
end;

end.