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

with AUnit.Test_Caller;
with EL.Expressions;
with EL.Objects;
with EL.Objects.Enums;
with EL.Objects.Time;
with EL.Contexts;
with EL.Contexts.Default;
with Ada.Calendar;
with EL.Objects.Discrete_Tests;
with EL.Objects.Time.Tests;
with Ada.Calendar.Formatting;
with Ada.Calendar.Conversions;
with Interfaces.C;
with EL.Expressions.Tests;
package body EL.Testsuite is

   use Interfaces.C;
   use EL.Objects;
   use Ada.Calendar;
   use Ada.Calendar.Conversions;

   function "+" (Left, Right : Boolean) return Boolean;
   function "-" (Left, Right : Boolean) return Boolean;

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function Time_Value (S : String) return Ada.Calendar.Time;

   --  ------------------------------
   --  Test object integer
   --  ------------------------------
   procedure Test_To_Object_Integer (T : in out Test) is
   begin
      declare
         Value : constant EL.Objects.Object := To_Object (Integer (1));
      begin
         T.Assert (Condition => To_Integer (Value) = 1,
                   Message => "Object.To_Integer: invalid integer returned");
         T.Assert (Condition => To_Long_Integer (Value) = 1,
                   Message => "Object.To_Long_Integer: invalid integer returned");
         T.Assert (Condition => To_Boolean (Value),
                   Message => "Object.To_Boolean: invalid return");

         declare
            V2 : constant EL.Objects.Object := Value + To_Object (Long_Integer (100));
         begin
            T.Assert (Condition => To_Integer (V2) = 101,
                      Message => "To_Integer invalid after an add");
         end;
      end;
   end Test_To_Object_Integer;

   --  ------------------------------
   --  Test object integer
   --  ------------------------------
   procedure Test_Expression (T : in out Test) is
      E     : EL.Expressions.Expression;
      Value : Object;
      Ctx   : EL.Contexts.Default.Default_Context;
   begin
      --  Positive number
      E := EL.Expressions.Create_Expression ("12345678901", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Long_Long_Integer (Value) = Long_Long_Integer (12345678901),
                Message => "[1] Expression result invalid: " & To_String (Value));

      --  Negative number
      E := EL.Expressions.Create_Expression ("-10", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = -10,
                Message => "[2] Expression result invalid: " & To_String (Value));

      --  Simple add
      E := EL.Expressions.Create_Expression ("#{1+1}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 2,
                Message => "[2.1] Expression result invalid: " & To_String (Value));

      --  Constant expressions
      E := EL.Expressions.Create_Expression ("#{12 + (123 - 3) * 4}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 492,
                Message => "[3] Expression result invalid: " & To_String (Value));

      --  Constant expressions
      E := EL.Expressions.Create_Expression ("#{12 + (123 - 3) * 4 + (23? 10 : 0)}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 502,
                Message => "[4] Expression result invalid: " & To_String (Value));

      --  Choice expressions
      E := EL.Expressions.Create_Expression ("#{1 > 2 ? 12 + 2 : 3 * 3}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 9,
                Message => "[5] Expression result invalid: " & To_String (Value));

      --  Choice expressions using strings
      E := EL.Expressions.Create_Expression ("#{1 > 2 ? 12 + 2 : 'A string'}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_String (Value) = "A string",
                Message => "[6] Expression result invalid: " & To_String (Value));

   end Test_Expression;

   package Test_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Integer,
                                To_Type        => EL.Objects.To_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Integer'Value,
                                Test_Name      => "Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Integer,
                                To_Type        => EL.Objects.To_Long_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Integer'Value,
                                Test_Name      => "Long_Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Long_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Long_Integer,
                                To_Type        => EL.Objects.To_Long_Long_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Long_Integer'Value,
                                Test_Name      => "Long_Long_Integer",
                                Test_Values => "-10000000000000,1,0,1,1000_000_000_000");

   function "-" (Left, Right : Boolean) return Boolean is
   begin
      return Left and Right;
   end "-";

   function "+" (Left, Right : Boolean) return Boolean is
   begin
      return Left or Right;
   end "+";

   package Test_Boolean is new
     EL.Objects.Discrete_Tests (Test_Type      => Boolean,
                                To_Type        => EL.Objects.To_Boolean,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Boolean'Value,
                                Test_Name      => "Boolean",
                                Test_Values    => "false,true");

   type Color is (WHITE, BLACK, RED, GREEN, BLUE, YELLOW);

   package Color_Object is new EL.Objects.Enums (Color, ROUND_VALUE => True);

   function "-" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) - Color'Pos (Right);
   begin
      if N >= 0 then
         return Color'Val ((Color'Pos (WHITE) + N) mod 6);
      else
         return Color'Val ((Color'Pos (WHITE) - N) mod 6);
      end if;
   end "-";

   function "+" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) + Color'Pos (Right);
   begin
      return Color'Val ((Color'Pos (WHITE) + N) mod 6);
   end "+";

   package Test_Enum is new
     EL.Objects.Discrete_Tests (Test_Type      => Color,
                                To_Type        => Color_Object.To_Value,
                                To_Object_Test => Color_Object.To_Object,
                                Value          => Color'Value,
                                Test_Name      => "Color",
                                Test_Values    => "BLACK,RED,GREEN,BLUE,YELLOW");

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   function Time_Value (S : String) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Value (S);
   end Time_Value;

   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 + T2) + Epoch;
   end "+";

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 - T2) + Epoch;
   end "-";

   package Test_Time is new
     EL.Objects.Discrete_Tests (Test_Type      => Ada.Calendar.Time,
                                To_Type        => EL.Objects.Time.To_Time,
                                To_Object_Test => EL.Objects.Time.To_Object,
                                Value          => Time_Value,
                                Test_Name      => "Time",
                                Test_Values => "1970-03-04 12:12:00,1975-05-04 13:13:10");

   package Test_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Float,
                                To_Type        => EL.Objects.To_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Float'Value,
                                Test_Name      => "Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Float,
                                To_Type        => EL.Objects.To_Long_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Float'Value,
                                Test_Name      => "Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Long_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Long_Float,
                                To_Type        => EL.Objects.To_Long_Long_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Long_Float'Value,
                                Test_Name      => "Long_Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Caller is new AUnit.Test_Caller (Test);

   Tests : aliased Test_Suite;

   function Suite return Access_Test_Suite is
      Ret : constant Access_Test_Suite := Tests'Access;
   begin
      Ret.Add_Test (Caller.Create ("Test To_Object (Integer)",
                                   Test_To_Object_Integer'Access));
      Ret.Add_Test (Caller.Create ("Test Expressions", Test_Expression'Access));
      Test_Boolean.Add_Tests (Ret);
      Test_Integer.Add_Tests (Ret);
      Test_Long_Integer.Add_Tests (Ret);
      Test_Long_Long_Integer.Add_Tests (Ret);
      Test_Time.Add_Tests (Ret);
      Test_Float.Add_Tests (Ret);
      Test_Long_Float.Add_Tests (Ret);
      Test_Long_Long_Float.Add_Tests (Ret);
      Test_Enum.Add_Tests (Ret);
      EL.Objects.Time.Tests.Add_Tests (Ret);
      EL.Expressions.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end EL.Testsuite;

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

with AUnit.Test_Caller;
with EL.Expressions;
with EL.Objects;
with EL.Objects.Enums;
with EL.Objects.Time;
with EL.Contexts;
with EL.Contexts.Default;
with Ada.Calendar;
with EL.Objects.Discrete_Tests;
with EL.Objects.Time.Tests;
with Ada.Calendar.Formatting;
with Ada.Calendar.Conversions;
with Interfaces.C;
with EL.Expressions.Tests;
package body EL.Testsuite is

   use Interfaces.C;
   use EL.Objects;
   use Ada.Calendar;
   use Ada.Calendar.Conversions;

   function "+" (Left, Right : Boolean) return Boolean;
   function "-" (Left, Right : Boolean) return Boolean;

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time;
   function Time_Value (S : String) return Ada.Calendar.Time;

   --  ------------------------------
   --  Test object integer
   --  ------------------------------
   procedure Test_To_Object_Integer (T : in out Test) is
   begin
      declare
         Value : constant EL.Objects.Object := To_Object (Integer (1));
      begin
         T.Assert (Condition => To_Integer (Value) = 1,
                   Message => "Object.To_Integer: invalid integer returned");
         T.Assert (Condition => To_Long_Integer (Value) = 1,
                   Message => "Object.To_Long_Integer: invalid integer returned");
         T.Assert (Condition => To_Boolean (Value),
                   Message => "Object.To_Boolean: invalid return");

         declare
            V2 : constant EL.Objects.Object := Value + To_Object (Long_Integer (100));
         begin
            T.Assert (Condition => To_Integer (V2) = 101,
                      Message => "To_Integer invalid after an add");
         end;
      end;
   end Test_To_Object_Integer;

   --  ------------------------------
   --  Test object integer
   --  ------------------------------
   procedure Test_Expression (T : in out Test) is
      E     : EL.Expressions.Expression;
      Value : Object;
      Ctx   : EL.Contexts.Default.Default_Context;
   begin
      --  Positive number
      E := EL.Expressions.Create_Expression ("12345678901", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Long_Long_Integer (Value) = Long_Long_Integer (12345678901),
                Message => "[1] Expression result invalid: " & To_String (Value));

      --  Negative number
      E := EL.Expressions.Create_Expression ("-10", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = -10,
                Message => "[2] Expression result invalid: " & To_String (Value));

      --  Simple add
      E := EL.Expressions.Create_Expression ("#{1+1}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 2,
                Message => "[2.1] Expression result invalid: " & To_String (Value));

      --  Constant expressions
      E := EL.Expressions.Create_Expression ("#{12 + (123 - 3) * 4}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 492,
                Message => "[3] Expression result invalid: " & To_String (Value));

      --  Constant expressions
      E := EL.Expressions.Create_Expression ("#{12 + (123 - 3) * 4 + (23? 10 : 0)}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 502,
                Message => "[4] Expression result invalid: " & To_String (Value));

      --  Choice expressions
      E := EL.Expressions.Create_Expression ("#{1 > 2 ? 12 + 2 : 3 * 3}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_Integer (Value) = 9,
                Message => "[5] Expression result invalid: " & To_String (Value));

      --  Choice expressions using strings
      E := EL.Expressions.Create_Expression ("#{1 > 2 ? 12 + 2 : 'A string'}", Ctx);
      Value := E.Get_Value (Ctx);
      T.Assert (Condition => To_String (Value) = "A string",
                Message => "[6] Expression result invalid: " & To_String (Value));

   end Test_Expression;

   package Test_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Integer,
                                To_Type        => EL.Objects.To_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Integer'Value,
                                Test_Name      => "Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Integer,
                                To_Type        => EL.Objects.To_Long_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Integer'Value,
                                Test_Name      => "Long_Integer",
                                Test_Values    => "-100,1,0,1,1000");

   package Test_Long_Long_Integer is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Long_Integer,
                                To_Type        => EL.Objects.To_Long_Long_Integer,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Long_Integer'Value,
                                Test_Name      => "Long_Long_Integer",
                                Test_Values => "-10000000000000,1,0,1,1000_000_000_000");

   function "-" (Left, Right : Boolean) return Boolean is
   begin
      return Left and Right;
   end "-";

   function "+" (Left, Right : Boolean) return Boolean is
   begin
      return Left or Right;
   end "+";

   package Test_Boolean is new
     EL.Objects.Discrete_Tests (Test_Type      => Boolean,
                                To_Type        => EL.Objects.To_Boolean,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Boolean'Value,
                                Test_Name      => "Boolean",
                                Test_Values    => "false,true");

   type Color is (WHITE, BLACK, RED, GREEN, BLUE, YELLOW);

   package Color_Object is new EL.Objects.Enums (Color, ROUND_VALUE => True);

   function "-" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) - Color'Pos (Right);
   begin
      if N >= 0 then
         return Color'Val ((Color'Pos (WHITE) + N) mod 6);
      else
         return Color'Val ((Color'Pos (WHITE) - N) mod 6);
      end if;
   end "-";

   function "+" (Left, Right : Color) return Color is
      N : constant Integer := Color'Pos (Left) + Color'Pos (Right);
   begin
      return Color'Val ((Color'Pos (WHITE) + N) mod 6);
   end "+";

   package Test_Enum is new
     EL.Objects.Discrete_Tests (Test_Type      => Color,
                                To_Type        => Color_Object.To_Value,
                                To_Object_Test => Color_Object.To_Object,
                                Value          => Color'Value,
                                Test_Name      => "Color",
                                Test_Values    => "BLACK,RED,GREEN,BLUE,YELLOW");

   Epoch : constant Ada.Calendar.Time :=
     Ada.Calendar.Time_Of (Year    => Year_Number'First,
                           Month   => 1,
                           Day     => 1,
                           Seconds => 12 * 3600.0);

   function Time_Value (S : String) return Ada.Calendar.Time is
   begin
      return Ada.Calendar.Formatting.Value (S);
   end Time_Value;

   --  For the purpose of the time unit test, we need Time + Time operation even
   --  if this does not really makes sense.
   function "+" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 + T2) + Epoch;
   end "+";

   function "-" (Left, Right : Ada.Calendar.Time) return Ada.Calendar.Time is
      T1 : constant Duration := Left - Epoch;
      T2 : constant Duration := Right - Epoch;
   begin
      return (T1 - T2) + Epoch;
   end "-";

   package Test_Time is new
     EL.Objects.Discrete_Tests (Test_Type      => Ada.Calendar.Time,
                                To_Type        => EL.Objects.Time.To_Time,
                                To_Object_Test => EL.Objects.Time.To_Object,
                                Value          => Time_Value,
                                Test_Name      => "Time",
                                Test_Values => "1970-03-04 12:12:00,1975-05-04 13:13:10");

   package Test_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Float,
                                To_Type        => EL.Objects.To_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Float'Value,
                                Test_Name      => "Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Float,
                                To_Type        => EL.Objects.To_Long_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Float'Value,
                                Test_Name      => "Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Test_Long_Long_Float is new
     EL.Objects.Discrete_Tests (Test_Type      => Long_Long_Float,
                                To_Type        => EL.Objects.To_Long_Long_Float,
                                To_Object_Test => EL.Objects.To_Object,
                                Value          => Long_Long_Float'Value,
                                Test_Name      => "Long_Long_Float",
                                Test_Values    => "1.2,3.3,-3.3");

   package Caller is new AUnit.Test_Caller (Test);

   Tests : aliased Test_Suite;

   function Suite return Access_Test_Suite is
      Ret : constant Access_Test_Suite := Tests'Access;
   begin
      Ret.Add_Test (Caller.Create ("Test To_Object (Integer)",
                                   Test_To_Object_Integer'Access));
      Ret.Add_Test (Caller.Create ("Test Expressions", Test_Expression'Access));
      Test_Boolean.Add_Tests (Ret);
      Test_Integer.Add_Tests (Ret);
      Test_Long_Integer.Add_Tests (Ret);
      Test_Long_Long_Integer.Add_Tests (Ret);
      Test_Time.Add_Tests (Ret);
      Test_Float.Add_Tests (Ret);
      Test_Long_Float.Add_Tests (Ret);
      Test_Long_Long_Float.Add_Tests (Ret);
      Test_Enum.Add_Tests (Ret);
      EL.Objects.Time.Tests.Add_Tests (Ret);
      EL.Expressions.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end EL.Testsuite;

Add comment

Add comment


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

--  This is a small HTML parser that is called to deal with embedded HTML in wiki text.
--  The parser is intended to handle incorrect HTML and clean the result as much as possible.
--  We cannot use a real XML/Sax parser (such as XML/Ada) because we must handle errors and
--  backtrack from HTML parsing to wiki or raw text parsing.
--
--  When parsing HTML content, we call the `Parse_Element` and it calls back the `Process`
--  parameter procedure with the element name and the optional attributes.
private package Wiki.Html_Parser is

   pragma Preelaborate;

   type State_Type is (HTML_START, HTML_END, HTML_START_END, HTML_ERROR);

   type Entity_State_Type is (ENTITY_NONE, ENTITY_MIDDLE, ENTITY_VALID);

   type Parser_Type is limited private;

   function Is_Empty (Parser : in Parser_Type) return Boolean;

   --  Parse a HTML element `<XXX attributes>` or parse an end of HTML element </XXX>
   --  The first '<' is assumed to have been already verified.
   procedure Parse_Element (Parser  : in out Parser_Type;
                            Text    : in Wiki.Strings.WString;
                            From    : in Positive;
                            Process : not null access
                             procedure (Kind  : in State_Type;
                                        Name  : in Wiki.Strings.WString;
                                        Attr  : in out Wiki.Attributes.Attribute_List);
                            Last    : out Positive);

   --  Parse an HTML entity such as ` ` and return its value with the last position
   --  if it was correct.  The first `&` is assumed to have been already verified.
   --  When `Entity` is not 0, the parsing is finished.  When `Last` exceeds the input
   --  text position, it is necessary to call `Parse_Entity` with the next input chunk.
   procedure Parse_Entity (Parser  : in out Parser_Type;
                           Text    : in Wiki.Strings.WString;
                           From    : in Positive;
                           Status  : in out Entity_State_Type;
                           Entity  : out Wiki.Strings.WChar;
                           Last    : out Natural);

   NUL : constant Wiki.Strings.WChar := Wiki.Strings.WChar'Val (0);

private

   type Html_Parser_State is (State_None,
                              State_Comment_Or_Doctype,
                              State_Doctype,
                              State_Comment,
                              State_Element,
                              State_Check_Attribute,
                              State_Parse_Attribute,
                              State_Check_Attribute_Value,
                              State_Parse_Attribute_Value,
                              State_Valid_Attribute_Value,
                              State_No_Attribute_Value,
                              State_Expect_Start_End_Element,
                              State_Expect_End_Element,
                              State_End_Element);

   MAX_ENTITY_LENGTH : constant := 10;

   type Parser_Type is limited record
      State       : Html_Parser_State := State_None;
      Elt_Name    : Wiki.Strings.BString (64);
      Attr_Name   : Wiki.Strings.BString (64);
      Attr_Value  : Wiki.Strings.BString (256);
      Attributes  : Wiki.Attributes.Attribute_List;
      Entity_Name : String (1 .. MAX_ENTITY_LENGTH);
      Counter     : Natural := 0;
      Separator   : Wiki.Strings.WChar;
   end record;

end Wiki.Html_Parser;

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

--  This is a small HTML parser that is called to deal with embedded HTML in wiki text.
--  The parser is intended to handle incorrect HTML and clean the result as much as possible.
--  We cannot use a real XML/Sax parser (such as XML/Ada) because we must handle errors and
--  backtrack from HTML parsing to wiki or raw text parsing.
--
--  When parsing HTML content, we call the `Parse_Element` and it calls back the `Process`
--  parameter procedure with the element name and the optional attributes.
private package Wiki.Html_Parser is

   pragma Preelaborate;

   type State_Type is (HTML_START, HTML_END, HTML_START_END, HTML_ERROR);

   type Entity_State_Type is (ENTITY_NONE, ENTITY_MIDDLE, ENTITY_VALID);

   type Parser_Type is limited private;

   function Is_Empty (Parser : in Parser_Type) return Boolean;

   --  Parse a HTML element `<XXX attributes>` or parse an end of HTML element </XXX>
   --  The first '<' is assumed to have been already verified.
   procedure Parse_Element (Parser  : in out Parser_Type;
                            Text    : in Wiki.Strings.WString;
                            From    : in Positive;
                            Process : not null access
                             procedure (Kind  : in State_Type;
                                        Name  : in Wiki.Strings.WString;
                                        Attr  : in out Wiki.Attributes.Attribute_List);
                            Last    : out Positive);

   --  Parse an HTML entity such as ` ` and return its value with the last position
   --  if it was correct.  The first `&` is assumed to have been already verified.
   --  When `Entity` is not 0, the parsing is finished.  When `Last` exceeds the input
   --  text position, it is necessary to call `Parse_Entity` with the next input chunk.
   procedure Parse_Entity (Parser  : in out Parser_Type;
                           Text    : in Wiki.Strings.WString;
                           From    : in Positive;
                           Status  : in out Entity_State_Type;
                           Entity  : out Wiki.Strings.WChar;
                           Last    : out Natural);

   NUL : constant Wiki.Strings.WChar := Wiki.Strings.WChar'Val (0);

private

   type Html_Parser_State is (State_None,
                              State_Comment_Or_Doctype,
                              State_Doctype,
                              State_Comment,
                              State_Element,
                              State_Check_Attribute,
                              State_Parse_Attribute,
                              State_Check_Attribute_Value,
                              State_Parse_Attribute_Value,
                              State_Valid_Attribute_Value,
                              State_No_Attribute_Value,
                              State_Expect_Start_End_Element,
                              State_Expect_End_Element,
                              State_End_Element);

   MAX_ENTITY_LENGTH : constant := 32;

   type Parser_Type is limited record
      State       : Html_Parser_State := State_None;
      Elt_Name    : Wiki.Strings.BString (64);
      Attr_Name   : Wiki.Strings.BString (64);
      Attr_Value  : Wiki.Strings.BString (256);
      Attributes  : Wiki.Attributes.Attribute_List;
      Entity_Name : String (1 .. MAX_ENTITY_LENGTH);
      Counter     : Natural := 0;
      Separator   : Wiki.Strings.WChar;
   end record;

end Wiki.Html_Parser;

Change MAX_ENTITY_LENGTH to 32 because the HTML5 defines a very long entity name


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

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

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

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

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

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

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

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

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

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

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

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

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

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Engine   : in out Wiki_Renderer;
                       Optional : in Boolean := False);
   procedure Need_Separator_Line (Engine   : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

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

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Link_First          : Boolean := False;
      Html_Blockquote     : Boolean := False;
      Need_Newline        : Boolean := False;
      Line_Count          : Natural := 0;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

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

with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Streams;
with Wiki.Strings;

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

   use Standard.Wiki.Attributes;

   --  ------------------------------
   --  Wiki to HTML writer
   --  ------------------------------
   type Wiki_Renderer is new Renderer with private;

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

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

   --  Add a section header in the document.
   procedure Render_Header (Engine : in out Wiki_Renderer;
                            Header : in Wide_Wide_String;
                            Level  : in Positive);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Engine : in out Wiki_Renderer);

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

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

   --  Render a link.
   procedure Render_Link (Engine : in out Wiki_Renderer;
                          Name     : in Strings.WString;
                          Attrs    : in Attributes.Attribute_List);

   --  Render an image.
   procedure Render_Image (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Render a quote.
   procedure Render_Quote (Engine : in out Wiki_Renderer;
                           Title  : in Strings.WString;
                           Attrs  : in Attributes.Attribute_List);

   --  Add a text block with the given format.
   procedure Render_Text (Engine : in out Wiki_Renderer;
                          Text   : in Wide_Wide_String;
                          Format : in Format_Map);

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

   procedure Render_Tag (Engine : in out Wiki_Renderer;
                         Doc    : in Documents.Document;
                         Node   : in Nodes.Node_Type);

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

   --  Set the text style format.
   procedure Set_Format (Engine : in out Wiki_Renderer;
                         Format   : in Format_Map);

private

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wide_String_Access is access constant Wide_Wide_String;

   type Wiki_Tag_Type is (Header_Start, Header_End,
                          Img_Start, Img_End,
                          Link_Start, Link_End, Link_Separator,
                          Quote_Start, Quote_End, Quote_Separator,
                          Preformat_Start, Preformat_End,
                          List_Start, List_Item, List_Ordered_Item,
                          Line_Break, Escape_Rule,
                          Horizontal_Rule,
                          Blockquote_Start, Blockquote_End);

   type Wiki_Tag_Array is array (Wiki_Tag_Type) of Wide_String_Access;

   type Wiki_Format_Array is array (Format_Type) of Wide_String_Access;

   --  Emit a new line.
   procedure New_Line (Engine   : in out Wiki_Renderer;
                       Optional : in Boolean := False);
   procedure Need_Separator_Line (Engine   : in out Wiki_Renderer);

   procedure Close_Paragraph (Engine : in out Wiki_Renderer);
   procedure Start_Keep_Content (Engine : in out Wiki_Renderer);

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

   EMPTY_TAG : aliased constant Wide_Wide_String := "";

   type Wiki_Renderer is new Renderer with record
      Output              : Streams.Output_Stream_Access := null;
      Syntax              : Wiki_Syntax := SYNTAX_CREOLE;
      Format              : Format_Map := (others => False);
      Tags                : Wiki_Tag_Array := (others => EMPTY_TAG'Access);
      Style_Start_Tags    : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Style_End_Tags      : Wiki_Format_Array := (others => EMPTY_TAG'Access);
      Escape_Set          : Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Set;
      Has_Paragraph       : Boolean := False;
      Has_Item            : Boolean := False;
      Need_Paragraph      : Boolean := False;
      Empty_Line          : Boolean := True;
      Empty_Previous_Line : Boolean := True;
      Keep_Content        : Boolean := False;
      In_List             : Boolean := False;
      Invert_Header_Level : Boolean := False;
      Allow_Link_Language : Boolean := False;
      Link_First          : Boolean := False;
      Html_Blockquote     : Boolean := False;
      Need_Newline        : Boolean := False;
      Line_Count          : Natural := 0;
      Current_Level       : Natural := 0;
      Quote_Level         : Natural := 0;
      UL_List_Level       : Natural := 0;
      OL_List_Level       : Natural := 0;
      Current_Style       : Format_Map := (others => False);
      Content             : Unbounded_Wide_Wide_String;
      Link_Href           : Unbounded_Wide_Wide_String;
      Link_Title          : Unbounded_Wide_Wide_String;
      Link_Lang           : Unbounded_Wide_Wide_String;
   end record;

end Wiki.Render.Wiki;

Add Empty_Previous_Line in the Wiki_Renderer type


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

with DOM.Core;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

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

with DOM.Core;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is abstract;

   --  Get the result directory path.
   function Get_Result_Directory (Handler : in Generator) return String is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

Add the Get_Result_Directory function to the Artifact interface


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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--  In this policy, users are assigned one or several roles and permissions are
--  associated with roles.  A permission is granted if the user has one of the roles required
--  by the permission.
--
--  === Policy creation ===
--  An instance of the <tt>Role_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Roles.Role_Policy_Access;
--
--  Create the role policy and register it in the policy manager as follows:
--
--    Policy := new Role_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  A role is represented by a name in security configuration files.  A role based permission
--  is associated with a list of roles.  The permission is granted if the user has one of these
--  roles.  When the role based policy is registered in the policy manager, the following
--  XML configuration is used:
--
--    <policy-rules>
--      <security-role>
--        <role-name>admin</role-name>
--      </security-role>
--      <security-role>
--        <role-name>manager</role-name>
--      </security-role>
--      <role-permission>
--        <name>create-workspace</name>
--        <role>admin</role>
--        <role>manager</role>
--      </role-permission>
--      ...
--    </policy-rules>
--
--  This definition declares two roles: <tt>admin</tt> and <tt>manager</tt>
--  It defines a permission create-workspace that will be granted if the
--  user has either the admin or the manager role.
--
--  Each role is identified by a name in the configuration file.  It is represented by
--  a <tt>Role_Type</tt>.  To provide an efficient implementation, the <tt>Role_Type</tt>
--  is represented as an integer with a limit of 64 different roles.
--
--  === Assigning roles to users ===
--  A <tt>Security_Context</tt> must be associated with a set of roles before checking the
--  permission.  This is done by using the <tt>Set_Role_Context</tt> operation:
--
--     Security.Policies.Roles.Set_Role_Context (Security.Contexts.Current, "admin");
--
package Security.Policies.Roles is

   NAME : constant String := "Role-Policy";

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role principal context
   --  ------------------------------
   --  The <tt>Role_Principal_Context</tt> interface must be implemented by the user
   --  <tt>Principal</tt> to be able to use the role based policy.   The role based policy
   --  controller will first check that the <tt>Principal</tt> implements that interface.
   --  It uses the <tt>Get_Roles</tt> function to get the current roles assigned to the user.
   type Role_Principal_Context is limited interface;
   function Get_Roles (User : in Role_Principal_Context) return Role_Map is abstract;

   --  ------------------------------
   --  Policy context
   --  ------------------------------
   --  The Role_Policy_Context gives security context information that the role
   --  based policy can use to verify the permission.
   type Role_Policy_Context is new Policy_Context with record
      Roles : Role_Map;
   end record;
   type Role_Policy_Context_Access is access all Role_Policy_Context'Class;

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map);

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in String);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;
   type Role_Policy_Access is access all Role_Policy'Class;

   Invalid_Name : exception;

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

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Set the roles specified in the <tt>Roles</tt> parameter.  Each role is represented by
   --  its name and multiple roles are separated by ','.
   --  Raises Invalid_Name if a role was not found.
   procedure Set_Roles (Manager : in Role_Policy;
                        Roles   : in String;
                        Into    : out Role_Map);

   --  Setup the XML parser to read the role-permission description.
   overriding
   procedure Prepare_Config (Policy : in out Role_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

   --  Finalize the policy manager.
   overriding
   procedure Finalize (Policy : in out Role_Policy);

   --  Get the role policy associated with the given policy manager.
   --  Returns the role policy instance or null if it was not registered in the policy manager.
   function Get_Role_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                             return Role_Policy_Access;

private

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names     : Role_Name_Array := (others => null);
      Next_Role : Role_Type := Role_Type'First;
      Name      : Util.Beans.Objects.Object;
      Roles     : Role_Type_Array (1 .. Integer (Role_Type'Last)) := (others => 0);
      Count     : Natural := 0;
   end record;

end Security.Policies.Roles;

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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--  In this policy, users are assigned one or several roles and permissions are
--  associated with roles.  A permission is granted if the user has one of the roles required
--  by the permission.
--
--  === Policy creation ===
--  An instance of the <tt>Role_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Roles.Role_Policy_Access;
--
--  Create the role policy and register it in the policy manager as follows:
--
--    Policy := new Role_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  A role is represented by a name in security configuration files.  A role based permission
--  is associated with a list of roles.  The permission is granted if the user has one of these
--  roles.  When the role based policy is registered in the policy manager, the following
--  XML configuration is used:
--
--    <policy-rules>
--      <security-role>
--        <role-name>admin</role-name>
--      </security-role>
--      <security-role>
--        <role-name>manager</role-name>
--      </security-role>
--      <role-permission>
--        <name>create-workspace</name>
--        <role>admin</role>
--        <role>manager</role>
--      </role-permission>
--      ...
--    </policy-rules>
--
--  This definition declares two roles: <tt>admin</tt> and <tt>manager</tt>
--  It defines a permission create-workspace that will be granted if the
--  user has either the admin or the manager role.
--
--  Each role is identified by a name in the configuration file.  It is represented by
--  a <tt>Role_Type</tt>.  To provide an efficient implementation, the <tt>Role_Type</tt>
--  is represented as an integer with a limit of 64 different roles.
--
--  === Assigning roles to users ===
--  A <tt>Security_Context</tt> must be associated with a set of roles before checking the
--  permission.  This is done by using the <tt>Set_Role_Context</tt> operation:
--
--     Security.Policies.Roles.Set_Role_Context (Security.Contexts.Current, "admin");
--
package Security.Policies.Roles is

   NAME : constant String := "Role-Policy";

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role principal context
   --  ------------------------------
   --  The <tt>Role_Principal_Context</tt> interface must be implemented by the user
   --  <tt>Principal</tt> to be able to use the role based policy.   The role based policy
   --  controller will first check that the <tt>Principal</tt> implements that interface.
   --  It uses the <tt>Get_Roles</tt> function to get the current roles assigned to the user.
   type Role_Principal_Context is limited interface;
   function Get_Roles (User : in Role_Principal_Context) return Role_Map is abstract;

   --  ------------------------------
   --  Policy context
   --  ------------------------------
   --  The Role_Policy_Context gives security context information that the role
   --  based policy can use to verify the permission.
   type Role_Policy_Context is new Policy_Context with record
      Roles : Role_Map;
   end record;
   type Role_Policy_Context_Access is access all Role_Policy_Context'Class;

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map);

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in String);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;
   type Role_Policy_Access is access all Role_Policy'Class;

   Invalid_Name : exception;

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

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Set the roles specified in the <tt>Roles</tt> parameter.  Each role is represented by
   --  its name and multiple roles are separated by ','.
   --  Raises Invalid_Name if a role was not found.
   procedure Set_Roles (Manager : in Role_Policy;
                        Roles   : in String;
                        Into    : out Role_Map);

   --  Setup the XML parser to read the role-permission description.
   overriding
   procedure Prepare_Config (Policy : in out Role_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

   --  Finalize the policy manager.
   overriding
   procedure Finalize (Policy : in out Role_Policy);

   --  Get the role policy associated with the given policy manager.
   --  Returns the role policy instance or null if it was not registered in the policy manager.
   function Get_Role_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                             return Role_Policy_Access;

private

   --  Array to map a permission index to a list of roles that are granted the permission.
   type Permission_Role_Array is array (Permission_Index) of Role_Map;

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names     : Role_Name_Array := (others => null);
      Next_Role : Role_Type := Role_Type'First;
      Name      : Util.Beans.Objects.Object;
      Roles     : Role_Type_Array (1 .. Integer (Role_Type'Last)) := (others => 0);
      Count     : Natural := 0;

      --  The Grants array indicates for each permission the list of roles
      --  that are granted the permission.  This array allows a O(1) lookup.
      --  The implementation is limited to 256 permissions and 64 roles so this array uses 2K.
      --  The default is that no role is assigned to the permission.
      Grants    : Permission_Role_Array := (others => (others => False));
   end record;

end Security.Policies.Roles;

Declare the Permission_Role_Array type Add a Grants member to the Role_Policy type to know easily the roles that grant a given permission


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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--
--  A role is represented by a name in security configuration files.
package Security.Policies.Roles is

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;

   Invalid_Name : exception;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

private

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names        : Role_Name_Array;
      Next_Role    : Role_Type := Role_Type'First;
   end record;

   type Controller_Config is record
      Name    : Util.Beans.Objects.Object;
      Roles   : Permissions.Role_Type_Array (1 .. Integer (Permissions.Role_Type'Last));
      Count   : Natural := 0;
      Manager : Security.Permissions.Permission_Manager_Access;
   end record;

   --  Setup the XML parser to read the role-permission description.  For example:
   --
   --  <security-role>
   --    <role-name>admin</role-name>
   --  </security-role>
   --  <role-permission>
   --     <name>create-workspace</name>
   --     <role>admin</role>
   --     <role>manager</role>
   --  </role-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  user has either the admin or the manager role.
   overriding
   procedure Set_Reader_Config (Pol     : in out Policy;
                                Reader  : in out Util.Serialize.IO.XML.Parser);

end Security.Policies.Roles;

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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--
--  A role is represented by a name in security configuration files.
package Security.Policies.Roles is

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;

   Invalid_Name : exception;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

private

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names        : Role_Name_Array;
      Next_Role    : Role_Type := Role_Type'First;
   end record;

   type Controller_Config is record
      Name    : Util.Beans.Objects.Object;
      Roles   : Permissions.Role_Type_Array (1 .. Integer (Permissions.Role_Type'Last));
      Count   : Natural := 0;
      Manager : Security.Permissions.Permission_Manager_Access;
   end record;

   --  Setup the XML parser to read the role-permission description.  For example:
   --
   --  <security-role>
   --    <role-name>admin</role-name>
   --  </security-role>
   --  <role-permission>
   --     <name>create-workspace</name>
   --     <role>admin</role>
   --     <role>manager</role>
   --  </role-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  user has either the admin or the manager role.
   overriding
   procedure Set_Reader_Config (Pol     : in out Policy;
                                Reader  : in out Util.Serialize.IO.XML.Parser);

end Security.Policies.Roles;

Remove Permission_Type and Permission_Map


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

with DOM.Core;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is abstract;

   --  Get the result directory path.
   function Get_Result_Directory (Handler : in Generator) return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in String := "") return String is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

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

with DOM.Core;
with Gen.Model;
with Gen.Model.Packages;
with Gen.Model.Projects;

--  The Gen.Artifacts package represents the methods and process to prepare,
--  control and realize the code generation.
package Gen.Artifacts is

   type Iteration_Mode is (ITERATION_PACKAGE, ITERATION_TABLE);

   type Generator is limited interface;

   --  Report an error and set the exit status accordingly
   procedure Error (Handler : in out Generator;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is abstract;

   --  Get the config directory path.
   function Get_Config_Directory (Handler : in Generator) return String is abstract;

   --  Get the result directory path.
   function Get_Result_Directory (Handler : in Generator) return String is abstract;

   --  Get the configuration parameter.
   function Get_Parameter (Handler : in Generator;
                           Name    : in String;
                           Default : in String := "") return String is abstract;

   --  Tell the generator to activate the generation of the given template name.
   --  The name is a property name that must be defined in generator.properties to
   --  indicate the template file.  Several artifacts can trigger the generation
   --  of a given template.  The template is generated only once.
   procedure Add_Generation (Handler : in out Generator;
                             Name    : in String;
                             Mode    : in Iteration_Mode) is abstract;

   --  Scan the dynamo directories and execute the Process procedure with the
   --  directory path.
   procedure Scan_Directories (Handler : in Generator;
                               Process : not null access
                                 procedure (Dir : in String)) is abstract;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   type Artifact is abstract new Ada.Finalization.Limited_Controlled with private;

   --  After the configuration file is read, processes the node whose root
   --  is passed in Node and initializes the Model with the information.
   procedure Initialize (Handler : in out Artifact;
                         Path    : in String;
                         Node    : in DOM.Core.Node;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class);

   --  Prepare the model after all the configuration files have been read and before
   --  actually invoking the generation.
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Context : in out Generator'Class) is null;

   --  After the generation, perform a finalization step for the generation process.
   procedure Finish (Handler : in out Artifact;
                     Model   : in out Gen.Model.Packages.Model_Definition'Class;
                     Project : in out Gen.Model.Projects.Project_Definition'Class;
                     Context : in out Generator'Class) is null;

   --  Check whether this artifact has been initialized.
   function Is_Initialized (Handler : in Artifact) return Boolean;

private

   type Artifact is abstract new Ada.Finalization.Limited_Controlled with record
      Initialized : Boolean := False;
   end record;

end Gen.Artifacts;

Add the Get_Config_Directory function to the artifact interface