rejuvenation_23.0.0_507c1f00/src/rejuvenation-text_rewrites.adb

with Ada.Assertions; use Ada.Assertions;
with Ada.Strings;    use Ada.Strings;
--  Debug includes:
--  with Ada.Strings.Fixed;       use Ada.Strings.Fixed;
--  with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
with Ada.Text_IO;             use Ada.Text_IO;
with Rejuvenation.File_Utils; use Rejuvenation.File_Utils;
with Rejuvenation.Navigation; use Rejuvenation.Navigation;

package body Rejuvenation.Text_Rewrites is

   -- Public: Collect rewrite operation (node) --------
   function Prepend
     (TR     : in out Text_Rewrite; Node : Ada_Node'Class; Text : String;
      Before :        Node_Location := No_Trivia; Charset : String := "")
      return Boolean
   is
      First : constant Positive         := Start_Offset (Node, Before);
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      Assert
        (Check   => TR.Is_Initialized,
         Message => "Text Rewrite used uninitialized");
      Assert
        (Check   => Is_Reflexive_Ancestor (TR.Get_Unit.Root, Node),
         Message =>
           "Text Rewrite does not contain provided Node - " &
           Langkit_Support.Text.Image (Node.Text));
      Assert
        (Check   => TR.First <= First,
         Message => "Text Rewrite - prepend before part");
      return Replace (TR, First, First - 1, WText);
   end Prepend;

   function Append
     (TR    : in out Text_Rewrite; Node : Ada_Node'Class; Text : String;
      After :        Node_Location := No_Trivia; Charset : String := "")
      return Boolean
   is
      Last  : constant Positive         := End_Offset (Node, After);
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      Assert
        (Check   => TR.Is_Initialized,
         Message => "Text Rewrite used uninitialized");
      Assert
        (Check   => Is_Reflexive_Ancestor (TR.Get_Unit.Root, Node),
         Message =>
           "Text Rewrite Node does not contain provided Node - " &
           Langkit_Support.Text.Image (Node.Text));
      Assert
        (Check   => Last <= TR.Last,
         Message => "Text Rewrite - append after part");
      return Replace (TR, Last + 1, Last, WText);
   end Append;

   procedure Remove
     (TR     : in out Text_Rewrite; Node : Ada_Node'Class;
      Before : Node_Location := No_Trivia; After : Node_Location := No_Trivia)
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Remove (Node, Before, After);
   end Remove;

   procedure Prepend
     (TR     : in out Text_Rewrite; Node : Ada_Node'Class; Text : String;
      Before :        Node_Location := No_Trivia; Charset : String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Prepend (Node, Text, Before, Charset);
   end Prepend;

   procedure Append
     (TR    : in out Text_Rewrite; Node : Ada_Node'Class; Text : String;
      After :        Node_Location := No_Trivia; Charset : String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Append (Node, Text, After, Charset);
   end Append;

   procedure Replace
     (TR : in out Text_Rewrite; Node : Ada_Node'Class; Text : String;
      Before, After :    Node_Location := No_Trivia; Charset : String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Replace (Node, Text, Before, After, Charset);
   end Replace;

   procedure Restore (TR : in out Text_Rewrite; Node : Ada_Node'Class) is
      Dummy : Boolean;
   begin
      Dummy := TR.Restore (Node);
   end Restore;

   procedure ReplaceAround
     (TR : in out Text_Rewrite; Node : Ada_Node'Class; Before_Text : String;
      Innernode :        Ada_Node'Class; After_Text : String;
      Before : Node_Location := No_Trivia; After : Node_Location := No_Trivia;
      Charset   :        String        := "")
   is
      NodeStartOffset : constant Positive := Start_Offset (Node, Before);
      NodeEndOffset   : constant Positive := End_Offset (Node, After);

      InnernodeStartOffset : constant Positive :=
        Start_Offset (Innernode, Before);
      InnernodeEndOffset : constant Positive := End_Offset (Innernode, After);

      Before_WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Before_Text, Charset);
      After_WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (After_Text, Charset);

      Dummy_Before, Dummy_After : Boolean;
   begin
      Assert
        (Check   => TR.Is_Initialized,
         Message => "Text Rewrite used uninitialized");
      Assert
        (Check   => Is_Reflexive_Ancestor (TR.Get_Unit.Root, Node),
         Message =>
           "Text Rewrite Node does not contain provided Node - " &
           Langkit_Support.Text.Image (Node.Text));
      Assert
        (Check   => TR.First <= NodeStartOffset,
         Message => "Text Rewrite - start of node outside part");
      Assert
        (Check   => NodeEndOffset <= TR.Last,
         Message => "Text Rewrite - end of node outside part");
      Assert
        (Check   => Is_Reflexive_Ancestor (Node, Innernode),
         Message => "Innernode should be contained in node");
      Log ("ReplaceAround - Before");
      Dummy_Before :=
        Replace (TR, NodeStartOffset, InnernodeStartOffset - 1, Before_WText);
      Log ("ReplaceAround - After");
      Dummy_After :=
        Replace (TR, InnernodeEndOffset + 1, NodeEndOffset, After_WText);
      Assert
        (Check   => Dummy_Before = Dummy_After,
         Message =>
           Langkit_Support.Text.Image (Node.Full_Sloc_Image) &
           "How to handle only one of the two is accepted?" & ASCII.LF &
           "Before = " & Boolean'Image (Dummy_Before) & ASCII.LF & "After = " &
           Boolean'Image (Dummy_After));
   end ReplaceAround;

   -- Collect rewrite operation (nodes) ---------------

   function Replace
     (TR    : in out Text_Rewrite; First_Node, Last_Node : Ada_Node'Class;
      Text  :        String; Before : Node_Location := No_Trivia;
      After :        Node_Location := No_Trivia; Charset : String := "")
      return Boolean
   is
      First : constant Positive         := Start_Offset (First_Node, Before);
      Last  : constant Positive         := End_Offset (Last_Node, After);
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      Assert
        (Check   => TR.Is_Initialized,
         Message => "Text Rewrite used uninitialized");
      --  TODO: First and Last node might be the same node
      --  How to check it efficiently?
      --  Options [at least]
      --    * Move Assert upwards (before duplication happens)
      --    * add check "First_Node = Last_Node or else .."
      Assert
        (Check   => Is_Reflexive_Ancestor (TR.Get_Unit.Root, First_Node),
         Message =>
           "Text Rewrite Node does not contain provided First Node - " &
           Langkit_Support.Text.Image (First_Node.Text));
      Assert
        (Check   => TR.First <= First,
         Message => "Text Rewrite - start of first node outside part");
      Assert
        (Check   => Is_Reflexive_Ancestor (TR.Get_Unit.Root, Last_Node),
         Message =>
           "Text Rewrite Node does not contain provided Last Node - " &
           Langkit_Support.Text.Image (Last_Node.Text));
      Assert
        (Check   => Last <= TR.Last,
         Message => "Text Rewrite - end of last node outside part");
      return Replace (TR, First, Last, WText);
   end Replace;

   procedure Remove
     (TR     : in out Text_Rewrite; First_Node, Last_Node : Ada_Node'Class;
      Before : Node_Location := No_Trivia; After : Node_Location := No_Trivia)
   is
      Dummy : Boolean;
   begin
      Dummy := Remove (TR, First_Node, Last_Node, Before, After);
   end Remove;

   procedure Replace
     (TR    : in out Text_Rewrite; First_Node, Last_Node : Ada_Node'Class;
      Text  :        String; Before : Node_Location := No_Trivia;
      After :        Node_Location := No_Trivia; Charset : String := "")
   is
      Dummy : Boolean;
   begin
      Dummy :=
        Replace (TR, First_Node, Last_Node, Text, Before, After, Charset);
   end Replace;

   -- Public: Collect rewrite operation (token) --------

   function Prepend
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "") return Boolean
   is
      First : constant Integer          := Raw_Data (Token).Source_First;
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      return Replace (TR, First, First - 1, WText);
   end Prepend;

   function Append
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "") return Boolean
   is
      Last  : constant Integer          := Raw_Data (Token).Source_Last;
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      return Replace (TR, Last + 1, Last, WText);
   end Append;

   function Replace
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "") return Boolean
   is
      First : constant Integer          := Raw_Data (Token).Source_First;
      Last  : constant Integer          := Raw_Data (Token).Source_Last;
      WText : constant Wide_Wide_String :=
        Langkit_Support.Text.Decode (Text, Charset);
   begin
      return Replace (TR, First, Last, WText);
   end Replace;

   procedure Remove (TR : in out Text_Rewrite; Token : Token_Reference) is
      Dummy : Boolean;
   begin
      Dummy := TR.Remove (Token);
   end Remove;

   procedure Prepend
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Prepend (Token, Text, Charset);
   end Prepend;

   procedure Append
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Append (Token, Text, Charset);
   end Append;

   procedure Replace
     (TR      : in out Text_Rewrite; Token : Token_Reference; Text : String;
      Charset :        String := "")
   is
      Dummy : Boolean;
   begin
      Dummy := TR.Replace (Token, Text, Charset);
   end Replace;

   -- Public: Inspect rewrite operations --------

   function HasReplacements (TR : Text_Rewrite) return Boolean is
   begin
      return not TR.Entries.Is_Empty;
   end HasReplacements;

   -- Public: Apply rewrite operations --------

   function ApplyToString (TR : Text_Rewrite) return String is
      use Replacement_List;
      Txt : constant Langkit_Support.Text.Text_Type :=
        TR.Get_Unit.Text (TR.First .. TR.Last);
      Str : Unbounded_Wide_Wide_String := To_Unbounded_Wide_Wide_String (Txt);
      Str_First : constant Positive          := 1;
      --  lower bound of an Unbounded_Wide_Wide_String is 1
      C : Cursor := TR.Entries.Last;
   begin
      Assert
        (Check   => TR.Is_Initialized,
         Message => "Text Rewrite used uninitialized");
      Log ("ApplyToString -" & TR.Entries.Length'Image & " Slices");
      while Has_Element (C) loop
         declare
            RE          : constant Replacement_Entry := Element (C);
            From        : constant Positive := RE.First - TR.First + Str_First;
            To          : constant Natural := RE.Last - TR.First + Str_First;
            Replacement : constant Wide_Wide_String  :=
              To_Wide_Wide_String (RE.Text);
         begin
            Log
              ("Slice #" & To_Index (C)'Image & " [" & From'Image & ":" &
               To'Image & " ]");
            Replace_Slice (Str, From, To, Replacement);
         end;

         Previous (C);
      end loop;

      return
        Langkit_Support.Text.Encode
          (To_Wide_Wide_String (Str), TR.Get_Unit.Get_Charset);
   exception
      when others =>
         Put_Line ("Error in ApplyToString - " & TR.Get_Unit.Get_Filename);
         raise;
   end ApplyToString;

   function Make_Text_Rewrite_Nodes
     (First_Node, Last_Node : Ada_Node'Class;
      Before : Node_Location := No_Trivia; After : Node_Location := No_Trivia)
      return Text_Rewrite
   is
      First : constant Positive := Start_Offset (First_Node, Before);
      Last  : constant Positive := End_Offset (Last_Node, After);
   begin
      Assert
        (Check   => First <= Last,
         Message => "Make_Text_Rewrite_Nodes - not a sequence");
      Assert
        (Check   => "=" (First_Node.Unit, Last_Node.Unit),
         Message => "Make_Text_Rewrite_Nodes - not same unit");

      return
        (Entries => Replacement_List.Empty_Vector, Unit => First_Node.Unit,
         First   => First, Last => Last);
   end Make_Text_Rewrite_Nodes;

   function Make_Text_Rewrite_Unit
     (Unit : Analysis_Unit) return Text_Rewrite_Unit
   is
   begin
      return
        (Entries => Replacement_List.Empty_Vector, Unit => Unit, First => 1,
         Last    => Length (To_Unbounded_Wide_Wide_String (Unit.Text)));
   end Make_Text_Rewrite_Unit;

   procedure Apply (TR : Text_Rewrite_Unit) is
   begin
      if TR.HasReplacements then
         Write_String_To_File (TR.ApplyToString, TR.Get_Unit.Get_Filename);
      end if;
   end Apply;

   procedure Apply_And_Reparse (TR : in out Text_Rewrite_Unit) is
   begin
      if TR.HasReplacements then
         declare
            Unit : constant Analysis_Unit := TR.Get_Unit;
         begin
            Write_String_To_File (TR.ApplyToString, Unit.Get_Filename);
            Unit.Reparse;
            TR := Make_Text_Rewrite_Unit (Unit);
         end;
      end if;
   end Apply_And_Reparse;

   -- Private: Collect rewrite operation --------
   function Replace_Inner
     (TR : in out Text_Rewrite; First, Last : Natural; Text : Wide_Wide_String)
      return Boolean;

   --  Return value indicates whether replacement is accepted.
   function Replace_Inner
     (TR : in out Text_Rewrite; First, Last : Natural; Text : Wide_Wide_String)
      return Boolean
   is
      use Replacement_List;
      New_Text : Unbounded_Wide_Wide_String :=
        To_Unbounded_Wide_Wide_String (Text);
      C : Cursor := TR.Entries.First;
   begin
      while Has_Element (C) loop
         declare
            RE : Replacement_Entry := Element (C);
         begin
            if First = RE.First then
               if RE.First - RE.Last = 1 then
                  Log ("Merge insert/replacement with earlier insertion");
                  New_Text := RE.Text & New_Text;
                  --  Might cover multiple earlier inserted replacements
                  if TR.Entries.Last = C then
                     Delete (TR.Entries, C);
                  else
                     declare
                        Dummy : Cursor := C;
                     begin
                        Delete (TR.Entries, Dummy);
                     end;
                  end if;
               elsif First - Last = 1 then
                  Log ("Merge insertion with earlier replacement");
                  RE.Text := New_Text & RE.Text;
                  Replace_Element (TR.Entries, C, RE);
                  return True;
               elsif Last < RE.Last then
                  Log ("Replacements at the same offset; keep the earlier");
                  return False;
               elsif RE.Last < Last then
                  Log ("Replacements at the same offset; keep the current");
                  --  Might cover multiple earlier inserted replacements
                  if TR.Entries.Last = C then
                     Delete (TR.Entries, C);
                  else
                     declare
                        Dummy : Cursor := C;
                     begin
                        Delete (TR.Entries, Dummy);
                     end;
                  end if;
               else
                  if RE.Text = New_Text then
                     Log ("Identical replacements");
                     return True;
                     --  TODO: Why return False / True?
                     --  Both the current is accepted and the old is kept
                     --  (since both are identical)
                  else
                     Log
                       ("Conflicting replacements of equal length; " &
                        "keep the current");
                     RE.Text := New_Text;
                     Replace_Element (TR.Entries, C, RE);
                     return True;
                  end if;
               end if;

            elsif First < RE.First then
               if RE.Last = Last then
                  --  length != 0
                  if RE.First - RE.Last = 1 then
                     Log ("Merging of operation with insert operation");
                     RE.First := First;
                     RE.Text  := New_Text & RE.Text;
                     Replace_Element (TR.Entries, C, RE);
                     return True;
                  else
                     Log
                       ("Replacements at the same end-offset; " &
                        "keep the current");
                     RE.First := First;
                     RE.Text  := New_Text;
                     Replace_Element (TR.Entries, C, RE);
                     return True;
                  end if;
               elsif RE.Last < Last then
                  Log
                    ("Earlier replacement is completely covered " &
                     "by the current");
                  --  Might cover multiple earlier inserted replacements
                  if TR.Entries.Last = C then
                     Delete (TR.Entries, C);
                  else
                     declare
                        Dummy : Cursor := C;
                     begin
                        Delete (TR.Entries, Dummy);
                     end;
                  end if;
               elsif RE.First - 1 < Last then
                  Log ("Overlapping edit operations (1)");
                  return False;
               else
                  Log ("Insert current operation before earlier operation");
                  exit;
               end if;

            else
               --  RE.First < First
               if Last = RE.Last then
                  --  entry.length != 0
                  if First - Last = 1 then
                     Log ("Merging of operation with insert operation");
                     RE.Text := RE.Text & New_Text;
                     Replace_Element (TR.Entries, C, RE);
                     return True;
                  else
                     Log
                       ("Replacements at the same end-offset; " &
                        "keep the earlier");
                     return False;
                  end if;
               elsif Last < RE.Last then
                  Log
                    ("Current replacement is completely covered " &
                     "by the earlier");
                  return False;
               elsif First - 1 < RE.Last then
                  Log ("Overlapping edit operations (2)");
                  return False;
               else
                  Next (C);
               end if;
            end if;
         end;
      end loop;

      --  To have "the largest replacement wins" independent of the order
      --  we cannot check for trivial replacements
      --  since by removing the replacement,
      --  a later smaller replacement can unexpectedly win!
      declare
         RE : Replacement_Entry;
      begin
         RE.First := First;
         RE.Last  := Last;
         RE.Text  := New_Text;
         Log ("Add replacement");
         Insert (TR.Entries, C, RE);
      end;

      return True;
   end Replace_Inner;

   --
   --  Debug functionality to check replace
   --

   --  Max_Length_Text : constant Integer := 30;
   --
   --  function Image (TR : Text_Rewrite) return String
   --  is
   --     Return_Value : Unbounded_String;
   --  begin
   --     for E of TR.Entries loop
   --        Return_Value := Return_Value & E.First'Image & "-"
   --                        & E.Last'Image & ":"
   --                        & Head (Image (To_Text (E.Text)), Max_Length_Text)
   --                        & ASCII.CR & ASCII.LF;
   --     end loop;
   --
   --     return To_String (Return_Value);
   --  end Image;
   --
   --  function Is_Internally_Consistent (TR : Text_Rewrite) return Boolean
   --  is
   --     Last : Integer := -1;
   --  begin
   --     for E of TR.Entries loop
   --        if Last > E.First then
   --           return False;
   --        else
   --           Last := E.Last;
   --        end if;
   --     end loop;
   --     return True;
   --  end Is_Internally_Consistent;
   --
   --  function Replace (TR : in out Text_Rewrite;
   --                    First, Last : Natural;
   --                    Text : Wide_Wide_String)
   --              return Boolean
   --  is
   --     Return_Value : Boolean;
   --  begin
   --     Log ("Replace " & First'Image & "-" & Last'Image & ":" &
   --            Head (Image (To_Text (To_Unbounded_Wide_Wide_String (Text))),
   --                  Max_Length_Text));
   --     Return_Value := Replace_Inner (TR, First, Last, Text);
   --     Assert (Check => Is_Internally_Consistent (TR),
   --             Message => "Text Rewrite no longer internally consistent" &
   --               ASCII.CR & ASCII.LF & Image (TR));
   --     return Return_Value;
   --  end Replace;

   function Replace
     (TR : in out Text_Rewrite; First, Last : Natural; Text : Wide_Wide_String)
      return Boolean is
     (Replace_Inner (TR, First, Last, Text));
   --  Proxy to allow easy switching to debug variant

   --  Private: Debugging utilities --------

   procedure Log (Str : String) is
   begin
      if DEBUG then
         Put_Line (Str);
      end if;
   end Log;

end Rejuvenation.Text_Rewrites;