gnatcoll-db/sql/gnatcoll-sql_impl.ads

------------------------------------------------------------------------------
--                             G N A T C O L L                              --
--                                                                          --
--                     Copyright (C) 2005-2020, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;
with Ada.Calendar;
with Ada.Containers.Vectors;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Hashed_Sets;
with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
with GNATCOLL.Refcount;       use GNATCOLL.Refcount;

package GNATCOLL.SQL_Impl is
   --  Work around issue with the Ada containers: the tampering checks
   --  mean that the container might be corrupted if used from multiple
   --  tasks, even in read-only.
   --      pragma Suppress (Tampering_Check);

   type Cst_String_Access is access constant String;
   --  Various aspects of a database description (table names, field names,...)
   --  are represented as string. To limit the number of memory allocation and
   --  deallocation (and therefore increase speed), this package uses such
   --  strings as Cst_String_Access. These strings are never deallocation, and
   --  should therefore be pointed to "aliased constant String" in your
   --  code, as in:
   --       Name : aliased constant String := "mysubquery";
   --       Q : SQL_Query := SQL_Select
   --          (Fields => ...,
   --           From   => Subquery (SQL_Select (...),
   --                               Name => Name'Access));

   Null_String : aliased constant String := "NULL";

   K_Delta : constant := 0.01;
   K_Decimals : constant := 2;   --  must match K_Delta above
   K_Digits : constant := 14;
   type T_Money is delta K_Delta digits K_Digits;
   --  The base type to represent money in a database. The exact mapping
   --  depends on the DBMS (for postgreSQL, this is "numeric(14,2)").

   ---------------
   -- Formatter --
   ---------------

   type Formatter is abstract tagged null record;
   --  A formatter provides DBMS-specific formatting for SQL statements.
   --  Each backend has its peculiarities, and these are handled through
   --  various instances of Formatter.

   function Boolean_Image (Self : Formatter; Value : Boolean) return String;
   function Money_Image (Self : Formatter; Value : T_Money) return String;
   --  Return an image of the various basic types suitable for the DBMS.
   --  For instance, sqlite does not support boolean fields, which are thus
   --  mapped to integers at the lowest level, even though the Ada layer still
   --  manipulates Booleans.
   --  If you override these, you will likely want to also override
   --  Boolean_Value (DBMS_Forward_Cursor).

   function String_Image
     (Self : Formatter; Value : String; Quote : Boolean) return String;
   --  Escape every apostrophe character "'".
   --  Useful for strings in SQL commands where "'" means the end
   --  of the current string.
   --  This is not suitable for use for prepared queries, which should not be
   --  quoted.
   --  If Quote is False, Value is returned as is (suitable for prepared
   --  queries). Otherwise, Value is surrounded by quote characters, and every
   --  special character in Value are also protected.

   function Field_Type_Autoincrement
     (Self : Formatter) return String is abstract;
   --  Return the SQL type to use for auto-incremented fields.
   --  Such a field is always a primary key, so this information is also
   --  returned as part of the type (this is mandatory for sqlite in
   --  particular).

   function Field_Type_Money
     (Self : Formatter) return String is abstract;
   --  Return the SQL type to use for money fields depending on DBMS

   function Supports_Timezone (Self  : Formatter) return Boolean;
   --  Whether the formatter supports time zones for times. Default is True.

   function Parameter_String
     (Self       : Formatter;
      Index      : Positive;
      Type_Descr : String) return String;
   --  Return the character to put before a parameter in a SQL statement, when
   --  the value will be substituted at run time.
   --  Type_Descr describes the type of the parameter, and is returned by the
   --  SQL_Parameter primitive operation Describe_Type;

   generic
      type Base_Type is digits <>;
   function Any_Float_To_SQL
     (Self : Formatter'Class; Value : Base_Type; Quote : Boolean)
     return String;

   function Boolean_To_SQL
     (Self : Formatter'Class; Value : Boolean; Quote : Boolean) return String;
   function Integer_To_SQL
     (Self : Formatter'Class; Value : Integer; Quote : Boolean) return String;
   function Bigint_To_SQL
     (Self  : Formatter'Class;
      Value : Long_Long_Integer;
      Quote : Boolean) return String;
   function String_To_SQL
     (Self : Formatter'Class; Value : String; Quote : Boolean) return String;
   function Time_To_SQL
     (Self : Formatter'Class; Value : Ada.Calendar.Time; Quote : Boolean)
      return String;
   function Date_To_SQL
     (Self : Formatter'Class; Value : Ada.Calendar.Time; Quote : Boolean)
      return String;
   function Money_To_SQL
     (Self : Formatter'Class; Value : T_Money; Quote : Boolean) return String;
   --  Calls the above formatting primitives (or provide default version, when
   --  not overridable)
   --  If Quote is False, these functions provide quotes around the values. For
   --  instance, the image for a string contains the string itself, unquoted,
   --  and with special characters unprotected. As a result, this is only
   --  suitable for use with parametrized queries.

   ----------------
   -- Parameters --
   ----------------
   --  Support for parameters when executing SQL queries.
   --  See GNATCOLL.SQL.Exec

   type SQL_Parameter_Type is abstract tagged null record;

   procedure Free (Self : in out SQL_Parameter_Type) is null;
   --  Free memory used by Self

   function Type_String
      (Self   : SQL_Parameter_Type;
       Index  : Positive;
       Format : Formatter'Class) return String is abstract;
   --  Return the string to use in a query to describe the parameter, for
   --  instance "$1::integer" with postgreSQL, or "?1" with sqlite.
   --  In general, this will be done via a call to Format.Parameter_String
   --  unless you do not need to support multiple DBMS.

   function Internal_Image
      (Self   : SQL_Parameter_Type;
       Format : Formatter'Class) return String with Inline;
   --  Marshall the parameter to a string, to pass it to the DBMS.
   --  Use the formatter's primitives to encode basic types when possible.

   procedure Free_Dispatch (Self : in out SQL_Parameter_Type'Class);
   package Parameters is new GNATCOLL.Refcount.Shared_Pointers
      (SQL_Parameter_Type'Class, Free_Dispatch);
   type SQL_Parameter_Base is new Parameters.Ref with null record;

   function Image
      (Self   : SQL_Parameter_Base;
       Format : Formatter'Class) return String
   is (if Self.Is_Null then "NULL" else Internal_Image (Self.Get, Format));
   --  Marshall the parameter to a string, to pass it to the DBMS.
   --  Null parameter show as NULL to avoid Constraint_Error.

   generic
      type Ada_Type is private;
      SQL_Type : String;
      with function Image
         (Format : Formatter'Class; Value : Ada_Type; Quote : Boolean)
         return String;
   package Scalar_Parameters is
      --  A helper package to create simple sql parameters. These assume
      --  the data type is constrained, and that they map to a single SQL
      --  type.

      type SQL_Parameter is new SQL_Parameter_Type with record
         Val     : Ada_Type;
      end record;
      overriding function Type_String
         (Self   : SQL_Parameter;
          Index  : Positive;
          Format : Formatter'Class) return String
         is (Format.Parameter_String (Index, SQL_Type));
      overriding function Internal_Image
         (Self   : SQL_Parameter;
          Format : Formatter'Class) return String
         is (Image (Format, Self.Val, Quote => False));
   end Scalar_Parameters;

   ----------------------
   -- Parameters types --
   ----------------------

   type SQL_Parameter_Text is new SQL_Parameter_Type with record
      Str_Ptr : access constant String;
      --  References external string, to avoid an extra copy

      Str_Val : Unbounded_String;
      --  Unbounded string copies only reference on assignment

      Make_Copy : Boolean;
      --  If set this forces SQL engine to make a copy of Str_Ptr.all
   end record;
   function To_String (Self : SQL_Parameter_Text) return String
      is (if Self.Str_Ptr = null
          then To_String (Self.Str_Val)
          else Self.Str_Ptr.all);
   overriding function Type_String
      (Self   : SQL_Parameter_Text;
       Index  : Positive;
       Format : Formatter'Class) return String
      is (Format.Parameter_String (Index, "text"));
   overriding function Internal_Image
      (Self   : SQL_Parameter_Text;
       Format : Formatter'Class) return String with Inline;

   type SQL_Parameter_Character is new SQL_Parameter_Type with record
      Char_Val   : Character;
   end record;
   overriding function Type_String
      (Self   : SQL_Parameter_Character;
       Index  : Positive;
       Format : Formatter'Class) return String
      is (Format.Parameter_String (Index, "text"));
   overriding function Internal_Image
      (Self   : SQL_Parameter_Character;
       Format : Formatter'Class) return String with Inline;

   -------------------------------------
   -- General declarations for tables --
   -------------------------------------
   --  The following declarations are needed to be able to declare the
   --  following generic packages. They are repeated in GNATCOLL.SQL for ease
   --  of use.

   type Table_Names is record
      Name     : Cst_String_Access;

      Instance : Cst_String_Access;
      Instance_Index : Integer := -1;
      --  The name of the instance is either Instance (if not null), or
      --  computed from the index (see Numbered_Tables above) if not -1, or the
      --  name of the table
   end record;
   No_Names : constant Table_Names := (null, null, -1);
   --  Describes a table (by its name), and the name of its instance. This is
   --  used to find all tables involved in a query, for the auto-completion. We
   --  do not store instances of SQL_Table'Class directly, since that would
   --  involve several things:
   --     - extra Initialize/Adjust/Finalize calls
   --     - Named_Field_Internal would need to embed a pointer to a table, as
   --       opposed to just its names, and therefore must be a controlled type.
   --       This makes the automatic package more complex, and makes the field
   --       type controlled, which is also a lot more costly.
   --  The contents of this type is the same as the discriminants for SQL_Table
   --  and SQL_Field (but unfortunately cannot be used directly as the
   --  discriminant).

   function Instance_Name (Names : Table_Names) return String;
   --  Return the name of the instance for that table.

   function Hash (Self : Table_Names) return Ada.Containers.Hash_Type;
   package Table_Sets is new Ada.Containers.Indefinite_Hashed_Sets
     (Table_Names, Hash, "=", "=");

   type SQL_Table_Or_List is abstract tagged private;
   --  Either a single table or a group of tables

   procedure Append_Tables
     (Self : SQL_Table_Or_List; To : in out Table_Sets.Set) is null;
   --  Append all the tables referenced in Self to To

   function To_String
     (Self : SQL_Table_Or_List; Format : Formatter'Class)
      return String is abstract;
   --  Convert the table to a string

   type SQL_Single_Table (Instance : GNATCOLL.SQL_Impl.Cst_String_Access;
                          Instance_Index : Integer)
      is abstract new SQL_Table_Or_List with private;
   --  Any type of table, or result of join between several tables. Such a
   --  table can have fields

   -------------------------------------
   -- General declarations for fields --
   -------------------------------------

   type SQL_Assignment is private;

   type SQL_Field_Or_List is abstract tagged null record;
   --  Either a single field or a list of fields

   function To_String
     (Self   : SQL_Field_Or_List;
      Format : Formatter'Class;
      Long   : Boolean := True) return String
      is abstract;
   --  Convert the field to a string. If Long is true, a fully qualified
   --  name is used (table.name), otherwise just the field name is used

   type SQL_Field_List is new SQL_Field_Or_List with private;
   Empty_Field_List : constant SQL_Field_List;
   --  A list of fields, as used in a SELECT query ("field1, field2");

   function Is_Empty (List : SQL_Field_List) return Boolean;
   --  Returns true when field list is empty

   function Length (List : SQL_Field_List) return Natural;
   --  Returns number of elements in field list

   overriding function To_String
     (Self   : SQL_Field_List;
      Format : Formatter'Class;
      Long   : Boolean := True) return String;
   --  See inherited doc

   type SQL_Field (Table : Cst_String_Access;
                   Instance : Cst_String_Access;
                   Name : Cst_String_Access;
                   Instance_Index : Integer)
      is abstract new SQL_Field_Or_List with null record;
   --  A field that comes directly from the database. It can be within a
   --  specific table instance, but we still need to know the name of the table
   --  itself for the auto-completion.
   --  (Table,Instance) might be null if the field is a constant.
   --  The discriminants are used to get the name of the table when displaying
   --  the field, while permitting static constructs like:
   --      Ta_Names : constant Cst_String_Access := ...;
   --      type T_Names (Instance : Cst_String_Access)
   --          is new SQL_Table (Ta_Names, Instance, -1)
   --      with record
   --         Id : SQL_Field_Integer (Ta_Names, Instance, -1);
   --      end record;
   --  so that one can define multiple representations of the Names table, as
   --  in:
   --     T1 : T_Names (null);       --  Default, name will be "names"
   --     T2 : T_Names (Ta_Names2);  --  An alias
   --  In both cases, the fields T1.Id and T2.Id automatically know how to
   --  display themselves as "names.id" and "names2.id". This does not
   --  require memory allocation and is thus more efficient.

   overriding function To_String
     (Self   : SQL_Field;
      Format : Formatter'Class;
      Long   : Boolean := True) return String;
   --  See inherited doc

   procedure Append_Tables (Self : SQL_Field; To : in out Table_Sets.Set);
   --  Append the table(s) referenced by Self to To.
   --  This is used for auto-completion later on

   procedure Append_If_Not_Aggregate
     (Self         : SQL_Field;
      To           : in out SQL_Field_List'Class;
      Is_Aggregate : in out Boolean);
   --  Append all fields referenced by Self if Self is not the result of an
   --  aggregate function. This is used for auto-completion of "group by".
   --  Is_Aggregate is set to True if Self is an aggregate, untouched otherwise

   procedure Append (List : in out SQL_Field_List; Field : SQL_Field'Class);

   function "&" (Left, Right : SQL_Field'Class) return SQL_Field_List;
   function "&" (Left, Right : SQL_Field_List) return SQL_Field_List;
   function "&"
     (Left : SQL_Field_List; Right : SQL_Field'Class) return SQL_Field_List;
   function "&"
     (Left : SQL_Field'Class; Right : SQL_Field_List) return SQL_Field_List;
   --  Create lists of fields

   function "+" (Left : SQL_Field'Class) return SQL_Field_List;
   --  Create a list with a single field

   package Field_List is new Ada.Containers.Indefinite_Vectors
     (Natural, SQL_Field'Class);

   function First (List : SQL_Field_List) return Field_List.Cursor;
   --  Return the first field contained in the list

   --------------------
   -- Field pointers --
   --------------------
   --  A smart pointer that frees memory whenever the field is no longer needed

   type SQL_Field_Pointer is private;
   No_Field_Pointer : constant SQL_Field_Pointer;
   --  A smart pointer

   function "+" (Field : SQL_Field'Class) return SQL_Field_Pointer;
   --  Create a new pointer. Memory will be deallocated automatically

   procedure Append
     (List : in out SQL_Field_List'Class; Field : SQL_Field_Pointer);
   --  Append a new field to the list

   function To_String
     (Self   : SQL_Field_Pointer;
      Format : Formatter'Class;
      Long   : Boolean) return String;
   procedure Append_Tables
     (Self : SQL_Field_Pointer; To : in out Table_Sets.Set);
   procedure Append_If_Not_Aggregate
     (Self         : SQL_Field_Pointer;
      To           : in out SQL_Field_List'Class;
      Is_Aggregate : in out Boolean);
   --  See doc for SQL_Field

   ----------------
   -- Field data --
   ----------------
   --  There are two kinds of fields: one is simple fields coming straight from
   --  the database ("table.field"), the other are fields computed through this
   --  API ("field1 || field2", Expression ("field"), "field as name"). The
   --  latter need to allocate memory to store their contents, and are stored
   --  in a refcounted type internally, so that we can properly manage memory.

   type SQL_Field_Internal is abstract tagged null record;
   --  Data that can be stored in a field

   procedure Free (Self : in out SQL_Field_Internal) is null;
   procedure Free_Dispatch (Self : in out SQL_Field_Internal'Class);
   function To_String
     (Self   : SQL_Field_Internal;
      Format : Formatter'Class;
      Long   : Boolean) return String is abstract;
   procedure Append_Tables
     (Self : SQL_Field_Internal; To : in out Table_Sets.Set) is null;
   procedure Append_If_Not_Aggregate
     (Self         : access SQL_Field_Internal;   --  for dispatching
      To           : in out SQL_Field_List'Class;
      Is_Aggregate : in out Boolean) is null;
   --  The three subprograms are equivalent to the ones for SQL_Field. When a
   --  field contains some data, it will simply delegate the calls to the above
   --  subprograms.
   --  Self_Field is added to the list. Self_Field.Get must be equal to Self

   package Field_Pointers is new Shared_Pointers
      (SQL_Field_Internal'Class, Free_Dispatch);
   subtype SQL_Field_Internal_Access is Field_Pointers.Element_Access;

   generic
      type Base_Field is abstract new SQL_Field with private;
   package Data_Fields is
      type Field is new Base_Field with record
         Data : Field_Pointers.Ref;
      end record;

      overriding function To_String
        (Self   : Field;
         Format : Formatter'Class;
         Long   : Boolean := True) return String;
      overriding procedure Append_Tables
        (Self : Field; To : in out Table_Sets.Set);
      overriding procedure Append_If_Not_Aggregate
        (Self         : Field;
         To           : in out SQL_Field_List'Class;
         Is_Aggregate : in out Boolean);
   end Data_Fields;
   --  Mixin inheritance for a field, to add specific user data to them. This
   --  user data is refcounted. Field just acts as a proxy for Data, and
   --  delegates all its operations to Data.

   ----------------------------------------
   -- General declarations for criterias --
   ----------------------------------------

   type SQL_Criteria is private;
   No_Criteria : constant SQL_Criteria;

   function To_String
     (Self   : SQL_Criteria;
      Format : Formatter'Class;
      Long   : Boolean := True) return String;
   procedure Append_Tables (Self : SQL_Criteria; To : in out Table_Sets.Set);
   procedure Append_If_Not_Aggregate
     (Self         : SQL_Criteria;
      To           : in out SQL_Field_List'Class;
      Is_Aggregate : in out Boolean);
   --  The usual semantics for these subprograms (see SQL_Field)

   type SQL_Criteria_Data is abstract tagged null record;
   --  The data contained in a criteria. You can create new versions of it if
   --  you need to create new types of criterias

   procedure Free (Self : in out SQL_Criteria_Data) is null;
   procedure Free_Dispatch (Self : in out SQL_Criteria_Data'Class);
   function To_String
     (Self   : SQL_Criteria_Data;
      Format : Formatter'Class;
      Long   : Boolean := True) return String
      is abstract;
   procedure Append_Tables
     (Self : SQL_Criteria_Data; To : in out Table_Sets.Set) is null;
   procedure Append_If_Not_Aggregate
     (Self         : SQL_Criteria_Data;
      To           : in out SQL_Field_List'Class;
      Is_Aggregate : in out Boolean) is null;
   --  See description of these subprograms for a SQL_Criteria

   procedure Set_Data
     (Self : in out SQL_Criteria; Data : SQL_Criteria_Data'Class);

   package SQL_Criteria_Pointers
      is new Shared_Pointers (SQL_Criteria_Data'Class, Free_Dispatch);

   subtype SQL_Criteria_Data_Access is
     SQL_Criteria_Pointers.Element_Access;

   function Get_Data (Self : SQL_Criteria) return SQL_Criteria_Data_Access;
   --  Set the data associated with Self.
   --  This is only needed when you implement your own kinds of criteria, not
   --  when writing SQL queries.

   function Compare
     (Left, Right : SQL_Field'Class;
      Op          : Cst_String_Access;
      Suffix      : Cst_String_Access := null)
      return SQL_Criteria;
   --  Used to write comparison operations. This is a low-level implementation,
   --  which should only be used when writing your own criterias, not when
   --  writing queries.
   --  The operation is written as
   --     Left Op Right Suffix

   function Compare1
     (Field       : SQL_Field'Class;
      Op          : Cst_String_Access;
      Suffix      : Cst_String_Access := null)
      return SQL_Criteria;
   --  Apply a function to a field, as in:
   --     Op Field Suffix         (Op or Suffix can contain parenthesis)

   ------------------------------------------
   -- General declarations for assignments --
   ------------------------------------------

   No_Assignment : constant SQL_Assignment;

   function "&" (Left, Right : SQL_Assignment) return SQL_Assignment;
   --  Concat two assignments

   procedure Append_Tables (Self : SQL_Assignment; To : in out Table_Sets.Set);
   function To_String
     (Self       : SQL_Assignment;
      Format     : Formatter'Class;
      With_Field : Boolean) return String;
   --  The usual semantics for these subprograms (see fields)

   procedure To_List (Self : SQL_Assignment; List : out SQL_Field_List);
   --  Return the list of values in Self as a list of fields. This is used for
   --  statements likes "INSERT INTO ... SELECT list"

   procedure Get_Fields (Self : SQL_Assignment; List : out SQL_Field_List);
   --  Return the list of fields impacted by the assignments

   function Create (F1, F2 : SQL_Field'Class) return SQL_Assignment;
   --  A generic way to create assignments

   --------------
   -- Generics --
   --------------
   --  The following package can be used to create your own field types, based
   --  on specific Ada types. It creates various subprograms for ease of use
   --  when writing queries, as well as subprograms to more easily bind SQL
   --  functions manipulating this type.

   generic
      type Ada_Type (<>) is private;
      with function To_SQL
        (Format : Formatter'Class;
         Value  : Ada_Type;
         Quote  : Boolean) return String;
      --  Converts Ada_Type to a value suitable to pass to SQL. This should
      --  protect special characters if need be and if Quote is True.
      --  This function can also be used to add constraints on the types
      --  supported by these fields.
      --  You can often rely on Ada's builtin checks (for instance an integer
      --  field that accepts values from 1 to 10 would be instantiated with an
      --  Ada type
      --       type My_Type is new Integer range 1 .. 10;
      --  and that would work. However, this isn't always doable. For instance,
      --  to represent a string field with a _maximum_ length of 10, we cannot
      --  instantiate it with String (1 .. 10), since that would only allow
      --  strings of _exactly_ 10 character. In such a case, we should
      --  implement Check_Value to ensure the max length of the string.
      --  This procedure should raise Constraint_Error in case of error.

      type Param_Type is new SQL_Parameter_Type with private;
      --  Internal type to use for the parameter

   package Field_Types is
      type Field is new SQL_Field with null record;

      function From_Table
        (Self  : Field;
         Table : SQL_Single_Table'Class) return Field'Class;
      --  Returns field applied to the table, as in Table.Field.
      --  In general, this is not needed, except when Table is the result of a
      --  call to Rename on a table generated by a call to Left_Join for
      --  instance. In such a case, the list of valid fields for Table is not
      --  known, and we do not have primitive operations to access those, so
      --  this function makes them accessible. However, there is currently no
      --  check that Field is indeed valid for Table.

      Null_Field : constant Field;

      function Expression (Value : Ada_Type) return Field'Class;
      --  Create a constant field

      function From_String (SQL : String) return Field'Class;
      --  Similar to the above, but the parameter is assumed to be proper SQL
      --  already (so for instance no quoting or special-character quoting
      --  would occur for strings). This function just indicates to GNATCOLL
      --  how the string should be interpreted

      function Param (Index : Positive) return Field'Class;
      --  Return a special string that will be inserted in the query, and
      --  can be substituted with an actual value when the query is executed.
      --  This is used to parametrize queries. In particular, this allows you
      --  to prepare a general form of the query, as in:
      --      SELECT * FROM table WHERE table.field1 = ?1
      --  and execute this several times, substituting a different value
      --  every time.
      --  This is more efficient in general (since the statement is prepared
      --  only once, although the preparation cannot take advantage of special
      --  knowledge related to the value), and safer (no need to worry about
      --  specially quoting the actual value, which GNATCOLL would do for you
      --  but potentially there might still be issues).
      --  The exact string inserted depends on the DBMS.

      function "&"
        (Field : SQL_Field'Class; Value : Ada_Type) return SQL_Field_List;
      function "&"
        (Value : Ada_Type; Field : SQL_Field'Class) return SQL_Field_List;
      function "&"
        (List : SQL_Field_List; Value : Ada_Type) return SQL_Field_List;
      function "&"
        (Value : Ada_Type; List : SQL_Field_List) return SQL_Field_List;
      --  Create lists of fields

      function "="  (Left : Field; Right : Field'Class) return SQL_Criteria;
      function "/=" (Left : Field; Right : Field'Class) return SQL_Criteria;
      function "<"  (Left : Field; Right : Field'Class) return SQL_Criteria;
      function "<=" (Left : Field; Right : Field'Class) return SQL_Criteria;
      function ">"  (Left : Field; Right : Field'Class) return SQL_Criteria;
      function ">=" (Left : Field; Right : Field'Class) return SQL_Criteria;
      function "="  (Left : Field; Right : Ada_Type) return SQL_Criteria;
      function "/=" (Left : Field; Right : Ada_Type) return SQL_Criteria;
      function "<"  (Left : Field; Right : Ada_Type) return SQL_Criteria;
      function "<=" (Left : Field; Right : Ada_Type) return SQL_Criteria;
      function ">"  (Left : Field; Right : Ada_Type) return SQL_Criteria;
      function ">=" (Left : Field; Right : Ada_Type) return SQL_Criteria;
      pragma Inline ("=", "/=", "<", ">", "<=", ">=");
      --  Compare fields and values

      function Greater_Than
        (Left : SQL_Field'Class; Right : Field) return SQL_Criteria;
      function Greater_Or_Equal
        (Left : SQL_Field'Class; Right : Field) return SQL_Criteria;
      function Equal
        (Left : SQL_Field'Class; Right : Field) return SQL_Criteria;
      function Less_Than
        (Left : SQL_Field'Class; Right : Field) return SQL_Criteria;
      function Less_Or_Equal
        (Left : SQL_Field'Class; Right : Field) return SQL_Criteria;
      function Greater_Than
        (Left : SQL_Field'Class; Right : Ada_Type) return SQL_Criteria;
      function Greater_Or_Equal
        (Left : SQL_Field'Class; Right : Ada_Type) return SQL_Criteria;
      function Equal
        (Left : SQL_Field'Class; Right : Ada_Type) return SQL_Criteria;
      function Less_Than
        (Left : SQL_Field'Class; Right : Ada_Type) return SQL_Criteria;
      function Less_Or_Equal
        (Left : SQL_Field'Class; Right : Ada_Type) return SQL_Criteria;
      pragma Inline
        (Greater_Than, Greater_Or_Equal, Equal, Less_Than, Less_Or_Equal);
      --  Same as "<", "<=", ">", ">=" and "=", but these can be used with the
      --  result of aggregate fields for instance. In general, you should not
      --  use these to work around typing issues (for instance comparing a text
      --  field with 1234)

      function "=" (Self : Field; Value : Ada_Type) return SQL_Assignment;
      function "=" (Self : Field; To : Field'Class) return SQL_Assignment;
      --  Set Field to the value of To

      --  Assign a new value to the value

      generic
         Name : String;
      function Operator (Field1, Field2 : SQL_Field'Class) return Field'Class;
      --  An operator between two fields, that return a field of the new type

      generic
         Name   : String;
         Prefix : String := "";
         Suffix : String := "";
      function String_Operator
        (Self : SQL_Field'Class; Operand : String) return Field'Class;

      generic
         type Scalar is (<>);
         Name   : String;
         Prefix : String := "";
         Suffix : String := "";
      function Scalar_Operator
        (Self : SQL_Field'Class; Operand : Scalar) return Field'Class;
      --  An operator between a field and a constant value, as in
      --      field + interval '2 days'
      --           where  Name   is "+"
      --                  Prefix is "interval '"
      --                  Suffix is " days'"

      generic
         Name : String;
      function SQL_Function return Field'Class;
      --  A no-parameter sql function, as in "CURRENT_TIMESTAMP"

      generic
         type Argument_Type is abstract new SQL_Field with private;
         Name   : String;
         Suffix : String := ")";
      function Apply_Function (Self : Argument_Type'Class) return Field'Class;
      --  Applying a function to a field, as in  "LOWER (field)", where
      --     Name   is "LOWER ("
      --     Suffix is ")"

      function Cast_Implicit (Self : SQL_Field'Class) return Field'Class;
      --  Convert any field type to this package provided implicitly

      generic
         type Argument1_Type is abstract new SQL_Field with private;
         type Argument2_Type is abstract new SQL_Field with private;
         Name   : String;
         Suffix : String := ")";
      function Apply_Function2
         (Arg1 : Argument1_Type'Class;
          Arg2 : Argument2_Type'Class)
         return Field'Class;
      --  Applying a function to two fields, and return another field

      function Nullif (Left, Right : SQL_Field'Class) return Field'Class;
      --  SQL NULLIF function

   private
      Null_Field : constant Field :=
        (Table    => null,
         Instance => null,
         Instance_Index => -1,
         Name     => Null_String'Access);
   end Field_Types;

private

   type SQL_Field_List is new SQL_Field_Or_List with record
      List : Field_List.Vector;
   end record;

   type SQL_Table_Or_List is abstract tagged null record;

   type SQL_Single_Table (Instance : Cst_String_Access;
                          Instance_Index : Integer)
      is abstract new SQL_Table_Or_List with null record;
   --  instance name, might be null when this is the same name as the table.
   --  This isn't used for lists, but is used for all other types of tables
   --  (simple, left join, subqueries) so is put here for better sharing.

   ---------------
   -- Criterias --
   ---------------

   type SQL_Criteria is record
      Criteria : SQL_Criteria_Pointers.Ref;
   end record;
   --  SQL_Criteria must not be tagged, otherwise we have subprograms that are
   --  primitive for two types. This would also be impossible for users to
   --  declare a variable of type SQL_Criteria.

   No_Criteria : constant SQL_Criteria :=
     (Criteria => SQL_Criteria_Pointers.Null_Ref);

   --------------------
   -- Field pointers --
   --------------------

   package SQL_Field_Pointers is new Shared_Pointers (SQL_Field'Class);
   type SQL_Field_Pointer is new SQL_Field_Pointers.Ref with null record;
   No_Field_Pointer : constant SQL_Field_Pointer :=
      (SQL_Field_Pointers.Null_Ref with null record);

   -----------------
   -- Assignments --
   -----------------

   type Assignment_Item is record
      Field    : SQL_Field_Pointer;
      --  The modified field

      To_Field : SQL_Field_Pointer;
      --  Its new value (No_Field_Pointer sets to NULL)
   end record;

   package Assignment_Lists is new Ada.Containers.Vectors
      (Natural, Assignment_Item);

   type SQL_Assignment is record
      List : Assignment_Lists.Vector;
   end record;

   No_Assignment : constant SQL_Assignment :=
     (List => Assignment_Lists.Empty_Vector);

   Empty_Field_List : constant SQL_Field_List :=
     (SQL_Field_Or_List with List => Field_List.Empty_Vector);

end GNATCOLL.SQL_Impl;