--  dh_ada_library, helper for Ada libraries Debian maintainers
--
--  Copyright (C) 2012-2016 Nicolas Boulenguez <nicolas@debian.org>
--
--  This program 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 3 of the
--  License, or (at your option) any later version.
--  This program 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 program. If not, see <http://www.gnu.org/licenses/>.

with Ada.Directories;

with GNAT.OS_Lib;

with GPR.Conf;
with GPR.Err;
with GPR.Ext;
with GPR.Names;
with GPR.Snames;
with GPR.Tree;
with GPR.Util;

package body Projects is

   Default_Cgpr : constant String := "/usr/share/dh_ada_library/default_cgpr";

   use type GNAT.OS_Lib.String_Access;
   use type GPR.Name_Id;
   use type GPR.Path_Name_Type;
   use type GPR.Lib_Kind;
   use type GPR.Naming_Exception_Type;
   use type GPR.Project_Id;
   use type GPR.Project_List;
   use type GPR.Source_Kind;
   use type GPR.Source_Id;
   use type GPR.String_List_Id;
   use type GPR.Variable_Kind;
   use type GPR.Variable_Value;

   Project_Tree_Data      : aliased GPR.Project_Tree_Data;
   Project_Node_Tree_Data : aliased GPR.Project_Node_Tree_Data;
   Project_Id             :         GPR.Project_Id := GPR.No_Project;

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

   function Initialized return Boolean is (Project_Id /= GPR.No_Project);

   function Externally_Built
     return Boolean
   is
   begin
      return Project_Id.all.Externally_Built;
   end Externally_Built;

   function Dynamic
     return Boolean
   is
   begin
      case Project_Id.all.Library_Kind is
         when GPR.Dynamic | GPR.Relocatable =>
            return True;
         when GPR.Static | GPR.Static_Pic =>
            return False;
      end case;
   end Dynamic;

   function Is_Library
     return Boolean
   is
   begin
      return Project_Id.all.Library;
   end Is_Library;

   procedure Iterate_On_Ali_Files
     (Process : not null access procedure (Path : in String))
   is
      Source_Iterator : GPR.Source_Iterator;
      Source_Id       : GPR.Source_Id;
   begin
      Source_Iterator := GPR.For_Each_Source (Project_Tree_Data'Access,
                                              Project => Project_Id,
                                              Language => GPR.Snames.Name_Ada,
                                              Locally_Removed => False);
      loop
         Source_Id := GPR.Element (Source_Iterator);
         exit when Source_Id = GPR.No_Source;
         --  Separate bodies have no Spec, Impl or ALI file.
         --  ALI files are named after the body file if any, else
         --  after the specification file.
         if (Source_Id.all.Kind = GPR.Impl
               or (Source_Id.all.Kind = GPR.Spec
                     and GPR.Other_Part (Source_Id) = GPR.No_Source))
           and Source_Id.all.Replaced_By = GPR.No_Source
         then
            declare
               Name : String := Ada.Directories.Simple_Name
                 (GPR.Names.Get_Name_String (Source_Id.all.Path.Name));
            begin
               pragma Assert (Name (Name'Last - 3 .. Name'Last) = ".ads"
                                or Name (Name'Last - 3 .. Name'Last) = ".adb");
               Name (Name'Last - 1 .. Name'Last) := "li";
               Process.all (GPR.Names.Get_Name_String
                              (Project_Id.all.Object_Directory.Name)
                              & '/' & Name);
            end;
         end if;
         GPR.Next (Source_Iterator);
      end loop;
   end Iterate_On_Ali_Files;

   procedure Iterate_On_Imported_Projects
     (Process : not null access procedure
        (Imported_Full_File_Name : in String;
         Imported_Library_Name   : in String))
   is
      Project_List : GPR.Project_List;
      Import       : GPR.Project_Id;
   begin
      Project_List := Project_Id.all.Imported_Projects;
      while Project_List /= null loop
         Import := Project_List.all.Project;
         if Import.all.Library then
            Process.all (GPR.Names.Get_Name_String (Import.all.Path.Name),
                         GPR.Names.Get_Name_String (Import.all.Library_Name));
         else
            Process.all (GPR.Names.Get_Name_String (Import.all.Name), "");
         end if;
         Project_List := Project_List.all.Next;
      end loop;
   end Iterate_On_Imported_Projects;

   procedure Iterate_On_Library_Options
     (Process : not null access procedure (Option : in String))
   is
      Lib_Opts_Attrs : constant array (Positive range <>) of GPR.Name_Id
        := (GPR.Snames.Name_Leading_Library_Options,
            GPR.Snames.Name_Library_Options);
      Variable_Value : GPR.Variable_Value;
      String_List_Id : GPR.String_List_Id;
      Shared : constant GPR.Shared_Project_Tree_Data_Access
        := Project_Tree_Data.Shared;
   begin
      for Attribute_Name of Lib_Opts_Attrs loop
         Variable_Value := GPR.Util.Value_Of
           (Variable_Name => Attribute_Name,
            In_Variables  => Project_Id.all.Decl.Attributes,
            Shared        => Shared);
         if not Variable_Value.Default then
            pragma Assert (Variable_Value.Project = Project_Id);
            pragma Assert (Variable_Value.Kind = GPR.List);
            String_List_Id := Variable_Value.Values;
            while String_List_Id /= GPR.Nil_String loop
               declare
                  String_Element : constant GPR.String_Element
                    := Shared.all.String_Elements.Table.all (String_List_Id);
               begin
                  Process.all
                    (GPR.Names.Get_Name_String (String_Element.Value));
                  String_List_Id := String_Element.Next;
               end;
            end loop;
         end if;
      end loop;
   end Iterate_On_Library_Options;

   procedure Iterate_On_Naming_Exceptions
     (Process : not null access procedure (Unit    : in String;
                                           File    : in String;
                                           Is_Body : in Boolean))
   is
      Source_Iterator : GPR.Source_Iterator;
      Source_Id       : GPR.Source_Id;
   begin
      Source_Iterator := GPR.For_Each_Source (Project_Tree_Data'Access,
                                              Project => Project_Id,
                                              Locally_Removed => False);
      loop
         Source_Id := GPR.Element (Source_Iterator);
         exit when Source_Id = GPR.No_Source;
         if Source_Id.all.Naming_Exception /= GPR.No
           and Source_Id.all.Replaced_By = GPR.No_Source
         then
            Process.all
              (GPR.Names.Get_Name_String (Source_Id.all.Unit.all.Name),
               GPR.Names.Get_Name_String (Source_Id.all.File),
               Source_Id.all.Kind /= GPR.Spec);
         end if;
         GPR.Next (Source_Iterator);
      end loop;
   end Iterate_On_Naming_Exceptions;

   procedure Iterate_On_Sources
     (Process : not null access procedure (Path   : in String;
                                           In_Ada : in Boolean))
   is
      Source_Iterator : GPR.Source_Iterator;
      Source_Id       : GPR.Source_Id;
   begin
      Source_Iterator := GPR.For_Each_Source (Project_Tree_Data'Access,
                                              Project => Project_Id,
                                              Locally_Removed => False);
      loop
         Source_Id := GPR.Element (Source_Iterator);
         exit when Source_Id = GPR.No_Source;
         if Source_Id.all.Replaced_By = GPR.No_Source then
            Process.all
              (GPR.Names.Get_Name_String (Source_Id.all.Path.Name),
               Source_Id.all.Language.all.Name = GPR.Snames.Name_Ada);
         end if;
         GPR.Next (Source_Iterator);
      end loop;
   end Iterate_On_Sources;

   function Library_Dir
     return String
   is
   begin
      return GPR.Names.Get_Name_String (Project_Id.all.Library_Dir.Name);
   end Library_Dir;

   function Library_Name
     return String
   is
   begin
      return GPR.Names.Get_Name_String (Project_Id.all.Library_Name);
   end Library_Name;

   procedure Parse
     (Assignments : in     Assignment_Vectors.Vector;
      File_Name   : in     String)
   is
      Insignificant_String_Access     : GNAT.OS_Lib.String_Access;
      Unsavory_Project_Node_Id        : GPR.Project_Node_Id;
      Environment                     : GPR.Tree.Environment;
      Spiceless_Boolean               : Boolean;
      Processing_Flags : constant GPR.Processing_Flags := GPR.Create_Flags
        (Report_Error               => null,
         When_No_Sources            => GPR.Error,
         Require_Sources_Other_Lang => True, --  False for gnatmake
         Allow_Duplicate_Basenames  => False,
         Compiler_Driver_Mandatory  => False, --  True for gprbuild
         Error_On_Unknown_Language  => True,
         Require_Obj_Dirs           => GPR.Error,
         Allow_Invalid_External     => GPR.Error,
         Missing_Source_Files       => GPR.Error,
         Ignore_Missing_With        => False,
         Check_Configuration_Only   => False);
   begin
      if Project_Id = GPR.No_Project then
         GPR.Snames.Initialize;
         GPR.Initialize (Project_Tree_Data'Access);
         GPR.Tree.Initialize (Project_Node_Tree_Data'Access);
      end if;

      GPR.Tree.Initialize (Environment, Processing_Flags);
      for Aff in 1 .. Natural (Assignment_Vectors.Length (Assignments)) loop
         GPR.Ext.Add (Environment.External,
                      Assignment_Vectors.Element (Assignments, Aff).Name,
                      Assignment_Vectors.Element (Assignments, Aff).Value);
      end loop;

      GPR.Conf.Parse_Project_And_Apply_Config
        (Main_Project               => Project_Id,
         User_Project_Node          => Unsavory_Project_Node_Id,
         Config_File_Name           => Default_Cgpr,
         Autoconf_Specified         => False,
         Project_File_Name          => File_Name,
         Project_Tree               => Project_Tree_Data'Access,
         Project_Node_Tree          => Project_Node_Tree_Data'Access,
         Env                        => Environment,
         Packages_To_Check          => GPR.All_Packages,
         Allow_Automatic_Generation => False,
         Automatically_Generated    => Spiceless_Boolean,
         Config_File_Path           => Insignificant_String_Access,
         Normalized_Hostname        => "");
      if Project_Id = GPR.No_Project then
         raise Parse_Error with '"' & File_Name & '"';
      end if;
      GNAT.OS_Lib.Free (Insignificant_String_Access);
      GPR.Tree.Free (Environment);
      pragma Assert (not Spiceless_Boolean);
      GPR.Err.Finalize;
   exception
      When others =>
         Project_Id := GPR.No_Project;
         GNAT.OS_Lib.Free (Insignificant_String_Access);
         GPR.Tree.Free (Environment);
         GPR.Err.Finalize;
         raise;
   end Parse;

end Projects;
