------------------------------------------------------------------------------ -- 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 -- -- . -- -- -- ------------------------------------------------------------------------------ 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;