--
-- @filename module_interface.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 17.6.02
-- @brief Interface between SAX parser and the AdaDoc modules
--
-- History  :
-- Date     Modification               Author
--
with Ada.Text_IO; use Ada.Text_IO;
with Stack_ASM; -- Abstract State Machine of stack
with Module; use Module; -- AdaDoc modules
with Unicode.CES.Utf8; use Unicode.CES.Utf8;
with Unicode; use type Unicode.Unicode_Char;
with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;

with Ada.Integer_Text_IO;use Ada.Integer_Text_IO; 

package body Module_Interface is

   -- A stack to know where we are (what level) in the parsing
   package Stat_Stack is new Stack_ASM(Element_Type);

   -- A dictionnaries to stock the attributes (to be independent of SAX in the modules)
   Attributs : Dict_Type;

   -- Activate or not the processing (filtering and redirecting) of the datas
   Processing : Boolean := True;


   -- Convert string to Element_Type enumerate data type
   function Convert (S : String) return Element_Type is

      -- For use the Enumeration Get of Text_IO
      package Enum_Convert is new Ada.Text_IO.Enumeration_IO(Element_Type);

      Garbage : Positive; -- requiert by Get procedure
      Tmp : Element_Type;
   begin
      -- Add the "Is_" to be in accordance with the Element_Type
      Enum_Convert.Get("Is_"&S, Tmp, Garbage);
      return Tmp;
   exception
      when Data_Error => -- write the unknown element in current output
         New_Line(2);
         Put_Line("==========================================");
         Put("XML_Element_Name_Error : "); Put_Line(S);
         Put_Line("==========================================");
         raise XML_Element_Name_Error;
   end Convert;

   -- Set a module to our Sax.Readers.Reader derived object
   procedure Set_Module (Self : in out Object; Module_Instance : Module.Object_Access;
                         Dict_Tags : in Dict_Tda.Dict_Type; Options : String) is
   begin
      Self.Modul := Module_Instance;
      Self.Tags  := Dict_Tags; -- the optional user tags
      Initialize(Self.Modul.All, Options);
   end Set_Module;


   -- Convert SAX unicode string to Ada95 Latin1 string
   function Unicode_To_String(Item : Utf8_String) return String is
      String_Tmp : String(1..Length(Item));
      J : Positive := Item'First;
      Char : Unicode.Unicode_Char;
   
   begin
      for I in String_Tmp'Range loop
         Read(Item, J, Char);
         String_Tmp(I) := Character'Val(Char);
      end loop;
      return String_Tmp;
   end Unicode_To_String;
   
   -- Start_Element is a SAX callback called when a new XML element start
   procedure Start_Element (Self : in out Object;
                            Namespace_URI : Unicode.CES.Byte_Sequence := "";
                            Local_Name    : Unicode.CES.Byte_Sequence := "";
                            Qname         : Unicode.CES.Byte_Sequence := "";
                            Atts          : Sax.Attributes.Attributes'Class) is
   begin
      -- we do nothing if we are not in processing mode (for example: private part)
      if not Processing then
         return;
      end if;

      -- Create (convert) attributs list
      for J in 0 .. Sax.Attributes.Get_Length (Atts) - 1 loop
         Insert(Attributs, Sax.Attributes.Get_Qname (Atts, J),
                Unicode_To_String(Sax.Attributes.Get_Value (Atts, J)));
      end loop;

      -- Convert the SAX Qname and switch in accordance with element (see XSD diagram)
      case Convert(Qname) is

         -- Element root
         -- Call the only ans first callback to begin the output generating
         when Is_Package =>
            declare
               User_Dict : Dict_Type; -- dictionnary for the user tags

               -- Create the user tags from the general attributs
               procedure Update_Tags (Title, Value : String) is
               begin
                 if Exist(Attributs, Title) then
                     Insert(User_Dict, Value, Value_Of(Attributs, Title));
                 end if;
               end Update_Tags;
               procedure Update_User_Dict is new Run_Through(Update_Tags);

            begin
               Update_User_Dict(Self.Tags); -- Create (update) user tags
               Begin_Document(Self.Modul.All, Value_Of(Attributs, "name"),
                                                                   Attributs, User_Dict);
            end;

         -- Stop processing in the private element
         when Is_Private | Is_TaskPrivate | Is_ProtectedPrivate =>
            Processing := False; -- turn the processing OFF (reactivate in End_Element)

         --------------------------------------------------------------------------------
         -- All the elements group (sorted alphabetically)

         when Is_BasicObjects =>
            Start_Group(Self.Modul.All, Is_BasicObjects);

         when Is_Clauses =>
            Start_Group(Self.Modul.All, Is_Clauses);

         when Is_Components =>
            Start_Group(Self.Modul.All, Is_Components);

         when Is_ContextClauses =>
            Start_Group(Self.Modul.All, Is_ContextClauses);

         when Is_Definitions =>
            Start_Group(Self.Modul.All, Is_Definitions);

         when Is_Discriminants =>
            Start_Group(Self.Modul.all, Is_Discriminants);
            
         when Is_Entries =>
            Start_Group(Self.Modul.all, Is_Entries);            

         when Is_Exceptions =>
            Start_Group(Self.Modul.All, Is_Exceptions);

         when Is_GenericInstanciations =>
            Start_Group(Self.Modul.All, Is_GenericInstanciations);

         when Is_GenericParameters =>
            Start_Group(Self.Modul.All, Is_GenericParameters);

         when Is_Objects =>
            Start_Group(Self.Modul.All, Is_Objects);

         when Is_PackagesSubprograms =>
            Start_Group(Self.Modul.All, Is_PackagesSubprograms);

         when Is_Parameters =>
            Start_Group(Self.Modul.All, Is_Parameters);

         when Is_Pragmas =>
            Start_Group(Self.Modul.All, Is_Pragmas);

         when Is_ProtectedObjects =>
            Start_Group(Self.Modul.All, Is_ProtectedObjects);

         when Is_Records =>
            Start_Group(Self.Modul.All, Is_Records);

         when Is_Renames =>
            Start_Group(Self.Modul.All, Is_Renames);

         when Is_RepClauses =>
            Start_Group(Self.Modul.All, Is_RepClauses);

         when Is_SubpGenericParameters =>
            Start_Group(Self.Modul.All, Is_SubpGenericParameters);

         when Is_Subprograms =>
            Start_Group(Self.Modul.All, Is_Subprograms);

         when Is_Tasks =>
            Start_Group(Self.Modul.All, Is_Tasks);

         when Is_Types =>
            Start_Group(Self.Modul.All, Is_Types);

         when Is_UseClauses =>
            Start_Group(Self.Modul.All, Is_UseClauses);

         when Is_UseTypeClauses =>
            Start_Group(Self.Modul.All, Is_UseTypeClauses);


         --------------------------------------------------------------------------------
         -- Simple elements with only a name and attributs (sorted alphabetically)

         when Is_Clause =>
            A_Clause(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_Entry =>
            An_Entry(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_Exception =>
            An_Exception(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_GenericInstanciation =>
            A_Generic_Instance(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_PackageOrSubprogram =>
            A_Package_Subprogram_Gen(Self.Modul.All, Attributs,
                                                            Value_Of(Attributs, "name"));

         when Is_Pragma =>
            A_Pragma(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_ProtectedObject =>
            A_Protected_Object(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_Record =>
            A_Record(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_Rename =>
            A_Rename(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         when Is_Task =>
            A_Task(Self.Modul.All, Attributs, Value_Of(Attributs, "name"));

         --------------------------------------------------------------------------------
         -- Simple elements with specific value

         when Is_Choice =>
            A_Choice(Self.Modul.All, Attributs, Value_Of(Attributs, "choice"));

         when Is_VariantPart =>
            A_Variant_Part(Self.Modul.All,Attributs, Value_Of(Attributs,"discriminant"));

         --------------------------------------------------------------------------------
         -- Special elements with their paramters (see modules ads)

         when Is_Object => An_Object(Self.Modul.All, Attributs,
                                     Value_Of(Attributs, "name"),
                                     Value_Of(Attributs, "type"),
                                     Stat_Stack.Head = Is_Components);

         when Is_Typedef => A_Type_Definition(Self.Modul.All,
                                              Attributs,
                                              Value_Of(Attributs, "name"),
                                              Value_Of(Attributs, "declaration"));

         when Is_Parameter => A_Parameter(Self.Modul.All,
                                          Attributs,
                                          Value_Of(Attributs, "name"),
                                          Value_Of(Attributs, "type"),
                                          Value_Of(Attributs, "mode"));

         when Is_Procedure => A_Procedure(Self.Modul.All,
                                          Attributs,
                                          Value_Of(Attributs, "name"),
                                          Stat_Stack.Head = Is_ProtectedObject);

         when Is_Function => A_Function(Self.Modul.All,
                                        Attributs,
                                        Value_Of(Attributs, "name"),
                                        Value_Of(Attributs, "return"),
                                        Stat_Stack.Head = Is_ProtectedObject);
      end case;

      Stat_Stack.Push(Convert(Qname)); -- Push the current element

      Empty(Attributs);

   end Start_Element;


   -- End_Element is a SAX callback called when exit a XML element
   procedure End_Element  (Self : in out Object;
                           Namespace_URI : Unicode.CES.Byte_Sequence := "";
                           Local_Name    : Unicode.CES.Byte_Sequence := "";
                           Qname         : Unicode.CES.Byte_Sequence := "") is
   begin
      -- Only if processing we forward callback
      if Processing then
         End_Element(Self.Modul.All, Stat_Stack.Head);
         Stat_Stack.Pop;
      end if;

      case Convert(Qname) is
         when Is_Private | Is_TaskPrivate | Is_ProtectedPrivate => Processing := True; -- Exit the private element
         when others => null;
      end case;
   end End_Element;


   -- The only and last SAX callback
   procedure End_Document (Self : in out Object) is
   begin
      End_Document(Self.Modul.All); -- last callback

      -- Cleaning
      Stat_Stack.Empty;
      Empty(Attributs);
   end End_Document;


end Module_Interface;
