-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
   begin
      Log.Info ("Close connection {0}", Database.Name);
      Database.Server := null;
   end Close;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   protected body Sqlite_Connections is

      procedure Open (Config : in Configuration'Class;
                      Result : in out Ref.Ref'Class) is
         use Strings;

         URI      : constant String := Config.Get_URI;
         Database : Database_Connection_Access;
         Pos      : Database_List.Cursor := Database_List.First (List);
         DB       : SQLite_Database;
      begin
         --  Look first in the database list.
         while Database_List.Has_Element (Pos) loop
            DB := Database_List.Element (Pos);
            if DB.URI = URI then
               Database := new Database_Connection;
               Database.URI := DB.URI;
               Database.Name := DB.Name;
               Database.Server := DB.Server;
               Result := Ref.Create (Database.all'Access);
               return;
            end if;
            Database_List.Next (Pos);
         end loop;

         --  Now we can open a new database connection.
         declare
            Name     : constant String := Config.Get_Database;
            Filename : Strings.chars_ptr;
            Status   : int;
            Handle   : aliased access Sqlite3;
            Flags    : int
              := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
         begin
            if Config.Get_Property ("create") = "1" then
               Flags := Flags + Sqlite3_H.SQLITE_OPEN_CREATE;
            end if;
            Filename := Strings.New_String (Name);
            Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                                 Flags,
                                                 Strings.Null_Ptr);

            Strings.Free (Filename);
            if Status /= Sqlite3_H.SQLITE_OK then
               declare
                  Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
                  Msg   : constant String := Strings.Value (Error);
               begin
                  Log.Error ("Cannot open SQLite database: {0}", Msg);
                  raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
               end;
            end if;

            Database := new Database_Connection;
            declare

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value);
               function Escape (Value : in Util.Properties.Value) return String;

               function Escape (Value : in Util.Properties.Value) return String is
                  S : constant String := Util.Properties.To_String (Value);
               begin
                  if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
                     return S;
                  elsif S'Length > 0 and then S (S'First) = ''' then
                     return S;
                  else
                     return "'" & S & "'";
                  end if;
               end Escape;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value) is
                  SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
               begin
                  if Util.Strings.Index (Name, '.') = 0 then
                     Log.Info ("Configure database with {0}", SQL);
                     ADO.Statements.Sqlite.Execute (Database.Server, SQL);
                  end if;

               exception
                  when SQL_Error =>
                     null;
               end Configure;

            begin
               Database.Server := Handle;
               Database.Name   := To_Unbounded_String (Config.Get_Database);
               Database.URI    := To_Unbounded_String (URI);
               Result := Ref.Create (Database.all'Access);

               DB.Server := Handle;
               DB.Name := Database.Name;
               DB.URI := Database.URI;
               Database_List.Prepend (Container => List, New_Item => DB);

               --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
               --  Typical configuration includes:
               --    synchronous=OFF
               --    temp_store=MEMORY
               --    encoding='UTF-8'
               Config.Iterate (Process => Configure'Access);
            end;
         end;
      end Open;

      procedure Clear is
         DB     : SQLite_Database;
         Result : int;
      begin
         while not Database_List.Is_Empty (List) loop
            DB := Database_List.First_Element (List);
            Database_List.Delete_First (List);
            if DB.Server /= null then
               Result := Sqlite3_H.sqlite3_close_v2 (DB.Server);
               if Result /= Sqlite3_H.SQLITE_OK then
                  declare
                     Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
                     Msg   : constant String := Strings.Value (Error);
                  begin
                     Log.Error ("Cannot close database {0}: {1}", To_String (DB.Name), Msg);
                  end;
               end if;
            end if;
         end loop;
      end Clear;

   end Sqlite_Connections;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      D.Map.Open (Config, Result);
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

   --  ------------------------------
   --  Deletes the SQLite driver.
   --  ------------------------------
   overriding
   procedure Finalize (D : in out Sqlite_Driver) is
   begin
      Log.Debug ("Deleting the sqlite driver");
      D.Map.Clear;
   end Finalize;

end ADO.Drivers.Connections.Sqlite;

-----------------------------------------------------------------------
--  ADO Sqlite Database -- SQLite Database connections
--  Copyright (C) 2009, 2010, 2011, 2012, 2015, 2017, 2018 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.C.Strings;

with Util.Log;
with Util.Log.Loggers;
with Util.Processes.Tools;
with ADO.Sessions;
with ADO.Statements.Sqlite;
with ADO.Schemas.Sqlite;

package body ADO.Drivers.Connections.Sqlite is

   use ADO.Statements.Sqlite;
   use Interfaces.C;

   pragma Linker_Options ("-lsqlite3");

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Databases.Sqlite");

   Driver_Name : aliased constant String := "sqlite";
   Driver      : aliased Sqlite_Driver;

   --  ------------------------------
   --  Get the database driver which manages this connection.
   --  ------------------------------
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access is
      pragma Unreferenced (Database);
   begin
      return Driver'Access;
   end Get_Driver;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Query => Query);
   end Create_Statement;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access is
   begin
      return Create_Statement (Database => Database.Server, Table => Table);
   end Create_Statement;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Database_Connection) is
   begin
      if Database.Server = null then
         raise ADO.Sessions.Session_Error with "Database connection is closed";
      end if;
   end Rollback;

   --  ------------------------------
   --  Closes the database connection
   --  ------------------------------
   overriding
   procedure Close (Database : in out Database_Connection) is
   begin
      Log.Info ("Close connection {0}", Database.Name);
      Database.Server := null;
   end Close;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      ADO.Schemas.Sqlite.Load_Schema (Database, Schema);
   end Load_Schema;

   protected body Sqlite_Connections is

      procedure Open (Config : in Configuration'Class;
                      Result : in out Ref.Ref'Class) is
         use Strings;

         URI      : constant String := Config.Get_URI;
         Database : Database_Connection_Access;
         Pos      : Database_List.Cursor := Database_List.First (List);
         DB       : SQLite_Database;
      begin
         --  Look first in the database list.
         while Database_List.Has_Element (Pos) loop
            DB := Database_List.Element (Pos);
            if DB.URI = URI then
               Database := new Database_Connection;
               Database.URI := DB.URI;
               Database.Name := DB.Name;
               Database.Server := DB.Server;
               Result := Ref.Create (Database.all'Access);
               return;
            end if;
            Database_List.Next (Pos);
         end loop;

         --  Now we can open a new database connection.
         declare
            Name     : constant String := Config.Get_Database;
            Filename : Strings.chars_ptr;
            Status   : int;
            Handle   : aliased access Sqlite3;
            Flags    : int
              := Sqlite3_H.SQLITE_OPEN_FULLMUTEX + Sqlite3_H.SQLITE_OPEN_READWRITE;
         begin
            if Config.Is_On (CREATE_NAME) then
               Flags := Flags + Sqlite3_H.SQLITE_OPEN_CREATE;
            end if;
            Filename := Strings.New_String (Name);
            Status := Sqlite3_H.sqlite3_open_v2 (Filename, Handle'Address,
                                                 Flags,
                                                 Strings.Null_Ptr);

            Strings.Free (Filename);
            if Status /= Sqlite3_H.SQLITE_OK then
               declare
                  Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Status);
                  Msg   : constant String := Strings.Value (Error);
               begin
                  Log.Error ("Cannot open SQLite database: {0}", Msg);
                  raise ADO.Configs.Connection_Error with "Cannot open database: " & Msg;
               end;
            end if;

            Database := new Database_Connection;
            declare

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value);
               function Escape (Value : in Util.Properties.Value) return String;

               function Escape (Value : in Util.Properties.Value) return String is
                  S : constant String := Util.Properties.To_String (Value);
               begin
                  if S'Length > 0 and then S (S'First) >= '0' and then S (S'First) <= '9' then
                     return S;
                  elsif S'Length > 0 and then S (S'First) = ''' then
                     return S;
                  else
                     return "'" & S & "'";
                  end if;
               end Escape;

               procedure Configure (Name : in String;
                                    Item : in Util.Properties.Value) is
                  SQL : constant String := "PRAGMA " & Name & "=" & Escape (Item);
               begin
                  if Name /= CREATE_NAME then
                     if Util.Strings.Index (Name, '.') = 0 then
                        Log.Info ("Configure database with {0}", SQL);
                        ADO.Statements.Sqlite.Execute (Database.Server, SQL);
                     end if;
                  end if;

               exception
                  when SQL_Error =>
                     null;
               end Configure;

            begin
               Database.Server := Handle;
               Database.Name   := To_Unbounded_String (Config.Get_Database);
               Database.URI    := To_Unbounded_String (URI);
               Result := Ref.Create (Database.all'Access);

               DB.Server := Handle;
               DB.Name := Database.Name;
               DB.URI := Database.URI;
               Database_List.Prepend (Container => List, New_Item => DB);

               --  Configure the connection by setting up the SQLite 'pragma X=Y' SQL commands.
               --  Typical configuration includes:
               --    synchronous=OFF
               --    temp_store=MEMORY
               --    encoding='UTF-8'
               Config.Iterate (Process => Configure'Access);
            end;
         end;
      end Open;

      procedure Clear is
         DB     : SQLite_Database;
         Result : int;
      begin
         while not Database_List.Is_Empty (List) loop
            DB := Database_List.First_Element (List);
            Database_List.Delete_First (List);
            if DB.Server /= null then
               Result := Sqlite3_H.sqlite3_close_v2 (DB.Server);
               if Result /= Sqlite3_H.SQLITE_OK then
                  declare
                     Error : constant Strings.chars_ptr := Sqlite3_H.sqlite3_errstr (Result);
                     Msg   : constant String := Strings.Value (Error);
                  begin
                     Log.Error ("Cannot close database {0}: {1}", To_String (DB.Name), Msg);
                  end;
               end if;
            end if;
         end loop;
      end Clear;

   end Sqlite_Connections;

   --  ------------------------------
   --  Initialize the database connection manager.
   --  ------------------------------
   procedure Create_Connection (D      : in out Sqlite_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      D.Map.Open (Config, Result);
   end Create_Connection;

   --  ------------------------------
   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   --  ------------------------------
   overriding
   procedure Create_Database (D           : in out Sqlite_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector) is
      pragma Unreferenced (D, Admin);

      Status        : Integer;
      Database_Path : constant String := Config.Get_Database;
      Command       : constant String :=
        "sqlite3 --batch --init " & Schema_Path & " " & Database_Path;
   begin
      Log.Info ("Creating SQLite database {0}", Database_Path);
      Util.Processes.Tools.Execute (Command, Messages, Status);

      if Status = 0 then
         Log.Info ("Database schema created successfully.");
      elsif Status = 255 then
         Messages.Append ("Command not found: " & Command);
         Log.Error ("Command not found: {0}", Command);
      else
         Messages.Append ("Command " & Command & " failed with exit code "
                            & Util.Strings.Image (Status));
         Log.Error ("Command {0} failed with exit code {1}", Command,
                    Util.Strings.Image (Status));
      end if;
   end Create_Database;

   --  ------------------------------
   --  Initialize the SQLite driver.
   --  ------------------------------
   procedure Initialize is
      use type Util.Strings.Name_Access;
   begin
      Log.Debug ("Initializing sqlite driver");

      if Driver.Name = null then
         Driver.Name := Driver_Name'Access;
         Register (Driver'Access);
      end if;
   end Initialize;

   --  ------------------------------
   --  Deletes the SQLite driver.
   --  ------------------------------
   overriding
   procedure Finalize (D : in out Sqlite_Driver) is
   begin
      Log.Debug ("Deleting the sqlite driver");
      D.Map.Clear;
   end Finalize;

end ADO.Drivers.Connections.Sqlite;

Use Is_On function to check if the SQLite create flag must be set Ignore the 'create' property when configuring the SQLite pragmas


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 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 Ada.Unchecked_Deallocation;
with ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query);
      if Query.Is_Null then
         raise Query_Error with "Query does not exist";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         elsif Length (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         else
            raise Query_Error with "Default count-query is empty";
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      elsif Length (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      else
         raise Query_Error with "Default query is empty";
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 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 Ada.Unchecked_Deallocation;
with ADO.Queries.Loaders;
package body ADO.Queries is

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   --  ------------------------------
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := False;
   end Set_Query;

   --  ------------------------------
   --  Set the query definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   --  ------------------------------
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access) is
   begin
      Into.Query_Def := Query;
      Into.Is_Count  := True;
   end Set_Count_Query;

   procedure Set_Query (Into  : in out Context;
                        Name  : in String) is
   begin
      Into.Query_Def := ADO.Queries.Loaders.Find_Query (Name);
   end Set_Query;

   --  ------------------------------
   --  Set the query to execute as SQL statement.
   --  ------------------------------
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String) is
   begin
      ADO.SQL.Clear (Into.SQL);
      ADO.SQL.Append (Into.SQL, SQL);
   end Set_SQL;

   --  ------------------------------
   --  Set the limit for the SQL query.
   --  ------------------------------
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural) is
   begin
      Into.First := First;
      Into.Last  := Last;
   end Set_Limit;

   --  ------------------------------
   --  Get the first row index.
   --  ------------------------------
   function Get_First_Row_Index (From : in Context) return Natural is
   begin
      return From.First;
   end Get_First_Row_Index;

   --  ------------------------------
   --  Get the last row index.
   --  ------------------------------
   function Get_Last_Row_Index (From : in Context) return Natural is
   begin
      return From.Last;
   end Get_Last_Row_Index;

   --  ------------------------------
   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the <b>sql-count</b> query.
   --  ------------------------------
   function Get_Max_Row_Count (From : in Context) return Natural is
   begin
      return From.Max_Row_Count;
   end Get_Max_Row_Count;

   --  ------------------------------
   --  Get the SQL query that correspond to the query context.
   --  ------------------------------
   function Get_SQL (From   : in Context;
                     Manager : in Query_Manager'Class) return String is
   begin
      if From.Query_Def = null then
         return ADO.SQL.To_String (From.SQL);
      else
         return Get_SQL (From.Query_Def, Manager, From.Is_Count);
      end if;
   end Get_SQL;

   --  ------------------------------
   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   --  ------------------------------
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access is
      Query : Query_Definition_Access := File.File.Queries;
   begin
      while Query /= null loop
         if Query.Name.all = Name then
            return Query;
         end if;
         Query := Query.Next;
      end loop;
      return null;
   end Find_Query;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String is
      Query : Query_Info_Ref.Ref;
   begin
      ADO.Queries.Loaders.Read_Query (Manager, From);
      Query := Manager.Queries (From.Query);
      if Query.Is_Null then
         raise Query_Error with "Query '" & From.Name.all & "'does not exist";
      end if;
      if Use_Count then
         if Length (Query.Value.Count_Query (Manager.Driver).SQL) > 0 then
            return To_String (Query.Value.Count_Query (Manager.Driver).SQL);
         elsif Length (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
            return To_String (Query.Value.Count_Query (ADO.Drivers.Driver_Index'First).SQL);
         else
            raise Query_Error with "Default count-query '" & From.Name.all & "'is empty";
         end if;
      elsif Length (Query.Value.Main_Query (Manager.Driver).SQL) > 0 then
         return To_String (Query.Value.Main_Query (Manager.Driver).SQL);
      elsif Length (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL) > 0 then
         return To_String (Query.Value.Main_Query (ADO.Drivers.Driver_Index'First).SQL);
      else
         raise Query_Error with "Default query '" & From.Name.all & "' is empty";
      end if;
   end Get_SQL;

   overriding
   procedure Finalize (Manager : in out Query_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => File_Table,
                                        Name   => File_Table_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Query_Table,
                                        Name   => Query_Table_Access);
   begin
      Free (Manager.Queries);
      Free (Manager.Files);
   end Finalize;

end ADO.Queries;

Update the Query_Error exception to add the query name in the message


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
with Ada.Finalization;

--  == Introduction ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by [http://code.google.com/p/ada-gen Dynamo] to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by [http://code.google.com/p/ada-gen Dynamo].
--
--  == XML Query File and Mapping ==
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  == SQL Result Mapping ==
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify and table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with private;
   type Query_Manager_Access is access all Query_Manager;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager'Class) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Atomic_Ref;
   type Query_Table_Access is access all Query_Table;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;
   type File_Table_Access is access all File_Table;
--
--     type Query_Manager (Query_Count : Query_Index;
--                         File_Count  : File_Index) is limited record
--        Driver  : ADO.Drivers.Driver_Index;
--        Queries : Query_Table (1 .. Query_Count);
--        Files   : File_Table (1 .. File_Count);
--     end record;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table_Access;
      Files   : File_Table_Access;
   end record;

   overriding
   procedure Finalize (Manager : in out Query_Manager);

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015, 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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
with Ada.Finalization;

--  == Introduction ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by [http://code.google.com/p/ada-gen Dynamo] to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by [http://code.google.com/p/ada-gen Dynamo].
--
--  == XML Query File and Mapping ==
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  == SQL Result Mapping ==
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify and table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with private;
   type Query_Manager_Access is access all Query_Manager;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager'Class) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;
   type Query_Info_Access is access all Query_Info;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Atomic_Ref;
   type Query_Table_Access is access all Query_Table;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;
   type File_Table_Access is access all File_Table;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table_Access;
      Files   : File_Table_Access;
   end record;

   overriding
   procedure Finalize (Manager : in out Query_Manager);

end ADO.Queries;

Make Query_Info, Query_Info_Access and Query_Info_Ref_Access private types


-----------------------------------------------------------------------
--  util-http-clients -- HTTP Clients
--  Copyright (C) 2011, 2012, 2015 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 Ada.Finalization;

with Util.Http.Cookies;

--  == Client ==
--  The <tt>Util.Http.Clients</tt> package defines a set of API for an HTTP client to send
--  requests to an HTTP server.
--
--  === GET request ===
--  To retrieve a content using the HTTP GET operation, a client instance must be created.
--  The response is returned in a specific object that must therefore be declared:
--
--    Http     : Util.Http.Clients.Client;
--    Response : Util.Http.Clients.Response;
--
--  Before invoking the GET operation, the client can setup a number of HTTP headers.
--
--    Http.Add_Header ("X-Requested-By", "wget");
--
--  The GET operation is performed when the <tt>Get</tt> procedure is called:
--
--    Http.Get ("http://www.google.com", Response);
--
--  Once the response is received, the <tt>Response</tt> object contains the status of the
--  HTTP response, the HTTP reply headers and the body.  A response header can be obtained
--  by using the <tt>Get_Header</tt> function and the body using <tt>Get_Body</tt>:
--
--    Body : constant String := Response.Get_Body;
--
package Util.Http.Clients is

   Connection_Error : exception;

   --  ------------------------------
   --  Http response
   --  ------------------------------
   --  The Response type represents a response returned by an HTTP request.
   type Response is limited new Abstract_Response with private;

   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   overriding
   function Contains_Header (Reply : in Response;
                             Name  : in String) return Boolean;

   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Reply  : in Response;
                        Name   : in String) return String;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Reply    : in out Response;
                         Name     : in String;
                         Value    : in String);

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   overriding
   procedure Add_Header (Reply   : in out Response;
                         Name    : in String;
                         Value   : in String);

   --  Iterate over the response headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Reply   : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String));

   --  Get the response body as a string.
   overriding
   function Get_Body (Reply : in Response) return String;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in Response) return Natural;

   --  ------------------------------
   --  Http client
   --  ------------------------------
   --  The Client type allows to execute HTTP GET/POST requests.
   type Client is limited new Abstract_Request with private;
   type Client_Access is access all Client;

   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   overriding
   function Contains_Header (Request : in Client;
                             Name    : in String) return Boolean;

   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Request : in Client;
                        Name    : in String) return String;

   --  Sets a header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String);

   --  Adds a header with the given name and value.
   --  This method allows headers to have multiple values.
   overriding
   procedure Add_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String);

   --  Iterate over the request headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Request : in Client;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String));

   --  Removes all headers with the given name.
   procedure Remove_Header (Request : in out Client;
                            Name    : in String);

   --  Adds the specified cookie to the request.  This method can be called multiple
   --  times to set more than one cookie.
   procedure Add_Cookie (Http   : in out Client;
                         Cookie : in Util.Http.Cookies.Cookie);

   --  Execute an http GET request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   procedure Get (Request  : in out Client;
                  URL      : in String;
                  Reply    : out Response'Class);

   --  Execute an http POST request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in String;
                   Reply   : out Response'Class);

private

   subtype Http_Request is Abstract_Request;
   subtype Http_Request_Access is Abstract_Request_Access;

   subtype Http_Response is Abstract_Response;
   subtype Http_Response_Access is Abstract_Response_Access;

   type Http_Manager is interface;
   type Http_Manager_Access is access all Http_Manager'Class;

   procedure Create (Manager  : in Http_Manager;
                     Http     : in out Client'Class) is abstract;

   procedure Do_Get (Manager  : in Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is abstract;

   procedure Do_Post (Manager  : in Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is abstract;

   Default_Http_Manager : Http_Manager_Access;

   type Response is limited new Ada.Finalization.Limited_Controlled
     and Abstract_Response with record
      Delegate : Abstract_Response_Access;
   end record;

   --  Free the resource used by the response.
   overriding
   procedure Finalize (Reply : in out Response);

   type Client is limited new Ada.Finalization.Limited_Controlled
     and Abstract_Request with record
      Manager  : Http_Manager_Access;
      Delegate : Http_Request_Access;
   end record;

   --  Initialize the client
   overriding
   procedure Initialize (Http : in out Client);

   overriding
   procedure Finalize (Http : in out Client);

end Util.Http.Clients;

-----------------------------------------------------------------------
--  util-http-clients -- HTTP Clients
--  Copyright (C) 2011, 2012, 2015, 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 Ada.Finalization;

with Util.Http.Cookies;

--  == Client ==
--  The <tt>Util.Http.Clients</tt> package defines a set of API for an HTTP client to send
--  requests to an HTTP server.
--
--  === GET request ===
--  To retrieve a content using the HTTP GET operation, a client instance must be created.
--  The response is returned in a specific object that must therefore be declared:
--
--    Http     : Util.Http.Clients.Client;
--    Response : Util.Http.Clients.Response;
--
--  Before invoking the GET operation, the client can setup a number of HTTP headers.
--
--    Http.Add_Header ("X-Requested-By", "wget");
--
--  The GET operation is performed when the <tt>Get</tt> procedure is called:
--
--    Http.Get ("http://www.google.com", Response);
--
--  Once the response is received, the <tt>Response</tt> object contains the status of the
--  HTTP response, the HTTP reply headers and the body.  A response header can be obtained
--  by using the <tt>Get_Header</tt> function and the body using <tt>Get_Body</tt>:
--
--    Body : constant String := Response.Get_Body;
--
package Util.Http.Clients is

   Connection_Error : exception;

   --  ------------------------------
   --  Http response
   --  ------------------------------
   --  The Response type represents a response returned by an HTTP request.
   type Response is limited new Abstract_Response with private;

   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   overriding
   function Contains_Header (Reply : in Response;
                             Name  : in String) return Boolean;

   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Reply  : in Response;
                        Name   : in String) return String;

   --  Sets a message header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Reply    : in out Response;
                         Name     : in String;
                         Value    : in String);

   --  Adds a request header with the given name and value.
   --  This method allows request headers to have multiple values.
   overriding
   procedure Add_Header (Reply   : in out Response;
                         Name    : in String;
                         Value   : in String);

   --  Iterate over the response headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Reply   : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String));

   --  Get the response body as a string.
   overriding
   function Get_Body (Reply : in Response) return String;

   --  Get the response status code.
   overriding
   function Get_Status (Reply : in Response) return Natural;

   --  ------------------------------
   --  Http client
   --  ------------------------------
   --  The Client type allows to execute HTTP GET/POST requests.
   type Client is limited new Abstract_Request with private;
   type Client_Access is access all Client;

   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   overriding
   function Contains_Header (Request : in Client;
                             Name    : in String) return Boolean;

   --  Returns the value of the specified request header as a String. If the request
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the request. The header name is case insensitive. You can use
   --  this method with any response header.
   overriding
   function Get_Header (Request : in Client;
                        Name    : in String) return String;

   --  Sets a header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   overriding
   procedure Set_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String);

   --  Adds a header with the given name and value.
   --  This method allows headers to have multiple values.
   overriding
   procedure Add_Header (Request  : in out Client;
                         Name     : in String;
                         Value    : in String);

   --  Iterate over the request headers and executes the Process procedure.
   overriding
   procedure Iterate_Headers (Request : in Client;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String));

   --  Removes all headers with the given name.
   procedure Remove_Header (Request : in out Client;
                            Name    : in String);

   --  Adds the specified cookie to the request.  This method can be called multiple
   --  times to set more than one cookie.
   procedure Add_Cookie (Http   : in out Client;
                         Cookie : in Util.Http.Cookies.Cookie);

   --  Execute an http GET request on the given URL.  Additional request parameters,
   --  cookies and headers should have been set on the client object.
   procedure Get (Request  : in out Client;
                  URL      : in String;
                  Reply    : out Response'Class);

   --  Execute an http POST request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   procedure Post (Request : in out Client;
                   URL     : in String;
                   Data    : in String;
                   Reply   : out Response'Class);

   --  Execute an http PUT request on the given URL.  The post data is passed in Data.
   --  Additional request cookies and headers should have been set on the client object.
   procedure Put (Request : in out Client;
                  URL     : in String;
                  Data    : in String;
                  Reply   : out Response'Class);

private

   subtype Http_Request is Abstract_Request;
   subtype Http_Request_Access is Abstract_Request_Access;

   subtype Http_Response is Abstract_Response;
   subtype Http_Response_Access is Abstract_Response_Access;

   type Http_Manager is interface;
   type Http_Manager_Access is access all Http_Manager'Class;

   procedure Create (Manager  : in Http_Manager;
                     Http     : in out Client'Class) is abstract;

   procedure Do_Get (Manager  : in Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is abstract;

   procedure Do_Post (Manager  : in Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is abstract;

   procedure Do_Put (Manager  : in Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is abstract;

   Default_Http_Manager : Http_Manager_Access;

   type Response is limited new Ada.Finalization.Limited_Controlled
     and Abstract_Response with record
      Delegate : Abstract_Response_Access;
   end record;

   --  Free the resource used by the response.
   overriding
   procedure Finalize (Reply : in out Response);

   type Client is limited new Ada.Finalization.Limited_Controlled
     and Abstract_Request with record
      Manager  : Http_Manager_Access;
      Delegate : Http_Request_Access;
   end record;

   --  Initialize the client
   overriding
   procedure Initialize (Http : in out Client);

   overriding
   procedure Finalize (Http : in out Client);

end Util.Http.Clients;

Declare the Put and Do_Put procedure

Declare the Put and Do_Put procedure


-----------------------------------------------------------------------
--  functions -- Show how to plug and use functions
--  Copyright (C) 2009, 2010 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 EL.Expressions;
with EL.Objects;
with EL.Contexts.Default;
with EL.Functions.Default;
with Ada.Text_IO;
with Bean;
procedure Functions is

   use Bean;
   use Ada.Text_IO;
   use EL.Expressions;
   use EL.Objects;

   E : Expression;

   Fn  : constant EL.Functions.Function_Mapper_Access
     := new EL.Functions.Default.Default_Function_Mapper;
   Ctx : EL.Contexts.Default.Default_Context;

   Joe  : constant Person_Access := Create_Person ("Joe", "Smith", 12);
   Bill : constant Person_Access := Create_Person ("Bill", "Johnson", 42);

   Result : Object;
begin
   --  Register the 'format' function.
   Fn.Set_Function (Namespace => "",
                    Name      => "format",
                    Func      => Bean.Format'Access);
   Ctx.Set_Function_Mapper (Fn);

   --  Create the expression
   E := Create_Expression ("#{format(user.firstName) & ' ' & user.lastName}", Ctx);

   --  Bind the context to 'Joe' and evaluate
   Ctx.Set_Variable ("user", Joe);
   Result := E.Get_Value (Ctx);
   Put_Line ("Joe's name is " & To_String (Result));

   --  Bind the context to 'Bill' and evaluate
   Ctx.Set_Variable ("user", Bill);
   Result := E.Get_Value (Ctx);
   Put_Line ("Bill's name is " & To_String (Result));
end Functions;

-----------------------------------------------------------------------
--  functions -- Show how to plug and use functions
--  Copyright (C) 2009, 2010 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 EL.Expressions;
with EL.Objects;
with EL.Contexts.Default;
with EL.Functions.Default;
with Ada.Text_IO;
with Bean;
procedure Functions is

   use Bean;
   use Ada.Text_IO;
   use EL.Expressions;
   use EL.Objects;

   E : Expression;

   Fn  : constant EL.Functions.Function_Mapper_Access
     := new EL.Functions.Default.Default_Function_Mapper;
   Ctx : EL.Contexts.Default.Default_Context;

   Joe  : constant Person_Access := Create_Person ("Joe", "Smith", 12);
   Bill : constant Person_Access := Create_Person ("Bill", "Johnson", 42);

   Result : Object;
begin
   --  Register the 'format' function.
   Fn.Set_Function (Namespace => "",
                    Name      => "format",
                    Func      => Bean.Format'Access);
   Ctx.Set_Function_Mapper (Fn);

   --  Create the expression
   E := Create_Expression ("#{format(user.firstName)} #{user.lastName}", Ctx);

   --  Bind the context to 'Joe' and evaluate
   Ctx.Set_Variable ("user", Joe);
   Result := E.Get_Value (Ctx);
   Put_Line ("Joe's name is " & To_String (Result));

   --  Bind the context to 'Bill' and evaluate
   Ctx.Set_Variable ("user", Bill);
   Result := E.Get_Value (Ctx);
   Put_Line ("Bill's name is " & To_String (Result));
end Functions;

Update the EL expression (both variants work but this later implementation is more conformed to the JSR specification)


------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Printers.Pretty provides an implementation of the  --
-- S-expression Printer interface, using user-defines perferences to pretty --
-- print the S-expression into the output stream.                           --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Encodings;

package Natools.S_Expressions.Printers.Pretty is
   pragma Pure (Pretty);

   type Atom_Encoding is (Base64, Hexadecimal, Verbatim);
   type Character_Encoding is (ASCII, Latin, UTF_8);
   type Newline_Encoding is (CR, LF, CR_LF, LF_CR);
   type Entity is (Opening, Atom_Data, Closing);
   type Entity_Separator is array (Entity, Entity) of Boolean;
   type Indent_Type is (Spaces, Tabs, Tabs_And_Spaces);
   type Quoted_Escape_Type is (Hex_Escape, Octal_Escape);
   type Quoted_Option is (When_Shorter, Single_Line, No_Quoted);
   type Token_Option is (Extended_Token, Standard_Token, No_Token);
   type Screen_Offset is new Natural;

   subtype Screen_Column is Screen_Offset range 1 .. Screen_Offset'Last;

   type Parameters is record
      Width         : Screen_Offset;
      Newline_At    : Entity_Separator;
      Space_At      : Entity_Separator;
      Tab_Stop      : Screen_Column;
      Indentation   : Screen_Offset;
      Indent        : Indent_Type;
      Quoted        : Quoted_Option;
      Token         : Token_Option;
      Hex_Casing    : Encodings.Hex_Casing;
      Quoted_Escape : Quoted_Escape_Type;
      Char_Encoding : Character_Encoding;
      Fallback      : Atom_Encoding;
      Newline       : Newline_Encoding;
   end record;

   Canonical : constant Parameters;

   type Printer is abstract limited new Printers.Printer with private;

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
   overriding procedure Append_Atom
     (Output : in out Printer;
      Data : in Atom);
   overriding procedure Close_List (Output : in out Printer);

   procedure Set_Parameters (Output : in out Printer; Param : in Parameters);
   function Get_Parameters (Output : Printer) return Parameters;

   procedure Set_Width
     (Output : in out Printer;
      Width : in Screen_Offset);
   procedure Set_Newline_At
     (Output : in out Printer;
      Newline_At : in Entity_Separator);
   procedure Set_Space_At
     (Output : in out Printer;
      Space_At : in Entity_Separator);
   procedure Set_Tab_Stop
     (Output : in out Printer;
      Tab_Stop : in Screen_Column);
   procedure Set_Indentation
     (Output : in out Printer;
      Indentation : in Screen_Offset);
   procedure Set_Indent
     (Output : in out Printer;
      Indent : in Indent_Type);
   procedure Set_Quoted
     (Output : in out Printer;
      Quoted : in Quoted_Option);
   procedure Set_Token
     (Output : in out Printer;
      Token : in Token_Option);
   procedure Set_Hex_Casing
     (Output : in out Printer;
      Hex_Casing : in Encodings.Hex_Casing);
   procedure Set_Quoted_Escape
     (Output : in out Printer;
      Quoted_Escape : in Quoted_Escape_Type);
   procedure Set_Char_Encoding
     (Output : in out Printer;
      Char_Encoding : in Character_Encoding);
   procedure Set_Fallback
     (Output : in out Printer;
      Fallback : in Atom_Encoding);
   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding);

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Printers.Printer with private;

private

   type Printer is abstract limited new Printers.Printer with record
      Param        : Parameters;
      Cursor       : Screen_Column := 1;
      Previous     : Entity;
      First        : Boolean := True;
      Indent_Level : Screen_Offset := 0;
      Need_Blank   : Boolean := False;
   end record;

   Canonical : constant Parameters :=
     (Width         => 0,
      Newline_At    => (others => (others => False)),
      Space_At      => (others => (others => False)),
      Tab_Stop      => 8,  --  unused
      Indentation   => 0,
      Indent        => Spaces,  --  unused
      Quoted        => No_Quoted,
      Token         => No_Token,
      Hex_Casing    => Encodings.Upper,  --  unused
      Quoted_Escape => Octal_Escape,  --  unused
      Char_Encoding => ASCII,  --  unused
      Fallback      => Verbatim,
      Newline       => LF);  --  unused

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printer with null record;

   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array);

end Natools.S_Expressions.Printers.Pretty;

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Printers.Pretty provides an implementation of the  --
-- S-expression Printer interface, using user-defines perferences to pretty --
-- print the S-expression into the output stream.                           --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Encodings;

package Natools.S_Expressions.Printers.Pretty is
   pragma Pure (Pretty);

   type Atom_Encoding is (Base64, Hexadecimal, Verbatim);
   type Character_Encoding is (ASCII, Latin, UTF_8);
   type Newline_Encoding is (CR, LF, CR_LF, LF_CR);
   type Entity is (Opening, Atom_Data, Closing);
   type Entity_Separator is array (Entity, Entity) of Boolean;
   type Indent_Type is (Spaces, Tabs, Tabs_And_Spaces);
   type Quoted_Escape_Type is (Hex_Escape, Octal_Escape);
   type Quoted_Option is (When_Shorter, Single_Line, No_Quoted);
   type Token_Option is (Extended_Token, Standard_Token, No_Token);
   type Screen_Offset is new Natural;

   subtype Screen_Column is Screen_Offset range 1 .. Screen_Offset'Last;

   type Parameters is record
      Width         : Screen_Offset        := 0;
      Newline_At    : Entity_Separator     := (others => (others => False));
      Space_At      : Entity_Separator     := (others => (others => False));
      Tab_Stop      : Screen_Column        := 8;                --  *
      Indentation   : Screen_Offset        := 0;
      Indent        : Indent_Type          := Spaces;           --  *
      Quoted        : Quoted_Option        := No_Quoted;
      Token         : Token_Option         := No_Token;
      Hex_Casing    : Encodings.Hex_Casing := Encodings.Upper;  --  *
      Quoted_Escape : Quoted_Escape_Type   := Hex_Escape;       --  *
      Char_Encoding : Character_Encoding   := ASCII;            --  *
      Fallback      : Atom_Encoding        := Verbatim;
      Newline       : Newline_Encoding     := LF;               --  *
   end record;
      --  Default values yield canonical encoding, though fields marked with
      --  an asterisk (*) can have any value and still be canonical.

   Canonical : constant Parameters := (others => <>);

   type Printer is abstract limited new Printers.Printer with private;

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
   overriding procedure Append_Atom
     (Output : in out Printer;
      Data : in Atom);
   overriding procedure Close_List (Output : in out Printer);

   procedure Set_Parameters (Output : in out Printer; Param : in Parameters);
   function Get_Parameters (Output : Printer) return Parameters;

   procedure Set_Width
     (Output : in out Printer;
      Width : in Screen_Offset);
   procedure Set_Newline_At
     (Output : in out Printer;
      Newline_At : in Entity_Separator);
   procedure Set_Space_At
     (Output : in out Printer;
      Space_At : in Entity_Separator);
   procedure Set_Tab_Stop
     (Output : in out Printer;
      Tab_Stop : in Screen_Column);
   procedure Set_Indentation
     (Output : in out Printer;
      Indentation : in Screen_Offset);
   procedure Set_Indent
     (Output : in out Printer;
      Indent : in Indent_Type);
   procedure Set_Quoted
     (Output : in out Printer;
      Quoted : in Quoted_Option);
   procedure Set_Token
     (Output : in out Printer;
      Token : in Token_Option);
   procedure Set_Hex_Casing
     (Output : in out Printer;
      Hex_Casing : in Encodings.Hex_Casing);
   procedure Set_Quoted_Escape
     (Output : in out Printer;
      Quoted_Escape : in Quoted_Escape_Type);
   procedure Set_Char_Encoding
     (Output : in out Printer;
      Char_Encoding : in Character_Encoding);
   procedure Set_Fallback
     (Output : in out Printer;
      Fallback : in Atom_Encoding);
   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding);

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Printers.Printer with private;

private

   type Printer is abstract limited new Printers.Printer with record
      Param        : Parameters;
      Cursor       : Screen_Column := 1;
      Previous     : Entity;
      First        : Boolean := True;
      Indent_Level : Screen_Offset := 0;
      Need_Blank   : Boolean := False;
   end record;

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printer with null record;

   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array);

end Natools.S_Expressions.Printers.Pretty;

s_expressions-printers-pretty: add valid default values to Parameter objects

This ensures that default Parameters objects are valid, and therefore that
pretty printers without explicit parameter initialization are valid
(and canonical) too.