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

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wide_Wide_String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return To_Unbounded_Wide_Wide_String (Attr.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List_Type;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Access := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List_Type;
                           Name : in String) return Unbounded_Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Null_Unbounded_Wide_Wide_String;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Wide_Wide_String;
                     Value : in Wide_Wide_String) is
      Attr : constant Attribute_Access
        := new Attribute '(Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attr);
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
   begin
      Append (List, Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Name),
              Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Value));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List_Type) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List_Type) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List_Type) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Attribute,
                                        Name   => Attribute_Access);
      Item : Attribute_Access;
   begin
      while not List.List.Is_Empty loop
         Item := List.List.Last_Element;
         List.List.Delete_Last;
         Free (Item);
      end loop;
   end Clear;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List_Type) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

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

package body Wiki.Attributes is

   use Ada.Characters;

   --  ------------------------------
   --  Get the attribute name.
   --  ------------------------------
   function Get_Name (Position : in Cursor) return String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Name;
   end Get_Name;

   --  ------------------------------
   --  Get the attribute value.
   --  ------------------------------
   function Get_Value (Position : in Cursor) return String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Ada.Characters.Conversions.To_String (Attr.Value);
   end Get_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Wide_Value (Position : in Cursor) return Wide_Wide_String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return Attr.Value;
   end Get_Wide_Value;

   --  ------------------------------
   --  Get the attribute wide value.
   --  ------------------------------
   function Get_Unbounded_Wide_Value (Position : in Cursor) return Unbounded_Wide_Wide_String is
      Attr : constant Attribute_Access := Attribute_Vectors.Element (Position.Pos);
   begin
      return To_Unbounded_Wide_Wide_String (Attr.Value);
   end Get_Unbounded_Wide_Value;

   --  ------------------------------
   --  Returns True if the cursor has a valid attribute.
   --  ------------------------------
   function Has_Element (Position : in Cursor) return Boolean is
   begin
      return Attribute_Vectors.Has_Element (Position.Pos);
   end Has_Element;

   --  ------------------------------
   --  Move the cursor to the next attribute.
   --  ------------------------------
   procedure Next (Position : in out Cursor) is
   begin
      Attribute_Vectors.Next (Position.Pos);
   end Next;

   --  ------------------------------
   --  Find the attribute with the given name.
   --  ------------------------------
   function Find (List : in Attribute_List_Type;
                  Name : in String) return Cursor is
      Iter : Attribute_Vectors.Cursor := List.List.First;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         declare
            Attr : constant Attribute_Access := Attribute_Vectors.Element (Iter);
         begin
            if Attr.Name = Name then
               return Cursor '(Pos => Iter);
            end if;
         end;
         Attribute_Vectors.Next (Iter);
      end loop;
      return Cursor '(Pos => Iter);
   end Find;

   --  ------------------------------
   --  Find the attribute with the given name and return its value.
   --  ------------------------------
   function Get_Attribute (List : in Attribute_List_Type;
                           Name : in String) return Unbounded_Wide_Wide_String is
      Attr : constant Cursor := Find (List, Name);
   begin
      if Has_Element (Attr) then
         return Get_Unbounded_Wide_Value (Attr);
      else
         return Null_Unbounded_Wide_Wide_String;
      end if;
   end Get_Attribute;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Wide_Wide_String;
                     Value : in Wide_Wide_String) is
      Attr : constant Attribute_Access
        := new Attribute '(Name_Length  => Name'Length,
                           Value_Length => Value'Length,
                           Name         => Conversions.To_String (Name),
                           Value        => Value);
   begin
      List.List.Append (Attr);
   end Append;

   --  ------------------------------
   --  Append the attribute to the attribute list.
   --  ------------------------------
   procedure Append (List  : in out Attribute_List_Type;
                     Name  : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
                     Value : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
   begin
      Append (List, Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Name),
              Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (Value));
   end Append;

   --  ------------------------------
   --  Get the cursor to get access to the first attribute.
   --  ------------------------------
   function First (List : in Attribute_List_Type) return Cursor is
   begin
      return Cursor '(Pos => List.List.First);
   end First;

   --  ------------------------------
   --  Get the number of attributes in the list.
   --  ------------------------------
   function Length (List : in Attribute_List_Type) return Natural is
   begin
      return Natural (List.List.Length);
   end Length;

   --  ------------------------------
   --  Clear the list and remove all existing attributes.
   --  ------------------------------
   procedure Clear (List : in out Attribute_List_Type) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Attribute,
                                        Name   => Attribute_Access);
      Item : Attribute_Access;
   begin
      while not List.List.Is_Empty loop
         Item := List.List.Last_Element;
         List.List.Delete_Last;
         Free (Item);
      end loop;
   end Clear;

   --  ------------------------------
   --  Iterate over the list attributes and call the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterate (List    : in Attribute_List_Type;
                      Process : not null access procedure (Name : in String;
                                                           Value : in Wide_Wide_String)) is
      Iter : Attribute_Vectors.Cursor := List.List.First;
      Item : Attribute_Access;
   begin
      while Attribute_Vectors.Has_Element (Iter) loop
         Item := Attribute_Vectors.Element (Iter);
         Process (Item.Name, Item.Value);
         Attribute_Vectors.Next (Iter);
      end loop;
   end Iterate;

   --  ------------------------------
   --  Finalize the attribute list releasing any storage.
   --  ------------------------------
   overriding
   procedure Finalize (List : in out Attribute_List_Type) is
   begin
      List.Clear;
   end Finalize;

end Wiki.Attributes;

Implement the Iterate procedure and invoke the Process procedure with each name/value pair


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

with Ada.Finalization;

with Util.Beans.Basic;
with Util.Refs;
with EL.Expressions;
with EL.Contexts;

package ASF.Routes is

   type Route_Type is abstract new Util.Refs.Ref_Entity with null record;
   type Route_Type_Access is access all Route_Type'Class;

   --  function Duplicate (Route : in Route_Type) return Route_Type_Access is abstract;

   package Route_Type_Refs is
     new Util.Refs.Indefinite_References (Element_Type => Route_Type'Class,
                                          Element_Access => Route_Type_Access);

   subtype Route_Type_Ref is Route_Type_Refs.Ref;
   --  subtype Route_Type_Access is Route_Type_Refs.Element_Access;

   No_Parameter : exception;

   type Path_Mode is (FULL, PREFIX, SUFFIX);

   --  The <tt>Route_Context_Type</tt> defines the context information after a path
   --  has been routed.
   type Route_Context_Type is tagged limited private;

   --  Get path information after the routing.
   function Get_Path (Context : in Route_Context_Type;
                      Mode    : in Path_Mode := FULL) return String;

   --  Get the path parameter value for the given parameter index.
   --  The <tt>No_Parameter</tt> exception is raised if the parameter does not exist.
   function Get_Parameter (Context : in Route_Context_Type;
                           Index   : in Positive) return String;

   --  Get the number of path parameters that were extracted for the route.
   function Get_Parameter_Count (Context : in Route_Context_Type) return Natural;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   function Get_Path_Pos (Context : in Route_Context_Type) return Natural;

   --  Return the route associated with the resolved route context.
   function Get_Route (Context : in Route_Context_Type) return Route_Type_Access;

   --  Change the context to use a new route.
   procedure Change_Route (Context : in out Route_Context_Type;
                           To      : in Route_Type_Access);

   --  Inject the parameters that have been extracted from the path according
   --  to the selected route.
   procedure Inject_Parameters (Context   : in Route_Context_Type;
                                Into      : in out Util.Beans.Basic.Bean'Class;
                                ELContext : in EL.Contexts.ELContext'Class);

   --  The <tt>Router_Type</tt> registers the different routes with their rules and
   --  resolves a path into a route context information.
   type Router_Type is new Ada.Finalization.Limited_Controlled with private;
   type Router_Type_Access is access all Router_Type'Class;

   --  Add a route associated with the given path pattern.  The pattern is split into components.
   --  Some path components can be a fixed string (/home) and others can be variable.
   --  When a path component is variable, the value can be retrieved from the route context.
   procedure Add_Route (Router    : in out Router_Type;
                        Pattern   : in String;
                        To        : in Route_Type_Access;
                        ELContext : in EL.Contexts.ELContext'Class);

   --  Build the route context from the given path by looking at the different routes registered
   --  in the router with <tt>Add_Route</tt>.
   procedure Find_Route (Router  : in Router_Type;
                         Path    : in String;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Router  : in Router_Type;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

private

   -- use type Route_Type_Refs.Element_Access;

   type String_Access is access all String;

   type Route_Node_Type;
   type Route_Node_Access is access all Route_Node_Type'Class;

   --  Describes a variable path component whose value must be injected in an Ada bean.
   type Route_Param_Type is limited record
      Route : Route_Node_Access;
      First : Natural := 0;
      Last  : Natural := 0;
   end record;

   type Route_Param_Array is array (Positive range <>) of Route_Param_Type;

   type Route_Match_Type is (NO_MATCH, MAYBE_MATCH, WILDCARD_MATCH, EXT_MATCH, YES_MATCH);

   type Route_Node_Type is abstract tagged limited record
      Next_Route : Route_Node_Access;
      Children   : Route_Node_Access;
      Route      : Route_Type_Ref;
   end record;

   --  Inject the parameter that was extracted from the path.
   procedure Inject_Parameter (Node      : in Route_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class) is null;

   --  Check if the route node accepts the given path component.
   function Matches (Node    : in Route_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type is abstract;

   --  Return the component path pattern that this route node represents.
   --  Example: 'index.html', '#{user.id}', ':id'
   function Get_Pattern (Node : in Route_Node_Type) return String is abstract;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   function Get_Path_Pos (Node  : in Route_Node_Type;
                          Param : in Route_Param_Type) return Natural;

   --  Find recursively a match on the given route sub-tree.  The match must start at the position
   --  <tt>First</tt> in the path up to the last path position.  While the path components are
   --  checked, the route context is populated with variable components.  When the full path
   --  matches, <tt>YES_MATCH</tt> is returned in the context gets the route instance.
   procedure Find_Match (Node    : in Route_Node_Type;
                         Path    : in String;
                         First   : in Natural;
                         Match   : out Route_Match_Type;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Node    : in Route_Node_Type;
                      Path    : in String;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

   --  A fixed path component identification.
   type Path_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : aliased String (1 .. Len);
   end record;
   type Path_Node_Access is access all Path_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns YES_MATCH if the name corresponds exactly to the node's name.
   overriding
   function Matches (Node    : in Path_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, 'Name').
   overriding
   function Get_Pattern (Node : in Path_Node_Type) return String;

   --  A variable path component whose value is injected in an Ada bean using the EL expression.
   --  The route node is created each time an EL expression is found in the route pattern.
   --  Example: /home/#{user.id}/index.html
   --  In this example, the EL expression refers to <tt>user.id</tt>.
   type EL_Node_Type is new Route_Node_Type with record
      Value : EL.Expressions.Value_Expression;
   end record;
   type EL_Node_Access is access all EL_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in EL_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, the EL expr).
   overriding
   function Get_Pattern (Node : in EL_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in EL_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   --  A variable path component which can be injected in an Ada bean.
   --  Example: /home/:id/view.html
   --  The path component represented by <tt>:id</tt> is injected in the Ada bean object
   --  passed to the <tt>Inject_Parameters</tt> procedure.
   type Param_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : String (1 .. Len);
   end record;
   type Param_Node_Access is access all Param_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Param_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, Name).
   overriding
   function Get_Pattern (Node : in Param_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in Param_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   type Extension_Node_Type (Len : Natural) is new Route_Node_Type with record
      Ext : String (1 .. Len);
   end record;
   type Extension_Node_Access is access all Extension_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Extension_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *.Ext).
   overriding
   function Get_Pattern (Node : in Extension_Node_Type) return String;

   type Wildcard_Node_Type is new Route_Node_Type with null record;
   type Wildcard_Node_Access is access all Wildcard_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns WILDCARD_MATCH.
   overriding
   function Matches (Node    : in Wildcard_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *).
   overriding
   function Get_Pattern (Node : in Wildcard_Node_Type) return String;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   overriding
   function Get_Path_Pos (Node  : in Wildcard_Node_Type;
                          Param : in Route_Param_Type) return Natural;

   MAX_ROUTE_PARAMS : constant Positive := 10;

   type Route_Context_Type is limited new Ada.Finalization.Limited_Controlled with record
      Route  : Route_Type_Access;
      Path   : String_Access;
      Params : Route_Param_Array (1 .. MAX_ROUTE_PARAMS);
      Count  : Natural := 0;
   end record;

   --  Release the storage held by the route context.
   overriding
   procedure Finalize (Context : in out Route_Context_Type);

   type Router_Type is new Ada.Finalization.Limited_Controlled with record
      Route : aliased Path_Node_Type (Len => 0);
   end record;

   --  Release the storage held by the router.
   overriding
   procedure Finalize (Router : in out Router_Type);

end ASF.Routes;

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

with Ada.Finalization;

with Util.Beans.Basic;
with Util.Refs;
with EL.Expressions;
with EL.Contexts;

package ASF.Routes is

   type Route_Type is abstract new Util.Refs.Ref_Entity with null record;
   type Route_Type_Access is access all Route_Type'Class;

   --  function Duplicate (Route : in Route_Type) return Route_Type_Access is abstract;

   package Route_Type_Refs is
     new Util.Refs.Indefinite_References (Element_Type => Route_Type'Class,
                                          Element_Access => Route_Type_Access);

   subtype Route_Type_Ref is Route_Type_Refs.Ref;
   --  subtype Route_Type_Access is Route_Type_Refs.Element_Access;

   No_Parameter : exception;

   type Path_Mode is (FULL, PREFIX, SUFFIX);

   --  The <tt>Route_Context_Type</tt> defines the context information after a path
   --  has been routed.
   type Route_Context_Type is tagged limited private;

   --  Get path information after the routing.
   function Get_Path (Context : in Route_Context_Type;
                      Mode    : in Path_Mode := FULL) return String;

   --  Get the path parameter value for the given parameter index.
   --  The <tt>No_Parameter</tt> exception is raised if the parameter does not exist.
   function Get_Parameter (Context : in Route_Context_Type;
                           Index   : in Positive) return String;

   --  Get the number of path parameters that were extracted for the route.
   function Get_Parameter_Count (Context : in Route_Context_Type) return Natural;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   function Get_Path_Pos (Context : in Route_Context_Type) return Natural;

   --  Return the route associated with the resolved route context.
   function Get_Route (Context : in Route_Context_Type) return Route_Type_Access;

   --  Change the context to use a new route.
   procedure Change_Route (Context : in out Route_Context_Type;
                           To      : in Route_Type_Access);

   --  Inject the parameters that have been extracted from the path according
   --  to the selected route.
   procedure Inject_Parameters (Context   : in Route_Context_Type;
                                Into      : in out Util.Beans.Basic.Bean'Class;
                                ELContext : in EL.Contexts.ELContext'Class);

   --  The <tt>Router_Type</tt> registers the different routes with their rules and
   --  resolves a path into a route context information.
   type Router_Type is new Ada.Finalization.Limited_Controlled with private;
   type Router_Type_Access is access all Router_Type'Class;

   --  Add a route associated with the given path pattern.  The pattern is split into components.
   --  Some path components can be a fixed string (/home) and others can be variable.
   --  When a path component is variable, the value can be retrieved from the route context.
   --  Once the route path is created, the <tt>Process</tt> procedure is called with the route
   --  reference.
   procedure Add_Route (Router    : in out Router_Type;
                        Pattern   : in String;
                        ELContext : in EL.Contexts.ELContext'Class;
                        Process   : not null access procedure (Route : in out Route_Type_Ref));

   --  Build the route context from the given path by looking at the different routes registered
   --  in the router with <tt>Add_Route</tt>.
   procedure Find_Route (Router  : in Router_Type;
                         Path    : in String;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Router  : in Router_Type;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

private

   -- use type Route_Type_Refs.Element_Access;

   type String_Access is access all String;

   type Route_Node_Type;
   type Route_Node_Access is access all Route_Node_Type'Class;

   --  Describes a variable path component whose value must be injected in an Ada bean.
   type Route_Param_Type is limited record
      Route : Route_Node_Access;
      First : Natural := 0;
      Last  : Natural := 0;
   end record;

   type Route_Param_Array is array (Positive range <>) of Route_Param_Type;

   type Route_Match_Type is (NO_MATCH, MAYBE_MATCH, WILDCARD_MATCH, EXT_MATCH, YES_MATCH);

   type Route_Node_Type is abstract tagged limited record
      Next_Route : Route_Node_Access;
      Children   : Route_Node_Access;
      Route      : Route_Type_Ref;
   end record;

   --  Inject the parameter that was extracted from the path.
   procedure Inject_Parameter (Node      : in Route_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class) is null;

   --  Check if the route node accepts the given path component.
   function Matches (Node    : in Route_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type is abstract;

   --  Return the component path pattern that this route node represents.
   --  Example: 'index.html', '#{user.id}', ':id'
   function Get_Pattern (Node : in Route_Node_Type) return String is abstract;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   function Get_Path_Pos (Node  : in Route_Node_Type;
                          Param : in Route_Param_Type) return Natural;

   --  Find recursively a match on the given route sub-tree.  The match must start at the position
   --  <tt>First</tt> in the path up to the last path position.  While the path components are
   --  checked, the route context is populated with variable components.  When the full path
   --  matches, <tt>YES_MATCH</tt> is returned in the context gets the route instance.
   procedure Find_Match (Node    : in Route_Node_Type;
                         Path    : in String;
                         First   : in Natural;
                         Match   : out Route_Match_Type;
                         Context : in out Route_Context_Type'Class);

   --  Walk the routes that have been added by <tt>Add_Route</tt> and call the <tt>Process</tt>
   --  procedure with each path pattern and route object.
   procedure Iterate (Node    : in Route_Node_Type;
                      Path    : in String;
                      Process : not null access procedure (Pattern : in String;
                                                           Route   : in Route_Type_Access));

   --  A fixed path component identification.
   type Path_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : aliased String (1 .. Len);
   end record;
   type Path_Node_Access is access all Path_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns YES_MATCH if the name corresponds exactly to the node's name.
   overriding
   function Matches (Node    : in Path_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, 'Name').
   overriding
   function Get_Pattern (Node : in Path_Node_Type) return String;

   --  A variable path component whose value is injected in an Ada bean using the EL expression.
   --  The route node is created each time an EL expression is found in the route pattern.
   --  Example: /home/#{user.id}/index.html
   --  In this example, the EL expression refers to <tt>user.id</tt>.
   type EL_Node_Type is new Route_Node_Type with record
      Value : EL.Expressions.Value_Expression;
   end record;
   type EL_Node_Access is access all EL_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in EL_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, the EL expr).
   overriding
   function Get_Pattern (Node : in EL_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in EL_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   --  A variable path component which can be injected in an Ada bean.
   --  Example: /home/:id/view.html
   --  The path component represented by <tt>:id</tt> is injected in the Ada bean object
   --  passed to the <tt>Inject_Parameters</tt> procedure.
   type Param_Node_Type (Len : Natural) is new Route_Node_Type with record
      Name : String (1 .. Len);
   end record;
   type Param_Node_Access is access all Param_Node_Type'Class;

   --  Check if the route node accepts the given path component.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Param_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, Name).
   overriding
   function Get_Pattern (Node : in Param_Node_Type) return String;

   --  Inject the parameter that was extracted from the path.
   overriding
   procedure Inject_Parameter (Node      : in Param_Node_Type;
                               Param     : in String;
                               Into      : in out Util.Beans.Basic.Bean'Class;
                               ELContext : in EL.Contexts.ELContext'Class);

   type Extension_Node_Type (Len : Natural) is new Route_Node_Type with record
      Ext : String (1 .. Len);
   end record;
   type Extension_Node_Access is access all Extension_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns MAYBE_MATCH.
   overriding
   function Matches (Node    : in Extension_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *.Ext).
   overriding
   function Get_Pattern (Node : in Extension_Node_Type) return String;

   type Wildcard_Node_Type is new Route_Node_Type with null record;
   type Wildcard_Node_Access is access all Wildcard_Node_Type'Class;

   --  Check if the route node accepts the given extension.
   --  Returns WILDCARD_MATCH.
   overriding
   function Matches (Node    : in Wildcard_Node_Type;
                     Name    : in String;
                     Is_Last : in Boolean) return Route_Match_Type;

   --  Return the component path pattern that this route node represents (ie, *).
   overriding
   function Get_Pattern (Node : in Wildcard_Node_Type) return String;

   --  Return the position of the variable part of the path.
   --  If the URI matches a wildcard pattern, the position of the last '/' in the wildcard pattern
   --  is returned.
   overriding
   function Get_Path_Pos (Node  : in Wildcard_Node_Type;
                          Param : in Route_Param_Type) return Natural;

   MAX_ROUTE_PARAMS : constant Positive := 10;

   type Route_Context_Type is limited new Ada.Finalization.Limited_Controlled with record
      Route  : Route_Type_Access;
      Path   : String_Access;
      Params : Route_Param_Array (1 .. MAX_ROUTE_PARAMS);
      Count  : Natural := 0;
   end record;

   --  Release the storage held by the route context.
   overriding
   procedure Finalize (Context : in out Route_Context_Type);

   type Router_Type is new Ada.Finalization.Limited_Controlled with record
      Route : aliased Path_Node_Type (Len => 0);
   end record;

   --  Release the storage held by the router.
   overriding
   procedure Finalize (Router : in out Router_Type);

end ASF.Routes;

Change the Add_Route procedure to invoke a Process procedure with the route reference so that we can update the existing route


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

package Babel.Base is

   type Database is abstract new Ada.Finalization.Limited_Controlled with private;

private

   type Database is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Integer;
   end record;

end Babel.Base;

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

with Babel.Files;
package Babel.Base is

   type Database is abstract new Ada.Finalization.Limited_Controlled with private;

   --  Insert the file in the database.
   procedure Insert (Into : in out Database;
                     File : in Babel.Files.File_Type) is abstract;

private

   type Database is abstract new Ada.Finalization.Limited_Controlled with record
      Name : Integer;
   end record;

end Babel.Base;

Define the Insert operation on the Database abstract type


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

with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Calendar;
with Ada.Containers.Indefinite_Vectors;

with ADO.Utils;
with ADO.Drivers.Dialects;

--  === Query Parameters ===
--  Query parameters are represented by the <tt>Parameter</tt> type which can represent almost
--  all database types including boolean, numbers, strings, dates and blob.  Parameters are
--  put in a list represented by the <tt>Abstract_List</tt> or <tt>List</tt> types.
--
--  A parameter is added by using either the <tt>Bind_Param</tt> or the <tt>Add_Param</tt>
--  operation.  The <tt>Bind_Param</tt> operation allows to specify either the parameter name
--  or its position.  The <tt>Add_Param</tt> operation adds the parameter at end of the list
--  and uses the last position.  In most cases, it is easier to bind a parameter with a name
--  as follows:
--
--    Query.Bind_Param ("name", "Joe");
--
--  and the SQL can use the following construct:
--
--    SELECT * FROM user WHERE name = :name
--
--  When the <tt>Add_Param</tt> is used, the parameter is not associated with any name but it
--  as a position index.  Setting a parameter is easier:
--
--    Query.Add_Param ("Joe");
--
--  but the SQL cannot make any reference to names and must use the <tt>?</tt> construct:
--
--    SELECT * FROM user WHERE name = ?
--
--  === Parameter Expander ===
--  The parameter expander is a mechanism that allows to replace or inject values in the SQL
--  query by looking at an operation provided by the <tt>Expander</tt> interface.  Such expander
--  is useful to replace parameters that are global to a session or to an application.
--
package ADO.Parameters is

   use Ada.Strings.Unbounded;

   type Token is new String;

   type Parameter_Type is (T_NULL, T_STRING, T_TOKEN, T_LIST, T_DATE, T_LONG_INTEGER,
                           T_INTEGER, T_BOOLEAN, T_BLOB);

   type Parameter (T   : Parameter_Type;
                   Len : Natural;
                   Value_Len : Natural) is record
      Position : Natural := 0;
      Name     : String (1 .. Len);
      case T is
         when T_NULL =>
            null;

         when T_LONG_INTEGER =>
            Long_Num : Long_Long_Integer := 0;

         when T_INTEGER =>
            Num : Integer;

         when T_BOOLEAN =>
            Bool : Boolean;

         when T_DATE =>
            Time : Ada.Calendar.Time;

         when T_BLOB =>
            Data : ADO.Blob_Ref;

         when others =>
            Str : String (1 .. Value_Len);
      end case;
   end record;

   type Expander is limited interface;
   type Expander_Access is access all Expander'Class;

   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   function Expand (Instance : in Expander;
                    Group    : in String;
                    Name     : in String) return Parameter is abstract;

   type Abstract_List is abstract new Ada.Finalization.Controlled with private;
   type Abstract_List_Access is access all Abstract_List'Class;

   --  Set the SQL dialect description object.
   procedure Set_Dialect (Params : in out Abstract_List;
                          D      : in ADO.Drivers.Dialects.Dialect_Access);

   --  Get the SQL dialect description object.
   function Get_Dialect (From : in Abstract_List) return ADO.Drivers.Dialects.Dialect_Access;

   --  Add the parameter in the list.
   procedure Add_Parameter (Params : in out Abstract_List;
                            Param  : in Parameter) is abstract;

   --  Set the parameters from another parameter list.
   procedure Set_Parameters (Parameters : in out Abstract_List;
                             From       : in Abstract_List'Class) is abstract;

   --  Return the number of parameters in the list.
   function Length (Params : in Abstract_List) return Natural is abstract;

   --  Return the parameter at the given position
   function Element (Params   : in Abstract_List;
                     Position : in Natural) return Parameter is abstract;

   --  Execute the Process procedure with the given parameter as argument.
   procedure Query_Element (Params   : in Abstract_List;
                            Position : in Natural;
                            Process  : not null access
                              procedure (Element : in Parameter)) is abstract;

   --  Clear the list of parameters.
   procedure Clear (Parameters : in out Abstract_List) is abstract;

   --  Operations to bind a parameter
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Boolean);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Long_Long_Integer);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Identifier);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Integer);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Entity_Type);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in String);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Unbounded_String);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Ada.Calendar.Time);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Token);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Blob_Ref);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Utils.Identifier_Vector);

   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Boolean);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Long_Long_Integer);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Identifier);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Integer);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Entity_Type);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in String);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Unbounded_String);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Ada.Calendar.Time);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in ADO.Blob_Ref);
   procedure Bind_Null_Param (Params   : in out Abstract_List;
                              Position : in Natural);
   procedure Bind_Null_Param (Params   : in out Abstract_List;
                              Name     : in String);

   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Boolean);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Long_Long_Integer);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Identifier);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Integer);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in String);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Unbounded_String);
   procedure Add_Param (Params : in out Abstract_List;
                        Value : in Ada.Calendar.Time);

   --  Add a null parameter.
   procedure Add_Null_Param (Params : in out Abstract_List);

   --  Expand the SQL string with the query parameters.  The following parameters syntax
   --  are recognized and replaced:
   --

   --
? is replaced according to the current parameter index.  The index is incremented
   --         after each occurrence of ? character.
   --
:nnn is replaced by the parameter at index nnn.
   --
:name is replaced by the parameter with the name name
   --

   --  Parameter strings are escaped.  When a parameter is not found, an empty string is used.
   --  Returns the expanded SQL string.
   function Expand (Params : in Abstract_List'Class;
                    SQL    : in String) return String;

   --  ------------------------------
   --  List of parameters
   --  ------------------------------
   --  The List is an implementation of the parameter list.
   type List is new Abstract_List with private;

   procedure Add_Parameter (Params : in out List;
                            Param  : in Parameter);

   procedure Set_Parameters (Params : in out List;
                             From   : in Abstract_List'Class);

   --  Return the number of parameters in the list.
   function Length (Params : in List) return Natural;

   --  Return the parameter at the given position
   function Element (Params   : in List;
                     Position : in Natural) return Parameter;

   --  Execute the Process procedure with the given parameter as argument.
   procedure Query_Element (Params   : in List;
                            Position : in Natural;
                            Process  : not null access procedure (Element : in Parameter));

   --  Clear the list of parameters.
   procedure Clear (Params : in out List);

private

   function Compare_On_Name (Left, Right : in Parameter) return Boolean;

   package Parameter_Vectors is
     new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                            Element_Type => Parameter,
                                            "="          => Compare_On_Name);

   type Abstract_List is abstract new Ada.Finalization.Controlled with record
      Dialect  : ADO.Drivers.Dialects.Dialect_Access := null;
      Expander : Expander_Access;
   end record;

   type List is new Abstract_List with record
      Params : Parameter_Vectors.Vector;
   end record;

end ADO.Parameters;

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

with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Calendar;
with Ada.Containers.Indefinite_Vectors;

with ADO.Utils;
with ADO.Drivers.Dialects;

--  === Query Parameters ===
--  Query parameters are represented by the <tt>Parameter</tt> type which can represent almost
--  all database types including boolean, numbers, strings, dates and blob.  Parameters are
--  put in a list represented by the <tt>Abstract_List</tt> or <tt>List</tt> types.
--
--  A parameter is added by using either the <tt>Bind_Param</tt> or the <tt>Add_Param</tt>
--  operation.  The <tt>Bind_Param</tt> operation allows to specify either the parameter name
--  or its position.  The <tt>Add_Param</tt> operation adds the parameter at end of the list
--  and uses the last position.  In most cases, it is easier to bind a parameter with a name
--  as follows:
--
--    Query.Bind_Param ("name", "Joe");
--
--  and the SQL can use the following construct:
--
--    SELECT * FROM user WHERE name = :name
--
--  When the <tt>Add_Param</tt> is used, the parameter is not associated with any name but it
--  as a position index.  Setting a parameter is easier:
--
--    Query.Add_Param ("Joe");
--
--  but the SQL cannot make any reference to names and must use the <tt>?</tt> construct:
--
--    SELECT * FROM user WHERE name = ?
--
--  === Parameter Expander ===
--  The parameter expander is a mechanism that allows to replace or inject values in the SQL
--  query by looking at an operation provided by the <tt>Expander</tt> interface.  Such expander
--  is useful to replace parameters that are global to a session or to an application.
--
package ADO.Parameters is

   use Ada.Strings.Unbounded;

   type Token is new String;

   type Parameter_Type is (T_NULL, T_STRING, T_TOKEN, T_LIST, T_DATE, T_LONG_INTEGER,
                           T_INTEGER, T_BOOLEAN, T_BLOB);

   type Parameter (T   : Parameter_Type;
                   Len : Natural;
                   Value_Len : Natural) is record
      Position : Natural := 0;
      Name     : String (1 .. Len);
      case T is
         when T_NULL =>
            null;

         when T_LONG_INTEGER =>
            Long_Num : Long_Long_Integer := 0;

         when T_INTEGER =>
            Num : Integer;

         when T_BOOLEAN =>
            Bool : Boolean;

         when T_DATE =>
            Time : Ada.Calendar.Time;

         when T_BLOB =>
            Data : ADO.Blob_Ref;

         when others =>
            Str : String (1 .. Value_Len);
      end case;
   end record;

   type Expander is limited interface;
   type Expander_Access is access all Expander'Class;

   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   function Expand (Instance : in Expander;
                    Group    : in String;
                    Name     : in String) return Parameter is abstract;

   type Abstract_List is abstract new Ada.Finalization.Controlled with private;
   type Abstract_List_Access is access all Abstract_List'Class;

   --  Set the SQL dialect description object.
   procedure Set_Dialect (Params : in out Abstract_List;
                          D      : in ADO.Drivers.Dialects.Dialect_Access);

   --  Get the SQL dialect description object.
   function Get_Dialect (From : in Abstract_List) return ADO.Drivers.Dialects.Dialect_Access;

   --  Add the parameter in the list.
   procedure Add_Parameter (Params : in out Abstract_List;
                            Param  : in Parameter) is abstract;

   --  Set the parameters from another parameter list.
   procedure Set_Parameters (Parameters : in out Abstract_List;
                             From       : in Abstract_List'Class) is abstract;

   --  Return the number of parameters in the list.
   function Length (Params : in Abstract_List) return Natural is abstract;

   --  Return the parameter at the given position
   function Element (Params   : in Abstract_List;
                     Position : in Natural) return Parameter is abstract;

   --  Execute the Process procedure with the given parameter as argument.
   procedure Query_Element (Params   : in Abstract_List;
                            Position : in Natural;
                            Process  : not null access
                              procedure (Element : in Parameter)) is abstract;

   --  Clear the list of parameters.
   procedure Clear (Parameters : in out Abstract_List) is abstract;

   --  Operations to bind a parameter
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Boolean);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Long_Long_Integer);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Identifier);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Integer);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Entity_Type);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in String);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Unbounded_String);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Ada.Calendar.Time);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in Token);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Blob_Ref);
   procedure Bind_Param (Params : in out Abstract_List;
                         Name   : in String;
                         Value  : in ADO.Utils.Identifier_Vector);

   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Boolean);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Long_Long_Integer);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Identifier);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Integer);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Entity_Type);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in String);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Unbounded_String);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in Ada.Calendar.Time);
   procedure Bind_Param (Params   : in out Abstract_List;
                         Position : in Natural;
                         Value    : in ADO.Blob_Ref);
   procedure Bind_Null_Param (Params   : in out Abstract_List;
                              Position : in Natural);
   procedure Bind_Null_Param (Params   : in out Abstract_List;
                              Name     : in String);

   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Boolean);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Long_Long_Integer);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Identifier);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Integer);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in String);
   procedure Add_Param (Params : in out Abstract_List;
                         Value : in Unbounded_String);
   procedure Add_Param (Params : in out Abstract_List;
                        Value : in Ada.Calendar.Time);

   --  Add a null parameter.
   procedure Add_Null_Param (Params : in out Abstract_List);

   --  Expand the SQL string with the query parameters.  The following parameters syntax
   --  are recognized and replaced:
   --

   --
? is replaced according to the current parameter index.  The index is incremented
   --         after each occurrence of ? character.
   --
:nnn is replaced by the parameter at index nnn.
   --
:name is replaced by the parameter with the name name
   --
$group[var-name] is replaced by using the expander interface.
   --

   --  Parameter strings are escaped.  When a parameter is not found, an empty string is used.
   --  Returns the expanded SQL string.
   function Expand (Params : in Abstract_List'Class;
                    SQL    : in String) return String;

   --  ------------------------------
   --  List of parameters
   --  ------------------------------
   --  The List is an implementation of the parameter list.
   type List is new Abstract_List with private;

   procedure Add_Parameter (Params : in out List;
                            Param  : in Parameter);

   procedure Set_Parameters (Params : in out List;
                             From   : in Abstract_List'Class);

   --  Return the number of parameters in the list.
   function Length (Params : in List) return Natural;

   --  Return the parameter at the given position
   function Element (Params   : in List;
                     Position : in Natural) return Parameter;

   --  Execute the Process procedure with the given parameter as argument.
   procedure Query_Element (Params   : in List;
                            Position : in Natural;
                            Process  : not null access procedure (Element : in Parameter));

   --  Clear the list of parameters.
   procedure Clear (Params : in out List);

private

   function Compare_On_Name (Left, Right : in Parameter) return Boolean;

   package Parameter_Vectors is
     new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                            Element_Type => Parameter,
                                            "="          => Compare_On_Name);

   type Abstract_List is abstract new Ada.Finalization.Controlled with record
      Dialect  : ADO.Drivers.Dialects.Dialect_Access := null;
      Expander : Expander_Access;
   end record;

   type List is new Abstract_List with record
      Params : Parameter_Vectors.Vector;
   end record;

end ADO.Parameters;

Update the documentation for the Expand function


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

with EL.Expressions.Nodes;
with EL.Expressions.Parser;
package body EL.Expressions is

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object is
   begin
      if Expr.Node = null then
         return EL.Objects.Null_Object;
      end if;
      return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
   end Get_Value;

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : ValueExpression;
                       Context : ELContext'Class) return Object is
      pragma Unreferenced (Context);
   begin
      if Expr.Bean = null then
         return EL.Objects.Null_Object;
      end if;
      return To_Object (Expr.Bean);
   end Get_Value;

   procedure Set_Value (Expr    : in ValueExpression;
                        Context : in ELContext'Class;
                        Value   : in Object) is
   begin
      null;
   end Set_Value;

   function Is_Readonly (Expr : in ValueExpression) return Boolean is
   begin
      if Expr.Bean = null then
         return True;
      end if;
      return not (Expr.Bean.all in EL.Beans.Bean'Class);
   end Is_Readonly;

   --  ------------------------------
   --  Parse an expression and return its representation ready for evaluation.
   --  ------------------------------
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression is
      use EL.Expressions.Nodes;
      Result : Expression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      if Node /= null then
         Result.Node := Node.all'Access;
      end if;
      return Result;
   end Create_Expression;

   function Create_ValueExpression (Bean : access EL.Beans.Readonly_Bean'Class)
                                    return ValueExpression is
      Result : ValueExpression;
   begin
      Result.Bean := Bean;
      return Result;
   end Create_ValueExpression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return ValueExpression is
      Result : ValueExpression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      Result.Node := Node.all'Access;
      return Result;
   end Create_Expression;

   procedure Adjust (Object : in out Expression) is
   begin
      if Object.Node /= null then
         Object.Node.Ref_Counter := Object.Node.Ref_Counter + 1;
      end if;
   end Adjust;

   procedure Finalize (Object : in out Expression) is
      Node : EL.Expressions.Nodes.ELNode_Access;
   begin
      if Object.Node /= null then
         Node := Object.Node.all'Access;
         Node.Ref_Counter := Node.Ref_Counter - 1;
         if Node.Ref_Counter = 0 then
            EL.Expressions.Nodes.Delete (Node);
            Object.Node := null;
         end if;
      end if;
   end Finalize;

end EL.Expressions;

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

with EL.Expressions.Nodes;
with EL.Expressions.Parser;
package body EL.Expressions is

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object is
   begin
      if Expr.Node = null then
         return EL.Objects.Null_Object;
      end if;
      return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
   end Get_Value;

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : ValueExpression;
                       Context : ELContext'Class) return Object is
      pragma Unreferenced (Context);
   begin
      if Expr.Bean = null then
         if Expr.Node = null then
            return EL.Objects.Null_Object;
         else
            return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
         end if;
      end if;
      return To_Object (Expr.Bean);
   end Get_Value;

   procedure Set_Value (Expr    : in ValueExpression;
                        Context : in ELContext'Class;
                        Value   : in Object) is
   begin
      null;
   end Set_Value;

   function Is_Readonly (Expr : in ValueExpression) return Boolean is
   begin
      if Expr.Bean = null then
         return True;
      end if;
      return not (Expr.Bean.all in EL.Beans.Bean'Class);
   end Is_Readonly;

   --  ------------------------------
   --  Parse an expression and return its representation ready for evaluation.
   --  ------------------------------
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression is
      use EL.Expressions.Nodes;
      Result : Expression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      if Node /= null then
         Result.Node := Node.all'Access;
      end if;
      return Result;
   end Create_Expression;

   function Create_ValueExpression (Bean : access EL.Beans.Readonly_Bean'Class)
                                    return ValueExpression is
      Result : ValueExpression;
   begin
      Result.Bean := Bean;
      return Result;
   end Create_ValueExpression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return ValueExpression is
      Result : ValueExpression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      Result.Node := Node.all'Access;
      return Result;
   end Create_Expression;

   procedure Adjust (Object : in out Expression) is
   begin
      if Object.Node /= null then
         Object.Node.Ref_Counter := Object.Node.Ref_Counter + 1;
      end if;
   end Adjust;

   procedure Finalize (Object : in out Expression) is
      Node : EL.Expressions.Nodes.ELNode_Access;
   begin
      if Object.Node /= null then
         Node := Object.Node.all'Access;
         Node.Ref_Counter := Node.Ref_Counter - 1;
         if Node.Ref_Counter = 0 then
            EL.Expressions.Nodes.Delete (Node);
            Object.Node := null;
         end if;
      end if;
   end Finalize;

end EL.Expressions;

Fix Get_Value for the Value_Expression

Fix Get_Value for the Value_Expression


-----------------------------------------------------------------------
--  wiki-parsers-mediawiki -- Media Wiki parser operations
--  Copyright (C) 2011- 2022 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.Nodes;
with Wiki.Helpers;
with Wiki.Parsers.Common;
package body Wiki.Parsers.MediaWiki is

   use Wiki.Helpers;
   use Wiki.Buffers;
   use type Wiki.Nodes.Node_Kind;

   procedure Parse_Bold_Italic (Parser  : in out Parser_Type;
                                Text    : in out Wiki.Buffers.Buffer_Access;
                                From    : in out Positive);

   --  ------------------------------
   --  Parse an italic, bold or bold + italic sequence.
   --  Example:
   --    ''name''         (italic)
   --    '''name'''       (bold)
   --    '''''name'''''   (bold+italic)
   --  ------------------------------
   procedure Parse_Bold_Italic (Parser  : in out Parser_Type;
                                Text    : in out Wiki.Buffers.Buffer_Access;
                                From    : in out Positive) is
      Count : Natural := Count_Occurence (Text, From, ''');
   begin
      case Count is
         when 1 =>
            Common.Parse_Text (Parser, Text, From);
            return;

         when 2 =>
            Toggle_Format (Parser, ITALIC);

         when 3 =>
            Toggle_Format (Parser, BOLD);

         when 4 =>
            Toggle_Format (Parser, BOLD);
            Common.Parse_Text (Parser, Text, From);
            Count := 3;

         when 5 =>
            Toggle_Format (Parser, BOLD);
            Toggle_Format (Parser, ITALIC);

         when others =>
            Common.Parse_Text (Parser, Text, From);
            return;

      end case;
      for I in 1 .. Count loop
         Next (Text, From);
      end loop;
   end Parse_Bold_Italic;

   procedure Parse_Line (Parser : in out Parser_Type;
                         Text   : in Wiki.Buffers.Buffer_Access) is
      Pos    : Natural := 1;
      C      : Wiki.Strings.WChar;
      Buffer : Wiki.Buffers.Buffer_Access := Text;
   begin
      --  Feed the HTML parser if there are some pending state.
      if not Wiki.Html_Parser.Is_Empty (Parser.Html) then
         Common.Parse_Html_Element (Parser, Buffer, Pos, Start => False);
         if Buffer = null then
            return;
         end if;
      end if;

      if Parser.Pre_Tag_Counter > 0 then
         Common.Parse_Html_Preformatted (Parser, Buffer, Pos);
         if Buffer = null then
            return;
         end if;
      end if;

      if Parser.Current_Node = Nodes.N_PREFORMAT then
         if Buffer.Content (Pos) = ' ' then
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;
         end if;
         Pop_Block (Parser);
      end if;

      if Parser.Current_Node = Nodes.N_HEADER then
         Pop_Block (Parser);
      end if;

      C := Buffer.Content (Pos);
      case C is
         when CR | LF =>
            Common.Parse_Paragraph (Parser, Buffer, Pos);
            return;

         when '=' =>
            Common.Parse_Header (Parser, Buffer, Pos, '=');
            if Buffer = null then
               return;
            end if;

         when '-' =>
            Common.Parse_Horizontal_Rule (Parser, Buffer, Pos, '-');
            if Buffer = null then
               return;
            end if;

         when '*' | '#' =>
            if Common.Is_List (Buffer, Pos) then
               Common.Parse_List (Parser, Buffer, Pos);
            end if;

         when ' ' =>
            Parser.Preformat_Indent := 1;
            Parser.Preformat_Fence := ' ';
            Parser.Preformat_Fcount := 1;
            Flush_Text (Parser, Trim => Right);
            Pop_Block (Parser);
            Push_Block (Parser, Nodes.N_PREFORMAT);
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;

         when ';' =>
            Common.Parse_Definition (Parser, Buffer, Pos);
            return;

         when ':' =>
            if Parser.Current_Node = Nodes.N_DEFINITION then
               Next (Buffer, Pos);
               Common.Skip_Spaces (Buffer, Pos);
            end if;

         when others =>
            if Parser.Current_Node /= Nodes.N_PARAGRAPH then
               Pop_List (Parser);
               Push_Block (Parser, Nodes.N_PARAGRAPH);
            end if;

      end case;

      Main :
      while Buffer /= null loop
         declare
            Last : Natural := Buffer.Last;
         begin
            while Pos <= Last loop
               C := Buffer.Content (Pos);
               case C is
                  when ''' =>
                     Parse_Bold_Italic (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '/' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '/', Wiki.EMPHASIS);
                     exit Main when Buffer = null;

                  when '[' =>
                     Common.Parse_Link (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '{' =>
                     Common.Parse_Template (Parser, Buffer, Pos, '{');
                     exit Main when Buffer = null;

                  when CR | LF =>
                     Append (Parser.Text, ' ');
                     Pos := Pos + 1;

                  when '<' =>
                     Common.Parse_Html_Element (Parser, Buffer, Pos, Start => True);
                     exit Main when Buffer = null;

                  when '&' =>
                     Common.Parse_Entity (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when others =>
                     Append (Parser.Text, C);
                     Pos := Pos + 1;

               end case;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop Main;
   end Parse_Line;

end Wiki.Parsers.MediaWiki;

-----------------------------------------------------------------------
--  wiki-parsers-mediawiki -- Media Wiki parser operations
--  Copyright (C) 2011- 2022 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.Nodes;
with Wiki.Helpers;
with Wiki.Parsers.Common;
package body Wiki.Parsers.MediaWiki is

   use Wiki.Helpers;
   use Wiki.Buffers;
   use type Wiki.Nodes.Node_Kind;

   procedure Parse_Bold_Italic (Parser  : in out Parser_Type;
                                Text    : in out Wiki.Buffers.Buffer_Access;
                                From    : in out Positive);

   --  ------------------------------
   --  Parse an italic, bold or bold + italic sequence.
   --  Example:
   --    ''name''         (italic)
   --    '''name'''       (bold)
   --    '''''name'''''   (bold+italic)
   --  ------------------------------
   procedure Parse_Bold_Italic (Parser  : in out Parser_Type;
                                Text    : in out Wiki.Buffers.Buffer_Access;
                                From    : in out Positive) is
      Count : Natural := Count_Occurence (Text, From, ''');
   begin
      case Count is
         when 1 =>
            Common.Parse_Text (Parser, Text, From);
            return;

         when 2 =>
            Toggle_Format (Parser, ITALIC);

         when 3 =>
            Toggle_Format (Parser, BOLD);

         when 4 =>
            Toggle_Format (Parser, BOLD);
            Common.Parse_Text (Parser, Text, From);
            Count := 3;

         when 5 =>
            Toggle_Format (Parser, BOLD);
            Toggle_Format (Parser, ITALIC);

         when others =>
            Common.Parse_Text (Parser, Text, From);
            return;

      end case;
      for I in 1 .. Count loop
         Next (Text, From);
      end loop;
   end Parse_Bold_Italic;

   procedure Parse_Line (Parser : in out Parser_Type;
                         Text   : in Wiki.Buffers.Buffer_Access) is
      Pos    : Natural := 1;
      C      : Wiki.Strings.WChar;
      Buffer : Wiki.Buffers.Buffer_Access := Text;
   begin
      --  Feed the HTML parser if there are some pending state.
      if not Wiki.Html_Parser.Is_Empty (Parser.Html) then
         Common.Parse_Html_Element (Parser, Buffer, Pos, Start => False);
         if Buffer = null then
            return;
         end if;
      end if;

      if Parser.Pre_Tag_Counter > 0 then
         Common.Parse_Html_Preformatted (Parser, Buffer, Pos);
         if Buffer = null then
            return;
         end if;
      end if;

      if Parser.Current_Node = Nodes.N_PREFORMAT then
         if Buffer.Content (Pos) = ' ' then
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;
         end if;
         Pop_Block (Parser);
      end if;

      if Parser.Current_Node = Nodes.N_HEADER then
         Pop_Block (Parser);
      end if;

      C := Buffer.Content (Pos);
      case C is
         when CR | LF =>
            Common.Parse_Paragraph (Parser, Buffer, Pos);
            return;

         when '=' =>
            Common.Parse_Header (Parser, Buffer, Pos, '=');
            if Buffer = null then
               return;
            end if;

         when '-' =>
            Common.Parse_Horizontal_Rule (Parser, Buffer, Pos, '-');
            if Buffer = null then
               return;
            end if;

         when '*' | '#' =>
            if Common.Is_List (Buffer, Pos) then
               Common.Parse_List (Parser, Buffer, Pos);
            end if;

         when ' ' =>
            if Common.Is_List (Buffer, Pos + 1) then
               Pos := Pos + 1;
               Common.Parse_List (Parser, Buffer, Pos);
            end if;
         --   Parser.Preformat_Indent := 1;
         --   Parser.Preformat_Fence := ' ';
         --   Parser.Preformat_Fcount := 1;
         --   Flush_Text (Parser, Trim => Right);
         --   Pop_Block (Parser);
         --   Push_Block (Parser, Nodes.N_PREFORMAT);
         --   Common.Append (Parser.Text, Buffer, Pos + 1);
         --   return;

         when ';' =>
            Common.Parse_Definition (Parser, Buffer, Pos);
            return;

         when ':' =>
            if Parser.Current_Node = Nodes.N_DEFINITION then
               Next (Buffer, Pos);
               Common.Skip_Spaces (Buffer, Pos);
            end if;

         when others =>
            if Parser.Current_Node /= Nodes.N_PARAGRAPH then
               Pop_List (Parser);
               Push_Block (Parser, Nodes.N_PARAGRAPH);
            end if;

      end case;

      Main :
      while Buffer /= null loop
         declare
            Last : Natural := Buffer.Last;
         begin
            while Pos <= Buffer.Last loop
               C := Buffer.Content (Pos);
               case C is
                  when ''' =>
                     Parse_Bold_Italic (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '/' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '/', Wiki.EMPHASIS);
                     exit Main when Buffer = null;

                  when '[' =>
                     Common.Parse_Link (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '{' =>
                     Common.Parse_Template (Parser, Buffer, Pos, '{');
                     exit Main when Buffer = null;

                  when CR | LF =>
                     Append (Parser.Text, ' ');
                     Pos := Pos + 1;

                  when '<' =>
                     Common.Parse_Html_Element (Parser, Buffer, Pos, Start => True);
                     exit Main when Buffer = null;

                  when '&' =>
                     Common.Parse_Entity (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when others =>
                     Append (Parser.Text, C);
                     Pos := Pos + 1;

               end case;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop Main;
   end Parse_Line;

end Wiki.Parsers.MediaWiki;

Fix pre-formatting in the new Mediawiki parser


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

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Wiki.Strings.UString;
                              Width    : out Natural;
                              Height   : out Natural) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Wiki.Strings.UString;
                             Exists   : out Boolean) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Exists := True;
   end Make_Page_Link;

   --  ------------------------------
   --  Render the list of nodes from the document.
   --  ------------------------------
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access) is
      use type Wiki.Nodes.Node_List_Access;

      procedure Process (Node : in Wiki.Nodes.Node_Type);

      procedure Process (Node : in Wiki.Nodes.Node_Type) is
      begin
         Engine.Render (Doc, Node);
      end Process;

   begin
      if List /= null then
         Wiki.Nodes.Iterate (List, Process'Access);
      end if;
   end Render;

   --  ------------------------------
   --  Render the document.
   --  ------------------------------
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document) is
      procedure Process (Node : in Wiki.Nodes.Node_Type);

      procedure Process (Node : in Wiki.Nodes.Node_Type) is
      begin
         Engine.Render (Doc, Node);
      end Process;
   begin
      Doc.Iterate (Process'Access);
      Engine.Finish (Doc);
   end Render;

end Wiki.Render;

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

   --  ------------------------------
   --  Render the list of nodes from the document.
   --  ------------------------------
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document;
                     List   : in Wiki.Nodes.Node_List_Access) is
      use type Wiki.Nodes.Node_List_Access;

      procedure Process (Node : in Wiki.Nodes.Node_Type);

      procedure Process (Node : in Wiki.Nodes.Node_Type) is
      begin
         Engine.Render (Doc, Node);
      end Process;

   begin
      if List /= null then
         Wiki.Nodes.Iterate (List, Process'Access);
      end if;
   end Render;

   --  ------------------------------
   --  Render the document.
   --  ------------------------------
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Documents.Document) is
      procedure Process (Node : in Wiki.Nodes.Node_Type);

      procedure Process (Node : in Wiki.Nodes.Node_Type) is
      begin
         Engine.Render (Doc, Node);
      end Process;
   begin
      Doc.Iterate (Process'Access);
      Engine.Finish (Doc);
   end Render;

end Wiki.Render;

Move the Link_Renderer and Default_Link_Renderer in the Wiki.Render.Links package