Skip to content

Commit 8205f15

Browse files
joaopsazevedojoaopsazevedo
committed
SA22-035 Sort Dependencies tool initial implementation
1 parent 1758fd5 commit 8205f15

File tree

14 files changed

+732
-0
lines changed

14 files changed

+732
-0
lines changed

‎source/ada/lsp-ada_driver.adb

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ with LSP.Ada_Handlers.Refactor_Extract_Subprogram;
5353
with LSP.Ada_Handlers.Refactor_Introduce_Parameter;
5454
with LSP.Ada_Handlers.Refactor_Pull_Up_Declaration;
5555
with LSP.Ada_Handlers.Refactor_Replace_Type;
56+
with LSP.Ada_Handlers.Refactor_Sort_Dependencies;
5657
with LSP.Commands;
5758
with LSP.Error_Decorators;
5859
with LSP.Fuzz_Decorators;
@@ -150,6 +151,8 @@ procedure LSP.Ada_Driver is
150151
(LSP.Ada_Handlers.Refactor_Pull_Up_Declaration.Command'Tag);
151152
LSP.Commands.Register
152153
(LSP.Ada_Handlers.Refactor_Replace_Type.Command'Tag);
154+
LSP.Commands.Register
155+
(LSP.Ada_Handlers.Refactor_Sort_Dependencies.Command'Tag);
153156

154157
-- Refactoring - Change Subprogram Signature Commands
155158
LSP.Commands.Register

‎source/ada/lsp-ada_handlers-refactor_sort_dependencies.adb

Lines changed: 234 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,234 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with Ada.Strings.UTF_Encoding;
19+
20+
with Langkit_Support.Slocs;
21+
22+
with Libadalang.Analysis;
23+
24+
with Laltools.Refactor.Sort_Dependencies;
25+
26+
with LSP.Common;
27+
with LSP.Messages.Client_Requests;
28+
with LSP.Lal_Utils;
29+
30+
with VSS.Strings.Conversions;
31+
32+
package body LSP.Ada_Handlers.Refactor_Sort_Dependencies is
33+
34+
------------------------
35+
-- Append_Code_Action --
36+
------------------------
37+
38+
procedure Append_Code_Action
39+
(Self : in out Command;
40+
Context : Context_Access;
41+
Commands_Vector : in out LSP.Messages.CodeAction_Vector;
42+
Where : LSP.Messages.Location)
43+
is
44+
Pointer : LSP.Commands.Command_Pointer;
45+
Code_Action : LSP.Messages.CodeAction;
46+
47+
begin
48+
Self.Initialize
49+
(Context => Context.all,
50+
Where => Where);
51+
52+
Pointer.Set (Self);
53+
54+
Code_Action :=
55+
(title => "Sort Dependencies",
56+
kind =>
57+
(Is_Set => True,
58+
Value => LSP.Messages.Refactor),
59+
diagnostics => (Is_Set => False),
60+
edit => (Is_Set => False),
61+
isPreferred => (Is_Set => False),
62+
disabled => (Is_Set => False),
63+
command =>
64+
(Is_Set => True,
65+
Value =>
66+
(Is_Unknown => False,
67+
title => <>,
68+
Custom => Pointer)));
69+
70+
Commands_Vector.Append (Code_Action);
71+
end Append_Code_Action;
72+
73+
------------
74+
-- Create --
75+
------------
76+
77+
overriding
78+
function Create
79+
(JS : not null access LSP.JSON_Streams.JSON_Stream'Class)
80+
return Command
81+
is
82+
use Ada.Strings.UTF_Encoding;
83+
use LSP.Messages;
84+
use LSP.Types;
85+
use VSS.Strings.Conversions;
86+
87+
begin
88+
return C : Command do
89+
pragma Assert (JS.R.Is_Start_Object);
90+
91+
JS.R.Read_Next;
92+
93+
while not JS.R.Is_End_Object loop
94+
pragma Assert (JS.R.Is_Key_Name);
95+
96+
declare
97+
Key : constant UTF_8_String := To_UTF_8_String (JS.R.Key_Name);
98+
99+
begin
100+
JS.R.Read_Next;
101+
102+
if Key = "context" then
103+
Read_String (JS, C.Context);
104+
105+
elsif Key = "where" then
106+
Location'Read (JS, C.Where);
107+
108+
else
109+
JS.Skip_Value;
110+
end if;
111+
end;
112+
end loop;
113+
114+
JS.R.Read_Next;
115+
end return;
116+
end Create;
117+
118+
-------------
119+
-- Execute --
120+
-------------
121+
122+
overriding
123+
procedure Execute
124+
(Self : Command;
125+
Handler : not null access LSP.Server_Notification_Receivers.
126+
Server_Notification_Receiver'Class;
127+
Client : not null access LSP.Client_Message_Receivers.
128+
Client_Message_Receiver'Class;
129+
Error : in out LSP.Errors.Optional_ResponseError)
130+
is
131+
use Langkit_Support.Slocs;
132+
use Libadalang.Analysis;
133+
use Laltools.Refactor;
134+
use Laltools.Refactor.Sort_Dependencies;
135+
use LSP.Messages;
136+
use LSP.Types;
137+
use VSS.Strings.Conversions;
138+
139+
Message_Handler : LSP.Ada_Handlers.Message_Handler renames
140+
LSP.Ada_Handlers.Message_Handler (Handler.all);
141+
Context : LSP.Ada_Contexts.Context renames
142+
Message_Handler.Contexts.Get (Self.Context).all;
143+
144+
Apply : Client_Requests.Workspace_Apply_Edit_Request;
145+
Workspace_Edits : WorkspaceEdit renames Apply.params.edit;
146+
Label : Optional_Virtual_String renames Apply.params.label;
147+
148+
Analysis_Unit : constant Libadalang.Analysis.Analysis_Unit :=
149+
Context.LAL_Context.Get_From_File
150+
(Context.URI_To_File (Self.Where.uri));
151+
Sloc : constant Source_Location :=
152+
(Langkit_Support.Slocs.Line_Number (Self.Where.span.first.line) + 1,
153+
Langkit_Support.Slocs.Column_Number (Self.Where.span.first.character)
154+
+ 1);
155+
Compilation_Unit : constant Libadalang.Analysis.Compilation_Unit :=
156+
Analysis_Unit.Root.Lookup (Sloc).P_Enclosing_Compilation_Unit;
157+
158+
Sorter : constant Dependencies_Sorter :=
159+
Create_Dependencies_Sorter (Compilation_Unit);
160+
Edits : constant Refactoring_Edits := Sorter.Refactor (null);
161+
162+
begin
163+
if Edits = No_Refactoring_Edits then
164+
Error :=
165+
(Is_Set => True,
166+
Value =>
167+
(code => LSP.Errors.UnknownErrorCode,
168+
message => VSS.Strings.Conversions.To_Virtual_String
169+
("Failed to execute the Sort Dependencies refactoring"),
170+
data => <>));
171+
172+
else
173+
Workspace_Edits :=
174+
LSP.Lal_Utils.To_Workspace_Edit
175+
(Edits => Edits,
176+
Resource_Operations => Message_Handler.Resource_Operations,
177+
Versioned_Documents => Message_Handler.Versioned_Documents,
178+
Document_Provider => Message_Handler'Access);
179+
Label :=
180+
(Is_Set => True,
181+
Value => To_Virtual_String (Command'External_Tag));
182+
183+
Client.On_Workspace_Apply_Edit_Request (Apply);
184+
end if;
185+
186+
exception
187+
when E : others =>
188+
LSP.Common.Log (Message_Handler.Trace, E);
189+
Error :=
190+
(Is_Set => True,
191+
Value =>
192+
(code => LSP.Errors.UnknownErrorCode,
193+
message => VSS.Strings.Conversions.To_Virtual_String
194+
("Failed to execute the Sort Dependencies refactoring"),
195+
data => <>));
196+
end Execute;
197+
198+
----------------
199+
-- Initialize --
200+
----------------
201+
202+
procedure Initialize
203+
(Self : in out Command'Class;
204+
Context : LSP.Ada_Contexts.Context;
205+
Where : LSP.Messages.Location) is
206+
begin
207+
Self.Context := Context.Id;
208+
Self.Where := Where;
209+
end Initialize;
210+
211+
-------------------
212+
-- Write_Command --
213+
-------------------
214+
215+
procedure Write_Command
216+
(S : access Ada.Streams.Root_Stream_Type'Class;
217+
C : Command)
218+
is
219+
use LSP.Messages;
220+
use LSP.Types;
221+
222+
JS : LSP.JSON_Streams.JSON_Stream'Class renames
223+
LSP.JSON_Streams.JSON_Stream'Class (S.all);
224+
225+
begin
226+
JS.Start_Object;
227+
JS.Key ("context");
228+
Write_String (S, C.Context);
229+
JS.Key ("where");
230+
Location'Write (S, C.Where);
231+
JS.End_Object;
232+
end Write_Command;
233+
234+
end LSP.Ada_Handlers.Refactor_Sort_Dependencies;

‎source/ada/lsp-ada_handlers-refactor_sort_dependencies.ads

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
--
18+
-- Implementation of the refactoring command to sort dependencies
19+
20+
with Ada.Streams;
21+
22+
with LSP.Client_Message_Receivers;
23+
with LSP.Commands;
24+
with LSP.Errors;
25+
with LSP.JSON_Streams;
26+
27+
private with VSS.Strings;
28+
29+
package LSP.Ada_Handlers.Refactor_Sort_Dependencies is
30+
31+
type Command is new LSP.Commands.Command with private;
32+
33+
procedure Append_Code_Action
34+
(Self : in out Command;
35+
Context : Context_Access;
36+
Commands_Vector : in out LSP.Messages.CodeAction_Vector;
37+
Where : LSP.Messages.Location);
38+
-- Initializes Self and appends it to Commands_Vector
39+
40+
private
41+
42+
type Command is new LSP.Commands.Command with record
43+
Context : VSS.Strings.Virtual_String;
44+
Where : LSP.Messages.Location;
45+
end record;
46+
47+
overriding
48+
function Create
49+
(JS : not null access LSP.JSON_Streams.JSON_Stream'Class)
50+
return Command;
51+
-- Reads JS and creates a new Command
52+
53+
overriding
54+
procedure Execute
55+
(Self : Command;
56+
Handler : not null access
57+
LSP.Server_Notification_Receivers.Server_Notification_Receiver'Class;
58+
Client : not null access
59+
LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
60+
Error : in out LSP.Errors.Optional_ResponseError);
61+
-- Executes Self by computing the necessary refactorings
62+
63+
procedure Initialize
64+
(Self : in out Command'Class;
65+
Context : LSP.Ada_Contexts.Context;
66+
Where : LSP.Messages.Location);
67+
-- Initializes Self
68+
69+
procedure Write_Command
70+
(S : access Ada.Streams.Root_Stream_Type'Class;
71+
C : Command);
72+
-- Writes C to S
73+
74+
for Command'Write use Write_Command;
75+
for Command'External_Tag use "als-refactor-sort_dependencies";
76+
77+
end LSP.Ada_Handlers.Refactor_Sort_Dependencies;

0 commit comments

Comments
 (0)