-----------------------------------------------------------------------
--  util-log-appenders -- Log appenders
--  Copyright (C) 2001 - 2021 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.Calendar;
with Ada.Finalization;
with Util.Properties;
with Util.Strings.Builders;

--  The log Appender will handle the low level operations to write
--  the log content to a file, the console, a database.
package Util.Log.Appenders is

   --  The layout type to indicate how to format the message.
   --  Unlike Logj4, there is no customizable layout.
   type Layout_Type
     is (
         --  The message layout with only the log message.
         --  Ex: "Cannot open file"
         MESSAGE,

         --  The level-message layout with level and message.
         --  Ex: "ERROR: Cannot open file"
         LEVEL_MESSAGE,

         --  The date-level-message layout with date
         --  Ex: "2011-03-04 12:13:34 ERROR: Cannot open file"
         DATE_LEVEL_MESSAGE,

         --  The full layout with everything (the default).
         --  Ex: "2011-03-04 12:13:34 ERROR - my.application - Cannot open file"
         FULL);

   type Appender;
   type Appender_Access is access all Appender'Class;

   --  ------------------------------
   --  Log appender
   --  ------------------------------
   type Appender (Length : Positive) is abstract
     new Ada.Finalization.Limited_Controlled with record
      Next     : Appender_Access;
      Level    : Level_Type := INFO_LEVEL;
      Layout   : Layout_Type := FULL;
      Name     : String (1 .. Length);
   end record;

   --  Get the log level that triggers display of the log events
   function Get_Level (Self : in Appender) return Level_Type;

   --  Set the log level.
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type);
   procedure Set_Level (Self       : in out Appender;
                        Level      : in Level_Type);

   --  Set the log layout format.
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type);
   procedure Set_Layout (Self       : in out Appender;
                         Layout     : in Layout_Type);

   --  Format the event into a string
   function Format (Self    : in Appender'Class;
                    Date    : in Ada.Calendar.Time;
                    Level   : in Level_Type;
                    Logger  : in String) return String;

   --  Append a log event to the appender.  Depending on the log level
   --  defined on the appender, the event can be taken into account or
   --  ignored.
   procedure Append (Self    : in out Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String) is abstract;

   --  Flush the log events.
   procedure Flush (Self   : in out Appender) is abstract;

   --  ------------------------------
   --  List appender
   --  ------------------------------
   --  Write log events to a list of appenders
   type List_Appender (Length : Positive) is new Appender with private;
   type List_Appender_Access is access all List_Appender'Class;

   --  Max number of appenders that can be added to the list.
   --  In most cases, 2 or 3 appenders will be used.
   MAX_APPENDERS : constant Natural := 10;

   overriding
   procedure Append (Self    : in out List_Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out List_Appender);

   --  Add the appender to the list.
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access);

   --  Create a list appender and configure it according to the properties
   function Create_List_Appender (Name : in String) return List_Appender_Access;

   type Appender_List is limited private;

   --  Find an appender with a given name from the list of appenders.
   --  Returns null if there is no such appender.
   function Find_Appender (List : in Appender_List;
                           Name : in String) return Appender_Access;

   --  Add the appender to the list of appenders.
   procedure Add_Appender (List     : in out Appender_List;
                           Appender : in Appender_Access);

   --  Clear the list of appenders.
   procedure Clear (List : in out Appender_List);

   type Factory_Access is
     access function (Name       : in String;
                      Properties : in Util.Properties.Manager;
                      Default    : in Level_Type) return Appender_Access;

   type Appender_Factory;
   type Appender_Factory_Access is access all Appender_Factory;

   type Appender_Factory (Length : Positive) is limited record
      Next_Factory : Appender_Factory_Access;
      Factory      : Factory_Access;
      Name         : String (1 .. Length);
   end record;

   --  Register the factory handler to create an appender instance.
   procedure Register (Into   : in Appender_Factory_Access;
                       Name   : in String;
                       Create : in Factory_Access);

   --  Create an appender instance with a factory with the given name.
   function Create (Name    : in String;
                    Config  : in Util.Properties.Manager;
                    Default : in Level_Type) return Appender_Access;

private

   type Appender_List is limited record
      First : Appender_Access;
   end record;

   type Appender_Array_Access is array (1 .. MAX_APPENDERS) of Appender_Access;

   type List_Appender (Length : Positive) is new Appender (Length) with record
      Appenders : Appender_Array_Access;
      Count     : Natural := 0;
   end record;

end Util.Log.Appenders;

-----------------------------------------------------------------------
--  util-log-appenders -- Log appenders
--  Copyright (C) 2001 - 2021 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.Calendar;
with Ada.Finalization;
with Util.Properties;
with Util.Strings.Builders;

--  The log Appender will handle the low level operations to write
--  the log content to a file, the console, a database.
package Util.Log.Appenders is

   --  The layout type to indicate how to format the message.
   --  Unlike Logj4, there is no customizable layout.
   type Layout_Type
     is (
         --  The message layout with only the log message.
         --  Ex: "Cannot open file"
         MESSAGE,

         --  The level-message layout with level and message.
         --  Ex: "ERROR: Cannot open file"
         LEVEL_MESSAGE,

         --  The date-level-message layout with date
         --  Ex: "2011-03-04 12:13:34 ERROR: Cannot open file"
         DATE_LEVEL_MESSAGE,

         --  The full layout with everything (the default).
         --  Ex: "2011-03-04 12:13:34 ERROR - my.application - Cannot open file"
         FULL);

   type Appender (Length : Positive) is
     abstract new Ada.Finalization.Limited_Controlled with private;

   type Appender_Access is access all Appender'Class;

   --  Get the log level that triggers display of the log events
   function Get_Level (Self : in Appender) return Level_Type;

   --  Set the log level.
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type);
   procedure Set_Level (Self       : in out Appender;
                        Level      : in Level_Type);

   --  Set the log layout format.
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type);
   procedure Set_Layout (Self       : in out Appender;
                         Layout     : in Layout_Type);

   --  Format the event into a string
   function Format (Self    : in Appender'Class;
                    Date    : in Ada.Calendar.Time;
                    Level   : in Level_Type;
                    Logger  : in String) return String;

   --  Append a log event to the appender.  Depending on the log level
   --  defined on the appender, the event can be taken into account or
   --  ignored.
   procedure Append (Self    : in out Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String) is abstract;

   --  Flush the log events.
   procedure Flush (Self   : in out Appender) is abstract;

   --  ------------------------------
   --  List appender
   --  ------------------------------
   --  Write log events to a list of appenders
   type List_Appender (Length : Positive) is new Appender with private;
   type List_Appender_Access is access all List_Appender'Class;

   --  Max number of appenders that can be added to the list.
   --  In most cases, 2 or 3 appenders will be used.
   MAX_APPENDERS : constant Natural := 10;

   overriding
   procedure Append (Self    : in out List_Appender;
                     Message : in Util.Strings.Builders.Builder;
                     Date    : in Ada.Calendar.Time;
                     Level   : in Level_Type;
                     Logger  : in String);

   --  Flush the log events.
   overriding
   procedure Flush (Self   : in out List_Appender);

   --  Add the appender to the list.
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access);

   --  Create a list appender and configure it according to the properties
   function Create_List_Appender (Name : in String) return List_Appender_Access;

   type Appender_List is limited private;

   --  Find an appender with a given name from the list of appenders.
   --  Returns null if there is no such appender.
   function Find_Appender (List : in Appender_List;
                           Name : in String) return Appender_Access;

   --  Add the appender to the list of appenders.
   procedure Add_Appender (List     : in out Appender_List;
                           Appender : in Appender_Access);

   --  Clear the list of appenders.
   procedure Clear (List : in out Appender_List);

   type Factory_Access is
     access function (Name       : in String;
                      Properties : in Util.Properties.Manager;
                      Default    : in Level_Type) return Appender_Access;

   type Appender_Factory;
   type Appender_Factory_Access is access all Appender_Factory;

   type Appender_Factory (Length : Positive) is limited record
      Next_Factory : Appender_Factory_Access;
      Factory      : Factory_Access;
      Name         : String (1 .. Length);
   end record;

   --  Register the factory handler to create an appender instance.
   procedure Register (Into   : in Appender_Factory_Access;
                       Name   : in String;
                       Create : in Factory_Access);

   --  Create an appender instance with a factory with the given name.
   function Create (Name    : in String;
                    Config  : in Util.Properties.Manager;
                    Default : in Level_Type) return Appender_Access;

private

   --  ------------------------------
   --  Log appender
   --  ------------------------------
   type Appender (Length : Positive) is abstract
     new Ada.Finalization.Limited_Controlled with record
      Next     : Appender_Access;
      Level    : Level_Type := INFO_LEVEL;
      Layout   : Layout_Type := FULL;
      Name     : String (1 .. Length);
   end record;

   type Appender_List is limited record
      First : Appender_Access;
   end record;

   type Appender_Array_Access is array (1 .. MAX_APPENDERS) of Appender_Access;

   type List_Appender (Length : Positive) is new Appender (Length) with record
      Appenders : Appender_Array_Access;
      Count     : Natural := 0;
   end record;

end Util.Log.Appenders;

Fix compilation warning with GNAT 2021

Fix compilation warning with GNAT 2021


-----------------------------------------------------------------------
--  util-serialize-io-json -- JSON Serialization Driver
--  Copyright (C) 2010, 2011, 2012, 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 Util.Streams.Texts;
with Util.Stacks;
package Util.Serialize.IO.JSON is

   --  ------------------------------
   --  JSON Output Stream
   --  ------------------------------
   --  The <b>Output_Stream</b> provides methods for creating a JSON output stream.
   --  The stream object takes care of the JSON escape rules.
   type Output_Stream is
     new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with private;

   --  Start a JSON document.  This operation writes the initial JSON marker ('{').
   overriding
   procedure Start_Document (Stream : in out Output_Stream);

   --  Finish a JSON document by writing the final JSON marker ('}').
   overriding
   procedure End_Document (Stream : in out Output_Stream);

   --  Write the value as a JSON string.  Special characters are escaped using the JSON
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in String);

   --  Write the value as a JSON string.  Special characters are escaped using the JSON
   --  escape rules.
   procedure Write_Wide_String (Stream : in out Output_Stream;
                                Value  : in Wide_Wide_String);

   --  Start a new JSON object.  If the name is not empty, write it as a string
   --  followed by the ':' (colon).  The JSON object starts with '{' (curly brace).
   --  Example:   "list": {
   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String);

   --  Terminates the current JSON object.
   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String);

   --  Write the attribute name/value pair.
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String);

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean);

   --  Write a JSON name/value pair.  The value is written according to its type
   --  Example:  "name": null
   --            "name": false
   --            "name": 12
   --            "name": "value"
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object);

   --  Write a JSON name/value pair (see Write_Attribute).
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object);

   --  Write a JSON name/value pair (see Write_Attribute).
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String);

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer);

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer);

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String);

   --  Starts a JSON array.
   --  Example:  "list": [
   overriding
   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String);

   --  Terminates a JSON array.
   overriding
   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String);

   type Parser is new Serialize.IO.Parser with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

private

   type Node_Info is record
      Is_Array   : Boolean := False;
      Has_Fields : Boolean := False;
   end record;
   type Node_Info_Access is access all Node_Info;

   package Node_Info_Stack is new Util.Stacks (Element_Type => Node_Info,
                                               Element_Type_Access => Node_Info_Access);

   type Output_Stream is
     new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with record
      Stack : Node_Info_Stack.Stack;
   end record;

   type Token_Type is (T_EOF, T_LEFT_BRACE, T_RIGHT_BRACE, T_LEFT_BRACKET,
                       T_RIGHT_BRACKET, T_COLON, T_COMMA, T_TRUE, T_FALSE,
                       T_STRING, T_NUMBER, T_BOOLEAN, T_UNKNOWN, T_NULL);

   type Parser is new Util.Serialize.IO.Parser with record
      Token            : Ada.Strings.Unbounded.Unbounded_String;
      Pending_Token    : Token_Type := T_EOF;
      Line_Number      : Natural  := 1;
      Has_Pending_Char : Boolean := False;
      Pending_Char     : Character;
   end record;

end Util.Serialize.IO.JSON;

-----------------------------------------------------------------------
--  util-serialize-io-json -- JSON Serialization Driver
--  Copyright (C) 2010, 2011, 2012, 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 Util.Streams.Texts;
with Util.Stacks;
package Util.Serialize.IO.JSON is

   --  ------------------------------
   --  JSON Output Stream
   --  ------------------------------
   --  The <b>Output_Stream</b> provides methods for creating a JSON output stream.
   --  The stream object takes care of the JSON escape rules.
   type Output_Stream is
     new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with private;

   --  Start a JSON document.  This operation writes the initial JSON marker ('{').
   overriding
   procedure Start_Document (Stream : in out Output_Stream);

   --  Finish a JSON document by writing the final JSON marker ('}').
   overriding
   procedure End_Document (Stream : in out Output_Stream);

   --  Write the value as a JSON string.  Special characters are escaped using the JSON
   --  escape rules.
   procedure Write_String (Stream : in out Output_Stream;
                           Value  : in String);

   --  Write the value as a JSON string.  Special characters are escaped using the JSON
   --  escape rules.
   procedure Write_Wide_String (Stream : in out Output_Stream;
                                Value  : in Wide_Wide_String);

   --  Start a new JSON object.  If the name is not empty, write it as a string
   --  followed by the ':' (colon).  The JSON object starts with '{' (curly brace).
   --  Example:   "list": {
   procedure Start_Entity (Stream : in out Output_Stream;
                           Name   : in String);

   --  Terminates the current JSON object.
   procedure End_Entity (Stream : in out Output_Stream;
                         Name   : in String);

   --  Write the attribute name/value pair.
   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in String);

   overriding
   procedure Write_Wide_Attribute (Stream : in out Output_Stream;
                                   Name   : in String;
                                   Value  : in Wide_Wide_String);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Integer);

   overriding
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Boolean);

   --  Write a JSON name/value pair.  The value is written according to its type
   --  Example:  "name": null
   --            "name": false
   --            "name": 12
   --            "name": "value"
   procedure Write_Attribute (Stream : in out Output_Stream;
                              Name   : in String;
                              Value  : in Util.Beans.Objects.Object);

   --  Write a JSON name/value pair (see Write_Attribute).
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Util.Beans.Objects.Object);

   --  Write a JSON name/value pair (see Write_Attribute).
   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in String);

   overriding
   procedure Write_Wide_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Wide_Wide_String);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Boolean);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Integer);

   overriding
   procedure Write_Entity (Stream : in out Output_Stream;
                           Name   : in String;
                           Value  : in Ada.Calendar.Time);

   overriding
   procedure Write_Long_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in Long_Long_Integer);

   overriding
   procedure Write_Enum_Entity (Stream : in out Output_Stream;
                                Name   : in String;
                                Value  : in String);

   --  Starts a JSON array.
   --  Example:  "list": [
   overriding
   procedure Start_Array (Stream : in out Output_Stream;
                          Name   : in String);

   --  Terminates a JSON array.
   overriding
   procedure End_Array (Stream : in out Output_Stream;
                        Name   : in String);

   type Parser is new Serialize.IO.Parser with private;

   --  Parse the stream using the JSON parser.
   procedure Parse (Handler : in out Parser;
                    Stream  : in out Util.Streams.Buffered.Buffered_Stream'Class);

   --  Get the current location (file and line) to report an error message.
   function Get_Location (Handler : in Parser) return String;

private

   type Node_Info is record
      Is_Array   : Boolean := False;
      Has_Fields : Boolean := False;
   end record;
   type Node_Info_Access is access all Node_Info;

   package Node_Info_Stack is new Util.Stacks (Element_Type => Node_Info,
                                               Element_Type_Access => Node_Info_Access);

   type Output_Stream is
     new Util.Streams.Texts.Print_Stream and Util.Serialize.IO.Output_Stream with record
      Stack : Node_Info_Stack.Stack;
   end record;

   type Token_Type is (T_EOF, T_LEFT_BRACE, T_RIGHT_BRACE, T_LEFT_BRACKET,
                       T_RIGHT_BRACKET, T_COLON, T_COMMA, T_TRUE, T_FALSE,
                       T_STRING, T_NUMBER, T_BOOLEAN, T_UNKNOWN, T_NULL);

   type Parser is new Util.Serialize.IO.Parser with record
      Token            : Ada.Strings.Unbounded.Unbounded_String;
      Pending_Token    : Token_Type := T_EOF;
      Line_Number      : Natural  := 1;
      Has_Pending_Char : Boolean := False;
      Pending_Char     : Character;
   end record;

end Util.Serialize.IO.JSON;

Declare the Write_Entity operation with a date/time


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

with Ada.Strings.Unbounded;
with Ada.Calendar;

with Util.Refs;
with Util.Streams.Buffered;
package ADO is

   type Int64 is range -2**63 .. 2**63 - 1;
   for Int64'Size use 64;

   type Unsigned64 is mod 2**64;
   for Unsigned64'Size use 64;

   DEFAULT_TIME : constant Ada.Calendar.Time;

   --  ------------------------------
   --  Database Identifier
   --  ------------------------------
   --
   type Identifier is range -2**47 .. 2**47 - 1;

   NO_IDENTIFIER : constant Identifier := -1;

   type Entity_Type is range 0 .. 2**16 - 1;

   NO_ENTITY_TYPE : constant Entity_Type := 0;

   type Object_Id is record
      Id   : Identifier;
      Kind : Entity_Type;
   end record;
   pragma Pack (Object_Id);

   --  ------------------------------
   --  Nullable Types
   --  ------------------------------
   --  Most database allow to store a NULL instead of an actual integer, date or string value.
   --  Unlike Java, there is no easy way to distinguish between a NULL and an actual valid value.
   --  The Nullable_T types provide a way to specify and check whether a value is null
   --  or not.

   --  An integer which can be null.
   type Nullable_Integer is record
      Value   : Integer := 0;
      Is_Null : Boolean := True;
   end record;

   --  A string which can be null.
   type Nullable_String is record
      Value   : Ada.Strings.Unbounded.Unbounded_String;
      Is_Null : Boolean := True;
   end record;

   --  A date which can be null.
   type Nullable_Time is record
      Value   : Ada.Calendar.Time;
      Is_Null : Boolean := True;
   end record;

   --  ------------------------------
   --  Blob data type
   --  ------------------------------
   --  The Blob type is used to represent database blobs.  The data is stored
   --  in an Ada.Streams.Stream_Element_Array pointed to by the Data member.
   --  The query statement and bind parameter will use a Blob_Ref which represents
   --  a reference to the blob data.  This is intended to minimize data copy.
   type Blob is new Util.Refs.Ref_Entity with record
      Data : Util.Streams.Buffered.Buffer_Access := null;
   end record;
   type Blob_Access is access all Blob;

   package Blob_References is new Util.Refs.References (Blob, Blob_Access);
   subtype Blob_Ref is Blob_References.Ref;

private

   DEFAULT_TIME : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year    => 1901,
                                                                      Month   => 1,
                                                                      Day     => 1,
                                                                      Seconds => 0.0);

end ADO;

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

with Ada.Strings.Unbounded;
with Ada.Calendar;

with Util.Refs;
with Util.Streams.Buffered;
package ADO is

   type Int64 is range -2**63 .. 2**63 - 1;
   for Int64'Size use 64;

   type Unsigned64 is mod 2**64;
   for Unsigned64'Size use 64;

   DEFAULT_TIME : constant Ada.Calendar.Time;

   --  ------------------------------
   --  Database Identifier
   --  ------------------------------
   --
   type Identifier is range -2**47 .. 2**47 - 1;

   NO_IDENTIFIER : constant Identifier := -1;

   type Entity_Type is range 0 .. 2**16 - 1;

   NO_ENTITY_TYPE : constant Entity_Type := 0;

   type Object_Id is record
      Id   : Identifier;
      Kind : Entity_Type;
   end record;
   pragma Pack (Object_Id);

   --  ------------------------------
   --  Nullable Types
   --  ------------------------------
   --  Most database allow to store a NULL instead of an actual integer, date or string value.
   --  Unlike Java, there is no easy way to distinguish between a NULL and an actual valid value.
   --  The Nullable_T types provide a way to specify and check whether a value is null
   --  or not.

   --  An integer which can be null.
   type Nullable_Integer is record
      Value   : Integer := 0;
      Is_Null : Boolean := True;
   end record;

   --  A string which can be null.
   type Nullable_String is record
      Value   : Ada.Strings.Unbounded.Unbounded_String;
      Is_Null : Boolean := True;
   end record;

   --  A date which can be null.
   type Nullable_Time is record
      Value   : Ada.Calendar.Time;
      Is_Null : Boolean := True;
   end record;

   --  ------------------------------
   --  Blob data type
   --  ------------------------------
   --  The Blob type is used to represent database blobs.  The data is stored
   --  in an Ada.Streams.Stream_Element_Array pointed to by the Data member.
   --  The query statement and bind parameter will use a Blob_Ref which represents
   --  a reference to the blob data.  This is intended to minimize data copy.
   type Blob is new Util.Refs.Ref_Entity with record
      Data : Util.Streams.Buffered.Buffer_Access := null;
   end record;
   type Blob_Access is access all Blob;

   package Blob_References is new Util.Refs.References (Blob, Blob_Access);
   subtype Blob_Ref is Blob_References.Ref;

private

   DEFAULT_TIME : constant Ada.Calendar.Time := Ada.Calendar.Time_Of (Year    => 1901,
                                                                      Month   => 1,
                                                                      Day     => 2,
                                                                      Seconds => 0.0);

end ADO;

Change default time to avoid timezone issues


-----------------------------------------------------------------------
--  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 Ada.Strings.Maps;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   use type Ada.Strings.Maps.Character_Set;

   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");

   Marker : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" .,;:!?")
     or Ada.Strings.Maps.To_Set (ASCII.HT)
     or Ada.Strings.Maps.To_Set (ASCII.VT)
     or Ada.Strings.Maps.To_Set (ASCII.CR)
     or Ada.Strings.Maps.To_Set (ASCII.LF);

   --  ------------------------------
   --  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;

   procedure Write_Text_Auto_Links (Formatter : in out Document_Formatter;
                                    File      : in Ada.Text_IO.File_Type;
                                    Text      : in String) is
      Start : Natural := Text'First;
      Last  : Natural := Text'Last;
      Link  : Util.Strings.Maps.Cursor;
      Pos   : Natural;
   begin
      Log.Debug ("Auto link |{0}|", Text);
      loop
         --  Emit spaces at beginning of line or words.
         while Start <= Text'Last and then Ada.Strings.Maps.Is_In (Text (Start), Marker) loop
            Ada.Text_IO.Put (File, Text (Start));
            Start := Start + 1;
         end loop;
         exit when Start > Text'Last;

         --  Find a possible link.
         Link := Formatter.Links.Find (Text (Start .. Last));
         if Util.Strings.Maps.Has_Element (Link) then
            Ada.Text_IO.Put (File, "[");
            Ada.Text_IO.Put (File, Text (Start .. Last));
            Ada.Text_IO.Put (File, "](");
            Ada.Text_IO.Put (File, Util.Strings.Maps.Element (Link));
            Ada.Text_IO.Put (File, ")");
            Start := Last + 1;
            Last := Text'Last;
         else
            Pos := Ada.Strings.Fixed.Index (Text (Start .. Last), Marker,
                                            Going => Ada.Strings.Backward);
            if Pos = 0 then
               Ada.Text_IO.Put (File, Text (Start .. Last));
               Start := Last + 1;
               Last := Text'Last;
            else
               Last := Pos - 1;

               --  Skip spaces at end of words for the search.
               while Last > Start and then Ada.Strings.Maps.Is_In (Text (Last), Marker) loop
                  Last := Last - 1;
               end loop;
            end if;
         end if;
      end loop;
   end Write_Text_Auto_Links;

   --  ------------------------------
   --  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
      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
            Formatter.Write_Text_Auto_Links (File, Text (Start .. Text'Last));
            return;
         end if;
         Formatter.Write_Text_Auto_Links (File, Text (Start .. Pos - 1));

         if Pos - 1 >= Text'First and then (Text (Pos - 1) = '\' or Text (Pos - 1) = '`') then
            Ada.Text_IO.Put (File, "[");
            Start := Pos + 1;

         --  Parse a markdown link format.
         elsif 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 =>
            if Formatter.Mode /= L_START_CODE then
               Formatter.Mode := L_TEXT;
            end if;
            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, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   use type Ada.Strings.Maps.Character_Set;

   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");

   Marker : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" .,;:!?)")
     or Ada.Strings.Maps.To_Set (ASCII.HT)
     or Ada.Strings.Maps.To_Set (ASCII.VT)
     or Ada.Strings.Maps.To_Set (ASCII.CR)
     or Ada.Strings.Maps.To_Set (ASCII.LF);

   --  ------------------------------
   --  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;

   procedure Write_Text_Auto_Links (Formatter : in out Document_Formatter;
                                    File      : in Ada.Text_IO.File_Type;
                                    Text      : in String) is
      Start : Natural := Text'First;
      Last  : Natural := Text'Last;
      Link  : Util.Strings.Maps.Cursor;
      Pos   : Natural;
   begin
      Log.Debug ("Auto link |{0}|", Text);
      loop
         --  Emit spaces at beginning of line or words.
         while Start <= Text'Last and then Ada.Strings.Maps.Is_In (Text (Start), Marker) loop
            Ada.Text_IO.Put (File, Text (Start));
            Start := Start + 1;
         end loop;
         exit when Start > Text'Last;

         --  Find a possible link.
         Link := Formatter.Links.Find (Text (Start .. Last));
         if Util.Strings.Maps.Has_Element (Link) then
            Ada.Text_IO.Put (File, "[");
            Ada.Text_IO.Put (File, Text (Start .. Last));
            Ada.Text_IO.Put (File, "](");
            Ada.Text_IO.Put (File, Util.Strings.Maps.Element (Link));
            Ada.Text_IO.Put (File, ")");
            Start := Last + 1;
            Last := Text'Last;
         else
            Pos := Ada.Strings.Fixed.Index (Text (Start .. Last), Marker,
                                            Going => Ada.Strings.Backward);
            if Pos = 0 then
               Ada.Text_IO.Put (File, Text (Start .. Last));
               Start := Last + 1;
               Last := Text'Last;
            else
               Last := Pos - 1;

               --  Skip spaces at end of words for the search.
               while Last > Start and then Ada.Strings.Maps.Is_In (Text (Last), Marker) loop
                  Last := Last - 1;
               end loop;
            end if;
         end if;
      end loop;
   end Write_Text_Auto_Links;

   --  ------------------------------
   --  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
      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
            Formatter.Write_Text_Auto_Links (File, Text (Start .. Text'Last));
            return;
         end if;
         Formatter.Write_Text_Auto_Links (File, Text (Start .. Pos - 1));

         if Pos - 1 >= Text'First and then (Text (Pos - 1) = '\' or Text (Pos - 1) = '`') then
            Ada.Text_IO.Put (File, "[");
            Start := Pos + 1;

         --  Parse a markdown link format.
         elsif 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 =>
            if Formatter.Mode /= L_START_CODE then
               Formatter.Mode := L_TEXT;
            end if;
            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;

Add ')' as final delimiter for auto-links


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

private package Gen.Artifacts.Docs.Markdown is

   --  Format documentation for Google Wiki syntax.
   type Document_Formatter is new Gen.Artifacts.Docs.Document_Formatter with record
      Need_Newline : Boolean := False;
   end record;

   --  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;

   --  Start a new document.
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type);

   --  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);

   --  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);

   --  Write a line in the document.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String);

end Gen.Artifacts.Docs.Markdown;

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

   --  Format documentation for GitHub Markdown syntax.
   type Document_Formatter is new Gen.Artifacts.Docs.Document_Formatter with record
      Need_Newline : Boolean := False;
      Mode         : Line_Kind := L_TEXT;
   end record;

   --  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;

   --  Start a new document.
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type);

   --  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);

   --  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);

   --  Write a line in the document.
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String);

   --  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);

end Gen.Artifacts.Docs.Markdown;

Declare the Write_Text procedure

Declare the Write_Text procedure


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

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Maps.Web.List_Templates;

package body Natools.Web.List_Templates is

   procedure Execute_Atom
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom);

   procedure Execute_Expression
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   ---------------------------
   -- Parameter Interpreter --
   ---------------------------

   procedure Execute_Expression
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);

      package Commands renames Natools.Static_Maps.Web.List_Templates;
      package Constructors renames Natools.S_Expressions.Atom_Ref_Constructors;

      use type S_Expressions.Events.Event;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            null;

         when Commands.Backward =>
            State.Going := Backward;

         when Commands.Ellipsis_Prefix =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               State.Ellipsis_Prefix
                 := Constructors.Create (Arguments.Current_Atom);
            end if;

         when Commands.Ellipsis_Suffix =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               State.Ellipsis_Suffix
                 := Constructors.Create (Arguments.Current_Atom);
            end if;

         when Commands.Forward =>
            State.Going := Forward;

         when Commands.Length_Limit =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               begin
                  State.Limit := Count'Value (S_Expressions.To_String
                                               (Arguments.Current_Atom));
               exception
                  when Constraint_Error =>
                     State.Limit := 0;
               end;
            end if;

         when Commands.Template =>
            State.Template := S_Expressions.Caches.Move (Arguments);
      end case;
   end Execute_Expression;

   procedure Execute_Atom
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);

      package Commands renames Natools.Static_Maps.Web.List_Templates;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            null;

         when Commands.Backward =>
            State.Going := Backward;

         when Commands.Ellipsis_Prefix =>
            State.Ellipsis_Prefix.Reset;

         when Commands.Ellipsis_Suffix =>
            State.Ellipsis_Suffix.Reset;

         when Commands.Forward =>
            State.Going := Forward;

         when Commands.Length_Limit =>
            State.Limit := 0;

         when Commands.Template =>
            null;
      end case;
   end Execute_Atom;

   procedure Read is new Natools.S_Expressions.Interpreter_Loop
     (Parameters, Meaningless_Type, Execute_Expression, Execute_Atom);

   procedure Read_Parameters
     (Object : in out Parameters;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Read (Expression, Object, Meaningless_Value);
   end Read_Parameters;

   function Read_Parameters
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Parameters
   is
      Result : Parameters;
   begin
      Read_Parameters (Result, Expression);
      return Result;
   end Read_Parameters;

   -----------------------
   -- Generic Rendering --
   -----------------------

   procedure Render
     (Exchange : in out Exchanges.Exchange;
      Iterator : in Iterators.Reversible_Iterator'Class;
      Param : in Parameters)
   is
      procedure Loop_Body
        (Position : in Iterators.Cursor; Exit_Loop : out Boolean);

      Rendered : Count := 0;

      procedure Loop_Body
        (Position : in Iterators.Cursor; Exit_Loop : out Boolean) is
      begin
         Exit_Loop := False;

         declare
            Template_Copy : S_Expressions.Caches.Cursor := Param.Template;
         begin
            Render (Exchange, Position, Template_Copy);
         end;

         Rendered := Rendered + 1;

         if Param.Limit > 0 and then Rendered > Param.Limit then
            if not Param.Ellipsis_Suffix.Is_Empty then
               Exchanges.Append
                 (Exchange,
                  Param.Ellipsis_Suffix.Query.Data.all);
            end if;

            Exit_Loop := True;
         end if;
      end Loop_Body;

      Exit_Loop : Boolean;
   begin
      if Param.Limit > 0 and then not Param.Ellipsis_Prefix.Is_Empty then
         declare
            Seen : Count := 0;
         begin
            for I in Iterator loop
               Seen := Seen + 1;
               exit when Seen > Param.Limit;
            end loop;

            if Seen > Param.Limit then
               Exchanges.Append
                 (Exchange,
                  Param.Ellipsis_Prefix.Query.Data.all);
            end if;
         end;
      end if;

      case Param.Going is
         when Forward =>
            for Position in Iterator loop
               Loop_Body (Position, Exit_Loop);
               exit when Exit_Loop;
            end loop;

         when Backward =>
            for Position in reverse Iterator loop
               Loop_Body (Position, Exit_Loop);
               exit when Exit_Loop;
            end loop;
      end case;
   end Render;

end Natools.Web.List_Templates;

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

with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.Static_Maps.Web.List_Templates;

package body Natools.Web.List_Templates is

   procedure Execute_Atom
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom);

   procedure Execute_Expression
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   ---------------------------
   -- Parameter Interpreter --
   ---------------------------

   procedure Execute_Expression
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);

      package Commands renames Natools.Static_Maps.Web.List_Templates;
      package Constructors renames Natools.S_Expressions.Atom_Ref_Constructors;

      use type S_Expressions.Events.Event;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            null;

         when Commands.Backward =>
            State.Going := Backward;

         when Commands.Ellipsis_Prefix =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               State.Ellipsis_Prefix
                 := Constructors.Create (Arguments.Current_Atom);
            end if;

         when Commands.Ellipsis_Suffix =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               State.Ellipsis_Suffix
                 := Constructors.Create (Arguments.Current_Atom);
            end if;

         when Commands.Forward =>
            State.Going := Forward;

         when Commands.Length_Limit =>
            if Arguments.Current_Event = S_Expressions.Events.Add_Atom then
               begin
                  State.Limit := Count'Value (S_Expressions.To_String
                                               (Arguments.Current_Atom));
               exception
                  when Constraint_Error =>
                     State.Limit := 0;
               end;
            end if;

         when Commands.Template =>
            State.Template := S_Expressions.Caches.Move (Arguments);
      end case;
   end Execute_Expression;

   procedure Execute_Atom
     (State : in out Parameters;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);

      package Commands renames Natools.Static_Maps.Web.List_Templates;
   begin
      case Commands.To_Command (S_Expressions.To_String (Name)) is
         when Commands.Unknown_Command =>
            null;

         when Commands.Backward =>
            State.Going := Backward;

         when Commands.Ellipsis_Prefix =>
            State.Ellipsis_Prefix.Reset;

         when Commands.Ellipsis_Suffix =>
            State.Ellipsis_Suffix.Reset;

         when Commands.Forward =>
            State.Going := Forward;

         when Commands.Length_Limit =>
            State.Limit := 0;

         when Commands.Template =>
            null;
      end case;
   end Execute_Atom;

   procedure Read is new Natools.S_Expressions.Interpreter_Loop
     (Parameters, Meaningless_Type, Execute_Expression, Execute_Atom);

   procedure Read_Parameters
     (Object : in out Parameters;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      Read (Expression, Object, Meaningless_Value);
   end Read_Parameters;

   function Read_Parameters
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Parameters
   is
      Result : Parameters;
   begin
      Read_Parameters (Result, Expression);
      return Result;
   end Read_Parameters;

   -----------------------
   -- Generic Rendering --
   -----------------------

   procedure Render
     (Exchange : in out Exchanges.Exchange;
      Iterator : in Iterators.Reversible_Iterator'Class;
      Param : in Parameters)
   is
      procedure Loop_Body
        (Position : in Iterators.Cursor; Exit_Loop : out Boolean);

      Rendered : Count := 0;

      procedure Loop_Body
        (Position : in Iterators.Cursor; Exit_Loop : out Boolean) is
      begin
         Exit_Loop := False;

         declare
            Template_Copy : S_Expressions.Caches.Cursor := Param.Template;
         begin
            Render (Exchange, Position, Template_Copy);
         end;

         Rendered := Rendered + 1;

         if Param.Limit > 0 and then Rendered >= Param.Limit then
            if not Param.Ellipsis_Suffix.Is_Empty then
               Exchanges.Append
                 (Exchange,
                  Param.Ellipsis_Suffix.Query.Data.all);
            end if;

            Exit_Loop := True;
         end if;
      end Loop_Body;

      Exit_Loop : Boolean;
   begin
      if Param.Limit > 0 and then not Param.Ellipsis_Prefix.Is_Empty then
         declare
            Seen : Count := 0;
         begin
            for I in Iterator loop
               Seen := Seen + 1;
               exit when Seen > Param.Limit;
            end loop;

            if Seen > Param.Limit then
               Exchanges.Append
                 (Exchange,
                  Param.Ellipsis_Prefix.Query.Data.all);
            end if;
         end;
      end if;

      case Param.Going is
         when Forward =>
            for Position in Iterator loop
               Loop_Body (Position, Exit_Loop);
               exit when Exit_Loop;
            end loop;

         when Backward =>
            for Position in reverse Iterator loop
               Loop_Body (Position, Exit_Loop);
               exit when Exit_Loop;
            end loop;
      end case;
   end Render;

end Natools.Web.List_Templates;

fix off-by-one error in list limits

list_templates: fix off-by-one error in list limits


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2022 onox <denkpadje@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.

private with Ada.Containers.Indefinite_Holders;

with Orka.Numerics.Tensors;

generic
   with package Tensors is new Orka.Numerics.Tensors (<>);
   type Tensor (<>) is new Tensors.Tensor with private;
package Orka.Numerics.Kalman is
   pragma Preelaborate;

   use type Tensors.Tensor_Shape;

   subtype Vector is Tensor;
   subtype Matrix is Tensor;

   type Update_Phase is (Time_Update, Measurement_Update);

   type Filter_Kind is (Filter_UKF, Filter_CDKF);

   type State_Covariance is private;

   type Weights_Type (N : Positive; Kind : Filter_Kind) is private;

   type Filter (Kind : Filter_Kind; Dimension_X, Dimension_Z : Positive) is tagged private;

   function State (Object : Filter) return Vector
     with Post => State'Result.Shape = (1 => Object.Dimension_X);

   procedure Set_State (Object : in out Filter; State : Vector)
     with Pre => State.Shape = (1 => Object.Dimension_X);

private

   subtype Element_Type is Tensors.Element_Type;

   package Tensor_Holders is new Ada.Containers.Indefinite_Holders (Tensor);

   --  These predicates cannot be applied to the formal types above
   subtype Vector_Holder is Tensor_Holders.Holder
     with Dynamic_Predicate => Vector_Holder.Element.Dimensions = 1;
   subtype Matrix_Holder is Tensor_Holders.Holder
     with Dynamic_Predicate => Matrix_Holder.Element.Dimensions = 2;

   type Weights_Type (N : Positive; Kind : Filter_Kind) is record
      Mean           : Vector_Holder;
      Scaling_Factor : Element_Type;
      case Kind is
         when Filter_UKF =>
            Covariance : Vector_Holder;
         when Filter_CDKF =>
            Covariance_1 : Element_Type;
            Covariance_2 : Element_Type;
      end case;
   end record;

   type State_Covariance is record
      State      : Vector_Holder;
      Covariance : Matrix_Holder;
   end record;

   type Filter (Kind : Filter_Kind; Dimension_X, Dimension_Z : Positive) is tagged record
      Process_Noise     : Matrix_Holder;
      Measurement_Noise : Matrix_Holder;

      Weights  : Weights_Type (Dimension_X, Kind);
      Estimate : State_Covariance;
   end record;

   function State (Object : Filter) return Vector is (Object.Estimate.State.Element);

end Orka.Numerics.Kalman;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2022 onox <denkpadje@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.

private with Ada.Containers.Indefinite_Holders;

with Orka.Numerics.Tensors;

generic
   with package Tensors is new Orka.Numerics.Tensors (<>);
   type Tensor (<>) is new Tensors.Tensor with private;
package Orka.Numerics.Kalman is
   pragma Preelaborate;

   use type Tensors.Tensor_Shape;

   subtype Vector is Tensor;
   subtype Matrix is Tensor;

   type Update_Phase is (Time_Update, Measurement_Update);

   type Filter_Kind is (Filter_UKF, Filter_CDKF);

   type State_Covariance is private;

   type Weights_Type (N : Positive; Kind : Filter_Kind) is private;

   type Filter (Kind : Filter_Kind; Dimension_X, Dimension_Z : Positive) is tagged private;

   function State (Object : Filter) return Vector
     with Post => State'Result.Shape = (1 => Object.Dimension_X);

   procedure Set_State (Object : in out Filter; State : Vector)
     with Pre => State.Shape = (1 => Object.Dimension_X);

private

   subtype Element_Type is Tensors.Element_Type;

   package Tensor_Holders is new Ada.Containers.Indefinite_Holders (Tensor);

   --  These predicates cannot be applied to the formal types above
   subtype Vector_Holder is Tensor_Holders.Holder;
   subtype Matrix_Holder is Tensor_Holders.Holder;

   type Weights_Type (N : Positive; Kind : Filter_Kind) is record
      Mean           : Vector_Holder;
      Scaling_Factor : Element_Type;
      case Kind is
         when Filter_UKF =>
            Covariance : Vector_Holder;
         when Filter_CDKF =>
            Covariance_1 : Element_Type;
            Covariance_2 : Element_Type;
      end case;
   end record;

   type State_Covariance is record
      State      : Vector_Holder;
      Covariance : Matrix_Holder;
   end record;

   type Filter (Kind : Filter_Kind; Dimension_X, Dimension_Z : Positive) is tagged record
      Process_Noise     : Matrix_Holder;
      Measurement_Noise : Matrix_Holder;

      Weights  : Weights_Type (Dimension_X, Kind);
      Estimate : State_Covariance;
   end record;

   function State (Object : Filter) return Vector is (Object.Estimate.State.Element);

end Orka.Numerics.Kalman;

numerics: Remove some Dynamic_Predicates to avoid bug box with GCC 12

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


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

package body Wiki.Nodes is

   --  ------------------------------
   --  Create a text node.
   --  ------------------------------
   function Create_Text (Text : in WString) return Node_Type_Access is
   begin
      return new Node_Type '(Kind => N_TEXT,
                             Len  => Text'Length,
                             Text => Text,
                             others => <>);
   end Create_Text;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access) is
   begin
      Append (Into.Nodes, Node);
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Into.Length);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

end Wiki.Nodes;

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

package body Wiki.Nodes is

   --  ------------------------------
   --  Create a text node.
   --  ------------------------------
   function Create_Text (Text : in WString) return Node_Type_Access is
   begin
      return new Node_Type '(Kind => N_TEXT,
                             Len  => Text'Length,
                             Text => Text,
                             others => <>);
   end Create_Text;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Add_Tag (Document   : in out Wiki.Nodes.Document;
                      Tag        : in Html_Tag_Type;
                      Attributes : in Wiki.Attributes.Attribute_List_Type) is
      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Document.Current);
   begin
      Append (Document.Nodes, Node);
      Document.Current := Node;
   end Add_Tag;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         if Into.Current.Children = null then
            Into.Current.Children := new Node_List;
         end if;
         Append (Into.Current.Children.all, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a node to the node list.
   --  ------------------------------
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access) is
      Block : Node_List_Block_Access := Into.Current;
   begin
      if Block.Last = Block.Max then
         Block.Next := new Node_List_Block (Into.Length);
         Block := Block.Next;
         Into.Current := Block;
      end if;
      Block.Last := Block.Last + 1;
      Block.List (Block.Last) := Node;
      Into.Length := Into.Length + 1;
   end Append;

end Wiki.Nodes;

Implement the Add_Tag procedure and update the Append procedure to take into account the node insertion in a HTML node