Fortran · 24770 bytes Raw Blame History
1 module diagnostics_module
2 use iso_fortran_env, only: int32
3 use json_module, only: json_value_t, json_get_string, &
4 json_get_number, json_get_object, &
5 json_get_array, json_array_size, &
6 json_get_array_element, json_has_key, &
7 json_stringify, json_get_value
8 implicit none
9 private
10
11 public :: diagnostic_t, diagnostics_store_t, diagnostic_range_t
12 public :: init_diagnostics_store, cleanup_diagnostics_store
13 public :: parse_diagnostics, parse_diagnostics_from_params, clear_diagnostics
14 public :: parse_diagnostics_from_params_with_server ! NEW: with server attribution
15 public :: get_diagnostics_for_line, get_diagnostic_at_cursor
16 public :: get_diagnostics_for_line_by_server ! NEW: filter by server
17 public :: has_diagnostics_for_file, get_diagnostics_for_file
18 public :: diagnostics_to_json
19 public :: SEVERITY_ERROR, SEVERITY_WARNING, SEVERITY_INFO, SEVERITY_HINT
20
21 ! Diagnostic severity levels (LSP standard)
22 integer, parameter :: SEVERITY_ERROR = 1
23 integer, parameter :: SEVERITY_WARNING = 2
24 integer, parameter :: SEVERITY_INFO = 3
25 integer, parameter :: SEVERITY_HINT = 4
26
27 type :: diagnostic_range_t
28 integer :: start_line = 0 ! 0-based
29 integer :: start_col = 0 ! 0-based
30 integer :: end_line = 0 ! 0-based
31 integer :: end_col = 0 ! 0-based
32 end type diagnostic_range_t
33
34 type :: diagnostic_t
35 type(diagnostic_range_t) :: range
36 integer :: severity = SEVERITY_ERROR
37 character(len=:), allocatable :: message
38 character(len=:), allocatable :: source ! e.g., "eslint", "clangd"
39 character(len=:), allocatable :: code ! Error code
40 character(len=:), allocatable :: data ! Raw JSON data field (for Ruff quickfixes)
41 integer :: server_index = 0 ! Which LSP server sent this diagnostic
42 end type diagnostic_t
43
44 type :: file_diagnostics_t
45 character(len=:), allocatable :: uri
46 type(diagnostic_t), allocatable :: items(:)
47 integer :: count = 0
48 end type file_diagnostics_t
49
50 type :: diagnostics_store_t
51 type(file_diagnostics_t), allocatable :: files(:)
52 integer :: file_count = 0
53 end type diagnostics_store_t
54
55 contains
56
57 subroutine init_diagnostics_store(store)
58 type(diagnostics_store_t), intent(out) :: store
59 allocate(store%files(0))
60 store%file_count = 0
61 end subroutine init_diagnostics_store
62
63 subroutine cleanup_diagnostics_store(store)
64 type(diagnostics_store_t), intent(inout) :: store
65 integer :: i, j
66
67 if (allocated(store%files)) then
68 do i = 1, store%file_count
69 if (allocated(store%files(i)%uri)) deallocate(store%files(i)%uri)
70 if (allocated(store%files(i)%items)) then
71 do j = 1, store%files(i)%count
72 if (allocated(store%files(i)%items(j)%message)) &
73 deallocate(store%files(i)%items(j)%message)
74 if (allocated(store%files(i)%items(j)%source)) &
75 deallocate(store%files(i)%items(j)%source)
76 if (allocated(store%files(i)%items(j)%code)) &
77 deallocate(store%files(i)%items(j)%code)
78 end do
79 deallocate(store%files(i)%items)
80 end if
81 end do
82 deallocate(store%files)
83 end if
84 store%file_count = 0
85 end subroutine cleanup_diagnostics_store
86
87 ! Parse diagnostics from LSP notification
88 subroutine parse_diagnostics(store, notification)
89 type(diagnostics_store_t), intent(inout) :: store
90 type(json_value_t), intent(in) :: notification
91 type(json_value_t) :: params
92
93 ! Get params from notification
94 if (.not. json_has_key(notification, "params")) return
95 params = json_get_object(notification, "params")
96
97 ! Delegate to params parser
98 call parse_diagnostics_from_params(store, params)
99 end subroutine parse_diagnostics
100
101 ! Parse diagnostics from just the params object
102 subroutine parse_diagnostics_from_params(store, params)
103 use terminal_io_module, only: terminal_write
104 type(diagnostics_store_t), intent(inout) :: store
105 type(json_value_t), intent(in) :: params
106 type(json_value_t) :: diagnostics_array, diag_obj, range_obj
107 type(json_value_t) :: start_obj, end_obj
108 character(len=:), allocatable :: uri
109 integer :: i, n_diagnostics, file_idx
110 type(diagnostic_t) :: diag
111
112 ! Get URI
113 if (.not. json_has_key(params, "uri")) return
114 uri = json_get_string(params, "uri")
115
116 ! Find or create file entry
117 file_idx = find_or_create_file(store, uri)
118
119 ! Clear existing diagnostics for this file
120 if (allocated(store%files(file_idx)%items)) then
121 deallocate(store%files(file_idx)%items)
122 end if
123 store%files(file_idx)%count = 0
124
125 ! Parse diagnostics array
126 if (json_has_key(params, "diagnostics")) then
127 diagnostics_array = json_get_array(params, "diagnostics")
128 n_diagnostics = json_array_size(diagnostics_array)
129
130 if (n_diagnostics > 0) then
131 allocate(store%files(file_idx)%items(n_diagnostics))
132 store%files(file_idx)%count = n_diagnostics
133
134 do i = 1, n_diagnostics
135 diag_obj = json_get_array_element(diagnostics_array, i-1)
136
137 ! Parse range
138 if (json_has_key(diag_obj, "range")) then
139 range_obj = json_get_object(diag_obj, "range")
140
141 if (json_has_key(range_obj, "start")) then
142 start_obj = json_get_object(range_obj, "start")
143 diag%range%start_line = int(json_get_number(start_obj, "line"))
144 diag%range%start_col = int(json_get_number(start_obj, "character"))
145 end if
146
147 if (json_has_key(range_obj, "end")) then
148 end_obj = json_get_object(range_obj, "end")
149 diag%range%end_line = int(json_get_number(end_obj, "line"))
150 diag%range%end_col = int(json_get_number(end_obj, "character"))
151 end if
152 end if
153
154 ! Parse severity
155 if (json_has_key(diag_obj, "severity")) then
156 diag%severity = int(json_get_number(diag_obj, "severity"))
157 else
158 diag%severity = SEVERITY_ERROR
159 end if
160
161 ! Parse message
162 if (json_has_key(diag_obj, "message")) then
163 diag%message = json_get_string(diag_obj, "message")
164 else
165 diag%message = "Unknown error"
166 end if
167
168 ! Parse source
169 if (json_has_key(diag_obj, "source")) then
170 diag%source = json_get_string(diag_obj, "source")
171 else
172 diag%source = ""
173 end if
174
175 ! Parse code
176 if (json_has_key(diag_obj, "code")) then
177 ! Code can be string or number
178 diag%code = json_get_string(diag_obj, "code")
179 else
180 diag%code = ""
181 end if
182
183 store%files(file_idx)%items(i) = diag
184 end do
185 end if
186 end if
187 end subroutine parse_diagnostics_from_params
188
189 ! Parse diagnostics with server attribution (for multi-LSP support)
190 ! Instead of clearing all diagnostics, this ADDS to existing diagnostics
191 ! and tags them with the server_index so they can be filtered later
192 subroutine parse_diagnostics_from_params_with_server(store, params, server_index)
193 use terminal_io_module, only: terminal_write
194 type(diagnostics_store_t), intent(inout) :: store
195 type(json_value_t), intent(in) :: params
196 integer, intent(in) :: server_index
197 type(json_value_t) :: diagnostics_array, diag_obj, range_obj
198 type(json_value_t) :: start_obj, end_obj
199 character(len=:), allocatable :: uri
200 integer :: i, n_diagnostics, file_idx, old_count, new_count, j
201 type(diagnostic_t) :: diag
202 type(diagnostic_t), allocatable :: old_items(:)
203
204 ! Get URI
205 if (.not. json_has_key(params, "uri")) return
206 uri = json_get_string(params, "uri")
207
208 ! Find or create file entry
209 file_idx = find_or_create_file(store, uri)
210
211 ! First, remove any existing diagnostics from this server
212 if (allocated(store%files(file_idx)%items) .and. store%files(file_idx)%count > 0) then
213 old_count = 0
214 ! Count diagnostics NOT from this server
215 do i = 1, store%files(file_idx)%count
216 if (store%files(file_idx)%items(i)%server_index /= server_index) then
217 old_count = old_count + 1
218 end if
219 end do
220
221 ! Copy diagnostics NOT from this server
222 if (old_count > 0) then
223 allocate(old_items(old_count))
224 j = 0
225 do i = 1, store%files(file_idx)%count
226 if (store%files(file_idx)%items(i)%server_index /= server_index) then
227 j = j + 1
228 old_items(j) = store%files(file_idx)%items(i)
229 end if
230 end do
231 end if
232 deallocate(store%files(file_idx)%items)
233 else
234 old_count = 0
235 end if
236
237 ! Parse new diagnostics array
238 n_diagnostics = 0
239 if (json_has_key(params, "diagnostics")) then
240 diagnostics_array = json_get_array(params, "diagnostics")
241 n_diagnostics = json_array_size(diagnostics_array)
242 end if
243
244 ! Allocate combined array
245 new_count = old_count + n_diagnostics
246 if (new_count > 0) then
247 if (allocated(store%files(file_idx)%items)) deallocate(store%files(file_idx)%items)
248 allocate(store%files(file_idx)%items(new_count))
249 store%files(file_idx)%count = new_count
250
251 ! Copy old diagnostics first
252 if (old_count > 0) then
253 store%files(file_idx)%items(1:old_count) = old_items(1:old_count)
254 deallocate(old_items)
255 end if
256
257 ! Parse and add new diagnostics
258 do i = 1, n_diagnostics
259 diag_obj = json_get_array_element(diagnostics_array, i-1)
260
261 ! Parse range
262 if (json_has_key(diag_obj, "range")) then
263 range_obj = json_get_object(diag_obj, "range")
264
265 if (json_has_key(range_obj, "start")) then
266 start_obj = json_get_object(range_obj, "start")
267 diag%range%start_line = int(json_get_number(start_obj, "line"))
268 diag%range%start_col = int(json_get_number(start_obj, "character"))
269 end if
270
271 if (json_has_key(range_obj, "end")) then
272 end_obj = json_get_object(range_obj, "end")
273 diag%range%end_line = int(json_get_number(end_obj, "line"))
274 diag%range%end_col = int(json_get_number(end_obj, "character"))
275 end if
276 end if
277
278 ! Parse severity
279 if (json_has_key(diag_obj, "severity")) then
280 diag%severity = int(json_get_number(diag_obj, "severity"))
281 else
282 diag%severity = SEVERITY_ERROR
283 end if
284
285 ! Parse message
286 if (json_has_key(diag_obj, "message")) then
287 diag%message = json_get_string(diag_obj, "message")
288 else
289 diag%message = "Unknown error"
290 end if
291
292 ! Parse source
293 if (json_has_key(diag_obj, "source")) then
294 diag%source = json_get_string(diag_obj, "source")
295 else
296 diag%source = ""
297 end if
298
299 ! Parse code
300 if (json_has_key(diag_obj, "code")) then
301 diag%code = json_get_string(diag_obj, "code")
302 else
303 diag%code = ""
304 end if
305
306 ! Parse data field (stores raw JSON for quickfixes like Ruff)
307 if (json_has_key(diag_obj, "data")) then
308 diag%data = json_stringify(json_get_value(diag_obj, "data"))
309 else
310 diag%data = ""
311 end if
312
313 ! Set server index
314 diag%server_index = server_index
315
316 store%files(file_idx)%items(old_count + i) = diag
317 end do
318 else
319 ! No diagnostics - ensure items is allocated as empty array
320 if (.not. allocated(store%files(file_idx)%items)) then
321 allocate(store%files(file_idx)%items(0))
322 end if
323 store%files(file_idx)%count = 0
324 end if
325 end subroutine parse_diagnostics_from_params_with_server
326
327 function find_or_create_file(store, uri) result(idx)
328 type(diagnostics_store_t), intent(inout) :: store
329 character(len=*), intent(in) :: uri
330 integer :: idx, i
331 type(file_diagnostics_t), allocatable :: new_files(:)
332
333 ! Search for existing file
334 do i = 1, store%file_count
335 if (store%files(i)%uri == uri) then
336 idx = i
337 return
338 end if
339 end do
340
341 ! Create new file entry
342 allocate(new_files(store%file_count + 1))
343 if (store%file_count > 0) then
344 new_files(1:store%file_count) = store%files(1:store%file_count)
345 end if
346
347 idx = store%file_count + 1
348 new_files(idx)%uri = uri
349 new_files(idx)%count = 0
350 allocate(new_files(idx)%items(0))
351
352 deallocate(store%files)
353 store%files = new_files
354 store%file_count = idx
355 end function find_or_create_file
356
357 subroutine clear_diagnostics(store, uri)
358 type(diagnostics_store_t), intent(inout) :: store
359 character(len=*), intent(in) :: uri
360 integer :: i
361
362 do i = 1, store%file_count
363 if (store%files(i)%uri == uri) then
364 if (allocated(store%files(i)%items)) then
365 deallocate(store%files(i)%items)
366 end if
367 store%files(i)%count = 0
368 allocate(store%files(i)%items(0))
369 exit
370 end if
371 end do
372 end subroutine clear_diagnostics
373
374 function get_diagnostics_for_line(store, uri, line) result(diagnostics)
375 type(diagnostics_store_t), intent(in) :: store
376 character(len=*), intent(in) :: uri
377 integer, intent(in) :: line ! 1-based editor line
378 type(diagnostic_t), allocatable :: diagnostics(:)
379 integer :: i, j, count, lsp_line
380
381 lsp_line = line - 1 ! Convert to 0-based
382
383 allocate(diagnostics(0))
384
385 do i = 1, store%file_count
386 if (store%files(i)%uri == uri) then
387 count = 0
388 ! Count diagnostics on this line
389 do j = 1, store%files(i)%count
390 if (store%files(i)%items(j)%range%start_line <= lsp_line .and. &
391 store%files(i)%items(j)%range%end_line >= lsp_line) then
392 count = count + 1
393 end if
394 end do
395
396 if (count > 0) then
397 deallocate(diagnostics)
398 allocate(diagnostics(count))
399 count = 0
400 do j = 1, store%files(i)%count
401 if (store%files(i)%items(j)%range%start_line <= lsp_line .and. &
402 store%files(i)%items(j)%range%end_line >= lsp_line) then
403 count = count + 1
404 diagnostics(count) = store%files(i)%items(j)
405 end if
406 end do
407 end if
408 exit
409 end if
410 end do
411 end function get_diagnostics_for_line
412
413 ! Get diagnostics for a specific line, filtered by server index
414 ! Used for code actions to only send diagnostics from the server being queried
415 function get_diagnostics_for_line_by_server(store, uri, line, server_index) result(diagnostics)
416 type(diagnostics_store_t), intent(in) :: store
417 character(len=*), intent(in) :: uri
418 integer, intent(in) :: line ! 1-based editor line
419 integer, intent(in) :: server_index
420 type(diagnostic_t), allocatable :: diagnostics(:)
421 integer :: i, j, count, lsp_line
422
423 lsp_line = line - 1 ! Convert to 0-based
424
425 allocate(diagnostics(0))
426
427 do i = 1, store%file_count
428 if (store%files(i)%uri == uri) then
429 count = 0
430 ! Count diagnostics on this line from this server
431 do j = 1, store%files(i)%count
432 if (store%files(i)%items(j)%server_index == server_index .and. &
433 store%files(i)%items(j)%range%start_line <= lsp_line .and. &
434 store%files(i)%items(j)%range%end_line >= lsp_line) then
435 count = count + 1
436 end if
437 end do
438
439 if (count > 0) then
440 deallocate(diagnostics)
441 allocate(diagnostics(count))
442 count = 0
443 do j = 1, store%files(i)%count
444 if (store%files(i)%items(j)%server_index == server_index .and. &
445 store%files(i)%items(j)%range%start_line <= lsp_line .and. &
446 store%files(i)%items(j)%range%end_line >= lsp_line) then
447 count = count + 1
448 diagnostics(count) = store%files(i)%items(j)
449 end if
450 end do
451 end if
452 exit
453 end if
454 end do
455 end function get_diagnostics_for_line_by_server
456
457 function get_diagnostic_at_cursor(store, uri, line, col) result(diagnostic)
458 type(diagnostics_store_t), intent(in) :: store
459 character(len=*), intent(in) :: uri
460 integer, intent(in) :: line, col ! 1-based editor position
461 type(diagnostic_t) :: diagnostic
462 integer :: i, j, lsp_line, lsp_col
463 logical :: found
464
465 lsp_line = line - 1 ! Convert to 0-based
466 lsp_col = col - 1
467
468 found = .false.
469 diagnostic%severity = SEVERITY_INFO
470 diagnostic%message = ""
471
472 do i = 1, store%file_count
473 if (store%files(i)%uri == uri) then
474 do j = 1, store%files(i)%count
475 if (lsp_line >= store%files(i)%items(j)%range%start_line .and. &
476 lsp_line <= store%files(i)%items(j)%range%end_line) then
477
478 ! Check column range if on same line
479 if ((lsp_line == store%files(i)%items(j)%range%start_line .and. &
480 lsp_col >= store%files(i)%items(j)%range%start_col) .or. &
481 (lsp_line == store%files(i)%items(j)%range%end_line .and. &
482 lsp_col <= store%files(i)%items(j)%range%end_col) .or. &
483 (lsp_line > store%files(i)%items(j)%range%start_line .and. &
484 lsp_line < store%files(i)%items(j)%range%end_line)) then
485
486 diagnostic = store%files(i)%items(j)
487 found = .true.
488 exit
489 end if
490 end if
491 end do
492 exit
493 end if
494 end do
495 end function get_diagnostic_at_cursor
496
497 function has_diagnostics_for_file(store, uri) result(has_diags)
498 type(diagnostics_store_t), intent(in) :: store
499 character(len=*), intent(in) :: uri
500 logical :: has_diags
501 integer :: i
502
503 has_diags = .false.
504 do i = 1, store%file_count
505 if (store%files(i)%uri == uri) then
506 has_diags = store%files(i)%count > 0
507 exit
508 end if
509 end do
510 end function has_diagnostics_for_file
511
512 function get_diagnostics_for_file(store, uri) result(diagnostics)
513 type(diagnostics_store_t), intent(in) :: store
514 character(len=*), intent(in) :: uri
515 type(diagnostic_t), allocatable :: diagnostics(:)
516 integer :: i
517
518 ! Find file and return all its diagnostics
519 do i = 1, store%file_count
520 if (store%files(i)%uri == uri) then
521 if (store%files(i)%count > 0) then
522 allocate(diagnostics(store%files(i)%count))
523 diagnostics = store%files(i)%items(1:store%files(i)%count)
524 else
525 allocate(diagnostics(0))
526 end if
527 return
528 end if
529 end do
530
531 ! File not found, return empty array
532 allocate(diagnostics(0))
533 end function get_diagnostics_for_file
534
535 ! Convert diagnostics array to JSON array for LSP codeAction context
536 function diagnostics_to_json(diagnostics) result(json_array)
537 use json_module, only: json_value_t, json_create_array, json_create_object, &
538 json_add_string, json_add_number, json_add_object, &
539 json_array_add_element, json_parse
540 use iso_fortran_env, only: real64
541 type(diagnostic_t), intent(in) :: diagnostics(:)
542 type(json_value_t) :: json_array
543 type(json_value_t) :: diag_obj, range_obj, start_pos, end_pos, data_obj
544 integer :: i
545
546 json_array = json_create_array()
547
548 do i = 1, size(diagnostics)
549 diag_obj = json_create_object()
550
551 ! Build range object
552 range_obj = json_create_object()
553 start_pos = json_create_object()
554 call json_add_number(start_pos, "line", real(diagnostics(i)%range%start_line, real64))
555 call json_add_number(start_pos, "character", real(diagnostics(i)%range%start_col, real64))
556 call json_add_object(range_obj, "start", start_pos)
557
558 end_pos = json_create_object()
559 call json_add_number(end_pos, "line", real(diagnostics(i)%range%end_line, real64))
560 call json_add_number(end_pos, "character", real(diagnostics(i)%range%end_col, real64))
561 call json_add_object(range_obj, "end", end_pos)
562
563 call json_add_object(diag_obj, "range", range_obj)
564
565 ! Add severity
566 call json_add_number(diag_obj, "severity", real(diagnostics(i)%severity, real64))
567
568 ! Add message
569 if (allocated(diagnostics(i)%message)) then
570 call json_add_string(diag_obj, "message", diagnostics(i)%message)
571 else
572 call json_add_string(diag_obj, "message", "")
573 end if
574
575 ! Add source if present (use nested if to ensure short-circuit evaluation)
576 if (allocated(diagnostics(i)%source)) then
577 if (len_trim(diagnostics(i)%source) > 0) then
578 call json_add_string(diag_obj, "source", diagnostics(i)%source)
579 end if
580 end if
581
582 ! Add code if present (use nested if to ensure short-circuit evaluation)
583 if (allocated(diagnostics(i)%code)) then
584 if (len_trim(diagnostics(i)%code) > 0) then
585 call json_add_string(diag_obj, "code", diagnostics(i)%code)
586 end if
587 end if
588
589 ! Add data field if present (required for Ruff quickfixes, LSP-agnostic)
590 if (allocated(diagnostics(i)%data)) then
591 if (len_trim(diagnostics(i)%data) > 0) then
592 data_obj = json_parse(diagnostics(i)%data)
593 call json_add_object(diag_obj, "data", data_obj)
594 end if
595 end if
596
597 call json_array_add_element(json_array, diag_obj)
598 end do
599 end function diagnostics_to_json
600
601 end module diagnostics_module