{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   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

  //TGMCharKind = (ckAnsi, ckUtf8, ckUtf16LE, jccISO_8859_1);

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

  TGMJsonFloat = Double;


  PGMJsonValueData = ^RGMJsonValueData;

  RGMJsonValueData = packed record
    //StringValue: UnicodeString;

    function IsNullOrUnassigned: Boolean;

    class operator Implicit(const AJsonValue: RGMJsonValueData): Boolean;
    class operator Implicit(const AJsonValue: RGMJsonValueData): Int64;
    class operator Implicit(const AJsonValue: RGMJsonValueData): LongInt;
    class operator Implicit(const AJsonValue: RGMJsonValueData): Double;
    class operator Implicit(const AJsonValue: RGMJsonValueData): TDateTime;
    class operator Implicit(const AJsonValue: RGMJsonValueData): UnicodeString;
    class operator Implicit(const AJsonValue: RGMJsonValueData): AnsiString;
    class operator Implicit(const AJsonValue: RGMJsonValueData): RGMUnionValue;

    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: AnsiString): RGMJsonValueData;
    class operator Implicit(const AValue: RGMUnionValue): RGMJsonValueData;

    function AsString: 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(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): IGMIterator; // <- may return nil!
    procedure WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind = ckUtf8; const AIndent: TGMString = '');
    property Parent: IGMJsonValueBase read GetParent write SetParent;
  end;


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


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


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

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


  TGMJsonValueBase = class(TGMRefCountedObj, IGMJsonValueBase, IGMGetName, IGWriteToStream)
   protected
    FName: UnicodeString;
    FParent: IGMJsonValueBase;
    //FSharedParents: array of 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): IGMIterator; 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, IGMGetStringValue)
   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;
    destructor Destroy; override;
    function ValueKind: EGMJsonValueKind; override;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
    function GetStringValue: UnicodeString;
    function GetUnionValue: RGMUnionValue;
    function GetValueData: RGMJsonValueData;
    //function GetOleValue: OleVariant; stdcall;
    procedure SetValueData(const AVAlueData: RGMJsonValueData);
    procedure SetStringValue(const AStringValue: UnicodeString);
  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
  //
  TGMJsonObjectValue = class(TGMJsonValueBase, IGMJsonObject, IGMJsonContainerInternal)
   protected
    FReleasingMembers: Boolean;
    FValues: IGMIntfCollection;

    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: IGMIntfCollection;
    function CreateSubValueIterator(const AReverse: Boolean = False): IGMIterator; override;

    property Values: IGMIntfCollection read GetValues;
  end;


  //
  // Internal contract: will be disposed when Values.Count = RefCount => no more external references, only expected references from Parent memebers
  //
  TGMJsonArrayValue = class(TGMJsonValueBase, IGMJsonArray, IGMJsonContainerInternal)
   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 ValueKind: EGMJsonValueKind; override;
    function AsString(const AIndent: UnicodeString = ''): UnicodeString; override;
    function ArrayLowBound: PtrInt;
    function ArrayHighBound: PtrInt;
    function GetArrayValueAt(const AArrayIdx: PtrInt): IGMJsonValueBase;
    function CreateSubValueIterator(const AReverse: Boolean = False): IGMIterator; override;

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


  TGMJsonArrayIterator = class(TGMRefCountedObj, IGMIterator)
   protected
    FReverse: Boolean;
    FPosition: PtrInt;
    FJsonArray: IGMJsonArray;

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


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


  TGMJsonDocument = class (TGMJsonObjectValue, 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 GMJsonValueDataRec(const AValue: Variant): RGMJsonValueData; {$IFDEF HAS_INLINE}inline;{$ENDIF}
//function GMJsonValueDataRecInt(const AValue: Int64): RGMJsonValueData; {$IFDEF HAS_INLINE}inline;{$ENDIF}
//function GMJsonValueDataRecFloat(const AValue: TGMJsonFloat): RGMJsonValueData; {$IFDEF HAS_INLINE}inline;{$ENDIF}
//function GMJsonValueDataRecBool(const AValue: Boolean): RGMJsonValueData; {$IFDEF HAS_INLINE}inline;{$ENDIF}

procedure SetValueDataString(var AValueData: RGMJsonValueData; const AStringValue: UnicodeString); {$IFDEF HAS_INLINE}inline;{$ENDIF}
procedure FinalizeValueData(var AValueData: RGMJsonValueData); {$IFDEF HAS_INLINE}inline;{$ENDIF}

function JsonValueDataAsString(const AValue: RGMJsonValueData; const AJsonEncoded: Boolean = True): UnicodeString;
function JsonValueDataAsVariant(const AValue: RGMJsonValueData): Variant;

function JsonEncodeEscapeChars(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 charachter "%s" at position %d on line %d';
  srEscapeChar = 'Escape character';
  srHexDigit = 'Hexadecimal digit';
  srValueData = 'Value data';
  srJsonconvertErrFmt = 'Cannot convert JSON value kind "%s" to type %s';
  //srDecimalDigit = 'decimal digit';
  //srNumber = 'number';
  //srUnknownJsonContent = 'Unknown';
  //srUsupportedJsonContent = 'Unsupported JSON content';
  srEndOfInputInUtf8Sequence = 'Unexpected end of input in Utf-8 multibyte charachter sequence';



{ ------------------------- }
{ ---- 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 JsonEncodeEscapeChars(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 GMJsonValueDataRec(const AValue: Variant): RGMJsonValueData;
//begin
//  FillChar(Result, SizeOf(Result), 0);
//  Result.ValueKind := jvkUnassigned;
//
//  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: SetValueDataString(Result, AValue);
//   varEmpty, varNull: Result.ValueKind := jvkNull;
//   //else Result.ValueKind := jvkUnassigned;
//  end;
//end;
//
//function GMJsonValueDataRecInt(const AValue: Int64): RGMJsonValueData;
//begin
//  Result.IntValue := AValue;
//  Result.ValueKind := jvkInteger;
//end;
//
//function GMJsonValueDataRecFloat(const AValue: TGMJsonFloat): RGMJsonValueData;
//begin
//  Result.FloatValue := AValue;
//  Result.ValueKind := jvkFloat;
//end;
//
//function GMJsonValueDataRecBool(const AValue: Boolean): RGMJsonValueData;
//begin
//  Result.BoolValue := AValue;
//  Result.ValueKind := jvkBoolean;
//end;


{ ---------------------------- }
{ ---- ValueData Routines ---- }
{ ---------------------------- }

procedure FinalizeValueData(var AValueData: RGMJsonValueData);
begin
  case AValueData.ValueKind of
// jvkObject, jvkArray: IUnknown(AValueData.ObjectValue) := nil;
   //jvkString: if AValueData.StringValue <> nil then begin Dispose(AValueData.StringValue); AValueData.StringValue := nil; end;
   jvkString: if AValueData.StringValue <> nil then UnicodeString(AValueData.StringValue) := '';
   //else AValueData.StringValue := nil;  //FillChar(AValueData, SizeOf(AValueData), 0);
  end;
  AValueData.StringValue := nil;
  AValueData.ValueKind := jvkUnassigned;
end;

procedure SetValueDataString(var AValueData: RGMJsonValueData; const AStringValue: UnicodeString);
begin
  if AValueData.ValueKind <> jvkString then FinalizeValueData(AValueData);
  //if AValueData.StringValue = nil then New(AValueData.StringValue);
  //AValueData.StringValue^ := AStringValue;
  UnicodeString(AValueData.StringValue) := AStringValue;
  AValueData.ValueKind := jvkString;
end;


{ ------------------------- }
{ ---- Output Routines ---- }
{ ------------------------- }

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

function JsonValueDataAsString(const AValue: RGMJsonValueData; const AJsonEncoded: Boolean = True): UnicodeString;
begin
  case AValue.ValueKind of
// jvkUnassigned: Result := '<' + srUnknownJsonContent + '>';
   jvkNull: Result := scJsonNull;
   jvkBoolean: Result := GMBoolToStr(AValue.BoolValue, scJsonFalse, scJsonTrue);
   jvkString:
     begin
      if AValue.StringValue = nil then Result := '' else Result := UnicodeString(AValue.StringValue); // AValue.StringValue^;
      if AJsonEncoded then Result := '"'+ JsonEncodeEscapeChars(Result) + '"';
     end;
   jvkInteger: Result := GMIntToStr(AValue.IntValue);
   jvkFloat: Result := JsonFloatToString(AValue.FloatValue); // GMDoubleToStr(AValue.FloatValue);
// jvkObject,
// jvkArray
   else Result := '';
  end;
end;

function JsonValueDataAsVariant(const AValue: RGMJsonValueData): Variant;
begin
  case AValue.ValueKind of
// jvkUnassigned: Result := Unassigned;
   jvkNull:    Result := Null;
   jvkBoolean: Result := AValue.BoolValue;
   jvkString:  begin
                if AValue.StringValue = nil then Result := '' else Result := UnicodeString(AValue.StringValue); // AValue.StringValue^;
               end;
   jvkInteger: Result := AValue.IntValue;
   jvkFloat:   Result := AValue.FloatValue;
// jvkObject,
// jvkArray
   else Result := Unassigned;
  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.Implicit(const AJsonValue: RGMJsonValueData): Boolean;
begin
  case AJsonValue.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: Result := AJsonValue.BoolValue;
   //jvkString: Result := GMStrToBool(AJsonValue.StringValue^);
   jvkString: Result := GMStrToBool(UnicodeString(AJsonValue.StringValue));
   jvkInteger: Result := AJsonValue.IntValue <> 0;
   jvkFloat: Result := AJsonValue.FloatValue <> 0.0;
   else raise XGMJsonConvertError.ObjError(GMformat(srJsonconvertErrFmt, [ValueKindName(AJsonValue.ValueKind), 'Boolean']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

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

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

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

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

class operator RGMJsonValueData.Implicit(const AJsonValue: RGMJsonValueData): UnicodeString;
begin
  case AJsonValue.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: if AJsonValue.BoolValue then Result := 'True' else Result := 'False';
   //jvkString: Result := AJsonValue.StringValue^;
   jvkString: Result := UnicodeString(AJsonValue.StringValue);
   jvkInteger: Result := GMIntToStr(AJsonValue.IntValue);
   jvkFloat: Result := GMdoubleToStr(AJsonValue.FloatValue);
   else raise XGMJsonConvertError.ObjError(GMformat(srJsonconvertErrFmt, [ValueKindName(AJsonValue.ValueKind), 'UnicodeString']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

class operator RGMJsonValueData.Implicit(const AJsonValue: RGMJsonValueData): AnsiString;
begin
  case AJsonValue.ValueKind of
   //jvkUnassigned, jvkNull
   jvkBoolean: if AJsonValue.BoolValue then Result := 'True' else Result := 'False';
   //jvkString: Result := AJsonValue.StringValue^;
   jvkString: Result := UnicodeString(AJsonValue.StringValue);
   jvkInteger: Result := GMIntToStr(AJsonValue.IntValue);
   jvkFloat: Result := GMdoubleToStr(AJsonValue.FloatValue);
   else raise XGMJsonConvertError.ObjError(GMformat(srJsonconvertErrFmt, [ValueKindName(AJsonValue.ValueKind), 'AnsiString']), nil, 'RGMJsonValueData.Implicit');
  end;
end;

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

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

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

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

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

class operator RGMJsonValueData.Implicit(AValue: UnicodeString): RGMJsonValueData;
begin
  //FillChar(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  SetValueDataString(Result, AValue);
end;

class operator RGMJsonValueData.Implicit(AValue: AnsiString): RGMJsonValueData;
begin
  //FillChar(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  SetValueDataString(Result, AValue);
end;

class operator RGMJsonValueData.Implicit(const AValue: RGMUnionValue): RGMJsonValueData;
begin
  //FillChar(Result, SizeOf(Result), 0);
  Result := Default(RGMJsonValueData);
  case AValue.ValueType of
   uvtUnassigned: Result.ValueKind := jvkUnassigned;
   uvtNull: Result.ValueKind := jvkNull;
   uvtString: Result := AValue.StringValue;
   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);
  end;
end;

function RGMJsonValueData.AsString: TGMString;
begin
  case ValueKind of
   jvkUnassigned, jvkNull: Result := '';
   else Result := Self;
  end;
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; stdcall;
begin
  Result := FName;
end;

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

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

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

procedure TGMJsonValueBase.WriteToStream(const ADestStream: ISequentialStream; const ACharCoding: TGMCharKind; const AIndent: TGMString);
const cStrMethodname = 'TGMJsonValueBase.WriteToStream';
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), cStrMethodname);
   ckAnsi: begin // , jccISO_8859_1
            aStr := strVal;
            GMSafeIStreamWrite(ADestStream, PAnsiChar(aStr), Length(aStr), cStrMethodname);
           end;
   ckUtf8: begin
            aStr := GMStringToUtf8(strVal);
            GMSafeIStreamWrite(ADestStream, PAnsiChar(aStr), Length(aStr), cStrMethodname);
            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;

destructor TGMJsonTerminalValue.Destroy;
begin
  FinalizeValueData(FValueData);
  inherited;
end;

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

function TGMJsonTerminalValue.AsString(const AIndent: UnicodeString = ''): UnicodeString;
begin
  Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', JsonValueDataAsString(FValueData));
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.SetStringValue(const AStringValue: UnicodeString);
begin
  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;


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

constructor TGMJsonObjectValue.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FValues := TGMIntfArrayCollection.Create(True, False, nil, True);
end;

function TGMJsonObjectValue._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 TGMJsonObjectValue.GetValues: IGMIntfCollection;
begin
  Result := FValues;
end;

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

function TGMJsonObjectValue.InternalAddValue(const AValue: IGMJsonValueBase): IGMJsonValueBase;
begin
  //Result := FValues.Add(AValue);
  if AValue = nil then Result := nil else
     GMQueryInterface(FValues.Add(AValue), IGMJsonValueBase, Result);
end;

function TGMJsonObjectValue.InternalRemoveValue(const AValue: IGMJsonValueBase): Boolean;
begin
  if AValue = nil then Result := False else Result := FValues.RemoveByInstance(AValue);
end;

function TGMJsonObjectValue.CreateSubValueIterator(const AReverse: Boolean): IGMIterator;
begin
  Result := Values.CreateIterator(AReverse);
end;

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

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

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

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


{ --------------------------- }
{ ---- TGMJsonArrayValue ---- }
{ --------------------------- }

function TGMJsonArrayValue._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 TGMJsonArrayValue.ValueKind: EGMJsonValueKind;
begin
  Result := jvkArray;
end;

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

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

function TGMJsonArrayValue.GetArrayValueAt(const AArrayIdx: PtrInt): IGMJsonValueBase;
begin
  Result := FValues[AArrayIdx];
end;

function TGMJsonArrayValue.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 TGMJsonArrayValue.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 memebers
    end;
end;

function TGMJsonArrayValue.CreateSubValueIterator(const AReverse: Boolean): IGMIterator;
begin
  Result := TGMJsonArrayIterator.Create(Self, AReverse, True);
end;

function TGMJsonArrayValue.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;
  inherited;
end;

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

  function StrToQuotedChars(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;

  procedure MissingInputError(const AMissing: TGMString);
  begin
    raise XGMJsonParsingError.ObjError(MsgMissingInput(AMissing), Self, cStrMethodName);
  end;

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

  procedure WrongInputError(const AExpected: TGMString); // , AFound
  begin
    raise XGMJsonParsingError.ObjError(MsgExpectedChar(AExpected, ch, chPos-1, lineNo), Self, cStrMethodName);
  end;

  procedure WrongInputErrorChars(const AExpected: TGMString);
  begin
    WrongInputError(StrToQuotedChars(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, cStrMethodName);
        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, cStrMethodName);
      '\': 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 := (chCode shl 4) + Ord(ch) - Ord('0');
                  'a'..'f': chCode := (chCode shl 4) + Ord(ch) - Ord('a') + 10;
                  'A'..'F': chCode := (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
    //
    //FillChar(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
  //  FillChar(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
    //FillChar(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 := TGMJsonObjectValue.Create(AParent, AName);
           ParseJsonObject(Result);
           _ReadNextChar;
          end;

     '[': begin
           Result := TGMJsonArrayValue.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: IGMIterator; unkValue: IUnknown; val: IGMJsonValueBase; firstVal: Boolean;
begin
//Result := AIndent + GMStringJoin(JsonQuotedName(FName), ': ', '{');
  Result := '';
  firstVal := True;
  it := Values.CreateIterator;
  while it.NextEntry(unkValue) do
   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.Create(const AJsonArray: IUnknown; const AReverse, ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FReverse := AReverse;
  GMQueryInterface(AJsonArray, IGMJsonArray, FJsonArray);
  Reset;
end;

function TGMJsonArrayIterator.NextEntry(out AEntry): Boolean;
var unkEntry: IUnknown;
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;

  GMQueryInterface(FJsonArray[FPosition], IUnknown, unkEntry);
  IUnknown(AEntry) := unkEntry;
  if FReverse then Dec(FPosition) else Inc(FPosition);
end;

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


end.