File : soap/soap-types.adb


------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                         Copyright (C) 2000-2003                          --
--                                ACT-Europe                                --
--                                                                          --
--  Authors: Dmitriy Anisimkov - Pascal Obry                                --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, or (at   --
--  your option) any later version.                                         --
--                                                                          --
--  This library is distributed in the hope that it will be useful, but     --
--  WITHOUT ANY WARRANTY; without even the implied warranty of              --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

--  $Id: soap-types.adb,v 1.28 2003/12/31 16:00:53 obry Exp $

with Ada.Long_Float_Text_IO;
with Ada.Long_Long_Float_Text_IO;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Tags;
with Ada.Task_Attributes;
with Ada.Unchecked_Deallocation;

with AWS.Utils;
with GNAT.Calendar.Time_IO;

with SOAP.Utils;

package body SOAP.Types is

   use Ada;

   procedure Free is
      new Ada.Unchecked_Deallocation (Object_Set, Object_Set_Access);

   procedure Free is
      new Ada.Unchecked_Deallocation (Natural, Counter_Access);

   function xsi_type (Name : in String) return String;
   pragma Inline (xsi_type);
   --  Returns the xsi:type field for the XML type representation whose name
   --  is passed as argument.

   function Spaces (N : in Natural) return String;
   pragma Inline (Spaces);
   --  Returns N * 3 spaces.

   package XML_Indent is new Ada.Task_Attributes (Natural, 0);
   --  Thread safe Indentation counter.

   ---------
   -- "+" --
   ---------

   function "+" (O : in Object'Class) return Object_Safe_Pointer is
   begin
      return (Finalization.Controlled with new Object'Class'(O));
   end "+";

   -------
   -- - --
   -------

   function "-" (O : in Object_Safe_Pointer) return Object'Class is
   begin
      return O.O.all;
   end "-";

   -------
   -- A --
   -------

   function A
     (V    : in Object_Set;
      Name : in String)
      return SOAP_Array is
   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name),
                     new Natural'(1), new Object_Set'(V));
   end A;

   ------------
   -- Adjust --
   ------------

   procedure Adjust (O : in out Object_Safe_Pointer) is
   begin
      if O.O /= null then
         O.O := new Object'Class'(O.O.all);
      end if;
   end Adjust;

   procedure Adjust (O : in out Composite) is
   begin
      O.Ref_Counter.all := O.Ref_Counter.all + 1;
   end Adjust;

   -------
   -- B --
   -------

   function B
     (V    : in Boolean;
      Name : in String  := "item")
      return XSD_Boolean is
   begin
      return (Finalization.Controlled with To_Unbounded_String (Name), V);
   end B;

   ---------
   -- B64 --
   ---------

   function B64
     (V      : in String;
      Name   : in String  := "item")
      return SOAP_Base64 is
   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name), To_Unbounded_String (V));
   end B64;

   -------
   -- D --
   -------

   function D
     (V    : in Long_Long_Float;
      Name : in String          := "item")
      return XSD_Double is
   begin
      return (Finalization.Controlled with To_Unbounded_String (Name), V);
   end D;

   -------
   -- E --
   -------

   function E
     (V         : in String;
      Type_Name : in String;
      Name      : in String := "item")
      return SOAP_Enumeration is
   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name),
                     To_Unbounded_String (V),
                     To_Unbounded_String (Type_Name));
   end E;

   -------
   -- F --
   -------

   function F
     (V    : in Long_Float;
      Name : in String := "item")
      return XSD_Float is
   begin
      return (Finalization.Controlled with To_Unbounded_String (Name), V);
   end F;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (O : in out Object_Safe_Pointer) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object'Class, Object_Access);
   begin
      if O.O /= null then
         Free (O.O);
      end if;
   end Finalize;

   procedure Finalize (O : in out Composite) is
   begin
      O.Ref_Counter.all := O.Ref_Counter.all - 1;

      if O.Ref_Counter.all = 0 then
         Free (O.O);
         Free (O.Ref_Counter);
      end if;
   end Finalize;

   ---------
   -- Get --
   ---------

   function Get (O : in Object'Class) return Integer is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_Integer'Tag then
         return V (XSD_Integer (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "Integer expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return Long_Float is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_Float'Tag then
         return V (XSD_Float (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "Float expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return Long_Long_Float is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_Double'Tag then
         return V (XSD_Double (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "Double expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return String is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_String'Tag then
         return V (XSD_String (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "String expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return Unbounded_String is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_String'Tag then
         return V (XSD_String (O));
      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "String expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return Boolean is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_Boolean'Tag then
         return V (XSD_Boolean (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "Boolean expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return Ada.Calendar.Time is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.XSD_Time_Instant'Tag then
         return V (XSD_Time_Instant (O));

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "timeInstant expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return SOAP_Base64 is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.SOAP_Base64'Tag then
         return SOAP_Base64 (O);

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "SOAP Base64 expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return SOAP_Record is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.SOAP_Record'Tag then
         return SOAP_Record (O);

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "SOAP Struct expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   function Get (O : in Object'Class) return SOAP_Array is
      use type Ada.Tags.Tag;
   begin
      if O'Tag = Types.SOAP_Array'Tag then
         return SOAP_Array (O);

      else
         Exceptions.Raise_Exception
           (Data_Error'Identity,
            "SOAP Array expected, found " & Tags.Expanded_Name (O'Tag));
      end if;
   end Get;

   -------
   -- I --
   -------

   function I
     (V    : in Integer;
      Name : in String := "item")
     return XSD_Integer is
   begin
      return (Finalization.Controlled with To_Unbounded_String (Name), V);
   end I;

   -----------
   -- Image --
   -----------

   function Image (O : in Object) return String is
      pragma Warnings (Off, O);
   begin
      return "";
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_Integer) return String is
      V : constant String := Integer'Image (O.V);
   begin
      if O.V >= 0 then
         return V (V'First + 1 .. V'Last);
      else
         return V;
      end if;
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_Float) return String is
      use Ada;

      Result : String (1 .. Long_Float'Width);
   begin
      Long_Float_Text_IO.Put (Result, O.V, Exp => 0);
      return Strings.Fixed.Trim (Result, Strings.Both);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_Double) return String is
      use Ada;

      Result : String (1 .. Long_Long_Float'Width);
   begin
      Long_Long_Float_Text_IO.Put (Result, O.V, Exp => 0);
      return Strings.Fixed.Trim (Result, Strings.Both);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_String) return String is
   begin
      return To_String (O.V);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_Boolean) return String is
   begin
      if O.V then
         return "1";
      else
         return "0";
      end if;
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in XSD_Time_Instant) return String is

      function Image (Timezone : in TZ) return String;
      --  Returns Image for the TZ

      -----------
      -- Image --
      -----------

      function Image (Timezone : in TZ) return String is

         subtype Str2 is String (1 .. 2);

         function I2D (N : in Natural) return Str2;
         --  Returns N image with 2 characters padding with 0 is needed

         ---------
         -- I2D --
         ---------

         function I2D (N : Natural) return Str2 is
            V : constant String := Natural'Image (N);
         begin
            if N > 9 then
               return V (V'First + 1 .. V'Last);
            else
               return '0' & V (V'First + 1 .. V'Last);
            end if;
         end I2D;

      begin
         if Timezone = 0 then
            return "Z";
         elsif Timezone >= 0 then
            return '+' & I2D (Timezone) & ":00";
         else
            return '-' & I2D (abs Timezone) & ":00";
         end if;
      end Image;

   begin
      return GNAT.Calendar.Time_IO.Image (O.T, "%Y-%m-%dT%H:%M:%S")
        & Image (O.Timezone);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in SOAP_Base64) return String is
   begin
      return To_String (O.V);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in SOAP_Array) return String is
      Result : Unbounded_String;
   begin
      Append (Result, '(');

      for K in O.O'Range loop
         Append (Result, Integer'Image (K));
         Append (Result, " => ");
         Append (Result, Image (O.O (K).O.all));

         if K /= O.O'Last then
            Append (Result, ", ");
         end if;
      end loop;

      Append (Result, ')');

      return To_String (Result);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in SOAP_Record) return String is
      Result : Unbounded_String;
   begin
      Append (Result, '(');

      for K in O.O'Range loop
         Append (Result, Name (O));
         Append (Result, " => ");
         Append (Result, Image (O.O (K).O.all));

         if K /= O.O'Last then
            Append (Result, ", ");
         end if;
      end loop;

      Append (Result, ')');

      return To_String (Result);
   end Image;

   -----------
   -- Image --
   -----------

   function Image (O : in SOAP_Enumeration) return String is
   begin
      return To_String (O.V);
   end Image;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (O : in out Composite) is
   begin
      O.Ref_Counter := new Natural'(1);
   end Initialize;

   -------
   -- N --
   -------

   function N (Name : in String  := "item") return XSD_Null is
   begin
      return (Finalization.Controlled with Name => To_Unbounded_String (Name));
   end N;

   ----------
   -- Name --
   ----------

   function Name (O : in Object'Class) return String is
   begin
      return To_String (O.Name);
   end Name;

   -------
   -- R --
   -------

   function R
     (V    : in Object_Set;
      Name : in String;
      Type_Name : in String := "")
      return SOAP_Record
   is
      function T_Name return String;
      pragma Inline (T_Name);
      --  Returns Type_Name is not empty and Name otherwise

      ------------
      -- T_Name --
      ------------

      function T_Name return String is
      begin
         if Type_Name = "" then
            return Name;
         else
            return Type_Name;
         end if;
      end T_Name;

   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name),
                new Natural'(1), new Object_Set'(V),
                To_Unbounded_String (T_Name));
   end R;

   -------
   -- S --
   -------

   function S
     (V    : in String;
      Name : in String := "item")
      return XSD_String
   is
      L_V : constant String := Utils.To_Utf8 (V);
   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name), To_Unbounded_String (L_V));
   end S;

   function S
     (V      : in Unbounded_String;
      Name   : in String  := "item")
      return XSD_String is
   begin
      return (Finalization.Controlled
              with To_Unbounded_String (Name), Utils.To_Utf8 (V));
   end S;

   ----------
   -- Size --
   ----------

   function Size (O : in SOAP_Array) return Natural is
   begin
      return O.O'Length;
   end Size;

   ------------
   -- Spaces --
   ------------

   function Spaces (N : in Natural) return String is
      use Ada.Strings.Fixed;
   begin
      return (3 * N) * ' ';
   end Spaces;

   -------
   -- T --
   -------

   function T
     (V        : in Calendar.Time;
      Name     : in String        := "item";
      Timezone : in TZ            := GMT)
      return XSD_Time_Instant is
   begin
      return (Finalization.Controlled
                with To_Unbounded_String (Name), V, Timezone);
   end T;

   -------
   -- V --
   -------

   function V (O : in XSD_Integer) return Integer is
   begin
      return O.V;
   end V;

   function V (O : in XSD_Float) return Long_Float is
   begin
      return O.V;
   end V;

   function V (O : in XSD_Double) return Long_Long_Float is
   begin
      return O.V;
   end V;

   function V (O : in XSD_String) return String is
   begin
      return Utils.From_Utf8 (To_String (O.V));
   end V;

   function V (O : in XSD_String) return Unbounded_String is
   begin
      return Utils.From_Utf8 (O.V);
   end V;

   function V (O : in XSD_Boolean) return Boolean is
   begin
      return O.V;
   end V;

   function V (O : in XSD_Time_Instant) return Calendar.Time is
   begin
      return O.T;
   end V;

   function V (O : in SOAP_Base64) return String is
   begin
      return To_String (O.V);
   end V;

   function V (O : in SOAP_Enumeration) return String is
   begin
      return To_String (O.V);
   end V;

   function V (O : in SOAP_Array) return Object_Set is
   begin
      return O.O.all;
   end V;

   function V (O : in SOAP_Array; N : in Positive) return Object'Class is
   begin
      return O.O (N).O.all;
   end V;

   function V (O : in SOAP_Record; Name : in String) return Object'Class is
   begin
      for K in O.O'Range loop
         if Types.Name (O.O (K).O.all) = Name then
            return O.O (K).O.all;
         end if;
      end loop;

      Exceptions.Raise_Exception
        (Types.Data_Error'Identity,
         "(V) Struct object " & Name & " not found");
   end V;

   function V (O : in SOAP_Record) return Object_Set is
   begin
      return O.O.all;
   end V;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in Object) return String is
      Indent : constant Natural      := XML_Indent.Value;
      OC     : constant Object'Class := Object'Class (O);
   begin
      if OC in XSD_String then
         return Spaces (Indent)
           & "<" & Name (OC) & xsi_type (XML_Type (OC)) & '>'
           & Utils.Encode (Image (OC))
           & "</" & Name (OC) & '>';
      else
         return Spaces (Indent)
           & "<" & Name (OC) & xsi_type (XML_Type (OC)) & '>'
           & Image (OC)
           & "</" & Name (OC) & '>';
      end if;
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Integer) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Float) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Double) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_String) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Boolean) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Time_Instant) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in XSD_Null) return String is
      Indent : constant Natural := XML_Indent.Value;
      OC     : constant Object'Class := Object'Class (O);
   begin
      return Spaces (Indent) & "<" & Name (OC) & " xsi_null=""1""/>";
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in SOAP_Base64) return String is
   begin
      return XML_Image (Object (O));
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   New_Line : constant String := ASCII.CR & ASCII.LF;

   function XML_Image (O : in SOAP_Array) return String is

      Indent : constant Natural := XML_Indent.Value;

      function Array_Type return String;
      --  Returns the right SOAP array type.

      ----------------
      -- Array_Type --
      ----------------

      function Array_Type return String is
         use type Ada.Tags.Tag;

         T : Ada.Tags.Tag;
      begin
         --  Empty array

         if O.O'Length = 0 then
            --  This is a zero length array, type is undefined.
            return XML_Undefined;
         end if;

         T := O.O (O.O'First).O'Tag;

         --  Array with record components

         if T = SOAP_Record'Tag then
            --  This is a record, check if array is composed of only records
            --  having the same name.

            declare
               Name : constant String
                 := Types.XML_Type (O.O (O.O'First).O.all);
            begin
               --  For all remaining elements

               for K in O.O'First + 1 .. O.O'Last loop
                  if O.O (K).O'Tag /= SOAP_Record'Tag
                    or else Name /= Types.XML_Type (O.O (K).O.all)
                  then
                     return XML_Undefined;
                  end if;
               end loop;

               --  The array is composed of only records having the same
               --  name. Use this name for the array component type.
               return "awsns:" & Name;
            end;
         end if;

         --  All other cases

         for K in O.O'First + 1 .. O.O'Last loop

            --  Not same type if type different or is a composite type.

            if T /= O.O (K).O'Tag
              or else O.O (K).O.all in SOAP.Types.Composite'Class
            then
               return XML_Undefined;
            end if;

         end loop;

         --  We have the same type for all items

         return XML_Type (O.O (O.O'First).O.all);
      end Array_Type;

      Result : Unbounded_String;
   begin
      --  Open array element

      Append (Result, Spaces (Indent));
      Append (Result, '<');
      Append (Result, O.Name);
      Append (Result, " SOAP-ENC:arrayType=""");
      Append (Result, Array_Type);
      Append (Result, '[');
      Append (Result, AWS.Utils.Image (O.O'Length));
      Append (Result, "]""");
      Append (Result, xsi_type (XML_Array));
      Append (Result, '>');
      Append (Result, New_Line);

      --  Add all elements

      XML_Indent.Set_Value (Indent + 1);

      for K in O.O'Range loop
         Append (Result, XML_Image (O.O (K).O.all));
         Append (Result, New_Line);
      end loop;

      XML_Indent.Set_Value (Indent);

      --  End array element

      Append (Result, Spaces (Indent));
      Append (Result, Utils.Tag (To_String (O.Name), Start => False));

      return To_String (Result);
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in SOAP_Record) return String is
      Indent : constant Natural := XML_Indent.Value;
      Result : Unbounded_String;
   begin
      Append (Result, Spaces (Indent));

      if Name (O) = XML_Type (O) then
         --  The name and the type are identical, we do not have to specify
         --  the xsi:type in this case.
         Append (Result, Utils.Tag (Name (O), Start => True));

      else
         Append (Result, "<" & Name (O)
                   & " xsi:type=""awsns:" & XML_Type (O) & """>");
      end if;

      Append (Result, New_Line);

      XML_Indent.Set_Value (Indent + 1);

      for K in O.O'Range loop
         Append (Result, XML_Image (O.O (K).O.all));
         Append (Result, New_Line);
      end loop;

      XML_Indent.Set_Value (Indent);

      Append (Result, Spaces (Indent));
      Append (Result, Utils.Tag (Name (O), Start => False));

      return To_String (Result);
   end XML_Image;

   ---------------
   -- XML_Image --
   ---------------

   function XML_Image (O : in SOAP_Enumeration) return String is
   begin
      return Spaces (XML_Indent.Value) & "<" & Name (O)
        & " type=""" & To_String (O.Type_Name) & """>"
        & To_String (O.V)
        & Utils.Tag (Name (O), Start => False);
   end XML_Image;

   --------------
   -- XML_Type --
   --------------

   function XML_Type (O : in Object) return String is
      pragma Warnings (Off, O);
   begin
      return "";
   end XML_Type;

   function XML_Type (O : in XSD_Integer) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Int;
   end XML_Type;

   function XML_Type (O : in XSD_Float) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Float;
   end XML_Type;

   function XML_Type (O : in XSD_Double) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Double;
   end XML_Type;

   function XML_Type (O : in XSD_String) return String is
      pragma Warnings (Off, O);
   begin
      return XML_String;
   end XML_Type;

   function XML_Type (O : in XSD_Boolean) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Boolean;
   end XML_Type;

   function XML_Type  (O : in XSD_Time_Instant) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Time_Instant;
   end XML_Type;

   function XML_Type (O : in XSD_Null) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Null;
   end XML_Type;

   function XML_Type (O : in SOAP_Base64) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Base64;
   end XML_Type;

   function XML_Type (O : in SOAP_Array) return String is
      pragma Warnings (Off, O);
   begin
      return XML_Array;
   end XML_Type;

   function XML_Type  (O : in SOAP_Record) return String is
   begin
      return To_String (O.Type_Name);
   end XML_Type;

   function XML_Type (O : in SOAP_Enumeration) return String is
   begin
      return To_String (O.Type_Name);
   end XML_Type;

   --------------
   -- xsi_type --
   --------------

   function xsi_type (Name : in String) return String is
   begin
      return " xsi:type=""" & Name & '"';
   end xsi_type;

end SOAP.Types;