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

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

with Security.Contexts;

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

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

   use Util.Tests;
   use ADO;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      Do_Vote (T);
   end Test_Question_Vote;

end AWA.Questions.Modules.Tests;

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

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

with Security.Contexts;

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

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

   use Util.Tests;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      Do_Vote (T);
   end Test_Question_Vote;

end AWA.Questions.Modules.Tests;

Fix compilation warning

Fix compilation warning


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

--  = Wiki =
--  The Wiki engine parses a Wiki text in several Wiki syntax such as `MediaWiki`,
--  `Creole`, `Markdown`, `Dotclear` and renders the result either in HTML, text or into
--  another Wiki format.  The Wiki engine is used in two steps:
--
--  * The Wiki text is parsed according to its syntax to produce a Wiki Document instance.
--  * The Wiki document is then rendered by a renderer to produce the final HTML, text.
--
--  Through this process, it is possible to insert filters and plugins to customize the
--  parsing and the rendering.
--
--  [images/ada-wiki.png]
--
--  The Ada Wiki engine is organized in several packages:
--
--  * The [Wiki Streams](#wiki-streams) packages define the interface, types and operations
--  for the Wiki engine to read the Wiki or HTML content and for the Wiki renderer to generate
--  the HTML or text outputs.
--  * The [Wiki parser](#wiki-parsers) is responsible for parsing HTML or Wiki content
--  according to a selected Wiki syntax.  It builds the final Wiki document through filters
--  and plugins.
--  * The [Wiki Filters](#wiki-filters) provides a simple filter framework that allows to plug
--  specific filters when a Wiki document is parsed and processed.  Filters are used for the
--  table of content generation, for the HTML filtering, to collect words or links
--  and so on.
--  * The [Wiki Plugins](#wiki-plugins) defines the plugin interface that is used
--  by the Wiki engine to provide pluggable extensions in the Wiki.  Plugins are used
--  for the Wiki template support, to hide some Wiki text content when it is rendered
--  or to interact with other systems.
--  * The Wiki documents and attributes are used for the representation of the Wiki
--  document after the Wiki content is parsed.
--  * The [Wiki renderers](@wiki-render) are the last packages which are used for the rendering
--  of the Wiki document to produce the final HTML or text.
--
--  @include-doc docs/Tutorial.md
--  @include wiki-documents.ads
--  @include wiki-attributes.ads
--  @include wiki-parsers.ads
--  @include wiki-filters.ads
--  @include wiki-plugins.ads
--  @include wiki-render.ads
--  @include wiki-streams.ads
package Wiki is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax
      is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  Textile syntax
         --  https://www.redmine.org/projects/redmine/wiki/RedmineTextFormattingTextile
         SYNTAX_TEXTILE,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Defines the possible text formats.
   type Format_Type is (BOLD, ITALIC, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT, PREFORMAT);

   type Format_Map is array (Format_Type) of Boolean;

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag is
     (
      --  Section 4.1 The root element
      ROOT_HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Deprecated tags but still used widely
      TT_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag) return String_Access;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   No_End_Tag   : constant Tag_Boolean_Array :=
     (
      BASE_TAG   => True,
      LINK_TAG   => True,
      META_TAG   => True,
      IMG_TAG    => True,
      HR_TAG     => True,
      BR_TAG     => True,
      WBR_TAG    => True,
      INPUT_TAG  => True,
      KEYGEN_TAG => True,
      others     => False);

   Tag_Omission : constant Tag_Boolean_Array :=
     (
      --  Section 4.4 Grouping content
      LI_TAG    => True,
      DT_TAG    => True,
      DD_TAG    => True,

      --  Section 4.5 Text-level semantics
      RB_TAG    => True,
      RT_TAG    => True,
      RTC_TAG   => True,
      RP_TAG    => True,

      --  Section 4.9 Tabular data
      TH_TAG    => True,
      TD_TAG    => True,
      TR_TAG    => True,
      TBODY_TAG => True,
      THEAD_TAG => True,
      TFOOT_TAG => True,

      OPTGROUP_TAG => True,
      OPTION_TAG   => True,

      others    => False);

end Wiki;

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

--  = Wiki =
--  The Wiki engine parses a Wiki text in several Wiki syntax such as `MediaWiki`,
--  `Creole`, `Markdown`, `Dotclear` and renders the result either in HTML, text or into
--  another Wiki format.  The Wiki engine is used in two steps:
--
--  * The Wiki text is parsed according to its syntax to produce a Wiki Document instance.
--  * The Wiki document is then rendered by a renderer to produce the final HTML, text.
--
--  Through this process, it is possible to insert filters and plugins to customize the
--  parsing and the rendering.
--
--  [images/ada-wiki.png]
--
--  The Ada Wiki engine is organized in several packages:
--
--  * The [Wiki Streams](#wiki-streams) packages define the interface, types and operations
--  for the Wiki engine to read the Wiki or HTML content and for the Wiki renderer to generate
--  the HTML or text outputs.
--  * The [Wiki parser](#wiki-parsers) is responsible for parsing HTML or Wiki content
--  according to a selected Wiki syntax.  It builds the final Wiki document through filters
--  and plugins.
--  * The [Wiki Filters](#wiki-filters) provides a simple filter framework that allows to plug
--  specific filters when a Wiki document is parsed and processed.  Filters are used for the
--  table of content generation, for the HTML filtering, to collect words or links
--  and so on.
--  * The [Wiki Plugins](#wiki-plugins) defines the plugin interface that is used
--  by the Wiki engine to provide pluggable extensions in the Wiki.  Plugins are used
--  for the Wiki template support, to hide some Wiki text content when it is rendered
--  or to interact with other systems.
--  * The Wiki documents and attributes are used for the representation of the Wiki
--  document after the Wiki content is parsed.
--  * The [Wiki renderers](@wiki-render) are the last packages which are used for the rendering
--  of the Wiki document to produce the final HTML or text.
--
--  @include-doc docs/Tutorial.md
--  @include wiki-documents.ads
--  @include wiki-attributes.ads
--  @include wiki-parsers.ads
--  @include wiki-filters.ads
--  @include wiki-plugins.ads
--  @include wiki-render.ads
--  @include wiki-streams.ads
package Wiki is

   pragma Preelaborate;

   --  Defines the possible wiki syntax supported by the parser.
   type Wiki_Syntax
      is (
         --  Google wiki syntax http://code.google.com/p/support/wiki/WikiSyntax
         SYNTAX_GOOGLE,

         --  Creole wiki syntax http://www.wikicreole.org/wiki/Creole1.0
         SYNTAX_CREOLE,

         --  Dotclear syntax http://dotclear.org/documentation/2.0/usage/syntaxes
         SYNTAX_DOTCLEAR,

         --  PhpBB syntax http://wiki.phpbb.com/Help:Formatting
         SYNTAX_PHPBB,

         --  MediaWiki syntax http://www.mediawiki.org/wiki/Help:Formatting
         SYNTAX_MEDIA_WIKI,

         --  Markdown
         SYNTAX_MARKDOWN,

         --  Textile syntax
         --  https://www.redmine.org/projects/redmine/wiki/RedmineTextFormattingTextile
         SYNTAX_TEXTILE,

         --  A mix of the above
         SYNTAX_MIX,

         --  The input is plain possibly incorrect HTML.
         SYNTAX_HTML);

   --  Defines the possible text formats.
   type Format_Type is (BOLD, STRONG, ITALIC, EMPHASIS, CODE, SUPERSCRIPT, SUBSCRIPT, STRIKEOUT, PREFORMAT);

   type Format_Map is array (Format_Type) of Boolean;

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag is
     (
      --  Section 4.1 The root element
      ROOT_HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Deprecated tags but still used widely
      TT_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   --  Find the tag from the tag name.
   function Find_Tag (Name : in Wide_Wide_String) return Html_Tag;

   type String_Access is access constant String;

   --  Get the HTML tag name.
   function Get_Tag_Name (Tag : in Html_Tag) return String_Access;

   type Tag_Boolean_Array is array (Html_Tag) of Boolean;

   No_End_Tag   : constant Tag_Boolean_Array :=
     (
      BASE_TAG   => True,
      LINK_TAG   => True,
      META_TAG   => True,
      IMG_TAG    => True,
      HR_TAG     => True,
      BR_TAG     => True,
      WBR_TAG    => True,
      INPUT_TAG  => True,
      KEYGEN_TAG => True,
      others     => False);

   Tag_Omission : constant Tag_Boolean_Array :=
     (
      --  Section 4.4 Grouping content
      LI_TAG    => True,
      DT_TAG    => True,
      DD_TAG    => True,

      --  Section 4.5 Text-level semantics
      RB_TAG    => True,
      RT_TAG    => True,
      RTC_TAG   => True,
      RP_TAG    => True,

      --  Section 4.9 Tabular data
      TH_TAG    => True,
      TD_TAG    => True,
      TR_TAG    => True,
      TBODY_TAG => True,
      THEAD_TAG => True,
      TFOOT_TAG => True,

      OPTGROUP_TAG => True,
      OPTION_TAG   => True,

      others    => False);

end Wiki;

Add STRONG and EMPHASIS formats

Add STRONG and EMPHASIS formats


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

   --  ------------------------------
   --  Render the panel header.
   --  ------------------------------
   procedure Render_Header (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Header       : Util.Beans.Objects.Object;
      Header_Facet : ASF.Components.Base.UIComponent_Access;
   begin
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "ui-panel-header");
      Header := UI.Get_Attribute (Name => HEADER_ATTR_NAME, Context => Context);
      if not Util.Beans.Objects.Is_Empty (Header) then
         Writer.Start_Element ("span");
         Writer.Write_Text (Header);
         Writer.End_Element ("span");
         Writer.End_Element ("div");
      end if;

      --  If there is a header facet, render it now.
      Header_Facet := UI.Get_Facet (HEADER_FACET_NAME);
      if Header_Facet /= null then
         Header_Facet.Encode_All (Context);
      end if;
      Writer.End_Element ("div");

      null;
   end Render_Header;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   procedure Render_Footer (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Footer       : Util.Beans.Objects.Object;
      Footer_Facet : ASF.Components.Base.UIComponent_Access;
      Has_Footer   : Boolean;
   begin
      Footer_Facet := UI.Get_Facet (FOOTER_FACET_NAME);
      Footer := UI.Get_Attribute (Name => FOOTER_ATTR_NAME, Context => Context);

      Has_Footer := Footer_Facet /= null or else not Util.Beans.Objects.Is_Empty (Footer);
      if Has_Footer then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-footer");
      end if;
      if not Util.Beans.Objects.Is_Empty (Footer) then
         Writer.Write_Text (Footer);
      end if;

      --  If there is a footer facet, render it now.
      if Footer_Facet /= null then
         Footer_Facet.Encode_All (Context);
      end if;
      if Has_Footer then
         Writer.End_Element ("div");
      end if;
   end Render_Footer;

   --  ------------------------------
   --  Render the panel header and prepare for the panel content.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIPanel;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel");
         UIPanel'Class (UI).Render_Header (Writer.all, Context);
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-content");
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIPanel;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
         UIPanel'Class (UI).Render_Footer (Writer.all, Context);
         Writer.End_Element ("div");
      end if;
   end Encode_End;

end ASF.Components.Widgets.Panels;

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

   --  ------------------------------
   --  Render the panel header.
   --  ------------------------------
   procedure Render_Header (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Header       : Util.Beans.Objects.Object;
      Header_Facet : ASF.Components.Base.UIComponent_Access;
   begin
      Writer.Start_Element ("div");
      Writer.Write_Attribute ("class", "ui-panel-header ui-widget-header");
      Header := UI.Get_Attribute (Name => HEADER_ATTR_NAME, Context => Context);
      if not Util.Beans.Objects.Is_Empty (Header) then
         Writer.Start_Element ("span");
         Writer.Write_Text (Header);
         Writer.End_Element ("span");
         Writer.End_Element ("div");
      end if;

      --  If there is a header facet, render it now.
      Header_Facet := UI.Get_Facet (HEADER_FACET_NAME);
      if Header_Facet /= null then
         Header_Facet.Encode_All (Context);
      end if;
      Writer.End_Element ("div");

      null;
   end Render_Header;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   procedure Render_Footer (UI      : in UIPanel;
                            Writer  : in out ASF.Contexts.Writer.Response_Writer'Class;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      use type ASF.Components.Base.UIComponent_Access;

      Footer       : Util.Beans.Objects.Object;
      Footer_Facet : ASF.Components.Base.UIComponent_Access;
      Has_Footer   : Boolean;
   begin
      Footer_Facet := UI.Get_Facet (FOOTER_FACET_NAME);
      Footer := UI.Get_Attribute (Name => FOOTER_ATTR_NAME, Context => Context);

      Has_Footer := Footer_Facet /= null or else not Util.Beans.Objects.Is_Empty (Footer);
      if Has_Footer then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-footer ui-widget-footer");
      end if;
      if not Util.Beans.Objects.Is_Empty (Footer) then
         Writer.Write_Text (Footer);
      end if;

      --  If there is a footer facet, render it now.
      if Footer_Facet /= null then
         Footer_Facet.Encode_All (Context);
      end if;
      if Has_Footer then
         Writer.End_Element ("div");
      end if;
   end Render_Footer;

   --  ------------------------------
   --  Render the panel header and prepare for the panel content.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIPanel;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel ui-widget ui-corner-all");
         UIPanel'Class (UI).Render_Header (Writer.all, Context);
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("class", "ui-panel-content ui-widget-content");
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the panel footer.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UIPanel;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
         UIPanel'Class (UI).Render_Footer (Writer.all, Context);
         Writer.End_Element ("div");
      end if;
   end Encode_End;

end ASF.Components.Widgets.Panels;

Add some CSS from jQuery UI widgets

Add some CSS from jQuery UI widgets


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

--  == Introduction ==
--  The AWA.Jobs plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.  The `Jobs` plugin is intended to help web application
--  designers in implementing end to end asynchronous operation.  A client schedules a job
--  and does not block nor wait for the immediate completion.  Instead, the client asks
--  periodically or uses other mechanisms to check for the job completion.
--
--  === Writing a job ===
--  A new job type is created by implementing the `Execute` operation of the abstract
--  `Job_Type` tagged record.
--
--    type Resize_Job is new AWA.Jobs.Job_Type with ...;
--
--  The `Execute` procedure must be implemented.  It should use the `Get_Parameter` functions
--  to retrieve the job parameters and perform the work.  While the job is being executed,
--  it can save result by using the `Set_Result` operations, save messages by using the
--  `Set_Message` operations and report the progress by using `Set_Progress`.
--  It may report the job status by using `Set_Status`.
--
--    procedure Execute (Job : in out Resize_Job) is
--    begin
--        Job.Set_Result ("done", "ok");
--    end Execute;
--
--  === Registering a job ===
--  The AWA.Jobs plugin must be able to create the job instance when it is going to
--  be executed.  For this, a registration package must be instantiated:
--
--    package Resize_Def is new AWA.Jobs.Definition (Resize_Job);
--
--  and the job definition must be added:
--
--    AWA.Jobs.Modules.Register (Resize_Def.Create'Access);
--
--  === Scheduling a job ===
--  To schedule a job, declare an instance of the job to execute and set the job specific
--  parameters.  The job parameters will be saved in the database.  As soon as parameters
--  are defined, call the `Schedule` procedure to schedule the job in the job queue and
--  obtain a job identifier.
--
--    Resize : Resize_Job;
--    ...
--    Resize.Set_Parameter ("file", "image.png");
--    Resize.Set_Parameter ("width", "32");
--    Resize.Set_Parameter ("height, "32");
--    Resize.Schedule;
--
--  === Checking for job completion ===
--
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

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

--  == Introduction ==
--  The AWA.Jobs plugin defines a batch job framework for modules to perform and execute
--  long running and deferred actions.  The `Jobs` plugin is intended to help web application
--  designers in implementing end to end asynchronous operation.  A client schedules a job
--  and does not block nor wait for the immediate completion.  Instead, the client asks
--  periodically or uses other mechanisms to check for the job completion.
--
--  === Writing a job ===
--  A new job type is created by implementing the `Execute` operation of the abstract
--  `Job_Type` tagged record.
--
--    type Resize_Job is new AWA.Jobs.Job_Type with ...;
--
--  The `Execute` procedure must be implemented.  It should use the `Get_Parameter` functions
--  to retrieve the job parameters and perform the work.  While the job is being executed,
--  it can save result by using the `Set_Result` operations, save messages by using the
--  `Set_Message` operations and report the progress by using `Set_Progress`.
--  It may report the job status by using `Set_Status`.
--
--    procedure Execute (Job : in out Resize_Job) is
--    begin
--        Job.Set_Result ("done", "ok");
--    end Execute;
--
--  === Registering a job ===
--  The AWA.Jobs plugin must be able to create the job instance when it is going to
--  be executed.  For this, a registration package must be instantiated:
--
--    package Resize_Def is new AWA.Jobs.Definition (Resize_Job);
--
--  and the job definition must be added:
--
--    AWA.Jobs.Modules.Register (Resize_Def.Create'Access);
--
--  === Scheduling a job ===
--  To schedule a job, declare an instance of the job to execute and set the job specific
--  parameters.  The job parameters will be saved in the database.  As soon as parameters
--  are defined, call the `Schedule` procedure to schedule the job in the job queue and
--  obtain a job identifier.
--
--    Resize : Resize_Job;
--    ...
--    Resize.Set_Parameter ("file", "image.png");
--    Resize.Set_Parameter ("width", "32");
--    Resize.Set_Parameter ("height, "32");
--    Resize.Schedule;
--
--  === Checking for job completion ===
--
--
--  @include awa-jobs-modules.ads
--
--  == Data Model ==
--  @include jobs.hbm.xml
--
package AWA.Jobs is

end AWA.Jobs;

Update the documentation

Update the documentation


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

with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;

with ADO.Schemas.Entities;
with ADO.Sessions.Entities;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Permissions.Controllers;
package body AWA.Permissions is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Permissions");

   --  ------------------------------
   --  Verify that the permission represented by Permission is granted.
   --  ------------------------------
   procedure Check (Permission : in Security.Permissions.Permission_Index) is
   begin
      if not (Security.Contexts.Has_Permission (Permission)) then
         raise NO_PERMISSION;
      end if;
   end Check;

   --  ------------------------------
   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   --  ------------------------------
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier) is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : Entity_Permission (Permission);
   begin
      if Context = null then
         Log.Debug ("There is no security context, permission denied");
         raise NO_PERMISSION;
      end if;
      Perm.Entity := Entity;
      if not (Security.Contexts.Has_Permission (Perm)) then
         Log.Debug ("Permission is refused");
         raise NO_PERMISSION;
      end if;
   end Check;

   type Controller_Config is record
      Name    : Util.Beans.Objects.Object;
      SQL     : Util.Beans.Objects.Object;
      Entity  : ADO.Entity_Type := 0;
      Count   : Natural := 0;
      Manager : Entity_Policy_Access;
      Session : ADO.Sessions.Session;
   end record;

   type Config_Fields is (FIELD_NAME, FIELD_ENTITY_TYPE, FIELD_ENTITY_PERMISSION, FIELD_SQL);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <entity-type>, <sql> and
   --  <entity-permission> XML entities are found.  Create the new permission when the complete
   --  permission definition has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use AWA.Permissions.Controllers;
      use type ADO.Entity_Type;
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_SQL =>
            Into.SQL := Value;

         when FIELD_ENTITY_TYPE =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Entity := ADO.Sessions.Entities.Find_Entity_Type (Into.Session, Name);

            exception
               when ADO.Schemas.Entities.No_Entity_Type =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid entity type: " & Name;
            end;

         when FIELD_ENTITY_PERMISSION =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
            begin
               if Into.Entity = 0 then
                  raise Util.Serialize.Mappers.Field_Error
                  with "Permission '" & Name & "' ignored: missing entity type";
               end if;
               declare
                  SQL  : constant String := Util.Beans.Objects.To_String (Into.SQL);
                  Perm : constant Entity_Controller_Access
                    := new Entity_Controller '(Len    => SQL'Length,
                                               SQL    => SQL,
                                               Entity => Into.Entity);
               begin
                  Into.Manager.Add_Permission (Name, Perm.all'Access);
                  Into.Count := 0;
                  Into.Entity := 0;
               end;
            end;

      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the entity-permission description.  For example:
   --
   --  <entity-permission>
   --     <name>create-workspace</name>
   --     <entity-type>WORKSPACE</entity-type>
   --     <sql>select acl.id from acl where ...</sql>
   --  </entity-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  SQL statement returns a non empty list.
   --  ------------------------------

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String is
   begin
      return NAME;
   end Get_Name;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
      Config : Controller_Config_Access := new Controller_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Policy'Unchecked_Access;
      Config.Session := AWA.Services.Contexts.Get_Session (AWA.Services.Contexts.Current);
      Config_Mapper.Set_Context (Reader, Config);
   end Prepare_Config;

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

begin
   Mapper.Add_Mapping ("entity-permission", FIELD_ENTITY_PERMISSION);
   Mapper.Add_Mapping ("entity-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("entity-permission/entity-type", FIELD_ENTITY_TYPE);
   Mapper.Add_Mapping ("entity-permission/sql", FIELD_SQL);
end AWA.Permissions;

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

with Util.Log.Loggers;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;

with ADO.Schemas.Entities;
with ADO.Sessions.Entities;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Permissions.Controllers;
package body AWA.Permissions is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Permissions");

   --  ------------------------------
   --  Verify that the permission represented by Permission is granted.
   --  ------------------------------
   procedure Check (Permission : in Security.Permissions.Permission_Index) is
   begin
      if not (Security.Contexts.Has_Permission (Permission)) then
         raise NO_PERMISSION;
      end if;
   end Check;

   --  ------------------------------
   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   --  ------------------------------
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier) is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : Entity_Permission (Permission);
      Result  : Boolean;
   begin
      if Context = null then
         Log.Debug ("There is no security context, permission denied");
         raise NO_PERMISSION;
      end if;
      Perm.Entity := Entity;
      Context.Has_Permission (Perm, Result);
      if not Result then
         Log.Debug ("Permission is refused");
         raise NO_PERMISSION;
      end if;
   end Check;

   type Controller_Config is record
      Name    : Util.Beans.Objects.Object;
      SQL     : Util.Beans.Objects.Object;
      Entity  : ADO.Entity_Type := 0;
      Count   : Natural := 0;
      Manager : Entity_Policy_Access;
      Session : ADO.Sessions.Session;
   end record;

   type Config_Fields is (FIELD_NAME, FIELD_ENTITY_TYPE, FIELD_ENTITY_PERMISSION, FIELD_SQL);

   type Controller_Config_Access is access all Controller_Config;

   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  ------------------------------
   --  Called while parsing the XML policy file when the <name>, <entity-type>, <sql> and
   --  <entity-permission> XML entities are found.  Create the new permission when the complete
   --  permission definition has been parsed and save the permission in the security manager.
   --  ------------------------------
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object) is
      use AWA.Permissions.Controllers;
      use type ADO.Entity_Type;
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_SQL =>
            Into.SQL := Value;

         when FIELD_ENTITY_TYPE =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Value);
            begin
               Into.Entity := ADO.Sessions.Entities.Find_Entity_Type (Into.Session, Name);

            exception
               when ADO.Schemas.Entities.No_Entity_Type =>
                  raise Util.Serialize.Mappers.Field_Error with "Invalid entity type: " & Name;
            end;

         when FIELD_ENTITY_PERMISSION =>
            declare
               Name : constant String := Util.Beans.Objects.To_String (Into.Name);
            begin
               if Into.Entity = 0 then
                  raise Util.Serialize.Mappers.Field_Error
                  with "Permission '" & Name & "' ignored: missing entity type";
               end if;
               declare
                  SQL  : constant String := Util.Beans.Objects.To_String (Into.SQL);
                  Perm : constant Entity_Controller_Access
                    := new Entity_Controller '(Len    => SQL'Length,
                                               SQL    => SQL,
                                               Entity => Into.Entity);
               begin
                  Into.Manager.Add_Permission (Name, Perm.all'Access);
                  Into.Count := 0;
                  Into.Entity := 0;
               end;
            end;

      end case;
   end Set_Member;

   package Config_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Controller_Config,
                                               Element_Type_Access => Controller_Config_Access,
                                               Fields              => Config_Fields,
                                               Set_Member          => Set_Member);

   Mapper : aliased Config_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the entity-permission description.  For example:
   --
   --  <entity-permission>
   --     <name>create-workspace</name>
   --     <entity-type>WORKSPACE</entity-type>
   --     <sql>select acl.id from acl where ...</sql>
   --  </entity-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  SQL statement returns a non empty list.
   --  ------------------------------

   --  Get the policy name.
   overriding
   function Get_Name (From : in Entity_Policy) return String is
   begin
      return NAME;
   end Get_Name;

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out Entity_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser) is
      Config : Controller_Config_Access := new Controller_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Mapper'Access);
      Reader.Add_Mapping ("module", Mapper'Access);
      Config.Manager := Policy'Unchecked_Access;
      Config.Session := AWA.Services.Contexts.Get_Session (AWA.Services.Contexts.Current);
      Config_Mapper.Set_Context (Reader, Config);
   end Prepare_Config;

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

begin
   Mapper.Add_Mapping ("entity-permission", FIELD_ENTITY_PERMISSION);
   Mapper.Add_Mapping ("entity-permission/name", FIELD_NAME);
   Mapper.Add_Mapping ("entity-permission/entity-type", FIELD_ENTITY_TYPE);
   Mapper.Add_Mapping ("entity-permission/sql", FIELD_SQL);
end AWA.Permissions;

Fix Check_Permission

Fix Check_Permission


-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 2015, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Fixed;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   function Has_Scheme (Link : in String) return Boolean;
   function Is_Image (Link : in String) return Boolean;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Artifacts.Docs.Mark");

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
      pragma Unreferenced (Formatter);
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
      pragma Unreferenced (Formatter);
   begin
      Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Return True if the link has either a http:// or a https:// scheme.
   --  ------------------------------
   function Has_Scheme (Link : in String) return Boolean is
   begin
      if Link'Length < 8 then
         return False;
      elsif Link (Link'First .. Link'First + 6) = "http://" then
         return True;
      elsif Link (Link'First .. Link'First + 7) = "https://" then
         return True;
      else
         return False;
      end if;
   end Has_Scheme;

   function Is_Image (Link : in String) return Boolean is
   begin
      if Link'Length < 4 then
         return False;
      elsif Link (Link'Last - 3 .. Link'Last) = ".png" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".jpg" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".gif" then
         return True;
      else
         Log.Info ("Link {0} not an image", Link);
         return False;
      end if;
   end Is_Image;

   --  ------------------------------
   --  Write a line doing some link transformation for Markdown.
   --  ------------------------------
   procedure Write_Text (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Text      : in String) is
      pragma Unreferenced (Formatter);
      Pos      : Natural;
      Start    : Natural := Text'First;
      End_Pos  : Natural;
      Last_Pos : Natural;
   begin
      --  Transform links
      --  [Link]   -> [[Link]]
      --  [Link Title] -> [[Title|Link]]
      --
      --  Do not change the following links:
      --  [[Link|Title]]
      loop
         Pos := Util.Strings.Index (Text, '[', Start);
         if Pos = 0 or else Pos = Text'Last then
            Ada.Text_IO.Put (File, Text (Start .. Text'Last));
            return;
         end if;
         Ada.Text_IO.Put (File, Text (Start .. Pos - 1));

         --  Parse a markdown link format.
         if Text (Pos + 1) = '[' then
            Start := Pos + 2;
            Pos := Util.Strings.Index (Text, ']', Pos + 2);
            if Pos = 0 then
               if Is_Image (Text (Start .. Text'Last)) then
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               else
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               end if;
               return;
            end if;
            if Is_Image (Text (Start .. Pos - 1)) then
               Ada.Text_IO.Put (File, "![](");
               Ada.Text_IO.Put (File, Text (Start .. Pos - 1));
               Ada.Text_IO.Put (File, ")");
               Start := Pos + 2;
            else
               Ada.Text_IO.Put (File, Text (Start .. Pos));
               Start := Pos + 1;
            end if;
         else
            Pos := Pos + 1;
            End_Pos := Pos;
            while End_Pos < Text'Last and Text (End_Pos) /= ' ' and Text (End_Pos) /= ']' loop
               End_Pos := End_Pos + 1;
            end loop;
            Last_Pos := End_Pos;
            while Last_Pos < Text'Last and Text (Last_Pos) /= ']' loop
               Last_Pos := Last_Pos + 1;
            end loop;
            if Is_Image (Text (Pos .. Last_Pos - 1)) then
               Ada.Text_IO.Put (File, "![");
               --  Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. Last_Pos - 1));
               Ada.Text_IO.Put (File, ")");
            elsif Is_Image (Text (Pos .. End_Pos)) then
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "![");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, ")");
            elsif Has_Scheme (Text (Pos .. End_Pos)) then
               Ada.Text_IO.Put (File, "[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "(");
               Ada.Text_IO.Put (File,
                                Ada.Strings.Fixed.Trim (Text (Pos .. End_Pos), Ada.Strings.Both));
               Ada.Text_IO.Put (File, ")");
            else
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "[[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "|");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "]");
            end if;
            Start := Last_Pos + 1;
         end if;
      end loop;
   end Write_Text;

   --  ------------------------------
   --  Write a line in the document.
   --  ------------------------------
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String) is
   begin
      if Formatter.Need_Newline then
         Ada.Text_IO.New_Line (File);
         Formatter.Need_Newline := False;
      end if;
      if Formatter.Mode = L_START_CODE and then Line'Length > 2
        and then Line (Line'First .. Line'First + 1) = "  "
      then
         Ada.Text_IO.Put_Line (File, Line (Line'First + 2 .. Line'Last));
      elsif Formatter.Mode = L_TEXT then
         Formatter.Write_Text (File, Line);
         Ada.Text_IO.New_Line (File);
      else
         Ada.Text_IO.Put_Line (File, Line);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      case Line.Kind is
         when L_LIST =>
            Ada.Text_IO.New_Line (File);
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;
            Formatter.Mode := Line.Kind;

         when L_LIST_ITEM =>
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_START_CODE =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "```");

         when L_END_CODE =>
            Formatter.Mode := L_TEXT;
            Formatter.Write_Line (File, "```");

         when L_TEXT =>
            Formatter.Write_Line (File, Line.Content);

         when L_HEADER_1 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "# " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_2 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "## " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_3 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_4 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "#### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when others =>
            null;

      end case;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
      pragma Unreferenced (Formatter);
   begin
      Ada.Text_IO.New_Line (File);
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "----");
         Ada.Text_IO.Put_Line (File,
                               "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                               & Source & "*");
      end if;
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 2015, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Fixed;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   function Has_Scheme (Link : in String) return Boolean;
   function Is_Image (Link : in String) return Boolean;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Artifacts.Docs.Mark");

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
      pragma Unreferenced (Formatter);
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
      pragma Unreferenced (Formatter);
   begin
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
         Ada.Text_IO.New_Line (File);
      end if;
   end Start_Document;

   --  ------------------------------
   --  Return True if the link has either a http:// or a https:// scheme.
   --  ------------------------------
   function Has_Scheme (Link : in String) return Boolean is
   begin
      if Link'Length < 8 then
         return False;
      elsif Link (Link'First .. Link'First + 6) = "http://" then
         return True;
      elsif Link (Link'First .. Link'First + 7) = "https://" then
         return True;
      else
         return False;
      end if;
   end Has_Scheme;

   function Is_Image (Link : in String) return Boolean is
   begin
      if Link'Length < 4 then
         return False;
      elsif Link (Link'Last - 3 .. Link'Last) = ".png" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".jpg" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".gif" then
         return True;
      else
         Log.Info ("Link {0} not an image", Link);
         return False;
      end if;
   end Is_Image;

   --  ------------------------------
   --  Write a line doing some link transformation for Markdown.
   --  ------------------------------
   procedure Write_Text (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Text      : in String) is
      pragma Unreferenced (Formatter);
      Pos      : Natural;
      Start    : Natural := Text'First;
      End_Pos  : Natural;
      Last_Pos : Natural;
   begin
      --  Transform links
      --  [Link]   -> [[Link]]
      --  [Link Title] -> [[Title|Link]]
      --
      --  Do not change the following links:
      --  [[Link|Title]]
      loop
         Pos := Util.Strings.Index (Text, '[', Start);
         if Pos = 0 or else Pos = Text'Last then
            Ada.Text_IO.Put (File, Text (Start .. Text'Last));
            return;
         end if;
         Ada.Text_IO.Put (File, Text (Start .. Pos - 1));

         --  Parse a markdown link format.
         if Text (Pos + 1) = '[' then
            Start := Pos + 2;
            Pos := Util.Strings.Index (Text, ']', Pos + 2);
            if Pos = 0 then
               if Is_Image (Text (Start .. Text'Last)) then
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               else
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               end if;
               return;
            end if;
            if Is_Image (Text (Start .. Pos - 1)) then
               Ada.Text_IO.Put (File, "![](");
               Ada.Text_IO.Put (File, Text (Start .. Pos - 1));
               Ada.Text_IO.Put (File, ")");
               Start := Pos + 2;
            else
               Ada.Text_IO.Put (File, Text (Start .. Pos));
               Start := Pos + 1;
            end if;
         else
            Pos := Pos + 1;
            End_Pos := Pos;
            while End_Pos < Text'Last and Text (End_Pos) /= ' ' and Text (End_Pos) /= ']' loop
               End_Pos := End_Pos + 1;
            end loop;
            Last_Pos := End_Pos;
            while Last_Pos < Text'Last and Text (Last_Pos) /= ']' loop
               Last_Pos := Last_Pos + 1;
            end loop;
            if Is_Image (Text (Pos .. Last_Pos - 1)) then
               Ada.Text_IO.Put (File, "![");
               --  Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. Last_Pos - 1));
               Ada.Text_IO.Put (File, ")");
            elsif Is_Image (Text (Pos .. End_Pos)) then
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "![");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, ")");
            elsif Has_Scheme (Text (Pos .. End_Pos)) then
               Ada.Text_IO.Put (File, "[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "(");
               Ada.Text_IO.Put (File,
                                Ada.Strings.Fixed.Trim (Text (Pos .. End_Pos), Ada.Strings.Both));
               Ada.Text_IO.Put (File, ")");
            else
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "[[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "|");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "]");
            end if;
            Start := Last_Pos + 1;
         end if;
      end loop;
   end Write_Text;

   --  ------------------------------
   --  Write a line in the document.
   --  ------------------------------
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String) is
   begin
      if Formatter.Need_Newline then
         Ada.Text_IO.New_Line (File);
         Formatter.Need_Newline := False;
      end if;
      if Formatter.Mode = L_START_CODE and then Line'Length > 2
        and then Line (Line'First .. Line'First + 1) = "  "
      then
         Ada.Text_IO.Put_Line (File, Line (Line'First + 2 .. Line'Last));
      elsif Formatter.Mode = L_TEXT then
         Formatter.Write_Text (File, Line);
         Ada.Text_IO.New_Line (File);
      else
         Ada.Text_IO.Put_Line (File, Line);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      case Line.Kind is
         when L_LIST =>
            Ada.Text_IO.New_Line (File);
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;
            Formatter.Mode := Line.Kind;

         when L_LIST_ITEM =>
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_START_CODE =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "```Ada");

         when L_END_CODE =>
            Formatter.Mode := L_TEXT;
            Formatter.Write_Line (File, "```");

         when L_TEXT =>
            Formatter.Write_Line (File, Line.Content);

         when L_HEADER_1 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "# " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_2 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "## " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_3 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_4 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "#### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when others =>
            null;

      end case;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
      pragma Unreferenced (Formatter);
   begin
      Ada.Text_IO.New_Line (File);
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "----");
         Ada.Text_IO.Put_Line (File,
                               "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                               & Source & "*");
      end if;
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

Fix formatting of code block to tell the language is Ada


-----------------------------------------------------------------------
--  Util.Streams.Buffered -- Buffered streams Stream utilities
--  Copyright (C) 2010, 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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Ada.Finalization;
package Util.Streams.Buffered is

   pragma Preelaborate;

   --  -----------------------
   --  Buffered stream
   --  -----------------------
   --  The Buffered_Stream is an output/input stream which uses
   --  an intermediate buffer.  It can be configured to read or write to
   --  another stream that it will read or write using the buffer.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the buffered stream.
   type Buffered_Stream is limited new Output_Stream and Input_Stream with private;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive);

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Buffered_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access;

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Buffered_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Buffered_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Buffered_Stream) return Natural;

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Buffered_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Buffered_Stream) return Boolean;

private

   use Ada.Streams;

   type Buffered_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      No_Flush    : Boolean := False;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Buffered_Stream);

end Util.Streams.Buffered;

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

   pragma Preelaborate;

   --  -----------------------
   --  Buffered stream
   --  -----------------------
   --  The Buffered_Stream is an output/input stream which uses
   --  an intermediate buffer.  It can be configured to read or write to
   --  another stream that it will read or write using the buffer.
   --
   --  It is necessary to call Flush to make sure the data
   --  is written to the target stream.  The Flush operation will
   --  be called when finalizing the buffered stream.
   type Buffered_Stream is limited new Output_Stream and Input_Stream with private;

   type Buffer_Access is access Ada.Streams.Stream_Element_Array;

   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive);

   --  Initialize the stream with a buffer of Size bytes.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive);

   --  Initialize the stream to read from the string.
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Buffered_Stream);

   --  Get the direct access to the buffer.
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access;

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Buffered_Stream);

   --  Get the number of element in the stream.
   function Get_Size (Stream : in Buffered_Stream) return Natural;

   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   procedure Fill (Stream : in out Buffered_Stream);

   --  Read one character from the input stream.
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset);

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Returns True if the end of the stream is reached.
   function Is_Eof (Stream : in Buffered_Stream) return Boolean;

private

   use Ada.Streams;

   type Buffered_Stream is limited new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      --  The buffer where the data is written before being flushed.
      Buffer      : Buffer_Access := null;

      --  The next write position within the buffer.
      Write_Pos   : Stream_Element_Offset := 0;

      --  The next read position within the buffer.
      Read_Pos    : Stream_Element_Offset := 1;

      --  The last valid write position within the buffer.
      Last        : Stream_Element_Offset := 0;

      --  The output stream to use for flushing the buffer.
      Output      : Output_Stream_Access := null;

      --  The input stream to use to fill the buffer.
      Input       : Input_Stream_Access := null;

      No_Flush    : Boolean := False;

      --  Reached end of file when reading.
      Eof         : Boolean := False;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Buffered_Stream);

end Util.Streams.Buffered;

Refactor Buffered_Stream and Print_Stream - move character related Write operation to the Texts package (Print_Stream)