--
--  Copyright (C) 2021-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

--  This package contains LAL_Tools utilities to be used by refactoring
--  rename tools.

with Ada.Containers; use Ada.Containers;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Holders;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Ordered_Maps;
with Ada.Containers.Ordered_Sets;

with GNATCOLL.Projects;

with GPR2;

with Langkit_Support.Text; use Langkit_Support.Text;

private with Ada.Strings.Wide_Wide_Unbounded;

package LAL_Refactor.Safe_Rename is

   type Rename_Problem is abstract new Refactoring_Diagnostic with private
     with Type_Invariant'Class => Check_Rename_Problem (Rename_Problem);

   function Check_Rename_Problem
     (Problem : Rename_Problem'Class)
      return Boolean
     with Inline;

   overriding
   function Filename (Self : Rename_Problem) return String;

   overriding
   function Location (Self : Rename_Problem) return Source_Location_Range;

   type Problem_Finder_Algorithm_Kind is (Map_References, Analyse_AST);

   type Attribute_Value_Provider_Access is access
     function
       (Attribute    : GNATCOLL.Projects.Attribute_Pkg_String;
        Index        : String := "";
        Default      : String := "";
        Use_Extended : Boolean := False) return String;

   type GPR2_Attribute_Value_Provider_Access is access
     function
       (Attribute    : GPR2.Q_Attribute_Id;
        Index        : String := "";
        Default      : String := "";
        Use_Extended : Boolean := False) return String;

   type Safe_Renamer is new Refactoring_Tool with private;

   function Create_Safe_Renamer
     (Definition               : Defining_Name'Class;
      New_Name                 : Unbounded_Text_Type;
      Algorithm                : Problem_Finder_Algorithm_Kind;
      Attribute_Value_Provider : Attribute_Value_Provider_Access := null)
      return Safe_Renamer
     with Pre => not Definition.Is_Null;

   function Create_Safe_Renamer
     (Definition               : Defining_Name'Class;
      New_Name                 : Unbounded_Text_Type;
      Algorithm                : Problem_Finder_Algorithm_Kind;
      Attribute_Value_Provider : GPR2_Attribute_Value_Provider_Access := null)
      return Safe_Renamer
     with Pre => not Definition.Is_Null;
   --  Safe_Renamer constructor.
   --  Creates a `Safe_Renamer` object that renames all references of
   --  `Definition` to `New_Name`.
   --  Uses the `Algorithm` kind to search for problems causes by the rename.
   --  Uses Attribute_Value_Provider to compute source file names when top
   --  level declarations are renamed, with the exception of top level
   --  declarations in an analysis unit with multiple compilation units.
   --  In that case, the source name must be hardcoded in the gpr file so it
   --  does not need to be renamed.

   overriding
   function Refactor
     (Self           : Safe_Renamer;
      Analysis_Units : access function return Analysis_Unit_Array)
      return Refactoring_Edits;
   --  Finds all references of the definition we want to rename and checks for
   --  problems caused by renaming such references.
   --  If the definition we want to rename is a primitive subrogram of a type,
   --  then the return refereces include references of supbprograms that it is
   --  overriding or that is being overridden by.
   --  If the definition we want to rename is a parameter of a subprogram
   --  that is a primitive of a type, then the returned refereces include
   --  parameter spec references of supbprograms that it is overriding or that
   --  is being overridden by.

private

   type New_Name_Type is record
      Original : Unbounded_Text_Type;
      Lower    : Unbounded_Text_Type;
   end record;

   function "=" (New_Name : New_Name_Type; Name : Text_Type) return Boolean;

   type Rename_Problem is abstract new Refactoring_Diagnostic with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : Unbounded_Text_Type;
         Conflicting_Id       : Name;
      end record;

   type Casing_Type is (lowercase, uppercase, mixedcase);

   type Naming_Scheme_Type is
      record
         Casing          : Casing_Type;
         Dot_Replacement : Unbounded_String;
         Spec_Suffix     : Unbounded_String;
         Body_Suffix     : Unbounded_String;
      end record;

   function Create_Naming_Scheme
     (Attribute_Value_Provider : not null GPR2_Attribute_Value_Provider_Access)
      return Naming_Scheme_Type;

   function Create_Naming_Scheme
     (Attribute_Value_Provider : not null Attribute_Value_Provider_Access)
     return Naming_Scheme_Type;
   --  Naming_Scheme_Type constructor.
   --  The formal parameters have the same meaning as the corresponding
   --  attributes in the Naming package of a .gpr project file.

   function Is_Valid (Self : Naming_Scheme_Type) return Boolean;
   --  Checks if Self is valid, i.e., not equal to Invalid_Naming_Scheme.

   Invalid_Naming_Scheme : constant Naming_Scheme_Type :=
     (Casing          => lowercase,
      Dot_Replacement => Null_Unbounded_String,
      Spec_Suffix     => Null_Unbounded_String,
      Body_Suffix     => Null_Unbounded_String);

   Default_Naming_Scheme : constant Naming_Scheme_Type :=
     (Casing          => lowercase,
      Dot_Replacement => To_Unbounded_String ("-"),
      Spec_Suffix     => To_Unbounded_String (".ads"),
      Body_Suffix     => To_Unbounded_String (".adb"));

   type Missing_Reference is new Rename_Problem with null record;

   overriding
   function Info (Self : Missing_Reference) return String;
   --  Returns a human readable message with the description of Self.

   type New_Reference is new Rename_Problem with null record;

   overriding
   function Info (Self : New_Reference) return String;
   --  Returns a human readable message with the description of Self.

   type Name_Collision is new Rename_Problem with null record;

   overriding
   function Info (Self : Name_Collision) return String;
   --  Returns a human readable message with the description of Self.

   type Overriding_Subprogram is new Rename_Problem with null record;

   overriding
   function Info (Self : Overriding_Subprogram) return String;
   --  Returns a human readable message with the description of Self.

   type Hiding_Name is new Rename_Problem with null record;

   overriding
   function Info (Self : Hiding_Name) return String;
   --  Returns a human readable message with the description of Self.

   type Hidden_Name is new Rename_Problem with null record;

   overriding
   function Info (Self : Hidden_Name) return String;
   --  Returns a human readable message with the description of Self.

   type Problem_Finder_Algorithm is limited interface;

   function Find (Self : in out Problem_Finder_Algorithm)
                  return Refactoring_Diagnostic_Vector is abstract;
   --  Finds problems caused by renaming a definition.

   function "<" (Left, Right : Source_Location_Range)
                    return Boolean;
   --  Starts by comparing if both Left and Right start lines. If equal, start
   --  columns are compared.

   package Slocs_Sets is new Ada.Containers.Ordered_Sets
     (Element_Type => Source_Location_Range,
      "<"          => "<");

   package Slocs_Maps is new
     Ada.Containers.Ordered_Maps
       (Key_Type     => Positive,
        Element_Type => Slocs_Sets.Set,
        "="          => Slocs_Sets."=");

   function "<" (Left, Right : Analysis_Unit) return Boolean is
     (Left.Get_Filename < Right.Get_Filename);

   package Unit_Slocs_Maps is new Ada.Containers.Ordered_Maps
     (Key_Type     => Analysis_Unit,
      Element_Type => Slocs_Maps.Map,
      "<"          => "<",
      "="          => Slocs_Maps."=");

   package Unit_Buffers is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => Analysis_Unit,
      Element_Type    => Unbounded_String,
      Hash            => Hash,
      Equivalent_Keys => "=");

   type Unit_Slocs_Maps_Diff is
      record
         Minus : Unit_Slocs_Maps.Map;
         Plus  : Unit_Slocs_Maps.Map;
      end record;

   type Reference_Mapper (Units_Length : Integer) is new
     Problem_Finder_Algorithm with
      record
         Canonical_Definition      : Defining_Name;
         Canonical_Definition_Unit : Analysis_Unit;
         Canonical_Definition_Sloc : Source_Location_Range;
         Units                     : Analysis_Unit_Array (1 .. Units_Length);
         Original_Name             : Unbounded_Text_Type;
         New_Name                  : Unbounded_Text_Type;
         Original_References       : Unit_Slocs_Maps.Map;
         New_References            : Unit_Slocs_Maps.Map;
         Temporary_Buffers         : Unit_Buffers.Map;
         References_Diff           : Unit_Slocs_Maps_Diff;
      end record;

   procedure Initialize
     (Self                 : out Reference_Mapper;
      Canonical_Definition : Defining_Name;
      New_Name             : Unbounded_Text_Type;
      Original_References  : Unit_Slocs_Maps.Map;
      Units                : Analysis_Unit_Array)
     with Pre => not Ada.Strings.Wide_Wide_Unbounded."="
                       (New_Name,
                        Ada.Strings.Wide_Wide_Unbounded.
                          Null_Unbounded_Wide_Wide_String)
                 and then not Canonical_Definition.Is_Null
                 and then Canonical_Definition.P_Canonical_Part =
                            Canonical_Definition;
   --  Initializes the Reference_Mapper algorithm by filling its elements
   --  with the necessary information to perform the Find function.

   overriding
   function Find (Self : in out Reference_Mapper)
                  return Refactoring_Diagnostic_Vector;
   --  Finds problems caused by renaming a definition. The strategy of this
   --  algorithm is to compare references before and after the rename.
   --  IMPORTANT NOTE: This function reparses all analysis units given to the
   --  Initialize procedure. All active references of nodes created before
   --  running thiss function will then be unreferenced.

   procedure Update_Canonical_Definition (Self : in out Reference_Mapper);
   --  Self.Parse_Temporary_Buffers which will invalidate all nodes.
   --  This procedure restores the canonical definition that the algorithm is\
   --  checking for rename problems.

   procedure Parse_Temporary_Buffers (Self : in out Reference_Mapper);
   --  For every unit, parses a temporary buffer with all the references
   --  renamed.

   procedure Parse_Original_Buffers (Self : in out Reference_Mapper);
   --  For every unit, parses it's original buffer.

   procedure Diff (Self : in out Reference_Mapper);
   --  Creates a diff between the original references and the new references
   --  after the rename is applied. Some references can be lost and some
   --  can be gained, therefore, they are stored seperately.

   type AST_Analyser (Units_Length : Integer) is new
     Problem_Finder_Algorithm with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
         Units                : Analysis_Unit_Array (1 .. Units_Length);
         References           : Base_Id_Vectors.Vector;
      end record;

   procedure Initialize
     (Self                 : out AST_Analyser;
      Canonical_Definition : Defining_Name;
      New_Name             : Unbounded_Text_Type;
      References           : Base_Id_Vectors.Vector;
      Units                : Analysis_Unit_Array)
     with Pre => not Ada.Strings.Wide_Wide_Unbounded."="
                       (New_Name,
                        Ada.Strings.Wide_Wide_Unbounded.
                          Null_Unbounded_Wide_Wide_String)
                 and then not Canonical_Definition.Is_Null
                 and then Canonical_Definition.P_Canonical_Part
                          = Canonical_Definition;
   --  Initializes the Reference_Mapper algorithm by filling its elements
   --  with the necessary information to perform the Find function.

   overriding
   function Find
     (Self : in out AST_Analyser)
      return Refactoring_Diagnostic_Vector;
   --  Finds problems caused by renaming a definition. The strategy of this
   --  algorithm is to analyse the AST and look for specific problems.

   package Rename_Problem_Indefinite_Holders is new
     Ada.Containers.Indefinite_Holders (Rename_Problem'Class);

   subtype Rename_Problem_Indefinite_Holder is
     Rename_Problem_Indefinite_Holders.Holder;

   type Specific_Problem_Finder_Result (Success : Boolean) is
      record
         case Success is
            when True =>
               null;
            when False =>
               Problem : Rename_Problem_Indefinite_Holder;
         end case;
      end record;

   function Create_Rename_Problem
     (Problem : Rename_Problem'Class)
      return Specific_Problem_Finder_Result
     with Post => Create_Rename_Problem'Result.Success = False;

   No_Rename_Problem : constant Specific_Problem_Finder_Result :=
     Specific_Problem_Finder_Result'(Success => True);

   type Specific_Problem_Finder is interface;

   function Find
     (Self : Specific_Problem_Finder)
      return Specific_Problem_Finder_Result is abstract;
   --  Finds specific problems caused by renaming a definition

   package Specific_Rename_Problem_Finder_Vectors is new
     Ada.Containers.Indefinite_Vectors
       (Index_Type   => Natural,
        Element_Type => Specific_Problem_Finder'Class);

   type Name_Collision_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Name_Collision_Finder)
      return Specific_Problem_Finder_Result;
   --  Find name collisions created by a rename operation in the same scope.

   type Enum_Name_Collision_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Enum_Name_Collision_Finder)
      return Specific_Problem_Finder_Result;
   --  Find name collisions created by a rename operation of an enum literal

   type Collision_With_Compilation_Unit_Finder (Units_Length : Integer) is new
     Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
         Units                : Analysis_Unit_Array (1 .. Units_Length);
      end record;

   overriding
   function Find
     (Self : Collision_With_Compilation_Unit_Finder)
      return Specific_Problem_Finder_Result;
   --  Find name collisions with a compilation unit created by a rename
   --  operation.
   --  Example: Is package Foo has a definition Bar, and a child compilation
   --  unit Foo.Baz, then renaming Bar to Baz creates a collision that is
   --  detected by this function.

   type Compilation_Unit_Collision_Finder (Units_Length : Integer) is new
     Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
         Units                : Analysis_Unit_Array (1 .. Units_Length);
      end record;

   overriding
   function Find
     (Self : Compilation_Unit_Collision_Finder)
      return Specific_Problem_Finder_Result;
 --  Find name collisions between a compilation units created by a rename
 --  operation.

   type Subp_Overriding_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Subp_Overriding_Finder)
      return Specific_Problem_Finder_Result;
   --  Checks if renaming a subprogram will start overriding another one.
   --  TODO: Also check if it will start being overriden.

   type Param_Spec_Collision_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
         Reference            : Base_Id := No_Base_Id;
      end record;

   overriding
   function Find
     (Self : Param_Spec_Collision_Finder)
      return Specific_Problem_Finder_Result;
   --  Checks if renaming a Param_Spec will cause a conflict with its type.

   type Name_Hiding_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Name_Hiding_Finder)
      return Specific_Problem_Finder_Result;
   --  Checks if renaming a definition will start hiding another one.

   type Subtype_Indication_Collision_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         References           : Base_Id_Vectors.Vector;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Subtype_Indication_Collision_Finder)
      return Specific_Problem_Finder_Result;
   --  Renaming a rype operation will also rename its references in
   --  subtype indications of subprograms specs. This function checks if
   --  renaming such references will cause a collision with its paramater.

   type Name_Hidden_Finder is new Specific_Problem_Finder with
      record
         Canonical_Definition : Defining_Name;
         References           : Base_Id_Vectors.Vector;
         New_Name             : New_Name_Type;
      end record;

   overriding
   function Find
     (Self : Name_Hidden_Finder)
      return Specific_Problem_Finder_Result;
   --  Checks if renaming a definition will make it hidden by another one

   type Safe_Renamer is new Refactoring_Tool with
      record
         --  Canonical Defining_Name that we want to rename
         Canonical_Definition          : Defining_Name;
         New_Name                      : Unbounded_Text_Type;
         Algorithm                     : Problem_Finder_Algorithm_Kind;
         Naming_Scheme                 : Naming_Scheme_Type;
         Attribute_Value_Provider      : Attribute_Value_Provider_Access;
         GPR2_Attribute_Value_Provider : GPR2_Attribute_Value_Provider_Access;
      end record;

   procedure Add_References_To_Edits
     (Self       : Safe_Renamer;
      References : Base_Id_Vectors.Vector;
      Edits      : in out Refactoring_Edits);
   --  Adds `References` to `Edits`

   function Is_Top_Level_Decl
     (Self : Safe_Renamer;
      Decl : Basic_Decl'Class)
      return Boolean;
   --  True if `Decl` is a unit top level declaration.
   --  These are the only declarations that lead to also renaming the source
   --  file.

   procedure Add_Files_Rename_To_Edits
     (Self       : Safe_Renamer;
      References : Base_Id_Vectors.Vector;
      Edits      : in out Refactoring_Edits)
     with Pre => Self.Is_Top_Level_Decl
                   (Self.Canonical_Definition.P_Basic_Decl);
   --  Iterates through all parts of `Self.Canonical_Definition` and adds the
   --  necessary file renames to `Edits`.

end LAL_Refactor.Safe_Rename;
