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

with Util.Strings;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers",
                                                    Util.Log.WARN_LEVEL);

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node : Mapper_Access := From.First_Child;
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Node.Next_Mapping := Result;
            return;
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping {0} for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      Copy (Node, Map.First_Child);
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      return Result;
   end Clone;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

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

with Util.Strings;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers",
                                                    Util.Log.WARN_LEVEL);

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node : Mapper_Access := From.First_Child;
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Node.Next_Mapping := Result;
            return;
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping {0} for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Map.First_Child /= null then
         Copy (Node, Map.First_Child);
      else
         Node.Mapper := Map;
      end if;
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      return Result;
   end Clone;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

Fix serialization mapping for vectors - when adding a vector mapping, do not copy the mapping but set the mapper to the vector mapping


-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Variable_Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Variable_Maps.Element (Item));
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
         end if;
         First := Last;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

end Wiki.Filters.Variables;

-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean;

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Variable_Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Variable_Maps.Element (Item));
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
         end if;
         First := Last;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

   --  ------------------------------
   --  Iterate over the filter variables.
   --  ------------------------------
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Iter : Variable_Cursor := Filter.Variables.First;
   begin
      while Variable_Maps.Has_Element (Iter) loop
         Variable_Maps.Query_Element (Iter, Process);
         Variable_Maps.Next (Iter);
      end loop;
   end Iterate;

end Wiki.Filters.Variables;

Implement the Iterate procedure to iterate over the filter variables


-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean;

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Variable_Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Variable_Maps.Element (Item));
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
         end if;
         First := Last;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

   --  ------------------------------
   --  Iterate over the filter variables.
   --  ------------------------------
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Iter : Variable_Cursor := Filter.Variables.First;
   begin
      while Variable_Maps.Has_Element (Iter) loop
         Variable_Maps.Query_Element (Iter, Process);
         Variable_Maps.Next (Iter);
      end loop;
   end Iterate;

   procedure Iterate (Chain   : in Wiki.Filters.Filter_Chain;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Iterate (Process);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Iterate;

end Wiki.Filters.Variables;

-----------------------------------------------------------------------
--  wiki-filters-variables -- Expand variables in text and links
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Filters.Variables is

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean;

   function Need_Expand (Text : in Wiki.Strings.WString) return Boolean is
   begin
      return Wiki.Strings.Index (Text, "$") > 0;
   end Need_Expand;

   procedure Add_Variable (Chain : in Wiki.Filters.Filter_Chain;
                           Name  : in Wiki.Strings.WString;
                           Value : in Wiki.Strings.WString) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Add_Variable (Name, Value);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Add_Variable;

   --  ------------------------------
   --  Add a variable to replace the given name by its value.
   --  ------------------------------
   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in Wiki.Strings.WString;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Name, Value);
   end Add_Variable;

   procedure Add_Variable (Filter : in out Variable_Filter;
                           Name   : in String;
                           Value  : in Wiki.Strings.WString) is
   begin
      Filter.Variables.Include (Wiki.Strings.To_WString (Name), Value);
   end Add_Variable;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out Variable_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Need_Expand (Header) then
         Filter_Type (Filter).Add_Header (Document, Filter.Expand (Header), Level);
      else
         Filter_Type (Filter).Add_Header (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a text content with the given format to the document.  Replace variables
   --  that are contained in the text.
   --  ------------------------------
   overriding
   procedure Add_Text (Filter    : in out Variable_Filter;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Need_Expand (Text) then
         Filter_Type (Filter).Add_Text (Document, Filter.Expand (Text), Format);
      else
         Filter_Type (Filter).Add_Text (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Filter     : in out Variable_Filter;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Link (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Filter     : in out Variable_Filter;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Need_Expand (Name) then
         Filter_Type (Filter).Add_Quote (Document, Filter.Expand (Name), Attributes);
      else
         Filter_Type (Filter).Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Expand the variables contained in the text.
   --  ------------------------------
   function Expand (Filter : in Variable_Filter;
                    Text   : in Wiki.Strings.WString) return Wiki.Strings.WString is
      First      : Natural := Text'First;
      Pos        : Natural;
      Last       : Natural;
      Name_Start : Natural;
      Name_End   : Natural;
      Result     : Wiki.Strings.BString (256);
      Item       : Variable_Cursor;
      Match_End  : Wiki.Strings.WChar;
   begin
      while First <= Text'Last loop
         Pos := First;
         while Pos <= Text'Last and then Text (Pos) /= '$' loop
            Pos := Pos + 1;
         end loop;
         exit when Pos >= Text'Last;
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Pos - 1));
         First := Pos;
         Name_Start := Pos + 1;
         if Text (Name_Start) = '(' or Text (Name_Start) = '{' then
            Match_End := (if Text (Name_Start) = '(' then ')' else '}');
            Name_Start := Name_Start + 1;
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= Match_End loop
               Name_End := Name_End + 1;
            end loop;
            exit when Name_End > Text'Last;
            exit when Text (Name_End) /= Match_End;
            Last := Name_End + 1;
            Name_End := Name_End - 1;
         else
            Name_End := Name_Start;
            while Name_End <= Text'Last and then Text (Name_End) /= ' ' loop
               Name_End := Name_End + 1;
            end loop;
            Last := Name_End;
            Name_End := Name_End - 1;
         end if;
         Item := Filter.Variables.Find (Text (Name_Start .. Name_End));
         if Variable_Maps.Has_Element (Item) then
            Strings.Wide_Wide_Builders.Append (Result, Variable_Maps.Element (Item));
            First := Last;
         elsif Last > Text'Last then
            exit;
         else
            Strings.Wide_Wide_Builders.Append (Result, Text (First .. Last));
            First := Last + 1;
         end if;
      end loop;
      if First <= Text'Last then
         Strings.Wide_Wide_Builders.Append (Result, Text (First .. Text'Last));
      end if;
      return Strings.Wide_Wide_Builders.To_Array (Result);
   end Expand;

   --  ------------------------------
   --  Iterate over the filter variables.
   --  ------------------------------
   procedure Iterate (Filter  : in Variable_Filter;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Iter : Variable_Cursor := Filter.Variables.First;
   begin
      while Variable_Maps.Has_Element (Iter) loop
         Variable_Maps.Query_Element (Iter, Process);
         Variable_Maps.Next (Iter);
      end loop;
   end Iterate;

   procedure Iterate (Chain   : in Wiki.Filters.Filter_Chain;
                      Process : not null
                        access procedure (Name, Value : in Strings.WString)) is
      Filter : Filter_Type_Access := Chain.Next;
   begin
      while Filter /= null loop
         if Filter.all in Variable_Filter'Class then
            Variable_Filter'Class (Filter.all).Iterate (Process);
            return;
         end if;
         Filter := Filter.Next;
      end loop;
   end Iterate;

end Wiki.Filters.Variables;

Fix replacing a variable at end of the string


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

--  === Template Plugins ===
--  The <b>Wiki.Plugins.Templates</b> package defines an abstract template plugin.
--  To use the template plugin, the <tt>Get_Template</tt> procedure must be implemented.
--  It is responsible for getting the template content according to the plugin parameters.
--
package Wiki.Plugins.Templates is

   pragma Preelaborate;

   type Template_Plugin is abstract new Wiki_Plugin with null record;

   --  Get the template content for the plugin evaluation.
   procedure Get_Template (Plugin   : in out Template_Plugin;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString) is abstract;

   --  Expand the template configured with the parameters for the document.
   --  The <tt>Get_Template</tt> operation is called and the template content returned
   --  by that operation is parsed in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

end Wiki.Plugins.Templates;

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

--  === Template Plugins ===
--  The <b>Wiki.Plugins.Templates</b> package defines an abstract template plugin.
--  To use the template plugin, the <tt>Get_Template</tt> procedure must be implemented.
--  It is responsible for getting the template content according to the plugin parameters.
--
package Wiki.Plugins.Templates is

   type Template_Plugin is abstract new Wiki_Plugin with null record;

   --  Get the template content for the plugin evaluation.
   procedure Get_Template (Plugin   : in out Template_Plugin;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString) is abstract;

   --  Expand the template configured with the parameters for the document.
   --  The <tt>Get_Template</tt> operation is called and the template content returned
   --  by that operation is parsed in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

   type File_Template_Plugin is new Wiki_Plugin with private;

   --  Set the directory path that contains template files.
   procedure Set_Template_Path (Plugin : in out File_Template_Plugin;
                                Path   : in String);

   --  Expand the template configured with the parameters for the document.
   --  Read the file whose basename correspond to the first parameter and parse that file
   --  in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out File_Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

private

   type File_Template_Plugin is new Wiki_Plugin with record
      Path : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Wiki.Plugins.Templates;

Declare the File_Template_Plugin type for the template evaluation based on a file read from a directory


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, 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 STMicroelectronics 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.   --
--                                                                          --
------------------------------------------------------------------------------

--  A simple example that blinks all the LEDs simultaneously, w/o tasking.
--  It does not use the various convenience functions defined elsewhere, but
--  instead works directly with the GPIO driver to configure and control the
--  LEDs.

--  Note that this code is independent of the specific MCU device and board
--  in use because we use names and constants that are common across all of
--  them. For example, "All_LEDs" refers to different GPIO pins on different
--  boards, and indeed defines a different number of LEDs on different boards.
--  The gpr file determines which board is actually used.

with STM32.Device;  use STM32.Device;
with STM32.Board;   use STM32.Board;

with STM32.GPIO;    use STM32.GPIO;
with Ada.Real_Time; use Ada.Real_Time;

procedure Demo_GPIO_Blinky is

   use STM32;

   Period : constant Time_Span := Milliseconds (250);
   Next   : Time := Clock;

   procedure Initialize_LEDs;
   --  Configures the GPIO pins and port connected to the LEDs on the board
   --  in use so that we can drive them via GPIO commands. Note that the board
   --  package provides a procedure to do this directly, for convenience, but
   --  we do not use it here for the sake of illustration.

   procedure Initialize_LEDs is
      Configuration : GPIO_Port_Configuration;
   begin
      Enable_Clock (All_LEDs);

      Configuration.Mode        := Mode_Out;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Floating;
      Configure_IO (All_LEDs, Configuration);
   end Initialize_LEDs;

begin
   Initialize_LEDs;

   loop
      Toggle (All_LEDs);

      Next := Next + Period;
      delay until Next;
   end loop;
end Demo_GPIO_Blinky;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, 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 STMicroelectronics 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.   --
--                                                                          --
------------------------------------------------------------------------------

--  A simple example that blinks all the LEDs simultaneously, w/o tasking.
--  It does not use the various convenience functions defined elsewhere, but
--  instead works directly with the GPIO driver to configure and control the
--  LEDs.

--  Note that this code is independent of the specific MCU device and board
--  in use because we use names and constants that are common across all of
--  them. For example, "All_LEDs" refers to different GPIO pins on different
--  boards, and indeed defines a different number of LEDs on different boards.
--  The gpr file determines which board is actually used.

with Last_Chance_Handler;  pragma Unreferenced (Last_Chance_Handler);
--  The "last chance handler" is the user-defined routine that is called when
--  an exception is propagated. We need it in the executable, therefore it
--  must be somewhere in the closure of the context clauses.

with STM32.Device;  use STM32.Device;
with STM32.Board;   use STM32.Board;

with STM32.GPIO;    use STM32.GPIO;
with Ada.Real_Time; use Ada.Real_Time;

procedure Demo_GPIO_Blinky is

   use STM32;

   Period : constant Time_Span := Milliseconds (250);
   Next   : Time := Clock;

   procedure Initialize_LEDs;
   --  Configures the GPIO pins and port connected to the LEDs on the board
   --  in use so that we can drive them via GPIO commands. Note that the board
   --  package provides a procedure to do this directly, for convenience, but
   --  we do not use it here for the sake of illustration.

   procedure Initialize_LEDs is
      Configuration : GPIO_Port_Configuration;
   begin
      Enable_Clock (All_LEDs);

      Configuration.Mode        := Mode_Out;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Floating;
      Configure_IO (All_LEDs, Configuration);
   end Initialize_LEDs;

begin
   Initialize_LEDs;

   loop
      Toggle (All_LEDs);

      Next := Next + Period;
      delay until Next;
   end loop;
end Demo_GPIO_Blinky;

Include LCH overriding default.

Include LCH overriding default.


-----------------------------------------------------------------------
--  util-dates -- Date utilities
--  Copyright (C) 2011, 2013, 2014, 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.
-----------------------------------------------------------------------
package body Util.Dates is

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
      use Ada.Calendar;
      D : Ada.Calendar.Time := Date;
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);

      --  The Day_Of_Week function uses the local timezone to find the week day.
      --  The wrong day is computed if the timezone is different.  If the current
      --  date is 23:30 GMT and the current system timezone is GMT+2, then the computed
      --  day of week will be the next day due to the +2 hour offset (01:30 AM).
      --  To avoid the timezone issue, we virtually force the hour to 12:00 am.
      if Into.Hour > 12 then
         D := D - Duration ((Into.Hour - 12) * 3600);
      elsif Into.Hour < 12 then
         D := D + Duration ((12 - Into.Hour) * 3600);
      end if;
      D := D - Duration ((60 - Into.Minute) * 60);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (D);
   end Split;

   --  ------------------------------
   --  Return the date from the date record (See Ada.Calendar.Formatting.Time_Of).
   --  ------------------------------
   function Time_Of (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => Date.Hour,
                                              Minute      => Date.Minute,
                                              Second      => Date.Second,
                                              Sub_Second  => Date.Sub_Second,
                                              Time_Zone   => Date.Time_Zone);
   end Time_Of;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      if Date.Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      --  End of week is 6 days + 23:59:59
      if Date.Day = Ada.Calendar.Formatting.Sunday then
         return T;
      else
         return T + Day_Count (6 - (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

-----------------------------------------------------------------------
--  util-dates -- Date utilities
--  Copyright (C) 2011, 2013, 2014, 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.
-----------------------------------------------------------------------
package body Util.Dates is

   --  ------------------------------
   --  Split the date into a date record (See Ada.Calendar.Formatting.Split).
   --  ------------------------------
   procedure Split (Into       : out Date_Record;
                    Date       : in Ada.Calendar.Time;
                    Time_Zone  : in Ada.Calendar.Time_Zones.Time_Offset := 0) is
      use Ada.Calendar;
      D : Ada.Calendar.Time := Date;
   begin
      Into.Date      := Date;
      Into.Time_Zone := Time_Zone;
      Ada.Calendar.Formatting.Split (Date        => Date,
                                     Year        => Into.Year,
                                     Month       => Into.Month,
                                     Day         => Into.Month_Day,
                                     Hour        => Into.Hour,
                                     Minute      => Into.Minute,
                                     Second      => Into.Second,
                                     Sub_Second  => Into.Sub_Second,
                                     Leap_Second => Into.Leap_Second,
                                     Time_Zone   => Time_Zone);

      --  The Day_Of_Week function uses the local timezone to find the week day.
      --  The wrong day is computed if the timezone is different.  If the current
      --  date is 23:30 GMT and the current system timezone is GMT+2, then the computed
      --  day of week will be the next day due to the +2 hour offset (01:30 AM).
      --  To avoid the timezone issue, we virtually force the hour to 12:00 am.
      if Into.Hour > 12 then
         D := D - Duration ((Into.Hour - 12) * 3600);
      elsif Into.Hour < 12 then
         D := D + Duration ((12 - Into.Hour) * 3600);
      end if;
      D := D - Duration ((60 - Into.Minute) * 60);
      Into.Day := Ada.Calendar.Formatting.Day_Of_Week (D);
   end Split;

   --  ------------------------------
   --  Return the date from the date record (See Ada.Calendar.Formatting.Time_Of).
   --  ------------------------------
   function Time_Of (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => Date.Hour,
                                              Minute      => Date.Minute,
                                              Second      => Date.Second,
                                              Sub_Second  => Date.Sub_Second,
                                              Time_Zone   => Date.Time_Zone);
   end Time_Of;

   --  ------------------------------
   --  Returns true if the given year is a leap year.
   --  ------------------------------
   function Is_Leap_Year (Year : in Ada.Calendar.Year_Number) return Boolean is
   begin
      if Year mod 400 = 0 then
         return True;
      elsif Year mod 100 = 0 then
         return False;
      elsif Year mod 4 = 0 then
         return True;
      else
         return False;
      end if;
   end Is_Leap_Year;

   --  ------------------------------
   --  Returns true if both dates are on the same day.
   --  ------------------------------
   function Is_Same_Day (Date1, Date2 : in Ada.Calendar.Time) return Boolean is
      Split_Date1 : Date_Record;
      Split_Date2 : Date_Record;
   begin
      Split (Split_Date1, Date1);
      Split (Split_Date2, Date2);
      return Is_Same_Day (Split_Date1, Split_Date2);
   end Is_Same_Day;

   function Is_Same_Day (Date1, Date2 : in Date_Record) return Boolean is
   begin
      return Date1.Year = Date2.Year
        and Date1.Month = Date2.Month
        and Date1.Month_Day = Date2.Month_Day;
   end Is_Same_Day;

   --  ------------------------------
   --  Get the number of days in the given year.
   --  ------------------------------
   function Get_Day_Count (Year : in Ada.Calendar.Year_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Is_Leap_Year (Year) then
         return 365;
      else
         return 366;
      end if;
   end Get_Day_Count;

   Month_Day_Count : constant array (Ada.Calendar.Month_Number)
     of Ada.Calendar.Arithmetic.Day_Count
       := (1 => 31, 2 => 28, 3 => 31, 4 => 30, 5 => 31, 6 => 30,
           7 => 31, 8 => 31, 9 => 30, 10 => 31, 11 => 30, 12 => 31);

   --  ------------------------------
   --  Get the number of days in the given month.
   --  ------------------------------
   function Get_Day_Count (Year  : in Ada.Calendar.Year_Number;
                           Month : in Ada.Calendar.Month_Number)
                           return Ada.Calendar.Arithmetic.Day_Count is
   begin
      if Month /= 2 then
         return Month_Day_Count (Month);
      elsif Is_Leap_Year (Year) then
         return 29;
      else
         return 28;
      end if;
   end Get_Day_Count;

   --  ------------------------------
   --  Get a time representing the given date at 00:00:00.
   --  ------------------------------
   function Get_Day_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_Start;

   function Get_Day_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_Start (D);
   end Get_Day_Start;

   --  ------------------------------
   --  Get a time representing the given date at 23:59:59.
   --  ------------------------------
   function Get_Day_End (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Date.Month_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Day_End;

   function Get_Day_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Day_End (D);
   end Get_Day_End;

   --  ------------------------------
   --  Get a time representing the beginning of the week at 00:00:00.
   --  ------------------------------
   function Get_Week_Start (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 0,
                                                 Minute      => 0,
                                                 Second      => 0,
                                                 Sub_Second  => 0.0,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      if Date.Day = Ada.Calendar.Formatting.Monday then
         return T;
      else
         return T - Day_Count (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday));
      end if;
   end Get_Week_Start;

   function Get_Week_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_Start (D);
   end Get_Week_Start;

   --  ------------------------------
   --  Get a time representing the end of the week at 23:59:99.
   --  ------------------------------
   function Get_Week_End (Date : in Date_Record) return Ada.Calendar.Time is
      use Ada.Calendar.Formatting;
      use Ada.Calendar.Arithmetic;

      T : constant Ada.Calendar.Time := Time_Of (Year        => Date.Year,
                                                 Month       => Date.Month,
                                                 Day         => Date.Month_Day,
                                                 Hour        => 23,
                                                 Minute      => 59,
                                                 Second      => 59,
                                                 Sub_Second  => 0.999,
                                                 Time_Zone   => Date.Time_Zone);
   begin
      --  End of week is 6 days + 23:59:59
      if Date.Day = Ada.Calendar.Formatting.Sunday then
         return T;
      else
         return T + Day_Count (6 - (Day_Name'Pos (Date.Day) - Day_Name'Pos (Monday)));
      end if;
   end Get_Week_End;

   function Get_Week_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Week_End (D);
   end Get_Week_End;

   --  ------------------------------
   --  Get a time representing the beginning of the month at 00:00:00.
   --  ------------------------------
   function Get_Month_Start (Date : in Date_Record) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Ada.Calendar.Day_Number'First,
                                              Hour        => 0,
                                              Minute      => 0,
                                              Second      => 0,
                                              Sub_Second  => 0.0,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_Start;

   function Get_Month_Start (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_Start (D);
   end Get_Month_Start;

   --  ------------------------------
   --  Get a time representing the end of the month at 23:59:59.
   --  ------------------------------
   function Get_Month_End (Date : in Date_Record) return Ada.Calendar.Time is
      Last_Day : constant Ada.Calendar.Day_Number
        := Ada.Calendar.Day_Number (Get_Day_Count (Date.Year, Date.Month));
   begin
      return Ada.Calendar.Formatting.Time_Of (Year        => Date.Year,
                                              Month       => Date.Month,
                                              Day         => Last_Day,
                                              Hour        => 23,
                                              Minute      => 59,
                                              Second      => 59,
                                              Sub_Second  => 0.999,
                                              Time_Zone   => Date.Time_Zone);
   end Get_Month_End;

   function Get_Month_End (Date : in Ada.Calendar.Time) return Ada.Calendar.Time is
      D : Date_Record;
   begin
      Split (D, Date);
      return Get_Month_End (D);
   end Get_Month_End;

end Util.Dates;

Implement the Is_Same_Day function

Implement the Is_Same_Day function