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

--  == Text Builders ==
--  The `Util.Texts.Builders` generic package was designed to provide string builders.
--  The interface was designed to reduce memory copies as much as possible.
--
--    * The `Builder` type holds a list of chunks into which texts are appended.
--    * The builder type holds an initial chunk whose capacity is defined when the builder
--      instance is declared.
--    * There is only an `Append` procedure which allows to append text to the builder.
--      This is the only time when a copy is made.
--    * The package defines the `Iterate` operation that allows to get the content
--      collected by the builder.  When using the `Iterate` operation, no copy is
--      performed since chunks data are passed passed by reference.
--    * The type is limited to forbid copies of the builder instance.
--
--  First, instantiate the package for the element type (eg, String):
--
--    package String_Builder is new Util.Texts.Builders (Character, String);
--
--  Declare the string builder instance with its initial capacity:
--
--    Builder : String_Builder.Builder (256);
--
--  And append to it:
--
--    String_Builder.Append (Builder, "Hello");
--
--  To get the content collected in the builder instance, write a procedure that receives
--  the chunk data as parameter:
--
--    procedure Collect (Item : in String) is ...
--
--  And use the `Iterate` operation:
--
--    String_Builder.Iterate (Builder, Collect'Access);
--
generic
   type Element_Type is (<>);
   type Input is array (Positive range <>) of Element_Type;
   Chunk_Size : Positive := 80;
package Util.Texts.Builders is

   pragma Preelaborate;

   type Builder (Len : Positive) is limited private;

   --  Get the length of the item builder.
   function Length (Source : in Builder) return Natural;

   --  Get the capacity of the builder.
   function Capacity (Source : in Builder) return Natural;

   --  Get the builder block size.
   function Block_Size (Source : in Builder) return Positive;

   --  Set the block size for the allocation of next chunks.
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Input);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type);

   --  Clear the source freeing any storage allocated for the buffer.
   procedure Clear (Source : in out Builder);

   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input));

   --  Get the buffer content as an array.
   function To_Array (Source : in Builder) return Input;

   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   function Tail (Source : in Builder;
                  Length : in Natural) return Input;

   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   generic
      with procedure Process (Content : in Input);
   procedure Get (Source : in Builder);

   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   generic
      type Value is limited private;
      type Value_List is array (Positive range <>) of Value;
      with procedure Append (Input : in out Builder; Item : in Value);
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List);

private

   pragma Inline (Length);
   pragma Inline (Iterate);

   type Block;
   type Block_Access is access all Block;

   type Block (Len : Positive) is limited record
      Next_Block : Block_Access;
      Last       : Natural := 0;
      Content    : Input (1 .. Len);
   end record;

   type Builder (Len : Positive) is new Ada.Finalization.Limited_Controlled with record
      Current    : Block_Access;
      Block_Size : Positive := Chunk_Size;
      Length     : Natural  := 0;
      First      : aliased Block (Len);
   end record;
   pragma Finalize_Storage_Only (Builder);

   --  Setup the builder.
   overriding
   procedure Initialize (Source : in out Builder);

   --  Finalize the builder releasing the storage.
   overriding
   procedure Finalize (Source : in out Builder);

end Util.Texts.Builders;

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

--  == Text Builders ==
--  The `Util.Texts.Builders` generic package was designed to provide string builders.
--  The interface was designed to reduce memory copies as much as possible.
--
--    * The `Builder` type holds a list of chunks into which texts are appended.
--    * The builder type holds an initial chunk whose capacity is defined when the builder
--      instance is declared.
--    * There is only an `Append` procedure which allows to append text to the builder.
--      This is the only time when a copy is made.
--    * The package defines the `Iterate` operation that allows to get the content
--      collected by the builder.  When using the `Iterate` operation, no copy is
--      performed since chunks data are passed passed by reference.
--    * The type is limited to forbid copies of the builder instance.
--
--  First, instantiate the package for the element type (eg, String):
--
--    package String_Builder is new Util.Texts.Builders (Character, String);
--
--  Declare the string builder instance with its initial capacity:
--
--    Builder : String_Builder.Builder (256);
--
--  And append to it:
--
--    String_Builder.Append (Builder, "Hello");
--
--  To get the content collected in the builder instance, write a procedure that receives
--  the chunk data as parameter:
--
--    procedure Collect (Item : in String) is ...
--
--  And use the `Iterate` operation:
--
--    String_Builder.Iterate (Builder, Collect'Access);
--
generic
   type Element_Type is (<>);
   type Input is array (Positive range <>) of Element_Type;
   Chunk_Size : Positive := 80;
package Util.Texts.Builders is

   pragma Preelaborate;

   type Builder (Len : Positive) is limited private;

   --  Get the length of the item builder.
   function Length (Source : in Builder) return Natural;

   --  Get the capacity of the builder.
   function Capacity (Source : in Builder) return Natural;

   --  Get the builder block size.
   function Block_Size (Source : in Builder) return Positive;

   --  Set the block size for the allocation of next chunks.
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Input);

   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   procedure Append (Source   : in out Builder;
                     New_Item : in Element_Type);

   --  Clear the source freeing any storage allocated for the buffer.
   procedure Clear (Source : in out Builder);

   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input));

   generic
      with procedure Process (Content : in Input);
   procedure Inline_Iterate (Source  : in Builder);

   --  Get the buffer content as an array.
   function To_Array (Source : in Builder) return Input;

   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   function Tail (Source : in Builder;
                  Length : in Natural) return Input;

   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   generic
      with procedure Process (Content : in Input);
   procedure Get (Source : in Builder);

   --  Format the message and replace occurrences of argument patterns by
   --  their associated value.
   --  Returns the formatted message in the stream
   generic
      type Value is limited private;
      type Value_List is array (Positive range <>) of Value;
      with procedure Append (Input : in out Builder; Item : in Value);
   procedure Format (Into      : in out Builder;
                     Message   : in Input;
                     Arguments : in Value_List);

private

   pragma Inline (Length);
   pragma Inline (Iterate);

   type Block;
   type Block_Access is access all Block;

   type Block (Len : Positive) is limited record
      Next_Block : Block_Access;
      Last       : Natural := 0;
      Content    : Input (1 .. Len);
   end record;

   type Builder (Len : Positive) is new Ada.Finalization.Limited_Controlled with record
      Current    : Block_Access;
      Block_Size : Positive := Chunk_Size;
      Length     : Natural  := 0;
      First      : aliased Block (Len);
   end record;
   pragma Finalize_Storage_Only (Builder);

   --  Setup the builder.
   overriding
   procedure Initialize (Source : in out Builder);

   --  Finalize the builder releasing the storage.
   overriding
   procedure Finalize (Source : in out Builder);

end Util.Texts.Builders;

Add an Inline_Iterate generic procedure to access the builder using inline and without buffer copy


-----------------------------------------------------------------------
--  awa-counters --
--  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.
-----------------------------------------------------------------------
with ADO.Objects;
with ADO.Schemas;
with Util.Strings;
with AWA.Index_Arrays;
package AWA.Counters is

   type Counter_Index_Type is new Natural;

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class);

   --  Increment the global counter identified by <tt>Counter</tt>.
   procedure Increment (Counter : in Counter_Index_Type);

private

   type Counter_Def is record
      Table : ADO.Schemas.Class_Mapping_Access;
      Field : Util.Strings.Name_Access;
   end record;

   function "=" (Left, Right : in Counter_Def) return Boolean;
   function "<" (Left, Right : in Counter_Def) return Boolean;
   function "&" (Left  : in String;
                 Right : in Counter_Def) return String;

   package Counter_Arrays is new AWA.Index_Arrays (Counter_Index_Type, Counter_Def);

end AWA.Counters;

-----------------------------------------------------------------------
--  awa-counters --
--  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.
-----------------------------------------------------------------------
with ADO.Objects;
with ADO.Schemas;
with Util.Strings;
with AWA.Index_Arrays;
package AWA.Counters is

   type Counter_Index_Type is new Natural;

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class);

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object key <tt>Key</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Key     : in ADO.Objects.Object_Key);

   --  Increment the global counter identified by <tt>Counter</tt>.
   procedure Increment (Counter : in Counter_Index_Type);

private

   type Counter_Def is record
      Table : ADO.Schemas.Class_Mapping_Access;
      Field : Util.Strings.Name_Access;
   end record;

   function "=" (Left, Right : in Counter_Def) return Boolean;
   function "<" (Left, Right : in Counter_Def) return Boolean;
   function "&" (Left  : in String;
                 Right : in Counter_Def) return String;

   package Counter_Arrays is new AWA.Index_Arrays (Counter_Index_Type, Counter_Def);

end AWA.Counters;

Declare the Increment procedure with the Object_Key type


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

package body Natools.S_Expressions.File_Readers is

   package Stream_IO renames Ada.Streams.Stream_IO;

   overriding procedure Finalize (Object : in out Autoclose) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;
   end Finalize;

   -------------------------
   -- S-Expression Reader --
   -------------------------

   function Reader (Name : String) return S_Reader is
   begin
      return Object : S_Reader do
         Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name);
         Object.Next;
      end return;
   end Reader;

   procedure Set_Filename (Object : in out S_Reader; Name : in String) is
   begin
      if Stream_IO.Is_Open (Object.Holder.File) then
         Stream_IO.Close (Object.Holder.File);
      end if;

      Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name);
      Object.Rewind;
   end Set_Filename;

   procedure Rewind (Object : in out S_Reader) is
   begin
      Stream_IO.Set_Index (Object.Holder.File, 1);
      Object.Next;
   end Rewind;

   overriding procedure Read_More
     (Object : in out S_Reader;
      Buffer : out Atom_Buffers.Atom_Buffer)
   is
      Data : Ada.Streams.Stream_Element_Array (0 .. 127);
      Last : Ada.Streams.Stream_Element_Offset;
   begin
      Stream_IO.Read (Object.Holder.File, Data, Last);

      if Last in Data'Range then
         Buffer.Append (Data (Data'First .. Last));
      end if;
   end Read_More;

   -----------------
   -- Atom Reader --
   -----------------

   function Reader (Name : String) return Atom_Reader is
   begin
      return Object : Atom_Reader do
         Stream_IO.Open (Object.File, Stream_IO.In_File, Name);
      end return;
   end Reader;

   procedure Set_Filename (Object : in out Atom_Reader; Name : in String) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;

      Stream_IO.Open (Object.File, Stream_IO.In_File, Name);
   end Set_Filename;

   function Length (Object : Atom_Reader) return Count is
   begin
      return Count (Stream_IO.Size (Object.File));
   end Length;

   function Read (Object : Atom_Reader) return Atom is
      Result : Atom (1 .. Object.Length);
      Last : Count;
   begin
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Result, Last);
      pragma Assert (Last = Result'Last);
      return Result;
   end Read;

   procedure Read
     (Object : in Atom_Reader;
      Data : out Atom;
      Length : out Count) is
   begin
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Data, Length);
      Length := Object.Length;
   end Read;

   procedure Read
     (Object : in Atom_Reader;
      Buffer : out Atom_Buffers.Atom_Buffer;
      Block_Size : in Count := 1024)
   is
      Block : Atom (1 .. Block_Size);
      Last : Count;
   begin
      Buffer.Soft_Reset;
      Stream_IO.Set_Index (Object.File, 1);
      loop
         Stream_IO.Read (Object.File, Block, Last);
         exit when Last not in Block'Range;
         Buffer.Append (Block (Block'First .. Last));
      end loop;
   end Read;

   procedure Query
     (Object : in Atom_Reader;
      Process : not null access procedure (Data : in Atom))
   is
      Buffer : Atom_Access := null;
      Last : Count;
   begin
      Buffer := new Atom (1 .. Object.Length);
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Buffer.all, Last);
      pragma Assert (Last = Buffer'Last);
      Process (Buffer.all);
      Unchecked_Deallocation (Buffer);
   exception
      when others =>
         Unchecked_Deallocation (Buffer);
         raise;
   end Query;

   procedure Block_Query
     (Object : in Atom_Reader;
      Block_Size : in Count;
      Process : not null access procedure (Block : in Atom))
   is
      Block : Atom (1 .. Block_Size);
      Last : Count;
   begin
      Stream_IO.Set_Index (Object.File, 1);
      loop
         Stream_IO.Read (Object.File, Block, Last);
         exit when Last not in Block'Range;
         Process.all (Block (Block'First .. Last));
      end loop;
   end Block_Query;

   overriding procedure Finalize (Object : in out Atom_Reader) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;
   end Finalize;

end Natools.S_Expressions.File_Readers;

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

package body Natools.S_Expressions.File_Readers is

   package Stream_IO renames Ada.Streams.Stream_IO;

   overriding procedure Finalize (Object : in out Autoclose) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;
   end Finalize;

   -------------------------
   -- S-Expression Reader --
   -------------------------

   function Reader (Name : String) return S_Reader is
   begin
      return Object : S_Reader do
         Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name);
         Object.Next;
      end return;
   end Reader;

   procedure Set_Filename (Object : in out S_Reader; Name : in String) is
   begin
      if Stream_IO.Is_Open (Object.Holder.File) then
         Stream_IO.Close (Object.Holder.File);
      end if;

      Stream_IO.Open (Object.Holder.File, Stream_IO.In_File, Name);
      Object.Rewind;
   end Set_Filename;

   procedure Rewind (Object : in out S_Reader) is
   begin
      Stream_IO.Set_Index (Object.Holder.File, 1);
      Object.Reset;
      Object.Next;
   end Rewind;

   overriding procedure Read_More
     (Object : in out S_Reader;
      Buffer : out Atom_Buffers.Atom_Buffer)
   is
      Data : Ada.Streams.Stream_Element_Array (0 .. 127);
      Last : Ada.Streams.Stream_Element_Offset;
   begin
      Stream_IO.Read (Object.Holder.File, Data, Last);

      if Last in Data'Range then
         Buffer.Append (Data (Data'First .. Last));
      end if;
   end Read_More;

   -----------------
   -- Atom Reader --
   -----------------

   function Reader (Name : String) return Atom_Reader is
   begin
      return Object : Atom_Reader do
         Stream_IO.Open (Object.File, Stream_IO.In_File, Name);
      end return;
   end Reader;

   procedure Set_Filename (Object : in out Atom_Reader; Name : in String) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;

      Stream_IO.Open (Object.File, Stream_IO.In_File, Name);
   end Set_Filename;

   function Length (Object : Atom_Reader) return Count is
   begin
      return Count (Stream_IO.Size (Object.File));
   end Length;

   function Read (Object : Atom_Reader) return Atom is
      Result : Atom (1 .. Object.Length);
      Last : Count;
   begin
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Result, Last);
      pragma Assert (Last = Result'Last);
      return Result;
   end Read;

   procedure Read
     (Object : in Atom_Reader;
      Data : out Atom;
      Length : out Count) is
   begin
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Data, Length);
      Length := Object.Length;
   end Read;

   procedure Read
     (Object : in Atom_Reader;
      Buffer : out Atom_Buffers.Atom_Buffer;
      Block_Size : in Count := 1024)
   is
      Block : Atom (1 .. Block_Size);
      Last : Count;
   begin
      Buffer.Soft_Reset;
      Stream_IO.Set_Index (Object.File, 1);
      loop
         Stream_IO.Read (Object.File, Block, Last);
         exit when Last not in Block'Range;
         Buffer.Append (Block (Block'First .. Last));
      end loop;
   end Read;

   procedure Query
     (Object : in Atom_Reader;
      Process : not null access procedure (Data : in Atom))
   is
      Buffer : Atom_Access := null;
      Last : Count;
   begin
      Buffer := new Atom (1 .. Object.Length);
      Stream_IO.Set_Index (Object.File, 1);
      Stream_IO.Read (Object.File, Buffer.all, Last);
      pragma Assert (Last = Buffer'Last);
      Process (Buffer.all);
      Unchecked_Deallocation (Buffer);
   exception
      when others =>
         Unchecked_Deallocation (Buffer);
         raise;
   end Query;

   procedure Block_Query
     (Object : in Atom_Reader;
      Block_Size : in Count;
      Process : not null access procedure (Block : in Atom))
   is
      Block : Atom (1 .. Block_Size);
      Last : Count;
   begin
      Stream_IO.Set_Index (Object.File, 1);
      loop
         Stream_IO.Read (Object.File, Block, Last);
         exit when Last not in Block'Range;
         Process.all (Block (Block'First .. Last));
      end loop;
   end Block_Query;

   overriding procedure Finalize (Object : in out Atom_Reader) is
   begin
      if Stream_IO.Is_Open (Object.File) then
         Stream_IO.Close (Object.File);
      end if;
   end Finalize;

end Natools.S_Expressions.File_Readers;

reset parser state in Rewind

s_expressions-file_readers: reset parser state in Rewind


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

with Util.Tests;

package Util.Serialize.IO.JSON.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Parse_Error (T : in out Test);

   procedure Test_Parser (T : in out Test);

   --  Generate some output stream for the test.
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class);

   --  Test the JSON output stream generation.
   procedure Test_Output (T : in out Test);

   --  Test reading a JSON content into an Object tree.
   procedure Test_Read (T : in out Test);

end Util.Serialize.IO.JSON.Tests;

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

with Util.Tests;

package Util.Serialize.IO.JSON.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Parse_Error (T : in out Test);

   procedure Test_Parser (T : in out Test);

   --  Generate some output stream for the test.
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class);

   --  Test the JSON output stream generation.
   procedure Test_Output (T : in out Test);

   --  Test the JSON output stream generation (simple JSON documents).
   procedure Test_Simple_Output (T : in out Test);

   --  Test reading a JSON content into an Object tree.
   procedure Test_Read (T : in out Test);

end Util.Serialize.IO.JSON.Tests;

Declare the Test_Simple_Output procedure


-----------------------------------------------------------------------
--  gen-artifacts-distribs-merges -- Web file merge
--  Copyright (C) 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.Directories;
with Ada.Strings.Fixed;
with Ada.Streams.Stream_IO;
with Ada.Exceptions;
with Ada.IO_Exceptions;

with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Files;
with Util.Strings;
with Util.Streams.Files;
with Util.Streams.Texts;

with EL.Expressions;

with Gen.Utils;
package body Gen.Artifacts.Distribs.Merges is

   use Util.Log;
   use Ada.Strings.Fixed;
   use Util.Beans.Objects;
   use Ada.Strings.Unbounded;

   procedure Process_Property (Rule : in out Merge_Rule;
                               Node : in DOM.Core.Node);

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Distribs.Merges");

   --  ------------------------------
   --  Extract the <property name='{name}'>{value}</property> to setup the
   --  EL context to evaluate the source and target links for the merge.
   --  ------------------------------
   procedure Process_Property (Rule : in out Merge_Rule;
                               Node : in DOM.Core.Node) is
      use Util.Beans.Objects.Maps;

      Name  : constant String := Gen.Utils.Get_Attribute (Node, "name");
      Value : constant String := Gen.Utils.Get_Data_Content (Node);
      Pos   : constant Natural := Util.Strings.Index (Name, '.');
   begin
      if Pos = 0 then
         Rule.Variables.Bind (Name, To_Object (Value));
         return;
      end if;

      --  A composed name such as 'jquery.path' must be split so that we store
      --  the 'path' value within a 'jquery' Map_Bean object.  We handle only
      --  one such composition.
      declare
         Param : constant String := Name (Name'First .. Pos - 1);
         Tag   : constant Unbounded_String := To_Unbounded_String (Param);
         Var   : constant EL.Expressions.Expression := Rule.Variables.Get_Variable (Tag);
         Val   : Object := Rule.Params.Get_Value (Param);
         Child : Map_Bean_Access;
      begin
         if Is_Null (Val) then
            Child := new Map_Bean;
            Val := To_Object (Child);
            Rule.Params.Set_Value (Param, Val);
         else
            Child := To_Bean (Val);
         end if;
         Child.Set_Value (Name (Pos + 1 .. Name'Last), To_Object (Value));
         if Var.Is_Null then
            Rule.Variables.Bind (Param, Val);
         end if;
      end;
   end Process_Property;

   procedure Iterate_Properties is
      new Gen.Utils.Iterate_Nodes (Merge_Rule, Process_Property);

   --  ------------------------------
   --  Create a distribution rule to copy a set of files or directories.
   --  ------------------------------
   function Create_Rule (Node : in DOM.Core.Node) return Distrib_Rule_Access is
      Result : constant Merge_Rule_Access := new Merge_Rule;
   begin
      Iterate_Properties (Result.all, Node, "property", False);
      Result.Context.Set_Variable_Mapper (Result.Variables'Access);
      return Result.all'Access;
   end Create_Rule;

   --  ------------------------------
   --  Get a name to qualify the installation rule (used for logs).
   --  ------------------------------
   overriding
   function Get_Install_Name (Rule : in Merge_Rule) return String is
      pragma Unreferenced (Rule);
   begin
      return "merge";
   end Get_Install_Name;

   overriding
   procedure Install (Rule    : in Merge_Rule;
                      Path    : in String;
                      Files   : in File_Vector;
                      Context : in out Generator'Class) is

      type Mode_Type is (MERGE_NONE, MERGE_LINK, MERGE_SCRIPT);

      procedure Error (Message : in String);
      function Get_Target_Path (Link : in String) return String;
      function Get_Filename (Line : in String) return String;
      function Get_Source (Line : in String;
                           Tag  : in String) return String;
      procedure Prepare_Merge (Line : in String);
      procedure Include (Source : in String);
      procedure Process (Line : in String);

      Root_Dir : constant String :=
        Util.Files.Compose (Context.Get_Result_Directory,
                            To_String (Rule.Dir));
      Source   : constant String := Get_Source_Path (Files, False);
      Dir      : constant String := Ada.Directories.Containing_Directory (Path);
      Output   : aliased Util.Streams.Files.File_Stream;
      Merge    : aliased Util.Streams.Files.File_Stream;
      Text     : Util.Streams.Texts.Print_Stream;
      Mode     : Mode_Type := MERGE_NONE;
      Line_Num : Natural := 0;

      procedure Error (Message : in String) is
         Line : constant String := Util.Strings.Image (Line_Num);
      begin
         Context.Error (Source & ":" & Line & ": " & Message);
      end Error;

      function Get_Target_Path (Link : in String) return String is
         Expr : EL.Expressions.Expression;
         File : Util.Beans.Objects.Object;
      begin
         Expr := EL.Expressions.Create_Expression (Link, Rule.Context);
         File := Expr.Get_Value (Rule.Context);
         return Util.Files.Compose (Root_Dir, To_String (File));
      end Get_Target_Path;

      function Get_Filename (Line : in String) return String is
         Pos  : Natural := Index (Line, "link=");
         Last : Natural;
      begin
         if Pos > 0 then
            Mode := MERGE_LINK;
         else
            Pos := Index (Line, "script=");
            if Pos > 0 then
               Mode := MERGE_SCRIPT;
            end if;
            if Pos = 0 then
               return "";
            end if;
         end if;
         Pos := Index (Line, "=");

         Last := Util.Strings.Index (Line, ' ', Pos + 1);
         if Last = 0 then
            return "";
         end if;
         return Line (Pos + 1 .. Last - 1);
      end Get_Filename;

      function Get_Source (Line : in String;
                           Tag  : in String) return String is
         Pos  : Natural := Index (Line, Tag);
         Last : Natural;
      begin
         if Pos = 0 then
            return "";
         end if;
         Pos := Pos + Tag'Length;
         if Pos > Line'Last or else (Line (Pos) /= '"' and Line (Pos) /= ''') then
            return "";
         end if;
         Last := Util.Strings.Index (Line, Line (Pos), Pos + 1);
         if Last = 0 then
            return "";
         end if;
         return Line (Pos + 1 .. Last - 1);
      end Get_Source;

      procedure Prepare_Merge (Line : in String) is
         Name : constant String := Get_Filename (Line);
         Path : constant String := Get_Target_Path (Name);
      begin
         if Name'Length = 0 then
            Error ("invalid file name");
            return;
         end if;
         case Mode is
            when MERGE_LINK =>
               Text.Write ("<link media='screen' type='text/css' rel='stylesheet'"
                           & " href='");
               Text.Write (Name);
               Text.Write ("'/>" & ASCII.LF);

            when MERGE_SCRIPT =>
               Text.Write ("<script type='text/javascript' src='");
               Text.Write (Name);
               Text.Write ("'></script>" & ASCII.LF);

            when MERGE_NONE =>
               null;

         end case;
         if Rule.Level >= Util.Log.INFO_LEVEL then
            Log.Info ("  create {0}", Path);
         end if;
         Merge.Create (Mode => Ada.Streams.Stream_IO.Out_File,
                       Name => Path);
      end Prepare_Merge;

      procedure Include (Source : in String) is
         Target : constant String := Get_Target_Path (Source);
         Input  : Util.Streams.Files.File_Stream;
      begin
         if Rule.Level >= Util.Log.INFO_LEVEL then
            Log.Info ("    include {0}", Target);
         end if;

         Input.Open (Name => Target, Mode => Ada.Streams.Stream_IO.In_File);
         Util.Streams.Copy (From => Input, Into => Merge);
         Input.Close;

      exception
         when Ex : Ada.IO_Exceptions.Name_Error =>
            Error ("Cannot read: " & Ada.Exceptions.Exception_Message (Ex));
      end Include;

      procedure Process (Line : in String) is
         Pos : Natural;
      begin
         Line_Num := Line_Num + 1;
         case Mode is
            when MERGE_NONE =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-START ");
               if Pos = 0 then
                  Text.Write (Line);
                  Text.Write (ASCII.LF);
                  return;
               end if;
               Text.Write (Line (Line'First .. Pos - 1));
               Prepare_Merge (Line (Pos + 10 .. Line'Last));

            when MERGE_LINK =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-END ");
               if Pos > 0 then
                  Merge.Close;
                  Mode := MERGE_NONE;
                  return;
               end if;
               Include (Get_Source (Line, "href="));

            when MERGE_SCRIPT =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-END ");
               if Pos > 0 then
                  Merge.Close;
                  Mode := MERGE_NONE;
                  return;
               end if;
               Text.Write (Line (Line'First .. Pos - 1));
               Include (Get_Source (Line, "src="));

         end case;
      end Process;

   begin
      if Rule.Level >= Util.Log.INFO_LEVEL then
         Log.Info ("webmerge {0}", Path);
      end if;

      Ada.Directories.Create_Path (Dir);
      Output.Create (Name => Path, Mode => Ada.Streams.Stream_IO.Out_File);
      Text.Initialize (Output'Unchecked_Access, 16 * 1024);
      Util.Files.Read_File (Source, Process'Access);
      Text.Flush;
      Output.Close;
   end Install;

end Gen.Artifacts.Distribs.Merges;

-----------------------------------------------------------------------
--  gen-artifacts-distribs-merges -- Web file merge
--  Copyright (C) 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.Directories;
with Ada.Strings.Fixed;
with Ada.Streams.Stream_IO;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;

with Util.Beans.Objects;
with Util.Log.Loggers;
with Util.Files;
with Util.Strings;
with Util.Streams.Files;
with Util.Streams.Texts;
with Util.Streams.Buffered;

with EL.Expressions;

with Gen.Utils;
package body Gen.Artifacts.Distribs.Merges is

   use Util.Log;
   use Ada.Strings.Fixed;
   use Util.Beans.Objects;
   use Ada.Strings.Unbounded;

   procedure Process_Property (Rule : in out Merge_Rule;
                               Node : in DOM.Core.Node);

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Artifacts.Distribs.Merges");

   --  ------------------------------
   --  Extract the <property name='{name}'>{value}</property> to setup the
   --  EL context to evaluate the source and target links for the merge.
   --  ------------------------------
   procedure Process_Property (Rule : in out Merge_Rule;
                               Node : in DOM.Core.Node) is
      use Util.Beans.Objects.Maps;

      Name  : constant String := Gen.Utils.Get_Attribute (Node, "name");
      Value : constant String := Gen.Utils.Get_Data_Content (Node);
      Pos   : constant Natural := Util.Strings.Index (Name, '.');
   begin
      if Pos = 0 then
         Rule.Variables.Bind (Name, To_Object (Value));
         return;
      end if;

      --  A composed name such as 'jquery.path' must be split so that we store
      --  the 'path' value within a 'jquery' Map_Bean object.  We handle only
      --  one such composition.
      declare
         Param : constant String := Name (Name'First .. Pos - 1);
         Tag   : constant Unbounded_String := To_Unbounded_String (Param);
         Var   : constant EL.Expressions.Expression := Rule.Variables.Get_Variable (Tag);
         Val   : Object := Rule.Params.Get_Value (Param);
         Child : Map_Bean_Access;
      begin
         if Is_Null (Val) then
            Child := new Map_Bean;
            Val := To_Object (Child);
            Rule.Params.Set_Value (Param, Val);
         else
            Child := To_Bean (Val);
         end if;
         Child.Set_Value (Name (Pos + 1 .. Name'Last), To_Object (Value));
         if Var.Is_Null then
            Rule.Variables.Bind (Param, Val);
         end if;
      end;
   end Process_Property;

   procedure Process_Replace (Rule : in out Merge_Rule;
                              Node : in DOM.Core.Node) is
      From : constant String := Gen.Utils.Get_Data_Content (Node, "from");
      To   : constant String := Gen.Utils.Get_Data_Content (Node, "to");
   begin
      Rule.Replace.Include (From, To);
   end Process_Replace;

   procedure Iterate_Properties is
      new Gen.Utils.Iterate_Nodes (Merge_Rule, Process_Property);

   procedure Iterate_Replace is
      new Gen.Utils.Iterate_Nodes (Merge_Rule, Process_Replace);

   --  ------------------------------
   --  Create a distribution rule to copy a set of files or directories.
   --  ------------------------------
   function Create_Rule (Node : in DOM.Core.Node) return Distrib_Rule_Access is
      Result : constant Merge_Rule_Access := new Merge_Rule;
   begin
      Iterate_Properties (Result.all, Node, "property", False);
      Iterate_Replace (Result.all, Node, "replace", False);
      Result.Context.Set_Variable_Mapper (Result.Variables'Access);
      return Result.all'Access;
   end Create_Rule;

   --  ------------------------------
   --  Get a name to qualify the installation rule (used for logs).
   --  ------------------------------
   overriding
   function Get_Install_Name (Rule : in Merge_Rule) return String is
      pragma Unreferenced (Rule);
   begin
      return "merge";
   end Get_Install_Name;

   overriding
   procedure Install (Rule    : in Merge_Rule;
                      Path    : in String;
                      Files   : in File_Vector;
                      Context : in out Generator'Class) is

      use Ada.Streams;

      type Mode_Type is (MERGE_NONE, MERGE_LINK, MERGE_SCRIPT);

      procedure Error (Message : in String);
      function Get_Target_Path (Link : in String) return String;
      function Get_Filename (Line : in String) return String;
      function Get_Source (Line : in String;
                           Tag  : in String) return String;
      procedure Prepare_Merge (Line : in String);
      procedure Include (Source : in String);
      procedure Process (Line : in String);

      Root_Dir : constant String :=
        Util.Files.Compose (Context.Get_Result_Directory,
                            To_String (Rule.Dir));
      Source   : constant String := Get_Source_Path (Files, False);
      Dir      : constant String := Ada.Directories.Containing_Directory (Path);
      Output   : aliased Util.Streams.Files.File_Stream;
      Merge    : aliased Util.Streams.Files.File_Stream;
      Text     : Util.Streams.Texts.Print_Stream;
      Mode     : Mode_Type := MERGE_NONE;
      Line_Num : Natural := 0;

      procedure Error (Message : in String) is
         Line : constant String := Util.Strings.Image (Line_Num);
      begin
         Context.Error (Source & ":" & Line & ": " & Message);
      end Error;

      function Get_Target_Path (Link : in String) return String is
         Expr : EL.Expressions.Expression;
         File : Util.Beans.Objects.Object;
      begin
         Expr := EL.Expressions.Create_Expression (Link, Rule.Context);
         File := Expr.Get_Value (Rule.Context);
         return Util.Files.Compose (Root_Dir, To_String (File));
      end Get_Target_Path;

      function Get_Filename (Line : in String) return String is
         Pos  : Natural := Index (Line, "link=");
         Last : Natural;
      begin
         if Pos > 0 then
            Mode := MERGE_LINK;
         else
            Pos := Index (Line, "script=");
            if Pos > 0 then
               Mode := MERGE_SCRIPT;
            end if;
            if Pos = 0 then
               return "";
            end if;
         end if;
         Pos := Index (Line, "=");

         Last := Util.Strings.Index (Line, ' ', Pos + 1);
         if Last = 0 then
            return "";
         end if;
         return Line (Pos + 1 .. Last - 1);
      end Get_Filename;

      function Get_Source (Line : in String;
                           Tag  : in String) return String is
         Pos  : Natural := Index (Line, Tag);
         Last : Natural;
      begin
         if Pos = 0 then
            return "";
         end if;
         Pos := Pos + Tag'Length;
         if Pos > Line'Last or else (Line (Pos) /= '"' and Line (Pos) /= ''') then
            return "";
         end if;
         Last := Util.Strings.Index (Line, Line (Pos), Pos + 1);
         if Last = 0 then
            return "";
         end if;
         return Line (Pos + 1 .. Last - 1);
      end Get_Source;

      procedure Prepare_Merge (Line : in String) is
         Name : constant String := Get_Filename (Line);
         Path : constant String := Get_Target_Path (Name);
      begin
         if Name'Length = 0 then
            Error ("invalid file name");
            return;
         end if;
         case Mode is
            when MERGE_LINK =>
               Text.Write ("<link media='screen' type='text/css' rel='stylesheet'"
                           & " href='");
               Text.Write (Name);
               Text.Write ("'/>" & ASCII.LF);

            when MERGE_SCRIPT =>
               Text.Write ("<script type='text/javascript' src='");
               Text.Write (Name);
               Text.Write ("'></script>" & ASCII.LF);

            when MERGE_NONE =>
               null;

         end case;
         if Rule.Level >= Util.Log.INFO_LEVEL then
            Log.Info ("  create {0}", Path);
         end if;
         Merge.Create (Mode => Ada.Streams.Stream_IO.Out_File,
                       Name => Path);
      end Prepare_Merge;

      Current_Match : Util.Strings.Maps.Cursor;

      function Find_Match (Buffer : in Stream_Element_Array) return Stream_Element_Offset is
         Iter  : Util.Strings.Maps.Cursor := Rule.Replace.First;
         First : Stream_Element_Offset := Buffer'Last + 1;
      begin
         while Util.Strings.Maps.Has_Element (Iter) loop
            declare
               Value : constant String := Util.Strings.Maps.Key (Iter);
               Match : Stream_Element_Array (1 .. Value'Length);
               for Match'Address use Value'Address;
               Pos   : Stream_Element_Offset;
            begin
               Pos := Buffer'First;
               while Pos + Match'Length < Buffer'Last loop
                  if Buffer (Pos .. Pos + Match'Length - 1) = Match then
                     if First > Pos then
                        First := Pos;
                        Current_Match := Iter;
                     end if;
                     exit;
                  end if;
                  Pos := Pos + 1;
               end loop;
            end;
            Util.Strings.Maps.Next (Iter);
         end loop;
         return First;
      end Find_Match;

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Ada.Streams.Stream_Element_Array,
                                        Name   => Util.Streams.Buffered.Buffer_Access);

      procedure Include (Source : in String) is
         Target : constant String := Get_Target_Path (Source);
         Input  : Util.Streams.Files.File_Stream;
         Size   : Stream_Element_Offset;
         Last   : Stream_Element_Offset;
         Pos    : Stream_Element_Offset;
         Next   : Stream_Element_Offset;
         Buffer : Util.Streams.Buffered.Buffer_Access;
      begin
         if Rule.Level >= Util.Log.INFO_LEVEL then
            Log.Info ("    include {0}", Target);
         end if;

         Input.Open (Name => Target, Mode => Ada.Streams.Stream_IO.In_File);

         Size := Stream_Element_Offset (Ada.Directories.Size (Target));
         Buffer := new Stream_Element_Array (1 .. Size);
         Input.Read (Buffer.all, Last);
         Input.Close;

         Pos := 1;
         while Pos < Last loop
            Next := Find_Match (Buffer (Pos .. Last));
            if Next > Pos then
               Merge.Write (Buffer (Pos .. Next - 1));
            end if;
            exit when Next >= Last;
            declare
               Value   : constant String := Util.Strings.Maps.Key (Current_Match);
               Replace : constant String := Util.Strings.Maps.Element (Current_Match);
               Content : Stream_Element_Array (1 .. Replace'Length);
               for Content'Address use Replace'Address;
            begin
               Merge.Write (Content);
               Pos := Next + Value'Length;
            end;
         end loop;
         Free (Buffer);

      exception
         when Ex : Ada.IO_Exceptions.Name_Error =>
            Error ("Cannot read: " & Ada.Exceptions.Exception_Message (Ex));
      end Include;

      procedure Process (Line : in String) is
         Pos : Natural;
      begin
         Line_Num := Line_Num + 1;
         case Mode is
            when MERGE_NONE =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-START ");
               if Pos = 0 then
                  Text.Write (Line);
                  Text.Write (ASCII.LF);
                  return;
               end if;
               Text.Write (Line (Line'First .. Pos - 1));
               Prepare_Merge (Line (Pos + 10 .. Line'Last));

            when MERGE_LINK =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-END ");
               if Pos > 0 then
                  Merge.Close;
                  Mode := MERGE_NONE;
                  return;
               end if;
               Include (Get_Source (Line, "href="));

            when MERGE_SCRIPT =>
               Pos := Index (Line, "<!-- DYNAMO-MERGE-END ");
               if Pos > 0 then
                  Merge.Close;
                  Mode := MERGE_NONE;
                  return;
               end if;
               Text.Write (Line (Line'First .. Pos - 1));
               Include (Get_Source (Line, "src="));

         end case;
      end Process;

   begin
      if Rule.Level >= Util.Log.INFO_LEVEL then
         Log.Info ("webmerge {0}", Path);
      end if;

      Ada.Directories.Create_Path (Dir);
      Output.Create (Name => Path, Mode => Ada.Streams.Stream_IO.Out_File);
      Text.Initialize (Output'Unchecked_Access, 16 * 1024);
      Util.Files.Read_File (Source, Process'Access);
      Text.Flush;
      Output.Close;
   end Install;

end Gen.Artifacts.Distribs.Merges;

Add support to replace some texts by another when merging the CSS files


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

with ASF.Applications.Main;
with ASF.Applications.Views;
with ASF.Components.Root;
with ASF.Contexts.Writer;

package body ASF.Components.Ajax.Includes is

   --  ------------------------------
   --  Get the HTML layout that must be used for the include container.
   --  The default layout is a "div".
   --  Returns "div", "span", "pre", "b".
   --  ------------------------------
   function Get_Layout (UI      : in UIInclude;
                        Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Layout : constant String := UI.Get_Attribute (Name    => LAYOUT_ATTR_NAME,
                                                    Context => Context,
                                                    Default => "div");
   begin
      if Layout = "div" or Layout = "span" or Layout = "pre" or Layout = "b" then
         return Layout;
      else
         return "div";
      end if;
   end Get_Layout;

   --  ------------------------------
   --  The included XHTML file is rendered according to the async attribute:
   --
   --  When async is false, render the specified XHTML file in such a way that inner
   --  forms will be posted on the included view.
   --
   --  When async is true, trigger an AJAX call to include the specified
   --  XHTML view when the page is loaded.
   --
   --
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIInclude;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         App    : constant ASF.Contexts.Faces.Application_Access := Context.Get_Application;
         View_Handler : constant access ASF.Applications.Views.View_Handler'Class
           := App.Get_View_Handler;
         Id     : constant Ada.Strings.Unbounded.Unbounded_String := UI.Get_Client_Id;
         Layout : constant String := UIInclude'Class (UI).Get_Layout (Context);
         Async  : constant Boolean := UI.Get_Attribute (Name    => ASYNC_ATTR_NAME,
                                                        Context => Context,
                                                        Default => False);
         Page   : constant String := UI.Get_Attribute (Name    => SRC_ATTR_NAME,
                                                       Context => Context,
                                                       Default => "");
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Start_Element (Layout);
         UI.Render_Attributes (Context, Writer);

         --  In Async mode, generate the javascript code to trigger the async update of
         --  the generated div/span.
         if Async then
            Writer.Queue_Script ("ASF.Update(""");
            Writer.Queue_Script (Id);
            Writer.Queue_Script (""", """);
            Writer.Queue_Script (View_Handler.Get_Action_URL (Context, Page));
            Writer.Queue_Script (""");");
         else
            --  Include the view content as if the user fetched the patch.  This has almost the
            --  same final result except that the inner content is returned now and not by
            --  another async http GET request.
            declare
               View         : constant ASF.Components.Root.UIViewRoot := Context.Get_View_Root;
               Include_View : ASF.Components.Root.UIViewRoot;
               Is_Ajax      : constant Boolean := Context.Is_Ajax_Request;
               Content_Type : constant String := Context.Get_Response.Get_Content_Type;
            begin
               Context.Set_Ajax_Request (True);
               View_Handler.Restore_View (Page, Context, Include_View);
               Context.Set_View_Root (Include_View);
               View_Handler.Render_View (Context, Include_View);
               Context.Get_Response.Set_Content_Type (Content_Type);
               Context.Set_View_Root (View);
               Context.Set_Ajax_Request (Is_Ajax);

            exception
               when others =>
                  Context.Get_Response.Set_Content_Type (Content_Type);
                  Context.Set_View_Root (View);
                  Context.Set_Ajax_Request (Is_Ajax);
                  raise;
            end;
         end if;
         Writer.End_Element (Layout);
      end;
   end Encode_Children;

end ASF.Components.Ajax.Includes;

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

with ASF.Applications.Main;
with ASF.Applications.Views;
with ASF.Components.Root;
with ASF.Contexts.Writer;

package body ASF.Components.Ajax.Includes is

   --  ------------------------------
   --  Get the HTML layout that must be used for the include container.
   --  The default layout is a "div".
   --  Returns "div", "span", "pre", "b".
   --  ------------------------------
   function Get_Layout (UI      : in UIInclude;
                        Context : in ASF.Contexts.Faces.Faces_Context'Class) return String is
      Layout : constant String := UI.Get_Attribute (Name    => LAYOUT_ATTR_NAME,
                                                    Context => Context,
                                                    Default => "div");
   begin
      if Layout = "div" or Layout = "span" or Layout = "pre" or Layout = "b" then
         return Layout;
      else
         return "div";
      end if;
   end Get_Layout;

   --  ------------------------------
   --  The included XHTML file is rendered according to the async attribute:
   --
   --  When async is false, render the specified XHTML file in such a way that inner
   --  forms will be posted on the included view.
   --
   --  When async is true, trigger an AJAX call to include the specified
   --  XHTML view when the page is loaded.
   --
   --
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIInclude;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
   begin
      if not UI.Is_Rendered (Context) then
         return;
      end if;
      declare
         App    : constant ASF.Contexts.Faces.Application_Access := Context.Get_Application;
         View_Handler : constant access ASF.Applications.Views.View_Handler'Class
           := App.Get_View_Handler;
         Id     : constant Ada.Strings.Unbounded.Unbounded_String := UI.Get_Client_Id;
         Layout : constant String := UIInclude'Class (UI).Get_Layout (Context);
         Async  : constant Boolean := UI.Get_Attribute (Name    => ASYNC_ATTR_NAME,
                                                        Context => Context,
                                                        Default => False);
         Page   : constant String := UI.Get_Attribute (Name    => SRC_ATTR_NAME,
                                                       Context => Context,
                                                       Default => "");
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         Writer.Start_Element (Layout);
         UI.Render_Attributes (Context, Writer);

         --  In Async mode, generate the javascript code to trigger the async update of
         --  the generated div/span.
         if Async then
            Writer.Write_Attribute ("id", Id);
            Writer.Queue_Script ("ASF.Update(null,""");
            Writer.Queue_Script (View_Handler.Get_Action_URL (Context, Page));
            Writer.Queue_Script (""", ""#");
            Writer.Queue_Script (Id);
            Writer.Queue_Script (""");");
         else
            --  Include the view content as if the user fetched the patch.  This has almost the
            --  same final result except that the inner content is returned now and not by
            --  another async http GET request.
            declare
               View         : constant ASF.Components.Root.UIViewRoot := Context.Get_View_Root;
               Include_View : ASF.Components.Root.UIViewRoot;
               Is_Ajax      : constant Boolean := Context.Is_Ajax_Request;
               Content_Type : constant String := Context.Get_Response.Get_Content_Type;
            begin
               Context.Set_Ajax_Request (True);
               View_Handler.Restore_View (Page, Context, Include_View);
               Context.Set_View_Root (Include_View);
               View_Handler.Render_View (Context, Include_View);
               Context.Get_Response.Set_Content_Type (Content_Type);
               Context.Set_View_Root (View);
               Context.Set_Ajax_Request (Is_Ajax);

            exception
               when others =>
                  Context.Get_Response.Set_Content_Type (Content_Type);
                  Context.Set_View_Root (View);
                  Context.Set_Ajax_Request (Is_Ajax);
                  raise;
            end;
         end if;
         Writer.End_Element (Layout);
      end;
   end Encode_Children;

end ASF.Components.Ajax.Includes;

Fix generation of javascript when rendering an ajax include in async mode


-----------------------------------------------------------------------
--  util-dates-rfc7231-- RFC7231 date format utilities
--  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.
-----------------------------------------------------------------------

with Ada.Calendar;
with Util.Strings.Builders;
package Util.Dates.RFC7231 is

   --  Parses a HTTP date that follows the RFC7231 or RFC2616 format.
   --  Raises Constraint_Error if the date format is not recognized.
   function Value (Date : in String) return Ada.Calendar.Time;

   --  Return the RFC7231/RFC2616 date format.
   function Image (Date : in Ada.Calendar.Time) return String;

   --  Append the date in RFC7231/RFC2616 format in the string builder.
   --  The date separator can be changed to '-' to generate a cookie expires date.
   procedure Append_Date (Into           : in out Util.Strings.Builders.Builder;
                          Date           : in Ada.Calendar.Time;
                          Date_Separator : in Character := ' ');

end Util.Dates.RFC7231;

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

with Ada.Calendar;
with Util.Strings.Builders;

--  == RFC7231 Dates ==
--  The RFC7231 defines a standard date format that is used by HTTP headers.
--  The `Util.Dates.RFC7231` package provides an `Image` function to convert a date into
--  that target format and a `Value` function to parse such format string and return the date.
--
--      Now  : constant Ada.Calendar.Time := Ada.Calendar.Clock;
--      S    : constant String := Util.Dates.RFC7231.Image (Now);
--      Date : Ada.Calendar.time := Util.Dates.RFC7231.Value (S);
--
--  A `Constraint_Error` exception is raised when the date string is not in the correct format.
package Util.Dates.RFC7231 is

   --  Parses a HTTP date that follows the RFC7231 or RFC2616 format.
   --  Raises Constraint_Error if the date format is not recognized.
   function Value (Date : in String) return Ada.Calendar.Time;

   --  Return the RFC7231/RFC2616 date format.
   function Image (Date : in Ada.Calendar.Time) return String;

   --  Append the date in RFC7231/RFC2616 format in the string builder.
   --  The date separator can be changed to '-' to generate a cookie expires date.
   procedure Append_Date (Into           : in out Util.Strings.Builders.Builder;
                          Date           : in Ada.Calendar.Time;
                          Date_Separator : in Character := ' ');

end Util.Dates.RFC7231;

Add and update the documentation

Add and update the documentation


-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 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.Calendar;
with Ada.Strings.Unbounded;

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : out AWA.Storages.Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 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.Calendar;
with Ada.Strings.Unbounded;

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage instance stored in a folder and identified by a name.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Folder  : in ADO.Identifier;
                           Name    : in String;
                           Found   : out Boolean);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : out AWA.Storages.Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

Declare new Load_Storage procedure to load a storage file from the folder ID and file name