-----------------------------------------------------------------------
--  awa-storages-modules -- Storage management module
--  Copyright (C) 2012 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 ASF.Applications;

with AWA.Modules;
with AWA.Storages.Services;

package AWA.Storages.Modules is

   NAME : constant String := "storages";

   type Storage_Module is new AWA.Modules.Module with private;
   type Storage_Module_Access is access all Storage_Module'Class;

   --  Initialize the storage module.
   overriding
   procedure Initialize (Plugin : in out Storage_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the storage manager.
   function Get_Storage_Manager (Plugin : in Storage_Module)
                                 return Services.Storage_Service_Access;

   --  Create a storage manager.  This operation can be overriden to provide another
   --  storage service implementation.
   function Create_Storage_Manager (Plugin : in Storage_Module)
                                    return Services.Storage_Service_Access;

   --  Get the storage module instance associated with the current application.
   function Get_Storage_Module return Storage_Module_Access;

   --  Get the storage manager instance associated with the current application.
   function Get_Storage_Manager return Services.Storage_Service_Access;

private

   type Storage_Module is new AWA.Modules.Module with record
      Manager     : Services.Storage_Service_Access := null;
   end record;

end AWA.Storages.Modules;

-----------------------------------------------------------------------
--  awa-storages-modules -- Storage management module
--  Copyright (C) 2012 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 ASF.Applications;

with AWA.Modules;
with AWA.Storages.Services;

package AWA.Storages.Modules is

   NAME : constant String := "storages";

   type Storage_Module is new AWA.Modules.Module with private;
   type Storage_Module_Access is access all Storage_Module'Class;

   --  Initialize the storage module.
   overriding
   procedure Initialize (Plugin : in out Storage_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the storage manager.
   function Get_Storage_Manager (Plugin : in Storage_Module)
                                 return Services.Storage_Service_Access;

   --  Create a storage manager.  This operation can be overridden to provide another
   --  storage service implementation.
   function Create_Storage_Manager (Plugin : in Storage_Module)
                                    return Services.Storage_Service_Access;

   --  Get the storage module instance associated with the current application.
   function Get_Storage_Module return Storage_Module_Access;

   --  Get the storage manager instance associated with the current application.
   function Get_Storage_Manager return Services.Storage_Service_Access;

private

   type Storage_Module is new AWA.Modules.Module with record
      Manager        : Services.Storage_Service_Access := null;
   end record;

end AWA.Storages.Modules;

Fix comments

Fix comments


-----------------------------------------------------------------------
--  awa-mail-components-recipients -- Mail UI Recipients
--  Copyright (C) 2012 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 ASF.Contexts.Faces;

--  === Mail Messages ===
--  The <b>AWA.Mail.Components.Messages</b> package defines the UI components
--  to represent the email message with its recipients, subject and body.
--
--  The mail message is retrieved by looking at the parent UI component until a
--  <tt>UIMailMessage</tt> component is found.  The mail message recipients are initialized
--  during the render response JSF phase, that is when <tt>Encode_End</tt> are called.
package AWA.Mail.Components.Messages is

   --  ------------------------------
   --  The mail recipient
   --  ------------------------------
   type UIMailMessage is new UIMailComponent with private;
   type UIMailMessage_Access is access all UIMailMessage'Class;

   --  Set the mail message instance.
   procedure Set_Message (UI      : in out UIMailMessage;
                          Message : in AWA.Mail.Clients.Mail_Message_Access);

   --  Get the mail message instance.
   overriding
   function Get_Message (UI      : in UIMailMessage) return AWA.Mail.Clients.Mail_Message_Access;

   --  Send the mail.
   overriding
   procedure Encode_End (UI      : in UIMailMessage;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Finalize and release the mail message.
   overriding
   procedure Finalize (UI : in out UIMailMessage);

   --  ------------------------------
   --  The mail subject
   --  ------------------------------
   type UIMailSubject is new UIMailComponent with private;

   --  Render the mail subject and initializes the message with its content.
   overriding
   procedure Encode_Children (UI      : in UIMailSubject;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  The mail body
   --  ------------------------------
   type UIMailBody is new UIMailComponent with private;

   --  Render the mail body and initializes the message with its content.
   overriding
   procedure Encode_Children (UI      : in UIMailBody;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class);

private

   type UIMailMessage is new UIMailComponent with record
      Message : AWA.Mail.Clients.Mail_Message_Access;
   end record;

   type UIMailBody is new UIMailComponent with null record;
   type UIMailSubject is new UIMailComponent with null record;

end AWA.Mail.Components.Messages;

-----------------------------------------------------------------------
--  awa-mail-components-recipients -- Mail UI Recipients
--  Copyright (C) 2012, 2020 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 ASF.Contexts.Faces;

--  === Mail Messages ===
--  The `AWA.Mail.Components.Messages` package defines the UI components
--  to represent the email message with its recipients, subject and body.
--
--  The mail message is retrieved by looking at the parent UI component until a
--  `UIMailMessage` component is found.  The mail message recipients are initialized
--  during the render response JSF phase, that is when `Encode_End` are called.
--
--  The `<mail:body>` component holds the message body.  This component can
--  include a facelet labeled `alternative` in which case it will be used
--  to build the `text/plain` mail message.  The default content type for
--  `<mail:body>` is `text/html` but this can be changed by using the
--  `type` attribute.
--
--    <mail:body type='text/html'>
--       <facet name='alternative'>
--          The text/plain mail message.
--       </facet>
--       The text/html mail message.
--    </mail:body>
package AWA.Mail.Components.Messages is

   ALTERNATIVE_NAME : constant String := "alternative";

   --  ------------------------------
   --  The mail recipient
   --  ------------------------------
   type UIMailMessage is new UIMailComponent with private;
   type UIMailMessage_Access is access all UIMailMessage'Class;

   --  Set the mail message instance.
   procedure Set_Message (UI      : in out UIMailMessage;
                          Message : in AWA.Mail.Clients.Mail_Message_Access);

   --  Get the mail message instance.
   overriding
   function Get_Message (UI      : in UIMailMessage) return AWA.Mail.Clients.Mail_Message_Access;

   --  Send the mail.
   overriding
   procedure Encode_End (UI      : in UIMailMessage;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  Finalize and release the mail message.
   overriding
   procedure Finalize (UI : in out UIMailMessage);

   --  ------------------------------
   --  The mail subject
   --  ------------------------------
   type UIMailSubject is new UIMailComponent with private;

   --  Render the mail subject and initializes the message with its content.
   overriding
   procedure Encode_Children (UI      : in UIMailSubject;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class);

   --  ------------------------------
   --  The mail body
   --  ------------------------------
   type UIMailBody is new UIMailComponent with private;

   --  Render the mail body and initializes the message with its content.
   overriding
   procedure Encode_Children (UI      : in UIMailBody;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class);

private

   type UIMailMessage is new UIMailComponent with record
      Message : AWA.Mail.Clients.Mail_Message_Access;
   end record;

   type UIMailBody is new UIMailComponent with null record;
   type UIMailSubject is new UIMailComponent with null record;

end AWA.Mail.Components.Messages;

Declare ALTERNATIVE_NAME and update documentation


-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  Copyright (C) 2013 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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  Copyright (C) 2013 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 Security.OAuth.Clients;
private package Security.Auth.OAuth is

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.
   type Manager is abstract new Security.Auth.Manager with private;

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   overriding
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the OAuth access token and retrieve information about the user.
   procedure Verify_Access_Token (Realm   : in Manager;
                                  Assoc   : in Association;
                                  Request : in Parameters'Class;
                                  Token   : in Security.OAuth.Clients.Access_Token_Access;
                                  Result  : in out Authentication) is abstract;

private

   type Manager is abstract new Security.Auth.Manager with record
      Return_To : Unbounded_String;
      Realm     : Unbounded_String;
      Scope     : Unbounded_String;
      App       : Security.OAuth.Clients.Application;
   end record;

end Security.Auth.OAuth;

Add some comment

Add some comment


-----------------------------------------------------------------------
--  ADO Databases -- Database Connections
--  Copyright (C) 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 Util.Log;
with Util.Log.Loggers;

with ADO.SQL;
with Ada.Unchecked_Deallocation;
with System.Address_Image;
package body ADO.Databases is

   use Util.Log;
   use ADO.Drivers;

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

   --  ------------------------------
   --  Get the database connection status.
   --  ------------------------------
   function Get_Status (Database : in Connection) return Connection_Status is
   begin
      if Database.Impl = null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      declare
         Query : Query_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create_Statement (Query);
      end;
   end Create_Statement;

   --  Create a query statement.  The statement is not prepared
   function Create_Statement (Database : in Connection;
                              Query    : in String)
                              return Query_Statement is
   begin
      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      declare
         Stmt : Query_Statement_Access := Database.Impl.all.Create_Statement (null);
      begin
         Append (Query => Stmt.all, SQL => Query);
         return ADO.Statements.Create_Statement (Stmt);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      if Database.Impl = null then
         Log.Error ("Database connection is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Load_Schema (Schema);
   end Load_Schema;

   --  ------------------------------
   --  Close the database connection
   --  ------------------------------
   procedure Close (Database : in out Connection) is
   begin
      Log.Info ("Closing database connection");

      if Database.Impl /= null then
         Database.Impl.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Connection) is
   begin
      Log.Info ("Begin transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Connection) is
   begin
      Log.Info ("Commit transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Connection) is
   begin
      Log.Info ("Rollback transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "Database implementation is not initialized";
      end if;
      Database.Impl.Rollback;
   end Rollback;

   procedure Execute (Database : in Master_Connection;
                      SQL      : in Query_String) is
   begin
      Log.Info ("Execute: {0}", SQL);

      Database.Impl.Execute (SQL);
   end Execute;

   procedure Execute (Database : in Master_Connection;
                      SQL      : in Query_String;
                      Id       : out Identifier) is
   begin
      Log.Info ("Execute: {0}", SQL);

      Database.Impl.Execute (SQL, Id);
   end Execute;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Log.Info ("Create delete statement");

      declare
         Stmt : Delete_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return Create_Statement (Stmt);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Log.Info ("Create insert statement");

      declare
         Stmt : constant Insert_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return Create_Statement (Stmt.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Log.Info ("Create insert statement");

      return Create_Statement (Database.Impl.all.Create_Statement (Table));
   end Create_Statement;

   --  ------------------------------
   --  Adjust the connection reference counter
   --  ------------------------------
   overriding
   procedure Adjust   (Object : in out Connection) is
   begin
      if Object.Impl /= null then
         Log.Debug ("Adjust {0} : {1}", System.Address_Image (Object.Impl.all'Address),
                    Natural'Image (Object.Impl.Count));
         Object.Impl.Count := Object.Impl.Count + 1;
      end if;
   end Adjust;

   --  ------------------------------
   --  Releases the connection reference counter
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Connection) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Database_Connection'Class,
                                    Name   => Database_Connection_Access);

   begin
      if Object.Impl /= null then
         Log.Debug ("Finalize {0} : {1}", System.Address_Image (Object.Impl.all'Address),
                    Natural'Image (Object.Impl.Count));
         Object.Impl.Count := Object.Impl.Count - 1;
         if Object.Impl.Count = 0 then
            Free (Object.Impl);
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Attempts to establish a connection with the data source
   --  that this DataSource object represents.
   --  ------------------------------
   function Get_Connection (Controller : in DataSource)
                           return Master_Connection'Class is
      Connection : ADO.Drivers.Database_Connection_Access;
   begin
      Log.Info ("Get master connection from data-source");

      Controller.Create_Connection (Connection);
      return Master_Connection '(Ada.Finalization.Controlled with
                                 Impl => Connection);
   end Get_Connection;

   --  ------------------------------
   --  Set the master data source
   --  ------------------------------
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in DataSource_Access) is
   begin
      Controller.Master := Master;
   end Set_Master;

   --  ------------------------------
   --  Get the master data source
   --  ------------------------------
   function Get_Master (Controller : in Replicated_DataSource)
                       return DataSource_Access is
   begin
      return Controller.Master;
   end Get_Master;

   --  ------------------------------
   --  Set the slave data source
   --  ------------------------------
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in DataSource_Access) is
   begin
      Controller.Slave := Slave;
   end Set_Slave;

   --  ------------------------------
   --  Get the slave data source
   --  ------------------------------
   function Get_Slave (Controller : in Replicated_DataSource)
                      return DataSource_Access is
   begin
      return Controller.Slave;
   end Get_Slave;

   --  ------------------------------
   --  Get a slave database connection
   --  ------------------------------
   function Get_Slave_Connection (Controller : in Replicated_DataSource)
                                 return Connection'Class is
   begin
      return Controller.Slave.Get_Connection;
   end Get_Slave_Connection;

end ADO.Databases;

-----------------------------------------------------------------------
--  ADO Databases -- Database Connections
--  Copyright (C) 2010, 2011 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.Log;
with Util.Log.Loggers;

with Ada.Unchecked_Deallocation;
with System.Address_Image;
with ADO.Statements.Create;
package body ADO.Databases is

   use Util.Log;
   use ADO.Drivers;

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

   --  ------------------------------
   --  Get the database connection status.
   --  ------------------------------
   function Get_Status (Database : in Connection) return Connection_Status is
   begin
      if Database.Impl = null then
         return CLOSED;
      else
         return OPEN;
      end if;
   end Get_Status;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement is
   begin
      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      declare
         Query : constant Query_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Query);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create a query statement.  The statement is not prepared
   --  ------------------------------
   function Create_Statement (Database : in Connection;
                              Query    : in String)
                              return Query_Statement is
   begin
      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      declare
         Stmt : constant Query_Statement_Access := Database.Impl.all.Create_Statement (null);
      begin
         Append (Query => Stmt.all, SQL => Query);
         return ADO.Statements.Create.Create_Statement (Stmt);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Load the database schema definition for the current database.
   --  ------------------------------
   procedure Load_Schema (Database : in Connection;
                          Schema   : out ADO.Schemas.Schema_Definition) is
   begin
      if Database.Impl = null then
         Log.Error ("Database connection is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Load_Schema (Schema);
   end Load_Schema;

   --  ------------------------------
   --  Close the database connection
   --  ------------------------------
   procedure Close (Database : in out Connection) is
   begin
      Log.Info ("Closing database connection");

      if Database.Impl /= null then
         Database.Impl.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Start a transaction.
   --  ------------------------------
   procedure Begin_Transaction (Database : in out Master_Connection) is
   begin
      Log.Info ("Begin transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Begin_Transaction;
   end Begin_Transaction;

   --  ------------------------------
   --  Commit the current transaction.
   --  ------------------------------
   procedure Commit (Database : in out Master_Connection) is
   begin
      Log.Info ("Commit transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "No connection to the database";
      end if;
      Database.Impl.Commit;
   end Commit;

   --  ------------------------------
   --  Rollback the current transaction.
   --  ------------------------------
   procedure Rollback (Database : in out Master_Connection) is
   begin
      Log.Info ("Rollback transaction");

      if Database.Impl = null then
         Log.Error ("Database implementation is not initialized");
         raise NOT_OPEN with "Database implementation is not initialized";
      end if;
      Database.Impl.Rollback;
   end Rollback;

   procedure Execute (Database : in Master_Connection;
                      SQL      : in Query_String) is
   begin
      Log.Info ("Execute: {0}", SQL);

      Database.Impl.Execute (SQL);
   end Execute;

   procedure Execute (Database : in Master_Connection;
                      SQL      : in Query_String;
                      Id       : out Identifier) is
   begin
      Log.Info ("Execute: {0}", SQL);

      Database.Impl.Execute (SQL, Id);
   end Execute;

   --  ------------------------------
   --  Create a delete statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement is
   begin
      Log.Info ("Create delete statement");

      declare
         Stmt : constant Delete_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an insert statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement is
   begin
      Log.Info ("Create insert statement");

      declare
         Stmt : constant Insert_Statement_Access := Database.Impl.all.Create_Statement (Table);
      begin
         return ADO.Statements.Create.Create_Statement (Stmt.all'Access);
      end;
   end Create_Statement;

   --  ------------------------------
   --  Create an update statement.
   --  ------------------------------
   function Create_Statement (Database : in Master_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement is
   begin
      Log.Info ("Create update statement");

      return ADO.Statements.Create.Create_Statement (Database.Impl.all.Create_Statement (Table));
   end Create_Statement;

   --  ------------------------------
   --  Adjust the connection reference counter
   --  ------------------------------
   overriding
   procedure Adjust   (Object : in out Connection) is
   begin
      if Object.Impl /= null then
         Log.Debug ("Adjust {0} : {1}", System.Address_Image (Object.Impl.all'Address),
                    Natural'Image (Object.Impl.Count));
         Object.Impl.Count := Object.Impl.Count + 1;
      end if;
   end Adjust;

   --  ------------------------------
   --  Releases the connection reference counter
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Connection) is

      procedure Free is new
        Ada.Unchecked_Deallocation (Object => Database_Connection'Class,
                                    Name   => Database_Connection_Access);

   begin
      if Object.Impl /= null then
         Log.Debug ("Finalize {0} : {1}", System.Address_Image (Object.Impl.all'Address),
                    Natural'Image (Object.Impl.Count));
         Object.Impl.Count := Object.Impl.Count - 1;
         if Object.Impl.Count = 0 then
            Free (Object.Impl);
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Attempts to establish a connection with the data source
   --  that this DataSource object represents.
   --  ------------------------------
   function Get_Connection (Controller : in DataSource)
                           return Master_Connection'Class is
      Connection : ADO.Drivers.Database_Connection_Access;
   begin
      Log.Info ("Get master connection from data-source");

      Controller.Create_Connection (Connection);
      return Master_Connection '(Ada.Finalization.Controlled with
                                 Impl => Connection);
   end Get_Connection;

   --  ------------------------------
   --  Set the master data source
   --  ------------------------------
   procedure Set_Master (Controller : in out Replicated_DataSource;
                         Master     : in DataSource_Access) is
   begin
      Controller.Master := Master;
   end Set_Master;

   --  ------------------------------
   --  Get the master data source
   --  ------------------------------
   function Get_Master (Controller : in Replicated_DataSource)
                       return DataSource_Access is
   begin
      return Controller.Master;
   end Get_Master;

   --  ------------------------------
   --  Set the slave data source
   --  ------------------------------
   procedure Set_Slave (Controller : in out Replicated_DataSource;
                        Slave      : in DataSource_Access) is
   begin
      Controller.Slave := Slave;
   end Set_Slave;

   --  ------------------------------
   --  Get the slave data source
   --  ------------------------------
   function Get_Slave (Controller : in Replicated_DataSource)
                      return DataSource_Access is
   begin
      return Controller.Slave;
   end Get_Slave;

   --  ------------------------------
   --  Get a slave database connection
   --  ------------------------------
   function Get_Slave_Connection (Controller : in Replicated_DataSource)
                                 return Connection'Class is
   begin
      return Controller.Slave.Get_Connection;
   end Get_Slave_Connection;

end ADO.Databases;

Use the Create_Statement functions now defined in ADO.Statements.Create package


-----------------------------------------------------------------------
--  util-streams-sockets-tests -- Unit tests for socket streams
--  Copyright (C) 2012 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.Strings.Unbounded;
with Ada.IO_Exceptions;

with Util.Test_Caller;

with Util.Streams.Texts;
with Util.Tests.Servers;
package body Util.Streams.Sockets.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Streams.Sockets");

   type Test_Server is new Util.Tests.Servers.Server with record
      Count : Natural := 0;
   end record;

   --  Process the line received by the server.
   overriding
   procedure Process_Line (Into : in out Test_Server;
                           Line : in Ada.Strings.Unbounded.Unbounded_String);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Initialize,Connect",
                       Test_Socket_Init'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Connect,Read,Write",
                       Test_Socket_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Process the line received by the server.
   --  ------------------------------
   overriding
   procedure Process_Line (Into : in out Test_Server;
                           Line : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      if Ada.Strings.Unbounded.Index (Line, "test-" & Natural'Image (Into.Count + 1)) > 0 then
         Into.Count := Into.Count + 1;
      end if;
   end Process_Line;

   --  ------------------------------
   --  Test reading and writing on a socket stream.
   --  ------------------------------
   procedure Test_Socket_Read (T : in out Test) is
      Stream : aliased Sockets.Socket_Stream;
      Writer : Util.Streams.Texts.Print_Stream;
      Server : Test_Server;
      Addr   : GNAT.Sockets.Sock_Addr_Type;
   begin
      Server.Start;
      T.Assert (Server.Get_Port > 0, "The server was not started");

      Addr := (GNAT.Sockets.Family_Inet,
               GNAT.Sockets.Addresses (GNAT.Sockets.Get_Host_By_Name (GNAT.Sockets.Host_Name), 1),
               GNAT.Sockets.Port_Type (Server.Get_Port));

      --  Let the server start.
      delay 0.1;

      --  Get a connection and write 10 lines.
      Stream.Connect (Server => Addr);
      Writer.Initialize (Output => Stream'Unchecked_Access,
                         Input  => null,
                         Size   => 1024);
      for I in 1 .. 10 loop
         Writer.Write ("Sending a line on the socket test-"
                       & Natural'Image (I) & ASCII.CR & ASCII.LF);
         Writer.Flush;
      end loop;
      Writer.Close;

      --  Stop the server and verify that 10 lines were received.
      Server.Stop;
      Util.Tests.Assert_Equals (T, 10, Server.Count, "Invalid number of lines received");
   end Test_Socket_Read;

   --  ------------------------------
   --  Test socket initialization.
   --  ------------------------------
   procedure Test_Socket_Init (T : in out Test) is
      Stream : aliased Sockets.Socket_Stream;
      Fd     : GNAT.Sockets.Socket_Type;
      Addr   : GNAT.Sockets.Sock_Addr_Type;
   begin
      Addr := (GNAT.Sockets.Family_Inet,
               GNAT.Sockets.Addresses (GNAT.Sockets.Get_Host_By_Name (GNAT.Sockets.Host_Name), 1),
               80);

      GNAT.Sockets.Create_Socket (Fd);
      Stream.Open (Fd);
      begin
         Stream.Connect (Addr);
         T.Assert (False, "No exception was raised");

      exception
         when Ada.IO_Exceptions.Use_Error =>
            null;
      end;
   end Test_Socket_Init;

end Util.Streams.Sockets.Tests;

-----------------------------------------------------------------------
--  util-streams-sockets-tests -- Unit tests for socket streams
--  Copyright (C) 2012 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.Strings.Unbounded;
with Ada.IO_Exceptions;

with Util.Test_Caller;

with Util.Streams.Texts;
with Util.Tests.Servers;
package body Util.Streams.Sockets.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Streams.Sockets");

   type Test_Server is new Util.Tests.Servers.Server with record
      Count : Natural := 0;
   end record;

   --  Process the line received by the server.
   overriding
   procedure Process_Line (Into   : in out Test_Server;
                           Line   : in Ada.Strings.Unbounded.Unbounded_String;
                           Stream : in out Util.Streams.Texts.Reader_Stream'Class);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Initialize,Connect",
                       Test_Socket_Init'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Connect,Read,Write",
                       Test_Socket_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Process the line received by the server.
   --  ------------------------------
   overriding
   procedure Process_Line (Into   : in out Test_Server;
                           Line   : in Ada.Strings.Unbounded.Unbounded_String;
                           Stream : in out Util.Streams.Texts.Reader_Stream'Class) is
      pragma Unreferenced (Stream);
   begin
      if Ada.Strings.Unbounded.Index (Line, "test-" & Natural'Image (Into.Count + 1)) > 0 then
         Into.Count := Into.Count + 1;
      end if;
   end Process_Line;

   --  ------------------------------
   --  Test reading and writing on a socket stream.
   --  ------------------------------
   procedure Test_Socket_Read (T : in out Test) is
      Stream : aliased Sockets.Socket_Stream;
      Writer : Util.Streams.Texts.Print_Stream;
      Server : Test_Server;
      Addr   : GNAT.Sockets.Sock_Addr_Type;
   begin
      Server.Start;
      T.Assert (Server.Get_Port > 0, "The server was not started");

      Addr := (GNAT.Sockets.Family_Inet,
               GNAT.Sockets.Addresses (GNAT.Sockets.Get_Host_By_Name (GNAT.Sockets.Host_Name), 1),
               GNAT.Sockets.Port_Type (Server.Get_Port));

      --  Let the server start.
      delay 0.1;

      --  Get a connection and write 10 lines.
      Stream.Connect (Server => Addr);
      Writer.Initialize (Output => Stream'Unchecked_Access,
                         Input  => null,
                         Size   => 1024);
      for I in 1 .. 10 loop
         Writer.Write ("Sending a line on the socket test-"
                       & Natural'Image (I) & ASCII.CR & ASCII.LF);
         Writer.Flush;
      end loop;
      Writer.Close;

      --  Stop the server and verify that 10 lines were received.
      Server.Stop;
      Util.Tests.Assert_Equals (T, 10, Server.Count, "Invalid number of lines received");
   end Test_Socket_Read;

   --  ------------------------------
   --  Test socket initialization.
   --  ------------------------------
   procedure Test_Socket_Init (T : in out Test) is
      Stream : aliased Sockets.Socket_Stream;
      Fd     : GNAT.Sockets.Socket_Type;
      Addr   : GNAT.Sockets.Sock_Addr_Type;
   begin
      Addr := (GNAT.Sockets.Family_Inet,
               GNAT.Sockets.Addresses (GNAT.Sockets.Get_Host_By_Name (GNAT.Sockets.Host_Name), 1),
               80);

      GNAT.Sockets.Create_Socket (Fd);
      Stream.Open (Fd);
      begin
         Stream.Connect (Addr);
         T.Assert (False, "No exception was raised");

      exception
         when Ada.IO_Exceptions.Use_Error =>
            null;
      end;
   end Test_Socket_Init;

end Util.Streams.Sockets.Tests;

Update the unit test

Update the unit test


-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 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 ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
with AWA.Events;
package AWA.Workspaces.Modules is

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   package Invite_User_Event is new AWA.Events.Definition (Name => "invite-user");

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

   --  Initialize the workspaces module.
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Load the invitation from the access key and verify that the key is still valid.
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

   --  Accept the invitation identified by the access key.
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String);

   --  Send the invitation to the user.
   procedure Send_Invitation (Module : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;
   end record;

end AWA.Workspaces.Modules;

-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 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 ADO.Sessions;

with ASF.Applications;

with AWA.Modules;
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Users.Services;
with AWA.Users.Models;
with AWA.Events;
package AWA.Workspaces.Modules is

   Not_Found : exception;

   --  The name under which the module is registered.
   NAME : constant String := "workspaces";

   package Invite_User_Event is new AWA.Events.Definition (Name => "invite-user");

   --  ------------------------------
   --  Module workspaces
   --  ------------------------------
   type Workspace_Module is new AWA.Modules.Module with private;
   type Workspace_Module_Access is access all Workspace_Module'Class;

   --  Initialize the workspaces module.
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref);

   --  Load the invitation from the access key and verify that the key is still valid.
   procedure Load_Invitation (Module     : in Workspace_Module;
                              Key        : in String;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class;
                              Inviter    : in out AWA.Users.Models.User_Ref);

   --  Accept the invitation identified by the access key.
   procedure Accept_Invitation (Module     : in Workspace_Module;
                                Key        : in String);

   --  Send the invitation to the user.
   procedure Send_Invitation (Module : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class);

private

   type Workspace_Module is new AWA.Modules.Module with record
      User_Manager : AWA.Users.Services.User_Service_Access;
   end record;

end AWA.Workspaces.Modules;

Add the Inviter parameter to the Load_Invitation procedure


-----------------------------------------------------------------------
--  xrds -- XRDS parser example
--  Copyright (C) 2010, 2011 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.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Containers;
with Ada.Containers.Vectors;

with Util.Log.Loggers;
with Util.Beans;
with Util.Beans.Objects;
with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;
with Util.Serialize.IO.XML;
procedure Xmlrd is

   use Ada.Containers;
   use Util.Streams.Buffered;
   use Ada.Strings.Unbounded;

   Reader : Util.Serialize.IO.XML.Parser;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   type Service_Fields is (FIELD_PRIORITY, FIELD_TYPE, FIELD_URI, FIELD_LOCAL_ID, FIELD_DELEGATE);

   type Service is record
      Priority : Integer;
      URI      : Ada.Strings.Unbounded.Unbounded_String;
      RDS_Type : Ada.Strings.Unbounded.Unbounded_String;
      Delegate : Ada.Strings.Unbounded.Unbounded_String;
      Local_Id : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Service_Access is access all Service;

   package Service_Vector is
     new Ada.Containers.Vectors (Element_Type => Service,
                                 Index_Type   => Natural);

   procedure Print (P : in Service_Vector.Cursor);
   procedure Print (P : in Service);
   procedure Set_Member (P     : in out Service;
                         Field : in Service_Fields;
                         Value : in Util.Beans.Objects.Object);
   function Get_Member (P     : in Service;
                        Field : in Service_Fields) return Util.Beans.Objects.Object;

   procedure Set_Member (P     : in out Service;
                         Field : in Service_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Ada.Text_IO.Put_Line ("Set member " & Service_Fields'Image (Field)
                            & " to " & Util.Beans.Objects.To_String (Value));
      case Field is
         when FIELD_PRIORITY =>
            P.Priority := Util.Beans.Objects.To_Integer (Value);

         when FIELD_TYPE =>
            P.RDS_Type := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_URI =>
            P.URI := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LOCAL_ID =>
            P.Local_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_DELEGATE =>
            P.Delegate := Util.Beans.Objects.To_Unbounded_String (Value);

      end case;
   end Set_Member;

   function Get_Member (P : in Service;
                        Field : in Service_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_PRIORITY =>
            return Util.Beans.Objects.To_Object (P.Priority);

         when FIELD_TYPE =>
            return Util.Beans.Objects.To_Object (P.RDS_Type);

         when FIELD_URI =>
            return Util.Beans.Objects.To_Object (P.URI);

         when FIELD_LOCAL_ID =>
            return Util.Beans.Objects.To_Object (P.Local_Id);

         when FIELD_DELEGATE =>
            return Util.Beans.Objects.To_Object (P.Delegate);

      end case;
   end Get_Member;

   package Service_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Service,
                                               Element_Type_Access => Service_Access,
                                               Fields              => Service_Fields,
                                               Set_Member          => Set_Member);

   package Service_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Service_Vector,
                                               Element_Mapper => Service_Mapper);

   procedure Print (P : in Service) is
   begin
      Ada.Text_IO.Put_Line ("        URI: " & To_String (P.URI));
      Ada.Text_IO.Put_Line ("   Priority: " & Integer'Image (P.Priority));
      Ada.Text_IO.Put_Line ("Type (last): " & To_String (P.RDS_Type));
      Ada.Text_IO.Put_Line ("   Delegate: " & To_String (P.Delegate));
      Ada.Text_IO.New_Line;
   end Print;

   procedure Print (P : in Service_Vector.Cursor) is
   begin
      Print (Service_Vector.Element (P));
   end Print;

   Service_Mapping        : aliased Service_Mapper.Mapper;
   Service_Vector_Mapping : aliased Service_Vector_Mapper.Mapper;
   Mapper                 : Util.Serialize.Mappers.Processing;
begin
   Util.Log.Loggers.Initialize ("samples/log4j.properties");

   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: xmlrd file...");
      return;
   end if;

   Service_Mapping.Add_Mapping ("Type", FIELD_TYPE);
   Service_Mapping.Add_Mapping ("URI", FIELD_URI);
   Service_Mapping.Add_Mapping ("Delegate", FIELD_DELEGATE);
   Service_Mapping.Add_Mapping ("@priority", FIELD_PRIORITY);
   Service_Mapping.Bind (Get_Member'Access);
   Service_Vector_Mapping.Set_Mapping (Service_Mapping'Unchecked_Access);

   Mapper.Add_Mapping ("XRDS/XRD/Service", Service_Vector_Mapping'Unchecked_Access);

   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);

         List : aliased Service_Vector_Mapper.Vector;
      begin
         Service_Vector_Mapper.Set_Context (Mapper, List'Unchecked_Access);
         Reader.Parse (S, Mapper);

         Ada.Text_IO.Put_Line ("Rule count: " & Count_Type'Image (List.Length));

         --  The list now contains our elements.
         List.Iterate (Process => Print'Access);

         declare

            Output : Util.Serialize.IO.XML.Output_Stream;
         begin
            Output.Initialize (Size => 10000);
            Output.Start_Entity ("XRDS");
            Service_Vector_Mapping.Write (Output, List);
            Output.End_Entity ("XRDS");
            Ada.Text_IO.Put_Line (Util.Streams.Texts.To_String (Buffered_Stream (Output)));
         end;
      end;
   end loop;
end Xmlrd;

-----------------------------------------------------------------------
--  xrds -- XRDS parser example
--  Copyright (C) 2010, 2011 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.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Command_Line;
with Ada.Containers;
with Ada.Containers.Vectors;

with Util.Log.Loggers;
with Util.Beans;
with Util.Beans.Objects;
with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.Mappers.Vector_Mapper;
with Util.Serialize.IO.XML;
procedure Xmlrd is

   use Ada.Containers;
   use Util.Streams.Buffered;
   use Ada.Strings.Unbounded;

   Reader : Util.Serialize.IO.XML.Parser;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   type Service_Fields is (FIELD_PRIORITY, FIELD_TYPE, FIELD_URI, FIELD_LOCAL_ID, FIELD_DELEGATE);

   type Service is record
      Priority : Integer;
      URI      : Ada.Strings.Unbounded.Unbounded_String;
      RDS_Type : Ada.Strings.Unbounded.Unbounded_String;
      Delegate : Ada.Strings.Unbounded.Unbounded_String;
      Local_Id : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Service_Access is access all Service;

   package Service_Vector is
     new Ada.Containers.Vectors (Element_Type => Service,
                                 Index_Type   => Natural);

   procedure Print (P : in Service_Vector.Cursor);
   procedure Print (P : in Service);
   procedure Set_Member (P     : in out Service;
                         Field : in Service_Fields;
                         Value : in Util.Beans.Objects.Object);
   function Get_Member (P     : in Service;
                        Field : in Service_Fields) return Util.Beans.Objects.Object;

   procedure Set_Member (P     : in out Service;
                         Field : in Service_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      Ada.Text_IO.Put_Line ("Set member " & Service_Fields'Image (Field)
                            & " to " & Util.Beans.Objects.To_String (Value));
      case Field is
         when FIELD_PRIORITY =>
            P.Priority := Util.Beans.Objects.To_Integer (Value);

         when FIELD_TYPE =>
            P.RDS_Type := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_URI =>
            P.URI := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_LOCAL_ID =>
            P.Local_Id := Util.Beans.Objects.To_Unbounded_String (Value);

         when FIELD_DELEGATE =>
            P.Delegate := Util.Beans.Objects.To_Unbounded_String (Value);

      end case;
   end Set_Member;

   function Get_Member (P : in Service;
                        Field : in Service_Fields) return Util.Beans.Objects.Object is
   begin
      case Field is
         when FIELD_PRIORITY =>
            return Util.Beans.Objects.To_Object (P.Priority);

         when FIELD_TYPE =>
            return Util.Beans.Objects.To_Object (P.RDS_Type);

         when FIELD_URI =>
            return Util.Beans.Objects.To_Object (P.URI);

         when FIELD_LOCAL_ID =>
            return Util.Beans.Objects.To_Object (P.Local_Id);

         when FIELD_DELEGATE =>
            return Util.Beans.Objects.To_Object (P.Delegate);

      end case;
   end Get_Member;

   package Service_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Service,
                                               Element_Type_Access => Service_Access,
                                               Fields              => Service_Fields,
                                               Set_Member          => Set_Member);

   package Service_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Service_Vector,
                                               Element_Mapper => Service_Mapper);

   procedure Print (P : in Service) is
   begin
      Ada.Text_IO.Put_Line ("        URI: " & To_String (P.URI));
      Ada.Text_IO.Put_Line ("   Priority: " & Integer'Image (P.Priority));
      Ada.Text_IO.Put_Line ("Type (last): " & To_String (P.RDS_Type));
      Ada.Text_IO.Put_Line ("   Delegate: " & To_String (P.Delegate));
      Ada.Text_IO.New_Line;
   end Print;

   procedure Print (P : in Service_Vector.Cursor) is
   begin
      Print (Service_Vector.Element (P));
   end Print;

   Service_Mapping        : aliased Service_Mapper.Mapper;
   Service_Vector_Mapping : aliased Service_Vector_Mapper.Mapper;
   Mapper                 : Util.Serialize.Mappers.Processing;
begin
   Util.Log.Loggers.Initialize ("samples/log4j.properties");

   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: xmlrd file...");
      return;
   end if;

   Service_Mapping.Add_Mapping ("Type", FIELD_TYPE);
   Service_Mapping.Add_Mapping ("URI", FIELD_URI);
   Service_Mapping.Add_Mapping ("Delegate", FIELD_DELEGATE);
   Service_Mapping.Add_Mapping ("@priority", FIELD_PRIORITY);
   Service_Mapping.Bind (Get_Member'Access);
   Service_Vector_Mapping.Set_Mapping (Service_Mapping'Unchecked_Access);

   Mapper.Add_Mapping ("XRDS/XRD/Service", Service_Vector_Mapping'Unchecked_Access);

   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);

         List : aliased Service_Vector_Mapper.Vector;
      begin
         Service_Vector_Mapper.Set_Context (Mapper, List'Unchecked_Access);
         Reader.Parse (S, Mapper);

         Ada.Text_IO.Put_Line ("Rule count: " & Count_Type'Image (List.Length));

         --  The list now contains our elements.
         List.Iterate (Process => Print'Access);

         declare
            Buffer : aliased Util.Streams.Texts.Print_Stream;
            Output : Util.Serialize.IO.XML.Output_Stream;
         begin
            Buffer.Initialize (Size => 10000);
            Output.Initialize (Output => Buffer'Unchecked_access);
            Output.Start_Entity ("XRDS");
            Service_Vector_Mapping.Write (Output, List);
            Output.End_Entity ("XRDS");
            Ada.Text_IO.Put_Line (Util.Streams.Texts.To_String (Buffer));
         end;
      end;
   end loop;
end Xmlrd;

Update the example

Update the example


-----------------------------------------------------------------------
--  gen-model -- Model for Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 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.Strings.Fixed;
with Ada.Strings.Maps;
with DOM.Core.Nodes;
with Gen.Utils;
package body Gen.Model is

   Trim_Chars : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" " & ASCII.HT & ASCII.LF & ASCII.CR);

   --  ------------------------------
   --  Get the object unique name.
   --  ------------------------------
   function Get_Name (From : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (From.Name);
   end Get_Name;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "comment" then
         return From.Comment;

      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Row_Index);

      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Name);
      else
         return From.Attrs.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return String is
      V : constant Util.Beans.Objects.Object := From.Get_Value (Name);
   begin
      return Util.Beans.Objects.To_String (V);
   end Get_Attribute;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (From.Get_Attribute (Name));
   end Get_Attribute;

   --  ------------------------------
   --  Set the comment associated with the element.
   --  ------------------------------
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String) is
      Trimmed_Comment : constant String := Ada.Strings.Fixed.Trim (Comment, Trim_Chars, Trim_Chars);
   begin
      Def.Comment := Util.Beans.Objects.To_Object (Trimmed_Comment);
   end Set_Comment;

   --  ------------------------------
   --  Initialize the definition from the DOM node attributes.
   --  ------------------------------
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node) is
      use type DOM.Core.Node;

      Attrs : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Node);
   begin
      Def.Name := Name;
      Def.Comment := Util.Beans.Objects.To_Object (Gen.Utils.Get_Comment (Node));

      for I in 0 .. DOM.Core.Nodes.Length (Attrs) loop
         declare
            A : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attrs, I);
         begin
            if A /= null then
               declare
                  Name  : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Name (A);
                  Value : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Value (A);
               begin
                  Def.Attrs.Include (Name, Util.Beans.Objects.To_Object (Value));
               end;
            end if;
         end;
      end loop;
   end Initialize;

end Gen.Model;

-----------------------------------------------------------------------
--  gen-model -- Model for Code Generator
--  Copyright (C) 2009, 2010, 2011, 2012, 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.Strings.Fixed;
with Ada.Strings.Maps;
with DOM.Core.Nodes;
with Gen.Utils;
package body Gen.Model is

   Trim_Chars : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" " & ASCII.HT & ASCII.LF & ASCII.CR);

   --  ------------------------------
   --  Get the object unique name.
   --  ------------------------------
   function Get_Name (From : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (From.Def_Name);
   end Get_Name;

   function Name (From : in Definition) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return From.Def_Name;
   end Name;

   --  ------------------------------
   --  Set the object unique name.
   --  ------------------------------
   procedure Set_Name (Def  : in out Definition;
                       Name : in String) is
   begin
      Def.Def_Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
   end Set_Name;

   procedure Set_Name (Def  : in out Definition;
                       Name : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Def.Def_Name := Name;
   end Set_Name;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "comment" then
         return From.Comment;

      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Row_Index);

      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Def_Name);
      else
         return From.Attrs.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return String is
      V : constant Util.Beans.Objects.Object := From.Get_Value (Name);
   begin
      return Util.Beans.Objects.To_String (V);
   end Get_Attribute;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (From.Get_Attribute (Name));
   end Get_Attribute;

   --  ------------------------------
   --  Set the comment associated with the element.
   --  ------------------------------
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String) is
      Trimmed_Comment : constant String := Ada.Strings.Fixed.Trim (Comment, Trim_Chars, Trim_Chars);
   begin
      Def.Comment := Util.Beans.Objects.To_Object (Trimmed_Comment);
   end Set_Comment;

   --  ------------------------------
   --  Get the comment associated with the element.
   --  ------------------------------
   function Get_Comment (Def : in Definition) return Util.Beans.Objects.Object is
   begin
      return Def.Comment;
   end Get_Comment;

   --  ------------------------------
   --  Set the location (file and line) where the model element is defined in the XMI file.
   --  ------------------------------
   procedure Set_Location (Node     : in out Definition;
                           Location : in String) is
   begin
      Node.Location := Ada.Strings.Unbounded.To_Unbounded_String (Location);
   end Set_Location;

   --  ------------------------------
   --  Get the location file and line where the model element is defined.
   --  ------------------------------
   function Get_Location (Node : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Node.Location);
   end Get_Location;

   --  ------------------------------
   --  Initialize the definition from the DOM node attributes.
   --  ------------------------------
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node) is
      use type DOM.Core.Node;

      Attrs : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Node);
   begin
      Def.Def_Name := Name;
      Def.Comment := Util.Beans.Objects.To_Object (Gen.Utils.Get_Comment (Node));

      for I in 0 .. DOM.Core.Nodes.Length (Attrs) loop
         declare
            A : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attrs, I);
         begin
            if A /= null then
               declare
                  Name  : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Name (A);
                  Value : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Value (A);
               begin
                  Def.Attrs.Include (Name, Util.Beans.Objects.To_Object (Value));
               end;
            end if;
         end;
      end loop;
   end Initialize;

end Gen.Model;

Implement Name, Set_Name, Get_Location, Set_Location, Get_Comment operations


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  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.

generic
   type Element_Type is private;
   type Index_Type   is (<>);
package GL.Algebra is
   pragma Pure;

   -----------------------------------------------------------------------------
   --                              Vector types                               --
   -----------------------------------------------------------------------------

   type Vector2 is array (Index_2D) of aliased Element_Type;
   type Vector3 is array (Index_3D) of aliased Element_Type;
   type Vector4 is array (Index_Homogeneous) of aliased Element_Type;

   pragma Convention (C, Vector2);
   pragma Convention (C, Vector3);
   pragma Convention (C, Vector4);

   -----------------------------------------------------------------------------
   --                              Matrix types                               --
   -----------------------------------------------------------------------------

   type Matrix2 is array (Index_2D, Index_2D) of aliased Element_Type;
   type Matrix3 is array (Index_3D, Index_3D) of aliased Element_Type;
   type Matrix4 is array (Index_Homogeneous, Index_Homogeneous) of aliased Element_Type;

   pragma Convention (C, Matrix2);
   pragma Convention (C, Matrix3);
   pragma Convention (C, Matrix4);

   -----------------------------------------------------------------------------
   --                               Array types                               --
   -----------------------------------------------------------------------------

   type Vector2_Array is array (Index_Type range <>) of aliased Vector2;
   type Vector3_Array is array (Index_Type range <>) of aliased Vector3;
   type Vector4_Array is array (Index_Type range <>) of aliased Vector4;

   type Matrix2_Array is array (Index_Type range <>) of aliased Matrix2;
   type Matrix3_Array is array (Index_Type range <>) of aliased Matrix3;
   type Matrix4_Array is array (Index_Type range <>) of aliased Matrix4;

   pragma Convention (C, Vector2_Array);
   pragma Convention (C, Vector3_Array);
   pragma Convention (C, Vector4_Array);
   pragma Convention (C, Matrix2_Array);
   pragma Convention (C, Matrix3_Array);
   pragma Convention (C, Matrix4_Array);

end GL.Algebra;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  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.

generic
   type Element_Type is private;
   type Index_Type   is (<>);
package GL.Algebra is
   pragma Pure;

   -----------------------------------------------------------------------------
   --                              Vector types                               --
   -----------------------------------------------------------------------------

   type Vector2 is array (Index_2D) of aliased Element_Type;
   type Vector3 is array (Index_3D) of aliased Element_Type;
   type Vector4 is array (Index_Homogeneous) of aliased Element_Type;

   pragma Convention (C, Vector2);
   pragma Convention (C, Vector3);
   pragma Convention (C, Vector4);

   -----------------------------------------------------------------------------
   --                              Matrix types                               --
   -----------------------------------------------------------------------------

   type Matrix4 is array (Index_Homogeneous, Index_Homogeneous) of aliased Element_Type;

   pragma Convention (C, Matrix4);

   -----------------------------------------------------------------------------
   --                               Array types                               --
   -----------------------------------------------------------------------------

   type Vector2_Array is array (Index_Type range <>) of aliased Vector2;
   type Vector3_Array is array (Index_Type range <>) of aliased Vector3;
   type Vector4_Array is array (Index_Type range <>) of aliased Vector4;

   type Matrix4_Array is array (Index_Type range <>) of aliased Matrix4;

   pragma Convention (C, Vector2_Array);
   pragma Convention (C, Vector3_Array);
   pragma Convention (C, Vector4_Array);
   pragma Convention (C, Matrix4_Array);

end GL.Algebra;

gl: Remove unused matrix types in GL.Algebra

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>