Skip to content

Commit 170edf8

Browse files
elierichaeliericha
committed
Introduce initial Alire sync operation for fresh crates
1 parent aa57af6 commit 170edf8

File tree

3 files changed

+139
-90
lines changed

3 files changed

+139
-90
lines changed

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

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -152,22 +152,34 @@ package body LSP.Ada_Handlers.Project_Loading is
152152

153153
elsif Is_Alire_Crate then
154154
Tracer.Trace ("Workspace is an Alire crate");
155-
Tracer.Trace ("Determining project from 'alr show' output");
156155

157-
LSP.Alire.Determine_Alire_Project
158-
(Root => Self.Client.Root_Directory.Display_Full_Name,
159-
Error => Alire_Error,
160-
Project => Project_File);
156+
Tracer.Trace ("Performing minimal Alire sync");
157+
LSP.Alire.Conservative_Alire_Sync
158+
(Self.Client.Root_Directory.Display_Full_Name, Alire_Error);
161159

162160
if not Alire_Error.Is_Empty then
163161
Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
164162
Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
165163
else
166-
-- Report how we found the project
167-
Self.Project_Status.Set_Project_Type
168-
(LSP.Ada_Project_Loading.Alire_Project);
169-
Self.Project_Status.Set_Alire_Messages ([]);
164+
Tracer.Trace ("Determining project from 'alr show' output");
165+
166+
LSP.Alire.Determine_Alire_Project
167+
(Root => Self.Client.Root_Directory.Display_Full_Name,
168+
Error => Alire_Error,
169+
Project => Project_File);
170+
171+
if not Alire_Error.Is_Empty then
172+
Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
173+
Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
174+
else
175+
-- Report how we found the project
176+
Self.Project_Status.Set_Project_Type
177+
(LSP.Ada_Project_Loading.Alire_Project);
178+
Self.Project_Status.Set_Alire_Messages ([]);
179+
end if;
180+
170181
end if;
182+
171183
end if;
172184

173185
-- If still haven't found a project, try to find a unique project at the root

‎source/ada/lsp-alire.adb‎

Lines changed: 100 additions & 79 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717

1818
with Ada.Streams;
1919
with GNAT.OS_Lib;
20+
with GNATCOLL.Traces;
2021
with GNATCOLL.VFS;
2122

2223
with LSP.GNATCOLL_Tracers;
@@ -32,11 +33,16 @@ with Spawn.Processes;
3233
with Spawn.Processes.Monitor_Loop;
3334
with Spawn.Process_Listeners;
3435
with Spawn.String_Vectors;
36+
with VSS.Strings.Formatters.Strings;
37+
with VSS.Strings.Templates;
3538

3639
package body LSP.Alire is
3740

3841
Trace : constant GNATCOLL_Tracers.Tracer :=
39-
GNATCOLL_Tracers.Create ("ALS.ALIRE");
42+
GNATCOLL_Tracers.Create ("ALS.ALIRE", GNATCOLL.Traces.On);
43+
44+
Alire_Verbose : constant GNATCOLL_Tracers.Tracer :=
45+
GNATCOLL_Tracers.Create ("ALS.ALIRE.VERBOSE", GNATCOLL.Traces.From_Config);
4046

4147
Fallback_Msg : constant VSS.Strings.Virtual_String :=
4248
"falling back to other methods to load a project";
@@ -61,16 +67,25 @@ package body LSP.Alire is
6167
procedure Error_Occurred (Self : in out Process_Listener; Error : Integer);
6268

6369
procedure Start_Alire
64-
(ALR : String;
65-
Option_1 : String;
66-
Option_2 : String;
67-
Root : String;
68-
Error : out VSS.Strings.Virtual_String;
69-
Lines : out VSS.String_Vectors.Virtual_String_Vector);
70+
(Options : VSS.String_Vectors.Virtual_String_Vector;
71+
Root : String;
72+
Error : out VSS.Strings.Virtual_String;
73+
Lines : out VSS.String_Vectors.Virtual_String_Vector);
7074

7175
Anchored : constant VSS.Regular_Expressions.Match_Options :=
7276
(VSS.Regular_Expressions.Anchored_Match => True);
7377

78+
Crate_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
79+
VSS.Regular_Expressions.To_Regular_Expression ("^([^= ]+)=");
80+
81+
Project_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
82+
VSS.Regular_Expressions.To_Regular_Expression
83+
(" +Project_File: ([^\n]+)");
84+
85+
Export_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
86+
VSS.Regular_Expressions.To_Regular_Expression
87+
("export ([^=]+)=""([^\n]+)""");
88+
7489
--------------------
7590
-- Error_Occurred --
7691
--------------------
@@ -82,6 +97,22 @@ package body LSP.Alire is
8297
Self.Error := Error;
8398
end Error_Occurred;
8499

100+
-----------------------------
101+
-- Conservative_Alire_Sync --
102+
-----------------------------
103+
104+
procedure Conservative_Alire_Sync
105+
(Root : String; Error : out VSS.Strings.Virtual_String)
106+
is
107+
Lines : VSS.String_Vectors.Virtual_String_Vector;
108+
begin
109+
Start_Alire
110+
(Options => ["--non-interactive", "build", "--stop-after=generation"],
111+
Root => Root,
112+
Error => Error,
113+
Lines => Lines);
114+
end Conservative_Alire_Sync;
115+
85116
---------------
86117
-- Run_Alire --
87118
---------------
@@ -91,39 +122,17 @@ package body LSP.Alire is
91122
Error : out VSS.Strings.Virtual_String;
92123
Project : out VSS.Strings.Virtual_String)
93124
is
94-
use type GNAT.OS_Lib.String_Access;
95-
use type VSS.Strings.Virtual_String;
96-
97-
ALR : GNAT.OS_Lib.String_Access :=
98-
GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
99-
100-
Crate_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
101-
VSS.Regular_Expressions.To_Regular_Expression ("^([^= ]+)=");
102-
103-
Project_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
104-
VSS.Regular_Expressions.To_Regular_Expression
105-
(" +Project_File: ([^\n]+)");
106-
107125
Lines : VSS.String_Vectors.Virtual_String_Vector;
108126
begin
109127
Project.Clear;
110128

111-
if ALR = null then
112-
Error :=
113-
"Alire executable ('alr') not found in PATH: " & Fallback_Msg;
114-
return;
115-
end if;
116-
117129
Start_Alire
118-
(ALR => ALR.all,
119-
Option_1 => "--non-interactive",
120-
Option_2 => "show",
121-
Root => Root,
122-
Error => Error,
123-
Lines => Lines);
130+
(Options => ["--non-interactive", "show"],
131+
Root => Root,
132+
Error => Error,
133+
Lines => Lines);
124134

125135
if not Error.Is_Empty then
126-
GNAT.OS_Lib.Free (ALR);
127136
return;
128137
end if;
129138

@@ -176,9 +185,7 @@ package body LSP.Alire is
176185
if Project.Is_Empty then
177186
Error.Append
178187
("No project file could be determined from the output of `alr show`:");
179-
for Line of Lines loop
180-
Error.Append (Line);
181-
end loop;
188+
Error.Append (Lines.Join_Lines (VSS.Strings.LF));
182189
end if;
183190

184191
end Determine_Alire_Project;
@@ -192,29 +199,17 @@ package body LSP.Alire is
192199
Error : out VSS.Strings.Virtual_String;
193200
Environment : in out GPR2.Environment.Object)
194201
is
195-
use type GNAT.OS_Lib.String_Access;
196-
use type VSS.Strings.Virtual_String;
197-
198-
ALR : GNAT.OS_Lib.String_Access :=
199-
GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
200-
201-
Export_Pattern : constant VSS.Regular_Expressions.Regular_Expression :=
202-
VSS.Regular_Expressions.To_Regular_Expression
203-
("export ([^=]+)=""([^\n]+)""");
202+
use VSS.Strings.Conversions;
204203

205204
Lines : VSS.String_Vectors.Virtual_String_Vector;
206205
begin
207206

208-
if ALR = null then
209-
Error := "No 'alr' in the PATH: " & Fallback_Msg;
207+
Start_Alire (["--non-interactive", "printenv"], Root, Error, Lines);
208+
209+
if not Error.Is_Empty then
210210
return;
211211
end if;
212212

213-
Start_Alire
214-
(ALR.all, "--non-interactive", "printenv", Root, Error, Lines);
215-
216-
GNAT.OS_Lib.Free (ALR);
217-
218213
-- Find variables in `alr printenv` output
219214

220215
for Line of Lines loop
@@ -225,12 +220,8 @@ package body LSP.Alire is
225220
begin
226221
if Match.Has_Match then
227222
Environment.Insert
228-
(Key =>
229-
VSS.Strings.Conversions.To_UTF_8_String
230-
(Match.Captured (1)),
231-
Value =>
232-
VSS.Strings.Conversions.To_UTF_8_String
233-
(Match.Captured (2)));
223+
(Key => To_UTF_8_String (Match.Captured (1)),
224+
Value => To_UTF_8_String (Match.Captured (2)));
234225
end if;
235226
end;
236227
end loop;
@@ -241,33 +232,64 @@ package body LSP.Alire is
241232
-----------------
242233

243234
procedure Start_Alire
244-
(ALR : String;
245-
Option_1 : String;
246-
Option_2 : String;
247-
Root : String;
248-
Error : out VSS.Strings.Virtual_String;
249-
Lines : out VSS.String_Vectors.Virtual_String_Vector)
235+
(Options : VSS.String_Vectors.Virtual_String_Vector;
236+
Root : String;
237+
Error : out VSS.Strings.Virtual_String;
238+
Lines : out VSS.String_Vectors.Virtual_String_Vector)
250239
is
251240
use type Spawn.Process_Exit_Code;
252241
use type Spawn.Process_Exit_Status;
253242
use type Spawn.Process_Status;
254-
255-
Item : aliased Process_Listener;
256-
Process : Spawn.Processes.Process renames Item.Process;
257-
Options : Spawn.String_Vectors.UTF_8_String_Vector;
258-
Decoder : VSS.Strings.Converters.Decoders.Virtual_String_Decoder;
259-
Text : VSS.Strings.Virtual_String;
243+
use type VSS.Strings.Virtual_String;
244+
use VSS.Strings.Formatters.Strings;
245+
use VSS.Strings.Conversions;
246+
247+
Item : aliased Process_Listener;
248+
Process : Spawn.Processes.Process renames Item.Process;
249+
Full_Options : VSS.String_Vectors.Virtual_String_Vector := Options;
250+
Sp_Options : Spawn.String_Vectors.UTF_8_String_Vector;
251+
Decoder : VSS.Strings.Converters.Decoders.Virtual_String_Decoder;
252+
Text : VSS.Strings.Virtual_String;
260253
begin
261-
Options.Append (Option_1);
262-
Options.Append (Option_2);
263-
Process.Set_Arguments (Options);
254+
255+
declare
256+
use type GNAT.OS_Lib.String_Access;
257+
ALR : GNAT.OS_Lib.String_Access :=
258+
GNAT.OS_Lib.Locate_Exec_On_Path ("alr");
259+
begin
260+
if ALR = null then
261+
Error :=
262+
"Alire executable ('alr') not found in PATH: " & Fallback_Msg;
263+
return;
264+
end if;
265+
266+
Process.Set_Program (ALR.all);
267+
GNAT.OS_Lib.Free (ALR);
268+
end;
269+
270+
if Alire_Verbose.Is_Active then
271+
Full_Options.Prepend ("-v");
272+
end if;
273+
274+
for Op of Full_Options loop
275+
Sp_Options.Append (To_UTF_8_String (Op));
276+
end loop;
277+
278+
Process.Set_Arguments (Sp_Options);
264279
Process.Set_Working_Directory (Root);
265-
Process.Set_Program (ALR);
266280
Process.Set_Listener (Item'Unchecked_Access);
267281

268282
if Trace.Is_Active then
269-
Trace.Trace
270-
("(in " & Root & ") " & ALR & " " & Option_1 & " " & Option_2);
283+
declare
284+
Template : VSS.Strings.Templates.Virtual_String_Template :=
285+
"(in {}) {} {}";
286+
begin
287+
Trace.Trace_Text
288+
(Template.Format
289+
(Image (To_Virtual_String (Process.Working_Directory)),
290+
Image (To_Virtual_String (Process.Program)),
291+
Image (Full_Options.Join (" "))));
292+
end;
271293
end if;
272294

273295
Process.Start;
@@ -312,7 +334,7 @@ package body LSP.Alire is
312334

313335
for Arg of Item.Process.Arguments loop
314336
Error.Append (" ");
315-
Error.Append (VSS.Strings.Conversions.To_Virtual_String (Arg));
337+
Error.Append (To_Virtual_String (Arg));
316338
end loop;
317339

318340
Error.Append ("' failed: ");
@@ -337,8 +359,7 @@ package body LSP.Alire is
337359

338360
if Item.Error /= 0 then
339361
Error.Append
340-
(VSS.Strings.Conversions.To_Virtual_String
341-
(GNAT.OS_Lib.Errno_Message (Item.Error)));
362+
(To_Virtual_String (GNAT.OS_Lib.Errno_Message (Item.Error)));
342363
end if;
343364
end if;
344365

‎source/ada/lsp-alire.ads‎

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@ with LSP.Ada_Client_Capabilities;
2323

2424
with VSS.Strings;
2525

26-
private
27-
package LSP.Alire is
26+
private package LSP.Alire is
2827

2928
function Is_Alire_Crate
3029
(Client : LSP.Ada_Client_Capabilities.Client_Capability) return Boolean;
@@ -37,6 +36,23 @@ package LSP.Alire is
3736
-- we are in a context where the Alire environment has already been
3837
-- set up.
3938

39+
procedure Conservative_Alire_Sync
40+
(Root : String; Error : out VSS.Strings.Virtual_String);
41+
-- Perform a conservative Alire sync action. The goal is to ensure a state
42+
-- where the crate's dependencies have been deployed, and the config/
43+
-- directory has been generated, such that the pre-requisites for loading
44+
-- the crate's GPR project are satisfied.
45+
--
46+
-- Currently that action is `alr --non-interactive build --stop-after=generation`.
47+
--
48+
-- If the workspace is a fresh crate checkout where Alire has never been
49+
-- called before, this action will deploy dependencies and generate the
50+
-- config/ directory which are both needed for loading the project.
51+
--
52+
-- Otherwise if the workspace is not a fresh checkout, the action will not
53+
-- alter existing dependencies to avoid taking drastic actions without User
54+
-- confirmation.
55+
4056
procedure Determine_Alire_Project
4157
(Root : String;
4258
Error : out VSS.Strings.Virtual_String;

0 commit comments

Comments
 (0)