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

with ASF.Events.Faces.Actions;

with ADO.Utils;
with ADO.Sessions.Entities;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   package ASC renames AWA.Services.Contexts;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "inviter" then
         return From.Inviter.Get_Value ("name");
      else
         return AWA.Workspaces.Models.Invitation_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean,
                                   Inviter    => Bean.Inviter);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Accept_Invitation (Key => Ada.Strings.Unbounded.To_String (Bean.Key));
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Send_Invitation (Bean);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

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

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (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 Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Workspaces_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" then
         return Util.Beans.Objects.To_Object (Value   => From.Members_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Workspaces.Models.Member_List_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Master_Session := Into.Module.Get_Master_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
      WS          : AWA.Workspaces.Models.Workspace_Ref;
   begin
      AWA.Workspaces.Modules.Get_Workspace (Session, Ctx, WS);
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
--        ADO.Sessions.Entities.Bind_Param (Params  => Query,
--                                          Name    => "page_table",
--                                          Table   => AWA.Wikis.Models.WIKI_PAGE_TABLE,
--                                          Session => Session);
      Query.Bind_Param (Name => "user_id", Value => User);
      Query.Bind_Param (Name => "workspace_id", Value => WS.Get_Id);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "workspace_id", Value => WS.Get_Id);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

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

with ASF.Events.Faces.Actions;

with ADO.Utils;
with ADO.Sessions.Entities;
with ADO.Sessions;
with ADO.Queries;
with ADO.Datasets;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Events.Action_Method;
with AWA.Services.Contexts;
package body AWA.Workspaces.Beans is

   package ASC renames AWA.Services.Contexts;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Member_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      return AWA.Workspaces.Models.Member_Bean (From).Get_Value (Name);
   end Get_Value;

   overriding
   procedure Load (Bean : in out Member_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Load;

   overriding
   procedure Delete (Bean : in out Member_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Delete_Member (Bean.Get_Id);
   end Delete;

   --  ------------------------------
   --  Create the Member_Bean bean instance.
   --  ------------------------------
   function Create_Member_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_Bean_Access := new Member_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Member_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Invitation_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "inviter" then
         return From.Inviter.Get_Value ("name");
      else
         return AWA.Workspaces.Models.Invitation_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Load_Invitation (Key        => Ada.Strings.Unbounded.To_String (Bean.Key),
                                   Invitation => Bean,
                                   Inviter    => Bean.Inviter);

   exception
      when others =>
         Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("not-found");
   end Load;

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Accept_Invitation (Key => Ada.Strings.Unbounded.To_String (Bean.Key));
   end Accept_Invitation;

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Send_Invitation (Bean);
   end Send;

   --  ------------------------------
   --  Create the Invitation_Bean bean instance.
   --  ------------------------------
   function Create_Invitation_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Invitation_Bean_Access := new Invitation_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Invitation_Bean;

   --  ------------------------------
   --  Example of action method.
   --  ------------------------------
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Action;

   --  ------------------------------
   --  Event action called to create the workspace when the given event is posted.
   --  ------------------------------
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class) is
      pragma Unreferenced (Bean, Event);

      WS  : AWA.Workspaces.Models.Workspace_Ref;
      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (Session   => DB,
                                            Context   => Ctx,
                                            Workspace => WS);
      Ctx.Commit;
   end Create;

   package Action_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Workspaces_Bean,
                                                      Method => Action,
                                                      Name   => "action");

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

   Workspaces_Bean_Binding : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Action_Binding.Proxy'Access, Create_Binding.Proxy'Access);

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Workspaces_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (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 Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
      pragma Unreferenced (From);
   begin
      return Workspaces_Bean_Binding'Access;
   end Get_Method_Bindings;

   --  ------------------------------
   --  Create the Workspaces_Bean bean instance.
   --  ------------------------------
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Workspaces_Bean_Access := new Workspaces_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Workspaces_Bean;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Member_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "members" then
         return Util.Beans.Objects.To_Object (Value   => From.Members_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Workspaces.Models.Member_List_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Load the list of members.
   --  ------------------------------
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Session     : ADO.Sessions.Session := Into.Module.Get_Session;
      Query       : ADO.Queries.Context;
      Count_Query : ADO.Queries.Context;
      First       : constant Natural  := (Into.Page - 1) * Into.Page_Size;
   begin
      Query.Set_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
      Count_Query.Set_Count_Query (AWA.Workspaces.Models.Query_Workspace_Member_List);
--        ADO.Sessions.Entities.Bind_Param (Params  => Query,
--                                          Name    => "page_table",
--                                          Table   => AWA.Wikis.Models.WIKI_PAGE_TABLE,
--                                          Session => Session);
      Query.Bind_Param (Name => "user_id", Value => User);
      Count_Query.Bind_Param (Name => "user_id", Value => User);
      AWA.Workspaces.Models.List (Into.Members, Session, Query);
      Into.Count := ADO.Datasets.Get_Count (Session, Count_Query);
   end Load;

   --  ------------------------------
   --  Create the Member_List_Bean bean instance.
   --  ------------------------------
   function Create_Member_List_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access is
      Object  : constant Member_List_Bean_Access := new Member_List_Bean;
   begin
      Object.Module     := Module;
      Object.Members_Bean := Object.Members'Access;
      Object.Page_Size  := 20;
      Object.Page       := 1;
      Object.Count      := 0;
      return Object.all'Access;
   end Create_Member_List_Bean;

end AWA.Workspaces.Beans;

Implement the Create_Member_Bean and operations for the Member_Bean type


-----------------------------------------------------------------------
--  Util.Concurrent.Fifos -- Concurrent Fifo Queues
--  Copyright (C) 2012, 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.Unchecked_Deallocation;
package body Util.Concurrent.Fifos is

   --  ------------------------------
   --  Put the element in the queue.
   --  ------------------------------
   procedure Enqueue (Into    : in out Fifo;
                      Item    : in Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         Into.Buffer.Enqueue (Item);
      else
         select
            Into.Buffer.Enqueue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Get an element from the queue.
   --  Wait until one element gets available.
   --  ------------------------------
   procedure Dequeue (From    : in out Fifo;
                      Item    : out Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         From.Buffer.Dequeue (Item);
      else
         select
            From.Buffer.Dequeue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Get the number of elements in the queue.
   --  ------------------------------
   function Get_Count (From : in Fifo) return Natural is
   begin
      return From.Buffer.Get_Count;
   end Get_Count;

   --  ------------------------------
   --  Set the queue size.
   --  ------------------------------
   procedure Set_Size (Into : in out Fifo;
                       Capacity : in Positive) is
   begin
      Into.Buffer.Set_Size (Capacity);
   end Set_Size;

   --  ------------------------------
   --  Initializes the queue.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out Fifo) is
   begin
      Object.Buffer.Set_Size (Default_Size);
   end Initialize;

   --  ------------------------------
   --  Release the queue elements.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Fifo) is
   begin
      if Clear_On_Dequeue then
         while Object.Get_Count > 0 loop
            declare
               Unused : Element_Type;
            begin
               Object.Dequeue (Unused);
            end;
         end loop;
      end if;
      Object.Buffer.Set_Size (0);
   end Finalize;

   --  Queue of objects.
   protected body Protected_Fifo is

      --  ------------------------------
      --  Put the element in the queue.
      --  If the queue is full, wait until some room is available.
      --  ------------------------------
      entry Enqueue (Item : in Element_Type) when Count < Elements'Length is
      begin
         Elements (Last) := Item;
         Last := Last + 1;
         if Last > Elements'Last then
            if Clear_On_Dequeue then
               Last := Elements'First + 1;
            else
               Last := Elements'First;
            end if;
         end if;
         Count := Count + 1;
      end Enqueue;

      --  ------------------------------
      --  Get an element from the queue.
      --  Wait until one element gets available.
      --  ------------------------------
      entry Dequeue (Item : out Element_Type) when Count > 0 is
      begin
         Count := Count - 1;
         Item := Elements (First);

         --  For the clear on dequeue mode, erase the queue element.
         --  If the element holds some storage or a reference, this gets cleared here.
         --  The element used to clear is at index 0 (which does not exist if Clear_On_Dequeue
         --  is false).  There is no overhead when this is not used
         --  (ie, instantiation/compile time flag).
         if Clear_On_Dequeue then
            Elements (First) := Elements (0);
         end if;
         First := First + 1;
         if First > Elements'Last then
            if Clear_On_Dequeue then
               First := Elements'First + 1;
            else
               First := Elements'First;
            end if;
         end if;
      end Dequeue;

      --  ------------------------------
      --  Get the number of elements in the queue.
      --  ------------------------------
      function Get_Count return Natural is
      begin
         return Count;
      end Get_Count;

      --  ------------------------------
      --  Set the queue size.
      --  ------------------------------
      procedure Set_Size (Capacity : in Natural) is
         procedure Free is new Ada.Unchecked_Deallocation (Element_Array, Element_Array_Access);
         First_Pos : Natural := 1;
      begin
         if Clear_On_Dequeue then
            First_Pos := 0;
         end if;
         if Capacity = 0 then
            Free (Elements);
         elsif Elements = null then
            Elements := new Element_Array (First_Pos .. Capacity);
         else
            declare
               New_Array : constant Element_Array_Access := new Element_Array (First_Pos .. Capacity);
            begin
               if Capacity > Elements'Length then
                  New_Array (First_Pos .. Elements'Last) := Elements (First_Pos .. Elements'Last);
               else
                  New_Array (First_Pos .. Capacity) := Elements (First_Pos .. Capacity);
               end if;

               Free (Elements);
               Elements := New_Array;
            end;
         end if;
      end Set_Size;

   end Protected_Fifo;

end Util.Concurrent.Fifos;

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

with Ada.Unchecked_Deallocation;
package body Util.Concurrent.Fifos is

   --  ------------------------------
   --  Put the element in the queue.
   --  ------------------------------
   procedure Enqueue (Into    : in out Fifo;
                      Item    : in Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         Into.Buffer.Enqueue (Item);
      else
         select
            Into.Buffer.Enqueue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Get an element from the queue.
   --  Wait until one element gets available.
   --  ------------------------------
   procedure Dequeue (From    : in out Fifo;
                      Item    : out Element_Type;
                      Wait    : in Duration := FOREVER) is
   begin
      if Wait < 0.0 then
         From.Buffer.Dequeue (Item);
      else
         select
            From.Buffer.Dequeue (Item);
         or
            delay Wait;
            raise Timeout;
         end select;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Get the number of elements in the queue.
   --  ------------------------------
   function Get_Count (From : in Fifo) return Natural is
   begin
      return From.Buffer.Get_Count;
   end Get_Count;

   --  ------------------------------
   --  Set the queue size.
   --  ------------------------------
   procedure Set_Size (Into : in out Fifo;
                       Capacity : in Positive) is
   begin
      Into.Buffer.Set_Size (Capacity);
   end Set_Size;

   --  ------------------------------
   --  Initializes the queue.
   --  ------------------------------
   overriding
   procedure Initialize (Object : in out Fifo) is
   begin
      Object.Buffer.Set_Size (Default_Size);
   end Initialize;

   --  ------------------------------
   --  Release the queue elements.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Fifo) is
   begin
      if Clear_On_Dequeue then
         while Object.Get_Count > 0 loop
            declare
               Unused : Element_Type;
            begin
               Object.Dequeue (Unused);
            end;
         end loop;
      end if;
      Object.Buffer.Set_Size (0);
   end Finalize;

   --  Queue of objects.
   protected body Protected_Fifo is

      --  ------------------------------
      --  Put the element in the queue.
      --  If the queue is full, wait until some room is available.
      --  ------------------------------
      entry Enqueue (Item : in Element_Type) when Count < Elements'Length is
      begin
         Elements (Last) := Item;
         Last := Last + 1;
         if Last > Elements'Last then
            if Clear_On_Dequeue then
               Last := Elements'First + 1;
            else
               Last := Elements'First;
            end if;
         end if;
         Count := Count + 1;
      end Enqueue;

      --  ------------------------------
      --  Get an element from the queue.
      --  Wait until one element gets available.
      --  ------------------------------
      entry Dequeue (Item : out Element_Type) when Count > 0 is
      begin
         Count := Count - 1;
         Item := Elements (First);

         --  For the clear on dequeue mode, erase the queue element.
         --  If the element holds some storage or a reference, this gets cleared here.
         --  The element used to clear is at index 0 (which does not exist if Clear_On_Dequeue
         --  is false).  There is no overhead when this is not used
         --  (ie, instantiation/compile time flag).
         if Clear_On_Dequeue then
            Elements (First) := Elements (0);
         end if;
         First := First + 1;
         if First > Elements'Last then
            if Clear_On_Dequeue then
               First := Elements'First + 1;
            else
               First := Elements'First;
            end if;
         end if;
      end Dequeue;

      --  ------------------------------
      --  Get the number of elements in the queue.
      --  ------------------------------
      function Get_Count return Natural is
      begin
         return Count;
      end Get_Count;

      --  ------------------------------
      --  Set the queue size.
      --  ------------------------------
      procedure Set_Size (Capacity : in Natural) is
         procedure Free is new Ada.Unchecked_Deallocation (Element_Array, Element_Array_Access);
         First_Pos : Natural := 1;
      begin
         if Clear_On_Dequeue then
            First_Pos := 0;
         end if;
         if Capacity = 0 then
            Free (Elements);
         elsif Elements = null then
            Elements := new Element_Array (First_Pos .. Capacity);
         else
            declare
               New_Array : constant Element_Array_Access
                 := new Element_Array (First_Pos .. Capacity);
            begin
               if Capacity > Elements'Length then
                  New_Array (First_Pos .. Elements'Last) := Elements (First_Pos .. Elements'Last);
               else
                  New_Array (First_Pos .. Capacity) := Elements (First_Pos .. Capacity);
               end if;

               Free (Elements);
               Elements := New_Array;
            end;
         end if;
      end Set_Size;

   end Protected_Fifo;

end Util.Concurrent.Fifos;

Fix compilation style warning

Fix compilation style warning


-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 2011, 2012, 2013, 2014, 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 Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Blogs.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Comment => False,
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              URI     => "testing-blog-title",
                              Text    => "The new post content",
                              Comment => True,
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 URI     => "testing-blog-title",
                                 Comment => True,
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 2011, 2012, 2013, 2014, 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 Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Blogs.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Comment => False,
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              URI     => "testing-blog-title",
                              Text    => "The new post content",
                              Publish_Date => ADO.Nullable_Time '(Is_Null => True, others => <>),
                              Comment => True,
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 URI     => "testing-blog-title",
                                 Publish_Date => ADO.Nullable_Time '(Is_Null => True, others => <>),
                                 Comment => True,
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

Update the unit test for publication date


-----------------------------------------------------------------------
--  awa-wikis-modules-tests -- Unit tests for wikis service
--  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 Util.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Wikis.Modules");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

   end Test_Create_Wiki_Content;

   --  ------------------------------
   --  Test getting the wiki page as well as info, history pages.
   --  ------------------------------
   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage", "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage", "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent", "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid", "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

end AWA.Wikis.Modules.Tests;

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

with Util.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "Wikis.Modules");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Update_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

   end Test_Create_Wiki_Content;

   --  ------------------------------
   --  Test getting the wiki page as well as info, history pages.
   --  ------------------------------
   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage", "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage", "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent", "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid", "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

   --  ------------------------------
   --  Test updating the wiki page through a POST request.
   --  ------------------------------
   procedure Test_Update_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Blog Title");
      Request.Set_Parameter ("page-id", Pub_Ident);
      Request.Set_Parameter ("page-wiki-id", Ident);
      Request.Set_Parameter ("name", "NewPageName");
      Request.Set_Parameter ("page-title", "New Page Title");
      Request.Set_Parameter ("text", "== Title ==" & ASCII.LF & "A paragraph" & ASCII.LF
                             & "[[http://mylink.com|Link]]" & ASCII.LF
                             & "[[Image:my-image.png|My Picture]]" & ASCII.LF
                             & "== Last header ==" & ASCII.LF);
      Request.Set_Parameter ("comment", "Update through test post simulation");
      Request.Set_Parameter ("page-is-public", "TRUE");
      Request.Set_Parameter ("wiki-format", "FORMAT_MEDIAWIKI");
      Request.Set_Parameter ("qtags[1]", "Test-Tag");
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/edit/" & Ident & "/PublicPage",
                         "update-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki update");
       declare
         Result : constant String
            := AWA.Tests.Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/");
      begin
         Util.Tests.Assert_Equals (T, Ident & "/NewPageName", Result,
                                   "The page name was not updated");

         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Result, "wiki-public-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (NewPageName)");
         Assert_Matches (T, ".*Last header.*", Reply,
                         "Last header is present in the response",
                         Status => ASF.Responses.SC_OK);

         ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/"
                           & Pub_Ident, "wiki-info-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (info NewPageName)");
         Assert_Matches (T, ".*wiki-image-name.*my-image.png.*", Reply,
                         "The info page must list the image",
                         Status => ASF.Responses.SC_OK);
      end;
   end Test_Update_Page;

end AWA.Wikis.Modules.Tests;

Implement the Test_Update_Page to check updating a page using a POST request and verify the view and info result page


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

with Ada.Strings.Unbounded;

with Util.Test_Caller;

with Gen.Configs;
with Gen.Generator;
package body Gen.Artifacts.Yaml.Tests is

   use Ada.Strings.Unbounded;

   package Caller is new Util.Test_Caller (Test, "Gen.Yaml");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Gen.Yaml.Read_Model",
                       Test_Read_Yaml'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the YAML files defines in regression tests.
   --  ------------------------------
   procedure Test_Read_Yaml (T : in out Test) is

      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      Path  : constant String := Util.Tests.Get_Path ("regtests/files/users.yaml");
      Model : Gen.Model.Packages.Model_Definition;
      Iter  : Gen.Model.Packages.Package_Cursor;
      Cnt   : Natural := 0;
   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_Model (Path, Model, G);

      Iter := Model.First;
      while Gen.Model.Packages.Has_Element (Iter) loop
         Cnt := Cnt + 1;
         Gen.Model.Packages.Next (Iter);
      end loop;
      Util.Tests.Assert_Equals (T, 1, Cnt, "Missing some packages");
   end Test_Read_Yaml;

end Gen.Artifacts.Yaml.Tests;

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

with Ada.Strings.Unbounded;

with Util.Test_Caller;

with Gen.Generator;
package body Gen.Artifacts.Yaml.Tests is

   package Caller is new Util.Test_Caller (Test, "Gen.Yaml");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Gen.Yaml.Read_Model",
                       Test_Read_Yaml'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the YAML files defines in regression tests.
   --  ------------------------------
   procedure Test_Read_Yaml (T : in out Test) is

      A : Artifact;
      G : Gen.Generator.Handler;
      C : constant String := Util.Tests.Get_Parameter ("config_dir", "config");

      Path  : constant String := Util.Tests.Get_Path ("regtests/files/users.yaml");
      Model : Gen.Model.Packages.Model_Definition;
      Iter  : Gen.Model.Packages.Package_Cursor;
      Cnt   : Natural := 0;
   begin
      Gen.Generator.Initialize (G, Ada.Strings.Unbounded.To_Unbounded_String (C), False);
      A.Read_Model (Path, Model, G);

      Iter := Model.First;
      while Gen.Model.Packages.Has_Element (Iter) loop
         Cnt := Cnt + 1;
         Gen.Model.Packages.Next (Iter);
      end loop;
      Util.Tests.Assert_Equals (T, 1, Cnt, "Missing some packages");
   end Test_Read_Yaml;

end Gen.Artifacts.Yaml.Tests;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  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 ASF.Components.Html.Forms;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer;

package ASF.Components.Widgets.Inputs is

   use ASF.Contexts.Faces;
   use ASF.Contexts.Writer;

   --  ------------------------------
   --  Input component
   --  ------------------------------
   --  The AWA input component overrides the ASF input component to build a compact component
   --  that displays a label, the input field and the associated error message if necessary.
   --
   --  The generated HTML looks like:
   --
   --

   --
title required

   --
<input type='text' ...>
   --        message
   --

   --

   type UIInput is new ASF.Components.Html.Forms.UIInput with null record;
   type UIInput_Access is access all UIInput'Class;

   --  Render the input field title.
   procedure Render_Title (UI      : in UIInput;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class);

   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class);

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class);

end ASF.Components.Widgets.Inputs;

-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  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 Util.Beans.Objects;
with Util.Beans.Basic;

with ASF.Components.Html.Forms;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer;
with ASF.Events.Faces;

package ASF.Components.Widgets.Inputs is

   use ASF.Contexts.Faces;
   use ASF.Contexts.Writer;

   --  ------------------------------
   --  Input component
   --  ------------------------------
   --  The AWA input component overrides the ASF input component to build a compact component
   --  that displays a label, the input field and the associated error message if necessary.
   --
   --  The generated HTML looks like:
   --
   --

   --
title required

   --
<input type='text' ...>
   --        message
   --

   --

   type UIInput is new ASF.Components.Html.Forms.UIInput with null record;
   type UIInput_Access is access all UIInput'Class;

   --  Render the input field title.
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class);

   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class);

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class);

   --  ------------------------------
   --  The auto complete component.
   --  ------------------------------
   --
   type UIComplete is new UIInput with private;
   type UIComplete_Access is access all UIInput'Class;

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class);
   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class);

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class);

private

   type UIComplete is new UIInput with record
      Match_Value : Util.Beans.Objects.Object;
   end record;

end ASF.Components.Widgets.Inputs;

Define the UIComplete component to provide autocomplete feature of input fields


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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 Orka.SIMD.SSE.Singles;

package Orka.SIMD.SSE2.Integers.Convert is
   pragma Pure;

   use SIMD.SSE.Singles;

   function Convert (Elements : m128) return m128i
     with Import, Convention => Intrinsic, External_Name => "__builtin_ia32_cvtps2dq";

   function Convert (Elements : m128i) return m128
     with Import, Convention => Intrinsic, External_Name => "__builtin_ia32_cvtdq2ps";

end Orka.SIMD.SSE2.Integers.Convert;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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 Orka.SIMD.SSE.Singles.Arithmetic;
with Orka.SIMD.SSE2.Integers.Shift;

package Orka.SIMD.SSE2.Integers.Convert is
   pragma Pure;

   use SIMD.SSE.Singles;
   use SIMD.SSE.Singles.Arithmetic;
   use SIMD.SSE2.Integers.Shift;

   function Convert (Elements : m128) return m128i
     with Import, Convention => Intrinsic, External_Name => "__builtin_ia32_cvtps2dq";

   function Convert (Elements : m128i) return m128
     with Import, Convention => Intrinsic, External_Name => "__builtin_ia32_cvtdq2ps";

   Smallest_Elements : constant m128 := (others => 2.0**(-24));

   function To_Unit_Floats (Elements : m128i) return m128 is
     (Convert (Shift_Bits_Right_Zeros (Elements, 8)) * Smallest_Elements)
   with Inline;
   --  Return floating-point numbers in the 0 .. 1 interval

end Orka.SIMD.SSE2.Integers.Convert;

simd: Add function to convert Unsigned_32s to Float_32s in range 0 .. 1

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


-----------------------------------------------------------------------
--  widgets-factory -- Factory for widget Components
--  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 ASF.Views.Nodes;
with ASF.Components.Base;
with ASF.Components.Widgets.Inputs;
with ASF.Components.Widgets.Gravatars;
with ASF.Components.Widgets.Likes;
with ASF.Components.Widgets.Panels;

package body ASF.Components.Widgets.Factory is

   use ASF.Components.Base;

   function Create_Input return UIComponent_Access;
   function Create_Input_Date return UIComponent_Access;
   function Create_Complete return UIComponent_Access;
   function Create_Gravatar return UIComponent_Access;
   function Create_Like return UIComponent_Access;
   function Create_Panel return UIComponent_Access;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input_Date return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInputDate;
   end Create_Input_Date;

   --  ------------------------------
   --  Create a UIComplete component
   --  ------------------------------
   function Create_Complete return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIComplete;
   end Create_Complete;

   --  ------------------------------
   --  Create a UIGravatar component
   --  ------------------------------
   function Create_Gravatar return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Gravatars.UIGravatar;
   end Create_Gravatar;

   --  ------------------------------
   --  Create a UILike component
   --  ------------------------------
   function Create_Like return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Likes.UILike;
   end Create_Like;

   --  ------------------------------
   --  Create a UIPanel component
   --  ------------------------------
   function Create_Panel return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Panels.UIPanel;
   end Create_Panel;

   use ASF.Views.Nodes;

   URI              : aliased constant String := "http://code.google.com/p/ada-asf/widget";
   AUTOCOMPLETE_TAG : aliased constant String := "autocomplete";
   INPUT_DATE_TAG   : aliased constant String := "inputDate";
   INPUT_TEXT_TAG   : aliased constant String := "inputText";
   GRAVATAR_TAG     : aliased constant String := "gravatar";
   LIKE_TAG         : aliased constant String := "like";
   PANEL_TAG        : aliased constant String := "panel";

   Widget_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => AUTOCOMPLETE_TAG'Access,
               Component => Create_Complete'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => INPUT_DATE_TAG'Access,
               Component => Create_Input_Date'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => GRAVATAR_TAG'Access,
               Component => Create_Gravatar'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LIKE_TAG'Access,
               Component => Create_Like'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => PANEL_TAG'Access,
               Component => Create_Panel'Access,
               Tag       => Create_Component_Node'Access)
        );

   Core_Factory : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Widget_Bindings'Access);

   --  ------------------------------
   --  Get the widget component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Core_Factory'Access;
   end Definition;

end ASF.Components.Widgets.Factory;

-----------------------------------------------------------------------
--  widgets-factory -- Factory for widget Components
--  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 ASF.Views.Nodes;
with ASF.Components.Base;
with ASF.Components.Widgets.Inputs;
with ASF.Components.Widgets.Gravatars;
with ASF.Components.Widgets.Likes;
with ASF.Components.Widgets.Panels;
with ASF.Components.Widgets.Tabs;

package body ASF.Components.Widgets.Factory is

   use ASF.Components.Base;

   function Create_Input return UIComponent_Access;
   function Create_Input_Date return UIComponent_Access;
   function Create_Complete return UIComponent_Access;
   function Create_Gravatar return UIComponent_Access;
   function Create_Like return UIComponent_Access;
   function Create_Panel return UIComponent_Access;
   function Create_TabView return UIComponent_Access;
   function Create_Tab return UIComponent_Access;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create a UIInput component
   --  ------------------------------
   function Create_Input_Date return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIInputDate;
   end Create_Input_Date;

   --  ------------------------------
   --  Create a UIComplete component
   --  ------------------------------
   function Create_Complete return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Inputs.UIComplete;
   end Create_Complete;

   --  ------------------------------
   --  Create a UIGravatar component
   --  ------------------------------
   function Create_Gravatar return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Gravatars.UIGravatar;
   end Create_Gravatar;

   --  ------------------------------
   --  Create a UILike component
   --  ------------------------------
   function Create_Like return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Likes.UILike;
   end Create_Like;

   --  ------------------------------
   --  Create a UIPanel component
   --  ------------------------------
   function Create_Panel return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Panels.UIPanel;
   end Create_Panel;

   --  ------------------------------
   --  Create a UITab component
   --  ------------------------------
   function Create_Tab return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Tabs.UITab;
   end Create_Tab;

   --  ------------------------------
   --  Create a UITabView component
   --  ------------------------------
   function Create_TabView return UIComponent_Access is
   begin
      return new ASF.Components.Widgets.Tabs.UITabView;
   end Create_TabView;

   use ASF.Views.Nodes;

   URI              : aliased constant String := "http://code.google.com/p/ada-asf/widget";
   AUTOCOMPLETE_TAG : aliased constant String := "autocomplete";
   INPUT_DATE_TAG   : aliased constant String := "inputDate";
   INPUT_TEXT_TAG   : aliased constant String := "inputText";
   GRAVATAR_TAG     : aliased constant String := "gravatar";
   LIKE_TAG         : aliased constant String := "like";
   PANEL_TAG        : aliased constant String := "panel";
   TAB_TAG          : aliased constant String := "tab";
   TAB_VIEW_TAG     : aliased constant String := "tabView";

   Widget_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => AUTOCOMPLETE_TAG'Access,
               Component => Create_Complete'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => INPUT_DATE_TAG'Access,
               Component => Create_Input_Date'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => GRAVATAR_TAG'Access,
               Component => Create_Gravatar'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LIKE_TAG'Access,
               Component => Create_Like'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => PANEL_TAG'Access,
               Component => Create_Panel'Access,
               Tag       => Create_Component_Node'Access),
         7 => (Name      => TAB_TAG'Access,
               Component => Create_Tab'Access,
               Tag       => Create_Component_Node'Access),
         8 => (Name      => TAB_VIEW_TAG'Access,
               Component => Create_TabView'Access,
               Tag       => Create_Component_Node'Access)
        );

   Core_Factory : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Widget_Bindings'Access);

   --  ------------------------------
   --  Get the widget component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Core_Factory'Access;
   end Definition;

end ASF.Components.Widgets.Factory;

Add the new <w:tab> and <w:tabView> components in the factory