Skip to content

Commit 54fa13b

Browse files
ogorodnikogorodnik
committed
New refactoring: Sort case alternatives
For eng/ide/ada_language_server#1671
1 parent 0f51b0f commit 54fa13b

File tree

9 files changed

+980
-0
lines changed

9 files changed

+980
-0
lines changed

‎doc/refactoring_tools.md‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@
1414
* [Extract Subprogram](#extract-subprogram)
1515
* [Extract Variable](#extract-variable)
1616
* [Pull Up Declaration](#pull-up-declaration)
17+
* [Sort Case](#sort-case)
1718
* [Suppress Separate](#suppress-separate)
1819
* [Delete Entity](#delete-entity)
1920
* [Introduce Parameter](#introduce-parameter)
@@ -157,6 +158,14 @@ Demo source is `pull_up_declaration/` in [Code Samples](https://github.com/AdaCo
157158

158159
![pull_up_declaration](media/pull_up_declaration.gif)
159160

161+
## Sort Case
162+
163+
**Command names:** `als-refactor-sort-case-alphabetical` `als-refactor-sort-case-declaration`
164+
165+
* Sort `when` and literals inside `when` alphabetically or according to the declaration order.
166+
167+
See `src/lal_refactor-sort_case.ads` in [LAL Refactor repository](https://github.com/AdaCore/lal-refactor).
168+
160169
## Suppress Separate
161170

162171
**Command name:** `als-suppress-separate`

‎source/ada/lsp-ada_driver.adb‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,7 @@ with LSP.Ada_Handlers.Refactor.Move_Parameter;
7676
with LSP.Ada_Handlers.Refactor.Pull_Up_Declaration;
7777
with LSP.Ada_Handlers.Refactor.Remove_Parameter;
7878
with LSP.Ada_Handlers.Refactor.Replace_Type;
79+
with LSP.Ada_Handlers.Refactor.Sort_Case;
7980
with LSP.Ada_Handlers.Refactor.Sort_Dependencies;
8081
with LSP.Ada_Handlers.Refactor.Suppress_Seperate;
8182
with LSP.Ada_Handlers.Show_Dependencies_Commands;
@@ -230,6 +231,10 @@ procedure LSP.Ada_Driver is
230231
(LSP.Ada_Handlers.Refactor.Pull_Up_Declaration.Command'Tag);
231232
LSP.Ada_Commands.Register
232233
(LSP.Ada_Handlers.Refactor.Replace_Type.Command'Tag);
234+
LSP.Ada_Commands.Register
235+
(LSP.Ada_Handlers.Refactor.Sort_Case.Alphabetical_Command'Tag);
236+
LSP.Ada_Commands.Register
237+
(LSP.Ada_Handlers.Refactor.Sort_Case.Declaration_Command'Tag);
233238
LSP.Ada_Commands.Register
234239
(LSP.Ada_Handlers.Refactor.Sort_Dependencies.Command'Tag);
235240

‎source/ada/lsp-ada_handlers-refactor-sort_case.adb‎

Lines changed: 277 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,277 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2025, 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 LAL_Refactor; use LAL_Refactor;
19+
with LAL_Refactor.Sort_Case; use LAL_Refactor.Sort_Case;
20+
21+
with VSS.JSON.Streams;
22+
23+
with LSP.Enumerations;
24+
with LSP.Structures.LSPAny_Vectors; use LSP.Structures.LSPAny_Vectors;
25+
26+
package body LSP.Ada_Handlers.Refactor.Sort_Case is
27+
28+
----------------
29+
-- Initialize --
30+
----------------
31+
32+
procedure Initialize
33+
(Self : in out Base_Command'Class;
34+
Context : LSP.Ada_Contexts.Context;
35+
Where : LSP.Structures.Location) is
36+
begin
37+
Self.Context_Id := Context.Id;
38+
Self.Location := Where;
39+
end Initialize;
40+
41+
------------------------
42+
-- Append_Code_Action --
43+
------------------------
44+
45+
procedure Append_Code_Action
46+
(Self : in out Base_Command'Class;
47+
Context : LSP.Ada_Context_Sets.Context_Access;
48+
Commands_Vector : in out LSP.Structures.Command_Or_CodeAction_Vector;
49+
Where : LSP.Structures.Location;
50+
Tag : String)
51+
is
52+
Code_Action : LSP.Structures.CodeAction;
53+
54+
begin
55+
Self.Initialize
56+
(Context => Context.all,
57+
Where => Where);
58+
59+
Code_Action :=
60+
(title =>
61+
VSS.Strings.Conversions.To_Virtual_String (Self.Name),
62+
kind =>
63+
(Is_Set => True,
64+
Value => LSP.Enumerations.RefactorExtract),
65+
diagnostics => <>,
66+
edit => (Is_Set => False),
67+
isPreferred => (Is_Set => False),
68+
disabled => (Is_Set => False),
69+
command =>
70+
(Is_Set => True,
71+
Value =>
72+
(title => "",
73+
command => VSS.Strings.Conversions.To_Virtual_String (Tag),
74+
arguments => Self.Write_Command)),
75+
data => <>);
76+
77+
Commands_Vector.Append
78+
(LSP.Structures.Command_Or_CodeAction'
79+
(Is_Command => False, CodeAction => Code_Action));
80+
end Append_Code_Action;
81+
82+
------------------------
83+
-- Append_Code_Action --
84+
------------------------
85+
86+
procedure Append_Code_Action
87+
(Self : in out Alphabetical_Command'Class;
88+
Context : LSP.Ada_Context_Sets.Context_Access;
89+
Commands_Vector : in out LSP.Structures.Command_Or_CodeAction_Vector;
90+
Where : LSP.Structures.Location) is
91+
begin
92+
Append_Code_Action
93+
(Self, Context, Commands_Vector, Where,
94+
Alphabetical_Command'External_Tag);
95+
end Append_Code_Action;
96+
97+
------------------------
98+
-- Append_Code_Action --
99+
------------------------
100+
101+
procedure Append_Code_Action
102+
(Self : in out Declaration_Command'Class;
103+
Context : LSP.Ada_Context_Sets.Context_Access;
104+
Commands_Vector : in out LSP.Structures.Command_Or_CodeAction_Vector;
105+
Where : LSP.Structures.Location) is
106+
begin
107+
Append_Code_Action
108+
(Self, Context, Commands_Vector, Where,
109+
Declaration_Command'External_Tag);
110+
end Append_Code_Action;
111+
112+
------------
113+
-- Create --
114+
------------
115+
116+
overriding function Create
117+
(Any : not null access LSP.Structures.LSPAny_Vector)
118+
return Alphabetical_Command is
119+
begin
120+
return Self : Alphabetical_Command do
121+
Load (Self, Any);
122+
end return;
123+
end Create;
124+
125+
------------
126+
-- Create --
127+
------------
128+
129+
overriding function Create
130+
(Any : not null access LSP.Structures.LSPAny_Vector)
131+
return Declaration_Command is
132+
begin
133+
return Self : Declaration_Command do
134+
Load (Self, Any);
135+
end return;
136+
end Create;
137+
138+
----------
139+
-- Load --
140+
----------
141+
142+
procedure Load
143+
(Self : in out Base_Command'Class;
144+
Any : not null access LSP.Structures.LSPAny_Vector)
145+
is
146+
use VSS.JSON.Streams;
147+
use VSS.Strings;
148+
use LSP.Structures.JSON_Event_Vectors;
149+
150+
C : Cursor := Any.First;
151+
begin
152+
pragma Assert (Element (C).Kind = Start_Array);
153+
Next (C);
154+
pragma Assert (Element (C).Kind = Start_Object);
155+
Next (C);
156+
157+
while Has_Element (C)
158+
and then Element (C).Kind /= End_Object
159+
loop
160+
pragma Assert (Element (C).Kind = Key_Name);
161+
declare
162+
Key : constant Virtual_String := Element (C).Key_Name;
163+
begin
164+
Next (C);
165+
166+
if Key = "context_id" then
167+
Self.Context_Id := Element (C).String_Value;
168+
169+
elsif Key = "location" then
170+
Self.Location := From_Any (C);
171+
172+
else
173+
Skip_Value (C);
174+
end if;
175+
end;
176+
177+
Next (C);
178+
end loop;
179+
end Load;
180+
181+
---------------------------
182+
-- Prepare_Refactor_Data --
183+
---------------------------
184+
185+
procedure Prepare_Refactor_Data
186+
(Self : Base_Command'Class;
187+
Handler : not null access LSP.Ada_Handlers.Message_Handler'Class;
188+
Unit : out Analysis_Unit;
189+
Location : out Source_Location)
190+
is
191+
Message_Handler : LSP.Ada_Handlers.Message_Handler renames
192+
LSP.Ada_Handlers.Message_Handler (Handler.all);
193+
Context : LSP.Ada_Contexts.Context renames
194+
Message_Handler.Contexts.Get (Self.Context_Id).all;
195+
File : constant GNATCOLL.VFS.Virtual_File :=
196+
Message_Handler.To_File (Self.Location.uri);
197+
begin
198+
Unit := Context.Get_AU (File);
199+
Location := Start_Sloc
200+
(From_LSP_Range (Message_Handler, Unit, Self.Location.a_range));
201+
end Prepare_Refactor_Data;
202+
203+
--------------
204+
-- Refactor --
205+
--------------
206+
207+
overriding procedure Refactor
208+
(Self : Alphabetical_Command;
209+
Handler : not null access LSP.Ada_Handlers.Message_Handler'Class;
210+
Edits : out LAL_Refactor.Refactoring_Edits)
211+
is
212+
Unit : Analysis_Unit;
213+
Location : Source_Location;
214+
begin
215+
Self.Prepare_Refactor_Data (Handler, Unit, Location);
216+
declare
217+
Extractor : constant Alphabetical_Case_Sorter :=
218+
Create_Alphabetical_Case_Sorter
219+
(Unit => Unit,
220+
Location => Location);
221+
begin
222+
Edits := Extractor.Refactor (null);
223+
end;
224+
end Refactor;
225+
226+
--------------
227+
-- Refactor --
228+
--------------
229+
230+
overriding procedure Refactor
231+
(Self : Declaration_Command;
232+
Handler : not null access LSP.Ada_Handlers.Message_Handler'Class;
233+
Edits : out LAL_Refactor.Refactoring_Edits)
234+
is
235+
Unit : Analysis_Unit;
236+
Location : Source_Location;
237+
begin
238+
Self.Prepare_Refactor_Data (Handler, Unit, Location);
239+
declare
240+
Extractor : constant Declaration_Case_Sorter :=
241+
Create_Declaration_Case_Sorter
242+
(Unit => Unit,
243+
Location => Location);
244+
begin
245+
Edits := Extractor.Refactor (null);
246+
end;
247+
end Refactor;
248+
249+
-------------------
250+
-- Write_Command --
251+
-------------------
252+
253+
function Write_Command
254+
(Self : Base_Command'Class) return LSP.Structures.LSPAny_Vector
255+
is
256+
use VSS.JSON.Streams;
257+
258+
Result : LSP.Structures.LSPAny_Vector;
259+
begin
260+
Result.Append (JSON_Stream_Element'(Kind => Start_Array));
261+
Result.Append (JSON_Stream_Element'(Kind => Start_Object));
262+
263+
-- "context_id"
264+
Add_Key ("context_id", Result);
265+
To_Any (Self.Context_Id, Result);
266+
267+
-- "location"
268+
Add_Key ("location", Result);
269+
To_Any (Self.Location, Result);
270+
271+
Result.Append (JSON_Stream_Element'(Kind => End_Object));
272+
Result.Append (JSON_Stream_Element'(Kind => End_Array));
273+
274+
return Result;
275+
end Write_Command;
276+
277+
end LSP.Ada_Handlers.Refactor.Sort_Case;

0 commit comments

Comments
 (0)