utilada_curl_2.1.0_56b45091/src/sys/serialize/util-serialize-io-json.adb

-----------------------------------------------------------------------
--  util-serialize-io-json -- JSON Serialization Driver
--  Copyright (C) 2010, 2011, 2012, 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Interfaces;

with Ada.Characters.Latin_1;
with Ada.Characters.Wide_Wide_Latin_1;
with Ada.IO_Exceptions;

with Util.Strings;
with Util.Streams;
with Util.Streams.Buffered;
with Util.Streams.Texts.TR;
with Util.Streams.Texts.WTR;
with Util.Dates.ISO8601;
with Util.Beans.Objects.Readers;
package body Util.Serialize.IO.JSON is

   use Ada.Strings.Unbounded;

   --  -----------------------
   --  Set the target output stream.
   --  -----------------------
   procedure Initialize (Stream : in out Output_Stream;
                         Output : in Util.Streams.Texts.Print_Stream_Access) is
   begin
      Stream.Stream := Output;
   end Initialize;

   --  -----------------------
   --  Flush the buffer (if any) to the sink.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Output_Stream) is
   begin
      Stream.Stream.Flush;
   end Flush;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Output_Stream) is
   begin
      Stream.Stream.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Output_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
   begin
      Stream.Stream.Write (Buffer);
   end Write;

   --  -----------------------
   --  Write a raw character on the stream.
   --  -----------------------
   procedure Write (Stream : in out Output_Stream;
                    Char   : in Character) is
   begin
      Stream.Stream.Write (Char);
   end Write;

   --  -----------------------
   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   --  -----------------------
   procedure Write_Wide (Stream : in out Output_Stream;
                         Item   : in Wide_Wide_Character) is
   begin
      Stream.Stream.Write_Wide (Item);
   end Write_Wide;

   --  -----------------------
   --  Write a raw string on the stream.
   --  -----------------------
   procedure Write (Stream : in out Output_Stream;
                    Item   : in String) is
   begin
      Stream.Stream.Write (Item);
   end Write;

   --  -----------------------
   --  Start a JSON document.  This operation writes the initial JSON marker ('{').
   --  -----------------------
   procedure Start_Document (Stream : in out Output_Stream) is
      Current : access Node_Info;
   begin
      Node_Info_Stack.Push (Stream.Stack);
      Current := Node_Info_Stack.Current (Stream.Stack);
      Current.Is_Root := True;
   end Start_Document;

   --  -----------------------
   --  Finish a JSON document by writing the final JSON marker ('}').
   --  -----------------------
   procedure End_Document (Stream : in out Output_Stream) is
      Current : constant access Node_Info := Node_Info_Stack.Current (Stream.Stack);
   begin
      if Current /= null and then Current.Has_Fields and then not Current.Is_Array then
         Stream.Write ('}');
      end if;
      Node_Info_Stack.Pop (Stream.Stack);
   end End_Document;

   --  -----------------------
   --  Write the string as a quoted JSON string
   --  -----------------------
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in String) is
   begin
      Stream.Write ('"');
      for I in Value'Range loop
         declare
            C : constant Character := Value (I);
         begin
            if C = '"' then
               Stream.Write ("\""");

            elsif C = '\'  then
               Stream.Write ("\\");

            elsif Character'Pos (C) >= 16#20# then
               Stream.Write (C);

            else
               case C is
                  when Ada.Characters.Latin_1.BS =>
                     Stream.Write ("\b");

                  when Ada.Characters.Latin_1.VT =>
                     Stream.Write ("\f");

                  when Ada.Characters.Latin_1.LF =>
                     Stream.Write ("\n");

                  when Ada.Characters.Latin_1.CR =>
                     Stream.Write ("\r");

                  when Ada.Characters.Latin_1.HT =>
                     Stream.Write ("\t");

                  when others =>
                     Util.Streams.Texts.TR.To_Hex (Stream.Stream.all, C);

               end case;
            end if;
         end;
      end loop;
      Stream.Write ('"');
   end Write_String;

   --  -----------------------
   --  Write the value as a JSON string.  Special characters are escaped using the JSON
   --  escape rules.
   --  -----------------------
   procedure Write_Wide_String (Stream : in out Output_Stream;
                                Value  : in Wide_Wide_String) is
   begin
      Stream.Write ('"');
      for I in Value'Range loop
         declare
            C : constant Wide_Wide_Character := Value (I);
         begin
            if C = '"' then
               Stream.Write ("\""");

            elsif C = '\'  then
               Stream.Write ("\\");

            elsif Wide_Wide_Character'Pos (C) >= 16#20# then
               Util.Streams.Texts.Write_Char (Stream.Stream.all, C);

            else
               case C is
                  when Ada.Characters.Wide_Wide_Latin_1.BS =>
                     Stream.Write ("\b");

                  when Ada.Characters.Wide_Wide_Latin_1.VT =>
                     Stream.Write ("\f");

                  when Ada.Characters.Wide_Wide_Latin_1.LF =>
                     Stream.Write ("\n");

                  when Ada.Characters.Wide_Wide_Latin_1.CR =>
                     Stream.Write ("\r");

                  when Ada.Characters.Wide_Wide_Latin_1.HT =>
                     Stream.Write ("\t");

                  when others =>
                     Util.Streams.Texts.WTR.To_Hex (Stream.Stream.all, C);

               end case;
            end if;
         end;
      end loop;
      Stream.Write ('"');
   end Write_Wide_String;

   procedure Write_Field_Name (Stream : in out Output_Stream;
                               Name   : in String) is
      Current : constant access Node_Info := Node_Info_Stack.Current (Stream.Stack);
   begin
      if Current /= null then
         if Current.Has_Fields then
            Stream.Write (',');
         elsif Name'Length > 0 or else not Current.Is_Root then
            Current.Has_Fields := True;
         end if;
      end if;

      if Name'Length > 0 and then (Current = null or else not Current.Is_Array) then
         Stream.Write_String (Name);
         Stream.Write (':');
      end if;
   end Write_Field_Name;

   --  -----------------------
   --  Start writing an object identified by the given name
   --  -----------------------
   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String) is
      Current : access Node_Info := Node_Info_Stack.Current (Stream.Stack);
   begin
      if Current /= null and then Current.Is_Root then
         if Name'Length > 0 then
            Stream.Write ('{');
            Stream.Write_Field_Name (Name);
            Current.Has_Fields := True;
         end if;
      else
         Stream.Write_Field_Name (Name);
      end if;
      Node_Info_Stack.Push (Stream.Stack);
      Current := Node_Info_Stack.Current (Stream.Stack);
      Current.Has_Fields := False;
      Current.Is_Array := False;
      Current.Is_Root := False;
      Stream.Write ('{');
   end Start_Entity;

   --  -----------------------
   --  Finish writing an object identified by the given name
   --  -----------------------
   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String) is
      pragma Unreferenced (Name);
   begin
      Node_Info_Stack.Pop (Stream.Stack);
      Stream.Write ('}');
   end End_Entity;

   --  -----------------------
   --  Write the attribute name/value pair.
   --  -----------------------
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String) is
   begin
      Stream.Write_Field_Name (Name);
      Stream.Write_String (Value);
   end Write_Attribute;

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String) is
   begin
      Stream.Write_Field_Name (Name);
      Stream.Write_Wide_String (Value);
   end Write_Wide_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer) is
   begin
      Stream.Write_Field_Name (Name);
      Stream.Write (Integer'Image (Value));
   end Write_Attribute;

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean) is
   begin
      Stream.Write_Field_Name (Name);
      if Value then
         Stream.Write ("true");
      else
         Stream.Write ("false");
      end if;
   end Write_Attribute;

   --  -----------------------
   --  Write an attribute member from the current object
   --  -----------------------
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      Stream.Write_Field_Name (Name);
      case Util.Beans.Objects.Get_Type (Value) is
         when TYPE_NULL =>
            Stream.Write ("null");

         when TYPE_BOOLEAN =>
            if Util.Beans.Objects.To_Boolean (Value) then
               Stream.Write ("true");
            else
               Stream.Write ("false");
            end if;

         when TYPE_INTEGER =>
            Stream.Stream.Write (Util.Beans.Objects.To_Long_Long_Integer (Value));

         when others =>
            Stream.Write_String (Util.Beans.Objects.To_String (Value));

      end case;
   end Write_Attribute;

   --  -----------------------
   --  Write the attribute with a null value.
   --  -----------------------
   overriding
   procedure Write_Null_Attribute (Stream : in out Output_Stream;
                                   Name   : in String) is
   begin
      Stream.Write_Field_Name (Name);
      Stream.Write ("null");
   end Write_Null_Attribute;

   --  -----------------------
   --  Write an object value as an entity
   --  -----------------------
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object) is
   begin
      Stream.Write_Attribute (Name, Value);
   end Write_Entity;

   --  -----------------------
   --  Write a JSON name/value pair (see Write_Attribute).
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String) is
   begin
      Stream.Write_Attribute (Name, Value);
   end Write_Entity;

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String) is
   begin
      Stream.Write_Wide_Attribute (Name, Value);
   end Write_Wide_Entity;

   --  -----------------------
   --  Write a JSON name/value pair (see Write_Attribute).
   --  -----------------------
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer) is
   begin
      Stream.Write_Attribute (Name, Value);
   end Write_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time) is
   begin
      Stream.Write_Entity (Name, Util.Dates.ISO8601.Image (Value, Util.Dates.ISO8601.SUBSECOND));
   end Write_Entity;

   --  -----------------------
   --  Write an entity with a null value.
   --  -----------------------
   overriding
   procedure Write_Null_Entity (Stream : in out Output_Stream;
                                Name   : in String) is
   begin
      Stream.Write_Null_Attribute (Name);
   end Write_Null_Entity;

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean) is
   begin
      Stream.Write_Attribute (Name, Value);
   end Write_Entity;

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer) is
   begin
      Stream.Write_Field_Name (Name);
      Stream.Write (Long_Long_Integer'Image (Value));
   end Write_Long_Entity;

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String) is
   begin
      Stream.Write_Entity (Name, Value);
   end Write_Enum_Entity;

   --  -----------------------
   --  Start an array that will contain the specified number of elements
   --  Example:  "list": [
   --  -----------------------
   overriding
   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String) is
      Current : access Node_Info := Node_Info_Stack.Current (Stream.Stack);
   begin
      if Current /= null then
         if Current.Has_Fields then
            Stream.Write (',');
         elsif not Current.Is_Root then
            Current.Has_Fields := True;
         elsif Name'Length > 0 then
            Stream.Write ('{');
            Current.Has_Fields := True;
         else
            Current.Is_Array := True;
         end if;
      end if;
      Node_Info_Stack.Push (Stream.Stack);
      Current := Node_Info_Stack.Current (Stream.Stack);
      Current.Has_Fields := False;
      Current.Is_Array := True;
      Current.Is_Root := False;
      if Name'Length > 0 then
         Stream.Write_String (Name);
         Stream.Write (':');
      end if;
      Stream.Write ('[');
   end Start_Array;

   --  -----------------------
   --  Finishes an array
   --  -----------------------
   overriding
   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String) is
      pragma Unreferenced (Name);
   begin
      Node_Info_Stack.Pop (Stream.Stack);
      Stream.Write (']');
   end End_Array;

   --  -----------------------
   --  Get the current location (file and line) to report an error message.
   --  -----------------------
   function Get_Location (Handler : in Parser) return String is
   begin
      return Util.Strings.Image (Handler.Line_Number);
   end Get_Location;

   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Input_Buffer_Stream'Class;
                    Sink    : in out Reader'Class) is

      --  Put back a token in the buffer.
      procedure Put_Back (P     : in out Parser'Class;
                          Token : in Token_Type);

      --  Parse the expression buffer to find the next token.
      procedure Peek (P     : in out Parser'Class;
                      Token : out Token_Type);

      function Hexdigit (C : in Character) return Interfaces.Unsigned_32;

      --  Parse a list of members
      --  members ::= pair | pair ',' members
      --  pair    ::= string ':' value
      --  value   ::= string | number | object | array | true | false | null
      procedure Parse_Pairs (P : in out Parser'Class);

      --  Parse a value
      --  value   ::= string | number | object | array | true | false | null
      procedure Parse_Value (P    : in out Parser'Class;
                             Name : in String);

      --  ------------------------------
      --  Parse a list of members
      --  members ::= pair | pair ',' members
      --  pair    ::= string ':' value
      --  value   ::= string | number | object | array | true | false | null
      --  ------------------------------
      procedure Parse_Pairs (P : in out Parser'Class) is
         Current_Name : Unbounded_String;
         Token        : Token_Type;
      begin
         loop
            Peek (P, Token);
            if Token /= T_STRING then
               Put_Back (P, Token);
               return;
            end if;
            Current_Name := P.Token;
            Peek (P, Token);
            if Token /= T_COLON then
               P.Error ("Missing ':'");
            end if;

            Parse_Value (P, To_String (Current_Name));
            Peek (P, Token);
            if Token /= T_COMMA then
               Put_Back (P, Token);
               return;
            end if;
         end loop;
      end Parse_Pairs;

      function Hexdigit (C : in Character) return Interfaces.Unsigned_32 is
         use type Interfaces.Unsigned_32;
      begin
         if C >= '0' and C <= '9' then
            return Character'Pos (C) - Character'Pos ('0');
         elsif C >= 'a' and C <= 'f' then
            return Character'Pos (C) - Character'Pos ('a') + 10;
         elsif C >= 'A' and C <= 'F' then
            return Character'Pos (C) - Character'Pos ('A') + 10;
         else
            raise Constraint_Error with "Invalid hexdigit: " & C;
         end if;
      end Hexdigit;

      --  ------------------------------
      --  Parse a value
      --  value   ::= string | number | object | array | true | false | null
      --  ------------------------------
      procedure Parse_Value (P    : in out Parser'Class;
                             Name : in String) is
         Token : Token_Type;
         Index : Natural;
      begin
         Peek (P, Token);
         case Token is
            when T_LEFT_BRACE =>
               Sink.Start_Object (Name, P);
               Parse_Pairs (P);
               Peek (P, Token);
               if Token /= T_RIGHT_BRACE then
                  P.Error ("Missing '}'");
               end if;
               Sink.Finish_Object (Name, P);

                  --
            when T_LEFT_BRACKET =>
               Sink.Start_Array (Name, P);
               Peek (P, Token);
               Index := 0;
               if Token /= T_RIGHT_BRACKET then
                  Put_Back (P, Token);
                  loop
                     Parse_Value (P, Util.Strings.Image (Index));
                     Peek (P, Token);
                     exit when Token = T_RIGHT_BRACKET;
                     if Token /= T_COMMA then
                        P.Error ("Missing ']'");
                        exit when Token = T_EOF;
                     end if;
                     Index := Index + 1;
                  end loop;
               end if;
               Sink.Finish_Array (Name, Index, P);

            when T_NULL =>
               Sink.Set_Member (Name, Util.Beans.Objects.Null_Object, P);

            when T_NUMBER =>
               Sink.Set_Member (Name, Util.Beans.Objects.To_Object (P.Token), P);

            when T_STRING =>
               Sink.Set_Member (Name, Util.Beans.Objects.To_Object (P.Token), P);

            when T_TRUE =>
               Sink.Set_Member (Name, Util.Beans.Objects.To_Object (True), P);

            when T_FALSE =>
               Sink.Set_Member (Name, Util.Beans.Objects.To_Object (False), P);

            when T_EOF =>
               P.Error ("End of stream reached");
               return;

            when others =>
               P.Error ("Invalid token");
         end case;
      end Parse_Value;

      --  ------------------------------
      --  Put back a token in the buffer.
      --  ------------------------------
      procedure Put_Back (P     : in out Parser'Class;
                          Token : in Token_Type) is
      begin
         P.Pending_Token := Token;
      end Put_Back;

      --  ------------------------------
      --  Parse the expression buffer to find the next token.
      --  ------------------------------
      procedure Peek (P     : in out Parser'Class;
                      Token : out Token_Type) is
         use Ada.Characters;
         C, C1 : Character;
      begin
         --  If a token was put back, return it.
         if P.Pending_Token /= T_EOF then
            Token := P.Pending_Token;
            P.Pending_Token := T_EOF;
            return;
         end if;

         if P.Has_Pending_Char then
            C := P.Pending_Char;
         else
            --  Skip white spaces
            loop
               Stream.Read (Char => C);
               if C = Ada.Characters.Latin_1.LF then
                  P.Line_Number := P.Line_Number + 1;
               else
                  exit when C /= ' '
                    and C /= Ada.Characters.Latin_1.CR and C /= Ada.Characters.Latin_1.HT;
               end if;
            end loop;
         end if;
         P.Has_Pending_Char := False;

         --  See what we have and continue parsing.
         case C is
            --  Literal string using double quotes
            --  Collect up to the end of the string and put
            --  the result in the parser token result.
         when '"' =>
            Delete (P.Token, 1, Length (P.Token));
            loop
               Stream.Read (Char => C1);
               if C1 = '\' then
                  Stream.Read (Char => C1);
                  case C1 is
                     when '"' | '\' | '/' =>
                        null;

                     when 'b' =>
                        C1 := Ada.Characters.Latin_1.BS;

                     when 'f' =>
                        C1 := Ada.Characters.Latin_1.VT;

                     when 'n' =>
                        C1 := Ada.Characters.Latin_1.LF;

                     when 'r' =>
                        C1 := Ada.Characters.Latin_1.CR;

                     when 't' =>
                        C1 := Ada.Characters.Latin_1.HT;

                     when 'u' =>
                        declare
                           use Interfaces;

                           C2, C3, C4 : Character;
                           Val : Interfaces.Unsigned_32;
                        begin
                           Stream.Read (Char => C1);
                           Stream.Read (Char => C2);
                           Stream.Read (Char => C3);
                           Stream.Read (Char => C4);
                           Val := Interfaces.Shift_Left (Hexdigit (C1), 12);
                           Val := Val + Interfaces.Shift_Left (Hexdigit (C2), 8);
                           Val := Val + Interfaces.Shift_Left (Hexdigit (C3), 4);
                           Val := Val + Hexdigit (C4);

                           --  Encode the value as an UTF-8 string.
                           if Val >= 16#1000# then
                              Append (P.Token, Character'Val (16#E0# or Shift_Right (Val, 12)));
                              Val := Val and 16#0fff#;
                              Append (P.Token, Character'Val (16#80# or Shift_Right (Val, 6)));
                              Val := Val and 16#03f#;
                              C1 := Character'Val (16#80# or Val);
                           elsif Val >= 16#80# then
                              Append (P.Token, Character'Val (16#C0# or Shift_Right (Val, 6)));
                              Val := Val and 16#03f#;
                              C1 := Character'Val (16#80# or Val);
                           else
                              C1 := Character'Val (Val);
                           end if;
                        end;

                     when others =>
                        P.Error ("Invalid character '" & C1 & "' in \x sequence");

                  end case;
               elsif C1 = C then
                  Token := T_STRING;
                  return;
               end if;
               Append (P.Token, C1);
            end loop;

            --  Number
         when '-' | '0' .. '9' =>
            Delete (P.Token, 1, Length (P.Token));
            Append (P.Token, C);
            loop
               Stream.Read (Char => C);
               exit when C not in '0' .. '9';
               Append (P.Token, C);
            end loop;
            if C = '.' then
               Append (P.Token, C);
               loop
                  Stream.Read (Char => C);
                  exit when C not in '0' .. '9';
                  Append (P.Token, C);
               end loop;
            end if;
            if C = 'e' or C = 'E' then
               Append (P.Token, C);
               Stream.Read (Char => C);
               if C = '+' or C = '-' then
                  Append (P.Token, C);
                  Stream.Read (Char => C);
               end if;
               loop
                  Stream.Read (Char => C);
                  exit when C not in '0' .. '9';
                  Append (P.Token, C);
               end loop;
            end if;
            if not (C in ' ' | Latin_1.HT | Latin_1.LF | Latin_1.CR) then
               P.Has_Pending_Char := True;
               P.Pending_Char := C;
            end if;
            Token := T_NUMBER;
            return;

            --  Parse a name composed of letters or digits.
         when 'a' .. 'z' | 'A' .. 'Z' =>
            Delete (P.Token, 1, Length (P.Token));
            Append (P.Token, C);
            loop
               Stream.Read (Char => C);
               exit when not (C in 'a' .. 'z' or C in 'A' .. 'Z'
                              or C in '0' .. '9' or C = '_');
               Append (P.Token, C);
            end loop;
            --  Putback the last character unless we can ignore it.
            if not (C in ' ' | Latin_1.HT | Latin_1.LF | Latin_1.CR) then
               P.Has_Pending_Char := True;
               P.Pending_Char := C;
            end if;

            --  and empty eq false ge gt le lt ne not null true
            case Element (P.Token, 1) is
               when 'n' | 'N' =>
                  if P.Token = "null" then
                     Token := T_NULL;
                     return;
                  end if;

               when 'f' | 'F' =>
                  if P.Token = "false" then
                     Token := T_FALSE;
                     return;
                  end if;

               when 't' | 'T' =>
                  if P.Token = "true" then
                     Token := T_TRUE;
                     return;
                  end if;

               when others =>
                  null;
            end case;
            Token := T_UNKNOWN;
            return;

         when '{' =>
            Token := T_LEFT_BRACE;
            return;

         when '}' =>
            Token := T_RIGHT_BRACE;
            return;

         when '[' =>
            Token := T_LEFT_BRACKET;
            return;

         when ']' =>
            Token := T_RIGHT_BRACKET;
            return;

         when ':' =>
            Token := T_COLON;
            return;

         when ',' =>
            Token := T_COMMA;
            return;

         when others =>
            Token := T_UNKNOWN;
            return;
         end case;

      exception
         when Ada.IO_Exceptions.Data_Error =>
            Token := T_EOF;
            return;
      end Peek;

   begin
      Parse_Value (Handler, "");
   end Parse;

   --  Read a JSON file and return an object.
   function Read (Path : in String) return Util.Beans.Objects.Object is
      P : Parser;
      R : Util.Beans.Objects.Readers.Reader;
   begin
      P.Parse (Path, R);
      return R.Get_Root;
   end Read;

end Util.Serialize.IO.JSON;