unit JsonObject;

interface

uses
  System.SysUtils, Generics.Collections;

type
  TJsonType = ( jntBoolean,
                jntInteger,
                jntString );

  TJsonValue = class
  private
    FValue : string;
    function FGetType : TJsonType;
  public
    procedure GetValue(var AOutput : boolean); overload;
    procedure GetValue(var AOutput : integer); overload;
    procedure GetValue(var AOutput : string); overload;

    procedure Assign(AValue : string);
    property ValueType : TJsonType read FGetType;
  end;


  TJsonNodes = class
  protected
    FKeyList : TList<string>;
    FValues : TDictionary<string, TJsonValue>;
    function FGetValue(Index : string) : TJsonValue;
  public
    constructor Create();
    procedure AddItem(AKey : string); overload;
    procedure AddItem(AKey : string; AValue : TJsonValue); overload;
    property KeyList : TList<string> read FKeyList;
    property Value[Index : string] : TJsonValue read FGetValue; default;
  end;



  TJsonParser = class(TJsonNodes)
  private
  protected
    FJson : string;
  public
    constructor Create();
    procedure Assign(AJson : string);
    procedure Parse(AJson : string); overload;
    procedure Clear();
    procedure Parse(); overload;
    property Json : string read FJson;
  end;

implementation

{ TJsonParser }

procedure TJsonParser.Assign(AJson: string);
begin
  FJson := AJson;
end;

procedure TJsonParser.Parse(AJson: string);
begin
  FJson := AJson;
  Parse();
end;

procedure TJsonParser.Clear;
var
  CurrentCharIndex: Integer;
  CurrentChar : char;
  OutputString : string;
  InString : boolean;
begin
  InString := False;

  for CurrentCharIndex := 1 to Length(FJson) do
  begin
    CurrentChar := FJson[CurrentCharIndex];

    if (CurrentChar = '"') then
      InString := not InString;

    if ((CurrentChar = ' ') and (InString = false)) or
       ((CurrentChar = #10) or (CurrentChar = #13)) then
      Continue;

    OutputString := OutputString + CurrentChar;
  end;
  FJson := OutputString;
end;

constructor TJsonParser.Create;
begin
  inherited Create;

end;

procedure TJsonParser.Parse;
var
  CurrentCharIndex: Integer;
  CurrentChar : char;

  LineStarted : boolean;

  IndexDone : boolean;
  InIndex : boolean;

  InValue : boolean;
  ValueDone : Boolean;

  InString : boolean;

  LJsonValue : TJsonValue;

  StringBuffer : string;

  LastAdded : string;
  LastChar : char;
begin
  Clear;

  LineStarted := false;

  IndexDone := false;
  InIndex := false;

  InValue := false;
  ValueDone := false;

  InString := False;

  for CurrentCharIndex := 1 to Length(FJson) do
  begin
    CurrentChar := FJson[CurrentCharIndex];
    LastChar := FJson[CurrentCharIndex-1];


   if (CurrentChar = ',') or (CurrentChar = '}') then
    begin
      if InString then
        raise Exception.Create('String should be ended')
      else if InIndex then
        raise Exception.Create('Index should be ended')
      else if IndexDone and not ValueDone then
        raise Exception.Create('Value should be setted')
      else
      begin
        LineStarted := false;

        IndexDone := false;
        InIndex := false;

        InValue := false;
        ValueDone := false;

        InString := False;


        Value[LastAdded].Assign(StringBuffer);

            StringBuffer := '';
            InValue := false;

        StringBuffer := '';
      end;
    end;


    if not LineStarted then
    begin
      if CurrentChar = '"' then
      begin
        InIndex := true;
        LineStarted := true;

        LJsonValue := TJsonValue.Create;

        Continue;
      end;
    end;

    if LineStarted then
    begin
      if (InIndex) and (not InValue) then
      begin
        if not(CurrentChar = '"') then
        begin
          StringBuffer := StringBuffer + CurrentChar;
          Continue;
        end
        else
        begin
          InIndex := false;
          AddItem(StringBuffer, LJsonValue);
          LastAdded := StringBuffer;
          StringBuffer := '';
          Continue;
        end;
      end
      else if (not InIndex) and (not InValue) then
      begin
        if CurrentChar = ':' then
        begin
          InValue := true;
          Continue;
        end;
      end
      else if (not InIndex) and (InValue) then
      begin
        StringBuffer := StringBuffer + CurrentChar;

        if (not(StringBuffer = '')) and
           (CurrentChar = '"') and
           (LastChar = '"') then
           raise Exception.Create('"," expected.');


      end;

    end;


  end;
end;

{ TJsonValue }

procedure TJsonValue.Assign(AValue: string);
begin
  FValue := AValue;
end;

function TJsonValue.FGetType: TJsonType;
var
  LInt : integer;
begin
  if (FValue = 'true') or
     (FValue = 'false') then
     Result := jntBoolean
  else if (FValue[1] = '"') and
          (FValue[Length(FValue)] = '"') then
     Result := jntString
  else
  begin
    try
      LInt := StrToInt(FValue);
    finally
      Result := jntInteger;
    end;
  end;



end;

procedure TJsonValue.GetValue(var AOutput: boolean);
begin
  if (FValue = 'true') then
    AOutput := True
  else if (FValue = 'false') then
    AOutput := false
  else
    raise Exception.Create(FValue + ' is no Boolean');
end;

procedure TJsonValue.GetValue(var AOutput: integer);
begin
  AOutput := StrToInt(FValue);
end;

procedure TJsonValue.GetValue(var AOutput: string);
begin
  if (FValue[1] = '"') and
     (FValue[Length(FValue)] = '"') then
     AOutput := Copy(FValue, 2, Length(FValue)-2);
end;

{ TJsonNodes }

procedure TJsonNodes.AddItem(AKey: string);
begin
  AddItem(AKey, TJsonValue.Create);
end;

procedure TJsonNodes.AddItem(AKey: string; AValue: TJsonValue);
begin
  FKeyList.Add(AKey);
  FValues.Add(AKey, AValue);
end;

constructor TJsonNodes.Create;
begin
  FKeyList := TList<string>.Create;
  FValues := TDictionary<string, TJsonValue>.Create();
end;

function TJsonNodes.FGetValue(Index: string): TJsonValue;
begin
  Result := FValues[Index];
end;

end.