{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: JSON implementations.                        | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2016 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMJson;

interface

uses {$IFNDEF JEDIAPI}{$IFDEF JEDIAPI}JwaWinType,{$ENDIF}{$ENDIF}
     GMStrDef, GMIntf, GMCommon, GMCollections, GMActiveX, GMUnionValue;

type

  EGMJsonValueKind = (jvkUnassigned, jvkNull, jvkBoolean, jvkString, jvkInteger, jvkFloat, jvkObject, jvkArray);

  TGMJsonFloat = Double;


  PGMJsonValueData = ^RGMJsonValueData;

  RGMJsonValueData = packed record // <- only 9 bytes in size!
   private
    //StringValue: UnicodeString;
    class operator Initialize(var AValueData: RGMJsonValueData);
    class operator Finalize(var AValueData: RGMJsonValueData);
    class operator Copy(constref ASrc: RGMJsonValueData; var ADst: RGMJsonValueData);

    class operator Implicit(const AValueData: RGMJsonValueData): Boolean;
    class operator Implicit(const AValueData: RGMJsonValueData): Int64;
    class operator Implicit(const AValueData: RGMJsonValueData): LongInt;
    class operator Implicit(const AValueData: RGMJsonValueData): Double;
    class operator Implicit(const AValueData: RGMJsonValueData): TDateTime;
    class operator Implicit(const AValueData: RGMJsonValueData): UnicodeString;
    class operator Implicit(const AValueData: RGMJsonValueData): WideString;
    class operator Implicit(const AValueData: RGMJsonValueData): AnsiString;
    class operator Implicit(const AValueData: RGMJsonValueData): Utf8String;
    class operator Implicit(const AValueData: RGMJsonValueData): RGMUnionValue;
    class operator Implicit(const AValueData: RGMJsonValueData): Variant;

    class operator Implicit(AValue: Boolean): RGMJsonValueData;
    class operator Implicit(AValue: Int64): RGMJsonValueData;
    class operator Implicit(AValue: LongInt): RGMJsonValueData;
    class operator Implicit(AValue: Double): RGMJsonValueData;
    class operator Implicit(AValue: UnicodeString): RGMJsonValueData;
    class operator Implicit(AValue: WideString): RGMJsonValueData;
    class operator Implicit(AValue: AnsiString): RGMJsonValueData;
    class operator Implicit(AValue: Utf8String): RGMJsonValueData;
    class operator Implicit(const AValue: RGMUnionValue): RGMJsonValueData;
    class operator Implicit(const AValue: Variant): RGMJsonValueData;

   public
    function IsNullOrUnassigned: Boolean;
    function AsString: TGMString;
    function AsJsonSyntax: TGMString;
    function ValueKindName: TGMString;

    case ValueKind: EGMJsonValueKind of
  //   jvkUnassigned: ();
  //   jvkNull: ();
     jvkBoolean: (BoolValue: Boolean);
     //jvkString: (StringValue: GMStrDef.PUnicodeString);
     jvkString: (StringValue: Pointer);
     jvkInteger: (IntValue: Int64);
     jvkFloat: (FloatValue: TGMJsonFloat);
//   jvkObject: (ObjectValue: Pointer);
//   jvkArray: (ArrayValue: Pointer);
  end;


  IGMJsonValueBase = interface; // <- forward declaration

  IGMJSONValuesIterator = IGMGenericIterator<IGMJsonValueBase>;


  IGMJsonValueBase = interface(IGMGetSetName)
    ['{50EE5AC0-0B7B-4143-9854-A34068E1B7A1}']
    function ValueName: UnicodeString;
    function ValueKind: EGMJsonValueKind;
    function GetParent: IGMJsonValueBase;
    procedure SetParent(const AParent: IGMJsonValueBase);
    function AsString(const AIndent: UnicodeString = ''): UnicodeString;
    function CreateSubValueIterator(const AReverse: Boolean = False): IGMJSONValuesIterator; // <- may return nil!
    procedure WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8; const AIndent: TGMString = '');
    property Parent: IGMJsonValueBase read GetParent write SetParent;
  end;


  IGMJSONValuesCollection = IGMGenericCollection<IGMJsonValueBase>;


  IGMJsonTerminalValue = interface(IGMJsonValueBase)
    ['{3D693C02-1CC5-4C45-9EB5-4442466033F9}']
    //function GetStringValue: TGMString;
    //procedure SetStringValue(const AStringValue: TGMString);
    function GetValueData: RGMJsonValueData;
    procedure SetValueData(const AValueData: RGMJsonValueData);
    //function GetValue: RGMJsonValueData;
    property ValueData: RGMJsonValueData read GetValueData write SetValueData;
  end;


  IGMJsonValueContainer = interface(IGMJsonValueBase)
    ['{0F053B53-52C4-4B7A-B72B-1EE3EC1DFB77}']
    function ArrayLowBound: PtrInt;
    function ArrayHighBound: PtrInt;
    function ArrayLength: PtrInt;
    function GetArrayValueAt(const AArrayIdx: PtrInt): IGMJsonValueBase;
    function IsEmpty: Boolean;
    function FirstValue: IGMJsonValueBase;
    function LastValue: IGMJsonValueBase;

    property Values[const Index: PtrInt]: IGMJsonValueBase read GetArrayValueAt; default;
  end;


  IGMJsonObject = interface(IGMJsonValueContainer)
    ['{AE87A05D-CE65-4C2C-A6DE-6B6B3D92C9A8}']
    //function GetValues: IGMGenericArrayCollection<IGMJsonValueBase>;
    //property Values: IGMGenericArrayCollection<IGMJsonValueBase> read GetValues;
  end;


  IGMJsonArray = interface(IGMJsonValueContainer)
    ['{72C6BEAF-E80F-4E51-9A96-94EA6F7D316F}']
  end;


  TGMJsonValueBase = class(TGMRefCountedObj, IGMJsonValueBase, IGMGetName, IGMGetSetName, IGWriteToStream)
   protected
    FName: UnicodeString;
    FParent: IGMJsonValueBase;

   public
    constructor Create(const AParent: IGMJsonValueBase; const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function ValueName: UnicodeString;
    function GetName: TGMString; stdcall;
    procedure SetName(const AName: TGMString); stdcall;
    function ValueKind: EGMJsonValueKind; virtual;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; virtual;
    function GetParent: IGMJsonValueBase;
    procedure SetParent(const AParent: IGMJsonValueBase);
    function CreateSubValueIterator(const AReverse: Boolean = False): IGMJSONValuesIterator; virtual;
    procedure WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8; const AIndent: TGMString = ''); virtual;

    property Parent: IGMJsonValueBase read GetParent write SetParent;
  end;


  TGMJsonTerminalValue = class(TGMJsonValueBase, IGMJsonTerminalValue, IGMGetUnionValue, IGMGetSetUnionValue, IGMGetStringValue, IGMGetSetStringValue)
   protected
    FValueData: RGMJsonValueData;

   public
    constructor CreateString(const AParent: IGMJsonValueBase; const AName, AValue: TGMString; const ARefLifeTime: Boolean = True); overload;
    constructor CreateValue(const AParent: IGMJsonValueBase; const AName: TGMString; const AValue: RGMJsonValueData; const ARefLifeTime: Boolean = True); overload;
    function ValueKind: EGMJsonValueKind; override;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
    function GetStringValue: UnicodeString;
    function GetUnionValue: RGMUnionValue;
    procedure SetUnionValue(const AValue: RGMUnionValue);
    function GetValueData: RGMJsonValueData;
    //function GetOleValue: OleVariant; stdcall;
    procedure SetValueData(const AValueData: RGMJsonValueData);
    procedure SetStringValue(const AStringValue: UnicodeString);

    property ValueData: RGMJsonValueData read GetValueData write SetValueData;
  end;


  //
  // Internal interface helping assert the contract: if Values.Count = RefCount => no more external references, the object can be disposed
  //
  IGMJsonContainerInternal = interface(IUnknown)
    ['{937B8620-6F50-489F-8873-085FD773E123}']
    function InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
    function InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;
  end;


  //
  // Internal contract: will be disposed when Values.Count = RefCount => no more external references, only expected references from Parent memebers
  //

  TGMJsonValueContainer = class(TGMJsonValueBase, IGMJsonContainerInternal, IGMJsonValueContainer)
   protected
    FReleasingMembers: Boolean;
    FValues: array of IGMJsonValueBase;

    function InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
    function InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;

   public
    function _Release: LongInt; override;
    function CreateSubValueIterator(const AReverse: Boolean = False): IGMJSONValuesIterator; override;
    function ArrayLowBound: PtrInt;
    function ArrayHighBound: PtrInt;
    function ArrayLength: PtrInt;
    function GetArrayValueAt(const AIndex: PtrInt): IGMJsonValueBase;
    function IsEmpty: Boolean;
    function FirstValue: IGMJsonValueBase;
    function LastValue: IGMJsonValueBase;

    property Values[const AIndex: PtrInt]: IGMJsonValueBase read GetArrayValueAt; default;
  end;


  //
  // Internal contract: will be disposed when Values.Count = RefCount => no more external references, only expected references from Parent memebers
  //

  TGMJsonObject = class(TGMJsonValueContainer, IGMJsonObject)
   public
    function ValueKind: EGMJsonValueKind; override;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
  end;


  //TGMJsonObject = class(TGMJsonValueBase, IGMJsonObject, IGMJsonContainerInternal)
  // protected
  //  FReleasingMembers: Boolean;
  //  //FValues: IGMIntfCollection;
  //  FValues: IGMGenericArrayCollection<IGMJsonValueBase>;
  //
  //  function InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
  //  function InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;
  //
  // public
  //  constructor Create(const ARefLifeTime: Boolean = True); overload; override;
  //  function _Release: LongInt; override;
  //  function ValueKind: EGMJsonValueKind; override;
  //  function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
  //  function GetValues: IGMGenericArrayCollection<IGMJsonValueBase>;
  //  function CreateSubValueIterator(const AReverse: Boolean = False): IGMJSONValuesIterator; override;
  //
  //  property Values: IGMGenericArrayCollection<IGMJsonValueBase> read GetValues;
  //end;


  //
  // Internal contract: will be disposed when Values.Count = RefCount => no more external references, only expected references from Parent memebers
  //
  TGMJsonArray = class(TGMJsonValueContainer, IGMJsonArray)
   public
    function ValueKind: EGMJsonValueKind; override;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
  end;


  TGMJsonArrayIterator<T> = class(TGMRefCountedObj, IGMGenericIterator<T>)
   protected
    FReverse: Boolean;
    FPosition: PtrInt;
    FJsonArray: IGMJsonValueContainer;

   public
    constructor Create(const AJsonArray: IUnknown; const AReverse: Boolean = False; const ARefLifeTime: Boolean = True); reintroduce;
    //function NextEntry(out AEntry): Boolean;
    function NextEntry(var AEntry: T): Boolean;
    procedure Reset;
  end;


  IGMJsonDocument = interface(IGMJsonObject)
    ['{0C88441F-2A1F-4EB0-A9F6-AB02C86C3BAF}']
    procedure ParseJsonData(const ASource: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8);
  end;


  TGMJsonDocument = class(TGMJsonObject, IGMJsonDocument)
   public
    constructor CreateRead(const ASource: ISequentialStream = nil;
                           const ACharCoding: TGMCharKind = ckUtf8;
                           const ARefLifeTime: Boolean = True);
    destructor Destroy; override;                       

    procedure ParseJsonData(const ASource: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8);
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
  end;


  XGMJsonError = class(EGMException);
  XGMJsonParsingError = class(XGMJsonError);
  XGMJsonConvertError = class(XGMJsonError);


function GMJsonEncodeEscapeChars(const AValue: TGMString): TGMString;

function GMStrAsQuotedChars(const AValue: TGMString): TGMString;


const

  scJsonFalse: UnicodeString = 'false';
  scJsonTrue: UnicodeString = 'true';
  scJsonNull: UnicodeString = 'null';

var

  gDfltIndent: UnicodeString = ' '; // #9;
  gJsonNewLine: UnicodeString = cNewLine;


implementation

uses SysUtils, TypInfo
     {$IFNDEF JEDIAPI}{$IFDEF JEDIAPI},jwaWinBase{$ENDIF}{$ENDIF}
     {$IFDEF DELPHI6},Variants{$ENDIF};

resourcestring

  srMissingInput = 'Expected %s, but instead reached end of input';
  srExpectedChar = 'Expected %s at character position %d on line %d, but instead found "%s"';
  srInvalidChar = 'Invalid character "%s" at position %d on line %d';
  srEscapeChar = 'Escape character';
  srHexDigit = 'Hexadecimal digit';
  srValueData = 'Value data';
  srJsonConvertToErrFmt = 'Cannot convert JSON value kind "%s" to type %s';
  srJsonConvertFromErrFmt = 'Cannot convert from %s to JSON Value';
  //srDecimalDigit = 'decimal digit';
  //srNumber = 'number';
  //srUnknownJsonContent = 'Unknown';
  //srUsupportedJsonContent = 'Unsupported JSON content';
  srEndOfInputInUtf8Sequence = 'Unexpected end of input in Utf-8 multibyte character sequence';
  srValueKindOutofBounds = 'JSON ValueKind %d out of bounds, must be in [%d .. %d]';
  srJSONElementIndex = 'JSON element index';


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function MsgMissingInput(const AMissing: TGMString): TGMString; {$IFDEF HAS_INLINE}inline;{$ENDIF}
begin
  Result := GMFormat(srMissingInput, [AMissing]);
end;

function MsgExpectedChar(const AExpected, AFound: TGMString; const ACharPos, ALineNo: Integer): TGMString; {$IFDEF HAS_INLINE}inline;{$ENDIF}
begin
  Result := GMFormat(srExpectedChar, [AExpected, ACharPos, ALineNo, AFound]);
end;

function MsgInvalidChar(const AFound: TGMString; const ACharPos, ALineNo: Integer): TGMString; {$IFDEF HAS_INLINE}inline;{$ENDIF}
begin
  Result := GMFormat(srInvalidChar, [AFound, ACharPos, ALineNo]);
end;

//function ValueKindName(const AValueKind: EGMJsonValueKind): TGMString;
//begin
//  Result := GetEnumName(TypeInfo(EGMJsonValueKind), Ord(AValueKind));
//end;

function WordToHexStr(AValue: Word): TGMString;
var i: Integer;
begin
  Result := '';
  for i:=1 to SizeOf(AValue) do
   begin
    Result := '' + cStrHexConvertChars[((AValue and $F0) shr 4)+1] + cStrHexConvertChars[(AValue and $F)+1] + Result;
    AValue := AValue shr 8;
   end;
end;

function GMJsonEncodeEscapeChars(const AValue: TGMString): TGMString;
var i: Integer; hexStr: TGMString;
begin
  Result := AValue; i:=1;
  while i <= Length(Result) do
   begin
    case Result[i] of
     '"', '\': begin Insert('\', Result, i); Inc(i); end;
     #8:  begin Delete(Result, i, 1); Insert('\b', Result, i); Inc(i); end;
     #9:  begin Delete(Result, i, 1); Insert('\t', Result, i); Inc(i); end;
     #10: begin Delete(Result, i, 1); Insert('\n', Result, i); Inc(i); end;
     #12: begin Delete(Result, i, 1); Insert('\f', Result, i); Inc(i); end;
     #13: begin Delete(Result, i, 1); Insert('\r', Result, i); Inc(i); end;
     else
      if Ord(Result[i]) < 32 then
       begin
        hexStr := 'u' + WordToHexStr(Ord(Result[i]));
        Delete(Result, i, 1);
        Insert(hexStr, Result, i);
        Inc(i, Length(hexStr)-1);
       end;
    end;
    Inc(i); // <- additional increment will be done at the end of every loop!
   end;
end;

function JsonQuotedName(const AName: UnicodeString): UnicodeString;
begin
  if Length(AName) <= 0 then Result := '' else Result := GMQuote(AName, '"', '"');
end;

function JsonFloatToString(const AValue: TGMJsonFloat): UnicodeString;
var fmtSeettings: TFormatSettings;
begin
  fmtSeettings := DefaultFormatSettings;
  fmtSeettings.DecimalSeparator := '.';
  Result := FloatToStr(AValue, fmtSeettings);
end;

function GMStrAsQuotedChars(const AValue: TGMString): TGMString;
var i: Integer;
begin
  SetLength(Result, 0);
  for i:=1 to Length(AValue) do
   case AValue[i] of
    '"': Result := GMStringJoin(Result, ' or ', GMQuote(AValue[i], '''', ''''));
    else Result := GMStringJoin(Result, ' or ', GMQuote(AValue[i], '"', '"'));
   end;
end;


{ -------------------------- }
{ ---- RGMJsonValueData ---- }
{ -------------------------- }

const cBoolInt: array [Boolean] of Int64 = (0, 1);


function RGMJsonValueData.IsNullOrUnassigned: Boolean;
begin
  Result := ValueKind in [jvkUnassigned, jvkNull];
end;

class operator RGMJsonValueData.Initialize(var AValueData: RGMJsonValueData);
begin
  //AValueData := Default(RGMJsonValueData); // <- dont use an assignment here, it would trigger the copy operator with an uninitialized source
  FillByte(AValueData, SizeOf(AValueData), 0);
end;

class operator RGMJsonValueData.Finalize(var AValueData: RGMJsonValueData);
begin
  case AValueData.ValueKind of
   jvkString: if AValueData.StringValue <> nil then begin UnicodeString(AValueData.StringValue) := ''; AValueData.StringValue := nil; end;
  end;
  //Initialize(ADst); <- avoid this, in most cases the record is discarded and this would be wasted cpu time
end;

class operator RGMJsonValueData.Copy(constref ASrc: RGMJsonValueData; var ADst: RGMJsonValueData);
begin
  Finalize(ADst);
  Initialize(ADst);

  case ASrc.ValueKind of
   jvkString: begin
               UnicodeString(ADst.StringValue) := UnicodeString(ASrc.StringValue);
               ADst.ValueKind := ASrc.ValueKind;
              end;
   else Move(Asrc, ADst, SizeOf(ADst));
  end;
end;

function RGMJsonValueData.ValueKindName: TGMString;
begin
  // ValueKind enum value out of bounds may happen if not proper initialized
  if GMIsInRange(Ord(ValueKind), Ord(Low(ValueKind)), Ord(High(ValueKind))) then
    Result := GetEnumName(TypeInfo(EGMJsonValueKind), Ord(ValueKind))
  else
    Result := GMFormat(srValueKindOutofBounds, [Ord(ValueKind), Low(ValueKind), High(ValueKind)]);
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): Boolean;
begin
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: Result := AValueData.BoolValue;
   //jvkString: Result := GMStrToBool(AValueData.StringValue^);
   jvkString: Result := GMStrToBool(UnicodeString(AValueData.StringValue));
   jvkInteger: Result := AValueData.IntValue <> 0;
   jvkFloat: Result := AValueData.FloatValue <> 0.0;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'Boolean']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): Int64;
begin
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: Result := cBoolInt[AValueData.BoolValue];
   //jvkString: Result := GMStrToInt(AValueData.StringValue^);
   jvkString: Result := GMStrToInt(UnicodeString(AValueData.StringValue));
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat: Result := Round(AValueData.FloatValue);
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'Int64']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): LongInt;
begin
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: Result := cBoolInt[AValueData.BoolValue];
   //jvkString: Result := GMStrToInt(AValueData.StringValue^);
   jvkString: Result := GMStrToInt(UnicodeString(AValueData.StringValue));
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat: Result := Round(AValueData.FloatValue);
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'LongInt']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): Double;
begin
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: Result := cBoolInt[AValueData.BoolValue];
   //jvkString: Result := GMStrToDouble(AValueData.StringValue^);
   jvkString: Result := GMStrToDouble(UnicodeString(AValueData.StringValue));
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat: Result := AValueData.FloatValue;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'Double']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): TDateTime;
begin
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull
   //jvkBoolean: Result := cBoolInt[AValueData.BoolValue];
   //jvkString: Result := GMStrToDouble(AValueData.StringValue^);
   jvkString: Result := GMStrToDouble(UnicodeString(AValueData.StringValue));
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat: Result := AValueData.FloatValue;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'TDateTime']), nil, 'RGMJsonValueData.Implicit');
  end;
end;


{$macro on}
{$define InsertStringResultCommonPart:=
  case AValueData.ValueKind of
   //jvkUnassigned, jvkNull => else case, raise exception
   jvkBoolean: if AValueData.BoolValue then Result := scJsonTrue else Result := scJsonFalse;
   jvkString: Result := UnicodeString(AValueData.StringValue);
   jvkInteger: Result := GMIntToStr(AValueData.IntValue);
   jvkFloat: Result := GMDoubleToStr(AValueData.FloatValue);
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, cResultTypeName]), nil, 'RGMJsonValueData.Implicit');
  end;}

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): UnicodeString;
const cResultTypeName = 'UnicodeString';
begin
  InsertStringResultCommonPart
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): WideString;
const cResultTypeName = 'WideString';
begin
  InsertStringResultCommonPart
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): AnsiString;
const cResultTypeName = 'AnsiString';
begin
  InsertStringResultCommonPart
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): Utf8String;
const cResultTypeName = 'Utf8String';
begin
  InsertStringResultCommonPart
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): RGMUnionValue;
begin
  FillByte(Result, SizeOf(Result), 0);
  case AValueData.ValueKind of
   jvkUnassigned: Result := uvtUnassigned; // begin Result.ValueType := uvtUnassigned; UnicodeString(Result.StringValue) := ''; end;
   jvkNull:       Result := uvtNull; // begin Result.ValueType := uvtNull; UnicodeString(Result.StringValue) := ''; end;
   jvkBoolean: Result := AValueData.BoolValue;
   jvkString: Result := UnicodeString(AValueData.StringValue);
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat: Result := AValueData.FloatValue;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'RGMUnionValue']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValueData: RGMJsonValueData): Variant;
begin
  case AValueData.ValueKind of
   jvkUnassigned: Result := Variants.Unassigned;
   jvkNull:    Result := Variants.Null;
   jvkBoolean: Result := AValueData.BoolValue;
   jvkString:  Result := UnicodeString(AValueData.StringValue); // AValueData.StringValue^;
   jvkInteger: Result := AValueData.IntValue;
   jvkFloat:   Result := AValueData.FloatValue;
   //else Result := Unassigned;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertToErrFmt, [AValueData.ValueKindName, 'Variant']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(AValue: Boolean): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  //Finalize(Result);
  Result.BoolValue := AValue;
  Result.ValueKind := jvkBoolean;
end;

class operator RGMJsonValueData.Implicit(AValue: Int64): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  //Finalize(Result);
  Result.IntValue := AValue;
  Result.ValueKind := jvkInteger;
end;

class operator RGMJsonValueData.Implicit(AValue: LongInt): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  //Finalize(Result);
  Result.IntValue := AValue;
  Result.ValueKind := jvkInteger;
end;

class operator RGMJsonValueData.Implicit(AValue: Double): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  //Finalize(Result);
  Result.FloatValue := AValue;
  Result.ValueKind := jvkFloat;
end;


{$macro on}
{$define InsertStringAssignCommonPart:=
   //FillByte(Result, SizeOf(Result), 0);
   Result := Default(RGMJsonValueData);
   //Finalize(Result);
   UnicodeString(Result.StringValue) := AValue;
   Result.ValueKind := jvkString;}

class operator RGMJsonValueData.Implicit(AValue: UnicodeString): RGMJsonValueData;
begin
  InsertStringAssignCommonPart
end;

class operator RGMJsonValueData.Implicit(AValue: WideString): RGMJsonValueData;
begin
  InsertStringAssignCommonPart
end;

class operator RGMJsonValueData.Implicit(AValue: AnsiString): RGMJsonValueData;
begin
  InsertStringAssignCommonPart
end;

class operator RGMJsonValueData.Implicit(AValue: Utf8String): RGMJsonValueData;
begin
  InsertStringAssignCommonPart
end;

class operator RGMJsonValueData.Implicit(const AValue: RGMUnionValue): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  //Finalize(Result);
  case AValue.ValueType of
   uvtUnassigned: Result.ValueKind := jvkUnassigned;
   uvtNull: Result.ValueKind := jvkNull;
   uvtString: Result := AValue.AsString;
   uvtBoolean: Result := AValue.BoolValue;
   uvtInt16: Result := AValue.Int16Value;
   uvtInt32: Result := AValue.Int32Value;
   uvtInt64: Result := AValue.Int64Value;
   uvtDouble: Result := AValue.DoubleValue;
   uvtDateTime: Result := Double(AValue.DateTimeValue);
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertFromErrFmt, [GMFormat('%s [%s]', ['RGMUnionValue', AValue.ValueTypeName])]), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AValue: Variant): RGMJsonValueData;
begin
  //FillByte(Result, SizeOf(Result), 0);
  //Result.ValueKind := jvkUnassigned;
  //Finalize(Result);
  Result := Default(RGMJsonValueData);
  case VarType(AValue) of
   varSmallint, varInteger, varShortInt, varByte, varWord, varLongWord, varInt64, varqword: begin Result.IntValue := AValue; Result.ValueKind := jvkInteger; end;
   varSingle, varDouble, varDate: begin Result.FloatValue := AValue; Result.ValueKind := jvkFloat; end;
   varBoolean: begin Result.BoolValue := AValue; Result.ValueKind := jvkBoolean; end;
   varOleStr, varString, varUString: Result := GMVarToStr(AValue); // SetValueDataString(Result, AValue);
   varEmpty, varNull: Result.ValueKind := jvkNull;
   //else Result.ValueKind := jvkUnassigned;
   else raise XGMJsonConvertError.ObjError(GMFormat(srJsonConvertFromErrFmt, [GMFormat('%s [%d]', ['Variant', VarType(AValue)])]), nil, 'RGMJsonValueData.Implicit');
  end;
end;

function RGMJsonValueData.AsString: TGMString;
begin
  case ValueKind of
   jvkUnassigned, jvkNull: Result := '';
   else Result := Self;
  end;
end;

function RGMJsonValueData.AsJsonSyntax: TGMString;
begin
  case ValueKind of
   //jvkUnassigned: Result := ''; // <- better raise an exception than creating JSON with invalid Syntax, uncommenting would prevent an exception but write nothing for the value => invalid syntax
   jvkNull:       Result := scJsonNull;
   jvkFloat:      Result := JsonFloatToString(FloatValue);
   else Result := Self; // <- raises exception for jvkUnassigned and jvkNull!
  end;
  if ValueKind = jvkString then Result := '"'+ GMJsonEncodeEscapeChars(Result) + '"';
end;


{ -------------------------- }
{ ---- TGMJsonValueBase ---- }
{ -------------------------- }

constructor TGMJsonValueBase.Create(const AParent: IGMJsonValueBase; const AName: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FName := AName;
  SetParent(AParent);
end;

function TGMJsonValueBase.GetParent: IGMJsonValueBase;
begin
  Result := FParent;
end;

procedure TGMJsonValueBase.SetParent(const AParent: IGMJsonValueBase);
var oldPrnt, newPrnt: IGMJsonContainerInternal;
begin
  if GMQueryInterface(AParent, IGMJsonContainerInternal, newPrnt) then newPrnt.InternalAddValue(Self);
  if GMQueryInterface(FParent, IGMJsonContainerInternal, oldPrnt) then oldPrnt.InternalRemoveValue(Self);
  FParent := AParent;
end;

function TGMJsonValueBase.ValueKind: EGMJsonValueKind;
begin
  Result := jvkUnassigned;
end;

function TGMJsonValueBase.ValueName: UnicodeString;
begin
  Result := FName;
end;

function TGMJsonValueBase.GetName: TGMString;
begin
  Result := FName;
end;

procedure TGMJsonValueBase.SetName(const AName: TGMString);
begin
  FName := AName;
end;

function TGMJsonValueBase.AsString(const AIndent: UnicodeString = ''): UnicodeString;
begin
  Result := ''; // AIndent + '<' + srUnknownJsonContent + '>';
end;

function TGMJsonValueBase.CreateSubValueIterator(const AReverse: Boolean): IGMJSONValuesIterator;
begin
  Result := nil;
end;

procedure TGMJsonValueBase.WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind; const AIndent: TGMString);
var strVal: UnicodeString; aStr: AnsiString;
begin
  if ADestStream = nil then Exit;
  strVal := AsString(AIndent);
  case ACharCoding of
   ckUtf16LE: GMSafeIStreamWrite(ADestStream, PUnicodeChar(strVal), Length(strVal) * SizeOf(WideChar), {$I %CurrentRoutine%});
   ckAnsi: begin // , jccISO_8859_1
            aStr := strVal;
            GMSafeIStreamWrite(ADestStream, PAnsiChar(aStr), Length(aStr), {$I %CurrentRoutine%});
           end;
   ckUtf8: begin
            aStr := GMStringToUtf8(strVal);
            GMSafeIStreamWrite(ADestStream, PAnsiChar(aStr), Length(aStr), {$I %CurrentRoutine%});
           end;
  end;
end;


{ ------------------------------ }
{ ---- TGMJsonTerminalValue ---- }
{ ------------------------------ }

constructor TGMJsonTerminalValue.CreateString(const AParent: IGMJsonValueBase; const AName, AValue: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(AParent, AName, ARefLifeTime);
  SetStringValue(AValue);
end;

constructor TGMJsonTerminalValue.CreateValue(const AParent: IGMJsonValueBase; const AName: TGMString; const AValue: RGMJsonValueData; const ARefLifeTime: Boolean);
begin
  inherited Create(AParent, AName, ARefLifeTime);
  SetValueData(AValue);
end;

function TGMJsonTerminalValue.ValueKind: EGMJsonValueKind;
begin
  Result := FValueData.ValueKind;
end;

function TGMJsonTerminalValue.AsString(const AIndent: UnicodeString = ''): UnicodeString;
begin
  Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', FValueData.AsJsonSyntax);
end;

function TGMJsonTerminalValue.GetStringValue: UnicodeString;
begin
  //if (FValueData.ValueKind = jvkString) and (FValueData.StringValue <> nil) then Result := FValueData.StringValue^ else Result := '';
  //if (FValueData.ValueKind = jvkString) and (FValueData.StringValue <> nil) then Result := UnicodeString(FValueData.StringValue) else Result := '';
  Result := FValueData;
end;

function TGMJsonTerminalValue.GetUnionValue: RGMUnionValue;
begin
  Result := FValueData;
end;

procedure TGMJsonTerminalValue.SetUnionValue(const AValue: RGMUnionValue);
begin
  FValueData := AValue;
end;

procedure TGMJsonTerminalValue.SetStringValue(const AStringValue: UnicodeString);
begin
  FValueData := AStringValue;
  //SetValueDataString(FValueData, AStringValue);
end;

function TGMJsonTerminalValue.GetValueData: RGMJsonValueData;
begin
  Result := FValueData;
end;

procedure TGMJsonTerminalValue.SetValueData(const AValueData: RGMJsonValueData);
begin
  //if FValueData.ValueKind <> jvkUnassigned then FinalizeValueData(FValueData);
  FValueData := AValueData;
end;

//function TGMJsonTerminalValue.GetOleValue: OleVariant;
//begin
//  Result := JsonValueDataAsVariant(FValueData);
//end;


{ ------------------------------------- }
{ ---- TGMJsonUnknownTerminalValue ---- }
{ ------------------------------------- }

//function TGMJsonUnknownTerminalValue.ValueKind: EGMJsonValueKind;
//begin
//Result := jvkUnassigned;
//end;
//
//function TGMJsonUnknownTerminalValue.AsString(const AIndent: UnicodeString): UnicodeString;
//begin
//Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', '"<' + srUsupportedJsonContent + ': ' + JsonValueDataAsString(FValueData, False)) + '>"';
//end;


{ ------------------------------- }
{ ---- TGMJsonValueContainer ---- }
{ ------------------------------- }

function TGMJsonValueContainer._Release: LongInt;
begin
  if not FReleasingMembers and (Length(FValues) = FRefCount-1) then
     begin FReleasingMembers := True; SetLength(FValues, 0); end; // <- resolve circular references

  Result := inherited _Release;
end;

function TGMJsonValueContainer.CreateSubValueIterator(const AReverse: Boolean): IGMJSONValuesIterator;
begin
  Result := TGMJsonArrayIterator<IGMJsonValueBase>.Create(Self, AReverse, True);
end;

function TGMJsonValueContainer.InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
begin
  if AValue = nil then Result := nil else
   begin
    SetLength(FValues, Length(FValues) + 1);
    FValues[High(FValues)] := AValue;
    Result := AValue;
   end;
end;

function TGMJsonValueContainer.InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;
var i, j: Integer;
begin
  Result := False;
  i:=Low(FValues);
  //for i:=Low(FValues) to High(FValues) do
  while i <= High(FValues) do
   if FValues[i] <> AValue then Inc(i) else
    begin
     for j:=i to High(FValues)-1 do FValues[j] := FValues[j+1];
     SetLength(FValues, Length(FValues)-1);
     Result := True;
     //Break; // <- assumes no duplicate entries
    end;
end;

function TGMJsonValueContainer.ArrayLowBound: PtrInt;
begin
  Result := Low(FValues);
end;

function TGMJsonValueContainer.ArrayHighBound: PtrInt;
begin
  Result := High(FValues);
end;

function TGMJsonValueContainer.ArrayLength: PtrInt;
begin
  Result := Length(FValues);
end;

function TGMJsonValueContainer.GetArrayValueAt(const AIndex: PtrInt): IGMJsonValueBase;
begin
  GMCheckIntRange(srJSONElementIndex, AIndex, Low(FValues), High(FValues), Self, 'GetArrayValueAt');
  Result := FValues[AIndex];
end;

function TGMJsonValueContainer.IsEmpty: Boolean;
begin
  Result := Length(FValues) <= 0;
end;

function TGMJsonValueContainer.FirstValue: IGMJsonValueBase;
begin
  if Length(FValues) > 0 then Result := FValues[Low(FValues)] else Result := nil;
end;

function TGMJsonValueContainer.LastValue: IGMJsonValueBase;
begin
  if Length(FValues) > 0 then Result := FValues[High(FValues)] else Result := nil;
end;


{ ----------------------- }
{ ---- TGMJsonObject ---- }
{ ----------------------- }

//constructor TGMJsonObject.Create(const ARefLifeTime: Boolean);
//begin
//  inherited Create(ARefLifeTime);
//  //FValues := TGMIntfArrayCollection.Create(True, False, nil, True);
//  FValues := TGMGenericArrayCollection<IGMJsonValueBase>.create(True, False, nil, nil, True);
//end;
//
//function TGMJsonObject._Release: LongInt;
//begin
//  if not FReleasingMembers and (FValues <> nil) and (FValues.Count = FRefCount-1) then
//     begin FReleasingMembers := True; FValues.Clear; end; // <- resolve circular references
//
//  Result := inherited _Release;
//end;

//function TGMJsonObject.GetValues: IGMGenericArrayCollection<IGMJsonValueBase>;
//begin
//  Result := FValues;
//end;

function TGMJsonObject.ValueKind: EGMJsonValueKind;
begin
  Result := jvkObject;
end;

//function TGMJsonObject.InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
//begin
//  //Result := FValues.Add(AValue);
//  if AValue = nil then Result := nil else
//    begin
//     Result := FValues.Add(AValue);
//    end;
//     //GMQueryInterface(FValues.Add(AValue), IGMJsonValueBase, Result);
//end;
//
//function TGMJsonObject.InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;
//var it: IGMJSONValuesIterator; entry: IGMJsonValueBase; idx: PtrInt;
//begin
//  idx := 0;
//  Result := False;
//  it := FValues.CreateIterator;
//  while it.NextEntry(entry) do
//    if entry = AValue then begin FValues.RemoveByIdx(idx); Result := True; end else Inc(idx);
//end;
//
//function TGMJsonObject.CreateSubValueIterator(const AReverse: Boolean): IGMJSONValuesIterator;
//begin
//  Result := Values.CreateIterator(AReverse);
//end;

function TGMJsonObject.AsString(const AIndent: UnicodeString = ''): UnicodeString;
var it: IGMJSONValuesIterator; entry: IGMJsonValueBase; firstVal: Boolean; newLn: TGMString; // unkValue: IUnknown;
begin
  if Length(AIndent) > 0 then newLn := gJsonNewLine else newLn := '';

  Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', '{');

  firstVal := True;
  it := CreateSubValueIterator; // Values.CreateIterator;
  while it.NextEntry(entry) do // unkValue
   //if GMQueryInterface(unkValue, IGMJsonValueBase, entry) then
    begin
     if firstVal then begin Result := Result + newLn; firstVal := False; end else Result := Result + ',' + newLn;
     Result := Result + entry.AsString(AIndent + gDfltIndent);
    end;

  Result := Result + newLn + AIndent + '}';
end;


{ ---------------------- }
{ ---- TGMJsonArray ---- }
{ ---------------------- }

function TGMJsonArray.ValueKind: EGMJsonValueKind;
begin
  Result := jvkArray;
end;

function TGMJsonArray.AsString(const AIndent: UnicodeString = ''): UnicodeString;
var i: Integer; firstVal: Boolean; newLn: TGMString;
begin
  if Length(AIndent) > 0 then newLn := gJsonNewLine else newLn := '';

  Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', '[');
  firstVal := True;
  for i:= ArrayLowBound to ArrayHighBound do
   begin
    if firstVal then begin Result := Result + newLn; firstVal := False; end else Result := Result + ',' + newLn;
    Result := Result + GetArrayValueAt(i).AsString(AIndent + gDfltIndent);
   end;

  Result := Result + newLn + AIndent + ']';
end;


{ ------------------------- }
{ ---- TGMJsonDocument ---- }
{ ------------------------- }

constructor TGMJsonDocument.CreateRead(const ASource: ISequentialStream; const ACharCoding: TGMCharKind; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  if ASource <> nil then ParseJsonData(ASource, ACharCoding);
end;

destructor TGMJsonDocument.Destroy;
begin
  //
  // Technically calling FValues.Clear is not really needed here since the compiler would clear them at the end
  // of the destructor call when freeing FValues. But the contained values have references to this instance and the inherited
  // destructor checks wheter FRefCount is 0. So clearing the values here is only to avoid the ref-count warning
  // of the inherited destructor.
  //
  // This is only a problem in case of an exception in the constructor and no other reference exists.
  //
  //if (FValues <> nil) and not FValues.IsEmpty then begin FReleasingMembers := True; FValues.Clear; end;
  if (Length(FValues) > 0) then begin FReleasingMembers := True; SetLength(FValues, 0); end;
  inherited;
end;

procedure TGMJsonDocument.ParseJsonData(const ASource: ISequentialStream; const ACharCoding: TGMCharKind);
// const cBufferSize = $10000; // <- 64 KB
var byteBuffer: AnsiString; bufByteCount, bufChPos, chPos, lineNo: Integer; ch: WideChar;

  procedure MissingInputError(const AMissing: TGMString);
  begin
    raise XGMJsonParsingError.ObjError(MsgMissingInput(AMissing), Self, {$I %CurrentRoutine%});
  end;

  procedure MissingInputErrorChars(const AMissing: TGMString);
  begin
    MissingInputError(GMStrAsQuotedChars(AMissing));
  end;

  procedure WrongInputError(const AExpected: TGMString); // , AFound
  begin
    raise XGMJsonParsingError.ObjError(MsgExpectedChar(AExpected, ch, chPos-1, lineNo), Self, {$I %CurrentRoutine%});
  end;

  procedure WrongInputErrorChars(const AExpected: TGMString);
  begin
    WrongInputError(GMStrAsQuotedChars(AExpected));
  end;

  function IsWhiteSpaceChar(ACh: WideChar): Boolean;
  begin
    Result := (ACh = ' ') or (ACh = #9) or (ACh = #10) or (ACh = #13);
  end;

  function NextChar(var ACh: WideChar): Boolean;
  var byteCh1, byteCh2: AnsiChar; utf8Str: AnsiString; wStr: UnicodeString; byteCount: Integer; mask: Byte;
    function NextCharByte(var AByteCh: AnsiChar): Boolean;
    begin
      if bufChPos > bufByteCount then
       begin
        GMHrCheckObj(ASource.Read(PAnsiChar(byteBuffer), Length(byteBuffer), Pointer(@bufByteCount)), Self, {$I %CurrentRoutine%});
        bufChPos := 1;
       end;
      Result := bufChPos <= bufByteCount;
      if Result then
         begin AByteCh := byteBuffer[bufChPos]; Inc(bufChPos); end;
    end;
  begin
    case ACharCoding of
     ckAnsi: // , jccISO_8859_1
      begin
       Result := NextCharByte(byteCh1);
       if Result then Word(ACh) := Byte(byteCh1);
      end;

     ckUtf16LE:
      begin
       Result := NextCharByte(byteCh1) and NextCharByte(byteCh2);
       if Result then Word(ACh) := Ord(byteCh2) shl 8 + Ord(byteCh1);
      end;

     ckUtf8:
      begin
       Result := NextCharByte(byteCh1);
       if Result then
        begin
         if Byte(byteCh1) and $80 = 0 then Word(ACh) := Byte(byteCh1) else
          begin
           utf8Str := byteCh1;

           byteCount := 0; mask := $80;
           while Byte(byteCh1) and mask <> 0 do begin mask := mask shr 1; Inc(byteCount); end;

           Assert(byteCount > 1, 'byteCount > 1');
           Dec(byteCount);

           while byteCount > 0 do
            begin
             if not NextCharByte(byteCh1) then raise XGMJsonParsingError.ObjError(srEndOfInputInUtf8Sequence);
             utf8Str := utf8Str + byteCh1;
             Assert((Byte(byteCh1) and $80 <> 0) and (Byte(byteCh1) and $40 = 0), '(Byte(byteCh1) and $80 <> 0) and (Byte(byteCh1) and $40 = 0)');
             Dec(byteCount);
            end;

           wStr := GMUtf8ToString(utf8Str);
           Result := Length(wStr) > 0;
           if Result then ACh := wStr[1];
          end;
        end;
      end;

     else Result := False;
    end;

    if Result then
     begin
      if ACh = #10 then begin chPos := 1; Inc(lineNo); end else Inc(chPos);
     end;
  end;

  function NextNonWhiteChar(var ACh: WideChar): Boolean;
  begin
    Result := True;
    while Result and IsWhiteSpaceChar(ACh) do Result := NextChar(ACh);
  end;

//function ReadAnythingUntilOneOfChars(const ACharsToFind: UnicodeString; const AForceNextChar: Boolean = False): UnicodeString;
//begin
//  Result := '';
//  while (GMStrLScanW(PWideChar(ACharsToFind), ch, Length(ACharsToFind)) = nil) do
//    begin
//     Result := Result + ch;
//     if not NextChar(ch) then MissingInputErrorChars(ACharsToFind);
//    end;
//end;

  procedure ReadWhiteSpaceUntilOneOfChars(const ACharsToFind: UnicodeString; const AForceNextChar: Boolean = False);
  begin
    if AForceNextChar then if not NextChar(ch) then MissingInputErrorChars(ACharsToFind);

    if GMStrLScanW(PWideChar(ACharsToFind), ch, Length(ACharsToFind)) = nil then
       if not NextNonWhiteChar(ch) then MissingInputErrorChars(ACharsToFind);

    if GMStrLScanW(PWideChar(ACharsToFind), ch, Length(ACharsToFind)) = nil then WrongInputErrorChars(ACharsToFind);
  end;

  function ParseString: UnicodeString;
  var i: Integer; chCode: Word;
  begin
    SetLength(Result, 0);
    //if ch <> '"' then if not NextNonWhiteChar(ch) then MissingInputError('"');
    ReadWhiteSpaceUntilOneOfChars('"');
    repeat
     if not NextChar(ch) then MissingInputError('"');
     case ch of
      '"': Break;
      #0..#31: raise XGMJsonParsingError.ObjError(MsgInvalidChar(ch, chPos, lineNo), Self, {$I %CurrentRoutine%});
      '\': begin
            if not NextChar(ch) then MissingInputError(srEscapeChar);
            case ch of
             '"', '/', '\': Result := Result + ch;
             'b', 'B': Result := Result + #8;
             't', 'T': Result := Result + #9;
             'n', 'N': Result := Result + #10;
             'f', 'F': Result := Result + #12;
             'r', 'R': Result := Result + #13;
             'u', 'U':
              begin
               chCode := 0;
               for i:=1 to 4 do
                begin
                 if not NextChar(ch) then MissingInputError(srHexDigit);
                 case ch of
                  '0'..'9': chCode := LongInt(chCode shl 4) + Ord(ch) - Ord('0');
                  'a'..'f': chCode := LongInt(chCode shl 4) + Ord(ch) - Ord('a') + 10;
                  'A'..'F': chCode := LongInt(chCode shl 4) + Ord(ch) - Ord('A') + 10;
                  else WrongInputError(srHexDigit);
                 end;
                end;
               Result := Result + WideChar(chCode);
              end;
             else WrongInputErrorChars('"\/btnfru');
            end;
           end;
      else Result := Result + ch;
     end;
    until False;
  end;

  function ParseNumber: RGMJsonValueData;
  const cValueKind: array [Boolean] of EGMJsonValueKind = (jvkInteger, jvkFloat);
  var isFloat: Boolean; numStr: UnicodeString;
  begin
    //
    // Simplified parsing not exactly examining the number syntax
    //
    //FillByte(Result, SizeOf(Result), 0);
    Result := Default(RGMJsonValueData);
    ReadWhiteSpaceUntilOneOfChars('-+0123456789');
    isFloat := False;
    repeat
     case ch of
      '-', '+', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'e', 'E': numStr := numStr + ch;
      '.': begin isFloat := True; numStr := numStr + ch end;
      else Break;
     end;
     if not NextChar(ch) then Break;
    until False;

    Result.ValueKind := cValueKind[isFloat];
    if isFloat then Result.FloatValue := GMStrToDouble(numStr) else Result.IntValue := GMStrToInt64(numStr);
  end;

  //function ParseNumber: RGMJsonValueData;
  //var neg, isFloat: Boolean; negStr, intPart, fracPart, expPart: TGMString;
  //  procedure SetResult(AValueKind: EGMJsonValueKind; const AStrValue: TGMString);
  //  begin
  //    Result.ValueKind := AValueKind;
  //    case AValueKind of
  //     jvkInteger: Result.IntValue := GMStrToInt(AStrValue);
  //     jvkFloat: Result.FloatValue := GMStrToDouble(AStrValue);
  //    end;
  //  end;
  //begin
  //  FillByte(Result, SizeOf(Result), 0);
  //  ReadWhiteSpaceUntilOneOfChars('-+0123456789');
  //  neg := False; isFloat := False; negStr := '';
  //  case ch of
  //   '-', '+': begin neg := ch = '-'; negStr := negStr + ch; if not NextChar(ch) then MissingInputError(srDecimalDigit); end;
  //  end;
  //
  //  intPart := '';
  //  repeat
  //   case ch of
  //    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': intPart := intPart + ch;
  //    else Break;
  //   end;
  //   if not NextChar(ch) then Break;
  //  until False;
  //
  //  if Length(intPart) <= 0 then WrongInputError(srDecimalDigit);
  //
  //  if ch <> '.' then
  //   begin
  //    Result.ValueKind := jvkInteger;
  //    Result.IntValue := GMStrToInt(negStr + intPart);
  //    Exit; // <- NOTE: Exit here!
  //   end;
  //
  //  fracPart := ''; expPart := '';
  //  repeat
  //   case ch of
  //    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': fracPart := fracPart + ch;
  //    else Break;
  //   end;
  //   if not NextChar(ch) then Break;
  //  until False;
  //
  //  if Length(fracPart) <= 0 then WrongInputError(srDecimalDigit);
  //
  //  if IsWhiteSpaceChar(ch) then if not NextNonWhiteChar(ch) then SetResult(jvkFloat, negStr + intPart + '.' + fracPart);
  //
  //  case ch of
  //   'e', 'E': ... ;
  //   else SetResult(jvkFloat, negStr + intPart + '.' + fracPart);
  //  end;
  //end;

  function ParseLiteralTerminal: RGMJsonValueData;
    procedure ParseLiteral(const ALiteral: UnicodeString);
    var i: Integer;
    begin
      for i:=1 to Length(ALiteral) do
       begin
        if ch <> ALiteral[i] then WrongInputErrorChars(ALiteral[i]);
        if not NextChar(ch) then
           if i < Length(ALiteral) then MissingInputErrorChars(ALiteral[i+1]);
       end;
    end;
  begin
    //FillByte(Result, SizeOf(Result), 0);
    Result := Default(RGMJsonValueData);
//  ReadWhiteSpaceUntilOneOfChars('tfn');
    case ch of
     't': begin ParseLiteral(scJsonTrue);  Result.ValueKind := jvkBoolean; Result.BoolValue := True; end;
     'f': begin ParseLiteral(scJsonFalse); Result.ValueKind := jvkBoolean; Result.BoolValue := False; end;
     'n': begin ParseLiteral(scJsonNull);  Result.ValueKind := jvkNull; end;
     else WrongInputErrorChars('tfn');
    end;
  end;


  function ParseValue(const AParent: IGMJsonValueBase; const AName: UnicodeString): IGMJsonValueBase; forward;

  procedure ParseArray(const AJsonArray: IGMJsonValueBase);
  var arrayIsEmpty: Boolean;
  begin
    if AJsonArray = nil then Exit;
//  ReadWhiteSpaceUntilOneOfChars('[');
    arrayIsEmpty := True;
    repeat
     if not NextChar(ch) then MissingInputError(srValueData);
     if arrayIsEmpty and not NextNonWhiteChar(ch) then MissingInputError(srValueData);

     if not arrayIsEmpty or (ch <> ']') then
      begin
       ParseValue(AJsonArray, '');
       ReadWhiteSpaceUntilOneOfChars(',]');
      end;

     arrayIsEmpty := False;
    until ch = ']';
  end;

  procedure ParseJsonObject(const AJsonObj: IGMJsonValueBase);
  var name: TGMString;
  begin
    if AJsonObj = nil then Exit;
//  ReadWhiteSpaceUntilOneOfChars('{');
    repeat
     ReadWhiteSpaceUntilOneOfChars('"}', True);
     if ch <> '}' then
      begin
       name := ParseString;
       ReadWhiteSpaceUntilOneOfChars(':', True);
       if not NextChar(ch) then MissingInputError(srValueData);
       ParseValue(AJsonObj, name); 
       ReadWhiteSpaceUntilOneOfChars(',}');
      end;
    until ch = '}';
  end;

  function ParseValue(const AParent: IGMJsonValueBase; const AName: UnicodeString): IGMJsonValueBase;
    procedure _ReadNextChar;
    begin
//    if not NextChar(ch) then MissingInputErrorChars('"}]');
      if not NextChar(ch) then ch := ' ';
    end;
  begin
    if not NextNonWhiteChar(ch) then MissingInputError(srValueData);
    case ch of
     '"': begin Result := TGMJsonTerminalValue.CreateString(AParent, AName, ParseString); _ReadNextChar; end;

     '{': begin
           Result := TGMJsonObject.Create(AParent, AName);
           ParseJsonObject(Result);
           _ReadNextChar;
          end;

     '[': begin
           Result := TGMJsonArray.Create(AParent, AName);
           ParseArray(Result);
           _ReadNextChar;
          end;

      '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': // '+'
          Result := TGMJsonTerminalValue.CreateValue(AParent, AName, ParseNumber);

      't', 'f', 'n':
          Result := TGMJsonTerminalValue.CreateValue(AParent, AName, ParseLiteralTerminal);

     else
      WrongInputErrorChars('"{[-0123456789tfn'); // +
//     Result := TGMJsonUnknownTerminalValue.CreateString(AName, ReadAnythingUntilOneOfChars(',}]'));
    end;
  end;

  procedure ParseRootValues;
  begin
    while NextNonWhiteChar(ch) do ParseValue(Self, '');
  end;
begin
  if ASource <> nil then
   begin
    SetLength(byteBuffer, cDfltCopyBufferSize);
    chPos := 1; lineNo := 1; bufByteCount := 0; bufChPos := 1; ch := ' ';
    ParseRootValues;
   end;
end;

function TGMJsonDocument.AsString(const AIndent: UnicodeString): UnicodeString;
var it: IGMJSONValuesIterator; val: IGMJsonValueBase; firstVal: Boolean; // unkValue: IUnknown;
begin
//Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', '{');
  Result := '';
  firstVal := True;
  it := CreateSubValueIterator;
  while it.NextEntry(val) do // unkValue
   //if GMQueryInterface(unkValue, IGMJsonValueBase, val) then
    begin
     if Length(AIndent) > 0 then
       if firstVal then firstVal := False else Result := Result + gJsonNewLine;
     Result := Result + val.AsString(AIndent);
    end;
//Result := Result + gJsonNewLine + AIndent + '}';
end;


{ ------------------------------ }
{ ---- TGMJsonArrayIterator ---- }
{ ------------------------------ }

constructor TGMJsonArrayIterator<T>.Create(const AJsonArray: IUnknown; const AReverse, ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FReverse := AReverse;
  GMQueryInterface(AJsonArray, IGMJsonValueContainer, FJsonArray);
  Reset;
end;

function TGMJsonArrayIterator<T>.NextEntry(var AEntry: T): Boolean;
begin
  Result := (FJsonArray <> nil) and (FPosition >= FJsonArray.ArrayLowBound) and (FPosition <= FJsonArray.ArrayHighBound);

//vfGMTrace('Array bounds: ' + GMIntToStr(FJsonArray.ArrayLowBound)+' .. '+GMIntToStr(FJsonArray.ArrayHighBound), 'Array');

  if not Result then Exit;

  AEntry := FJsonArray[FPosition];

  if FReverse then Dec(FPosition) else Inc(FPosition);
end;

procedure TGMJsonArrayIterator<T>.Reset;
begin
  if FJsonArray = nil then FPosition := 0 else
    if FReverse then FPosition := FJsonArray.ArrayHighBound else FPosition := FJsonArray.ArrayLowBound;
end;


end.