------------------------------------------------------------------------------
-- Copyright (c) 2014-2019, 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.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Templates.Dates;
with Natools.Static_Maps.Web.Simple_Pages;
with Natools.Web.Error_Pages;
with Natools.Web.Exchanges;
with Natools.Web.Fallback_Render;

package body Natools.Web.Simple_Pages is

   Expiration_Date_Key : constant S_Expressions.Atom
     := S_Expressions.To_Atom ("!expire");
   Publication_Date_Key : constant S_Expressions.Atom
     := S_Expressions.To_Atom ("!publish");

   procedure Append
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Data : in S_Expressions.Atom);

   function Comment_Path_Override
     (Template : in Page_Template)
     return S_Expressions.Atom_Refs.Immutable_Reference;

   procedure Execute
     (Data : in out Page_Data;
      Context : in Page_Template;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Render
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Read_Page is new S_Expressions.Interpreter_Loop
     (Page_Data, Page_Template, Execute);

   procedure Render_Page is new S_Expressions.Interpreter_Loop
     (Sites.Exchange, Page_Data, Render, Append);

   ---------------------------
   -- Page Data Constructor --
   ---------------------------

   procedure Execute
     (Data : in out Page_Data;
      Context : in Page_Template;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      package Components renames Natools.Static_Maps.Web.Simple_Pages;
   begin
      case Components.To_Component (S_Expressions.To_String (Name)) is
         when Components.Error =>
            Log (Severities.Error, "Unknown page component """
              & S_Expressions.To_String (Name) & '"');

         when Components.Comment_List =>
            if Context.Comments.Is_Empty then
               Data.Comment_List.Set (Arguments);
            else
               declare
                  Template : S_Expressions.Caches.Cursor
                    := Context.Comments.Value;
               begin
                  Data.Comment_List.Set
                    (Template,
                     Arguments,
                     Comment_Path_Override (Context));
               end;
            end if;

         when Components.Dates =>
            Containers.Set_Dates (Data.Dates, Arguments);

         when Components.Elements =>
            Containers.Add_Expressions (Data.Elements, Arguments);

         when Components.Maps =>
            Data.Maps := String_Tables.Create (Arguments);

         when Components.Tags =>
            Tags.Append (Data.Tags, Arguments);
      end case;
   end Execute;

   -------------------
   -- Page Renderer --
   -------------------

   procedure Append
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Data : in S_Expressions.Atom)
   is
      pragma Unreferenced (Page);
   begin
      Exchange.Append (Data);
   end Append;

   procedure Render
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      use type S_Expressions.Events.Event;

      procedure Re_Enter
        (Exchange : in out Sites.Exchange;
         Expression : in out S_Expressions.Lockable.Descriptor'Class);

      procedure Render_Date (Log_Error : in Boolean);

      procedure Re_Enter
        (Exchange : in out Sites.Exchange;
         Expression : in out S_Expressions.Lockable.Descriptor'Class) is
      begin
         Render_Page (Expression, Exchange, Page);
      end Re_Enter;

      procedure Render_Date (Log_Error : in Boolean) is
      begin
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            declare
               Cursor : constant Containers.Date_Maps.Cursor
                 := Page.Dates.Find (Arguments.Current_Atom);
            begin
               if not Containers.Date_Maps.Has_Element (Cursor) then
                  if Log_Error then
                     Log (Severities.Error, "Unable to find date """
                       & S_Expressions.To_String (Arguments.Current_Atom)
                       & """ in page date map");
                  end if;

                  return;
               end if;

               Arguments.Next;

               declare
                  Item : constant Containers.Date
                    := Containers.Date_Maps.Element (Cursor);
               begin
                  S_Expressions.Templates.Dates.Render
                    (Exchange, Arguments, Item.Time, Item.Offset);
               end;
            end;
         end if;
      end Render_Date;

      package Commands renames Natools.Static_Maps.Web.Simple_Pages;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            Fallback_Render
              (Exchange, Name, Arguments,
               "simple page",
               Re_Enter'Access, Page.Elements);

         when Commands.Comment_List =>
            Comments.Render (Exchange, Page.Comment_List, Arguments);

         when Commands.Date =>
            Render_Date (True);

         when Commands.My_Tags =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               declare
                  Prefix : constant S_Expressions.Atom
                    := Arguments.Current_Atom;
               begin
                  Arguments.Next;
                  Tags.Render
                    (Exchange,
                     Page.Tags,
                     Exchange.Site.Get_Tags,
                     Prefix,
                     Arguments);
               end;
            end if;

         when Commands.If_No_Date =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom
              and then not Page.Dates.Contains (Arguments.Current_Atom)
            then
               Arguments.Next;
               Render_Page (Arguments, Exchange, Page);
            end if;

         when Commands.Maps =>
            String_Tables.Render (Exchange, Page.Maps, Arguments);

         when Commands.Optional_Date =>
            Render_Date (False);

         when Commands.Path =>
            Exchange.Append (Page.Web_Path.Query);

         when Commands.Tags =>
            Tags.Render
              (Exchange,
               Exchange.Site.Get_Tags,
               Arguments,
               Page.Tags);
      end case;
   end Render;

   -------------------------
   -- Page_Data Interface --
   -------------------------

   not overriding procedure Get_Element
     (Data : in Page_Data;
      Name : in S_Expressions.Atom;
      Element : out S_Expressions.Caches.Cursor;
      Found : out Boolean)
   is
      Cursor : constant Containers.Expression_Maps.Cursor
        := Data.Elements.Find (Name);
   begin
      Found := Containers.Expression_Maps.Has_Element (Cursor);

      if Found then
         Element := Containers.Expression_Maps.Element (Cursor);
      end if;
   end Get_Element;

   -----------------------------
   -- Page_Template Interface --
   -----------------------------

   function Comment_Path_Override
     (Template : in Page_Template)
     return S_Expressions.Atom_Refs.Immutable_Reference
   is
      use type S_Expressions.Atom;
   begin
      if Template.Comment_Path_Prefix.Is_Empty
        or else Template.Name.Is_Empty
      then
         return S_Expressions.Atom_Refs.Null_Immutable_Reference;
      else
         return S_Expressions.Atom_Ref_Constructors.Create
           (Template.Comment_Path_Prefix.Query
            & Template.Name.Query
            & (if Template.Comment_Path_Suffix.Is_Empty
               then S_Expressions.Null_Atom
               else Template.Comment_Path_Suffix.Query));
      end if;
   end Comment_Path_Override;

   procedure Set_Comments
     (Object : in out Page_Template;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Object.Comments
        := (Is_Empty => False,
            Value => S_Expressions.Caches.Conditional_Move (Expression));
   end Set_Comments;

   procedure Set_Comment_Path_Prefix
     (Object : in out Page_Template;
      Prefix : in S_Expressions.Atom) is
   begin
      if Prefix'Length > 0 then
         Object.Comment_Path_Prefix
           := S_Expressions.Atom_Ref_Constructors.Create (Prefix);
      else
         Object.Comment_Path_Prefix.Reset;
      end if;
   end Set_Comment_Path_Prefix;

   procedure Set_Comment_Path_Suffix
     (Object : in out Page_Template;
      Suffix : in S_Expressions.Atom) is
   begin
      if Suffix'Length > 0 then
         Object.Comment_Path_Suffix
           := S_Expressions.Atom_Ref_Constructors.Create (Suffix);
      else
         Object.Comment_Path_Suffix.Reset;
      end if;
   end Set_Comment_Path_Suffix;

   procedure Set_Elements
     (Object : in out Page_Template;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Containers.Set_Expressions (Object.Elements, Expression);
   end Set_Elements;

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

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class;
      Template : in Page_Template := Default_Template;
      Name : in S_Expressions.Atom := S_Expressions.Null_Atom)
     return Page_Ref
   is
      Page : constant Data_Refs.Data_Access := new Page_Data;
      Result : constant Page_Ref := (Ref => Data_Refs.Create (Page));
      Actual_Template : Page_Template := Template;
   begin
      Actual_Template.Name
        := (if Name'Length > 0
            then S_Expressions.Atom_Ref_Constructors.Create (Name)
            else S_Expressions.Atom_Refs.Null_Immutable_Reference);
      Page.Self := Tags.Visible_Access (Page);
      Page.Elements := Template.Elements;
      Read_Page (Expression, Page.all, Actual_Template);
      return Result;
   end Create;

   function Create
     (File_Path, Web_Path : in S_Expressions.Atom_Refs.Immutable_Reference;
      Template : in Page_Template := Default_Template;
      Name : in S_Expressions.Atom := S_Expressions.Null_Atom)
     return Page_Ref
   is
      Page : constant Data_Refs.Data_Access := new Page_Data'
        (File_Path => File_Path,
         Web_Path => Web_Path,
         Elements => Template.Elements,
         Tags => <>,
         Self => null,
         Comment_List | Dates | Maps => <>);
      Result : constant Page_Ref := (Ref => Data_Refs.Create (Page));
      Actual_Template : Page_Template := Template;
   begin
      Page.Self := Tags.Visible_Access (Page);
      Actual_Template.Name
        := (if Name'Length > 0
            then S_Expressions.Atom_Ref_Constructors.Create (Name)
            else S_Expressions.Atom_Refs.Null_Immutable_Reference);

      Create_Page :
      declare
         Reader : Natools.S_Expressions.File_Readers.S_Reader
           := Natools.S_Expressions.File_Readers.Reader
              (S_Expressions.To_String (File_Path.Query));
      begin
         Read_Page (Reader, Page.all, Actual_Template);
      end Create_Page;

      return Result;
   end Create;

   procedure Get_Lifetime
     (Page : in Page_Ref;
      Publication : out Ada.Calendar.Time;
      Has_Publication : out Boolean;
      Expiration : out Ada.Calendar.Time;
      Has_Expiration : out Boolean)
   is
      Accessor : constant Data_Refs.Accessor := Page.Ref.Query;
      Cursor : Containers.Date_Maps.Cursor;
   begin
      Cursor := Accessor.Dates.Find (Expiration_Date_Key);

      if Containers.Date_Maps.Has_Element (Cursor) then
         Has_Expiration := True;
         Expiration := Containers.Date_Maps.Element (Cursor).Time;
      else
         Has_Expiration := False;
      end if;

      Cursor := Accessor.Dates.Find (Publication_Date_Key);

      if Containers.Date_Maps.Has_Element (Cursor) then
         Has_Publication := True;
         Publication := Containers.Date_Maps.Element (Cursor).Time;
      else
         Has_Publication := False;
      end if;
   end Get_Lifetime;

   procedure Register
     (Page : in Page_Ref;
      Builder : in out Sites.Site_Builder;
      Path : in S_Expressions.Atom) is
   begin
      Time_Check :
      declare
         use type Ada.Calendar.Time;
         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Publication : Ada.Calendar.Time;
         Has_Publication : Boolean;
         Expiration : Ada.Calendar.Time;
         Has_Expiration : Boolean;
      begin
         Get_Lifetime
           (Page, Publication, Has_Publication, Expiration, Has_Expiration);

         if Has_Publication and then Publication >= Now then
            Sites.Expire_At (Builder, Publication);
            return;
         end if;

         if Has_Expiration then
            if Expiration < Now then
               return;
            else
               Sites.Expire_At (Builder, Expiration);
            end if;
         end if;
      end Time_Check;

      if Path'Length > 0 then
         Sites.Insert (Builder, Path, Page);
      end if;

      Sites.Insert (Builder, Page.Get_Tags, Page);

      Load_Comments :
      declare
         Mutator : constant Data_Refs.Mutator := Page.Ref.Update;
      begin
         Mutator.Comment_List.Load (Builder, Mutator.Self, Mutator.Web_Path);
      end Load_Comments;
   end Register;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Page_Ref;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Render_Page
        (Expression,
         Exchange,
         Object.Ref.Query.Data.all);
   end Render;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Page_Data;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Render_Page (Expression, Exchange, Object);
   end Render;

   overriding procedure Respond
     (Object : in out Page_Ref;
      Exchange : in out Sites.Exchange;
      Extra_Path : in S_Expressions.Atom)
   is
      use type S_Expressions.Offset;
   begin
      if Extra_Path'Length = 9
        and then S_Expressions.To_String (Extra_Path) = "/comments"
      then
         Object.Ref.Update.Comment_List.Respond
           (Exchange, Extra_Path (Extra_Path'First + 9 .. Extra_Path'Last));
         return;
      end if;

      if Extra_Path'Length > 0 then
         return;
      end if;

      declare
         Accessor : constant Data_Refs.Accessor := Object.Ref.Query;
         Expression : S_Expressions.Caches.Cursor;
      begin
         Check_Method :
         declare
            use Exchanges;
            Allowed : Boolean;
         begin
            Error_Pages.Check_Method
              (Exchange,
               (GET, HEAD),
               Allowed);

            if not Allowed then
               return;
            end if;
         end Check_Method;

         Expression := Exchange.Site.Get_Template
           (Accessor.Data.Elements,
            Expression,
            Exchange.Site.Default_Template,
            Lookup_Element => True,
            Lookup_Template => True,
            Lookup_Name => True);

         Render_Page (Expression, Exchange, Accessor.Data.all);
      end;
   end Respond;

   -----------------------
   -- Page Constructors --
   -----------------------

   function Create (File : in S_Expressions.Atom)
     return Sites.Page_Loader'Class is
   begin
      return Loader'(File_Path
        => S_Expressions.Atom_Ref_Constructors.Create (File));
   end Create;

   overriding procedure Load
     (Object : in out Loader;
      Builder : in out Sites.Site_Builder;
      Path : in S_Expressions.Atom)
   is
      Page : constant Page_Ref := Create
        (Object.File_Path,
         S_Expressions.Atom_Ref_Constructors.Create (Path));
   begin
      Register (Page, Builder, Path);
   end Load;

   procedure Register_Loader (Site : in out Sites.Site) is
   begin
      Site.Register ("simple-page", Create'Access);
   end Register_Loader;

end Natools.Web.Simple_Pages;

------------------------------------------------------------------------------
-- Copyright (c) 2014-2019, 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.Atom_Ref_Constructors;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Templates.Dates;
with Natools.Static_Maps.Web.Simple_Pages;
with Natools.Web.Error_Pages;
with Natools.Web.Exchanges;
with Natools.Web.Fallback_Render;

package body Natools.Web.Simple_Pages is

   Expiration_Date_Key : constant S_Expressions.Atom
     := S_Expressions.To_Atom ("!expire");
   Publication_Date_Key : constant S_Expressions.Atom
     := S_Expressions.To_Atom ("!publish");

   procedure Append
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Data : in S_Expressions.Atom);

   function Comment_Path_Override
     (Template : in Page_Template;
      Override : in S_Expressions.Lockable.Descriptor'Class)
     return S_Expressions.Atom_Refs.Immutable_Reference;

   procedure Execute
     (Data : in out Page_Data;
      Context : in Page_Template;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Render
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Read_Page is new S_Expressions.Interpreter_Loop
     (Page_Data, Page_Template, Execute);

   procedure Render_Page is new S_Expressions.Interpreter_Loop
     (Sites.Exchange, Page_Data, Render, Append);

   ---------------------------
   -- Page Data Constructor --
   ---------------------------

   procedure Execute
     (Data : in out Page_Data;
      Context : in Page_Template;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      package Components renames Natools.Static_Maps.Web.Simple_Pages;
   begin
      case Components.To_Component (S_Expressions.To_String (Name)) is
         when Components.Error =>
            Log (Severities.Error, "Unknown page component """
              & S_Expressions.To_String (Name) & '"');

         when Components.Comment_List =>
            if Context.Comments.Is_Empty then
               Data.Comment_List.Set (Arguments);
            else
               declare
                  Template : S_Expressions.Caches.Cursor
                    := Context.Comments.Value;
               begin
                  Data.Comment_List.Set
                    (Template,
                     Arguments,
                     Comment_Path_Override (Context, Arguments));
               end;
            end if;

         when Components.Dates =>
            Containers.Set_Dates (Data.Dates, Arguments);

         when Components.Elements =>
            Containers.Add_Expressions (Data.Elements, Arguments);

         when Components.Maps =>
            Data.Maps := String_Tables.Create (Arguments);

         when Components.Tags =>
            Tags.Append (Data.Tags, Arguments);
      end case;
   end Execute;

   -------------------
   -- Page Renderer --
   -------------------

   procedure Append
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Data : in S_Expressions.Atom)
   is
      pragma Unreferenced (Page);
   begin
      Exchange.Append (Data);
   end Append;

   procedure Render
     (Exchange : in out Sites.Exchange;
      Page : in Page_Data;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      use type S_Expressions.Events.Event;

      procedure Re_Enter
        (Exchange : in out Sites.Exchange;
         Expression : in out S_Expressions.Lockable.Descriptor'Class);

      procedure Render_Date (Log_Error : in Boolean);

      procedure Re_Enter
        (Exchange : in out Sites.Exchange;
         Expression : in out S_Expressions.Lockable.Descriptor'Class) is
      begin
         Render_Page (Expression, Exchange, Page);
      end Re_Enter;

      procedure Render_Date (Log_Error : in Boolean) is
      begin
         if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
            declare
               Cursor : constant Containers.Date_Maps.Cursor
                 := Page.Dates.Find (Arguments.Current_Atom);
            begin
               if not Containers.Date_Maps.Has_Element (Cursor) then
                  if Log_Error then
                     Log (Severities.Error, "Unable to find date """
                       & S_Expressions.To_String (Arguments.Current_Atom)
                       & """ in page date map");
                  end if;

                  return;
               end if;

               Arguments.Next;

               declare
                  Item : constant Containers.Date
                    := Containers.Date_Maps.Element (Cursor);
               begin
                  S_Expressions.Templates.Dates.Render
                    (Exchange, Arguments, Item.Time, Item.Offset);
               end;
            end;
         end if;
      end Render_Date;

      package Commands renames Natools.Static_Maps.Web.Simple_Pages;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            Fallback_Render
              (Exchange, Name, Arguments,
               "simple page",
               Re_Enter'Access, Page.Elements);

         when Commands.Comment_List =>
            Comments.Render (Exchange, Page.Comment_List, Arguments);

         when Commands.Date =>
            Render_Date (True);

         when Commands.My_Tags =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               declare
                  Prefix : constant S_Expressions.Atom
                    := Arguments.Current_Atom;
               begin
                  Arguments.Next;
                  Tags.Render
                    (Exchange,
                     Page.Tags,
                     Exchange.Site.Get_Tags,
                     Prefix,
                     Arguments);
               end;
            end if;

         when Commands.If_No_Date =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom
              and then not Page.Dates.Contains (Arguments.Current_Atom)
            then
               Arguments.Next;
               Render_Page (Arguments, Exchange, Page);
            end if;

         when Commands.Maps =>
            String_Tables.Render (Exchange, Page.Maps, Arguments);

         when Commands.Optional_Date =>
            Render_Date (False);

         when Commands.Path =>
            Exchange.Append (Page.Web_Path.Query);

         when Commands.Tags =>
            Tags.Render
              (Exchange,
               Exchange.Site.Get_Tags,
               Arguments,
               Page.Tags);
      end case;
   end Render;

   -------------------------
   -- Page_Data Interface --
   -------------------------

   not overriding procedure Get_Element
     (Data : in Page_Data;
      Name : in S_Expressions.Atom;
      Element : out S_Expressions.Caches.Cursor;
      Found : out Boolean)
   is
      Cursor : constant Containers.Expression_Maps.Cursor
        := Data.Elements.Find (Name);
   begin
      Found := Containers.Expression_Maps.Has_Element (Cursor);

      if Found then
         Element := Containers.Expression_Maps.Element (Cursor);
      end if;
   end Get_Element;

   -----------------------------
   -- Page_Template Interface --
   -----------------------------

   function Comment_Path_Override
     (Template : in Page_Template;
      Override : in S_Expressions.Lockable.Descriptor'Class)
     return S_Expressions.Atom_Refs.Immutable_Reference
   is
      use type S_Expressions.Atom;
      use type S_Expressions.Events.Event;
      Name_Override : constant Boolean
        := Override.Current_Event = S_Expressions.Events.Add_Atom;
      Name : constant S_Expressions.Atom
        := (if Name_Override then Override.Current_Atom
            elsif not Template.Name.Is_Empty then Template.Name.Query
            else S_Expressions.Null_Atom);
   begin
      if Template.Comment_Path_Prefix.Is_Empty
        or else (not Name_Override and then Template.Name.Is_Empty)
      then
         return S_Expressions.Atom_Refs.Null_Immutable_Reference;
      else
         return S_Expressions.Atom_Ref_Constructors.Create
           (Template.Comment_Path_Prefix.Query
            & Name
            & (if Template.Comment_Path_Suffix.Is_Empty
               then S_Expressions.Null_Atom
               else Template.Comment_Path_Suffix.Query));
      end if;
   end Comment_Path_Override;

   procedure Set_Comments
     (Object : in out Page_Template;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Object.Comments
        := (Is_Empty => False,
            Value => S_Expressions.Caches.Conditional_Move (Expression));
   end Set_Comments;

   procedure Set_Comment_Path_Prefix
     (Object : in out Page_Template;
      Prefix : in S_Expressions.Atom) is
   begin
      if Prefix'Length > 0 then
         Object.Comment_Path_Prefix
           := S_Expressions.Atom_Ref_Constructors.Create (Prefix);
      else
         Object.Comment_Path_Prefix.Reset;
      end if;
   end Set_Comment_Path_Prefix;

   procedure Set_Comment_Path_Suffix
     (Object : in out Page_Template;
      Suffix : in S_Expressions.Atom) is
   begin
      if Suffix'Length > 0 then
         Object.Comment_Path_Suffix
           := S_Expressions.Atom_Ref_Constructors.Create (Suffix);
      else
         Object.Comment_Path_Suffix.Reset;
      end if;
   end Set_Comment_Path_Suffix;

   procedure Set_Elements
     (Object : in out Page_Template;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Containers.Set_Expressions (Object.Elements, Expression);
   end Set_Elements;

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

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class;
      Template : in Page_Template := Default_Template;
      Name : in S_Expressions.Atom := S_Expressions.Null_Atom)
     return Page_Ref
   is
      Page : constant Data_Refs.Data_Access := new Page_Data;
      Result : constant Page_Ref := (Ref => Data_Refs.Create (Page));
      Actual_Template : Page_Template := Template;
   begin
      Actual_Template.Name
        := (if Name'Length > 0
            then S_Expressions.Atom_Ref_Constructors.Create (Name)
            else S_Expressions.Atom_Refs.Null_Immutable_Reference);
      Page.Self := Tags.Visible_Access (Page);
      Page.Elements := Template.Elements;
      Read_Page (Expression, Page.all, Actual_Template);
      return Result;
   end Create;

   function Create
     (File_Path, Web_Path : in S_Expressions.Atom_Refs.Immutable_Reference;
      Template : in Page_Template := Default_Template;
      Name : in S_Expressions.Atom := S_Expressions.Null_Atom)
     return Page_Ref
   is
      Page : constant Data_Refs.Data_Access := new Page_Data'
        (File_Path => File_Path,
         Web_Path => Web_Path,
         Elements => Template.Elements,
         Tags => <>,
         Self => null,
         Comment_List | Dates | Maps => <>);
      Result : constant Page_Ref := (Ref => Data_Refs.Create (Page));
      Actual_Template : Page_Template := Template;
   begin
      Page.Self := Tags.Visible_Access (Page);
      Actual_Template.Name
        := (if Name'Length > 0
            then S_Expressions.Atom_Ref_Constructors.Create (Name)
            else S_Expressions.Atom_Refs.Null_Immutable_Reference);

      Create_Page :
      declare
         Reader : Natools.S_Expressions.File_Readers.S_Reader
           := Natools.S_Expressions.File_Readers.Reader
              (S_Expressions.To_String (File_Path.Query));
      begin
         Read_Page (Reader, Page.all, Actual_Template);
      end Create_Page;

      return Result;
   end Create;

   procedure Get_Lifetime
     (Page : in Page_Ref;
      Publication : out Ada.Calendar.Time;
      Has_Publication : out Boolean;
      Expiration : out Ada.Calendar.Time;
      Has_Expiration : out Boolean)
   is
      Accessor : constant Data_Refs.Accessor := Page.Ref.Query;
      Cursor : Containers.Date_Maps.Cursor;
   begin
      Cursor := Accessor.Dates.Find (Expiration_Date_Key);

      if Containers.Date_Maps.Has_Element (Cursor) then
         Has_Expiration := True;
         Expiration := Containers.Date_Maps.Element (Cursor).Time;
      else
         Has_Expiration := False;
      end if;

      Cursor := Accessor.Dates.Find (Publication_Date_Key);

      if Containers.Date_Maps.Has_Element (Cursor) then
         Has_Publication := True;
         Publication := Containers.Date_Maps.Element (Cursor).Time;
      else
         Has_Publication := False;
      end if;
   end Get_Lifetime;

   procedure Register
     (Page : in Page_Ref;
      Builder : in out Sites.Site_Builder;
      Path : in S_Expressions.Atom) is
   begin
      Time_Check :
      declare
         use type Ada.Calendar.Time;
         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Publication : Ada.Calendar.Time;
         Has_Publication : Boolean;
         Expiration : Ada.Calendar.Time;
         Has_Expiration : Boolean;
      begin
         Get_Lifetime
           (Page, Publication, Has_Publication, Expiration, Has_Expiration);

         if Has_Publication and then Publication >= Now then
            Sites.Expire_At (Builder, Publication);
            return;
         end if;

         if Has_Expiration then
            if Expiration < Now then
               return;
            else
               Sites.Expire_At (Builder, Expiration);
            end if;
         end if;
      end Time_Check;

      if Path'Length > 0 then
         Sites.Insert (Builder, Path, Page);
      end if;

      Sites.Insert (Builder, Page.Get_Tags, Page);

      Load_Comments :
      declare
         Mutator : constant Data_Refs.Mutator := Page.Ref.Update;
      begin
         Mutator.Comment_List.Load (Builder, Mutator.Self, Mutator.Web_Path);
      end Load_Comments;
   end Register;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Page_Ref;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Render_Page
        (Expression,
         Exchange,
         Object.Ref.Query.Data.all);
   end Render;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Page_Data;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Render_Page (Expression, Exchange, Object);
   end Render;

   overriding procedure Respond
     (Object : in out Page_Ref;
      Exchange : in out Sites.Exchange;
      Extra_Path : in S_Expressions.Atom)
   is
      use type S_Expressions.Offset;
   begin
      if Extra_Path'Length = 9
        and then S_Expressions.To_String (Extra_Path) = "/comments"
      then
         Object.Ref.Update.Comment_List.Respond
           (Exchange, Extra_Path (Extra_Path'First + 9 .. Extra_Path'Last));
         return;
      end if;

      if Extra_Path'Length > 0 then
         return;
      end if;

      declare
         Accessor : constant Data_Refs.Accessor := Object.Ref.Query;
         Expression : S_Expressions.Caches.Cursor;
      begin
         Check_Method :
         declare
            use Exchanges;
            Allowed : Boolean;
         begin
            Error_Pages.Check_Method
              (Exchange,
               (GET, HEAD),
               Allowed);

            if not Allowed then
               return;
            end if;
         end Check_Method;

         Expression := Exchange.Site.Get_Template
           (Accessor.Data.Elements,
            Expression,
            Exchange.Site.Default_Template,
            Lookup_Element => True,
            Lookup_Template => True,
            Lookup_Name => True);

         Render_Page (Expression, Exchange, Accessor.Data.all);
      end;
   end Respond;

   -----------------------
   -- Page Constructors --
   -----------------------

   function Create (File : in S_Expressions.Atom)
     return Sites.Page_Loader'Class is
   begin
      return Loader'(File_Path
        => S_Expressions.Atom_Ref_Constructors.Create (File));
   end Create;

   overriding procedure Load
     (Object : in out Loader;
      Builder : in out Sites.Site_Builder;
      Path : in S_Expressions.Atom)
   is
      Page : constant Page_Ref := Create
        (Object.File_Path,
         S_Expressions.Atom_Ref_Constructors.Create (Path));
   begin
      Register (Page, Builder, Path);
   end Load;

   procedure Register_Loader (Site : in out Sites.Site) is
   begin
      Site.Register ("simple-page", Create'Access);
   end Register_Loader;

end Natools.Web.Simple_Pages;

simple_pages: add support for comment name override in templated paths


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

procedure Evaluate is

   Ctx    : EL.Contexts.Default.Default_Context;
   E      : EL.Expressions.Expression;
   Result : EL.Objects.Object;
begin
   E := EL.Expressions.Create_Expression ("#{1 + (2 - 3) * 4}", Ctx);
   Result := E.Get_Value (Ctx);
   Ada.Text_IO.Put_Line ("Result: " & EL.Objects.To_String (Result));
end Evaluate;

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

procedure Evaluate is
   Expr   : constant String := "#{1 + (2 - 3) * 4}";
   Ctx    : EL.Contexts.Default.Default_Context;
   E      : EL.Expressions.Expression;
   Result : EL.Objects.Object;
begin
   Ada.Text_IO.Put_Line ("Evaluate: " & Expr);
   E := EL.Expressions.Create_Expression (Expr, Ctx);
   Result := E.Get_Value (Ctx);
   Ada.Text_IO.Put_Line ("Result: " & EL.Objects.To_String (Result));
end Evaluate;

Print the expression being evaluated

Print the expression being evaluated


-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  Copyright (C) 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|proprietary] [--web] [--tool] [--ado] "
                & "NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the GNU license or");
      Put_Line ("  a proprietary license. The author's name and email addresses");
      Put_Line ("  are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
   end Help;

end Gen.Commands.Project;

-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  Copyright (C) 2011, 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with GNAT.OS_Lib;

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
      Gtk_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado -gtk") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            elsif Full_Switch = "-gtk" then
               Gtk_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag and not Gtk_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Gen.Commands.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Gen.Commands.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Property ("is_gtk", Boolean'Image (Gtk_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         elsif Gtk_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-gtk");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|proprietary] [--web] [--tool] [--ado] "
                & "[--gtk] NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the GNU license or");
      Put_Line ("  a proprietary license. The author's name and email addresses");
      Put_Line ("  are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
      Put_Line ("  --gtk   Generate a GtkAda project");
   end Help;

end Gen.Commands.Project;

Add option --gtk to create a Gtk Ada application


------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with NRF51_SVD.GPIO; use NRF51_SVD.GPIO;

package body nRF51.GPIO is

   ---------
   -- Set --
   ---------

   overriding function Set
     (This : GPIO_Point)
      return Boolean
   is
   begin
      return GPIO_Periph.OUT_k.Arr (This.Pin) = High;
   end Set;

   ---------
   -- Set --
   ---------

   overriding procedure Set
     (This : in out GPIO_Point)
   is
   begin
      GPIO_Periph.OUTSET.Arr (This.Pin) := Set;
   end Set;

   -----------
   -- Clear --
   -----------

   overriding procedure Clear
     (This : in out GPIO_Point)
   is
   begin
      GPIO_Periph.OUTCLR.Arr (This.Pin) := Clear;
   end Clear;

   ------------
   -- Toggle --
   ------------

   overriding procedure Toggle
     (This : in out GPIO_Point)
   is
   begin
      if This.Set then
         This.Clear;
      else
         This.Set;
      end if;
   end Toggle;

   ------------------
   -- Configure_IO --
   ------------------

   procedure Configure_IO
     (This   : GPIO_Point;
      Config : GPIO_Configuration)
   is
      CNF : PIN_CNF_Register renames GPIO_Periph.PIN_CNF (This.Pin);
   begin
      CNF.DIR := (case Config.Mode is
                     when Mode_In  => Input,
                     when Mode_Out => Output);

      CNF.INPUT := (case Config.Input_Buffer is
                       when Input_Buffer_Connect    => Connect,
                       when Input_Buffer_Disconnect => Disconnect);

      CNF.PULL := (case Config.Resistors is
                      when No_Pull   => Disabled,
                      when Pull_Up   => Pullup,
                      when Pull_Down => Pulldown);

      CNF.DRIVE := (case Config.Drive is
                       when Drive_S0S1 => S0S1,
                       when Drive_H0S1 => H0S1,
                       when Drive_S0H1 => S0H1,
                       when Drive_H0H1 => H0H1,
                       when Drive_D0S1 => D0S1,
                       when Drive_D0H1 => D0H1,
                       when Drive_S0D1 => S0D1,
                       when Drive_H0D1 => H0D1);

      CNF.SENSE := (case Config.Sense is
                       when Sense_Disabled       => Disabled,
                       when Sense_For_High_Level => High,
                       when Sense_For_Low_Level  => Low);
   end Configure_IO;

end nRF51.GPIO;

------------------------------------------------------------------------------
--                                                                          --
--                       Copyright (C) 2016, AdaCore                        --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with NRF51_SVD.GPIO; use NRF51_SVD.GPIO;

package body nRF51.GPIO is

   ---------
   -- Set --
   ---------

   overriding function Set
     (This : GPIO_Point)
      return Boolean
   is
   begin
      return GPIO_Periph.OUT_k.Arr (This.Pin) = High;
   end Set;

   ---------
   -- Set --
   ---------

   overriding procedure Set
     (This : in out GPIO_Point)
   is
   begin
      GPIO_Periph.OUT_k.Arr (This.Pin) := High;
   end Set;

   -----------
   -- Clear --
   -----------

   overriding procedure Clear
     (This : in out GPIO_Point)
   is
   begin
      GPIO_Periph.OUT_k.Arr (This.Pin) := Low;
   end Clear;

   ------------
   -- Toggle --
   ------------

   overriding procedure Toggle
     (This : in out GPIO_Point)
   is
   begin
      if This.Set then
         This.Clear;
      else
         This.Set;
      end if;
   end Toggle;

   ------------------
   -- Configure_IO --
   ------------------

   procedure Configure_IO
     (This   : GPIO_Point;
      Config : GPIO_Configuration)
   is
      CNF : PIN_CNF_Register renames GPIO_Periph.PIN_CNF (This.Pin);
   begin
      CNF.DIR := (case Config.Mode is
                     when Mode_In  => Input,
                     when Mode_Out => Output);

      CNF.INPUT := (case Config.Input_Buffer is
                       when Input_Buffer_Connect    => Connect,
                       when Input_Buffer_Disconnect => Disconnect);

      CNF.PULL := (case Config.Resistors is
                      when No_Pull   => Disabled,
                      when Pull_Up   => Pullup,
                      when Pull_Down => Pulldown);

      CNF.DRIVE := (case Config.Drive is
                       when Drive_S0S1 => S0S1,
                       when Drive_H0S1 => H0S1,
                       when Drive_S0H1 => S0H1,
                       when Drive_H0H1 => H0H1,
                       when Drive_D0S1 => D0S1,
                       when Drive_D0H1 => D0H1,
                       when Drive_S0D1 => S0D1,
                       when Drive_H0D1 => H0D1);

      CNF.SENSE := (case Config.Sense is
                       when Sense_Disabled       => Disabled,
                       when Sense_For_High_Level => High,
                       when Sense_For_Low_Level  => Low);
   end Configure_IO;

end nRF51.GPIO;

Fix GPIO Set and Clear

nRF51: Fix GPIO Set and Clear


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

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with ASF.Contexts.Faces;
with ASF.Contexts.Faces.Mockup;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Questions.Modules;
with AWA.Questions.Beans;
with AWA.Votes.Beans;
with AWA.Tests.Helpers.Users;
package body AWA.Questions.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Questions.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Save_Question",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Delete_Question",
                       Test_Delete_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Queries question-list",
                       Test_List_Questions'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean",
                       Test_Question_Vote'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean (anonymous user)",
                       Test_Question_Vote'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Module;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I append strings in Ada?");
      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                        & "I also tried '.' without success.  What should I do?");
      T.Manager.Save_Question (Q);

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                         & "I also tried '.' without success.  What should I do? "
                         & "This is a stupid question for someone who reads this file. "
                         & "But I need some long text for the unit test.");
      T.Manager.Save_Question (Q);
   end Test_Create_Question;

   --  ------------------------------
   --  Test deletion of a question.
   --  ------------------------------
   procedure Test_Delete_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Module;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I search strings in Ada?");
      Q.Set_Description ("I have two strings that I want to search.  % does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      T.Manager.Delete_Question (Q);
   end Test_Delete_Question;

   --  ------------------------------
   --  Test list of questions.
   --  ------------------------------
   procedure Test_List_Questions (T : in out Test) is
      use AWA.Questions.Models;
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Module    : AWA.Questions.Modules.Question_Module_Access;
      List      : Util.Beans.Basic.Readonly_Bean_Access;
      Bean      : Util.Beans.Objects.Object;
      Count     : Natural;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);
      Module := AWA.Questions.Modules.Get_Question_Module;
      List := AWA.Questions.Beans.Create_Question_List_Bean (Module);
      T.Assert (List /= null, "The Create_Question_List_Bean returned null");

      Bean := Util.Beans.Objects.To_Object (List);
      T.Assert (not Util.Beans.Objects.Is_Null (Bean), "The list bean should not be null");
      Count := Questions.Models.Question_Info_List_Bean'Class (List.all).Get_Count;

      T.Assert (Count > 0, "The list of question is empty");
   end Test_List_Questions;

   --  ------------------------------
   --  Do a vote on a question through the question vote bean.
   --  ------------------------------
   procedure Do_Vote (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Context : ASF.Contexts.Faces.Mockup.Mockup_Faces_Context;
      Outcome : Ada.Strings.Unbounded.Unbounded_String;
      Bean    : Util.Beans.Basic.Readonly_Bean_Access;
      Vote    : AWA.Votes.Beans.Vote_Bean_Access;
   begin
      Context.Set_Parameter ("id", "1");
      Bean := Context.Get_Bean ("questionVote");
      T.Assert (Bean /= null, "The questionVote bean was not created");

      T.Assert (Bean.all in AWA.Votes.Beans.Vote_Bean'Class,
                "The questionVote is not a Vote_Bean");

      Vote := AWA.Votes.Beans.Vote_Bean (Bean.all)'Access;
      Vote.Rating    := 1;
      Vote.Entity_Id := 1;
      Vote.Vote_Up (Outcome);
   end Do_Vote;

   --  ------------------------------
   --  Test anonymous user voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote_Anonymous (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);

      Do_Vote (T);
      T.Fail ("Anonymous users should not be allowed to vote");

   exception
      when AWA.Permissions.NO_PERMISSION =>
         null;
   end Test_Question_Vote_Anonymous;

   --  ------------------------------
   --  Test voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-voter@test.com");

      Do_Vote (T);
   end Test_Question_Vote;

end AWA.Questions.Modules.Tests;

-----------------------------------------------------------------------
--  awa-questions-modules-tests -- Unit tests for storage service
--  Copyright (C) 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 Ada.Strings.Unbounded;

with Util.Test_Caller;
with Util.Beans.Basic;
with Util.Beans.Objects;

with Security.Contexts;

with ASF.Contexts.Faces;
with ASF.Contexts.Faces.Mockup;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Questions.Modules;
with AWA.Questions.Beans;
with AWA.Votes.Beans;
with AWA.Tests.Helpers.Users;
package body AWA.Questions.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Questions.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Save_Question",
                       Test_Create_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Services.Delete_Question",
                       Test_Delete_Question'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Queries question-list",
                       Test_List_Questions'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean",
                       Test_Question_Vote'Access);
      Caller.Add_Test (Suite, "Test AWA.Questions.Beans questionVote bean (anonymous user)",
                       Test_Question_Vote'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a question.
   --  ------------------------------
   procedure Test_Create_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Module;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I append strings in Ada?");
      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                        & "I also tried '.' without success.  What should I do?");
      T.Manager.Save_Question (Q);

      Q.Set_Description ("I have two strings that I want to concatenate.  + does not work. "
                         & "I also tried '.' without success.  What should I do? "
                         & "This is a stupid question for someone who reads this file. "
                         & "But I need some long text for the unit test.");
      T.Manager.Save_Question (Q);
   end Test_Create_Question;

   --  ------------------------------
   --  Test deletion of a question.
   --  ------------------------------
   procedure Test_Delete_Question (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Q         : AWA.Questions.Models.Question_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Manager := AWA.Questions.Modules.Get_Question_Module;
      T.Assert (T.Manager /= null, "There is no question manager");

      Q.Set_Title ("How can I search strings in Ada?");
      Q.Set_Description ("I have two strings that I want to search.  % does not work.");
      T.Manager.Save_Question (Q);
      T.Assert (Q.Is_Inserted, "The new question was not inserted");

      T.Manager.Delete_Question (Q);
   end Test_Delete_Question;

   --  ------------------------------
   --  Test list of questions.
   --  ------------------------------
   procedure Test_List_Questions (T : in out Test) is
      use AWA.Questions.Models;
      use AWA.Questions.Beans;
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Module    : AWA.Questions.Modules.Question_Module_Access;
      List      : Util.Beans.Basic.Readonly_Bean_Access;
      Bean      : Util.Beans.Objects.Object;
      Count     : Natural;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);
      Module := AWA.Questions.Modules.Get_Question_Module;
      List := AWA.Questions.Beans.Create_Question_List_Bean (Module);
      T.Assert (List /= null, "The Create_Question_List_Bean returned null");

      Bean := Util.Beans.Objects.To_Object (List);
      T.Assert (not Util.Beans.Objects.Is_Null (Bean), "The list bean should not be null");
      T.Assert (List.all in Questions.Beans.Question_List_Bean'Class,
                "The Create_Question_List_Bean returns an invalid bean");
      Count := Questions.Beans.Question_List_Bean'Class (List.all).Questions.Get_Count;

      T.Assert (Count > 0, "The list of question is empty");
   end Test_List_Questions;

   --  ------------------------------
   --  Do a vote on a question through the question vote bean.
   --  ------------------------------
   procedure Do_Vote (T : in out Test) is
      use type Util.Beans.Basic.Readonly_Bean_Access;

      Context : ASF.Contexts.Faces.Mockup.Mockup_Faces_Context;
      Outcome : Ada.Strings.Unbounded.Unbounded_String;
      Bean    : Util.Beans.Basic.Readonly_Bean_Access;
      Vote    : AWA.Votes.Beans.Vote_Bean_Access;
   begin
      Context.Set_Parameter ("id", "1");
      Bean := Context.Get_Bean ("questionVote");
      T.Assert (Bean /= null, "The questionVote bean was not created");

      T.Assert (Bean.all in AWA.Votes.Beans.Vote_Bean'Class,
                "The questionVote is not a Vote_Bean");

      Vote := AWA.Votes.Beans.Vote_Bean (Bean.all)'Access;
      Vote.Rating    := 1;
      Vote.Entity_Id := 1;
      Vote.Vote_Up (Outcome);
   end Do_Vote;

   --  ------------------------------
   --  Test anonymous user voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote_Anonymous (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Anonymous (Context, Sec_Ctx);

      Do_Vote (T);
      T.Fail ("Anonymous users should not be allowed to vote");

   exception
      when AWA.Permissions.NO_PERMISSION =>
         null;
   end Test_Question_Vote_Anonymous;

   --  ------------------------------
   --  Test voting for a question.
   --  ------------------------------
   procedure Test_Question_Vote (T : in out Test) is
      Sec_Ctx : Security.Contexts.Security_Context;
      Context : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-voter@test.com");

      Do_Vote (T);
   end Test_Question_Vote;

end AWA.Questions.Modules.Tests;

Fix the unit test after changes in the bean definitions


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

--  The `Lifecycles` package provides a listener interface dedicated to
--  track lifecycle managements on objects.  It defines a set of procedures to be
--  notified when an object is created, updated or deleted.
generic
   type Element_Type (<>) is limited private;
package Util.Listeners.Lifecycles is

   --  ------------------------------
   --  Lifecycle listener
   --  ------------------------------
   type Listener is limited interface and Util.Listeners.Listener;

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   procedure On_Create (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   procedure On_Update (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   procedure On_Delete (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been created (calls `On_Create`).
   procedure Notify_Create (List : in Util.Listeners.List;
                            Item : in Element_Type);

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been updated (calls `On_Update`).
   procedure Notify_Update (List : in Util.Listeners.List;
                            Item : in Element_Type);

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been deleted (calls `On_Delete`).
   procedure Notify_Delete (List : in Util.Listeners.List;
                            Item : in Element_Type);

end Util.Listeners.Lifecycles;

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

--  The `Lifecycles` package provides a listener interface dedicated to
--  track lifecycle managements on objects.  It defines a set of procedures to be
--  notified when an object is created, updated or deleted.
--
--  Notes: another implementation can be made by using three different listener lists
--  that use the simple observer pattern.
generic
   type Element_Type (<>) is limited private;
package Util.Listeners.Lifecycles is

   --  ------------------------------
   --  Lifecycle listener
   --  ------------------------------
   type Listener is limited interface and Util.Listeners.Listener;

   --  The `On_Create` procedure is called by `Notify_Create` to notify the creation of the item.
   procedure On_Create (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  The `On_Update` procedure is called by `Notify_Update` to notify the update of the item.
   procedure On_Update (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  The `On_Delete` procedure is called by `Notify_Delete` to notify the deletion of the item.
   procedure On_Delete (Instance : in Listener;
                        Item     : in Element_Type) is abstract;

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been created (calls `On_Create`).
   procedure Notify_Create (List : in Util.Listeners.List;
                            Item : in Element_Type);

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been updated (calls `On_Update`).
   procedure Notify_Update (List : in Util.Listeners.List;
                            Item : in Element_Type);

   --  Inform the the lifecycle listeners registered in `List` that the item passed in `Item`
   --  has been deleted (calls `On_Delete`).
   procedure Notify_Delete (List : in Util.Listeners.List;
                            Item : in Element_Type);

end Util.Listeners.Lifecycles;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  awa-permissions-beans -- Permission beans
--  Copyright (C) 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 ADO.Utils;
with ADO.Sessions;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Events.Action_Method;
with AWA.Permissions.Services;

package body AWA.Permissions.Beans is

   use Ada.Strings.Unbounded;

   package ASC renames AWA.Services.Contexts;

   package Create_Binding is
     new AWA.Events.Action_Method.Bind (Bean   => Permission_Bean,
                                        Method => Create,
                                        Name   => "create");

   Permission_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Permission_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_id" then
         From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_type" then
         From.Kind := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Permission_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Permission_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create a new permission.
   --  ------------------------------
   procedure Create (Bean    : in out Permission_Bean;
                     Event   : in AWA.Events.Module_Event'Class) is
      Ctx      : constant ASC.Service_Context_Access := ASC.Current;
      DB       : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Kind     : ADO.Entity_Type;
   begin
      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, To_String (Bean.Kind));
      AWA.Permissions.Services.Add_Permission (Session    => DB,
                                               Entity     => Bean.Get_Entity_Id,
                                               Kind       => Kind,
                                               User       => Ctx.Get_User_Identifier);
      Ctx.Commit;
   end Create;

   --  ------------------------------
   --  Create the permission bean instance.
   --  ------------------------------
   function Create_Permission_Bean return Util.Beans.Basic.Readonly_Bean_Access is
   begin
      return new Permission_Bean;
   end Create_Permission_Bean;

end AWA.Permissions.Beans;

-----------------------------------------------------------------------
--  awa-permissions-beans -- Permission beans
--  Copyright (C) 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 ADO.Utils;
with ADO.Sessions;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Events.Action_Method;
with AWA.Permissions.Services;

package body AWA.Permissions.Beans is

   use Ada.Strings.Unbounded;

   package ASC renames AWA.Services.Contexts;

   package Create_Binding is
     new AWA.Events.Action_Method.Bind (Bean   => Permission_Bean,
                                        Method => Create,
                                        Name   => "create");

   Permission_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Permission_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_id" then
         From.Set_Entity_Id (ADO.Utils.To_Identifier (Value));
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "entity_type" then
         From.Kind := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  This bean provides some methods that can be used in a Method_Expression
   --  ------------------------------
   overriding
   function Get_Method_Bindings (From : in Permission_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Permission_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create a new permission.
   --  ------------------------------
   procedure Create (Bean    : in out Permission_Bean;
                     Event   : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Event);

      Ctx      : constant ASC.Service_Context_Access := ASC.Current;
      DB       : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Kind     : ADO.Entity_Type;
   begin
      Ctx.Start;
      Kind := ADO.Sessions.Entities.Find_Entity_Type (DB, To_String (Bean.Kind));
      AWA.Permissions.Services.Add_Permission (Session    => DB,
                                               Entity     => Bean.Get_Entity_Id,
                                               Kind       => Kind,
                                               User       => Ctx.Get_User_Identifier);
      Ctx.Commit;
   end Create;

   --  ------------------------------
   --  Create the permission bean instance.
   --  ------------------------------
   function Create_Permission_Bean return Util.Beans.Basic.Readonly_Bean_Access is
   begin
      return new Permission_Bean;
   end Create_Permission_Bean;

end AWA.Permissions.Beans;

Fix compilation warnings

Fix compilation warnings


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

with Util.Properties;
with Util.Beans.Objects;

with EL.Contexts;
package EL.Utils is

   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class);

   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String;

   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object;

   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object;

end EL.Utils;

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

with Util.Properties;
with Util.Beans.Objects;

with EL.Contexts;
package EL.Utils is

   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class);
   procedure Expand (Config  : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class);

   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String;

   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object;

   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object;

end EL.Utils;

Add Expand procedure to expand the properties in place (small optimization)