------------------------------------------------------------------------------
--                     XML/Ada - An XML suite for Ada95                     --
--                                                                          --
--                     Copyright (C) 2005-2012, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  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 MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Unicode;               use Unicode;
with Unicode.CES;           use Unicode.CES;
with Ada.Unchecked_Deallocation;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Sax.Encodings;         use Sax.Encodings;

package body Sax.Models is

   function To_String (Model : element_model) return Unicode.CES.byte_sequence;
   --  Same as To_String, applies to an Element_Model_Ptr

   ---------
   -- Ref --
   ---------

   procedure Ref (Model : content_model) is
   begin
      if Model.Ref_Count /= null then
         Model.Ref_Count.all := Model.Ref_Count.all + 1;
      end if;
   end Ref;

   -----------
   -- Unref --
   -----------

   procedure Unref (Model : in out content_model) is
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
        (Natural,
         natural_access);
   begin
      if Model.Ref_Count /= null and then Model.Ref_Count.all > 0 then
         Model.Ref_Count.all := Model.Ref_Count.all - 1;
         if Model.Ref_Count.all = 0 then
            Unchecked_Free (Model.Ref_Count);
            Free (Model.Model);
         end if;
      end if;
   end Unref;

   ------------------
   -- Create_Model --
   ------------------

   function Create_Model (Element : element_model_ptr) return content_model is
   begin
      if Element = null then
         return Unknown_Model;
      else
         return (Model => Element, Ref_Count => new Natural'(1));
      end if;
   end Create_Model;

   -----------------------
   -- Get_Element_Model --
   -----------------------

   function Get_Element_Model
     (Model : content_model) return element_model_ptr
   is
   begin
      return Model.Model;
   end Get_Element_Model;

   --------------
   -- Is_Mixed --
   --------------

   function Is_Mixed (M : element_model_ptr) return Boolean is
   begin
      pragma assert (M /= null);
      return M.Content = any_of
        and then M.List (M.List'first).Content = character_data;
   end Is_Mixed;

   ---------------
   -- To_String --
   ---------------

   function To_String
     (Model : content_model) return Unicode.CES.byte_sequence
   is
   begin
      if Model.Model = null then
         return "";
      else
         return To_String (Model.Model.all);
      end if;
   end To_String;

   ---------------
   -- To_String --
   ---------------

   function To_String
     (Model : element_model) return Unicode.CES.byte_sequence
   is
      Str : Unbounded_String;
   begin
      case Model.Content is
         when character_data =>
            return Pcdata_Sequence;

         when empty =>
            return Empty_Sequence;

         when anything =>
            return Any_Sequence;

         when element_ref =>
            return Sax.Symbols.Get (Model.Name).all;

         when any_of | sequence =>
            for J in Model.List'range loop
               if Model.List (J).Content = character_data then
                  if Model.Content = sequence
                    or else J /= Model.List'first
                  then
                     raise Invalid_Content_Model;
                  end if;
               end if;

               if Model.List (J).Content = anything
                 or else Model.List (J).Content = empty
               then
                  raise Invalid_Content_Model;
               end if;

               Append (Str, To_String (Model.List (J).all));
               if J /= Model.List'last then
                  if Model.Content = any_of then
                     Append (Str, Vertical_Line_Sequence);
                  else
                     Append (Str, Comma_Sequence);
                  end if;
               end if;
            end loop;
            return Opening_Parenthesis_Sequence &
              To_String (Str) &
              Closing_Parenthesis_Sequence;

         when repeat =>
            if Model.Elem.Content = anything
              or else Model.Elem.Content = empty
            then
               raise Invalid_Content_Model;
            end if;

            if Model.Min = 0 and then Model.Max = Positive'last then
               return To_String (Model.Elem.all) & Star_Sequence;
            elsif Model.Min = 0 and then Model.Max = 1 then
               return To_String (Model.Elem.all) & Question_Mark_Sequence;
            elsif Model.Min = 1 and then Model.Max = Positive'last then
               return To_String (Model.Elem.all) & Plus_Sign_Sequence;
            else
               raise Invalid_Content_Model;
            end if;
      end case;
   end To_String;

   ----------
   -- Free --
   ----------

   procedure Free (Model : in out element_model_ptr) is
      procedure Free is new Ada.Unchecked_Deallocation
        (element_model_array,
         element_model_array_ptr);
      procedure Internal is new Ada.Unchecked_Deallocation
        (element_model,
         element_model_ptr);
   begin
      if Model /= null then
         case Model.Content is
            when character_data | anything | empty | element_ref =>
               null;
            when any_of | sequence =>
               for J in Model.List'range loop
                  Free (Model.List (J));
               end loop;
               Free (Model.List);
            when repeat =>
               Free (Model.Elem);
         end case;
         Internal (Model);
      end if;
   end Free;

end Sax.Models;