------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2016-2020, AdaCore                      --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with nRF.GPIO;       use nRF.GPIO;
with nRF.RTC;        use nRF.RTC;
with NRF_SVD.RTC;
with nRF.TWI;        use nRF.TWI;
with NRF_SVD.TWI;
with nRF.SPI_Master; use nRF.SPI_Master;
with NRF_SVD.SPI;
with nRF.Timers;     use nRF.Timers;
with NRF_SVD.TIMER;
with nRF.UART;       use nRF.UART;
with NRF_SVD.UART;

package nRF.Device is
   pragma Elaborate_Body;

   P00 : aliased GPIO_Point := (Pin => 00);
   P01 : aliased GPIO_Point := (Pin => 01);
   P02 : aliased GPIO_Point := (Pin => 02);
   P03 : aliased GPIO_Point := (Pin => 03);
   P04 : aliased GPIO_Point := (Pin => 04);
   P05 : aliased GPIO_Point := (Pin => 05);
   P06 : aliased GPIO_Point := (Pin => 06);
   P07 : aliased GPIO_Point := (Pin => 07);
   P08 : aliased GPIO_Point := (Pin => 08);
   P09 : aliased GPIO_Point := (Pin => 09);
   P10 : aliased GPIO_Point := (Pin => 10);
   P11 : aliased GPIO_Point := (Pin => 11);
   P12 : aliased GPIO_Point := (Pin => 12);
   P13 : aliased GPIO_Point := (Pin => 13);
   P14 : aliased GPIO_Point := (Pin => 14);
   P15 : aliased GPIO_Point := (Pin => 15);
   P16 : aliased GPIO_Point := (Pin => 16);
   P17 : aliased GPIO_Point := (Pin => 17);
   P18 : aliased GPIO_Point := (Pin => 18);
   P19 : aliased GPIO_Point := (Pin => 19);
   P20 : aliased GPIO_Point := (Pin => 20);
   P21 : aliased GPIO_Point := (Pin => 21);
   P22 : aliased GPIO_Point := (Pin => 22);
   P23 : aliased GPIO_Point := (Pin => 23);
   P24 : aliased GPIO_Point := (Pin => 24);
   P25 : aliased GPIO_Point := (Pin => 25);
   P26 : aliased GPIO_Point := (Pin => 26);
   P27 : aliased GPIO_Point := (Pin => 27);
   P28 : aliased GPIO_Point := (Pin => 28);
   P29 : aliased GPIO_Point := (Pin => 29);
   P30 : aliased GPIO_Point := (Pin => 30);
   P31 : aliased GPIO_Point := (Pin => 31);

   RTC_0 : aliased Real_Time_Counter (NRF_SVD.RTC.RTC0_Periph'Access);
   RTC_1 : aliased Real_Time_Counter (NRF_SVD.RTC.RTC1_Periph'Access);

   --  Be carefull of shared resources between the TWI and SPI controllers.
   --  TWI_O and SPI_Master_0 cannot be used at the same time.
   --  TWI_1 and SPI_Master_1 cannot be used at the same time.
   --
   --  See nRF Series Reference Manual, chapter Memory.Instantiation.

   TWI_0 : aliased TWI_Master (NRF_SVD.TWI.TWI0_Periph'Access);
   TWI_1 : aliased TWI_Master (NRF_SVD.TWI.TWI1_Periph'Access);

   SPI_Master_0 : aliased nRF.SPI_Master.SPI_Master (NRF_SVD.SPI.SPI0_Periph'Access);
   SPI_Master_1 : aliased nRF.SPI_Master.SPI_Master (NRF_SVD.SPI.SPI1_Periph'Access);

   Timer_0 : aliased Timer (NRF_SVD.TIMER.TIMER0_Periph'Access);
   Timer_1 : aliased Timer (NRF_SVD.TIMER.TIMER1_Periph'Access);
   Timer_2 : aliased Timer (NRF_SVD.TIMER.TIMER2_Periph'Access);
   Timer_3 : aliased Timer (NRF_SVD.TIMER.TIMER3_Periph'Access);
   Timer_4 : aliased Timer (NRF_SVD.TIMER.TIMER4_Periph'Access);

   UART_0 : aliased UART_Device (NRF_SVD.UART.UART0_Periph'Access);
end nRF.Device;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2016-2020, AdaCore                      --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of the copyright holder nor the names of its     --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with nRF.GPIO;       use nRF.GPIO;
with nRF.RTC;        use nRF.RTC;
with NRF_SVD.RTC;
with nRF.TWI;        use nRF.TWI;
with NRF_SVD.TWI;
with nRF.SPI_Master; use nRF.SPI_Master;
with NRF_SVD.SPI;
with nRF.Timers;     use nRF.Timers;
with NRF_SVD.TIMER;
with nRF.UART;       use nRF.UART;
with NRF_SVD.UART;

package nRF.Device is
   pragma Elaborate_Body;

   P00 : aliased GPIO_Point := (Pin => 00);
   P01 : aliased GPIO_Point := (Pin => 01);
   P02 : aliased GPIO_Point := (Pin => 02);
   P03 : aliased GPIO_Point := (Pin => 03);
   P04 : aliased GPIO_Point := (Pin => 04);
   P05 : aliased GPIO_Point := (Pin => 05);
   P06 : aliased GPIO_Point := (Pin => 06);
   P07 : aliased GPIO_Point := (Pin => 07);
   P08 : aliased GPIO_Point := (Pin => 08);
   P09 : aliased GPIO_Point := (Pin => 09);
   P10 : aliased GPIO_Point := (Pin => 10);
   P11 : aliased GPIO_Point := (Pin => 11);
   P12 : aliased GPIO_Point := (Pin => 12);
   P13 : aliased GPIO_Point := (Pin => 13);
   P14 : aliased GPIO_Point := (Pin => 14);
   P15 : aliased GPIO_Point := (Pin => 15);
   P16 : aliased GPIO_Point := (Pin => 16);
   P17 : aliased GPIO_Point := (Pin => 17);
   P18 : aliased GPIO_Point := (Pin => 18);
   P19 : aliased GPIO_Point := (Pin => 19);
   P20 : aliased GPIO_Point := (Pin => 20);
   P21 : aliased GPIO_Point := (Pin => 21);
   P22 : aliased GPIO_Point := (Pin => 22);
   P23 : aliased GPIO_Point := (Pin => 23);
   P24 : aliased GPIO_Point := (Pin => 24);
   P25 : aliased GPIO_Point := (Pin => 25);
   P26 : aliased GPIO_Point := (Pin => 26);
   P27 : aliased GPIO_Point := (Pin => 27);
   P28 : aliased GPIO_Point := (Pin => 28);
   P29 : aliased GPIO_Point := (Pin => 29);
   P30 : aliased GPIO_Point := (Pin => 30);
   P31 : aliased GPIO_Point := (Pin => 31);

   RTC_0 : aliased Real_Time_Counter (NRF_SVD.RTC.RTC0_Periph'Access);
   RTC_1 : aliased Real_Time_Counter (NRF_SVD.RTC.RTC1_Periph'Access);
   RTC_2 : aliased Real_Time_Counter (NRF_SVD.RTC.RTC2_Periph'Access);

   --  Be carefull of shared resources between the TWI and SPI controllers.
   --  TWI_O and SPI_Master_0 cannot be used at the same time.
   --  TWI_1 and SPI_Master_1 cannot be used at the same time.
   --
   --  See nRF Series Reference Manual, chapter Memory.Instantiation.

   TWI_0 : aliased TWI_Master (NRF_SVD.TWI.TWI0_Periph'Access);
   TWI_1 : aliased TWI_Master (NRF_SVD.TWI.TWI1_Periph'Access);

   SPI_Master_0 : aliased nRF.SPI_Master.SPI_Master (NRF_SVD.SPI.SPI0_Periph'Access);
   SPI_Master_1 : aliased nRF.SPI_Master.SPI_Master (NRF_SVD.SPI.SPI1_Periph'Access);
   SPI_Master_2 : aliased nRF.SPI_Master.SPI_Master (NRF_SVD.SPI.SPI2_Periph'Access);

   Timer_0 : aliased Timer (NRF_SVD.TIMER.TIMER0_Periph'Access);
   Timer_1 : aliased Timer (NRF_SVD.TIMER.TIMER1_Periph'Access);
   Timer_2 : aliased Timer (NRF_SVD.TIMER.TIMER2_Periph'Access);
   Timer_3 : aliased Timer (NRF_SVD.TIMER.TIMER3_Periph'Access);
   Timer_4 : aliased Timer (NRF_SVD.TIMER.TIMER4_Periph'Access);

   UART_0 : aliased UART_Device (NRF_SVD.UART.UART0_Periph'Access);
end nRF.Device;

Add missing devices

nRF.Device: Add missing devices


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

with ASF.Components.Base;
with ASF.Views.Nodes;
with ASF.Views.Nodes.Jsf;
with ASF.Components.Html.Selects;
with ASF.Components.Core.Views;
package body ASF.Components.Core.Factory is

   function Create_View return Base.UIComponent_Access;
   function Create_ViewAction return Base.UIComponent_Access;
   function Create_ViewMetaData return Base.UIComponent_Access;
   function Create_ViewParameter return Base.UIComponent_Access;
   function Create_Parameter return Base.UIComponent_Access;
   function Create_SelectItem return Base.UIComponent_Access;
   function Create_SelectItems return Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIView component
   --  ------------------------------
   function Create_View return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIView;
   end Create_View;

   --  ------------------------------
   --  Create an UIViewAction component
   --  ------------------------------
   function Create_ViewAction return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewAction;
   end Create_ViewAction;

   --  ------------------------------
   --  Create an UIViewMetaData component
   --  ------------------------------
   function Create_ViewMetaData return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewMetaData;
   end Create_ViewMetaData;

   --  ------------------------------
   --  Create an UIViewParameter component
   --  ------------------------------
   function Create_ViewParameter return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewParameter;
   end Create_ViewParameter;

   --  ------------------------------
   --  Create an UIParameter component
   --  ------------------------------
   function Create_Parameter return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.UIParameter;
   end Create_Parameter;

   --  ------------------------------
   --  Create an UISelectItem component
   --  ------------------------------
   function Create_SelectItem return Base.UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectItem;
   end Create_SelectItem;

   --  ------------------------------
   --  Create an UISelectItems component
   --  ------------------------------
   function Create_SelectItems return Base.UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectItems;
   end Create_SelectItems;

   use ASF.Views.Nodes;

   URI                     : aliased constant String := "http://java.sun.com/jsf/core";
   ATTRIBUTE_TAG           : aliased constant String := "attribute";
   CONVERT_DATE_TIME_TAG   : aliased constant String := "convertDateTime";
   CONVERTER_TAG           : aliased constant String := "converter";
   FACET_TAG               : aliased constant String := "facet";
   METADATA_TAG            : aliased constant String := "metadata";
   PARAM_TAG               : aliased constant String := "param";
   SELECT_ITEM_TAG         : aliased constant String := "selectItem";
   SELECT_ITEMS_TAG        : aliased constant String := "selectItems";
   VALIDATE_LENGTH_TAG     : aliased constant String := "validateLength";
   VALIDATE_LONG_RANGE_TAG : aliased constant String := "validateLongRange";
   VALIDATOR_TAG           : aliased constant String := "validator";
   VIEW_TAG                : aliased constant String := "view";
   VIEW_ACTION_TAG         : aliased constant String := "viewAction";
   VIEW_PARAM_TAG          : aliased constant String := "viewParam";

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => ATTRIBUTE_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Attribute_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => CONVERT_DATE_TIME_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Convert_Date_Time_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => CONVERTER_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Converter_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FACET_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Facet_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => METADATA_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Metadata_Tag_Node'Access,
                            Create => Create_ViewMetaData'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => PARAM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Parameter'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ITEM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectItem'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ITEMS_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectItems'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATE_LENGTH_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Length_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATE_LONG_RANGE_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Range_Validator_Tag_Node'Access,
                            Create => null);

      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATOR_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_View'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_ACTION_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_ViewAction'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_PARAM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_ViewParameter'Access);
   end Register;

end ASF.Components.Core.Factory;

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

with ASF.Components.Base;
with ASF.Views.Nodes;
with ASF.Views.Nodes.Jsf;
with ASF.Components.Html.Selects;
with ASF.Components.Core.Views;
package body ASF.Components.Core.Factory is

   function Create_View return Base.UIComponent_Access;
   function Create_ViewAction return Base.UIComponent_Access;
   function Create_ViewMetaData return Base.UIComponent_Access;
   function Create_ViewParameter return Base.UIComponent_Access;
   function Create_Parameter return Base.UIComponent_Access;
   function Create_SelectItem return Base.UIComponent_Access;
   function Create_SelectItems return Base.UIComponent_Access;

   --  ------------------------------
   --  Create an UIView component
   --  ------------------------------
   function Create_View return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIView;
   end Create_View;

   --  ------------------------------
   --  Create an UIViewAction component
   --  ------------------------------
   function Create_ViewAction return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewAction;
   end Create_ViewAction;

   --  ------------------------------
   --  Create an UIViewMetaData component
   --  ------------------------------
   function Create_ViewMetaData return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewMetaData;
   end Create_ViewMetaData;

   --  ------------------------------
   --  Create an UIViewParameter component
   --  ------------------------------
   function Create_ViewParameter return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.Views.UIViewParameter;
   end Create_ViewParameter;

   --  ------------------------------
   --  Create an UIParameter component
   --  ------------------------------
   function Create_Parameter return Base.UIComponent_Access is
   begin
      return new ASF.Components.Core.UIParameter;
   end Create_Parameter;

   --  ------------------------------
   --  Create an UISelectItem component
   --  ------------------------------
   function Create_SelectItem return Base.UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectItem;
   end Create_SelectItem;

   --  ------------------------------
   --  Create an UISelectItems component
   --  ------------------------------
   function Create_SelectItems return Base.UIComponent_Access is
   begin
      return new ASF.Components.Html.Selects.UISelectItems;
   end Create_SelectItems;

   use ASF.Views.Nodes;

   URI                     : aliased constant String := "http://java.sun.com/jsf/core";
   ATTRIBUTE_TAG           : aliased constant String := "attribute";
   CONVERT_DATE_TIME_TAG   : aliased constant String := "convertDateTime";
   CONVERTER_TAG           : aliased constant String := "converter";
   FACET_TAG               : aliased constant String := "facet";
   METADATA_TAG            : aliased constant String := "metadata";
   PARAM_TAG               : aliased constant String := "param";
   SELECT_ITEM_TAG         : aliased constant String := "selectItem";
   SELECT_ITEMS_TAG        : aliased constant String := "selectItems";
   VALIDATE_LENGTH_TAG     : aliased constant String := "validateLength";
   VALIDATE_LONG_RANGE_TAG : aliased constant String := "validateLongRange";
   VALIDATE_REGEX_TAG      : aliased constant String := "validateRegex";
   VALIDATOR_TAG           : aliased constant String := "validator";
   VIEW_TAG                : aliased constant String := "view";
   VIEW_ACTION_TAG         : aliased constant String := "viewAction";
   VIEW_PARAM_TAG          : aliased constant String := "viewParam";

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   procedure Register (Factory : in out ASF.Factory.Component_Factory) is
   begin
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => ATTRIBUTE_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Attribute_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => CONVERT_DATE_TIME_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Convert_Date_Time_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => CONVERTER_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Converter_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => FACET_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Facet_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => METADATA_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Metadata_Tag_Node'Access,
                            Create => Create_ViewMetaData'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => PARAM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_Parameter'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ITEM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectItem'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => SELECT_ITEMS_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_SelectItems'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATE_LENGTH_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Length_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATE_LONG_RANGE_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Range_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATE_REGEX_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Regex_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VALIDATOR_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_TAG'Access,
                            Tag    => ASF.Views.Nodes.Jsf.Create_Validator_Tag_Node'Access,
                            Create => null);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_View'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_ACTION_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_ViewAction'Access);
      ASF.Factory.Register (Factory,
                            URI    => URI'Access,
                            Name   => VIEW_PARAM_TAG'Access,
                            Tag    => Create_Component_Node'Access,
                            Create => Create_ViewParameter'Access);
   end Register;

end ASF.Components.Core.Factory;

Define and register the <f:validateRegex> tag


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

with Ada.Finalization;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;
with ADO.Sessions;
with ADO.Objects;
limited with ADO.Sessions.Factory;

--  The sequence generator is responsible for creating unique ID's
--  across all database objects.
--
--  Each table can be associated with a sequence generator.
--  The sequence factory is shared by several sessions and the
--  implementation is thread-safe.
--
--  The HiLoGenerator implements a simple High Low sequence generator
--  by using sequences that avoid to access the database.
--
--  Example:
--
--    F  : Factory;
--    Id : Identifier;
--
--    Allocate (Manager => F, Name => "user", Id => Id);
--
package ADO.Sequences is

   type Session_Factory_Access is access all ADO.Sessions.Factory.Session_Factory'Class;

   --  ------------------------------
   --  Abstract sequence generator
   --  ------------------------------
   type Generator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Generator_Access is access all Generator'Class;

   --  Get the name of the sequence.
   function Get_Sequence_Name (Gen : in Generator'Class) return String;

   --  Allocate an identifier using the generator.
   procedure Allocate (Gen : in out Generator;
                       Id  : in out Objects.Object_Record'Class) is abstract;

   --  Get a session to connect to the database.
   function Get_Session (Gen : in Generator) return ADO.Sessions.Master_Session'Class;

   type Generator_Factory is access
     function (Sess_Factory : in Session_Factory_Access)
               return Generator_Access;

   --  ------------------------------
   --  Sequence factory
   --  ------------------------------
   --  The sequence <b>Factory</b> allocates unique ids for new objects.
   --  The factory is shared by all connections to the same database.
   type Factory is limited private;
   type Factory_Access is access all Factory;

   --  Allocate a unique identifier for the given sequence.
   procedure Allocate (Manager : in out Factory;
                       Id      : in out Objects.Object_Record'Class);

   --  Set a generator to be used for the given sequence.
   procedure Set_Generator (Manager : in out Factory;
                            Name    : in String;
                            Gen     : in Generator_Access);

   --  Set the default factory for creating generators.
   --  The default factory is the HiLo generator.
   procedure Set_Default_Generator
     (Manager      : in out Factory;
      Factory      : in Generator_Factory;
      Sess_Factory : in Session_Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Generator is abstract new Ada.Finalization.Limited_Controlled with record
      Name    : Unbounded_String;
      Factory : Session_Factory_Access;
   end record;

   --  Each sequence generator is accessed through a protected type
   --  to make sure the allocation is unique and works in multi-threaded
   --  environments.
   protected type Sequence_Generator is

      --  Allocate a unique identifier for the given sequence.
      procedure Allocate (Id   : in out Objects.Object_Record'Class);

      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Generator_Access);

      --  Free the generator
      procedure Clear;

   private
      Generator : Generator_Access;
   end Sequence_Generator;
   type Sequence_Generator_Access is access all Sequence_Generator;

   --  Map to keep track of allocation generators for each sequence.
   package Sequence_Maps is new Ada.Containers.Hashed_Maps
     (Key_Type     => Unbounded_String,
      Element_Type => Sequence_Generator_Access,
      Hash         => Ada.Strings.Unbounded.Hash,
      Equivalent_Keys => "=",
      "=" => "=");

   --  The sequence factory map is also accessed through a protected type.
   protected type Factory_Map is

      --  Get the sequence generator associated with the name.
      --  If there is no such generator, an entry is created by using
      --  the default generator.
      procedure Get_Generator (Name : in Unbounded_String;
                               Gen  : out Sequence_Generator_Access);

      --  Set the sequence generator associated with the name.
      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Sequence_Generator_Access);

      --  Set the default sequence generator.
      procedure Set_Default_Generator
        (Gen : in Generator_Factory;
         Factory : in Session_Factory_Access);

      --  Clear the factory map.
      procedure Clear;
   private
      Map              : Sequence_Maps.Map;
      Create_Generator : Generator_Factory;
      Sess_Factory     : Session_Factory_Access;
   end Factory_Map;

   type Factory is new Ada.Finalization.Limited_Controlled with record
      Map : Factory_Map;
   end record;

   overriding
   procedure Finalize (Manager : in out Factory);

end ADO.Sequences;

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

with Ada.Finalization;
with Ada.Strings.Unbounded.Hash;
with Ada.Containers.Hashed_Maps;
with ADO.Sessions;
with ADO.Objects;
limited with ADO.Sessions.Factory;

--  == Sequence Generators ==
--  The sequence generator is responsible for creating unique ID's
--  across all database objects.
--
--  Each table can be associated with a sequence generator.
--  The sequence factory is shared by several sessions and the
--  implementation is thread-safe.
--
--  The HiLoGenerator implements a simple High Low sequence generator
--  by using sequences that avoid to access the database.
--
--  Example:
--
--    F  : Factory;
--    Id : Identifier;
--
--    Allocate (Manager => F, Name => "user", Id => Id);
--
--  @include ado-sequences-hilo.ads
package ADO.Sequences is

   type Session_Factory_Access is access all ADO.Sessions.Factory.Session_Factory'Class;

   --  ------------------------------
   --  Abstract sequence generator
   --  ------------------------------
   type Generator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Generator_Access is access all Generator'Class;

   --  Get the name of the sequence.
   function Get_Sequence_Name (Gen : in Generator'Class) return String;

   --  Allocate an identifier using the generator.
   procedure Allocate (Gen : in out Generator;
                       Id  : in out Objects.Object_Record'Class) is abstract;

   --  Get a session to connect to the database.
   function Get_Session (Gen : in Generator) return ADO.Sessions.Master_Session'Class;

   type Generator_Factory is access
     function (Sess_Factory : in Session_Factory_Access)
               return Generator_Access;

   --  ------------------------------
   --  Sequence factory
   --  ------------------------------
   --  The sequence <b>Factory</b> allocates unique ids for new objects.
   --  The factory is shared by all connections to the same database.
   type Factory is limited private;
   type Factory_Access is access all Factory;

   --  Allocate a unique identifier for the given sequence.
   procedure Allocate (Manager : in out Factory;
                       Id      : in out Objects.Object_Record'Class);

   --  Set a generator to be used for the given sequence.
   procedure Set_Generator (Manager : in out Factory;
                            Name    : in String;
                            Gen     : in Generator_Access);

   --  Set the default factory for creating generators.
   --  The default factory is the HiLo generator.
   procedure Set_Default_Generator
     (Manager      : in out Factory;
      Factory      : in Generator_Factory;
      Sess_Factory : in Session_Factory_Access);

private

   use Ada.Strings.Unbounded;

   type Generator is abstract new Ada.Finalization.Limited_Controlled with record
      Name    : Unbounded_String;
      Factory : Session_Factory_Access;
   end record;

   --  Each sequence generator is accessed through a protected type
   --  to make sure the allocation is unique and works in multi-threaded
   --  environments.
   protected type Sequence_Generator is

      --  Allocate a unique identifier for the given sequence.
      procedure Allocate (Id   : in out Objects.Object_Record'Class);

      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Generator_Access);

      --  Free the generator
      procedure Clear;

   private
      Generator : Generator_Access;
   end Sequence_Generator;
   type Sequence_Generator_Access is access all Sequence_Generator;

   --  Map to keep track of allocation generators for each sequence.
   package Sequence_Maps is new Ada.Containers.Hashed_Maps
     (Key_Type     => Unbounded_String,
      Element_Type => Sequence_Generator_Access,
      Hash         => Ada.Strings.Unbounded.Hash,
      Equivalent_Keys => "=",
      "=" => "=");

   --  The sequence factory map is also accessed through a protected type.
   protected type Factory_Map is

      --  Get the sequence generator associated with the name.
      --  If there is no such generator, an entry is created by using
      --  the default generator.
      procedure Get_Generator (Name : in Unbounded_String;
                               Gen  : out Sequence_Generator_Access);

      --  Set the sequence generator associated with the name.
      procedure Set_Generator (Name : in Unbounded_String;
                               Gen  : in Sequence_Generator_Access);

      --  Set the default sequence generator.
      procedure Set_Default_Generator
        (Gen : in Generator_Factory;
         Factory : in Session_Factory_Access);

      --  Clear the factory map.
      procedure Clear;
   private
      Map              : Sequence_Maps.Map;
      Create_Generator : Generator_Factory;
      Sess_Factory     : Session_Factory_Access;
   end Factory_Map;

   type Factory is new Ada.Finalization.Limited_Controlled with record
      Map : Factory_Map;
   end record;

   overriding
   procedure Finalize (Manager : in out Factory);

end ADO.Sequences;

Add some documentation on sequences

Add some documentation on sequences


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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Util.Log.Loggers;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Marshaller");

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         Log.Error ("Not enough data to get a uint8");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         Log.Error ("Not enough data to get a uint16");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         Log.Error ("Not enough data to get a uint32");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Buffer_Ptr;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg));

         when others =>
            Log.Error ("Invalid attribute type {0}",
                       MAT.EVents.Attribute_Type'Image (Kind));
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Buffer_Ptr) return String is
      Len    : constant MAT.Types.Uint8 := Get_Uint8 (Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Buffer_Ptr;
                   Size   : in Natural) is
   begin
      Buffer.Size := Buffer.Size - Size;
      Buffer.Current := Buffer.Current + Storage_Offset (Size);
   end Skip;

end MAT.Readers.Marshaller;

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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Util.Log.Loggers;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Marshaller");

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         Log.Error ("Not enough data to get a uint8");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         Log.Error ("Not enough data to get a uint16");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         Log.Error ("Not enough data to get a uint32");
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Buffer_Ptr;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg));

         when others =>
            Log.Error ("Invalid attribute type {0}",
                       MAT.EVents.Attribute_Type'Image (Kind));
            return 0;
      end case;
   end Get_Target_Value;

   --  ------------------------------
   --  Extract a string from the buffer.  The string starts with a byte that
   --  indicates the string length.
   --  ------------------------------
   function Get_String (Buffer : in Buffer_Ptr) return String is
      Len    : constant MAT.Types.Uint8 := Get_Uint8 (Buffer);
      Result : String (1 .. Natural (Len));
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Get_Uint8 (Buffer));
      end loop;
      return Result;
   end Get_String;

   --  ------------------------------
   --  Skip the given number of bytes from the message.
   --  ------------------------------
   procedure Skip (Buffer : in Buffer_Ptr;
                   Size   : in Natural) is
   begin
      Buffer.Size := Buffer.Size - Size;
      Buffer.Current := Buffer.Current + Storage_Offset (Size);
   end Skip;

   function Get_Target_Size (Msg  : in Buffer_Ptr;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Size is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Size);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Size;

   function Get_Target_Addr (Msg  : in Buffer_Ptr;
                             Kind : in MAT.Events.Attribute_Type) return MAT.Types.Target_Addr is
         function Get_Value is new Get_Target_Value (MAT.Types.Target_Addr);
   begin
      return Get_Value (Msg, Kind);
   end Get_Target_Addr;

end MAT.Readers.Marshaller;

Fix instantiation issue

Fix instantiation issue


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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

end MAT.Readers.Marshaller;

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

with System; use System;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
with MAT.Types;
with Interfaces; use Interfaces;
package body MAT.Readers.Marshaller is

   use System.Storage_Elements;

   package Uint8_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint8);

   package Uint32_Access is new System.Address_To_Access_Conversions (MAT.Types.Uint32);

   function Get_Raw_Uint32 (Buf : System.Address) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buf);
   begin
      return P.all;
   end Get_Raw_Uint32;

   function Get_Uint8 (Buffer : in Buffer_Ptr) return MAT.Types.Uint8 is
      use Uint8_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size = 0 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 1;
      Buffer.Current := Buffer.Current + Storage_Offset (1);
      return P.all;
   end Get_Uint8;

   function Get_Uint16 (Buffer : in Buffer_Ptr) return MAT.Types.Uint16 is
      use Uint8_Access;

      High : Object_Pointer := To_Pointer (Buffer.Current
                                           + Storage_Offset (1));
      Low : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size <= 1 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 2;
      Buffer.Current := Buffer.Current + Storage_Offset (2);
      return MAT.Types.Uint16 (High.all) * 256 + MAT.Types.Uint16 (Low.all);
   end Get_Uint16;

   function Get_Uint32 (Buffer : in Buffer_Ptr) return MAT.Types.Uint32 is
      use Uint32_Access;

      P : Object_Pointer := To_Pointer (Buffer.Current);
   begin
      if Buffer.Size < 4 then
         raise Buffer_Underflow_Error;
      end if;
      Buffer.Size := Buffer.Size - 4;
      Buffer.Current := Buffer.Current + Storage_Offset (4);
      if Buffer.Current >= Buffer.Last then
         Buffer.Current := Buffer.Start;
      end if;
      return P.all;
   end Get_Uint32;

   function Get_Uint64 (Buffer : in Buffer_Ptr) return MAT.Types.Uint64 is
      Val : MAT.Types.Uint64 := MAT.Types.Uint64 (Get_Uint32 (Buffer));
   begin
      return Val + MAT.Types.Uint64 (Get_Uint32 (Buffer)) * 2**32;
   end Get_Uint64;

   function Get_Target_Value (Msg  : in Buffer_Ptr;
                              Kind : in MAT.Events.Attribute_Type) return Target_Type is
   begin
      case Kind is
         when MAT.Events.T_UINT8 =>
            return Target_Type (Get_Uint8 (Msg));

         when MAT.Events.T_UINT16 =>
            return Target_Type (Get_Uint16 (Msg));

         when MAT.Events.T_UINT32 =>
            return Target_Type (Get_Uint32 (Msg));

         when MAT.Events.T_UINT64 =>
            return Target_Type (Get_Uint64 (Msg));

         when others =>
            pragma Assert (False, "Invalid attribute type ");
            return 0;
      end case;
   end Get_Target_Value;

end MAT.Readers.Marshaller;

Implement the Get_Target_Type generic function


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

with Util.Streams.Texts;

--  The Measures package defines utility types and functions to make
--  performance measurements in an Ada application.  It is designed to be used
--  for production and multi-threaded environments.
--
--  A measurement point starts by the creation of a Stamp variable
--  and ends at the next call to Report on that variable.
--
--   declare
--      M : Stamp;
--   begin
--      ...
--      Util.Measures.Report (M, "Request for X");
--   end;
--
--  Measures are collected in a Measure_Set which collects the number of
--  times each measure was made and the sum of their duration.
--  Measures can be written in an XML file once they are collected.
package Util.Measures is

   type Unit_Type is (Seconds, Milliseconds, Microseconds, Nanoseconds);

   --  ------------------------------
   --  Measure Set
   --  ------------------------------
   --  The measure set represent a collection of measures each of them being
   --  associated with a same name.  Several measure sets can be created to
   --  collect different kinds of runtime information.  The measure set can be
   --  set on a per-thread data and every call to Report will be
   --  associated with that measure set.
   --
   --  Measure set are thread-safe.
   type Measure_Set is limited private;
   type Measure_Set_Access is access all Measure_Set;

   --  Disable collecting measures on the measure set.
   procedure Disable (Measures : in out Measure_Set);

   --  Enable collecting measures on the measure set.
   procedure Enable (Measures : in out Measure_Set);

   --  Set the per-thread measure set.
   procedure Set_Current (Measures : in Measure_Set_Access);

   --  Get the per-thread measure set.
   function Get_Current return Measure_Set_Access;

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class);

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type);

   --  Dump  an XML result with the measures in a file.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String);

   --  ------------------------------
   --  Stamp
   --  ------------------------------
   --  The stamp marks the beginning of a measure when the variable of such
   --  type is declared.  The measure represents the time that elapsed between
   --  the stamp creation and when the Report method is called.
   type Stamp is limited private;

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds);

private

   type String_Access is access String;

   type Stamp is limited record
      Start : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

   type Measure;
   type Measure_Access is access Measure;

   type Measure is limited record
      Next  : Measure_Access;
      Time  : Duration;
      Count : Positive;
      Name  : String_Access;
   end record;

   type Buckets_Type is
     array (Ada.Containers.Hash_Type range <>) of Measure_Access;
   type Buckets_Access is access all Buckets_Type;

   --  To reduce contention we only protect insertion and updates of measures.
   --  To write the measure set, we steal the buckets and force the next call
   --  to Add to reallocate the buckets.
   protected type Measure_Data is

      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time);

      --  Add the measure
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1);

   private
      Start   : Ada.Calendar.Time := Ada.Calendar.Clock;
      Buckets : Buckets_Access;
   end Measure_Data;

   type Measure_Set is new Ada.Finalization.Limited_Controlled with record
      Enabled : Boolean := True;
      pragma Atomic (Enabled);

      Data    : Measure_Data;
   end record;

   --  Finalize the measures and release the storage.
   overriding
   procedure Finalize (Measures : in out Measure_Set);

end Util.Measures;

-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 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.Text_IO;
with Ada.Calendar;
with Ada.Containers;
with Ada.Finalization;

with Util.Streams.Texts;

--  = Performance Measurements =
--
--  Performance measurements is often made using profiling tools such as GNU gprof or others.
--  This profiling is however not always appropriate for production or release delivery.
--  The mechanism presented here is a lightweight performance measurement that can be
--  used in production systems.
--
--  The Ada package `Util.Measures` defines the types and operations to make
--  performance measurements.  It is designed to be used for production and multi-threaded
--  environments.
--
--  == Create the measure set ==
--
--  Measures are collected in a `Measure_Set`.  Each measure has a name, a counter and
--  a sum of time spent for all the measure.  The measure set should be declared as some
--  global variable.  The implementation is thread safe meaning that a measure set can
--  be used by several threads at the same time.  It can also be associated with
--  a per-thread data (or task attribute).
--
--  To declare the measure set, use:
--
--     with Util.Measures;
--        ...
--        Perf : Util.Measures.Measure_Set;
--
--  == Measure the implementation ==
--
--  A measure is made by creating a variable of type `Stamp`.  The declaration of
--  this variable marks the begining of the measure.  The measure ends at the
--  next call to the `Report` procedure.
--
--     with Util.Measures;
--     ...
--       declare
--          Start : Util.Measures.Stamp;
--       begin
--          ...
--          Util.Measures.Report (Perf, Start, "Measure for a block");
--       end;
--
--  When the `Report` procedure is called, the time that elapsed between the creation of
--  the `Start` variable and the procedure call is computed.  This time is
--  then associated with the measure title and the associated counter is incremented.
--  The precision of the measured time depends on the system.  On GNU/Linux, it uses
--  `gettimeofday`.
--
--  If the block code is executed several times, the measure set will report
--  the number of times it was executed.
--
--  == Reporting results ==
--
--  After measures are collected, the results can be saved in a file or in
--  an output stream.  When saving the measures, the measure set is cleared.
--
--     Util.Measures.Write (Perf, "Title of measures",
--                          Ada.Text_IO.Standard_Output);
--
--  == Measure Overhead ==
--
--  The overhead introduced by the measurement is quite small as it does not exceeds 1.5 us
--  on a 2.6 Ghz Core Quad.
--
--  == What must be measured ==
--
--  Defining a lot of measurements for a production system is in general not very useful.
--  Measurements should be relatively high level measurements.  For example:
--
--    * Loading or saving a file
--    * Rendering a page in a web application
--    * Executing a database query
--
package Util.Measures is

   type Unit_Type is (Seconds, Milliseconds, Microseconds, Nanoseconds);

   --  ------------------------------
   --  Measure Set
   --  ------------------------------
   --  The measure set represent a collection of measures each of them being
   --  associated with a same name.  Several measure sets can be created to
   --  collect different kinds of runtime information.  The measure set can be
   --  set on a per-thread data and every call to Report will be
   --  associated with that measure set.
   --
   --  Measure set are thread-safe.
   type Measure_Set is limited private;
   type Measure_Set_Access is access all Measure_Set;

   --  Disable collecting measures on the measure set.
   procedure Disable (Measures : in out Measure_Set);

   --  Enable collecting measures on the measure set.
   procedure Enable (Measures : in out Measure_Set);

   --  Set the per-thread measure set.
   procedure Set_Current (Measures : in Measure_Set_Access);

   --  Get the per-thread measure set.
   function Get_Current return Measure_Set_Access;

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class);

   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type);

   --  Dump  an XML result with the measures in a file.
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String);

   --  ------------------------------
   --  Stamp
   --  ------------------------------
   --  The stamp marks the beginning of a measure when the variable of such
   --  type is declared.  The measure represents the time that elapsed between
   --  the stamp creation and when the Report method is called.
   type Stamp is limited private;

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1);

   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds);

private

   type String_Access is access String;

   type Stamp is limited record
      Start : Ada.Calendar.Time := Ada.Calendar.Clock;
   end record;

   type Measure;
   type Measure_Access is access Measure;

   type Measure is limited record
      Next  : Measure_Access;
      Time  : Duration;
      Count : Positive;
      Name  : String_Access;
   end record;

   type Buckets_Type is
     array (Ada.Containers.Hash_Type range <>) of Measure_Access;
   type Buckets_Access is access all Buckets_Type;

   --  To reduce contention we only protect insertion and updates of measures.
   --  To write the measure set, we steal the buckets and force the next call
   --  to Add to reallocate the buckets.
   protected type Measure_Data is

      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time);

      --  Add the measure
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1);

   private
      Start   : Ada.Calendar.Time := Ada.Calendar.Clock;
      Buckets : Buckets_Access;
   end Measure_Data;

   type Measure_Set is new Ada.Finalization.Limited_Controlled with record
      Enabled : Boolean := True;
      pragma Atomic (Enabled);

      Data    : Measure_Data;
   end record;

   --  Finalize the measures and release the storage.
   overriding
   procedure Finalize (Measures : in out Measure_Set);

end Util.Measures;

Integrate documentation about measures

Integrate documentation about measures


-----------------------------------------------------------------------
--  util-streams-raw -- Raw streams for Unix based systems
--  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 Ada.Finalization;

with Util.Systems.Os;

--  The Util.Streams.Raw package provides a stream directly on top of
--  file system operations read and write.
package Util.Streams.Raw is

   --  -----------------------
   --  File stream
   --  -----------------------
   --  The Raw_Stream is an output/input stream that reads or writes
   --  into a file-based stream.
   type Raw_Stream is new Ada.Finalization.Limited_Controlled and Output_Stream
     and Input_Stream with private;
   type Raw_Stream_Access is access all Raw_Stream'Class;

   --  Initialize the raw stream to read and write on the given file descriptor.
   procedure Initialize (Stream  : in out Raw_Stream;
                         File    : in Util.Systems.Os.File_Type);

   --  Close the stream.
   overriding
   procedure Close (Stream : in out Raw_Stream);

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

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

private

   use Ada.Streams;

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

   type Raw_Stream is new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      File : Util.Systems.Os.File_Type := Util.Systems.Os.NO_FILE;
   end record;

end Util.Streams.Raw;

-----------------------------------------------------------------------
--  util-streams-raw -- Raw streams for Unix based systems
--  Copyright (C) 2011, 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.Finalization;

with Util.Systems.Os;
with Util.Systems.Types;

--  The Util.Streams.Raw package provides a stream directly on top of
--  file system operations read and write.
package Util.Streams.Raw is

   --  -----------------------
   --  File stream
   --  -----------------------
   --  The Raw_Stream is an output/input stream that reads or writes
   --  into a file-based stream.
   type Raw_Stream is new Ada.Finalization.Limited_Controlled and Output_Stream
     and Input_Stream with private;
   type Raw_Stream_Access is access all Raw_Stream'Class;

   --  Initialize the raw stream to read and write on the given file descriptor.
   procedure Initialize (Stream  : in out Raw_Stream;
                         File    : in Util.Systems.Os.File_Type);

   --  Close the stream.
   overriding
   procedure Close (Stream : in out Raw_Stream);

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

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

   --  Reposition the read/write file offset.
   procedure Seek (Stream : in out Raw_Stream;
                   Pos    : in Util.Systems.Types.off_t;
                   Mode   : in Util.Systems.Types.Seek_Mode);

private

   use Ada.Streams;

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

   type Raw_Stream is new Ada.Finalization.Limited_Controlled
     and Output_Stream and Input_Stream with record
      File : Util.Systems.Os.File_Type := Util.Systems.Os.NO_FILE;
   end record;

end Util.Streams.Raw;

Declare the Seek procedure to set the file read/write position


-----------------------------------------------------------------------
--  el-utils -- Utilities around EL
--  Copyright (C) 2011, 2012, 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.Unbounded;

with Util.Strings;
with Util.Beans.Basic;
with Util.Log.Loggers;

with EL.Objects;
with EL.Expressions;
with EL.Contexts.Default;
with EL.Contexts.Properties;
package body EL.Utils is

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

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("EL.Utils");

   --  ------------------------------
   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   --  ------------------------------
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class) is

      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object;

      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      procedure Process (Name : in String;
                         Item : in Util.Beans.Objects.Object);

      type Local_Resolver is new EL.Contexts.Properties.Property_Resolver with null record;

      --  Get the value associated with a base object and a given property.
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object;

      --  ------------------------------
      --  Get the value associated with a base object and a given property.
      --  ------------------------------
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object is
         pragma Unreferenced (Resolver);
      begin
         if Base /= null then
            return Base.Get_Value (To_String (Name));

         elsif Into.Exists (Name) then
            declare
               Value  : constant String := Into.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         elsif Source.Exists (Name) then
            declare
               Value  : constant String := Source.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end Get_Value;

      Recursion : Natural := 10;

      --  ------------------------------
      --  Expand (recursively) the EL expression defined in Value by using
      --  the context.  The recursion is provided by the above context resolver which
      --  invokes Expand if it detects that a value is a possible EL expression.
      --  ------------------------------
      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object is
         Expr   : EL.Expressions.Expression;
         Result : Util.Beans.Objects.Object;
      begin
         if Recursion = 0 then
            Log.Error ("Too many level of recursion when evaluating expression: {0}", Value);
            return Util.Beans.Objects.Null_Object;
         end if;

         Recursion := Recursion - 1;
         Expr := EL.Expressions.Create_Expression (Value, Context);
         Result := Expr.Get_Value (Context);
         Recursion := Recursion + 1;
         return Result;

         --  Ignore any exception and copy the value verbatim.
      exception
         when others =>
            Recursion := Recursion + 1;
            return Util.Beans.Objects.To_Object (Value);
      end Expand;

      Resolver       : aliased Local_Resolver;
      Local_Context  : aliased EL.Contexts.Default.Default_Context;

      --  ------------------------------
      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      --  ------------------------------
      procedure Process (Name : in String;
                         Item : in Util.Properties.Value) is
         Value : constant String := Util.Properties.To_String (Item);
      begin
         if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
            Log.Debug ("Adding config {0} = {1}", Name, Value);

            Into.Set_Value (Name, Item);
         else
            declare
               New_Value : constant Object := Expand (Value, Local_Context);
            begin
               Log.Debug ("Adding config {0} = {1}",
                          Name, Util.Beans.Objects.To_String (New_Value));
               if Util.Beans.Objects.Is_Null (New_Value) then
                  Into.Set (Name, "");
               else
                  Into.Set_Value (Name, New_Value);
               end if;
            end;
         end if;
      end Process;

   begin
      Resolver.Set_Properties (Source);
      Local_Context.Set_Function_Mapper (Context.Get_Function_Mapper);
      Local_Context.Set_Resolver (Resolver'Unchecked_Access);

      Source.Iterate (Process'Access);
   end Expand;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String is
      Expr   : EL.Expressions.Expression;
      Result : Util.Beans.Objects.Object;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      Result := Expr.Get_Value (Context);
      return Util.Beans.Objects.To_String (Result);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
      Expr   : EL.Expressions.Expression;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      return Expr.Get_Value (Context);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Util.Beans.Objects.To_Object (Value);
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when Util.Beans.Objects.TYPE_STRING | Util.Beans.Objects.TYPE_WIDE_STRING =>
            declare
               S    : constant String := Util.Beans.Objects.To_String (Value);
               Expr : EL.Expressions.Expression;
            begin
               Expr := EL.Expressions.Create_Expression (S, Context);
               return Expr.Get_Value (Context);
            end;

         when others =>
            return Value;
      end case;

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

end EL.Utils;

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

with Ada.Strings.Unbounded;

with Util.Strings;
with Util.Beans.Basic;
with Util.Log.Loggers;

with EL.Objects;
with EL.Expressions;
with EL.Contexts.Default;
with EL.Contexts.Properties;
package body EL.Utils is

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

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("EL.Utils");

   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class;
                     Copy    : in Boolean);

   --  ------------------------------
   --  Expand the properties stored in Source by evaluating the EL expressions
   --  used in the property values.  The EL context passed in Context can be used
   --  to specify the EL functions or some pre-defined beans that could be used.
   --  The EL context will integrate the source properties as well as properties stored
   --  in Into (only the Source properties will be evaluated).
   --  ------------------------------
   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class;
                     Copy    : in Boolean) is

      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object;

      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      procedure Process (Name : in String;
                         Item : in Util.Beans.Objects.Object);

      type Local_Resolver is new EL.Contexts.Properties.Property_Resolver with null record;

      --  Get the value associated with a base object and a given property.
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object;

      --  ------------------------------
      --  Get the value associated with a base object and a given property.
      --  ------------------------------
      overriding
      function Get_Value (Resolver : in Local_Resolver;
                          Context  : in EL.Contexts.ELContext'Class;
                          Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                          Name     : in Unbounded_String) return EL.Objects.Object is
         pragma Unreferenced (Resolver);
      begin
         if Base /= null then
            return Base.Get_Value (To_String (Name));

         elsif Into.Exists (Name) then
            declare
               Value  : constant String := Into.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         elsif Source.Exists (Name) then
            declare
               Value  : constant String := Source.Get (Name);
            begin
               if Util.Strings.Index (Value, '{') = 0 or Util.Strings.Index (Value, '}') = 0 then
                  return Util.Beans.Objects.To_Object (Value);
               end if;

               return Expand (Value, Context);
            end;

         else
            return Util.Beans.Objects.Null_Object;
         end if;
      end Get_Value;

      Recursion : Natural := 10;

      --  ------------------------------
      --  Expand (recursively) the EL expression defined in Value by using
      --  the context.  The recursion is provided by the above context resolver which
      --  invokes Expand if it detects that a value is a possible EL expression.
      --  ------------------------------
      function Expand (Value   : in String;
                       Context : in EL.Contexts.ELContext'Class) return EL.Objects.Object is
         Expr   : EL.Expressions.Expression;
         Result : Util.Beans.Objects.Object;
      begin
         if Recursion = 0 then
            Log.Error ("Too many level of recursion when evaluating expression: {0}", Value);
            return Util.Beans.Objects.Null_Object;
         end if;

         Recursion := Recursion - 1;
         Expr := EL.Expressions.Create_Expression (Value, Context);
         Result := Expr.Get_Value (Context);
         Recursion := Recursion + 1;
         return Result;

         --  Ignore any exception and copy the value verbatim.
      exception
         when others =>
            Recursion := Recursion + 1;
            return Util.Beans.Objects.To_Object (Value);
      end Expand;

      Resolver       : aliased Local_Resolver;
      Local_Context  : aliased EL.Contexts.Default.Default_Context;

      --  ------------------------------
      --  Copy the property identified by Name into the application config properties.
      --  The value passed in Item is expanded if it contains an EL expression.
      --  ------------------------------
      procedure Process (Name : in String;
                         Item : in Util.Properties.Value) is
         Value : constant String := Util.Properties.To_String (Item);
      begin
         if Util.Strings.Index (Value, '{') > 0 or else Util.Strings.Index (Value, '}') > 0 then
            declare
               New_Value : constant Object := Expand (Value, Local_Context);
            begin
               Log.Debug ("Adding config {0} = {1}",
                          Name, Util.Beans.Objects.To_String (New_Value));
               if Util.Beans.Objects.Is_Null (New_Value) then
                  Into.Set (Name, "");
               else
                  Into.Set_Value (Name, New_Value);
               end if;
            end;
         elsif Copy then
            Log.Debug ("Adding config {0} = {1}", Name, Value);

            Into.Set_Value (Name, Item);
         end if;
      end Process;

   begin
      Resolver.Set_Properties (Source);
      Local_Context.Set_Function_Mapper (Context.Get_Function_Mapper);
      Local_Context.Set_Resolver (Resolver'Unchecked_Access);

      Source.Iterate (Process'Access);
   end Expand;

   procedure Expand (Config  : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class) is
   begin
      Expand (Config, Config, Context, False);
   end Expand;

   procedure Expand (Source  : in Util.Properties.Manager'Class;
                     Into    : in out Util.Properties.Manager'Class;
                     Context : in EL.Contexts.ELContext'Class) is
   begin
      Expand (Source, Into, Context, True);
   end Expand;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return the
   --  string that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return String is
      Expr   : EL.Expressions.Expression;
      Result : Util.Beans.Objects.Object;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      Result := Expr.Get_Value (Context);
      return Util.Beans.Objects.To_String (Result);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in String;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
      Expr   : EL.Expressions.Expression;
   begin
      Expr := EL.Expressions.Create_Expression (Value, Context);
      return Expr.Get_Value (Context);

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Util.Beans.Objects.To_Object (Value);
   end Eval;

   --  ------------------------------
   --  Evaluate the possible EL expressions used in Value and return an
   --  object that correspond to that evaluation.
   --  ------------------------------
   function Eval (Value   : in Util.Beans.Objects.Object;
                  Context : in EL.Contexts.ELContext'Class) return Util.Beans.Objects.Object is
   begin
      case Util.Beans.Objects.Get_Type (Value) is
         when Util.Beans.Objects.TYPE_STRING | Util.Beans.Objects.TYPE_WIDE_STRING =>
            declare
               S    : constant String := Util.Beans.Objects.To_String (Value);
               Expr : EL.Expressions.Expression;
            begin
               Expr := EL.Expressions.Create_Expression (S, Context);
               return Expr.Get_Value (Context);
            end;

         when others =>
            return Value;
      end case;

      --  Ignore any exception and copy the value verbatim.
   exception
      when others =>
         return Value;
   end Eval;

end EL.Utils;

Implement Expand to replace properties in place and avoid unecessary copies