------------------------------------------------------------------------------
--                                                                          --
--                            GNAT2XML COMPONENTS                           --
--                                                                          --
--                    G N A T 2 X M L . X M L 2 G N A T                     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2012-2016, AdaCore                     --
--                                                                          --
-- Gnat2xml 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 2,  or  (at your option)  any later --
-- version. Gnat2xml is distributed  in the hope  that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MER-      --
-- CHANTABILITY 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 distributed with GNAT; see file COPYING. If   --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
-- Boston, MA 02111-1307, USA.                                              --
-- The gnat2xml tool was derived from the Avatox sources.                   --
------------------------------------------------------------------------------

pragma Ada_2012;

--  This program translates xml files generated by gnat2xml back into Ada
--  for testing purposes. The command line contains a list of the same Ada
--  files passed to gnat2xml. The xml files are assumed to be in an 'xml'
--  subdirectory of the directory in which the Ada source files are. So for
--  example, if the Ada source file is some/dir/mumble.adb, then the xml file
--  is found in some/dir/xml/mumble.adb.xml.

--  Output goes into subdirectories "generated_ada" and "self_rep" of the
--  output directory, which is the current directory by default, but can
--  be overridden with --output-dir=dir on the command line.

with ASIS_UL.Options;

with Ada.Wide_Text_IO; use Ada;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Directories;  use Ada.Directories;

with Namet; use Namet;

with ASIS_UL.Formatted_Output; use ASIS_UL.Formatted_Output;
with Ada_Trees;                use Ada_Trees;
with Gnat2xml.Xml2tree;        use Gnat2xml.Xml2tree;
with Ada_Trees.Formatting;     use Ada_Trees.Formatting;
with Ada_Trees.Self_Rep;       use Ada_Trees.Self_Rep;

with Pp.Formatting; use Pp.Formatting;

procedure Gnat2xml.Xml2gnat is

   Verbose_Mode : Boolean renames ASIS_UL.Options.Verbose_Mode;

   Output_Dir : Name_Id := Name_Find (Current_Directory);
   --  Default is current directory; can be overridden by --output-dir=dir
   --  switch. Output goes in subdirectories of Output_Dir.

   Self_Rep_Subdir      : constant String := "self_rep";
   Generated_Ada_Subdir : constant String := "generated_ada";

   procedure Do_Nothing
     (Original_Source_Name,
      Xml_File_Name,
      Self_Rep_Name,
      Regen_Ada_Name,
      Generated_Ada_Name : String) is null;

   procedure Generate_Ada
     (Original_Source_Name,
      Xml_File_Name,
      Self_Rep_Name,
      Regen_Ada_Name,
      Generated_Ada_Name : String);

   procedure Iter_File_Names
     (Action : not null access procedure
        (Original_Source_Name,
         Xml_File_Name,
         Self_Rep_Name,
         Regen_Ada_Name,
         Generated_Ada_Name : String));

   procedure Generate_Ada
     (Original_Source_Name,
      Xml_File_Name,
      Self_Rep_Name,
      Regen_Ada_Name,
      Generated_Ada_Name : String)
   is
      Tree : constant Ada_Tree := Read_Xml (Xml_File_Name);

      Self_Rep_File, Regen_Ada_File : Wide_Text_IO.File_Type;

   begin
      if not Debug_Mode then
         if Verbose_Mode then
            Put ("Creating \1\n", Self_Rep_Name);
         end if;
         Parallel_Make_Dir (Containing_Directory (Self_Rep_Name));
         Wide_Text_IO.Create (Self_Rep_File, Name => Self_Rep_Name);
         Wide_Text_IO.Set_Output (Self_Rep_File);
      end if;

      Put_Self_Rep (Tree);

      if not Debug_Mode then
         Wide_Text_IO.Set_Output (Wide_Text_IO.Standard_Output);
         Wide_Text_IO.Close (Self_Rep_File);
      end if;

      if not Debug_Mode then
         if Verbose_Mode then
            Put ("Creating \1\n", Regen_Ada_Name);
         end if;
         Parallel_Make_Dir (Containing_Directory (Regen_Ada_Name));
         Wide_Text_IO.Create (Regen_Ada_File, Name => Regen_Ada_Name);
         Wide_Text_IO.Set_Output (Regen_Ada_File);
      end if;

      Put ("--  Created by xml2gnat\n\n");
      Put_Regen_Ada (Tree);

      if not Debug_Mode then
         Wide_Text_IO.Set_Output (Wide_Text_IO.Standard_Output);
         Wide_Text_IO.Close (Regen_Ada_File);
      end if;

      if not Debug_Mode then
         if Verbose_Mode then
            Put ("Creating \1\n", Generated_Ada_Name);
         end if;
         Parallel_Make_Dir (Containing_Directory (Generated_Ada_Name));
      end if;

      if False then -- ???Messes up the diff's.
         Put ("--  Created by xml2gnat\n\n");
      end if;

      declare
         Options : constant Formatting_Options :=
           (Reformat_Comment_Block => True,
            Decimal_Grouping => 3,
            Based_Grouping => 4,
            others => <>);
      begin
         Tree_To_Ada (Tree, Original_Source_Name, Options,
                      Output_Name => Generated_Ada_Name);
      end;

      Format_Debug_Output ("Generate_Ada");

      Free_Tree (Tree);
   end Generate_Ada;

   procedure Iter_File_Names
     (Action : not null access procedure
        (Original_Source_Name,
         Xml_File_Name,
         Self_Rep_Name,
         Regen_Ada_Name,
         Generated_Ada_Name : String))
   is
   begin
      for X in 1 .. Argument_Count loop
         if Has_Prefix (Argument (X), Prefix => "-") then
            if Argument (X) = "--debug" then
               Debug_Mode := True;

            elsif Argument (X) = "-v" then
               Verbose_Mode := True;

            elsif Has_Prefix (Argument (X), Prefix => "--output-dir=") then
               Output_Dir :=
                 Name_Find
                   (Full_Name
                      (Strip_Prefix
                         (Argument (X),
                          Prefix => "--output-dir=")));

            else
               raise Program_Error with "unknown switch";
            end if;

         else
            declare
               Original_Source_Name : constant String := Argument (X);
               --  for example, "some/directory/some-package.adb"

               Original_Source_Dir : constant String :=
                 Containing_Directory (Original_Source_Name);
               --  for example, "some/directory"

               Xml_Dir : constant String :=
                 Compose
                   (Containing_Directory => Original_Source_Dir,
                    Name                 => "xml");
               --  for example, "some/directory/xml"

               Xml_File_Name : constant String :=
                 Compose
                   (Containing_Directory => Xml_Dir,
                    Name                 => Simple_Name (Original_Source_Name),
                    Extension            => "xml");
               --  for example, "some/directory/xml/some-package.adb.xml"

               Self_Rep_Name : constant String :=
                 Compose
                   (Containing_Directory =>
                      Compose (Get_Name_String (Output_Dir), Self_Rep_Subdir),
                    Name      => Simple_Name (Original_Source_Name),
                    Extension => "self_rep.ada");
               --  for example, "./self_rep/some-package.adb.self_rep.ada"

               Regen_Ada_Name : constant String :=
                 Compose
                   (Containing_Directory =>
                      Compose (Get_Name_String (Output_Dir), Self_Rep_Subdir),
                    Name      => Simple_Name (Original_Source_Name),
                    Extension => "regen_ada.ada");
               --  for example, "./self_rep/some-package.adb.regen_ada.ada"

               Generated_Ada_Name : constant String :=
                 Compose
                   (Containing_Directory =>
                      Compose
                        (Get_Name_String (Output_Dir),
                         Generated_Ada_Subdir),
                    Name => Simple_Name (Original_Source_Name));
            --  for example, "./generated_ada/some-package.adb"

            begin
               --  We don't want to overwrite the original source code, and
               --  Generated_Ada_Name is the same name. Note that in --debug
               --  mode, we don't write any files.

               if not Debug_Mode
                 and then Generated_Ada_Name = Original_Source_Name
               then
                  raise Program_Error
                    with "output file same as input: " & Generated_Ada_Name;
               end if;

               Action
                 (Original_Source_Name,
                  Xml_File_Name,
                  Self_Rep_Name,
                  Regen_Ada_Name,
                  Generated_Ada_Name);
            end;
         end if;
      end loop;
   end Iter_File_Names;

--  Start of processing for Xml2gnat

begin
   if Argument_Count = 0 then
      raise Program_Error with "missing arguments";
   end if;

   --  Go through all the files doing nothing, first, to check that we're not
   --  overwriting any sources. Also to pick up a "--debug" switch.

   Iter_File_Names (Do_Nothing'Access);

   --  Now go through again, this time doing the real work

   Iter_File_Names (Generate_Ada'Access);

   Main_Done := True;
end Gnat2xml.Xml2gnat;
