pas2js/packages/fcl-db/jsondataset.pas

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2019 by Michael Van Canneyt, member of the
    Free Pascal development team

    Simple JSON dataset component.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$mode objfpc}

unit JSONDataset;

interface

uses
  Types, JS, DB, Classes, SysUtils, typinfo, fpexprpars;

type
  TBaseJSONDataset = Class;
  TJSONIndexDef = class;

  // How are rows encoded in the JSON ?
  TJSONRowType = (rtJSONObject, // Each row is an object.
                  rtJSONArray   // Each row is an array.
                  );

  { TJSONFieldMapper }
  // This class is responsible for mapping the field objects of the records.
  TJSONFieldMapper = Class(TObject)
  Public
    // Remove a field from the
    Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); virtual; abstract;
    // Return row TJSONData instance with data for field 'FieldName' or 'FieldIndex'.
    Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : JSValue) : JSValue; virtual; abstract;
    // Same, but now based on TField.
    Function GetJSONDataForField(F : TField; Row : JSValue) : JSValue; virtual;
    // Set data for field 'FieldName' or 'FieldIndex' to supplied TJSONData instance in row
    procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : JSValue); virtual; abstract;
    // Set data for field TField to supplied TJSONData instance
    procedure SetJSONDataForField(F : TField; Row,Data : JSValue); virtual;
    // Create a new row.
    Function CreateRow : JSValue; virtual; abstract;
  end;

  // JSON has no date/time type, so we use a string field.
  // ExtJS provides the date/time  format in it's field config: 'dateFormat'
  // The below field classes store this in the NNNFormat field.
  { TJSONDateField }

  TJSONDateField = Class(TDateField)
  private
    FDateFormat: String;
  Published
    Property DateFormat : String Read FDateFormat Write FDateFormat;
  end;

  { TJSONTimeField }

  TJSONTimeField = Class(TTimeField)
  private
    FTimeFormat: String;
  Published
    Property TimeFormat : String Read FTimeFormat Write FTimeFormat;
  end;

  { TJSONDateTimeField }

  TJSONDateTimeField = Class(TDateTimeField)
  private
    FDateTimeFormat: String;
  Published
    Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
  end;

  { TFieldComparer }

  TFieldComparer = Class
  Private
    FDesc: Boolean;
    FValue : JSValue;
    FField : TField;
    FOptions : TLocateOptions;
    FDataset : TBaseJSONDataset;
  Public
    Constructor Create(aDataset : TBaseJSONDataset; aField : TField; aValue : JSValue; aOptions : TLocateOptions);
    Function GetFieldValue(RowIndex : integer) : JSValue;
    Function CompareRows (RowIndex1,RowIndex2 : Integer) : Integer; virtual;
    // First value is always dataset value.
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; virtual; abstract;
    Function Compare (RowIndex : Integer) : Integer; virtual;
    Property Value : JSValue read FValue Write FValue;
    Property Options : TLocateOptions Read FOptions Write FOptions;
    Property Dataset : TBaseJSONDataset Read FDataset;
    Property Field : TField Read FField;
    Property Desc : Boolean Read FDesc Write FDesc;
  end;
  TFieldComparerClass = Class of TFieldComparer;

  { TStringFieldComparer }

  TStringFieldComparer = Class (TFieldComparer)
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  end;

  { TNativeIntFieldComparer }

  TNativeIntFieldComparer = Class (TFieldComparer)
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  end;

  { TBooleanFieldComparer }

  TBooleanFieldComparer = Class (TFieldComparer)
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  end;

  { TDateTimeFieldComparer }

  TDateTimeFieldComparer = Class (TFieldComparer)
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  end;

  { TFloatFieldComparer }

  TFloatFieldComparer = Class (TFieldComparer)
    Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  end;

  { TRecordComparer }

  TRecordComparer = class
  private
    FDataset: TBaseJSONDataset;
    FIndexBased: Boolean;
    FItems : Array of TFieldComparer;
    FOptions: TLocateOptions;
    FValues: TJSValueDynArray;
    function GetFieldComparer(Index : Integer): TFieldComparer;
  Protected
    procedure ConstructItems(aFields: String); virtual;
    function DataTypeToComparerClass(aFieldType: TFieldType): TFieldComparerClass;
    Function Compare(aRowindex : integer) : Integer;
    Function CompareRows(aRowindex1,aRowIndex2 : integer) : Integer;
    procedure updateFromIndex(aIndex : TJSONIndexDef); virtual;
  Public
    Constructor Create(aDataset : TBaseJSONDataset; aFields : String; aValues : JSValue; aOptions : TLocateOptions);
    Constructor Create(aDataset : TBaseJSONDataset; aIndex : TJSONIndexDef);
    Destructor Destroy; override;
    Property Dataset : TBaseJSONDataset Read FDataset;
    property Items [Index : Integer] : TFieldComparer Read GetFieldComparer;
    Property Options : TLocateOptions Read FOptions Write FOptions;
    Property Values : TJSValueDynArray Read FValues;
    Property IndexBased : Boolean Read FIndexBased;
  end;
  TRecordComparerClass = Class of TRecordComparer;

  { TBaseJSONDataSet }

  { TJSONIndex }

  TJSONIndex = Class
    FList : TJSArray; // Indexes of elements in FRows.
    FRows : TJSArray;
    FDataset : TBaseJSONDataset;
  private
    function GetRecordIndex(aListIndex : Integer): NativeInt;
  protected
    Function GetCount: Integer; virtual;
    Procedure CreateIndex; Virtual; abstract;
    Property List : TJSArray Read FList;
    Property Rows : TJSArray Read FRows;
    Property Dataset : TBaseJSONDataset Read FDataset;
  Public
    Constructor Create(aDataset: TBaseJSONDataset; aRows : TJSArray); reintroduce;
    // Append remainder of FRows to FList.
    Procedure AppendToIndex; virtual; abstract;
    // Delete aListIndex from list, not from row. Return Recordindex of deleted record.
    Function Delete(aListIndex : Integer) : Integer; virtual;
    // Append aRecordIndex to list. Return ListIndex of appended record.
    Function Append(aRecordIndex : Integer) : Integer; virtual; abstract;
    // Insert record into list. By default, this does an append. Return ListIndex of inserted record
    Function Insert(aCurrentIndex{%H-}, aRecordIndex : Integer) : Integer; virtual;
    // Record at index aCurrentIndex has changed. Update index and return new listindex.
    Function Update(aRecordIndex : Integer) : Integer; virtual; abstract;
    // Find list index for Record at index aCurrentIndex. Return -1 if not found.
    Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
    // index of record in FRows based on aListIndex in List.
    Property RecordIndex[aListIndex : Integer] : NativeInt Read GetRecordIndex;
    // Number of records in index. This can differ from FRows, e.g. when filtering.
    Property Count : Integer Read GetCount;
  end;

  { TDefaultJSONIndex }

  TDefaultJSONIndex = Class(TJSONIndex)
  public
    Procedure CreateIndex; override;
    Procedure AppendToIndex; override;
    Function Append(aRecordIndex : Integer) : Integer; override;
    Function Insert(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
    Function FindRecord(aRecordIndex : Integer) : Integer; override;
    Function Update(aRecordIndex : Integer) : Integer; override;
  end;

  { TSortedJSONIndex }

  TSortedJSONIndex = Class(TJSONIndex)
  Private
    FComparer : TRecordComparer;
    FUnique: Boolean;
    function FindPos(aRecordIndex: Integer): Integer;
    function MergeSort(aList: TJSArray): TJSArray;
  Protected
    Property Comparer : TRecordComparer Read FComparer Write FComparer;
  public
    Destructor Destroy; override;
    procedure CreateComparer(aIndex: TJSONIndexDef);
    Procedure CreateIndex; override;
    Procedure AppendToIndex; override;
    Function Append(aRecordIndex : Integer) : Integer; override;
    Function FindRecord(aRecordIndex : Integer) : Integer; override;
    Function Update(aRecordIndex : Integer) : Integer; override;
    Property Unique : Boolean Read FUnique Write FUnique;
  end;

  { TJSONIndexDef }

  TJSONIndexDef = class(TIndexDef)
  Private
    FIndex : TSortedJSONIndex;
  Protected
    Property Index : TSortedJSONIndex Read FIndex Write FIndex;
  Public
    Procedure BuildIndex(aDataset : TBaseJSONDataset);
  end;

  { TJSONIndexDefs }

  TJSONIndexDefs = Class(TIndexDefs)
  private
    function GetD(aIndex : Integer): TJSONIndexDef;
    procedure SetD(aIndex : Integer; AValue: TJSONIndexDef);
  Public
    Function AddJSONIndexDef: TJSONIndexDef;
    Property Defs[aIndex : Integer] : TJSONIndexDef Read GetD Write SetD; default;
  end;

  // basic JSON dataset. Does nothing ExtJS specific.
  TBaseJSONDataSet = class (TDataSet)
  private
    FActiveIndex: String;
    FIndexes: TJSONIndexDefs;
    FMUS: Boolean;
    FOwnsData : Boolean;
    FDefaultIndex : TJSONIndex; // Default index, built from array
    FCurrentIndex : TJSONIndex; // Currently active index.
    FCurrent: Integer; // Record Index in the current IndexList
    // Possible metadata to configure fields from.
    FMetaData : TJSObject;
    // This will contain the rows.
    FRows : TJSArray;
    // Deleted rows
    FDeletedRows : TJSArray;
    FFieldMapper : TJSONFieldMapper;
    // When editing, this object is edited.
    FEditIdx : Integer;
    FEditRow : JSValue;
    // When filtering, this is the current row;
    FFilterRow : JSValue;
    FUseDateTimeFormatFields: Boolean;
    FRowType: TJSONRowType;
    FFilterExpression : TFPExpressionParser;
    function GetFilterField(const AName: String): TFPExpressionResult;
    procedure RemoveCalcFields(Buf: JSValue);
    procedure SetActiveIndex(AValue: String);
    procedure SetIndexes(AValue: TJSONIndexDefs);
    procedure SetMetaData(AValue: TJSObject);
    procedure SetRows(AValue: TJSArray);
    procedure SetRowType(AValue: TJSONRowType);
  protected
    // Determine filter value type based on field type
    function FieldTypeToExpressionType(aDataType: TFieldType): TResultType; virtual;
    // Callback for IsNull filter function.
    function GetFilterIsNull(const Args: TExprParameterArray): TFPExpressionResult; virtual;
    // Expression parser class. Override this to create a customized version.
    function FilterExpressionClass: TFPExpressionParserClass; virtual;
    // Create filter expression.
    function CreateFilterExpression: TFPExpressionParser; virtual;
    // Function called to check if current buffer should be accepted.
    function DoFilterRecord: Boolean; virtual;
    // Override this to return customized version.
    function CreateIndexDefs: TJSONIndexDefs; virtual;
    // override this to return a customized version if you are so inclined
    function RecordComparerClass: TRecordComparerClass; virtual;
    // Return index of Row in FRows matching keyfields/values. If not found, -1 is returned.
    function LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer; virtual;
    // dataset virtual methods
    function AllocRecordBuffer: TDataRecord; override;
    procedure FreeRecordBuffer(var Buffer: TDataRecord); override;
    procedure InternalInitRecord(var Buffer: TDataRecord); override;
    function GetRecord(Var Buffer: TDataRecord; GetMode: TGetMode; DoCheck{%H-}: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure AddToRows(AValue: TJSArray);
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalInsert; override;
    procedure InternalEdit; override;
    procedure InternalCancel; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalSetToRecord(Buffer: TDataRecord); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetFiltered(Value: Boolean); override;
    function  GetFieldClass(FieldType: TFieldType): TFieldClass; override;
    function IsCursorOpen: Boolean; override;
    // Bookmark operations
    procedure GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark); override;
    function GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag; override;
    procedure InternalGotoBookmark(ABookmark: TBookmark); override;
    procedure SetBookmarkFlag(Var Buffer: TDataRecord; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Var Buffer: TDataRecord; Data: TBookmark); override;
    function GetRecordCount: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    function GetRecNo: Integer; override;
  Protected
    // New methods.
    // Build all sorted indexes. Default index is not built.
    Procedure BuildIndexes;
    // Called when dataset is closed. If OwnsData is true, metadata and rows are freed.
    Procedure FreeData; virtual;
    // Fill default list.
    procedure AppendToIndexes; virtual;
    Procedure CreateIndexes; virtual;
    // Convert MetaData object to FieldDefs.
    Procedure MetaDataToFieldDefs; virtual; abstract;
    // Initialize Date/Time info in all date/time fields. Called during InternalOpen
    procedure InitDateTimeFields; virtual;
    // Convert JSON date S to DateTime for Field F
    function ConvertDateTimeField(S: String; F: TField): TDateTime; virtual;
    // Format JSON date to from DT for Field F
    function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual;
    // Create fieldmapper. A descendent MUST implement this.
    Function CreateFieldMapper : TJSONFieldMapper; virtual;
    // If True, then the dataset will free MetaData and FRows when it is closed.
    Property OwnsData : Boolean Read FownsData Write FOwnsData;
    // set to true if unknown field types should be handled as string fields.
    Property MapUnknownToStringType : Boolean Read FMUS Write FMUS;
    // Metadata
    Property MetaData : TJSObject Read FMetaData Write SetMetaData;
    // Rows
    Property Rows : TJSArray Read FRows Write SetRows;
    // RowType
    Property RowType : TJSONRowType Read FRowType Write SetRowType;
    // Fieldmapper
    Property FieldMapper : TJSONFieldMapper Read FFieldMapper;
    // FieldClass
    Property UseDateTimeFormatFields : Boolean Read FUseDateTimeFormatFields Write FUseDateTimeFormatFields;
    // Indexes
    Property Indexes : TJSONIndexDefs Read FIndexes Write SetIndexes;
    // Active index name. Set to empty for default index.
    Property ActiveIndex : String Read FActiveIndex Write SetActiveIndex;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    function Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean; override;
    function Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue; override;
    function GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;  override;
    procedure SetFieldData(Field: TField; var Buffer{%H-}: TDatarecord; AValue : JSValue);  override;
    function BookmarkValid(ABookmark: TBookmark): Boolean; override;
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  end;

  TJSONDataset = Class(TBaseJSONDataset)
  published
    Property FieldDefs;
    Property RowType;
    Property UseDateTimeFormatFields;
    Property Indexes;
    Property ActiveIndex;
    property Active;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  end;

  { TJSONObjectFieldMapper }
  // Fieldmapper to be used when the data is in an object
  TJSONObjectFieldMapper = Class(TJSONFieldMapper)
  Public
    Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
    procedure SetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row,Data : JSValue); override;
    Function GetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue) : JSValue; override;
    Function CreateRow : JSValue; override;
  end;

  { TJSONArrayFieldMapper }
  // Fieldmapper to be used when the data is in an array
  TJSONArrayFieldMapper = Class(TJSONFieldMapper)
  Public
    Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
    procedure SetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row,Data : JSValue); override;
    Function GetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
    Function CreateRow : JSValue; override;
  end;

  EJSONDataset = Class(EDatabaseError);
  
implementation

uses DateUtils;

{ TJSONIndexDef }

procedure TJSONIndexDef.BuildIndex(aDataset : TBaseJSONDataset);

begin
  if Findex=Nil then
    FIndex:=TSortedJSONIndex.Create(aDataset,aDataset.Rows);
  FIndex.CreateComparer(Self);
  FIndex.CreateIndex;
end;

{ TJSONIndexDefs }

function TJSONIndexDefs.GetD(aIndex : Integer): TJSONIndexDef;
begin
  Result:=Items[aIndex] as TJSONIndexDef;
end;

procedure TJSONIndexDefs.SetD(aIndex : Integer; AValue: TJSONIndexDef);
begin
  Items[aIndex]:=aValue;
end;

function TJSONIndexDefs.AddJSONIndexDef: TJSONIndexDef;
begin
  Result:=Add as TJSONIndexDef;
end;

{ TSortedJSONIndex }

Function TSortedJSONIndex.MergeSort(aList : TJSArray) : TJSArray;

Var
  temp : TJSArray;
  l,p,q,e,tail : integer;
  insize, nmerges, psize, qsize : Integer;

begin
  if aList=Nil then
    Exit(Nil);
  L:=aList.length;
  Result:=TJSArray.new(l);
  if L=0 then exit;
  insize:=1;
  Repeat
    p:=0;
    Tail:=0;
    nmerges := 0;  // count number of merges we do in this pass
    while (p<L) do
      begin
      Inc(nmerges);  { there exists a merge to be done }
      { step `insize' places along from p }
      pSize:=L-P;
      if Insize<pSize then
        pSize:=InSize;
      Q:=P+pSize;
      qsize:=insize;
       //* now we have two lists; merge them */
      while (psize>0) or ((qsize > 0) and (Q<L)) do
        begin // /* decide whether next element of merge comes from p or q */
        if (psize=0) then
          begin  // * p is empty; e must come from q. */
          e := q; Inc(q); Dec(qsize);
          end
        else if ((qsize = 0) or (q>=L)) then
          begin // * q is empty; e must come from p. */
          e := p; Inc(p); Dec(psize);
          end
        else if (FComparer.CompareRows(Integer(aList[p]),Integer(aList[q])) <= 0) then
          begin // * First element of p is lower (or same); * e must come from p. */
          e:=p; inc(p); Dec(psize);
          end
        else
          begin // * First element of q is lower; e must come from q. */
          e := q; Inc(q); Dec(qsize);
          end;
        Result[Tail]:=aList[e];
        Inc(tail);
        end;
      p:=q;
      end;
    // * If we have done only one merge, we're finished. */
    if (nmerges <= 1) then  //* allow for nmerges==0, the empty list case */
      exit;
    // * Otherwise repeat, merging lists twice the size */
    InSize:=Insize * 2;
    // Swap lists for next round.
    Temp:=Result;
    Result:=aList;
    aList:=Temp;
  until false;
end;

destructor TSortedJSONIndex.Destroy;
begin
  FreeAndNil(FComparer);
  Inherited;
end;

procedure TSortedJSONIndex.CreateComparer(aIndex: TJSONIndexDef);
begin
  FreeAndNil(FComparer);
  FComparer:=TRecordComparer.Create(Dataset,aindex);
end;

procedure TSortedJSONIndex.CreateIndex;

Var
  Lst : TJSArray;
  Len : Integer;
begin
  // CreateIndex is called during constructor. We cannot build index then, so we exit
  if FComparer=Nil then
    exit;
  Len:=FRows.Length-1;
  // Temp list, mergsort destroys list
  Lst:=TJSArray.New(Len+1);
  While Len>=0 do
    begin
    Lst[Len]:=Len;
    Dec(Len);
    end;
  FList:=MergeSort(Lst);
end;

procedure TSortedJSONIndex.AppendToIndex;
begin
  // In theory, we could sort the rest of the list, and then merge the 2 sublists.
  CreateIndex;
end;

function TSortedJSONIndex.FindPos(aRecordIndex: Integer): Integer;

Var
  L,R,I, CompareRes : Integer;

begin
  if not Assigned(FComparer) then
    exit;
  L := 0;
  R := Count - 1;
  while (L<=R) do
    begin
    I := L + (R - L) div 2;
    CompareRes := FComparer.CompareRows(aRecordIndex, Integer(Flist[I]));
    if (CompareRes>0) then
      L := I+1
    else
      begin
      R := I-1;
      if (CompareRes=0) then
        begin
        if Unique then
          L := I; // forces end of while loop
        end;
      end;
    end;
  Result:=L;
end;

function TSortedJSONIndex.Append(aRecordIndex: Integer): Integer;


begin
  Result:=FindPos(aRecordIndex);
  // insert in list
  FList.Splice(Result,0,aRecordIndex);
end;


function TSortedJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
begin
  Result:=FList.indexOf(aRecordIndex);
end;

function TSortedJSONIndex.Update(aRecordIndex: Integer): Integer;

Var
  aCurrentIndex : Integer;

begin
  // Old pos
  aCurrentIndex:=FindRecord(aRecordIndex);
  // New pos
  Result:=FindPos(aRecordIndex);
  if Result<>aCurrentIndex then
    FList.Splice(Result,0,FList.Splice(aCurrentIndex,1)[0])
end;

{ TFloatFieldComparer }

function TFloatFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
var
  D1,D2 : Double;

begin
  D1:=Double(GetFieldValue(Rowindex));
  D2:=Double(aValue);
  Result:=Round(D1-D2);
end;

{ TDateTimeFieldComparer }

function TDateTimeFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;

var
  D1,D2 : TDateTime;

begin
  D1:=Dataset.ConvertDateTimeField(String(GetFieldValue(Rowindex)),Self.Field);
  D2:=TDateTime(aValue);
  Result:=Round(D1-D2);
end;

{ TBooleanFieldComparer }

function TBooleanFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;

var
  B1,B2 : Boolean;

begin
  B1:=Boolean(GetFieldValue(Rowindex));
  B2:=Boolean(aValue);
  Result:=Ord(B1)-Ord(B2);
end;

{ TNativeIntFieldComparer }

function TNativeIntFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;

var
  I1,I2 : NativeInt;

begin
  I1:=NativeInt(GetFieldValue(Rowindex));
  I2:=NativeInt(aValue);
  Result:=I1-I2;
end;

{ TStringFieldComparer }

function TStringFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;

var
  S1,S2 : String;

begin
  S1:=String(GetFieldValue(Rowindex));
  S2:=String(aValue);
  if loPartialKey in Options then
    S1:=Copy(S1,1,Length(S2));
  if loCaseInsensitive in options then
    Result := CompareText(S1,S2)
  else
    Result := CompareStr(S1,S2);
end;

{ TFieldComparer }

constructor TFieldComparer.Create(aDataset: TBaseJSONDataset; aField: TField; aValue: JSValue; aOptions: TLocateOptions);

begin
  FField:=AField;
  FValue:=aValue;
  FOptions:=aOptions;
  FDataset:=aDataset;
end;

function TFieldComparer.GetFieldValue(RowIndex: integer): JSValue;
begin
  Result:=FDataset.FieldMapper.GetJSONDataForField(FField,FDataset.FRows[Rowindex]);
end;

function TFieldComparer.CompareRows(RowIndex1, RowIndex2: Integer): Integer;
begin
  Result:=Compare(RowIndex1,GetFieldValue(RowIndex2));
end;

function TFieldComparer.Compare(RowIndex: Integer): Integer;
begin
  Result:=Compare(RowIndex,FValue);
end;

{ TRecordComparer }

function TRecordComparer.GetFieldComparer(Index: Integer): TFieldComparer;
begin
  if (Index<0) or (Index>=Length(Fitems)) then
    Raise EListError.CreateFmt('Index out of bounds: %d not in [%d,%d]',[Index,0,Length(Fitems)-1]);
  Result:=Items[Index];
end;

procedure TRecordComparer.ConstructItems(aFields : String);

Var
  L : TFPlist;
  FCC : TFieldComparerClass;
  F : TField;
  I : Integer;


begin
  L:=TFPList.Create;
  try
    Dataset.GetFieldList(L,aFields);
    if Not Indexbased and (L.Count<>Length(FValues)) then
       Raise EDatabaseError.CreateFmt('Array of values has different length (%d) from array of fields (%d)',[Length(FValues), L.Count]);
    SetLength(FItems,L.Count);
    For I:=0 to L.Count-1 do
      begin
      F:=TField(L[i]);
      FCC:=DataTypeToComparerClass(F.DataType);
      If FCC=Nil then
        Raise EDatabaseError.CreateFmt('Cannot locate on field %s of type %s)',[F.FieldName,GetEnumName(TypeInfo(TFieldType),Ord(F.DataType))]);
      if IndexBased then
        Fitems[i]:=FCC.Create(FDataset,F,Null,FOptions)
      else
        Fitems[i]:=FCC.Create(FDataset,F,FValues[i],FOptions);
      end;
  finally
    L.Free;
  end;
end;

function TRecordComparer.DataTypeToComparerClass(aFieldType: TFieldType): TFieldComparerClass;

begin
  Case aFieldType of
    ftMemo, ftFixedChar,ftString :
      Result:=TStringFieldComparer;
    ftAutoInc, ftInteger, ftLargeInt:
      Result:=TNativeIntFieldComparer;
    ftBoolean:
      Result:=TBooleanFieldComparer;
    ftFloat:
      Result:=TFloatFieldComparer;
    ftDate, ftTime, ftDateTime:
      Result:=TDateTimeFieldComparer;
  else
   result:=Nil;
  end;
end;

function TRecordComparer.Compare(aRowindex: integer): Integer;

Var
  I,L : Integer;

begin
  Result:=0;
  I:=0;
  L:=Length(FItems);
  While (Result=0) and (I<L) do
    begin
    Result:=Fitems[i].Compare(aRowindex);
    Inc(I);
    end;
end;

function TRecordComparer.CompareRows(aRowindex1, aRowIndex2: integer): Integer;

Var
  I,L : Integer;

begin
  Result:=0;
  I:=0;
  L:=Length(FItems);
  While (Result=0) and (I<L) do
    begin
    Result:=Fitems[i].CompareRows(aRowindex1,aRowIndex2);
    if (Result<>0) and Fitems[i].Desc then
      Result:=-Result;
    Inc(I);
    end;
end;

procedure TRecordComparer.updateFromIndex(aIndex: TJSONIndexDef);

Var
  L : TFPList;
  I : Integer;

begin
  L:=TFPList.Create;
  try
    if (aIndex.CaseInsFields<>'') then
      begin
      Dataset.GetFieldList(L,aIndex.CaseInsFields);
      for I:=0 to Length(FItems)-1 do
        if L.IndexOf(FItems[i].Field)<>-1 then
          Fitems[i].Options:=Fitems[i].Options+[loCaseInsensitive];
      end;
    L.Clear;
    Dataset.GetFieldList(L,aIndex.DescFields);
    for I:=0 to Length(FItems)-1 do
      Fitems[i].Desc:=(ixDescending in aIndex.Options) or (L.IndexOf(FItems[i].Field)<>-1);
  finally
    L.Free;
  end;
end;

constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aFields: String; aValues: JSValue; aOptions: TLocateOptions);
begin
  FDataset:=aDataset;
  if isArray(aValues) then
    FValues:=TJSValueDynArray(aValues)
  else
    begin
    SetLength(FValues,1);
    FValues[0]:=Avalues;
    end;
  Foptions:=aOptions;
  ConstructItems(aFields);
end;

constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aIndex: TJSONIndexDef);
begin
  FDataset:=aDataset;
  FIndexBased:=True;
  if ixCaseInsensitive in aIndex.Options then
    FOptions:=[loCaseInsensitive];
  ConstructItems(aIndex.Fields);
  UpdateFromIndex(aIndex);
end;

destructor TRecordComparer.Destroy;

Var
  I : Integer;

begin
  For I:=0 to Length(FItems)-1 do
    FItems[i].Free;
  inherited Destroy;
end;

{ TDefaultJSONIndex }

procedure TDefaultJSONIndex.CreateIndex;

Var
  I : Integer;

begin
  For I:=0 to FRows.length-1 do
    FList[i]:=I;
end;

procedure TDefaultJSONIndex.AppendToIndex;

Var
  I,L : Integer;

begin
  L:=FList.Length;
  FList.Length:=FRows.Length;
  For I:=L to FRows.Length-1 do
    FList[i]:=I;
end;

function TDefaultJSONIndex.Append(aRecordIndex: Integer): Integer;
begin
  Result:=FList.Push(aRecordIndex)-1;
end;

function TDefaultJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer
  ): Integer;
begin
  FList.splice(aCurrentIndex, 0, aRecordIndex);
  Result:=aCurrentIndex;
end;

function TDefaultJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
begin
  Result:=FList.indexOf(aRecordIndex);
end;

function TDefaultJSONIndex.Update(aRecordIndex: Integer
  ): Integer;
begin
  Result:=aRecordIndex;
end;

{ TJSONIndex }

constructor TJSONIndex.Create(aDataset: TBaseJSONDataset; aRows: TJSArray);
begin
  FRows:=aRows;
  FList:=TJSArray.New(FRows.length);
  FDataset:=aDataset;
  CreateIndex;
end;

function TJSONIndex.Delete(aListIndex: Integer): Integer;

Var
  a : TJSArray;

begin
  A:=FList.Splice(aListIndex,1);
  If a.Length>0 then
    Result:=Integer(A[0])
  else
    Result:=-1;
end;

function TJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer): Integer;
begin
  Result:=Append(aRecordIndex);
end;

function TJSONIndex.GetCount: Integer;
begin
  Result:=FList.Length;
end;

function TJSONIndex.GetRecordIndex(aListIndex : Integer): NativeInt;
begin
  if isUndefined(FList[aListIndex]) then
    Result:=-1
  else
    Result:=NativeInt(FList[aListIndex]);
end;



{ TJSONFieldMapper }

function TJSONFieldMapper.GetJSONDataForField(F: TField; Row: JSValue  ): JSValue;
begin
  // This supposes that Index is correct, i.e. the field positions have not been changed.
  Result:=GetJSONDataForField(F.FieldName,F.Index,Row);
end;

procedure TJSONFieldMapper.SetJSONDataForField(F: TField; Row,Data: JSValue);
begin
  SetJSONDataForField(F.FieldName,F.Index,Row,Data);
end;


{ TJSONArrayFieldMapper }

procedure TJSONArrayFieldMapper.RemoveField(const FieldName: String; FieldIndex: Integer; Row: JSValue);
begin
  TJSArray(Row).Splice(FieldIndex,1);
end;

procedure TJSONArrayFieldMapper.SetJSONDataForField(const FieldName: String;
  FieldIndex: Integer; Row, Data: JSValue);
begin
  TJSValueDynArray(Row)[FieldIndex]:=Data;
end;

function TJSONArrayFieldMapper.GetJSONDataForField(const FieldName: String; FieldIndex: Integer; Row: JSValue): JSValue;
begin
  Result:=TJSValueDynArray(Row)[FieldIndex];
end;

function TJSONArrayFieldMapper.CreateRow: JSValue;

begin
  Result:=TJSArray.New;
end;

{ TJSONObjectFieldMapper }

procedure TJSONObjectFieldMapper.RemoveField(const FieldName: String; FieldIndex: Integer; Row: JSValue);
begin
  jsDelete(Row,FieldName);
end;

procedure TJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
  FieldIndex: Integer; Row, Data: JSValue);
begin
  TJSObject(Row).Properties[FieldName]:=Data;
end;

function TJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
  FieldIndex: Integer; Row: JSValue): JSValue;
begin
  Result:=TJSObject(Row).Properties[FieldName];
end;

function TJSONObjectFieldMapper.CreateRow: JSValue;
begin
  Result:=TJSObject.New;
end;

procedure TBaseJSONDataSet.SetMetaData(AValue: TJSObject);
begin
  CheckInActive;
  FMetaData:=AValue;
end;

procedure TBaseJSONDataSet.SetIndexes(AValue: TJSONIndexDefs);
begin
  if FIndexes=AValue then Exit;
  FIndexes.Assign(aValue);
  if Active then
    BuildIndexes;
end;

procedure TBaseJSONDataSet.SetActiveIndex(AValue: String);

Var
  Idx : TJSONIndexDef;

begin
  if FActiveIndex=AValue then Exit;
  if (csLoading in ComponentState) then
    FActiveIndex:=AValue
  else
    begin
    if (AValue<>'') then
      Idx:=FIndexes.Find(aValue) as TJSONIndexDef
    else
      Idx:=nil;
    FActiveIndex:=AValue;
    if Not (csLoading in ComponentState) then
    if Idx=Nil then
      FCurrentIndex:=FDefaultIndex
    else
      begin
      if Idx.Index=Nil then
        Idx.BuildIndex(Self);
      FCurrentIndex:=Idx.Index;
      end;
    if Active then
      Resync([rmCenter]);
    end;
end;

procedure TBaseJSONDataSet.AddToRows(AValue: TJSArray);

begin
  if FRows=Nil then
    FRows:=AValue
  else
    begin
    FRows:=FRows.Concat(AValue);
    AppendToIndexes;
    end;
end;

procedure TBaseJSONDataSet.SetRows(AValue: TJSArray);
begin
  if AValue=FRows then exit;
  CheckInActive;
  FRows:=Nil;
  AddToRows(AValue);
end;

procedure TBaseJSONDataSet.SetRowType(AValue: TJSONRowType);
begin
  if FRowType=AValue then Exit;
  CheckInactive;
  FRowType:=AValue;
end;


function TBaseJSONDataSet.AllocRecordBuffer: TDataRecord;
begin
  Result.data:=TJSObject.New;
  Result.bookmark:=null;
  Result.state:=rsNew;
end;

// the next two are particularly ugly.
procedure TBaseJSONDataSet.InternalInitRecord(var Buffer: TDataRecord);
begin
//  Writeln('TBaseJSONDataSet.InternalInitRecord');
  Buffer.Data:=FFieldMapper.CreateRow;
  Buffer.bookmark:=null;
  Buffer.state:=rsNew;
end;

procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: TDataRecord);
begin
  Buffer.Data:=Null;
  Buffer.bookmark:=null;
  Buffer.state:=rsNew;
end;

procedure TBaseJSONDataSet.GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark);
begin
   Data.Data:=Buffer.bookmark;
end;

function TBaseJSONDataSet.GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag;
begin
  Result :=Buffer.BookmarkFlag;
end;

function TBaseJSONDataSet.GetRecNo: Integer;

Var
  bkmIdx : Integer;

begin
  bkmIdx:=Integer(ActiveBuffer.bookmark);
  Result:=FCurrentIndex.FindRecord(bkmIdx)+1;
end;

procedure TBaseJSONDataSet.InternalInitFieldDefs;
begin
  If Assigned(FMetaData) then
    MetaDataToFieldDefs;
  if (FieldDefs.Count=0) then
    Raise EJSONDataset.Create('No fields found');
end;

procedure TBaseJSONDataSet.FreeData;
begin
  If FOwnsData then
    begin
    FRows:=Nil;
    FMetaData:=Nil;
    end;
  if (FCurrentIndex<>FDefaultIndex) then
    FreeAndNil(FCurrentIndex)
  else
    FCurrentIndex:=Nil;
  FreeAndNil(FDefaultindex);
  FreeAndNil(FFieldMapper);
  FCurrentIndex:=Nil;
  FDeletedRows:=Nil;
end;

procedure TBaseJSONDataSet.AppendToIndexes;

begin
  FDefaultIndex.AppendToIndex;
end;

procedure TBaseJSONDataSet.CreateIndexes;

begin
  FDefaultIndex:=TDefaultJSONIndex.Create(Self,FRows);
  AppendToIndexes;
  FCurrentIndex:=FDefaultIndex;
end;

function TBaseJSONDataSet.FilterExpressionClass : TFPExpressionParserClass;

begin
  Result:=TFPExpressionParser;
end;

function TBaseJSONDataSet.GetFilterIsNull(Const Args : TExprParameterArray) : TFPExpressionResult;

begin
  Result.ResultType:=rtBoolean;
  Result.ResValue:=FieldByName(String(Args[0].resValue)).IsNull;
end;

function TBaseJSONDataSet.FieldTypeToExpressionType(aDataType : TFieldType) : TResultType;

begin
  Case aDataType of
    ftMemo,
    ftFixedChar,
    ftString : Result:=rtString;
    ftInteger,
    ftAutoInc,
    ftLargeInt : Result:=rtInteger;
    ftBoolean : Result:=rtBoolean;
    ftFloat : Result:=rtFloat;
    ftDate,
    ftTime,
    ftDateTime : Result:=rtDateTime;
  else
    DatabaseErrorFmt('Fields of type %s are not supported in filter expressions.',[Fieldtypenames[aDataType]],Self);
  end;
end;

function TBaseJSONDataSet.GetFilterField(Const AName : String) : TFPExpressionResult;

Var
  F : TField;
  C : Currency;

begin
  F:=FieldByName(aName);
  Result.resultType:=FieldTypeToExpressionType(F.DataType);
  case Result.resultType of
    rtBoolean : Result.resValue:=F.AsBoolean;
    rtInteger : Result.resValue:=F.AsLargeInt;
    rtFloat : Result.resValue:=F.AsFloat;
    rtDateTime : Result.resValue:=F.AsDateTime;
    rtString : Result.resValue:=F.AsString;
    rtCurrency :
      begin
      C:=Currency(F.AsFloat);
      Result.resValue:=C;
      end;
  end;
//  Writeln('Filtering field ',aName,'value: ',result.resValue);
end;


function TBaseJSONDataSet.CreateFilterExpression : TFPExpressionParser;

Var
  I : Integer;

begin
  Result:=FilterExpressionClass.Create(Self);
  for I:=0 to Fields.Count-1 do
    Result.Identifiers.AddVariable(Fields[i].FieldName,FieldTypeToExpressionType(Fields[i].DataType),@GetFilterField);
  Result.Identifiers.AddFunction('IsNull','B','S',@GetFilterIsNull);
  Result.Expression:=Filter;
end;

function TBaseJSONDataSet.DoFilterRecord : Boolean;

Var
  DS : TDatasetState;

begin
  // Writeln('Filtering');
  Result:=True;
  DS:=SetTempState(dsFilter);
  try
    if Assigned(OnFilterRecord) then
      begin
      OnFilterRecord(Self,Result);
      if Not Result then
        Exit;
      end;
    if not Filtered or (Filter='') then
      Exit;
    if (FFilterExpression=Nil) then
      FFilterExpression:=CreateFilterExpression;
    Result:=FFilterExpression.AsBoolean;
  finally
    RestoreState(DS);
  end;
end;

function TBaseJSONDataSet.GetRecord(Var Buffer: TDataRecord; GetMode: TGetMode; DoCheck: Boolean): TGetResult;

Var
  BkmIdx : Integer;
  recordAccepted : Boolean;
begin
  Result := grOK; // default
  Repeat
    recordAccepted:=True;
    case GetMode of
      gmNext: // move on
        if fCurrent < fCurrentIndex.Count - 1 then
          Inc (fCurrent)
        else
          Result := grEOF; // end of file
      gmPrior: // move back
        if fCurrent > 0 then
          Dec (fCurrent)
        else
          Result := grBOF; // begin of file
      gmCurrent: // check if empty
        if fCurrent >= fCurrentIndex.Count then
          Result := grEOF;
    end;
    if Result = grOK then // read the data
      begin
      BkmIdx:=FCurrentIndex.RecordIndex[FCurrent];
      Buffer.Data:=FRows[bkmIdx];
      Buffer.BookmarkFlag := bfCurrent;
      Buffer.Bookmark:=BkmIdx;
      CalculateFields(Buffer);
      if Filtered then
        begin
        FFilterRow:=Buffer.Data;
        recordAccepted:=DoFilterRecord;
        end;
      end;
  until recordAccepted;
end;

function TBaseJSONDataSet.GetRecordCount: Integer;
begin
  Result:=FCurrentIndex.Count;
end;

function TBaseJSONDataSet.GetRecordSize: Word;
begin
  Result := 0; // actual data without house-keeping
end;


procedure TBaseJSONDataSet.InternalClose;
begin
  // disconnet and destroy field objects
  BindFields (False);
  if DefaultFields then
    DestroyFields;
  FreeData;
end;

procedure TBaseJSONDataSet.InternalDelete;

Var
  Idx : Integer;

begin
  Idx:=FCurrentIndex.Delete(FCurrent);
  if (Idx<>-1) then
    begin
    // Add code here to Delete from other indexes as well.
    // ...
    // Add to array of deleted records.
    if Not Assigned(FDeletedRows) then
      FDeletedRows:=TJSArray.New(FRows[idx])
    else
      FDeletedRows.Push(FRows[Idx]);
    FRows[Idx]:=Undefined;
    end;
end;

procedure TBaseJSONDataSet.InternalFirst;
begin
  FCurrent := -1;
end;

procedure TBaseJSONDataSet.InternalGotoBookmark(ABookmark: TBookmark);
begin
  if isNumber(ABookmark.Data) then
    FCurrent:=FCurrentIndex.FindRecord(Integer(ABookmark.Data));
//  Writeln('Fcurrent', FCurrent,' from ',ABookmark.Data);
end;


procedure TBaseJSONDataSet.InternalInsert;

Var
  I : Integer;
  D : TFieldDef;

begin
//  Writeln('TBaseJSONDataSet.InternalInsert');
  FEditRow:=ActiveBuffer.Data;
  For I:=0 to FieldDefs.Count-1 do
    begin
    D:=FieldDefs[i];
    FFieldMapper.SetJSONDataForField(D.Name,D.Index,FEditRow,Null);
    end;
end;

procedure TBaseJSONDataSet.RemoveCalcFields(Buf : JSValue);

Var
  i : integer;

begin
  For I:=0 to Fields.Count-1 do
    if Fields[i].FieldKind in [fkCalculated,fkInternalCalc] then
      FieldMapper.RemoveField(FIelds[i].FieldName,FIelds[i].Index,Buf);

end;

procedure TBaseJSONDataSet.InternalEdit;

begin
//  Writeln('TBaseJSONDataSet.InternalEdit:  ');
  FEditIdx:=FCurrentIndex.RecordIndex[FCurrent];
  if not isUndefined(Rows[FEditIdx]) then
    begin
    FEditRow:=TJSJSON.parse(TJSJSON.stringify(Rows[FEditIdx]));
    RemoveCalcFields(FEditRow);
    end
  else
    FEditRow:=TJSObject.new;
//  Writeln('TBaseJSONDataSet.InternalEdit: ',FEditRow);
end;

procedure TBaseJSONDataSet.InternalCancel;
begin
  FEditIdx:=-1;
  FEditRow:=Nil;
end;

procedure TBaseJSONDataSet.InternalLast;
begin
  // The first thing that will happen is a GetPrior Record.
  FCurrent:=FCurrentIndex.Count;
end;

procedure TBaseJSONDataSet.InitDateTimeFields;

begin
  // Do nothing
end;

procedure TBaseJSONDataSet.InternalOpen;
begin
  FreeAndNil(FFieldMapper);
  FFieldMapper:=CreateFieldMapper;
  IF (FRows=Nil) then // opening from fielddefs ?
    begin
    FRows:=TJSArray.New;
    OwnsData:=True;
    end;
  CreateIndexes;
  InternalInitFieldDefs;
  if DefaultFields then
    CreateFields;
  BindFields (True);
  InitDateTimeFields;
  FCurrent := -1;
end;

procedure TBaseJSONDataSet.InternalPost;

Var
  I,NewCurrent,Idx : integer;
  B : TBookmark;

begin
  NewCurrent:=-1;
  GetBookMarkData(ActiveBuffer,B);
  if (State=dsInsert) then
    begin // Insert or Append
    Idx:=FRows.push(FEditRow)-1;
    if GetBookMarkFlag(ActiveBuffer)=bfEOF then
      begin // Append
      FDefaultIndex.Append(Idx);
      // Must replace this by updating all indexes
      for I:=0 to FIndexes.Count-1 do
        begin
        NewCurrent:=FIndexes[i].Findex.Append(Idx);
        if FIndexes[i].Findex<>FCurrentIndex then
          NewCurrent:=-1;
        end;
      end
    else  // insert
      begin
      FCurrent:=FDefaultIndex.Insert(FCurrent,Idx);
      for I:=0 to FIndexes.Count-1 do
        begin
        NewCurrent:=FIndexes[i].Findex.Append(Idx);
        if FIndexes[i].Findex<>FCurrentIndex then
          NewCurrent:=-1;
        end;
      end;
    end
  else
    begin // Edit
    if (FEditIdx=-1) then
      DatabaseErrorFmt('Failed to retrieve record index for record %d',[FCurrent]);
    // Update source record
    Idx:=FEditIdx;
    FRows[Idx]:=FEditRow;
    FDefaultIndex.Update(Idx);
    // Must replace this by updating all indexes.
    // Note that this will change current index.
    for I:=0 to FIndexes.Count-1 do
      begin
      // Determine old index.
      NewCurrent:=FCurrentIndex.Update(Idx);
      if FIndexes[i].Findex<>FCurrentIndex then
        NewCurrent:=-1;
      end;
    end;
  // We have an active index, set current to that index.
  if NewCurrent<>-1 then
    FCurrent:=NewCurrent;
  FEditIdx:=-1;
  FEditRow:=Nil;
end;

procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: TDataRecord);
begin
  FCurrent:=FCurrentIndex.FindRecord(Integer(Buffer.Bookmark));
end;

procedure TBaseJSONDataSet.SetFilterText(const Value: string);
begin
  inherited SetFilterText(Value);
  FreeAndNil(FFilterExpression);
  if Active then
    Resync([rmCenter]);
end;

procedure TBaseJSONDataSet.SetFiltered(Value: Boolean);
begin
  inherited SetFiltered(Value);
  FreeAndNil(FFilterExpression);
  if Active then
    Resync([rmCenter]);
end;

function TBaseJSONDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
begin
  If UseDateTimeFormatFields and (FieldType in [ftDate,ftDateTime,ftTime]) then
    case FieldType of
      ftDate : Result:=TJSONDateField;
      ftDateTime : Result:=TJSONDateTimeField;
      ftTime : Result:=TJSONTimeField;
    end
  else
    Result:=inherited GetFieldClass(FieldType);
end;

function TBaseJSONDataSet.IsCursorOpen: Boolean;
begin
  Result := Assigned(FDefaultIndex);
end;

function TBaseJSONDataSet.BookmarkValid(ABookmark: TBookmark): Boolean;
begin
  Result:=isNumber(ABookmark.Data);
end;

procedure TBaseJSONDataSet.SetBookmarkData(var Buffer: TDataRecord;  Data: TBookmark);
begin
  Buffer.Bookmark:=Data.Data;
//  Writeln('Set Bookmark from: ',Data.Data);
end;

function TBaseJSONDataSet.ConvertDateTimeField(S : String; F : TField) : TDateTime;

Var
  Ptrn : string;

begin
  Result:=0;
  Ptrn:='';
  Case F.DataType of
    ftDate : if F is TJSONDateField then
               Ptrn:=(F as TJSONDateField).DateFormat;
    ftTime : if F is TJSONTimeField then
               Ptrn:=(F as TJSONTimeField).TimeFormat;
    ftDateTime : if F is TJSONDateTimeField then
               Ptrn:=(F as TJSONDateTimeField).DateTimeFormat;
  end;
  If (Ptrn='') then
    Case F.DataType of
      ftDate : Result:=StrToDate(S);
      ftTime : Result:=StrToTime(S);
      ftDateTime : Result:=StrToDateTime(S);
    end
  else
    begin
    Result:=ScanDateTime(ptrn,S,1);
    end;
end;

function TBaseJSONDataSet.FormatDateTimeField(DT: TDateTime; F: TField
  ): String;

Var
  Ptrn : string;
begin
  Result:='';
  Ptrn:='';
  Case F.DataType of
    ftDate : if F is TJSONDateField then
                Ptrn:=TJSONDateField(F).DateFormat;
    ftTime : if F is TJSONTimeField then
                Ptrn:=TJSONTimeField(F).TimeFormat;
    ftDateTime : if F is TJSONDateTimeField then
                Ptrn:=TJSONDateTimeField(F).DateTimeFormat;
  end;
  If (Ptrn='') then
    Case F.DataType of
      ftDate : Result:=DateToStr(DT);
      ftTime : Result:=TimeToStr(DT);
      ftDateTime : Result:=DateTimeToStr(DT);
    end
  else
    Result:=FormatDateTime(ptrn,DT);
end;

function TBaseJSONDataSet.CreateFieldMapper: TJSONFieldMapper;
begin
  if FRowType=rtJSONArray then
    Result:=TJSONArrayFieldMapper.Create
  else
    Result:=TJSONObjectFieldMapper.Create;
end;

function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;

var
  R : JSValue;

begin
  if State in [dsCalcFields,dsInternalCalc] then
    R:=CalcBuffer.data
  else if (State=dsFilter) then
    R:=FFilterRow
  else if (FEditIdx=Buffer.Bookmark) then
    begin
    if State=dsOldValue then
      R:=Buffer.data
    else
      R:=FEditRow
    end
  else
    begin
    if State=dsOldValue then
      Exit(Null)
    else
      R:=Buffer.data;
    end;
  Result:=FFieldMapper.GetJSONDataForField(Field,R);
end;

procedure TBaseJSONDataSet.SetFieldData(Field: TField; var Buffer: TDatarecord; AValue : JSValue);

var
  R : JSValue;

begin
  if State in [dsCalcFields,dsInternalCalc] then
    R:=CalcBuffer.Data
  else
    R:=FEditRow;
  FFieldMapper.SetJSONDataForField(Field,R,AValue);
  
  if not(State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
    DataEvent(deFieldChange, Field);

  SetModified(True);
//  FFieldMapper.SetJSONDataForField(Field,Buffer.Data,AValue);
end;

procedure TBaseJSONDataSet.SetBookmarkFlag(var Buffer: TDataRecord; Value: TBookmarkFlag);

begin
  Buffer.BookmarkFlag := Value;
end;

function TBaseJSONDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;

begin
  if isNumber(Bookmark1.Data) and isNumber(Bookmark2.Data) then
    Result := Integer(Bookmark2.Data) - Integer(Bookmark1.Data)
  else
  begin
    if isNumber(Bookmark1.Data) then
      Result := -1
    else
    if isNumber(Bookmark2.Data) then
      Result := 1
    else
      Result := 0;
  end;
end;


procedure TBaseJSONDataSet.SetRecNo(Value: Integer);
begin
  if (Value < 1) or (Value > FCurrentIndex.Count) then
    raise EJSONDataset.CreateFmt('%s: SetRecNo: index %d out of range',[Name,Value]);
  FCurrent := Value - 1;
  Resync([]); 
  DoAfterScroll;
end;

constructor TBaseJSONDataSet.Create(AOwner: TComponent);
begin
  inherited;
  FownsData:=True;
  UseDateTimeFormatFields:=False;
  FEditIdx:=-1;
  FIndexes:=CreateIndexDefs;
end;

destructor TBaseJSONDataSet.Destroy;
begin
  FreeAndNil(FFilterExpression);
  FreeAndNil(FIndexes);
  FEditIdx:=-1;
  FreeData;
  inherited;
end;

Function TBaseJSONDataSet.CreateIndexDefs : TJSONIndexDefs;

begin
  Result:=TJSONIndexDefs.Create(Self,Self,TJSONIndexDef);
end;


procedure TBaseJSONDataSet.BuildIndexes;

Var
  I : integer;

begin
  For I:=0 to FIndexes.Count-1 do
    FIndexes[i].BuildIndex(Self);
end;

function TBaseJSONDataSet.RecordComparerClass : TRecordComparerClass;

begin
  Result:=TRecordComparer;
end;

function TBaseJSONDataSet.LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer;

Var
  Comp : TRecordComparer;
  RI,I : Integer;

begin
  Result:=-1;
  Comp:=RecordComparerClass.Create(Self,KeyFields,KeyValues,Options);
  try
    I:=FCurrent;
    RI:=FCurrentIndex.GetRecordIndex(I);
    While (Result=-1) and (RI<>-1) do
      begin
      if Comp.Compare(RI)=0 then
        Result:=RI;
      inc(I);
      RI:=FCurrentIndex.GetRecordIndex(I);
      end;
  finally
    Comp.Free;
  end;
end;

function TBaseJSONDataSet.Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean;

Var
  I : Integer;
  BM : TBookMark;

begin
  Result:=Inherited;
  I:=LocateRecordIndex(KeyFields,KeyValues,Options);
  Result:=I<>-1;
  if Result then
    begin
    // Construct bookmark.
    // Bookmark is always the index in the FRows array.
    BM.Data:=I;
    BM.Flag:=bfCurrent;
    GotoBookMark(BM);
    end;
end;

function TBaseJSONDataSet.Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue;

Var
  RI,I : Integer;
  l : TFPList;
  Vals : TJSValueDynArray;

begin
  Result:=Null;
  l:=TFPList.Create;
  try
    GetFieldList(L,ResultFields);
    Result:=inherited Lookup(KeyFields, KeyValues, ResultFields);
    RI:=LocateRecordIndex(KeyFields,KeyValues,[]);
    Result:=RI<>-1;
    if Result then
      begin
      SetLength(Vals,L.Count);
      For I:=0 to L.Count-1 do
        Vals[i]:=FFieldMapper.GetJSONDataForField(TField(L[I]),FRows[RI]);
      if L.Count=1 then
        Result:=Vals[i]
      else
        Result:=Vals;
      end;
  finally
    L.Free;
  end;
end;

end.