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

{$INCLUDE GMCompilerSettings.inc}

unit GMJsonPath;

interface

uses //{$IFDEF JEDIAPI}JwaWinType,{$ENDIF}
     GMStrDef, GMCollections, GMIntf, GMCommon, GMUnionValue, GMJson;

type

  TJsonPathSelector = (jpsUnknown, jpsRoot, jpsSelf, jpsChildName, jpsChildIdx, jpsChildSlice, jpsDescendant, jpsWildcard);


  RGMJsonPathSelector = record
   Selector: TJsonPathSelector;
   MemberName: TGMString;
   StartIdx: Integer;
   EndIdx: Integer;
   IdxStep: Integer;
  end;


  //TGMJsonPathEvaluator = class;
  //
  //IGMJsonPathEvaluator = interface(IUnknown)
  //  ['{1A2FA727-ACCF-4E95-933F-29F96E966411}']
  //  function Obj: TGMJsonPathEvaluator;
  //end;
  //
  //TGMJsonPathEvaluator = class(TGMRefCountedObj, IGMJsonPathEvaluator)
  // protected
  //  FJsonRoot: IGMJsonValueBase;
  //
  //  procedure EvaluateSelector(constref ASelector: RGMJsonPathSelector; constref AInputNodes, AMatchingNodes: IGMJSONValuesCollection);
  //  function ParseSelectors(const AJsonPathExpression: TGMString): IGMJSONValuesCollection;
  //
  // public
  //  constructor Create(const ARefLifeTime: Boolean = True); overload; override;
  //  constructor Create(const AJsonRoot: IGMJsonValueBase; const ARefLifeTime: Boolean = True); reintroduce; overload;
  //  function Obj: TGMJsonPathEvaluator;
  //
  //  function EvaluateJsonPathExpression(const AJsonPathExpression: TGMString): IGMJSONValuesCollection;
  //end;


  EGMJsonPathException = class(EGMException);


function GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJSONValuesCollection;

function GMGetJsonTerminalValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): RGMJsonValueData;

function GMGetJsonTerminalValueDflt(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase;
                                    const ADefaultValue: RGMUnionValue; const AApplyDefaultOnNullValues: Boolean = True): RGMUnionValue;

function GMGetJsonArray(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): IGMJsonValueContainer;

function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJsonValueBase; overload;
function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AIID: TGUID; out AIntf): Boolean; overload;


function GMCreateJSONValueCollection: IGMJSONValuesCollection;



implementation

uses TypInfo;

resourcestring

  srNoValueMatchingExprFmt = 'No JSON %s value found matching the JSON-path expression "%s"';
  srUnexpectedExprChar = 'Invalid character "%s" in JSON path expression at position %d, excpeted %s';

  srTerminal = 'terminal';
  srArray = 'array';


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

function GMCreateJSONValueCollection: IGMJSONValuesCollection;
begin
  Result := TGMGenericArrayCollection<IGMJsonValueBase>.Create;
end;

procedure NotImplemented(const AName: TGMString);
begin
  raise EGMJsonPathException.ObjError('JSON path ' + AName + ' not implemented yet', nil, 'NotImplemented')
end;


{ ------------------------------ }
{ ---- TGMJsonPathEvaluator ---- }
{ ------------------------------ }

//constructor TGMJsonPathEvaluator.Create(const ARefLifeTime: Boolean);
//begin
//  inherited Create(ARefLifeTime);
//end;
//
//constructor TGMJsonPathEvaluator.Create(const AJsonRoot: IGMJsonValueBase; const ARefLifeTime: Boolean);
//begin
//  Create(ARefLifeTime);
//  FJsonRoot := AJsonRoot;
//end;
//
//function TGMJsonPathEvaluator.Obj: TGMJsonPathEvaluator;
//begin
//  Result := Self;
//end;

procedure EvaluateSelector(constref ASelector: RGMJsonPathSelector; const AJsonRoot: IGMJsonValueBase; const AInputNodes, AMatchingNodes: IGMJSONValuesCollection);
var inputValueIt, subValueIt: IGMJSONValuesIterator; ctxNode, subNode: IGMJsonValueBase; containerNode: IGMJsonValueContainer;
    idx, startIdx, endIdx, len: PtrInt;
  procedure AddDescendants(const ANode: IGMJsonValueBase);
  var it: IGMJSONValuesIterator; subNode: IGMJsonValueBase;
  begin
    if ANode = nil then Exit;
    AMatchingNodes.Add(ANode);
    it := ANode.CreateSubValueIterator;
    if it <> nil then
     while it.NextEntry(subNode) do AddDescendants(subNode);
  end;

  function NormalizeIdx(AIndex, AArrayLength: PtrInt): PtrInt;
  begin
    if AIndex >= 0 then Exit(AIndex) else Exit(AArrayLength + AIndex);
  end;
begin
  if AMatchingNodes = nil then Exit;

  if ASelector.Selector = jpsRoot then AMatchingNodes.Add(AJsonRoot) else
   if AInputNodes <> nil then
    begin
     inputValueIt := AInputNodes.CreateIterator;
     while inputValueIt.NextEntry(ctxNode) do
      case ASelector.Selector of
       //jpsUnknown,
       //jpsRoot: AMatchingNodes.Add(FJsonRoot);
       jpsSelf: AMatchingNodes.Add(ctxNode);
       jpsChildName: begin
                      if Length(ASelector.MemberName) <= 0 then
                       begin
                        if GMQueryInterface(ctxNode, IGMJsonValueContainer, containerNode) and
                           (containerNode.FirstValue <> nil) then AMatchingNodes.Add(containerNode.FirstValue);
                       end
                      else
                       begin
                        subValueIt := ctxNode.CreateSubValueIterator;
                        if subValueIt <> nil then
                         while subValueIt.NextEntry(subNode) do
                           if GMsameText(subNode.ValueName, ASelector.MemberName) then AMatchingNodes.Add(subNode);
                       end;
                     end;

       jpsChildIdx: if GMQueryInterface(ctxNode, IGMJsonValueContainer, containerNode) then
                      begin
                       len := containerNode.ArrayLength;
                       idx := NormalizeIdx(ASelector.StartIdx, len);
                       if GMIsInrange(idx, 0, len-1) then AMatchingNodes.Add(containerNode[idx]);
                      end;

       jpsChildSlice: if GMQueryInterface(ctxNode, IGMJsonValueContainer, containerNode) then
                       begin
                        len := containerNode.ArrayLength;
                        startIdx := NormalizeIdx(ASelector.StartIdx, len);
                        endIdx := NormalizeIdx(ASelector.EndIdx, len);

                        if ASelector.IdxStep > 0 then
                         begin
                          endIdx := Min(endIdx, len);
                          idx := Max(0, startIdx);
                          while idx < endIdx do
                           begin
                            AMatchingNodes.Add(containerNode[idx]);
                            Inc(idx, ASelector.IdxStep);
                           end;
                         end;

                        if ASelector.IdxStep < 0 then
                         begin
                          startIdx := Max(0, startIdx);
                          idx := Min(endIdx, len-1);
                          while startIdx < idx do
                           begin
                            AMatchingNodes.Add(containerNode[idx]);
                            Inc(idx, ASelector.IdxStep);
                           end;
                         end;
                       end;

       jpsDescendant: AddDescendants(ctxNode);

       jpsWildcard: begin
                     subValueIt := ctxNode.CreateSubValueIterator;
                     if subValueIt <> nil then
                       while subValueIt.NextEntry(subNode) do AMatchingNodes.Add(subNode);
                    end;
      end;
    end;
end;


function ParseSelectors(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJSONValuesCollection;
var selectorData: RGMJsonPathSelector; inputNodes, matchingNodes: IGMJSONValuesCollection; pExprCh: PGMChar; ch: TGMChar;
    isUnion: Boolean;

  function MsgUnexpectedChar(const AExpectedChars: TGMString): TGMString; // ; AFoundChr: TGMChar; ACharPos: Integer
  begin
    Result := GMFormat(srUnexpectedExprChar, [pExprCh^, pExprCh - PGMChar(AJsonPathExpression) + 1, GMStrAsQuotedChars(AExpectedChars)]);
  end;

  procedure ExcpectedChars(const AExpectedChars: TGMString);
  begin
    raise EGMJsonPathException.ObjError(MsgUnexpectedChar(AExpectedChars), nil, 'ParseSelectors')
  end;

  procedure SkipWhiteSpace;
  begin
    while pExprCh^ <> #0 do
     case pExprCh^ of
      ' ', #9, #10, #13: Inc(pExprCh);
      else Break;
     end;
  end;

  function ParseDotName: TGMString;
  var pStartCh: PGMChar;
  begin
    pStartCh := pExprCh;

    while pExprCh^ <> #0 do
     case pExprCh^ of
      '0' .. '9', 'a' ..'z', 'A' .. 'Z', '_': Inc(pExprCh);
      else if Ord(pExprCh^) < 128 then Break;
     end;

    SetLength(Result, pExprCh - pStartCh);
    if Length(Result) > 0 then System.Move(pStartCh^, Result[1], Length(Result) * SizeOf(TGMChar));
  end;

  function ParseNumber: Integer;
  var pStartCh: PGMChar; numStr: TGMString;
  begin
    pStartCh := pExprCh;

    while pExprCh^ <> #0 do
     case pExprCh^ of
      '0' .. '9': Inc(pExprCh);
      else Break;
     end;

    SetLength(numStr, pExprCh - pStartCh);
    if Length(numStr) > 0 then System.Move(pStartCh^, numStr[1], Length(numStr) * SizeOf(TGMChar));
    Result := GMStrToInt(numStr);
  end;

  function ParseQuotedString(AQuoteCh: TGMChar): TGMString;
  var pStartCh: PGMChar;
  begin
    {ToDo: Properly parse escape sequences and unicode characters in quoted strings}
    pStartCh := pExprCh;
    while (pExprCh^ <> #0) and (pExprCh^ <> AQuoteCh) do Inc(pExprCh);
    SetLength(Result, pExprCh - pStartCh);
    if Length(Result) > 0 then System.Move(pStartCh^, Result[1], Length(Result) * SizeOf(TGMChar));
    if pExprCh^ = AQuoteCh then Inc(pExprCh);
  end;

  procedure ParseFilterSelector;
  begin
    {ToDo: Implement jpsDescendant filter selectors}
    NotImplemented('filter selectors');
    //raise EGMJsonPathException.ObjError('Filter selectors not implemented yet', Self, 'ParseSelectors')
  end;


begin
  //if (AInputNodes = nil) or AInputNodes.IsEmpty then Exit(GMCreateJSONValueCollection);

  pExprCh := PGMChar(AJsonPathExpression);

  //inputNodes := GMCreateJSONValueCollection;

  while pExprCh^ <> #0 do
   begin
    selectorData := Default(RGMJsonPathSelector); // <- always reset selector at the beginning of each loop
    matchingNodes := GMCreateJSONValueCollection;

    case pExprCh^ of
     '$': begin selectorData.Selector := jpsRoot; Inc(pExprCh); end;
     '.': begin
           if (pExprCh + 1)^ = '.' then
            begin
             selectorData.Selector := jpsDescendant;
             if (pExprCh + 2)^ = '[' then Inc(pExprCh, 2) else Inc(pExprCh, 1); // <- use the last dot as member selector for the next round
            end
           else
           if (pExprCh + 1)^ = '*' then begin selectorData.Selector := jpsWildcard; Inc(pExprCh, 2); end
           else
            begin
             Inc(pExprCh);
             selectorData.Selector := jpschildName;
             selectorData.MemberName := ParseDotName;
            end;
          end;

     '[': begin
           Inc(pExprCh);
           repeat
            SkipWhiteSpace;
            isUnion := False;
            case pExprCh^ of
             '''', '"': begin
                         ch := pExprCh^;
                         Inc(pExprCh);
                         selectorData.Selector := jpschildName;
                         selectorData.MemberName := ParseQuotedString(ch);
                         SkipWhiteSpace;
                         case pExprCh^ of
                          ']': Inc(pExprCh);
                          ',': begin isUnion := True; Inc(pExprCh); end;
                          else ExcpectedChars('],');
                         end;
                        end;

             '*': begin
                   selectorData.Selector := jpsWildcard;
                   Inc(pExprCh);
                   SkipWhiteSpace;
                   if pExprCh^ <> ']' then ExcpectedChars(']');
                   Inc(pExprCh);
                  end;

             ']': begin selectorData.Selector := jpschildName; Inc(pExprCh); end;

             '?': ParseFilterSelector; {ToDo: Parse filter selector}

             ':': NotImplemented('array slice selectors');

             '0' .. '9': begin
                          selectorData.Selector := jpsChildIdx;
                          selectorData.StartIdx := ParseNumber;
                          SkipWhiteSpace;
                          case pExprCh^ of
                           ']': Inc(pExprCh);
                           ',': begin isUnion := True; Inc(pExprCh); end;
                           ':': NotImplemented('array slice selectors');  {ToDo: Parse array slice selector}
                           else ExcpectedChars('],:');
                          end;
                         end;
             else ExcpectedChars('''"*]?:0123456789');
            end;
            if isUnion then
              begin
               EvaluateSelector(selectorData, AJsonRoot, inputNodes, matchingNodes);
               selectorData := Default(RGMJsonPathSelector);
              end;
           until not isUnion;
          end;

     else ExcpectedChars('$.[');
    end;

    if selectorData.Selector <> jpsUnknown then
     begin
      EvaluateSelector(selectorData, AJsonRoot, inputNodes, matchingNodes);
      inputNodes := matchingNodes;
     end;

    SkipWhiteSpace;
   end;

  if matchingNodes = nil then Result := GMCreateJSONValueCollection else Result := matchingNodes; // <- always return a valid collection object
end;

//function TGMJsonPathEvaluator.EvaluateJsonPathExpression(const AJsonPathExpression: TGMString): IGMJSONValuesCollection;
//begin
//  if (FJsonRoot = nil) or (Length(AJsonPathExpression) <= 0) then Exit(GMCreateJSONValueCollection);
//  Result := ParseSelectors(AJsonPathExpression);
//end;


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

function GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJSONValuesCollection;
//var evaluator: IGMJsonPathEvaluator;
begin
  //evaluator := TGMJsonPathEvaluator.Create(AJsonRoot);
  //Result := evaluator.Obj.EvaluateJsonPathExpression(AJsonPathExpression);

  if (AJsonRoot = nil) or (Length(AJsonPathExpression) <= 0) then Exit(GMCreateJSONValueCollection);
  Result := ParseSelectors(AJsonPathExpression, AJsonRoot);
end;
                                                                        
function GMGetJsonTerminalValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject): RGMJsonValueData;
var matchingValues: IGMJSONValuesCollection; termVal: IGMJsonTerminalValue; it: IGMJSONValuesIterator; // unkVal: IUnknown;
    jsonEntry: IGMJsonValueBase;
begin
  matchingValues := GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot);

  it := matchingValues.CreateIterator;
  if it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, IGMJsonTerminalValue, termVal) then
    Result := termVal.ValueData
  else
    raise EGMJsonPathException.ObjError(GMFormat(srNoValueMatchingExprFmt, [srTerminal, AJsonPathExpression]), ACaller, {$I %CurrentRoutine%});
end;


function GMGetJsonTerminalValueDflt(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ADefaultValue: RGMUnionValue; const AApplyDefaultOnNullValues: Boolean): RGMUnionValue;
var matchingValues: IGMJSONValuesCollection; jsonEntry: IGMJsonValueBase; termVal: IGMJsonTerminalValue; it: IGMJSONValuesIterator;
begin
  matchingValues := GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot);

  it := matchingValues.CreateIterator;

  if it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, IGMJsonTerminalValue, termVal) and not (termVal.ValueData.IsNullOrUnassigned and AApplyDefaultOnNullValues) then
    Result := termVal.ValueData
  else
    Result := ADefaultValue;
end;


function GMGetJsonArray(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject = nil): IGMJsonValueContainer;
var matchingValues: IGMJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: IGMJSONValuesIterator;
begin
  matchingValues := GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot);

  it := matchingValues.CreateIterator;
  if not it.NextEntry(jsonEntry) or not GMQueryInterface(jsonEntry, IGMJsonValueContainer, Result) then
     raise EGMJsonPathException.ObjError(GMFormat(srNoValueMatchingExprFmt, [srArray]) +': '+ AJsonPathExpression, ACaller, {$I %CurrentRoutine%});
end;


function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJsonValueBase;
var matchingValues: IGMJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: IGMJSONValuesIterator;
begin
  matchingValues := GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot);

  it := matchingValues.CreateIterator;
  if not it.NextEntry(jsonEntry) or not GMQueryInterface(jsonEntry, IGMJsonValueBase, Result) then Result := nil;
end;


function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const AIID: TGUID; out AIntf): Boolean;
var matchingValues: IGMJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: IGMJSONValuesIterator;
begin
  matchingValues := GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot);

  it := matchingValues.CreateIterator;
  Result := it.NextEntry(jsonEntry) and GMQueryInterface(jsonEntry, AIID, AIntf);
end;


end.