------------------------------------------------------------------------------
--                                                                          --
--                           GPR2 PROJECT MANAGER                           --
--                                                                          --
--                     Copyright (C) 2019-2024, AdaCore                     --
--                                                                          --
-- This is  free  software;  you can redistribute it and/or modify it under --
-- terms of the  GNU  General Public License as published by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  This software 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. 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, --
-- see <http://www.gnu.org/licenses/>.                                      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Exceptions;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with GNAT.OS_Lib;

with GNATCOLL.OS.Process;

with GPR2.Options;
with GPR2.Project.Registry.Attribute;
with GPR2.Project.Registry.Attribute.Description;
with GPR2.Project.Registry.Exchange;
with GPR2.Project.Registry.Pack;
with GPR2.Project.Registry.Pack.Description;

package body GPRinspect.External_Tools_Support is

   use Ada;
   use Ada.Strings.Unbounded;

   use GNAT;
   use GPR2;

   package PRP renames GPR2.Project.Registry.Pack;
   package PRPD renames GPR2.Project.Registry.Pack.Description;
   package PRA renames GPR2.Project.Registry.Attribute;
   package PRAD renames GPR2.Project.Registry.Attribute.Description;


   procedure Register_Legacy_Gnatcheck;
   --  Add support of gnatcheck tool not installed or not able to print
   --  registered data

   procedure Register_Legacy_Gnatprove;
   --  Add support of gnatprove tool not installed or not able to print
   --  registered data

   procedure Import_From_File (File : GPR2.Path_Name.Object);
   --  Import attribute definitions/documentation from provided file

   procedure Import_From_Tool
     (Tool_Name       : String;
      Legacy_Callback : access procedure := null);
   --  Import attributes from tool using --print-gpr-registry switch
   --  If tool not installed or not supporting switch use 'Legacy_Callback'.

   ------------------------------------
   -- Import_External_Tools_Registry --
   ------------------------------------

   procedure Import_External_Tools_Registry (File : GPR2.Path_Name.Object) is
   begin
      Import_From_File (File);
      Import_From_Tool ("gnatcheck", Register_Legacy_Gnatcheck'Access);
      Import_From_Tool ("gnatprove", Register_Legacy_Gnatprove'Access);
   end Import_External_Tools_Registry;

   ----------------------
   -- Import_From_File --
   ----------------------

   procedure Import_From_File (File : GPR2.Path_Name.Object) is
      use Ada.Exceptions;
   begin
      if File.Is_Defined and then File.Exists then
         declare
            Definitions : Unbounded_String;
            F           : Text_IO.File_Type;
         begin
            Text_IO.Open (F, Text_IO.In_File, File.String_Value);

            while not Text_IO.End_Of_File (F) loop
               Append (Definitions, Text_IO.Get_Line (F) & ASCII.LF);
            end loop;

            GPR2.Project.Registry.Exchange.Import (Definitions);
         exception
            when E : others =>
               Ada.Text_IO.Put_Line
                 ("Warning: Cannot import attribute registry from file: "
                  & Exception_Information (E));
         end;
      end if;
   end Import_From_File;

   ----------------------
   -- Import_From_Tool --
   ----------------------

   procedure Import_From_Tool
     (Tool_Name       : String;
      Legacy_Callback : access procedure := null)
   is
      use type GNAT.OS_Lib.String_Access;

      Exec_Name : GNAT.OS_Lib.String_Access :=
                    OS_Lib.Locate_Exec_On_Path (Tool_Name);
   begin
      if Exec_Name /= null then
         declare
            Args_Vector : GNATCOLL.OS.Process.Argument_List;
            Output      : Unbounded_String;
            Dummy       : Integer;
         begin
            Args_Vector.Append (Exec_Name.all);
            OS_Lib.Free (Exec_Name);
            Args_Vector.Append (GPR2.Options.Print_GPR_Registry_Option);

            Output := GNATCOLL.OS.Process.Run
              (Args        => Args_Vector,
               Stdin       => GNATCOLL.OS.Process.FS.Null_FD,
               Stderr      => GNATCOLL.OS.Process.FS.To_Stdout,
               Status      => Dummy);

            if Dummy = 0 then
               GPR2.Project.Registry.Exchange.Import (Output);
               return;
            end if;
         exception
            when E : others =>
               Ada.Text_IO.Put_Line
                 ("Warning: Cannot import attribute registry from " & Tool_Name
                  & " : " & Ada.Exceptions.Exception_Information (E));
         end;
      end if;

      --  If registry cannot be imported from tool use Legacy_Callback
      if Legacy_Callback /= null then
         Legacy_Callback.all;
      end if;
   end Import_From_Tool;

   -------------------------------
   -- Register_Legacy_Gnatcheck --
   -------------------------------

   procedure Register_Legacy_Gnatcheck is
      Check_Package          : constant Package_Id := +"Check";
      Check_Default_Switches : constant Q_Attribute_Id :=
                                 (Check_Package, +"Default_Switches");
      Check_Switches         : constant Q_Attribute_Id :=
                                 (Check_Package, +"Switches");
      Codepeer_Package       : constant Package_Id := +"Codepeer";
      Codepeer_File_Patterns : constant Q_Attribute_Id :=
                                 (Codepeer_Package, +"File_Patterns");
   begin
      if not PRP.Exists (Check_Package) then
         PRP.Add
           (Name     => Check_Package,
            Projects => PRP.Everywhere);
      end if;

      if PRPD.Get_Package_Description (Check_Package) = "" then
         PRPD.Set_Package_Description
           (Key         => Check_Package,
            Description =>
              "This package specifies the options used when "
            & "calling the checking tool gnatcheck. Its attribute "
            & "Default_Switches has the same semantics as for the package "
            & "Builder. The first string should always be -rules to specify "
            & "that all the other options belong to the -rules section of "
            & "the parameters to gnatcheck.");
      end if;

      if not PRA.Exists (Check_Default_Switches) then
         PRA.Add
           (Name                  => Check_Default_Switches,
            Index_Type            => PRA.Language_Index,
            Value                 => PRA.List,
            Value_Case_Sensitive  => True,
            Is_Allowed_In         => PRA.Everywhere,
            Config_Concatenable   => True);
      end if;

      if PRAD.Get_Attribute_Description (Check_Default_Switches) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Check_Default_Switches,
            Description =>
              "Index is a language name. Value is a "
            & "list of switches to be used when invoking 'gnatcheck' for a "
            & "source of the language, if there is no applicable attribute "
            & "Switches.");
      end if;

      if not PRA.Exists (Check_Switches) then
         PRA.Add
           (Name                  => Check_Switches,
            Index_Type            => PRA.Language_Index,
            Value                 => PRA.List,
            Value_Case_Sensitive  => True,
            Is_Allowed_In         => PRA.Everywhere,
            Index_Optional        => True,
            Config_Concatenable   => True);
      end if;

      if PRAD.Get_Attribute_Description (Check_Switches) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Check_Switches,
            Description =>
              "Index is a language name. Value is a "
            & "list of switches to be used when invoking 'gnatcheck' for a "
            & "source of the language, if there is no applicable attribute "
            & "Switches.");
      end if;

      if not PRP.Exists (Codepeer_Package) then
         PRP.Add
           (Name     => Codepeer_Package,
            Projects => PRP.Everywhere);
      end if;

      if PRPD.Get_Package_Description (Codepeer_Package) = "" then
         PRPD.Set_Package_Description
           (Key         => Codepeer_Package,
            Description =>
              "This package specifies the options used when "
            & "calling codepeer or calling gnatcheck with --simple-project "
            & "switch. Default_Switches has the same semantics as for the "
            & "package Builder. The first string should always be -rules to "
            & "specify that all the other options belong to the -rules "
            & "section of the parameters to gnatcheck.");
      end if;

      if not PRA.Exists (Codepeer_File_Patterns) then
         PRA.Add
           (Name                  => Codepeer_File_Patterns,
            Index_Type            => PRA.No_Index,
            Value                 => PRA.List,
            Value_Case_Sensitive  => True,
            Is_Allowed_In         => PRA.Everywhere);
      end if;

      if PRAD.Get_Attribute_Description (Codepeer_File_Patterns) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Codepeer_File_Patterns,
            Description =>
              "If you want to override ada default file "
            & "extensions (ada, ads, adb, spc & bdy), use this attribute "
            & "which includes a list of file patterns where you can specify "
            & "the following meta characters: * : matches any string of 0 "
            & "or more characters, ? : matches any character, "
            & " [list of chars] : matches any character listed, [char-char] "
            & ": matches any character in given range, [^list of chars] : "
            & "matches any character not listed. These patterns are case "
            & "insensitive.");
      end if;

   end Register_Legacy_Gnatcheck;

   -------------------------------
   -- Register_Legacy_Gnatprove --
   -------------------------------

   procedure Register_Legacy_Gnatprove is
      Prove_Package        : constant Package_Id := +"Prove";
      Prove_Switches       : constant Q_Attribute_Id :=
                               (Prove_Package, +"Switches");
      Prove_Proof_Switches : constant Q_Attribute_Id :=
                               (Prove_Package, +"Proof_Switches");
      Prove_Proof_Dir      : constant Q_Attribute_Id :=
                               (Prove_Package, +"Proof_Dir");
   begin
      if not PRP.Exists (Prove_Package) then
         PRP.Add
           (Name     => Prove_Package,
            Projects => PRP.Everywhere);
      end if;

      if PRPD.Get_Package_Description (Prove_Package) = "" then
         PRPD.Set_Package_Description
           (Key         => Prove_Package,
            Description =>
              "This package specifies the options used when "
            & "calling gnatprove");
      end if;

      if not PRA.Exists (Prove_Proof_Switches) then
         PRA.Add
           (Name                  => Prove_Proof_Switches,
            Index_Type            => PRA.FileGlob_Or_Language_Index,
            Value                 => PRA.List,
            Value_Case_Sensitive  => False,
            Is_Allowed_In         => PRA.Everywhere);
      end if;

      if PRAD.Get_Attribute_Description (Prove_Proof_Switches) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Prove_Proof_Switches,
            Description =>
              "Defines additional command line switches that "
            & "are used for the invokation of GNATprove. Only the following "
            & "switches are allowed for file-specific switches: --steps, "
            & "--timeout, --memlimit, --proof, --prover, --level, --mode, "
            & "--counterexamples, --no-inlining, --no-loop-unrolling");
      end if;

      if not PRA.Exists (Prove_Switches) then
         PRA.Add
           (Name                  => Prove_Switches,
            Index_Type            => PRA.No_Index,
            Value                 => PRA.List,
            Value_Case_Sensitive  => False,
            Is_Allowed_In         => PRA.Everywhere);
      end if;

      if PRAD.Get_Attribute_Description (Prove_Switches) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Prove_Switches,
            Description =>
              "This deprecated attribute is the same as "
            & "Proof_Switches (""Ada"").");
      end if;

      if not PRA.Exists (Prove_Proof_Dir) then
         PRA.Add
           (Name                  => Prove_Proof_Dir,
            Index_Type            => PRA.No_Index,
            Value                 => PRA.Single,
            Value_Case_Sensitive  => True,
            Is_Allowed_In         => PRA.Everywhere);
      end if;

      if PRAD.Get_Attribute_Description (Prove_Proof_Dir) = "" then
         PRAD.Set_Attribute_Description
           (Key         => Prove_Proof_Dir,
            Description =>
              "Defines the directory where are stored the "
            & "files concerning the state of the proof of a project. This "
            & "directory contains a sub-directory sessions with one "
            & "directory per source package analyzed for proof. Each of "
            & "these package directories contains a Why3 session file. If a "
            & "manual prover is used to prove some VCs, then a "
            & "sub-directory called by the name of the prover is created "
            & "next to sessions, with the same organization of "
            & "sub-directories. Each of these package directories contains "
            & "manual proof files. Common proof files to be used across "
            & "various proofs can be stored at the toplevel of the "
            & "prover-specific directory.");
      end if;
   end Register_Legacy_Gnatprove;

end GPRinspect.External_Tools_Support;
