-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  Copyright (C) 2014 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 MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER);

   type Notice_Type is (N_PID_INFO,
                        N_PATH_INFO);

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

-----------------------------------------------------------------------
--  mat-consoles - Console interface
--  Copyright (C) 2014 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 MAT.Types;
package MAT.Consoles is

   type Field_Type is (F_ADDR,
                       F_SIZE,
                       F_TOTAL_SIZE,
                       F_MIN_SIZE,
                       F_MAX_SIZE,
                       F_MIN_ADDR,
                       F_MAX_ADDR,
                       F_THREAD,
                       F_COUNT,
                       F_FILE_NAME,
                       F_FUNCTION_NAME,
                       F_LINE_NUMBER);

   type Notice_Type is (N_PID_INFO,
                        N_DURATION,
                        N_PATH_INFO);

   type Console_Type is abstract tagged limited private;
   type Console_Access is access all Console_Type'Class;

   --  Report an error message.
   procedure Error (Console : in out Console_Type;
                    Message : in String) is abstract;

   --  Report a notice message.
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is abstract;

   --  Print the field value for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is abstract;

   --  Print the title for the given field.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is abstract;

   --  Start a new title in a report.
   procedure Start_Title (Console : in out Console_Type) is abstract;

   --  Finish a new title in a report.
   procedure End_Title (Console : in out Console_Type) is abstract;

   --  Start a new row in a report.
   procedure Start_Row (Console : in out Console_Type) is abstract;

   --  Finish a new row in a report.
   procedure End_Row (Console : in out Console_Type) is abstract;

   --  Print the title for the given field and setup the associated field size.
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String;
                          Length  : in Positive);

   --  Format the address and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr);

   --  Format the size and print it for the given field.
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size);

   --  Format the thread information and print it for the given field.
   procedure Print_Thread (Console : in out Console_Type;
                           Field   : in Field_Type;
                           Thread  : in MAT.Types.Target_Thread_Ref);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Integer);

   --  Format the integer and print it for the given field.
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in Ada.Strings.Unbounded.Unbounded_String);

private

   type Field_Size_Array is array (Field_Type) of Natural;

   type Field_List_Array is array (1 .. Field_Type'Pos (Field_Type'Last)) of Field_Type;

   type Console_Type is abstract tagged limited record
      Sizes       : Field_Size_Array := (others => 1);
      Cols        : Field_Size_Array := (others => 1);
      Fields      : Field_List_Array;
      Field_Count : Natural := 0;
   end record;

end MAT.Consoles;

Add the N_DURATION enum

Add the N_DURATION enum


-----------------------------------------------------------------------
--  awa-questions-beans -- Beans for 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.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
with AWA.Questions.Services;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Services.Question_Service_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the question.
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Services.Question_Service_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Answer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the answer.
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Question_Info_List_Bean bean instance.
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Services.Question_Service_Access := null;

      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Question_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create the Question_Display_Bean bean instance.
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                          return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Questions.Beans;

-----------------------------------------------------------------------
--  awa-questions-beans -- Beans for 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.Strings.Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;
with AWA.Questions.Modules;
with AWA.Questions.Models;
package AWA.Questions.Beans is

   type Question_Bean is new AWA.Questions.Models.Question_Bean with record
      Service : Modules.Question_Module_Access := null;
   end record;
   type Question_Bean_Access is access all Question_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the question.
   procedure Save (Bean    : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Questions_Bean bean instance.
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Answer_Bean is new AWA.Questions.Models.Answer_Bean with record
      Service  : Modules.Question_Module_Access := null;
      Question : AWA.Questions.Models.Question_Ref;
   end record;
   type Answer_Bean_Access is access all Answer_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Answer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Answer_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the answer.
   procedure Save (Bean    : in out Answer_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the question.
   procedure Delete (Bean    : in out Answer_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the answer bean instance.
   function Create_Answer_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Question_Info_List_Bean bean instance.
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Question_Display_Bean is new Util.Beans.Basic.Bean with record
      Service          : Modules.Question_Module_Access := null;

      Answer_List      : aliased AWA.Questions.Models.Answer_Info_List_Bean;
      Answer_List_Bean : AWA.Questions.Models.Answer_Info_List_Bean_Access;

      Question         : aliased AWA.Questions.Models.Question_Display_Info;
      Question_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Question_Display_Bean_Access is access all Question_Display_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Question_Display_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Question_Display_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create the Question_Display_Bean bean instance.
   function Create_Question_Display_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                          return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Questions.Beans;

Move the question services in the question module (simplify the implementation)


with Ada.Text_IO;
with PrimeUtilities;

package body Problem_70 is
   package IO renames Ada.Text_IO;
   subtype Ten_Million is Integer range 1 .. 9_999_999;
   package Ten_Million_Primes is new PrimeUtilities(Ten_Million);
   type Long_Sieve is Array (Positive range <>) of Long_Float;
   type Digit_Count is Array(Character range '0' .. '9') of Natural;
   Max_Double : constant := Long_Float(Ten_Million'Last);

   function Make_Long_Float_Sieve return Long_Sieve is
      old_sieve : constant Ten_Million_Primes.Sieve := Ten_Million_Primes.Generate_Sieve(Ten_Million'Last / 2);
      new_sieve : Long_Sieve(1 .. old_sieve'Last);
   begin
      for i in new_sieve'Range loop
         new_sieve(i) := Long_Float(old_sieve(i));
      end loop;
      return new_sieve;
   end Make_Long_Float_Sieve;

   procedure Solve is
      sieve : constant Long_Sieve := Make_Long_Float_Sieve;
      best : Ten_Million := 1;
      best_ratio : Long_Float := 99999.0;
      function Convert(num : Long_Float) return Digit_Count is
         num_cnv : constant Ten_Million := Ten_Million(Long_Float'Rounding(num));
         str : constant String := Ten_Million'Image(num_cnv);
         counts : Digit_Count := (others => 0);
      begin
         for i in 2 .. str'Last loop
            counts(str(i)) := counts(str(i)) + 1;
         end loop;
         return counts;
      end Convert;
      procedure Check(num, ratio : Long_Float) is
         euler : constant Long_Float := num * ratio;
         num_c : constant Digit_Count := Convert(num);
         euler_c : constant Digit_Count := Convert(euler);
      begin
         for c in num_c'Range loop
            if num_c(c) /= euler_c(c) then
               return;
            end if;
         end loop;
         if (1.0 / ratio) < best_ratio then
            best := Ten_Million(Long_Float'Rounding(num));
            best_ratio := 1.0 / ratio;
         end if;
      end Check;
      procedure Solve_Recursive(min_index : Positive; start_ratio : Long_Float; So_Far : Long_Float) is
         prime : Long_Float;
         total : Long_Float;
         ratio : Long_Float;
      begin
         for prime_index in min_index .. sieve'Last loop
            prime := sieve(prime_index);
            total := So_Far * prime;
            ratio := start_ratio * ((prime - 1.0) / prime);
            exit when total > Max_Double or ratio < 0.1;
            loop
               Check(total, ratio);
               Solve_Recursive(prime_index + 1, ratio, total);
               total := total * prime;
               exit when total > Max_Double;
            end loop;
         end loop;
      end Solve_Recursive;
   begin
      Solve_Recursive(sieve'First, 1.0, 1.0);
      IO.Put_Line(Integer'Image(best));
   end Solve;

end Problem_70;

with Ada.Text_IO;
with PrimeUtilities;

package body Problem_70 is
   package IO renames Ada.Text_IO;
   subtype Ten_Million is Integer range 1 .. 9_999_999;
   package Ten_Million_Primes is new PrimeUtilities(Ten_Million);
   type Long_Sieve is Array (Positive range <>) of Long_Float;
   type Digit_Count is Array(Character range '0' .. '9') of Natural;
   Max_Double : constant := Long_Float(Ten_Million'Last);

   function Make_Long_Float_Sieve return Long_Sieve is
      old_sieve : constant Ten_Million_Primes.Sieve := Ten_Million_Primes.Generate_Sieve(Ten_Million'Last / 2);
      new_sieve : Long_Sieve(1 .. old_sieve'Last);
   begin
      for i in new_sieve'Range loop
         new_sieve(i) := Long_Float(old_sieve(i));
      end loop;
      return new_sieve;
   end Make_Long_Float_Sieve;

   procedure Solve is
      sieve : constant Long_Sieve := Make_Long_Float_Sieve;
      best : Ten_Million := 1;
      best_ratio : Long_Float := 0.0;
      function Convert(num : Long_Float) return Digit_Count is
         num_cnv : constant Ten_Million := Ten_Million(Long_Float'Rounding(num));
         str : constant String := Ten_Million'Image(num_cnv);
         counts : Digit_Count := (others => 0);
      begin
         for i in 2 .. str'Last loop
            counts(str(i)) := counts(str(i)) + 1;
         end loop;
         return counts;
      end Convert;
      procedure Check(num, ratio : Long_Float) is
         euler : constant Long_Float := num * ratio;
         num_c : constant Digit_Count := Convert(num);
         euler_c : constant Digit_Count := Convert(euler);
      begin
         for c in num_c'Range loop
            if num_c(c) /= euler_c(c) then
               return;
            end if;
         end loop;
         best := Ten_Million(Long_Float'Rounding(num));
         best_ratio := ratio;
      end Check;
      procedure Solve_Recursive(min_index : Positive; start_ratio : Long_Float; So_Far : Long_Float) is
         prime : Long_Float;
         total : Long_Float;
         ratio : Long_Float;
      begin
         for prime_index in min_index .. sieve'Last loop
            prime := sieve(prime_index);
            total := So_Far * prime;
            ratio := start_ratio * ((prime - 1.0) / prime);
            exit when total > Max_Double or ratio < 0.1;
            loop
               if ratio > best_ratio then
                  Check(total, ratio);
               end if;
               Solve_Recursive(prime_index + 1, ratio, total);
               total := total * prime;
               exit when total > Max_Double;
            end loop;
         end loop;
      end Solve_Recursive;
   begin
      Solve_Recursive(sieve'First, 1.0, 1.0);
      IO.Put_Line(Integer'Image(best));
   end Solve;

end Problem_70;

Use inverse ratio because I don't need the ratio itself.

Check the ratio (cheap) before we do the permutation check (expensive), which halves the runtime for me.


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

with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Templates.Generic_Discrete_Render;
with Natools.S_Expressions.Templates.Integers;
with Natools.Static_Maps.S_Expressions.Templates.Dates;
with Natools.Time_IO.RFC_3339;

package body Natools.S_Expressions.Templates.Dates is

   package Commands renames Natools.Static_Maps.S_Expressions.Templates.Dates;

   procedure Render_Day_Of_Week
     is new Natools.S_Expressions.Templates.Generic_Discrete_Render
     (Ada.Calendar.Formatting.Day_Name,
      Ada.Calendar.Formatting.Day_Name'Image,
      Ada.Calendar.Formatting."=");

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom);

   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);

   function Two_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 10),
          2 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 99;

   function Four_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 1000),
          2 => Character'Pos ('0') + Octet ((Value / 100) mod 10),
          3 => Character'Pos ('0') + Octet ((Value / 10) mod 10),
          4 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 9999;

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset;

   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class);

   procedure Interpreter is new Interpreter_Loop
     (Ada.Streams.Root_Stream_Type'Class, Split_Time, Execute, Append);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset
   is
      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset;

      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset is
      begin
         if C in '0' .. '9' then
            return Ada.Calendar.Time_Zones.Time_Offset
                    (Character'Pos (C) - Character'Pos ('0'));
         else
            raise Constraint_Error with "Unknown time offset format";
         end if;
      end Value;
   begin
      if Image = "system" then
         return Ada.Calendar.Time_Zones.UTC_Time_Offset (Date);
      end if;

      Abbreviation :
      begin
         return Ada.Calendar.Time_Zones.Time_Offset
           (Static_Maps.S_Expressions.Templates.Dates.To_Time_Offset (Image));
      exception
         when Constraint_Error => null;
      end Abbreviation;

      Numeric :
      declare
         use type Ada.Calendar.Time_Zones.Time_Offset;
         First : Integer := Image'First;
         Length : Natural := Image'Length;
         V : Ada.Calendar.Time_Zones.Time_Offset;
         Negative : Boolean := False;
      begin
         if First in Image'Range and then Image (First) in '-' | '+' then
            Negative := Image (First) = '-';
            First := First + 1;
            Length := Length - 1;
         end if;

         case Length is
            when 1 =>
               V := Value (Image (First)) * 60;

            when 2 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60;

            when 4 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 2)) * 10
                  + Value (Image (First + 3));

            when 5 =>
               if Image (First + 2) in '0' .. '9' then
                  raise Constraint_Error with "Unknown time offset format";
               end if;

               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 3)) * 10
                  + Value (Image (First + 4));

            when others =>
               raise Constraint_Error with "Unknown time offset format";
         end case;

         if Negative then
            return -V;
         else
            return V;
         end if;
      end Numeric;
   end Parse_Time_Offset;

   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class) is
   begin
      Output.Write (Part_1);

      if Template.Current_Event = Events.Add_Atom then
         declare
            Separator : constant Atom := Template.Current_Atom;
            Event : Events.Event;
         begin
            Template.Next (Event);

            Output.Write (Separator);
            Output.Write (Part_2);

            if Event = Events.Add_Atom then
               Output.Write (Template.Current_Atom);
            else
               Output.Write (Separator);
            end if;
         end;
      else
         Output.Write (Part_2);
      end if;

      Output.Write (Part_3);
   end Render_Triplet;

   ----------------------------
   -- Interpreter Components --
   ----------------------------

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom)
   is
      pragma Unreferenced (Value);
   begin
      Output.Write (Data);
   end Append;

   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is
      Format : Integers.Format;
   begin
      case Commands.Main (To_String (Name)) is
         when Commands.Error =>
            null;

         when Commands.Big_Endian_Date =>
            Render_Triplet
              (Output,
               Four_Digit_Image (Value.Year),
               Two_Digit_Image (Value.Month),
               Two_Digit_Image (Value.Day),
               Arguments);

         when Commands.Big_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Hour),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Second),
               Arguments);

         when Commands.Day =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Day_Of_Week =>
            Render_Day_Of_Week (Output, Arguments, Value.Day_Of_Week);

         when Commands.Hour =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Little_Endian_Date =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Day),
               Two_Digit_Image (Value.Month),
               Four_Digit_Image (Value.Year),
               Arguments);

         when Commands.Little_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Second),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Hour),
               Arguments);

         when Commands.Minute =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Month =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Day =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Padded_Hour =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Padded_Minute =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Padded_Month =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Second =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.RFC_3339 =>
            Output.Write (To_Atom
              (Time_IO.RFC_3339.Image (Value.Source, Value.Time_Zone)));

         when Commands.Second =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.With_Offset =>
            if Arguments.Current_Event = Events.Add_Atom then
               declare
                  use type Ada.Calendar.Time_Zones.Time_Offset;
                  New_Offset : Ada.Calendar.Time_Zones.Time_Offset;
               begin
                  begin
                     New_Offset := Parse_Time_Offset
                       (S_Expressions.To_String (Arguments.Current_Atom),
                        Value.Source);
                  exception
                     when Constraint_Error => return;
                  end;

                  Arguments.Next;

                  if New_Offset = Value.Time_Zone then
                     Interpreter (Arguments, Output, Value);
                  else
                     Render (Output, Arguments, Value.Source, New_Offset);
                  end if;
               end;
            end if;

         when Commands.Year =>
            Integers.Render (Output, Arguments, Value.Year);
      end case;
   end Execute;

   ----------------------
   -- Public Interface --
   ----------------------

   function Split
     (Value : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset)
     return Split_Time
   is
      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number;
      Minute : Ada.Calendar.Formatting.Minute_Number;
      Second : Ada.Calendar.Formatting.Second_Number;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration;
   begin
      Ada.Calendar.Formatting.Split
        (Value,
         Year, Month, Day,
         Hour, Minute, Second,
         Sub_Second,
         Time_Zone);

      return Split_Time'
        (Source => Value,
         Time_Zone => Time_Zone,
         Year => Year,
         Month => Month,
         Day => Day,
         Day_Of_Week => Ada.Calendar.Formatting.Day_Of_Week (Value),
         Hour => Hour,
         Minute => Minute,
         Second => Second,
         Sub_Second => Sub_Second);
   end Split;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time) is
   begin
      Render
        (Output,
         Template,
         Value,
         Ada.Calendar.Time_Zones.UTC_Time_Offset (Value));
   end Render;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset) is
   begin
      Render (Output, Template, Split (Value, Time_Zone));
   end Render;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Split_Time) is
   begin
      Interpreter (Template, Output, Value);
   end Render;

end Natools.S_Expressions.Templates.Dates;

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

with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Templates.Generic_Discrete_Render;
with Natools.S_Expressions.Templates.Integers;
with Natools.Static_Maps.S_Expressions.Templates.Dates;
with Natools.Time_IO.RFC_3339;

package body Natools.S_Expressions.Templates.Dates is

   package Commands renames Natools.Static_Maps.S_Expressions.Templates.Dates;

   procedure Render_Day_Of_Week
     is new Natools.S_Expressions.Templates.Generic_Discrete_Render
     (Ada.Calendar.Formatting.Day_Name,
      Ada.Calendar.Formatting.Day_Name'Image,
      Ada.Calendar.Formatting."=");

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom);

   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);

   function Two_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 10),
          2 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 99;

   function Four_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 1000),
          2 => Character'Pos ('0') + Octet ((Value / 100) mod 10),
          3 => Character'Pos ('0') + Octet ((Value / 10) mod 10),
          4 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 9999;

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset;

   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class);

   procedure Interpreter is new Interpreter_Loop
     (Ada.Streams.Root_Stream_Type'Class, Split_Time, Execute, Append);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset
   is
      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset;

      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset is
      begin
         if C in '0' .. '9' then
            return Ada.Calendar.Time_Zones.Time_Offset
                    (Character'Pos (C) - Character'Pos ('0'));
         else
            raise Constraint_Error with "Unknown time offset format";
         end if;
      end Value;
   begin
      if Image = "system" then
         return Ada.Calendar.Time_Zones.UTC_Time_Offset (Date);
      end if;

      Abbreviation :
      begin
         return Ada.Calendar.Time_Zones.Time_Offset
           (Static_Maps.S_Expressions.Templates.Dates.To_Time_Offset (Image));
      exception
         when Constraint_Error => null;
      end Abbreviation;

      Numeric :
      declare
         use type Ada.Calendar.Time_Zones.Time_Offset;
         First : Integer := Image'First;
         Length : Natural := Image'Length;
         V : Ada.Calendar.Time_Zones.Time_Offset;
         Negative : Boolean := False;
      begin
         if First in Image'Range and then Image (First) in '-' | '+' then
            Negative := Image (First) = '-';
            First := First + 1;
            Length := Length - 1;
         end if;

         case Length is
            when 1 =>
               V := Value (Image (First)) * 60;

            when 2 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60;

            when 4 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 2)) * 10
                  + Value (Image (First + 3));

            when 5 =>
               if Image (First + 2) in '0' .. '9' then
                  raise Constraint_Error with "Unknown time offset format";
               end if;

               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 3)) * 10
                  + Value (Image (First + 4));

            when others =>
               raise Constraint_Error with "Unknown time offset format";
         end case;

         if Negative then
            return -V;
         else
            return V;
         end if;
      end Numeric;
   end Parse_Time_Offset;

   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class) is
   begin
      Output.Write (Part_1);

      if Template.Current_Event = Events.Add_Atom then
         declare
            Separator : constant Atom := Template.Current_Atom;
            Event : Events.Event;
         begin
            Template.Next (Event);

            Output.Write (Separator);
            Output.Write (Part_2);

            if Event = Events.Add_Atom then
               Output.Write (Template.Current_Atom);
            else
               Output.Write (Separator);
            end if;
         end;
      else
         Output.Write (Part_2);
      end if;

      Output.Write (Part_3);
   end Render_Triplet;

   ----------------------------
   -- Interpreter Components --
   ----------------------------

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom)
   is
      pragma Unreferenced (Value);
   begin
      Output.Write (Data);
   end Append;

   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is
      Format : Integers.Format;
   begin
      case Commands.Main (To_String (Name)) is
         when Commands.Error =>
            null;

         when Commands.Big_Endian_Date =>
            Render_Triplet
              (Output,
               Four_Digit_Image (Value.Year),
               Two_Digit_Image (Value.Month),
               Two_Digit_Image (Value.Day),
               Arguments);

         when Commands.Big_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Hour),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Second),
               Arguments);

         when Commands.Day =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Day_Of_Week =>
            Render_Day_Of_Week (Output, Arguments, Value.Day_Of_Week);

         when Commands.Hour =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Little_Endian_Date =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Day),
               Two_Digit_Image (Value.Month),
               Four_Digit_Image (Value.Year),
               Arguments);

         when Commands.Little_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Second),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Hour),
               Arguments);

         when Commands.Minute =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Month =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Day =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Padded_Hour =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Padded_Minute =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Padded_Month =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Second =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.RFC_3339 =>
            Output.Write (To_Atom
              (Time_IO.RFC_3339.Image (Value.Source, Value.Time_Zone)));

         when Commands.Second =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.With_Offset =>
            if Arguments.Current_Event = Events.Add_Atom then
               declare
                  use type Ada.Calendar.Time_Zones.Time_Offset;
                  New_Offset : Ada.Calendar.Time_Zones.Time_Offset;
               begin
                  begin
                     New_Offset := Parse_Time_Offset
                       (S_Expressions.To_String (Arguments.Current_Atom),
                        Value.Source);
                  exception
                     when Constraint_Error => return;
                  end;

                  Arguments.Next;

                  if New_Offset = Value.Time_Zone then
                     Interpreter (Arguments, Output, Value);
                  else
                     Render (Output, Arguments, Value.Source, New_Offset);
                  end if;
               end;
            end if;

         when Commands.Year =>
            Integers.Render (Output, Arguments, Value.Year);
      end case;
   end Execute;

   ----------------------
   -- Public Interface --
   ----------------------

   function Split
     (Value : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset)
     return Split_Time
   is
      use type Ada.Calendar.Time_Zones.Time_Offset;
      Zone_Offset : constant Ada.Calendar.Time_Zones.Time_Offset
        := Time_Zone - Ada.Calendar.Time_Zones.UTC_Time_Offset (Value);

      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number;
      Minute : Ada.Calendar.Formatting.Minute_Number;
      Second : Ada.Calendar.Formatting.Second_Number;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration;
   begin
      Ada.Calendar.Formatting.Split
        (Value,
         Year, Month, Day,
         Hour, Minute, Second,
         Sub_Second,
         Time_Zone);

      return Split_Time'
        (Source => Value,
         Time_Zone => Time_Zone,
         Year => Year,
         Month => Month,
         Day => Day,
         Day_Of_Week => Ada.Calendar.Formatting.Day_Of_Week
           (Ada.Calendar."+" (Value, 60 * Duration (Zone_Offset))),
         Hour => Hour,
         Minute => Minute,
         Second => Second,
         Sub_Second => Sub_Second);
   end Split;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time) is
   begin
      Render
        (Output,
         Template,
         Value,
         Ada.Calendar.Time_Zones.UTC_Time_Offset (Value));
   end Render;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset) is
   begin
      Render (Output, Template, Split (Value, Time_Zone));
   end Render;

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Split_Time) is
   begin
      Interpreter (Template, Output, Value);
   end Render;

end Natools.S_Expressions.Templates.Dates;

fix incorrect weekday w.r.t. time zone

s_expressions-templates-dates: fix incorrect weekday w.r.t. time zone


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

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Tools;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Frames;
with MAT.Frames.Print;
with MAT.Consoles;
package body MAT.Commands is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Commands");

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

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Slots : MAT.Memory.Allocation_Map;
      Iter  : MAT.Memory.Allocation_Cursor;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Type;
         Backtrace : MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Slot.Frame);

         Name : Ada.Strings.Unbounded.Unbounded_String;
         Func : Ada.Strings.Unbounded.Unbounded_String;
         Line : Natural;
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.Set_Col (30);
         Ada.Text_IO.Put (MAT.Types.Target_Thread_Ref'Image (Slot.Thread));
         Ada.Text_IO.Set_Col (50);
         Ada.Text_IO.Put (MAT.Types.Target_Tick_Ref'Image (Slot.Time));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (MAT.Types.Hex_Image (Backtrace (I)));
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Backtrace (I),
                                                   Name    => Name,
                                                   Func    => Func,
                                                   Line    => Line);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Func));
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Name));
            if Line /= 0 then
               Ada.Text_IO.Put (":");
               Ada.Text_IO.Put (Util.Strings.Image (Line));
            end if;
            Ada.Text_IO.New_Line;
         end loop;
      end Print;

   begin
      Target.Memory.Find (From => MAT.Types.Target_Addr'First,
                          To   => MAT.Types.Target_Addr'Last,
                          Into => Slots);
      Iter := Slots.First;
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      Sizes   : MAT.Memory.Tools.Size_Info_Map;
      Iter    : MAT.Memory.Tools.Size_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_SIZE, "Slot size", 25);
      Console.Print_Title (MAT.Consoles.F_COUNT, "Count", 15);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.End_Title;

      MAT.Memory.Targets.Size_Information (Memory => Target.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Tools.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Size  : MAT.Types.Target_Size := MAT.Memory.Tools.Size_Info_Maps.Key (Iter);
            Info  : MAT.Memory.Tools.Size_Info_Type := MAT.Memory.Tools.Size_Info_Maps.Element (Iter);
            Total : MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Console.Start_Row;
            Console.Print_Size (MAT.Consoles.F_SIZE, Size);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Count);
            Console.Print_Field (MAT.Consoles.F_TOTAL_SIZE, Total);
            Console.End_Row;
         end;
         MAT.Memory.Tools.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}", Args);
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos <= 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      elsif Command'Length > 0 then
         Ada.Text_IO.Put_Line ("Command '" & Command & "' not found");
      end if;
   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
end MAT.Commands;

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

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Tools;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Frames;
with MAT.Frames.Print;
with MAT.Consoles;
package body MAT.Commands is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Commands");

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

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Slots : MAT.Memory.Allocation_Map;
      Iter  : MAT.Memory.Allocation_Cursor;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Type;
         Backtrace : MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Slot.Frame);

         Name : Ada.Strings.Unbounded.Unbounded_String;
         Func : Ada.Strings.Unbounded.Unbounded_String;
         Line : Natural;
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.Set_Col (30);
         Ada.Text_IO.Put (MAT.Types.Target_Thread_Ref'Image (Slot.Thread));
         Ada.Text_IO.Set_Col (50);
         Ada.Text_IO.Put (MAT.Types.Target_Tick_Ref'Image (Slot.Time));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (MAT.Types.Hex_Image (Backtrace (I)));
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Backtrace (I),
                                                   Name    => Name,
                                                   Func    => Func,
                                                   Line    => Line);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Func));
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Name));
            if Line /= 0 then
               Ada.Text_IO.Put (":");
               Ada.Text_IO.Put (Util.Strings.Image (Line));
            end if;
            Ada.Text_IO.New_Line;
         end loop;
      end Print;

   begin
      Target.Memory.Find (From => MAT.Types.Target_Addr'First,
                          To   => MAT.Types.Target_Addr'Last,
                          Into => Slots);
      Iter := Slots.First;
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      Sizes   : MAT.Memory.Tools.Size_Info_Map;
      Iter    : MAT.Memory.Tools.Size_Info_Cursor;
      Console : constant MAT.Consoles.Console_Access := Target.Console;
   begin
      Console.Start_Title;
      Console.Print_Title (MAT.Consoles.F_SIZE, "Slot size", 25);
      Console.Print_Title (MAT.Consoles.F_COUNT, "Count", 15);
      Console.Print_Title (MAT.Consoles.F_TOTAL_SIZE, "Total size", 15);
      Console.End_Title;

      MAT.Memory.Targets.Size_Information (Memory => Target.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Tools.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Size  : MAT.Types.Target_Size := MAT.Memory.Tools.Size_Info_Maps.Key (Iter);
            Info  : MAT.Memory.Tools.Size_Info_Type := MAT.Memory.Tools.Size_Info_Maps.Element (Iter);
            Total : MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Console.Start_Row;
            Console.Print_Size (MAT.Consoles.F_SIZE, Size);
            Console.Print_Field (MAT.Consoles.F_COUNT, Info.Count);
            Console.Print_Field (MAT.Consoles.F_TOTAL_SIZE, Total);
            Console.End_Row;
         end;
         MAT.Memory.Tools.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}", Args);
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos <= 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      elsif Command'Length > 0 then
         Target.Console.Error ("Command '" & Command & "' not found");
      end if;
   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
end MAT.Commands;

Use the console Error procedure to report an error message


-----------------------------------------------------------------------
--  awa-permissions-controllers -- Permission controllers
--  Copyright (C) 2011, 2012, 2013, 2014 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 ADO.Statements;

with Util.Log.Loggers;
with Util.Strings;

with AWA.Applications;
with AWA.Users.Principals;
with AWA.Permissions.Services;
with AWA.Services.Contexts;
package body AWA.Permissions.Controllers is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Permissions.Controllers");

   --  ------------------------------
   --  Returns true if the user associated with the security context <b>Context</b> has
   --  the permission to access a database entity.  The security context contains some
   --  information about the entity to check and the permission controller will use an
   --  SQL statement to verify the permission.
   --  ------------------------------
   overriding
   function Has_Permission (Handler : in Entity_Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      use AWA.Permissions.Services;
      use AWA.Users.Principals;
      use type ADO.Identifier;
      use type ADO.Entity_Type;

      Manager   : constant Permission_Manager_Access := Get_Permission_Manager (Context);
      User_Id   : constant ADO.Identifier := Get_User_Identifier (Context.Get_User_Principal);
      Entity_Id : ADO.Identifier;
   begin
      --  If there is no permission manager, permission is denied.
      if Manager = null or else User_Id = ADO.NO_IDENTIFIER then
         return False;
      end if;

      --  If the user is not logged, permission is denied.
      if Manager = null or else User_Id = ADO.NO_IDENTIFIER then
         Log.Info ("No user identifier in the security context.  Permission is denied");
         return False;
      end if;

      if not (Permission in Entity_Permission'Class) then
         Log.Info ("Permission denied because the entity is not given.");
         return False;
      end if;
      Entity_Id := Entity_Permission'Class (Permission).Entity;

      --  If the security context does not contain the entity identifier, permission is denied.
      if Entity_Id = ADO.NO_IDENTIFIER then
         Log.Info ("No entity identifier in the security context.  Permission is denied");
         return False;
      end if;

      declare
         function Get_Session return ADO.Sessions.Session;

         --  ------------------------------
         --  Get a database session from the AWA application.
         --  There is no guarantee that a AWA.Services.Contexts be available.
         --  But if we are within a service context, we must use the current session so
         --  that we are part of the current transaction.
         --  ------------------------------
         function Get_Session return ADO.Sessions.Session is
            package ASC renames AWA.Services.Contexts;
            use type ASC.Service_Context_Access;

            Ctx : constant ASC.Service_Context_Access := ASC.Current;
         begin
            if Ctx /= null then
               return AWA.Services.Contexts.Get_Session (Ctx);
            else
               return Manager.Get_Application.Get_Session;
            end if;
         end Get_Session;

         Session : constant ADO.Sessions.Session := Get_Session;
         Query   : ADO.Statements.Query_Statement := Session.Create_Statement (Handler.SQL);
         Result  : Integer;
      begin
         --  Build the query
         Query.Bind_Param (Name => "entity_id", Value => Entity_Id);
         Query.Bind_Param (Name => "user_id", Value => User_Id);
         if Handler.Entities (2) /= ADO.NO_ENTITY_TYPE then
            for I in Handler.Entities'Range loop
               exit when Handler.Entities (I) = ADO.NO_ENTITY_TYPE;
               Query.Bind_Param (Name  => "entity_type_" & Util.Strings.Image (I),
                                 Value => Handler.Entities (I));
            end loop;
         else
            Query.Bind_Param (Name => "entity_type", Value => Handler.Entities (1));
         end if;

         --  Run the query.  We must get a single row result and the value must be > 0.
         Query.Execute;

         Result := Query.Get_Result_Integer;
         if Result >= 0 and Query.Has_Elements then
            Log.Info ("Permission granted to {0} on entity {1}",
                      ADO.Identifier'Image (User_Id),
                      ADO.Identifier'Image (Entity_Id));
            return True;
         else
            Log.Info ("Permission denied to {0} on entity {1}",
                      ADO.Identifier'Image (User_Id),
                      ADO.Identifier'Image (Entity_Id));
            return False;
         end if;
      end;
   end Has_Permission;

end AWA.Permissions.Controllers;

-----------------------------------------------------------------------
--  awa-permissions-controllers -- Permission controllers
--  Copyright (C) 2011, 2012, 2013, 2014, 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 ADO.Sessions;
with ADO.Statements;

with Util.Log.Loggers;
with Util.Strings;

with AWA.Applications;
with AWA.Users.Principals;
with AWA.Permissions.Services;
with AWA.Services.Contexts;
package body AWA.Permissions.Controllers is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Permissions.Controllers");

   --  ------------------------------
   --  Returns true if the user associated with the security context <b>Context</b> has
   --  the permission to access a database entity.  The security context contains some
   --  information about the entity to check and the permission controller will use an
   --  SQL statement to verify the permission.
   --  ------------------------------
   overriding
   function Has_Permission (Handler : in Entity_Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      use AWA.Permissions.Services;
      use AWA.Users.Principals;
      use type ADO.Identifier;
      use type ADO.Entity_Type;

      Manager   : constant Permission_Manager_Access := Get_Permission_Manager (Context);
      User_Id   : constant ADO.Identifier := Get_User_Identifier (Context.Get_User_Principal);
      Entity_Id : ADO.Identifier;
   begin
      --  If there is no permission manager, permission is denied.
      if Manager = null or else User_Id = ADO.NO_IDENTIFIER then
         return False;
      end if;

      --  If the user is not logged, permission is denied.
      if Manager = null or else User_Id = ADO.NO_IDENTIFIER then
         Log.Info ("No user identifier in the security context.  Permission is denied");
         return False;
      end if;

      if not (Permission in Entity_Permission'Class) then
         Log.Info ("Permission {0} denied because the entity is not given.",
                   Security.Permissions.Permission_Index'Image (Permission.Id));
         return False;
      end if;
      Entity_Id := Entity_Permission'Class (Permission).Entity;

      --  If the security context does not contain the entity identifier, permission is denied.
      if Entity_Id = ADO.NO_IDENTIFIER then
         Log.Info ("No entity identifier in the security context.  Permission is denied");
         return False;
      end if;

      declare
         function Get_Session return ADO.Sessions.Session;

         --  ------------------------------
         --  Get a database session from the AWA application.
         --  There is no guarantee that a AWA.Services.Contexts be available.
         --  But if we are within a service context, we must use the current session so
         --  that we are part of the current transaction.
         --  ------------------------------
         function Get_Session return ADO.Sessions.Session is
            package ASC renames AWA.Services.Contexts;
            use type ASC.Service_Context_Access;

            Ctx : constant ASC.Service_Context_Access := ASC.Current;
         begin
            if Ctx /= null then
               return AWA.Services.Contexts.Get_Session (Ctx);
            else
               return Manager.Get_Application.Get_Session;
            end if;
         end Get_Session;

         Session : constant ADO.Sessions.Session := Get_Session;
         Query   : ADO.Statements.Query_Statement := Session.Create_Statement (Handler.SQL);
         Result  : Integer;
      begin
         --  Build the query
         Query.Bind_Param (Name => "entity_id", Value => Entity_Id);
         Query.Bind_Param (Name => "user_id", Value => User_Id);
         if Handler.Entities (2) /= ADO.NO_ENTITY_TYPE then
            for I in Handler.Entities'Range loop
               exit when Handler.Entities (I) = ADO.NO_ENTITY_TYPE;
               Query.Bind_Param (Name  => "entity_type_" & Util.Strings.Image (I),
                                 Value => Handler.Entities (I));
            end loop;
         else
            Query.Bind_Param (Name => "entity_type", Value => Handler.Entities (1));
         end if;

         --  Run the query.  We must get a single row result and the value must be > 0.
         Query.Execute;

         Result := Query.Get_Result_Integer;
         if Result >= 0 and Query.Has_Elements then
            Log.Info ("Permission granted to {0} on entity {1}",
                      ADO.Identifier'Image (User_Id),
                      ADO.Identifier'Image (Entity_Id));
            return True;
         else
            Log.Info ("Permission denied to {0} on entity {1}",
                      ADO.Identifier'Image (User_Id),
                      ADO.Identifier'Image (Entity_Id));
            return False;
         end if;
      end;
   end Has_Permission;

end AWA.Permissions.Controllers;

Add the permission id in the log message


-----------------------------------------------------------------------
--  wiki-render-text -- Wiki Text renderer
--  Copyright (C) 2011, 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.Characters.Conversions;
with Wiki.Filters.Html;
with Wiki.Helpers;
package body Wiki.Render.Text is

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Emit a new line.
   --  ------------------------------
   procedure New_Line (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end New_Line;

   --  ------------------------------
   --  Add a line break (<br>).
   --  ------------------------------
   procedure Add_Line_Break (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   procedure Add_Paragraph (Document : in out Text_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
      Document.Add_Line_Break;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Text_Renderer;
                             Level    : in Natural) is
   begin
      Document.Close_Paragraph;
      for I in 1 .. Level loop
         Document.Output.Write ("  ");
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Text_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Document : in out Text_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Language);
   begin
      Document.Open_Paragraph;
      if Length (Title) > 0 then
         Document.Output.Write (Title);
      end if;
      Document.Output.Write (Link);
      if Link /= Name then
         Document.Output.Write (Name);
      end if;
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Text_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
      if Length (Alt) > 0 then
         Document.Output.Write (Alt);
      end if;
      if Length (Description) > 0 then
         Document.Output.Write (Description);
      end if;
      Document.Output.Write (Link);
      Document.Empty_Line := False;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Document : in out Text_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Link, Language);
   begin
      Document.Open_Paragraph;
      Document.Output.Write (Quote);
      Document.Empty_Line := False;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Text_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Format);
   begin
      Document.Close_Paragraph;
      Document.Output.Write (Text);
      Document.Empty_Line := False;
   end Add_Preformatted;

   procedure Start_Element (Document   : in out Text_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      pragma Unreferenced (Attributes);
      use type Wiki.Filters.Html.Html_Tag_Type;

      Tag : constant Wiki.Filters.Html.Html_Tag_Type := Wiki.Filters.Html.Find_Tag (Name);
   begin
      if Tag = Wiki.Filters.Html.DT_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DD_TAG then
         Document.Close_Paragraph;
         Document.Empty_Line := True;
         Document.Indent_Level := 4;
      end if;
   end Start_Element;

   procedure End_Element (Document : in out Text_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
      use type Wiki.Filters.Html.Html_Tag_Type;

      Tag : constant Wiki.Filters.Html.Html_Tag_Type := Wiki.Filters.Html.Find_Tag (Name);
   begin
      if Tag = Wiki.Filters.Html.DT_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DD_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DL_TAG then
         Document.Close_Paragraph;
         Document.New_Line;
      end if;
   end End_Element;

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Close_Paragraph;
            if not Engine.Empty_Line then
               Engine.Add_Line_Break;
            end if;
            Engine.Output.Write (Node.Header);
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Output.Write ("---------------------------------------------------------");
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_TEXT =>
            if Engine.Empty_Line and Engine.Indent_Level /= 0 then
               for I in 1 .. Engine.Indent_Level loop
                  Engine.Output.Write (' ');
               end loop;
            end if;
            Engine.Output.Write (Node.Text);
            Engine.Empty_Line := False;

      end case;
   end Render;
--
   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Text_Renderer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

-----------------------------------------------------------------------
--  wiki-render-text -- Wiki Text renderer
--  Copyright (C) 2011, 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.Characters.Conversions;
with Wiki.Filters.Html;
with Wiki.Helpers;
package body Wiki.Render.Text is

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Emit a new line.
   --  ------------------------------
   procedure New_Line (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end New_Line;

   --  ------------------------------
   --  Add a line break (<br>).
   --  ------------------------------
   procedure Add_Line_Break (Document : in out Text_Renderer) is
   begin
      Document.Output.Write (Wiki.Helpers.LF);
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Text_Renderer;
                             Level    : in Natural) is
   begin
      Document.Close_Paragraph;
      for I in 1 .. Level loop
         Document.Output.Write ("  ");
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Text_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Renderer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Document : in out Text_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Language);
   begin
      Document.Open_Paragraph;
      if Length (Title) > 0 then
         Document.Output.Write (Title);
      end if;
      Document.Output.Write (Link);
      if Link /= Name then
         Document.Output.Write (Name);
      end if;
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Document    : in out Text_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
      if Length (Alt) > 0 then
         Document.Output.Write (Alt);
      end if;
      if Length (Description) > 0 then
         Document.Output.Write (Description);
      end if;
      Document.Output.Write (Link);
      Document.Empty_Line := False;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Document : in out Text_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Link, Language);
   begin
      Document.Open_Paragraph;
      Document.Output.Write (Quote);
      Document.Empty_Line := False;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Text_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Format);
   begin
      Document.Close_Paragraph;
      Document.Output.Write (Text);
      Document.Empty_Line := False;
   end Add_Preformatted;

   procedure Start_Element (Document   : in out Text_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      pragma Unreferenced (Attributes);
      use type Wiki.Filters.Html.Html_Tag_Type;

      Tag : constant Wiki.Filters.Html.Html_Tag_Type := Wiki.Filters.Html.Find_Tag (Name);
   begin
      if Tag = Wiki.Filters.Html.DT_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DD_TAG then
         Document.Close_Paragraph;
         Document.Empty_Line := True;
         Document.Indent_Level := 4;
      end if;
   end Start_Element;

   procedure End_Element (Document : in out Text_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
      use type Wiki.Filters.Html.Html_Tag_Type;

      Tag : constant Wiki.Filters.Html.Html_Tag_Type := Wiki.Filters.Html.Find_Tag (Name);
   begin
      if Tag = Wiki.Filters.Html.DT_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DD_TAG then
         Document.Close_Paragraph;
         Document.Indent_Level := 0;
      elsif Tag = Wiki.Filters.Html.DL_TAG then
         Document.Close_Paragraph;
         Document.New_Line;
      end if;
   end End_Element;

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Close_Paragraph;
            if not Engine.Empty_Line then
               Engine.Add_Line_Break;
            end if;
            Engine.Output.Write (Node.Header);
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Output.Write ("---------------------------------------------------------");
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;
            Engine.Add_Line_Break;

         when Wiki.Nodes.N_TEXT =>
            if Engine.Empty_Line and Engine.Indent_Level /= 0 then
               for I in 1 .. Engine.Indent_Level loop
                  Engine.Output.Write (' ');
               end loop;
            end if;
            Engine.Output.Write (Node.Text);
            Engine.Empty_Line := False;

      end case;
   end Render;
--
   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Text_Renderer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end Wiki.Render.Text;

Remove the Add_Paragraph procedure

Remove the Add_Paragraph procedure