{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Simple JSON Path implementation.             | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2018 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed 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

  // jpaAncestor, jpaAncestorOrSelf, jpaNamespace,
  TJsonPathScope = (jpsRoot, jpsChild, jpsDescendant, jpsDescendantOrSelf, jpsFollowing,
                    jpsFollowingSibling, jpsPreceding, jpsPrecedingSibling, jpsSelf);

//TXPathPredicate = (xppFirst, xppLast);

  TJsonPathExprStepRec = record
    Axis: TJsonPathScope;
    NodeTest: TGMString;
//  Predicate: TGMString; // TXPathPredicate;
  end;


  TGMJsonPathEvaluator = class;

  IGMJsonPathEvaluator = interface(IUnknown)
    ['{1A2FA727-ACCF-4E95-933F-29F96E966411}']
    function Obj: TGMJsonPathEvaluator;
  end;

  TGMMatchingJSONValuesCollection = IGMGenericCollection<IGMJsonValueBase>;

  TGMJsonPathEvaluator = class(TGMRefCountedObj, IGMJsonPathEvaluator)
   protected
    FJsonDocument: IGMJsonValueBase;
    FMatchingEntries: TGMMatchingJSONValuesCollection;

    procedure IterateMatchingNodes(const AJsonPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TJsonPathExprStepRec);
    procedure EvaluateNextLocationStep(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
    procedure EvaluateSingleExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown);

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AJsonRoot: IGMJsonValueBase; const AMatchingEntries: TGMMatchingJSONValuesCollection; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TGMJsonPathEvaluator;

    procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
  end;


  EGMJsonPathException = class(EGMException);


procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase;
                                       const AContextNode: IUnknown; const AMatchingEntries: TGMMatchingJSONValuesCollection);

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): IGMJsonArray;

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 GMCreateMatchingValuesCollection: TGMMatchingJSONValuesCollection;


const

  cJsonPathUnionSep = '|';
  cJsonPathStepSep = '.';
  cJsonRootSyntaxToken = '$';

  // 'Ancestor','Ancestor-Or-Self', 'Namespace'
  cScopeLiterals: array [TJsonPathScope] of TGMString = ('Root', 'Child', 'Descendant',
     'Descendant-Or-Self', 'Following', 'Following-Sibling', 'Preceding', 'Preceding-Sibling', 'Self');


implementation

uses TypInfo;

resourcestring

  srInvalidAxisNameFmt = 'Invalid JSON-Path axis name: "%s"';
  srAxisNotImplemented = 'JSON-Path Axis "%s" not implemented yet';
  srNoValueMatchingExprFmt = 'No JSON %s value found matching the JSON-path expression "%s"';

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


type

  TJsonPathAxisNameObj = class;

  IXPathAxisNameObj = interface(IUnknown)
    ['{BBB808B5-6929-449C-8D5E-5B0CC0280438}']
    function Obj: TJsonPathAxisNameObj;
  end;

  TJsonPathAxisNameObj = class(TGMNameObj, IGMGetName, IXPathAxisNameObj) // TGMRefCountedObj
   protected
    FAxis: TJsonPathScope;
//  FName: TGMString;

   public
    constructor Create(const AAxis: TJsonPathScope; const AName: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TJsonPathAxisNameObj;
//  function GetName: TGMString; stdcall;
  end;


var

  vJsonPathScopeLiterals: IGMIntfCollection = nil;


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

function JsonPathScopeLiterals: IGMIntfCollection;
var a: TJsonPathScope;
begin
  if vJsonPathScopeLiterals = nil then
   begin
    vJsonPathScopeLiterals := TGMIntfArrayCollection.Create(False, True, GMCompareByName);
    for a:=Low(a) to High(a) do vJsonPathScopeLiterals.Add(TJsonPathAxisNameObj.Create(a, cScopeLiterals[a]));
   end;

  Result := vJsonPathScopeLiterals;
end;

function ParseStepEvalData(const AEvalStepExpression: TGMString; const ADefaultAxis: TJsonPathScope; const ACaller: TObject): TJsonPathExprStepRec;
const cStrRoutineName = 'ParseStepEvalData';
var pScanScope: PGMChar; axisName: TGMString; nameObj, foundEntry: IUnknown; axisEntry: IXPathAxisNameObj; // pScanPredicate
    len: Integer; isVerboseSyntax: Boolean;
begin
  FillChar(Result, SizeOf(Result), 0);
  Result.Axis := ADefaultAxis;
  isVerboseSyntax := False;
  //
  // Search for axis specification in verbose syntax
  //
  pScanScope := GMStrLScan(PGMChar(AEvalStepExpression), ':', Length(AEvalStepExpression));
  if pScanScope <> nil then
   begin
    Inc(pScanScope);
    if pScanScope^ = ':' then
     begin
      SetString(axisName, PGMChar(AEvalStepExpression), pScanScope - PGMChar(AEvalStepExpression) - 1);
      nameObj := TGMNameObj.Create(axisName);
      if not JsonPathScopeLiterals.Find(nameObj, foundEntry) then
        raise EGMJsonPathException.ObjError(GMFormat(srInvalidAxisNameFmt, [axisName]), ACaller, cStrRoutineName)
      else
        if GMQueryInterface(foundEntry, IXPathAxisNameObj, axisEntry) then Result.Axis := axisEntry.Obj.FAxis;

      Inc(pScanScope);
      isVerboseSyntax := True;
     end;
   end;

  //
  // check for abbreviated axis syntax if no axis has been specified in verbose syntax
  //
  if not isVerboseSyntax then                                                        
   begin
    pScanScope :=  PGMChar(AEvalStepExpression);
//  if pScanScope <> nil then
     case pScanScope^ of
      '.': begin
            Inc(pScanScope);
            if pScanScope^ = '.' then begin Result.Axis := jpsDescendant; Inc(pScanScope); end else Result.Axis := jpsChild;
           end;

      cJsonRootSyntaxToken: begin Result.Axis := jpsRoot; Inc(pScanScope); end;
      '@': begin Result.Axis := jpsSelf; Inc(pScanScope); end;
     end;
   end;

//pScanPredicate := GMStrLScan(pScanScope, '[', PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope);
//if pScanPredicate <> nil then SetString(Result.Predicate, pScanPredicate, PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanPredicate);

//if pScanPredicate = nil then len := PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope else len := pScanPredicate - pScanScope;

  len := PGMChar(AEvalStepExpression) + Length(AEvalStepExpression) - pScanScope;
  SetString(Result.NodeTest, pScanScope, len);
end;

function IsNodeMatch(const ANode: IUnknown; const AEvalData: TJsonPathExprStepRec): Boolean;
begin
  if AEvalData.NodeTest = '*' then Result := True else Result := GMSameText(GMGetIntfName(ANode), AEvalData.NodeTest);
end;

function GMCreateMatchingValuesCollection: TGMMatchingJSONValuesCollection;
begin
  Result := TGMGenericArrayCollection<IGMJsonValueBase>.Create;
end;


{ ------------------------------ }
{ ---- TJsonPathAxisNameObj ---- }
{ ------------------------------ }

constructor TJsonPathAxisNameObj.Create(const AAxis: TJsonPathScope; const AName: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FAxis := AAxis;
  FName := AName;
end;

function TJsonPathAxisNameObj.Obj: TJsonPathAxisNameObj;
begin
  Result := Self;
end;

//function TJsonPathAxisNameObj.GetName: TGMString;
//begin
//  Result := FName;
//end;


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

constructor TGMJsonPathEvaluator.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
end;

constructor TGMJsonPathEvaluator.Create(const AJsonRoot: IGMJsonValueBase; const AMatchingEntries: TGMMatchingJSONValuesCollection; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  FJsonDocument := AJsonRoot;
  FMatchingEntries := AMatchingEntries;
end;

function TGMJsonPathEvaluator.Obj: TGMJsonPathEvaluator;
begin
  Result := Self;
end;

procedure TGMJsonPathEvaluator.IterateMatchingNodes(const AJsonPathExpression: TGMString; const AContextNode: IUnknown; const AStepEval: TJsonPathExprStepRec);
const cStrMethodName = 'IterateMatchingNodes';
var ctxNode, outerSubNode: IGMJsonValueBase; subValueIt: TGMJSONValuesIterator; // unkNode: IUnknown;
  procedure ProcessNode(const ANode: IGMJsonValueBase);
  begin
    if Length(AJsonPathExpression) > 0 then
      EvaluateNextLocationStep(AJsonPathExpression, ANode)
    else
      if FMatchingEntries <> nil then FMatchingEntries.Add(ANode);
  end;

  procedure ProcessNodeIfMatch(const ANode: IGMJsonValueBase);
  begin
    if IsNodeMatch(ANode, AStepEval) then ProcessNode(ANode);
  end;

  procedure IterateAllSubNodes(const ANode: IGMJsonValueBase);
  var it: TGMJSONValuesIterator; innerSubNode: IGMJsonValueBase; // unkNode: IUnknown;
  begin
    if ANode = nil then Exit;
    it := ANode.CreateSubValueIterator;
    if it <> nil then
     while it.NextEntry(innerSubNode) do // unkNode
      begin
       ProcessNodeIfMatch(innerSubNode);
       //if GMQueryInterface(unkNode, IGMJsonValueBase, innerSubNode) then
        IterateAllSubNodes(innerSubNode);
      end;
  end;
begin
  if not GMQueryInterface(AContextNode, IGMJsonValueBase, ctxNode) then Exit;

  case AStepEval.Axis of
   jpsRoot: ProcessNode(FJsonDocument);
   jpsSelf: ProcessNode(ctxNode);

   jpsChild:
    begin
     subValueIt := ctxNode.CreateSubValueIterator;
     if subValueIt <> nil then while subValueIt.NextEntry(outerSubNode) do ProcessNodeIfMatch(outerSubNode);
    end;

   jpsDescendant, jpsDescendantOrSelf:
    begin
     if AStepEval.Axis = jpsDescendantOrSelf then ProcessNodeIfMatch(ctxNode);
     IterateAllSubNodes(ctxNode);
    end;

// xpaParent: ProcessNodeIfMatch(ctxNode.Obj.Parent);
// jpaAncestor, jpaAncestorOrSelf:
//  begin
//   if AStepEval.Axis = xpaAncestor then ctxNode := ctxNode.Obj.Parent;
//   while ctxNode <> nil do
//    begin
//     ProcessNodeIfMatch(ctxNode);
//     ctxNode := ctxNode.Obj.Parent;
//    end;
//  end;
   else raise EGMJsonPathException.ObjError(GMFormat(srAxisNotImplemented, [GetEnumName(TypeInfo(TJsonPathScope), Ord(AStepEval.Axis))]), Self, cStrMethodName);
  end;
end;

procedure TGMJsonPathEvaluator.EvaluateNextLocationStep(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
var locationStepExpr, remainingExpr: TGMString; pStartCh, pChScan, pChEnd: PGMChar; dfltAxis: TJsonPathScope; stepEval: TJsonPathExprStepRec;
begin
  dfltAxis := jpsChild;
  pStartCh := PGMChar(AJsonPathExpression);
  if pStartCh^ = cJsonPathStepSep then
   begin
    Inc(pStartCh);
    if pStartCh^ = cJsonPathStepSep then begin dfltAxis := jpsDescendant; Inc(pStartCh); end; // pStartCh := pStartCh + 1;
   end;

  pChScan := GMStrLScan(pStartCh, cJsonPathStepSep, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pStartCh);
  if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AJsonPathExpression) + Length(AJsonPathExpression);

  SetString(locationStepExpr, pStartCh, pChEnd - pStartCh);
  stepEval := ParseStepEvalData(locationStepExpr, dfltAxis, Self);

  SetString(remainingExpr, pChEnd, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pChEnd);

  IterateMatchingNodes(remainingExpr, AContextNode, stepEval);
end;

procedure TGMJsonPathEvaluator.EvaluateSingleExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
begin
  if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) then Exit;

  if AJsonPathExpression[1] = cJsonRootSyntaxToken then AContextNode := FJsonDocument;

  EvaluateNextLocationStep(AJsonPathExpression, AContextNode);
end;

procedure TGMJsonPathEvaluator.GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
var chPos: PtrInt; expression: TGMString;
begin
  if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) or (FMatchingEntries = nil) then Exit;

  if AContextNode = nil then AContextNode := FJsonDocument;

  chPos := 1;
  repeat
   expression := GMNextWord(chPos, AJsonPathExpression, cJsonPathUnionSep);
   if Length(expression) > 0 then EvaluateSingleExpression(expression, AContextNode);
  until Length(expression) <= 0;
end;

//procedure TGMJsonPathEvaluator.GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; AContextNode: IUnknown);
//var expression: TGMString; pStartCh, pChScan, pChEnd: PGMChar;
//begin
//if (FJsonDocument = nil) or (Length(AJsonPathExpression) <= 0) or (FMatchingEntries = nil) then Exit;
//
//if AContextNode = nil then AContextNode := FJsonDocument;
//
//pStartCh := PGMChar(AJsonPathExpression);
//
//repeat
// pChScan := GMStrLScan(pStartCh, cJsonPathUnionSep, PGMChar(AJsonPathExpression) + Length(AJsonPathExpression) - pStartCh);
//
// if pChScan <> nil then pChEnd := pChScan else pChEnd := PGMChar(AJsonPathExpression) + Length(AJsonPathExpression);
//
// SetString(expression, pStartCh, pChEnd - pStartCh);
//// expression := GMStrip(expression); <- would prevent specifying spaces at the end
// if Length(expression) > 0 then EvaluateSingleExpression(expression, AContextNode);
//
// pStartCh := pChEnd;
// if pChScan <> nil then Inc(pStartCh); // pStartCh := pStartCh + 1;
//
//until pChScan = nil;
//end;


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

procedure GMEvaluateJsonPathExpression(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase;
                                       const AContextNode: IUnknown; const AMatchingEntries: TGMMatchingJSONValuesCollection);
var xpathEvaluator: IGMJsonPathEvaluator;
begin
  xpathEvaluator := TGMJsonPathEvaluator.Create(AJsonRoot, AMatchingEntries);
  xpathEvaluator.Obj.GMEvaluateJsonPathExpression(AJsonPathExpression, AContextNode);
end;
                                                                        
function GMGetJsonTerminalValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase; const ACaller: TObject): RGMJsonValueData;
const cStrRoutineName = 'GMGetJsonTerminalValue';
var matchingValues: TGMMatchingJSONValuesCollection; termVal: IGMJsonTerminalValue; it: TGMJSONValuesIterator; // unkVal: IUnknown;
    jsonEntry: IGMJsonValueBase;
begin
  matchingValues := GMCreateMatchingValuesCollection;
  GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues);

  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, cStrRoutineName);
end;


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

  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): IGMJsonArray;
const cStrRoutineName = 'GMGetJsonArray';
var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator;
begin
  matchingValues := GMCreateMatchingValuesCollection;
  GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues);

  it := matchingValues.CreateIterator;
  if not it.NextEntry(jsonEntry) or not GMQueryInterface(jsonEntry, IGMJsonArray, Result) then
     raise EGMJsonPathException.ObjError(GMFormat(srNoValueMatchingExprFmt, [srArray]) +': '+ AJsonPathExpression, ACaller, cStrRoutineName);
end;


function GMFindJsonValue(const AJsonPathExpression: TGMString; const AJsonRoot: IGMJsonValueBase): IGMJsonValueBase;
var matchingValues: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator;
begin
  matchingValues := GMCreateMatchingValuesCollection;
  GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues);

  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: TGMMatchingJSONValuesCollection; jsonEntry: IGMJsonValueBase; it: TGMJSONValuesIterator;
begin
  matchingValues := GMCreateMatchingValuesCollection;
  GMEvaluateJsonPathExpression(AJsonPathExpression, AJsonRoot, nil, matchingValues);

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


initialization

  JsonPathScopeLiterals; // <- Create in Main Thread!

end.