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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
      Is_Hidden : Boolean;
   begin
      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 >= Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         begin
            Controller.Port := Natural'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

         exception
            when Constraint_Error =>
               Log.Error ("Invalid port in connection URI: {0}", URI);
               raise Connection_Error
                 with "Invalid port in connection URI: '" & URI & "'";
         end;
      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         Controller.Log_URI := To_Unbounded_String (URI (URI'First .. Pos));
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               Append (Controller.Log_URI, URI (Pos + 1 .. Pos2));
               Is_Hidden := URI (Pos + 1 .. Pos2 - 1) = "password";
               if Is_Hidden then
                  Append (Controller.Log_URI, "XXXXXXX");
               end if;
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  if not Is_Hidden then
                     Append (Controller.Log_URI, URI (Pos2 + 1 .. Next - 1));
                  end if;
                  Append (Controller.Log_URI, "&");
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                 if not Is_Hidden then
                     Append (Controller.Log_URI, URI (Pos2 + 1 .. URI'Last));
                  end if;
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Append (Controller.Log_URI, URI (Pos + 1 .. URI'Last));
               Pos := URI'Last;
            end if;
         end loop;
      else
         Controller.Log_URI := Controller.URI;
      end if;
      Log.Info ("Set connection URI: {0}", Controller.Log_URI);
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Set the server hostname.
   --  ------------------------------
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String) is
   begin
      Controller.Server := To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Set the server port.
   --  ------------------------------
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural) is
   begin
      Controller.Port := Port;
   end Set_Port;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Natural is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Set the database name.
   --  ------------------------------
   procedure Set_Database (Controller : in out Configuration;
                           Database   : in String) is
   begin
      Controller.Database := To_Unbounded_String (Database);
   end Set_Database;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Get the database driver name.
   --  ------------------------------
   function Get_Driver (Controller : in Configuration) return String is
   begin
      if Controller.Driver /= null then
         return Get_Driver_Name (Controller.Driver.all);
      else
         return "";
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.Log_URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      if Result.Is_Null then
         Log.Error ("Driver {0} failed to create connection {0}",
                    Config.Driver.Name.all, To_String (Config.Log_URI));
         raise Connection_Error with "Data source is not initialized: driver error";
      end if;
      Log.Info ("Created connection to '{0}' -> {1}", Config.Log_URI, Result.Value.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.Log_URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 2 loop
         if Retry = 1 then
            ADO.Drivers.Initialize;
         elsif Retry = 2 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
      Is_Hidden : Boolean;
   begin
      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 >= Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         begin
            Controller.Port := Natural'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

         exception
            when Constraint_Error =>
               Log.Error ("Invalid port in connection URI: {0}", URI);
               raise Connection_Error
                 with "Invalid port in connection URI: '" & URI & "'";
         end;
      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         Controller.Log_URI := To_Unbounded_String (URI (URI'First .. Pos));
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               Append (Controller.Log_URI, URI (Pos + 1 .. Pos2));
               Is_Hidden := URI (Pos + 1 .. Pos2 - 1) = "password";
               if Is_Hidden then
                  Append (Controller.Log_URI, "XXXXXXX");
               end if;
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  if not Is_Hidden then
                     Append (Controller.Log_URI, URI (Pos2 + 1 .. Next - 1));
                  end if;
                  Append (Controller.Log_URI, "&");
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                 if not Is_Hidden then
                     Append (Controller.Log_URI, URI (Pos2 + 1 .. URI'Last));
                  end if;
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Append (Controller.Log_URI, URI (Pos + 1 .. URI'Last));
               Pos := URI'Last;
            end if;
         end loop;
      else
         Controller.Log_URI := Controller.URI;
      end if;
      Log.Info ("Set connection URI: {0}", Controller.Log_URI);
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Set the server hostname.
   --  ------------------------------
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String) is
   begin
      Controller.Server := To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Set the server port.
   --  ------------------------------
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural) is
   begin
      Controller.Port := Port;
   end Set_Port;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Natural is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Set the database name.
   --  ------------------------------
   procedure Set_Database (Controller : in out Configuration;
                           Database   : in String) is
   begin
      Controller.Database := To_Unbounded_String (Database);
   end Set_Database;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Get the database driver name.
   --  ------------------------------
   function Get_Driver (Controller : in Configuration) return String is
   begin
      if Controller.Driver /= null then
         return Get_Driver_Name (Controller.Driver.all);
      else
         return "";
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.Log_URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      if Result.Is_Null then
         Log.Error ("Driver {0} failed to create connection {0}",
                    Config.Driver.Name.all, To_String (Config.Log_URI));
         raise Connection_Error with "Data source is not initialized: driver error";
      end if;
      Log.Info ("Created connection to '{0}' -> {1}", Config.Log_URI, Result.Value.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.Log_URI);
         raise;

   end Create_Connection;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Database_Connection) return Driver_Index is
      Driver : constant ADO.Drivers.Connections.Driver_Access
         := Database_Connection'Class (Database).Get_Driver;
   begin
      return Driver.Get_Driver_Index;
   end Get_Driver_Index;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 2 loop
         if Retry = 1 then
            ADO.Drivers.Initialize;
         elsif Retry = 2 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

Implement the Get_Driver_Index function

Implement the Get_Driver_Index function


-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016 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.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 >= Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         begin
            Controller.Port := Natural'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

         exception
            when Constraint_Error =>
               Log.Error ("Invalid port in connection URI: {0}", URI);
               raise Connection_Error
                 with "Invalid port in connection URI: '" & URI & "'";
         end;
      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Set the server hostname.
   --  ------------------------------
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String) is
   begin
      Controller.Server := To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Set the server port.
   --  ------------------------------
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural) is
   begin
      Controller.Port := Port;
   end Set_Port;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Natural is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016 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.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 >= Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         begin
            Controller.Port := Natural'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

         exception
            when Constraint_Error =>
               Log.Error ("Invalid port in connection URI: {0}", URI);
               raise Connection_Error
                 with "Invalid port in connection URI: '" & URI & "'";
         end;
      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Set the server hostname.
   --  ------------------------------
   procedure Set_Server (Controller : in out Configuration;
                         Server     : in String) is
   begin
      Controller.Server := To_Unbounded_String (Server);
   end Set_Server;

   --  ------------------------------
   --  Set the server port.
   --  ------------------------------
   procedure Set_Port (Controller : in out Configuration;
                       Port       : in Natural) is
   begin
      Controller.Port := Port;
   end Set_Port;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Natural is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Set the database name.
   --  ------------------------------
   procedure Set_Database (Controller : in out Configuration;
                           Database   : in String) is
   begin
      Controller.Database := To_Unbounded_String (Database);
   end Set_Database;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

Implement the Set_Database procedure

Implement the Set_Database procedure


-------------------------------------------------------------------------------
-- Copyright (c) 2016 Daniel King
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to
-- deal in the Software without restriction, including without limitation the
-- rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-- sell copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-- IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Interfaces;  use Interfaces;
with STM32.AFIO;
with STM32.EXTI;
with STM32.GPIO;
with STM32.NVIC;
with STM32.RCC;
with STM32.SPI;

package body DW1000.BSP
with SPARK_Mode => Off
is

   procedure Select_Device
   is
   begin
      STM32.GPIO.GPIOA_Periph.BSRR.BR :=
        STM32.GPIO.BSRR_BR_Field'(As_Array => True,
                                  Arr      => (4 => 1, others => 0));
   end Select_Device;

   procedure Deselect_Device
   is
   begin
      STM32.GPIO.GPIOA_Periph.BSRR.BS :=
        STM32.GPIO.BSRR_BS_Field'(As_Array => True,
                                  Arr      => (4 => 1, others => 0));
   end Deselect_Device;

   procedure Reset_DW1000
   is
   begin
      --  Configure RSTn GPIO as output
      STM32.GPIO.GPIOA_Periph.CRL.MODE0 := 2#11#; --  Output 50 MHz
      STM32.GPIO.GPIOA_Periph.CRL.CNF0  := 2#00#; --  Output push-pull

      --  Drive the RSTn line low
      STM32.GPIO.GPIOA_Periph.BSRR.BR :=
        STM32.GPIO.BSRR_BR_Field'(As_Array => True,
                                  Arr      => (1 => 1, others => 0));

      --  Put the RSTn line to hi-Z
      STM32.GPIO.GPIOA_Periph.CRL.MODE0 := 2#00#; --  Input
      STM32.GPIO.GPIOA_Periph.CRL.CNF0  := 2#01#; --  Floating input
   end Reset_DW1000;

   procedure Acknowledge_DW1000_IRQ
   is
   begin
      STM32.EXTI.EXTI_Periph.PR.PR.Arr (5) := 1;
   end Acknowledge_DW1000_IRQ;

   procedure Disable_DW1000_IRQ
   is
   begin
      --  Disable IRQ #25 (EXTI9_5_Interrupt)
      STM32.NVIC.NVIC_Periph.ICER0 := 16#0200_0000#;
   end Disable_DW1000_IRQ;

   procedure Enable_DW1000_IRQ
   is
   begin
      --  Enable IRQ #25 (EXTI9_5_Interrupt)
      STM32.NVIC.NVIC_Periph.ISER0 := 16#0200_0000#;
   end Enable_DW1000_IRQ;

   procedure Use_Slow_SPI_Clock
   is
   begin
      --  Use /32 prescaler (72 MHz / 32 = 2.25 MHz clock)
      STM32.SPI.SPI1_Periph.CR1.BR := 2#100#;
   end Use_Slow_SPI_Clock;

   procedure Use_Fast_SPI_Clock
   is
   begin
      --  Use /4 prescaler (72 MHz / 4 = 18 MHz clock)
      STM32.SPI.SPI1_Periph.CR1.BR := 2#001#;
   end Use_Fast_SPI_Clock;

   procedure Write_Transaction(Header : in DW1000.Types.Byte_Array;
                               Data   : in DW1000.Types.Byte_Array)
   is
      use type STM32.Bit;

   begin

      Select_Device;

      --  Send header
      for I in Header'Range loop
         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Header (I) );

         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;
      end loop;

      --  Send data
      for I in Data'Range loop
         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;

         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Data (I) );
      end loop;

      --  Wait for the last byte to finish transmitting.
      loop
         exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
      end loop;

      Deselect_Device;

   end Write_Transaction;

   procedure Read_Transaction(Header : in     DW1000.Types.Byte_Array;
                              Data   :    out DW1000.Types.Byte_Array)
   is
      use type STM32.Bit;

   begin
      Disable_DW1000_IRQ;

      Select_Device;

      --  Send header
      for I in Header'Range loop
         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Header (I));

         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;
      end loop;

      loop
         exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
      end loop;

      --  Read data
      for I in Data'Range loop
         -- Send a dummy byte to begin the transfer
         STM32.SPI.SPI1_Periph.DR.DR := 16#0000#;

         loop
            exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
         end loop;

         Data (I) := Unsigned_8 (STM32.SPI.SPI1_Periph.DR.DR and 16#FF#);
      end loop;

      Deselect_Device;

      Enable_DW1000_IRQ;

   end Read_Transaction;

begin
   --  Enable peripheral clocks
   STM32.RCC.RCC_Periph.APB2ENR.SPI1EN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.AFIOEN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.IOPAEN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.IOPBEN := 1;

   --  Configure GPIO
   STM32.GPIO.GPIOA_Periph.CRL.MODE4 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE5 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE6 := 2#00#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE7 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF4  := 2#00#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF5  := 2#10#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF6  := 2#10#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF7  := 2#10#;

   Deselect_Device;

   Reset_DW1000;

   --  Configure SPI
   STM32.SPI.SPI1_Periph.CR1 :=
     STM32.SPI.CR1_Register'(CPHA           => 0,
                             CPOL           => 0,
                             MSTR           => 1,
                             BR             => 2#100#, --  /32 prescaler
                             SPE            => 0,
                             LSBFIRST       => 0, --  MSB first
                             SSI            => 1,
                             SSM            => 1,
                             RXONLY         => 0, --  Full duplex
                             DFF            => 0, --  8-bit data
                             CRCNEXT        => 0,
                             CRCEN          => 0, --  No CRC
                             BIDIOE         => 0,
                             BIDIMODE       => 0, --  Bidirectional
                             Reserved_16_31 => 0);
   STM32.SPI.SPI1_Periph.CRCPR.CRCPOLY := 7;
   STM32.SPI.SPI1_Periph.CR1.SPE := 1;

   --  Configure IRQ
   STM32.GPIO.GPIOB_Periph.CRL.CNF5  := 2#10#;  --  Input with pull-up/down
   STM32.GPIO.GPIOB_Periph.CRL.MODE5 := 2#00#;  --  Input mode
   STM32.GPIO.GPIOB_Periph.BRR.BR.Arr (5) := 1; --  Pull-down

   STM32.AFIO.AFIO_Periph.EXTICR2.EXTI.Arr (5) := 2#0001#; --  GPIOB

   STM32.EXTI.EXTI_Periph.IMR.MR.Arr (5)  := 1; --  Enable interrupt
   STM32.EXTI.EXTI_Periph.EMR.MR.Arr (5)  := 0;
   STM32.EXTI.EXTI_Periph.RTSR.TR.Arr (5) := 1; --  Rising edge enabled
   STM32.EXTI.EXTI_Periph.FTSR.TR.Arr (5) := 0; --  Falling edge disabled

end DW1000.BSP;

-------------------------------------------------------------------------------
-- Copyright (c) 2016 Daniel King
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to
-- deal in the Software without restriction, including without limitation the
-- rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-- sell copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-- IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Interfaces;  use Interfaces;
with STM32.AFIO;
with STM32.EXTI;
with STM32.GPIO;
with STM32.NVIC;
with STM32.RCC;
with STM32.SPI;

package body DW1000.BSP
with SPARK_Mode => Off
is

   procedure Select_Device
   is
   begin
      STM32.GPIO.GPIOA_Periph.BSRR.BR :=
        STM32.GPIO.BSRR_BR_Field'(As_Array => True,
                                  Arr      => (4 => 1, others => 0));
   end Select_Device;

   procedure Deselect_Device
   is
   begin
      STM32.GPIO.GPIOA_Periph.BSRR.BS :=
        STM32.GPIO.BSRR_BS_Field'(As_Array => True,
                                  Arr      => (4 => 1, others => 0));
   end Deselect_Device;

   procedure Reset_DW1000
   is
   begin
      --  Configure RSTn GPIO as output
      STM32.GPIO.GPIOA_Periph.CRL.MODE0 := 2#11#; --  Output 50 MHz
      STM32.GPIO.GPIOA_Periph.CRL.CNF0  := 2#00#; --  Output push-pull

      --  Drive the RSTn line low
      STM32.GPIO.GPIOA_Periph.BSRR.BR :=
        STM32.GPIO.BSRR_BR_Field'(As_Array => True,
                                  Arr      => (1 => 1, others => 0));

      --  Put the RSTn line to hi-Z
      STM32.GPIO.GPIOA_Periph.CRL.MODE0 := 2#00#; --  Input
      STM32.GPIO.GPIOA_Periph.CRL.CNF0  := 2#01#; --  Floating input
   end Reset_DW1000;

   procedure Acknowledge_DW1000_IRQ
   is
   begin
      STM32.EXTI.EXTI_Periph.PR.PR.Arr (5) := 1;
   end Acknowledge_DW1000_IRQ;

   procedure Disable_DW1000_IRQ
   is
   begin
      --  Disable IRQ #25 (EXTI9_5_Interrupt)
      STM32.NVIC.NVIC_Periph.ICER0 := 16#0200_0000#;
   end Disable_DW1000_IRQ;

   procedure Enable_DW1000_IRQ
   is
   begin
      --  Enable IRQ #25 (EXTI9_5_Interrupt)
      STM32.NVIC.NVIC_Periph.ISER0 := 16#0200_0000#;
   end Enable_DW1000_IRQ;

   procedure Use_Slow_SPI_Clock
   is
   begin
      --  Use /32 prescaler (72 MHz / 32 = 2.25 MHz clock)
      STM32.SPI.SPI1_Periph.CR1.BR := 2#100#;
   end Use_Slow_SPI_Clock;

   procedure Use_Fast_SPI_Clock
   is
   begin
      --  Use /4 prescaler (72 MHz / 4 = 18 MHz clock)
      STM32.SPI.SPI1_Periph.CR1.BR := 2#001#;
   end Use_Fast_SPI_Clock;

   procedure Write_Transaction(Header : in DW1000.Types.Byte_Array;
                               Data   : in DW1000.Types.Byte_Array)
   is
      use type STM32.Bit;

   begin
      Disable_DW1000_IRQ;

      Select_Device;

      --  Send header
      for I in Header'Range loop
         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Header (I) );

         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;
      end loop;

      --  Send data
      for I in Data'Range loop
         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;

         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Data (I) );
      end loop;

      --  Wait for the last byte to finish transmitting.
      loop
         exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
      end loop;

      Deselect_Device;

      Enable_DW1000_IRQ;

   end Write_Transaction;

   procedure Read_Transaction(Header : in     DW1000.Types.Byte_Array;
                              Data   :    out DW1000.Types.Byte_Array)
   is
      use type STM32.Bit;

   begin
      Disable_DW1000_IRQ;

      Select_Device;

      --  Send header
      for I in Header'Range loop
         STM32.SPI.SPI1_Periph.DR.DR := Unsigned_16 (Header (I));

         loop
            exit when STM32.SPI.SPI1_Periph.SR.TXE = 1;
         end loop;
      end loop;

      loop
         exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
      end loop;

      --  Read data
      for I in Data'Range loop
         -- Send a dummy byte to begin the transfer
         STM32.SPI.SPI1_Periph.DR.DR := 16#0000#;

         loop
            exit when STM32.SPI.SPI1_Periph.SR.BSY = 0;
         end loop;

         Data (I) := Unsigned_8 (STM32.SPI.SPI1_Periph.DR.DR and 16#FF#);
      end loop;

      Deselect_Device;

      Enable_DW1000_IRQ;

   end Read_Transaction;

begin
   --  Enable peripheral clocks
   STM32.RCC.RCC_Periph.APB2ENR.SPI1EN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.AFIOEN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.IOPAEN := 1;
   STM32.RCC.RCC_Periph.APB2ENR.IOPBEN := 1;

   --  Configure GPIO
   STM32.GPIO.GPIOA_Periph.CRL.MODE4 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE5 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE6 := 2#00#;
   STM32.GPIO.GPIOA_Periph.CRL.MODE7 := 2#11#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF4  := 2#00#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF5  := 2#10#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF6  := 2#10#;
   STM32.GPIO.GPIOA_Periph.CRL.CNF7  := 2#10#;

   Deselect_Device;

   Reset_DW1000;

   --  Configure SPI
   STM32.SPI.SPI1_Periph.CR1 :=
     STM32.SPI.CR1_Register'(CPHA           => 0,
                             CPOL           => 0,
                             MSTR           => 1,
                             BR             => 2#100#, --  /32 prescaler
                             SPE            => 0,
                             LSBFIRST       => 0, --  MSB first
                             SSI            => 1,
                             SSM            => 1,
                             RXONLY         => 0, --  Full duplex
                             DFF            => 0, --  8-bit data
                             CRCNEXT        => 0,
                             CRCEN          => 0, --  No CRC
                             BIDIOE         => 0,
                             BIDIMODE       => 0, --  Bidirectional
                             Reserved_16_31 => 0);
   STM32.SPI.SPI1_Periph.CRCPR.CRCPOLY := 7;
   STM32.SPI.SPI1_Periph.CR1.SPE := 1;

   --  Configure IRQ
   STM32.GPIO.GPIOB_Periph.CRL.CNF5  := 2#10#;  --  Input with pull-up/down
   STM32.GPIO.GPIOB_Periph.CRL.MODE5 := 2#00#;  --  Input mode
   STM32.GPIO.GPIOB_Periph.BRR.BR.Arr (5) := 1; --  Pull-down

   STM32.AFIO.AFIO_Periph.EXTICR2.EXTI.Arr (5) := 2#0001#; --  GPIOB

   STM32.EXTI.EXTI_Periph.IMR.MR.Arr (5)  := 1; --  Enable interrupt
   STM32.EXTI.EXTI_Periph.EMR.MR.Arr (5)  := 0;
   STM32.EXTI.EXTI_Periph.RTSR.TR.Arr (5) := 1; --  Rising edge enabled
   STM32.EXTI.EXTI_Periph.FTSR.TR.Arr (5) := 0; --  Falling edge disabled

end DW1000.BSP;

Add missing DW1000 IRQ disable in the Write_Transaction procedure.

The DW1000 IRQ is disabled during the SPI transactions to prevent
a race condition on the SPI if the IRQ handler code accesses the
SPI bus during its execution.


-----------------------------------------------------------------------
--  awa-questions-modules -- Module questions
--  Copyright (C) 2012, 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 Ada.Calendar;
with Ada.Characters.Conversions;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Wikis.Parsers;
with AWA.Wikis.Writers;

with ADO.Sessions;
with ADO.Statements;

with Util.Log.Loggers;
with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Questions.Module");

   package Register is new AWA.Modules.Beans (Module => Question_Module,
                                              Module_Access => Question_Module_Access);

   --  ------------------------------
   --  Initialize the questions module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Question_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the questions module");

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Edit and save a question.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Question_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

      --  Edit and save an answer.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Answer_Bean",
                         Handler => AWA.Questions.Beans.Create_Answer_Bean'Access);

      --  List of questions.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_List_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_List_Bean'Access);

      --  Display a question with its answers.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_Display_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Display_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      function To_Wide (Item : in String) return Wide_Wide_String
                        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Ctx.Start;
      if Question.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Question.Get_Id));

         WS := AWA.Workspaces.Models.Workspace_Ref (Question.Get_Workspace);
      else
         Log.Info ("Creating new question {0}", String '(Question.Get_Title));

         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Create_Questions.Permission,
                                Entity     => WS);
         Question.Set_Workspace (WS);
         Question.Set_Author (User);
      end if;

      declare
         Text : constant String := AWA.Wikis.Writers.To_Text (To_Wide (Question.Get_Description),
                                                              AWA.Wikis.Parsers.SYNTAX_MIX);
         Last : Natural;
      begin
         if Text'Length < SHORT_DESCRIPTION_LENGTH then
            Last := Text'Last;
         else
            Last := SHORT_DESCRIPTION_LENGTH;
         end if;
         Question.Set_Short_Description (Text (Text'First .. Last) & "...");
      end;
      if not Question.Is_Inserted then
         Question.Set_Create_Date (Ada.Calendar.Clock);
      else
         Question.Set_Edit_Date (Ada.Calendar.Clock);
      end if;
      Question.Save (DB);
      Ctx.Commit;
   end Save_Question;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete_Question (Model    : in Question_Module;
                              Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given question.
      AWA.Permissions.Check (Permission => ACL_Delete_Questions.Permission,
                             Entity     => Question);

      --  Before deleting the question, delete the associated answers.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Questions.Models.ANSWER_TABLE);
      begin
         Stmt.Set_Filter (Filter => "question_id = ?");
         Stmt.Add_Param (Value => Question);
         Stmt.Execute;
      end;
      Question.Delete (DB);
      Ctx.Commit;
   end Delete_Question;

   --  ------------------------------
   --  Load the question.
   --  ------------------------------
   procedure Load_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Question.Load (DB, Id, Found);
   end Load_Question;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save_Answer (Model    : in Question_Module;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      if Answer.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Answer.Get_Id));

      else
         Log.Info ("Creating new answer for {0}", ADO.Identifier'Image (Question.Get_Id));

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Answer_Questions.Permission,
                                Entity     => Question);
         Answer.Set_Author (User);
      end if;

      if not Answer.Is_Inserted then
         Answer.Set_Create_Date (Ada.Calendar.Clock);
         Answer.Set_Question (Question);
      else
         Answer.Set_Edit_Date (ADO.Nullable_Time '(Value   => Ada.Calendar.Clock,
                                                   Is_Null => False));
      end if;
      Answer.Save (DB);
      Ctx.Commit;
   end Save_Answer;

   --  ------------------------------
   --  Delete the answer.
   --  ------------------------------
   procedure Delete_Answer (Model  : in Question_Module;
                            Answer : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => ACL_Delete_Answer.Permission,
                             Entity     => Answer);

      Answer.Delete (DB);
      Ctx.Commit;
   end Delete_Answer;

   --  ------------------------------
   --  Load the answer.
   --  ------------------------------
   procedure Load_Answer (Model    : in Question_Module;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class;
                          Question : in out AWA.Questions.Models.Question_Ref'Class;
                          Id       : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Answer.Load (DB, Id, Found);
      Question := Answer.Get_Question;
   end Load_Answer;

end AWA.Questions.Modules;

-----------------------------------------------------------------------
--  awa-questions-modules -- Module questions
--  Copyright (C) 2012, 2013, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Ada.Characters.Conversions;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Wikis.Parsers;
with AWA.Wikis.Writers;

with ADO.Sessions;
with ADO.Statements;

with Util.Log.Loggers;
with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Questions.Module");

   package Register is new AWA.Modules.Beans (Module => Question_Module,
                                              Module_Access => Question_Module_Access);

   --  ------------------------------
   --  Initialize the questions module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Question_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the questions module");

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Edit and save a question.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Question_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

      --  Edit and save an answer.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Answer_Bean",
                         Handler => AWA.Questions.Beans.Create_Answer_Bean'Access);

      --  List of questions.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_List_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_List_Bean'Access);

      --  Display a question with its answers.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_Display_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Display_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      function To_Wide (Item : in String) return Wide_Wide_String
                        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Ctx.Start;
      if Question.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Question.Get_Id));

         WS := AWA.Workspaces.Models.Workspace_Ref (Question.Get_Workspace);
      else
         Log.Info ("Creating new question {0}", String '(Question.Get_Title));

         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Create_Questions.Permission,
                                Entity     => WS);
         Question.Set_Workspace (WS);
         Question.Set_Author (User);
      end if;

      declare
         Text : constant String := AWA.Wikis.Writers.To_Text (To_Wide (Question.Get_Description),
                                                              AWA.Wikis.Parsers.SYNTAX_MIX);
         Last : Natural;
      begin
         if Text'Length < SHORT_DESCRIPTION_LENGTH then
            Last := Text'Last;
         else
            Last := SHORT_DESCRIPTION_LENGTH;
         end if;
         Question.Set_Short_Description (Text (Text'First .. Last) & "...");
      end;
      if not Question.Is_Inserted then
         Question.Set_Create_Date (Ada.Calendar.Clock);
      else
         Question.Set_Edit_Date (ADO.Nullable_Time '(Is_Null => False,
                                                     Value => Ada.Calendar.Clock));
      end if;
      Question.Save (DB);
      Ctx.Commit;
   end Save_Question;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete_Question (Model    : in Question_Module;
                              Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given question.
      AWA.Permissions.Check (Permission => ACL_Delete_Questions.Permission,
                             Entity     => Question);

      --  Before deleting the question, delete the associated answers.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Questions.Models.ANSWER_TABLE);
      begin
         Stmt.Set_Filter (Filter => "question_id = ?");
         Stmt.Add_Param (Value => Question);
         Stmt.Execute;
      end;
      Question.Delete (DB);
      Ctx.Commit;
   end Delete_Question;

   --  ------------------------------
   --  Load the question.
   --  ------------------------------
   procedure Load_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Question.Load (DB, Id, Found);
   end Load_Question;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save_Answer (Model    : in Question_Module;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      if Answer.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Answer.Get_Id));

      else
         Log.Info ("Creating new answer for {0}", ADO.Identifier'Image (Question.Get_Id));

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Answer_Questions.Permission,
                                Entity     => Question);
         Answer.Set_Author (User);
      end if;

      if not Answer.Is_Inserted then
         Answer.Set_Create_Date (Ada.Calendar.Clock);
         Answer.Set_Question (Question);
      else
         Answer.Set_Edit_Date (ADO.Nullable_Time '(Value   => Ada.Calendar.Clock,
                                                   Is_Null => False));
      end if;
      Answer.Save (DB);
      Ctx.Commit;
   end Save_Answer;

   --  ------------------------------
   --  Delete the answer.
   --  ------------------------------
   procedure Delete_Answer (Model  : in Question_Module;
                            Answer : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => ACL_Delete_Answer.Permission,
                             Entity     => Answer);

      Answer.Delete (DB);
      Ctx.Commit;
   end Delete_Answer;

   --  ------------------------------
   --  Load the answer.
   --  ------------------------------
   procedure Load_Answer (Model    : in Question_Module;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class;
                          Question : in out AWA.Questions.Models.Question_Ref'Class;
                          Id       : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Answer.Load (DB, Id, Found);
      Question := Answer.Get_Question;
   end Load_Answer;

end AWA.Questions.Modules;

Fix setting the question edit date to use the Nullable_Time type


-----------------------------------------------------------------------
--  ado-schemas-entities -- Entity types cache
--  Copyright (C) 2011, 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.Containers;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with ADO.Sessions;
package ADO.Schemas.Entities is

   No_Entity_Type : exception;

   --  The entity cache maintains a static cache of database entities.
   type Entity_Cache is private;

   --  Find the entity type index associated with the given database table.
   --  Raises the No_Entity_Type exception if no such mapping exist.
   function Find_Entity_Type (Cache : in Entity_Cache;
                              Table : in Class_Mapping_Access) return ADO.Entity_Type;

   --  Find the entity type index associated with the given database table.
   --  Raises the No_Entity_Type exception if no such mapping exist.
   function Find_Entity_Type (Cache : in Entity_Cache;
                              Name  : in Util.Strings.Name_Access) return ADO.Entity_Type;

   --  Initialize the entity cache by reading the database entity table.
   procedure Initialize (Cache   : in out Entity_Cache;
                         Session : in out ADO.Sessions.Session'Class);

private

   package Entity_Map is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => ADO.Entity_Type,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Entity_Cache is record
      Entities : Entity_Map.Map;
   end record;

end ADO.Schemas.Entities;

-----------------------------------------------------------------------
--  ado-schemas-entities -- Entity types cache
--  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 Ada.Containers;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with ADO.Sessions;
with ADO.Parameters;
package ADO.Schemas.Entities is

   No_Entity_Type : exception;

   --  The entity cache maintains a static cache of database entities.
   type Entity_Cache is new ADO.Caches.Cache_Type with private;

   --  Expand the name into a target parameter value to be used in the SQL query.
   --  The Expander can return a T_NULL when a value is not found or
   --  it may also raise some exception.
   overriding
   function Expand (Instance : in out Entity_Cache;
                    Name     : in String) return ADO.Parameters.Parameter;

   --  Find the entity type index associated with the given database table.
   --  Raises the No_Entity_Type exception if no such mapping exist.
   function Find_Entity_Type (Cache : in Entity_Cache;
                              Table : in Class_Mapping_Access) return ADO.Entity_Type;

   --  Find the entity type index associated with the given database table.
   --  Raises the No_Entity_Type exception if no such mapping exist.
   function Find_Entity_Type (Cache : in Entity_Cache;
                              Name  : in Util.Strings.Name_Access) return ADO.Entity_Type;

   --  Initialize the entity cache by reading the database entity table.
   procedure Initialize (Cache   : in out Entity_Cache;
                         Session : in out ADO.Sessions.Session'Class);

private

   package Entity_Map is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => ADO.Entity_Type,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Entity_Cache is new ADO.Caches.Cache_Type with record
      Entities : Entity_Map.Map;
   end record;

end ADO.Schemas.Entities;

Update the Entity_Cache so that it inherit from ADO.Caches.Cache_Type type Override the Expand function