1515-- of the license. --
1616-- ----------------------------------------------------------------------------
1717
18+ with GPR2.Source_Reference ;
19+ with GPR2.Message ;
20+ with GPR2.Path_Name ;
21+
1822with VSS.Strings ;
1923
2024with LSP.Enumerations ;
25+ with LSP.Utils ;
2126
2227package body LSP.Ada_Handlers.Project_Diagnostics is
2328
24- Single_Project_Found_Message : constant VSS.Strings.Virtual_String :=
25- VSS.Strings.To_Virtual_String
26- (" Unique project in root directory was found and " &
27- " loaded, but it wasn't explicitly configured." );
28-
29- No_Runtime_Found_Message : constant VSS.Strings.Virtual_String :=
30- VSS.Strings.To_Virtual_String
31- (" The project was loaded, but no Ada runtime found. " &
32- " Please check the installation of the Ada compiler." );
33-
34- No_Project_Found_Message : constant VSS.Strings.Virtual_String :=
35- VSS.Strings.To_Virtual_String
36- (" No project found in root directory. " &
37- " Please create a project file and add it to the configuration." );
29+ Project_Loading_Status_Messages : constant array (Load_Project_Status)
30+ of VSS.Strings.Virtual_String :=
31+ (Single_Project_Found =>
32+ VSS.Strings.To_Virtual_String
33+ (" Unique project in root directory was found and "
34+ & " loaded, but it wasn't explicitly configured." ),
35+ No_Runtime_Found =>
36+ VSS.Strings.To_Virtual_String
37+ (" The project was loaded, but no Ada runtime found. "
38+ & " Please check the installation of the Ada compiler." ),
39+ No_Project_Found =>
40+ VSS.Strings.To_Virtual_String
41+ (" No project found in root directory. "
42+ & " Please create a project file and add it to the "
43+ & " configuration." ),
44+ Multiple_Projects_Found =>
45+ VSS.Strings.To_Virtual_String
46+ (" No project was loaded, because more than one "
47+ & " project file has been found in the root directory. "
48+ & " Please change configuration to point a correct project "
49+ & " file." ),
50+ Invalid_Project_Configured =>
51+ VSS.Strings.To_Virtual_String
52+ (" Project file has errors and can't be loaded." ),
53+ others => VSS.Strings.Empty_Virtual_String);
54+ -- The diagnostics' messages depending on the project loading status.
3855
39- Multiple_Projects_Found_Message : constant VSS.Strings.Virtual_String :=
40- VSS.Strings.To_Virtual_String
41- (" No project was loaded, because more than one project file has been " &
42- " found in the root directory. Please change configuration to point " &
43- " a correct project file." );
44-
45- Invalid_Project_Configured_Message : constant VSS.Strings.Virtual_String :=
46- VSS.Strings.To_Virtual_String
47- (" Project file has error and can't be loaded." );
56+ Project_Loading_Status_Severities : constant array (Load_Project_Status)
57+ of LSP.Enumerations.DiagnosticSeverity :=
58+ (Valid_Project_Configured => LSP.Enumerations.Hint,
59+ Alire_Project => LSP.Enumerations.Hint,
60+ Single_Project_Found => LSP.Enumerations.Hint,
61+ No_Runtime_Found => LSP.Enumerations.Warning,
62+ Multiple_Projects_Found => LSP.Enumerations.Error,
63+ No_Project_Found => LSP.Enumerations.Error,
64+ Invalid_Project_Configured => LSP.Enumerations.Error);
65+ -- The diagnostics' severities depending on the project loading status.
4866
4967 -- ------------------
5068 -- Get_Diagnostic --
@@ -55,33 +73,119 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
5573 Context : LSP.Ada_Contexts.Context;
5674 Errors : out LSP.Structures.Diagnostic_Vector)
5775 is
58- Item : LSP.Structures.Diagnostic;
76+ use LSP.Structures;
77+
78+ Parent_Diagnostic : LSP.Structures.Diagnostic;
79+ GPR2_Messages : GPR2.Log.Object renames
80+ Self.Handler.Project_Status.GPR2_Messages;
81+
82+ procedure Create_Project_Loading_Diagnostic ;
83+ -- Create a parent diagnostic for the project loading status.
84+
85+ procedure Append_GPR2_Diagnostics ;
86+ -- Append the GPR2 messages to the given parent diagnostic, if any.
87+
88+ -- -------------------------------------
89+ -- Create_Project_Loading_Diagnostic --
90+ -- -------------------------------------
91+
92+ procedure Create_Project_Loading_Diagnostic is
93+ Project_File : GNATCOLL.VFS.Virtual_File renames
94+ Self.Handler.Project_Status.Project_File;
95+ URI : constant LSP.Structures.DocumentUri :=
96+ Self.Handler.To_URI (Project_File.Display_Full_Name);
97+ Sloc : constant LSP.Structures.A_Range :=
98+ (start => (0 , 0 ),
99+ an_end => (0 , 0 ));
100+ begin
101+ -- Initialize the parent diagnostic.
102+ Parent_Diagnostic.a_range := ((0 , 0 ), (0 , 0 ));
103+ Parent_Diagnostic.source := " project" ;
104+ Parent_Diagnostic.severity :=
105+ (True, Project_Loading_Status_Severities (Self.Last_Status));
106+
107+ -- If we don't have any GPR2 messages, display the project loading
108+ -- status message in the parent diagnostic directly.
109+ -- Otherwise display a generic message in the parent amnd append it
110+ -- to its children, along with the other GPR2 messages.
111+ if GPR2_Messages.Is_Empty then
112+ Parent_Diagnostic.message := Project_Loading_Status_Messages
113+ (Self.Last_Status);
114+ else
115+ Parent_Diagnostic.message := " Project Problems" ;
116+ Parent_Diagnostic.relatedInformation.Append
117+ (LSP .Structures.DiagnosticRelatedInformation'
118+ (location => LSP.Structures.Location'
119+ (uri => URI,
120+ a_range => Sloc,
121+ others => <>),
122+ message => Project_Loading_Status_Messages
123+ (Self.Last_Status)));
124+ end if ;
125+ end Create_Project_Loading_Diagnostic ;
126+
127+ -- ---------------------------
128+ -- Append_GPR2_Diagnostics --
129+ -- ---------------------------
130+
131+ procedure Append_GPR2_Diagnostics is
132+ use GPR2.Message;
133+ use LSP.Enumerations;
134+ begin
135+ for Msg of GPR2_Messages loop
136+ if Msg.Level in GPR2.Message.Warning .. GPR2.Message.Error then
137+ declare
138+ Sloc : constant GPR2.Source_Reference.Object :=
139+ GPR2.Message.Sloc (Msg);
140+ File : constant GPR2.Path_Name.Object :=
141+ (if Sloc.Is_Defined and then Sloc.Has_Source_Reference then
142+ GPR2.Path_Name.Create_File
143+ (GPR2.Filename_Type (Sloc.Filename))
144+ else
145+ Self.Handler.Project_Tree.Root_Path);
146+ begin
147+ Parent_Diagnostic.relatedInformation.Append
148+ (LSP .Structures.DiagnosticRelatedInformation'
149+ (location => LSP.Structures.Location'
150+ (uri => LSP.Utils.To_URI (File),
151+ a_range => LSP.Utils.To_Range (Sloc),
152+ others => <>),
153+ message => VSS.Strings.Conversions.To_Virtual_String
154+ (Msg.Message)));
155+ end ;
156+
157+ -- If we have one error in the GPR2 messages, the parent
158+ -- diagnostic's severity should be "error" too, otherwise
159+ -- "warning".
160+ if Msg.Level = GPR2.Message.Error then
161+ Parent_Diagnostic.severity :=
162+ (True, LSP.Enumerations.Error);
163+ elsif Parent_Diagnostic.severity.Value /=
164+ LSP.Enumerations.Error
165+ then
166+ Parent_Diagnostic.severity :=
167+ (True, LSP.Enumerations.Warning);
168+ end if ;
169+ end if ;
170+ end loop ;
171+ end Append_GPR2_Diagnostics ;
172+
59173 begin
60- Self.Last_Status := Self.Handler.Project_Status;
61- Item.a_range := ((0 , 0 ), (0 , 0 ));
62- Item.source := " project" ;
63- Item.severity := (True, LSP.Enumerations.Error);
64-
65- case Self.Last_Status is
66- when Valid_Project_Configured | Alire_Project =>
67- null ;
68- when No_Runtime_Found =>
69- Item.message := No_Runtime_Found_Message;
70- Errors.Append (Item);
71- when Single_Project_Found =>
72- Item.message := Single_Project_Found_Message;
73- Item.severity := (True, LSP.Enumerations.Hint);
74- Errors.Append (Item);
75- when No_Project_Found =>
76- Item.message := No_Project_Found_Message;
77- Errors.Append (Item);
78- when Multiple_Projects_Found =>
79- Item.message := Multiple_Projects_Found_Message;
80- Errors.Append (Item);
81- when Invalid_Project_Configured =>
82- Item.message := Invalid_Project_Configured_Message;
83- Errors.Append (Item);
84- end case ;
174+ Self.Last_Status := Self.Handler.Project_Status.Load_Status;
175+
176+ -- If we have a valid project return immediately: we want to display
177+ -- diagnostics only if there is an issue to solve or a potential
178+ -- enhancement.
179+ if Self.Last_Status = Valid_Project_Configured
180+ or else (Self.Last_Status = Alire_Project and then GPR2_Messages.Is_Empty)
181+ then
182+ return ;
183+ end if ;
184+
185+ Create_Project_Loading_Diagnostic;
186+ Append_GPR2_Diagnostics;
187+
188+ Errors.Append (Parent_Diagnostic);
85189 end Get_Diagnostic ;
86190
87191 -- ----------------------
@@ -95,7 +199,9 @@ package body LSP.Ada_Handlers.Project_Diagnostics is
95199 is
96200 pragma Unreferenced (Context);
97201 begin
98- return Self.Last_Status /= Self.Handler.Project_Status;
202+ return
203+ (Self.Last_Status /= Self.Handler.Project_Status.Load_Status
204+ or else not Self.Handler.Project_Status.GPR2_Messages.Is_Empty);
99205 end Has_New_Diagnostic ;
100206
101207end LSP.Ada_Handlers.Project_Diagnostics ;
0 commit comments