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

with ASF.Server.Tests;
with ASF.Server.Web;
with ASF.Converters.Dates;

with ASF.Tests;

with AWA.Converters.Dates;
with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");

      if Add_Modules then
         declare
            Ctx    : AWA.Services.Contexts.Service_Context;
            Users : constant AWA.Users.Modules.User_Module_Access := AWA.Tests.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

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

with ASF.Server.Tests;
with ASF.Server.Web;

with ASF.Tests;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

Remove dependencies to AWA modules

Remove dependencies to AWA modules


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

--  = Blogs Module =
--  The `blogs` module is a small blog application which allows users
--  to publish articles.  A user may own several blogs, each blog having
--  a name and its own base URI.  Within a blog, the user may write articles
--  and publish them.  Once published, the articles are visible to
--  anonymous users.
--
--  The `blogs` module uses several other modules:
--
--  * the [Counters Module] to track page display counter to a blog post,
--  * the [Tags Module] to associate one or several tags to a blog post,
--  * the [Comments Module] to allow users to write comments on a blog post,
--  * the [Images Module] to easily add images in blog post.
--
--  @include awa-blogs-modules.ads
--  @include awa-blogs-beans.ads
--  @include-bean blogs.xml
--  @include-bean blog-admin-post-list.xml
--  @include-bean blog-post-list.xml
--  @include-bean blog-comment-list.xml
--  @include-bean blog-list.xml
--  @include-bean blog-tags.xml
--
--  == Queries ==
--  @include-query blog-admin-post-list.xml
--  @include-query blog-post-list.xml
--  @include-query blog-comment-list.xml
--  @include-query blog-list.xml
--  @include-query blog-tags.xml
--
--  == Data model ==
--  [images/awa_blogs_model.png]
--
package AWA.Blogs is

   pragma Pure;

end AWA.Blogs;

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

--  = Blogs Module =
--  The `blogs` module is a small blog application which allows users
--  to publish articles.  A user may own several blogs, each blog having
--  a name and its own base URI.  Within a blog, the user may write articles
--  and publish them.  Once published, the articles are visible to
--  anonymous users.
--
--  The `blogs` module uses several other modules:
--
--  * the [Counters Module] to track page display counter to a blog post,
--  * the [Tags Module] to associate one or several tags to a blog post,
--  * the [Comments Module] to allow users to write comments on a blog post,
--  * the [Images Module] to easily add images in blog post.
--
--  @include awa-blogs-modules.ads
--  @include awa-blogs-beans.ads
--  @include-bean blogs.xml
--  @include-bean blog-admin-post-list.xml
--  @include-bean blog-post-list.xml
--  @include-bean blog-comment-list.xml
--  @include-bean blog-list.xml
--  @include-bean blog-tags.xml
--
--  == Queries ==
--  @include-query blog-admin-post-list.xml
--  @include-query blog-post-list.xml
--  @include-query blog-comment-list.xml
--  @include-query blog-list.xml
--  @include-query blog-tags.xml
--  @include-query blog-images.xml
--  @include-query blog-images-info.xml
--  @include-query blog-stat.xml
--
--  == Data model ==
--  [images/awa_blogs_model.png]
--
package AWA.Blogs is

   pragma Pure;

end AWA.Blogs;

Add more documentation

Add more documentation


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

with Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with Security.Permissions;
with Util.Serialize.Mappers;
limited with Security.Controllers;
limited with Security.Contexts;

--  == Security Policies ==
--  The Security Policy defines and implements the set of security rules that specify
--  how to protect the system or resources. The <tt>Policy_Manager</tt> maintains
--  the security policies.  These policies are registered when an application starts,
--  before reading the policy configuration files.
--
--  [[images/PolicyModel.png]]
--
--  While the policy configuration files are processed, the policy instances that have been
--  registered will create a security controller and bind it to a given permission.  After
--  successful initialization, the <tt>Policy_Manager</tt> contains a list of securiy
--  controllers which are associated with each permission defined by the application.
--
--  === Authenticated Permission ===
--  The `auth-permission` is a pre-defined permission that can be configured in the XML
--  configuration.  Basically the permission is granted if the security context has a principal.
--  Otherwise the permission is denied.  The permission is assigned a name and is declared
--  as follows:
--
--    <policy-rules>
--      <auth-permission>
--        <name>view-profile</name>
--      </auth-permission>
--    </policy-rules>
--
--  This example defines the `view-profile` permission.
--
--  === Grant Permission ===
--  The `grant-permission` is another pre-defined permission that gives the permission whatever
--  the security context.  The permission is defined as follows:
--
--    <policy-rules>
--      <grant-permission>
--        <name>anonymous</name>
--      </grant-permission>
--    </policy-rules>
--
--  This example defines the `anonymous` permission.
--
--  @include security-policies-roles.ads
--  @include security-policies-urls.ads
---  @include security-controllers.ads
package Security.Policies is

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is
     array (Permissions.Permission_Index range <>) of Controller_Access;

   type Policy_Index is new Positive;

   type Policy_Context is limited interface;
   type Policy_Context_Access is access all Policy_Context'Class;

   type Policy_Context_Array is
     array (Policy_Index range <>) of Policy_Context_Access;
   type Policy_Context_Array_Access is access Policy_Context_Array;

   --  ------------------------------
   --  Security policy
   --  ------------------------------
   type Policy is abstract new Ada.Finalization.Limited_Controlled with private;
   type Policy_Access is access all Policy'Class;

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is abstract;

   --  Get the policy index.
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index;
   pragma Inline (Get_Policy_Index);

   --  Prepare the XML parser to read the policy configuration.
   procedure Prepare_Config (Pol     : in out Policy;
                             Mapper  : in out Util.Serialize.Mappers.Processing) is null;

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   procedure Finish_Config (Into    : in out Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access);

   Invalid_Name : exception;

   Policy_Error : exception;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with private;
   type Policy_Manager_Access is access all Policy_Manager'Class;

   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access;

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access);

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Checks whether the permission defined by the Permission controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

   --  Returns True if the security controller is defined for the given permission index.
   function Has_Controller (Manager : in Policy_Manager;
                            Index   : in Permissions.Permission_Index) return Boolean;

   --  Create the policy contexts to be associated with the security context.
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access;

   --  Prepare the XML parser to read the policy configuration.
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Mapper  : in out Util.Serialize.Mappers.Processing);

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager);

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Policy_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Policy_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

private

   subtype Permission_Index is Permissions.Permission_Index;

   type Permission_Index_Array is array (Positive range <>) of Permissions.Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Policy_Access_Array is array (Policy_Index range <>) of Policy_Access;

   type Policy is abstract new Ada.Finalization.Limited_Controlled with record
      Manager : Policy_Manager_Access;
      Index   : Policy_Index := Policy_Index'First;
   end record;

   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with record
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;

      --  The security policies.
      Policies     : Policy_Access_Array (1 .. Max_Policies);
   end record;

end Security.Policies;

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

with Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with Security.Permissions;
with Util.Serialize.Mappers;
limited with Security.Controllers;
limited with Security.Contexts;

--  = Security Policies =
--  The Security Policy defines and implements the set of security rules that specify
--  how to protect the system or resources. The `Policy_Manager` maintains
--  the security policies.  These policies are registered when an application starts,
--  before reading the policy configuration files.
--
--  [[images/PolicyModel.png]]
--
--  While the policy configuration files are processed, the policy instances that have been
--  registered will create a security controller and bind it to a given permission.  After
--  successful initialization, the `Policy_Manager` contains a list of securiy
--  controllers which are associated with each permission defined by the application.
--
--  == Authenticated Permission ==
--  The `auth-permission` is a pre-defined permission that can be configured in the XML
--  configuration.  Basically the permission is granted if the security context has a principal.
--  Otherwise the permission is denied.  The permission is assigned a name and is declared
--  as follows:
--
--    <policy-rules>
--      <auth-permission>
--        <name>view-profile</name>
--      </auth-permission>
--    </policy-rules>
--
--  This example defines the `view-profile` permission.
--
--  == Grant Permission ==
--  The `grant-permission` is another pre-defined permission that gives the permission whatever
--  the security context.  The permission is defined as follows:
--
--    <policy-rules>
--      <grant-permission>
--        <name>anonymous</name>
--      </grant-permission>
--    </policy-rules>
--
--  This example defines the `anonymous` permission.
--
--  @include security-policies-roles.ads
--  @include security-policies-urls.ads
---  @include security-controllers.ads
package Security.Policies is

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is
     array (Permissions.Permission_Index range <>) of Controller_Access;

   type Policy_Index is new Positive;

   type Policy_Context is limited interface;
   type Policy_Context_Access is access all Policy_Context'Class;

   type Policy_Context_Array is
     array (Policy_Index range <>) of Policy_Context_Access;
   type Policy_Context_Array_Access is access Policy_Context_Array;

   --  ------------------------------
   --  Security policy
   --  ------------------------------
   type Policy is abstract new Ada.Finalization.Limited_Controlled with private;
   type Policy_Access is access all Policy'Class;

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is abstract;

   --  Get the policy index.
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index;
   pragma Inline (Get_Policy_Index);

   --  Prepare the XML parser to read the policy configuration.
   procedure Prepare_Config (Pol     : in out Policy;
                             Mapper  : in out Util.Serialize.Mappers.Processing) is null;

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   procedure Finish_Config (Into    : in out Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access);

   Invalid_Name : exception;

   Policy_Error : exception;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with private;
   type Policy_Manager_Access is access all Policy_Manager'Class;

   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access;

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access);

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Checks whether the permission defined by the Permission controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

   --  Returns True if the security controller is defined for the given permission index.
   function Has_Controller (Manager : in Policy_Manager;
                            Index   : in Permissions.Permission_Index) return Boolean;

   --  Create the policy contexts to be associated with the security context.
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access;

   --  Prepare the XML parser to read the policy configuration.
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Mapper  : in out Util.Serialize.Mappers.Processing);

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager);

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Policy_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Policy_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

private

   subtype Permission_Index is Permissions.Permission_Index;

   type Permission_Index_Array is array (Positive range <>) of Permissions.Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Policy_Access_Array is array (Policy_Index range <>) of Policy_Access;

   type Policy is abstract new Ada.Finalization.Limited_Controlled with record
      Manager : Policy_Manager_Access;
      Index   : Policy_Index := Policy_Index'First;
   end record;

   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with record
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;

      --  The security policies.
      Policies     : Policy_Access_Array (1 .. Max_Policies);
   end record;

end Security.Policies;

Update the documentation

Update the documentation


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

with Ada.Finalization;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with Security.Permissions;
limited with Security.Controllers;
limited with Security.Contexts;

package Security.Policies is

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is
     array (Permissions.Permission_Index range <>) of Controller_Access;

   type Policy_Index is new Positive;

   type Policy_Context is limited interface;
   type Policy_Context_Access is access all Policy_Context'Class;

   type Policy_Context_Array is
     array (Policy_Index range <>) of Policy_Context_Access;
   type Policy_Context_Array_Access is access Policy_Context_Array;

   --  ------------------------------
   --  Security policy
   --  ------------------------------
   type Policy is new Ada.Finalization.Limited_Controlled with private;
   type Policy_Access is access all Policy'Class;

   --  Get the policy name.
   function Get_Name (From : in Policy) return String;

   --  Get the policy index.
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index;
   pragma Inline (Get_Policy_Index);

   --  Prepare the XML parser to read the policy configuration.
   procedure Prepare_Config (Pol     : in out Policy;
                             Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   procedure Finish_Config (Into    : in out Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is null;

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access);

   Invalid_Name : exception;

   Policy_Error : exception;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with private;
   type Policy_Manager_Access is access all Policy_Manager'Class;

   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access;

   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access);

   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Checks whether the permission defined by the Permission controller data is granted
   --  by the security context passed in Context.
   --  Returns true if such permission is granted.
   function Has_Permission (Manager : in Policy_Manager;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

   --  Create the policy contexts to be associated with the security context.
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access;

   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access;
   pragma Inline_Always (Get_Controller);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager);

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Policy_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Policy_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

private

   subtype Permission_Index is Permissions.Permission_Index;

   type Permission_Index_Array is array (Positive range <>) of Permissions.Permission_Index;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Policy_Access_Array is array (Policy_Index range <>) of Policy_Access;

   type Policy is new Ada.Finalization.Limited_Controlled with record
      Manager : Policy_Manager_Access;
      Index   : Policy_Index;
   end record;

   type Policy_Manager (Max_Policies : Policy_Index) is
     new Ada.Finalization.Limited_Controlled with record
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;

      --  The security policies.
      Policies     : Policy_Access_Array (1 .. Max_Policies);
   end record;

end Security.Policies;

Fix indentation

Fix indentation


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

with Ada.Text_IO;
with Ada.Strings.Fixed;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Ahven.Runner;
with Ahven.XML_Runner;
with Ahven.AStrings;

use Ada.Text_IO;
use Ada.Strings.Fixed;

package body Ahven.Text_Runner is
   use Ahven.Results;
   use Ahven.Framework;
   use Ahven.AStrings;

   -- Local procedures
   procedure Pad (Level : Natural);

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String);

   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural);

   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False);

   procedure Print_Log_File (Filename : String);

   procedure Pad (Level : Natural) is
   begin
      for A in Integer range 1 .. Level loop
         Put (" ");
      end loop;
   end Pad;

   procedure Pad (Amount : in     Natural;
                  Total  : in out Natural) is
   begin
      for A in Natural range 1 .. Amount loop
         Put (" ");
      end loop;
      Total := Total + Amount;
   end Pad;

   procedure Multiline_Pad (Input : String;
                            Level : Natural) is
   begin
      Pad (Level);
      for A in Input'Range loop
         Put (Input (A));
         if (Input (A) = Ada.Characters.Latin_1.LF) and (A /= Input'Last) then
            Pad (Level);
         end if;
      end loop;
   end Multiline_Pad;

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String) is
      use Ada.Strings;

      Max_Output_Width   : constant := 50;
      Max_Result_Width   : constant := 7;
      Max_Time_Out_Width : constant := 12;

      subtype Result_Size is Integer range 1 .. Max_Result_Width;
      subtype Time_Out_Size is Integer range 1 .. Max_Time_Out_Width;

      procedure Print_Text (Str : String; Total : in out Natural) is
      begin
         Put (Str);
         Total := Total + Str'Length;
      end Print_Text;

      Msg        : constant String := Get_Message (Info);
      Result_Out : String (Result_Size) := (others => ' ');
      Time_Out   : String (Time_Out_Size) := (others => ' ');
      Total_Text : Natural := 0;

   begin
      Pad (Level + 1, Total_Text);
      Print_Text (Get_Routine_Name (Info), Total_Text);
      if Msg'Length > 0 then
         Print_Text (" - ", Total_Text);
         Print_Text (Msg, Total_Text);
      end if;

      if Total_Text < Max_Output_Width then
         Pad (Max_Output_Width - Total_Text, Total_Text);
      end if;

      -- If we know the name of the routine, we print it,
      -- the result, and the execution time.
      if Get_Routine_Name (Info)'Length > 0 then
         Move (Source  => Result,
               Target  => Result_Out,
               Drop    => Right,
               Justify => Left,
               Pad     => ' ');
         Move (Source  => Duration'Image (Get_Execution_Time (Info)),
               Target  => Time_Out,
               Drop    => Right,
               Justify => Right,
               Pad     => ' ');
         Put (" " & Result_Out);
         Put (" " & Time_Out & "s");
      end if;
      if Get_Long_Message (Info)'Length > 0 then
         New_Line;
         Multiline_Pad (Get_Long_Message (Info), Level + 2);
      end if;

      New_Line;
   end Print_Test;

   type Print_Child_Proc is access
     procedure (Result : Result_Collection; Level : Natural);

   type Child_Count_Proc is access
     function (Result : Result_Collection) return Natural;

   procedure Print_Children (Result : Result_Collection;
                             Level  : Natural;
                             Action : Print_Child_Proc;
                             Count  : Child_Count_Proc)
   is
      Child_Iter : Result_Collection_Cursor := First_Child (Result);
   begin
      loop
         exit when not Is_Valid (Child_Iter);
         if Count.all (Data (Child_Iter).all) > 0 then
            Action.all (Data (Child_Iter).all, Level + 1);
         end if;
         Child_Iter := Next (Child_Iter);
      end loop;
   end Print_Children;

   procedure Print_Statuses (Result    : Result_Collection;
                             Level     : Natural;
                             Start     : Result_Info_Cursor;
                             Action    : Print_Child_Proc;
                             Status    : String;
                             Count     : Child_Count_Proc;
                             Print_Log : Boolean) is
      Position : Result_Info_Cursor := Start;
   begin
      if Length (Get_Test_Name (Result)) > 0 then
         Pad (Level);
         Put_Line (To_String (Get_Test_Name (Result)) & ":");
      end if;

      Test_Loop :
      loop
         exit Test_Loop when not Is_Valid (Position);
         Print_Test (Data (Position), Level, Status);
         if Print_Log and
           (Length (Get_Output_File (Data (Position))) > 0) then
            Print_Log_File (To_String (Get_Output_File (Data (Position))));
         end if;
         Position := Next (Position);
      end loop Test_Loop;

      Print_Children (Result => Result,
                      Level  => Level,
                      Action => Action,
                      Count  => Count);
   end Print_Statuses;

   --
   -- Print all failures from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Failures (Result : Result_Collection;
                             Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Failure (Result),
         Action    => Print_Failures'Access,
         Status    => "FAIL",
         Count     => Failure_Count'Access,
         Print_Log => True);
   end Print_Failures;

   --
   -- Print all skips from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Skips (Result : Result_Collection;
                          Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Skipped (Result),
         Action    => Print_Skips'Access,
         Status    => "SKIPPED",
         Count     => Skipped_Count'Access,
         Print_Log => True);
   end Print_Skips;

   --
   -- Print all errors from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Errors (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Error (Result),
         Action    => Print_Errors'Access,
         Status    => "ERROR",
         Count     => Error_Count'Access,
         Print_Log => True);
   end Print_Errors;

   --
   -- Print all passes from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Pass (Result),
         Action    => Print_Passes'Access,
         Status    => "PASS",
         Count     => Pass_Count'Access,
         Print_Log => False);
   end Print_Passes;

   --
   -- Report passes, skips, failures, and errors from the result collection.
   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False) is
   begin
      Put_Line ("Passed : " & Integer'Image (Pass_Count (Result)));
      if Verbose then
         Print_Passes (Result => Result, Level => 0);
      end if;
      New_Line;
      if Skipped_Count (Result) > 0 then
         Put_Line ("Skipped : " & Integer'Image (Skipped_Count (Result)));
         Print_Skips (Result => Result, Level => 0);
         New_Line;
      end if;
      if Failure_Count (Result) > 0 then
         Put_Line ("Failed : " & Integer'Image (Failure_Count (Result)));
         Print_Failures (Result => Result, Level => 0);
         New_Line;
      end if;
      if Error_Count (Result) > 0 then
         Put_Line ("Errors : " & Integer'Image (Error_Count (Result)));
         Print_Errors (Result => Result, Level => 0);
      end if;
   end Report_Results;

   procedure Print_Log_File (Filename : String) is
      Handle : File_Type;
      Char   : Character := ' ';
      First  : Boolean := True;
   begin
      Open (Handle, In_File, Filename);
      begin
         loop
            exit when End_Of_File (Handle);
            Get (Handle, Char);
            if First then
               Put_Line ("===== Output =======");
               First := False;
            end if;
            Put (Char);
            if End_Of_Line (Handle) then
               New_Line;
            end if;

         end loop;

         --  The End_Error exception is sometimes raised.
      exception
         when Ada.IO_Exceptions.End_Error =>
            null;

      end;
      Close (Handle);
      if not First then
         Put_Line ("====================");
      end if;
   end Print_Log_File;

   procedure Do_Report (Test_Results : Results.Result_Collection;
                        Args         : Parameters.Parameter_Info) is
   begin
      if Parameters.XML_Results (Args) then
         XML_Runner.Report_Results
           (Test_Results, Parameters.Result_Dir (Args));
      else
         Report_Results (Test_Results, Parameters.Verbose (Args));
      end if;
   end Do_Report;

   procedure Run (Suite : in out Framework.Test'Class) is
   begin
      Runner.Run_Suite (Suite, Do_Report'Access);
   end Run;

   procedure Run (Suite : Framework.Test_Suite_Access) is
   begin
      Run (Suite.all);
   end Run;
end Ahven.Text_Runner;

Fix style warning

Fix style warning


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

--  == HTML Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Html is

   --  ------------------------------
   --  Wiki to HTML renderer
   --  ------------------------------
   type Html_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access);

   --  Set the link renderer.
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a quote.
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   procedure Add_Text (Engine   : in out Html_Renderer;
                       Text     : in Wiki.Strings.WString;
                       Format   : in Wiki.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Document : in out Html_Renderer);

private

   procedure Close_Paragraph (Document : in out Html_Renderer);
   procedure Open_Paragraph (Document : in out Html_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   Default_Links : aliased Default_Link_Renderer;

   type Html_Renderer is new Renderer with record
      Output         : Wiki.Streams.Html.Html_Output_Stream_Access := null;
      Format         : Wiki.Format_Map := (others => False);
      Links          : Link_Renderer_Access := Default_Links'Access;
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Has_Item       : Boolean := False;
      Current_Level  : Natural := 0;
      List_Styles    : List_Style_Array := (others => False);
      Quote_Level    : Natural := 0;
      Html_Level     : Natural := 0;
   end record;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type);

   --  Render a section header in the document.
   procedure Render_Header (Engine : in out Html_Renderer;
                            Header : in Wiki.Strings.WString;
                            Level  : in Positive);

   --  Render a link.
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type);

   --  Render an image.
   procedure Render_Image (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type);

end Wiki.Render.Html;

-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 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 Wiki.Attributes;
with Wiki.Streams.Html;
with Wiki.Strings;

--  == HTML Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Html is

   --  ------------------------------
   --  Wiki to HTML renderer
   --  ------------------------------
   type Html_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access);

   --  Set the link renderer.
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a text block with the given format.
   procedure Add_Text (Engine   : in out Html_Renderer;
                       Text     : in Wiki.Strings.WString;
                       Format   : in Wiki.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Document : in out Html_Renderer);

private

   procedure Close_Paragraph (Document : in out Html_Renderer);
   procedure Open_Paragraph (Document : in out Html_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   Default_Links : aliased Default_Link_Renderer;

   type Html_Renderer is new Renderer with record
      Output         : Wiki.Streams.Html.Html_Output_Stream_Access := null;
      Format         : Wiki.Format_Map := (others => False);
      Links          : Link_Renderer_Access := Default_Links'Access;
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Has_Item       : Boolean := False;
      Current_Level  : Natural := 0;
      List_Styles    : List_Style_Array := (others => False);
      Quote_Level    : Natural := 0;
      Html_Level     : Natural := 0;
   end record;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type);

   --  Render a section header in the document.
   procedure Render_Header (Engine : in out Html_Renderer;
                            Header : in Wiki.Strings.WString;
                            Level  : in Positive);

   --  Render a link.
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type);

   --  Render an image.
   procedure Render_Image (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type);

end Wiki.Render.Html;

Replace Add_Quote by Render_Quote procedure


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

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

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

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   procedure Add_Header (Document : in out Text_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
      pragma Unreferenced (Level);
   begin
      Document.Close_Paragraph;
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Writer.Write (Header);
      Document.Add_Line_Break;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (<br>).
   --  ------------------------------
   procedure Add_Line_Break (Document : in out Text_Renderer) is
   begin
      Document.Writer.Write (Ada.Characters.Conversions.To_Wide_Wide_Character (ASCII.LF));
      Document.Empty_Line := True;
   end Add_Line_Break;

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   procedure Add_Text (Document : in out Text_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
      pragma Unreferenced (Format);
   begin
      if Document.Empty_Line and Document.Indent_Level /= 0 then
         for I in 1 .. Document.Indent_Level loop
            Document.Writer.Write (' ');
         end loop;
      end if;
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Text;

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

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

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

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

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

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

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

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

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

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

end Wiki.Render.Text;

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   procedure Add_Text (Document : in out Text_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
      pragma Unreferenced (Format);
   begin
      if Document.Empty_Line and Document.Indent_Level /= 0 then
         for I in 1 .. Document.Indent_Level loop
            Document.Writer.Write (' ');
         end loop;
      end if;
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Text;

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

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

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

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

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

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

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

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

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

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

end Wiki.Render.Text;

Remove the Add_Header operation

Remove the Add_Header operation


-----------------------------------------------------------------------
--  wiki-render-text -- Wiki Text renderer
--  Copyright (C) 2011, 2012, 2013, 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 Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  == Text Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Text is

   --  ------------------------------
   --  Wiki to Text renderer
   --  ------------------------------
   type Text_Renderer is new Wiki.Render.Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a line break (<br>).
   procedure Add_Line_Break (Document : in out Text_Renderer);

   --  Render a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Render_Blockquote (Engine : in out Text_Renderer;
                                Level  : in Natural);

   --  Render a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Render_List_Item (Engine   : in out Text_Renderer;
                               Level    : in Positive;
                               Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine   : in out Text_Renderer;
                          Title    : in Wiki.Strings.WString;
                          Attr     : in Wiki.Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine   : in out Text_Renderer;
                           Title    : in Wiki.Strings.WString;
                           Attr     : in Wiki.Attributes.Attribute_List);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine   : in out Text_Renderer;
                                  Text     : in Wiki.Strings.WString;
                                  Format   : in Wiki.Strings.WString);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document);

private

   --  Emit a new line.
   procedure New_Line (Document : in out Text_Renderer);

   procedure Close_Paragraph (Document : in out Text_Renderer);
   procedure Open_Paragraph (Document : in out Text_Renderer);

   type Text_Renderer is new Wiki.Render.Renderer with record
      Output         : Streams.Output_Stream_Access := null;
      Format         : Wiki.Format_Map := (others => False);
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Empty_Line     : Boolean := True;
      Indent_Level   : Natural := 0;
   end record;

end Wiki.Render.Text;

-----------------------------------------------------------------------
--  wiki-render-text -- Wiki Text renderer
--  Copyright (C) 2011, 2012, 2013, 2015, 2016, 2019 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.Attributes;
with Wiki.Streams;
with Wiki.Strings;

--  == Text Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Text is

   --  ------------------------------
   --  Wiki to Text renderer
   --  ------------------------------
   type Text_Renderer is new Wiki.Render.Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Text_Renderer;
                                Stream : in Streams.Output_Stream_Access);

   --  Set the no-newline mode to produce a single line text (disabled by default).
   procedure Set_No_Newline (Engine : in out Text_Renderer;
                             Enable : in Boolean);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a line break (<br>).
   procedure Add_Line_Break (Document : in out Text_Renderer);

   --  Render a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Render_Blockquote (Engine : in out Text_Renderer;
                                Level  : in Natural);

   --  Render a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Render_List_Item (Engine   : in out Text_Renderer;
                               Level    : in Positive;
                               Ordered  : in Boolean);

   --  Render a link.
   procedure Render_Link (Engine   : in out Text_Renderer;
                          Title    : in Wiki.Strings.WString;
                          Attr     : in Wiki.Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine   : in out Text_Renderer;
                           Title    : in Wiki.Strings.WString;
                           Attr     : in Wiki.Attributes.Attribute_List);

   --  Render a text block that is pre-formatted.
   procedure Render_Preformatted (Engine   : in out Text_Renderer;
                                  Text     : in Wiki.Strings.WString;
                                  Format   : in Wiki.Strings.WString);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Engine : in out Text_Renderer;
                     Doc    : in Wiki.Documents.Document);

private

   --  Emit a new line.
   procedure New_Line (Document : in out Text_Renderer);

   procedure Close_Paragraph (Document : in out Text_Renderer);
   procedure Open_Paragraph (Document : in out Text_Renderer);

   type Text_Renderer is new Wiki.Render.Renderer with record
      Output         : Streams.Output_Stream_Access := null;
      Format         : Wiki.Format_Map := (others => False);
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Empty_Line     : Boolean := True;
      No_Newline     : Boolean := False;
      Indent_Level   : Natural := 0;
   end record;

end Wiki.Render.Text;

Add Set_No_Newline to drop the newlines in the text document