Skip to content

Commit

Permalink
add config to control dune diagnostics
Browse files Browse the repository at this point in the history
  • Loading branch information
@EduardoRFS
EduardoRFS committed Jan 5, 2024
1 parent d3d8de5 commit c6e6d43
Show file tree
Hide file tree
Showing 5 changed files with 153 additions and 10 deletions.
7 changes: 7 additions & 0 deletions ocaml-lsp-server/docs/ocamllsp/config.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,5 +21,12 @@ interface config {
* @since 1.16
*/
codelens: { enable : boolean }

/**
* Enable/Disable Dune diagnostics
* @default true
* @since 1.18
*/
duneDiagnostics: { enable : boolean }
}
```
111 changes: 108 additions & 3 deletions ocaml-lsp-server/src/config_data.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -145,11 +145,85 @@ module ExtendedHover = struct
[@@@end]
end

module DuneDiagnostics = struct
type t = { enable : bool [@default true] }
[@@deriving_inline yojson] [@@yojson.allow_extra_fields]

let _ = fun (_ : t) -> ()

let t_of_yojson =
(let _tp_loc = "ocaml-lsp-server/src/config_data.ml.DuneDiagnostics.t" in
function
| `Assoc field_yojsons as yojson -> (
let enable_field = ref Ppx_yojson_conv_lib.Option.None
and duplicates = ref []
and extra = ref [] in
let rec iter = function
| (field_name, _field_yojson) :: tail ->
(match field_name with
| "enable" -> (
match Ppx_yojson_conv_lib.( ! ) enable_field with
| Ppx_yojson_conv_lib.Option.None ->
let fvalue = bool_of_yojson _field_yojson in
enable_field := Ppx_yojson_conv_lib.Option.Some fvalue
| Ppx_yojson_conv_lib.Option.Some _ ->
duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
| _ -> ());
iter tail
| [] -> ()
in
iter field_yojsons;
match Ppx_yojson_conv_lib.( ! ) duplicates with
| _ :: _ ->
Ppx_yojson_conv_lib.Yojson_conv_error.record_duplicate_fields
_tp_loc
(Ppx_yojson_conv_lib.( ! ) duplicates)
yojson
| [] -> (
match Ppx_yojson_conv_lib.( ! ) extra with
| _ :: _ ->
Ppx_yojson_conv_lib.Yojson_conv_error.record_extra_fields
_tp_loc
(Ppx_yojson_conv_lib.( ! ) extra)
yojson
| [] ->
let enable_value = Ppx_yojson_conv_lib.( ! ) enable_field in
{ enable =
(match enable_value with
| Ppx_yojson_conv_lib.Option.None -> true
| Ppx_yojson_conv_lib.Option.Some v -> v)
}))
| _ as yojson ->
Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom
_tp_loc
yojson
: Ppx_yojson_conv_lib.Yojson.Safe.t -> t)

let _ = t_of_yojson

let yojson_of_t =
(function
| { enable = v_enable } ->
let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in
let bnds =
let arg = yojson_of_bool v_enable in
("enable", arg) :: bnds
in
`Assoc bnds
: t -> Ppx_yojson_conv_lib.Yojson.Safe.t)

let _ = yojson_of_t

[@@@end]
end

type t =
{ codelens : Lens.t Json.Nullable_option.t
[@default None] [@yojson_drop_default ( = )]
; extended_hover : ExtendedHover.t Json.Nullable_option.t
[@key "extendedHover"] [@default None] [@yojson_drop_default ( = )]
; dune_diagnostics : DuneDiagnostics.t Json.Nullable_option.t
[@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )]
}
[@@deriving_inline yojson] [@@yojson.allow_extra_fields]

Expand All @@ -161,6 +235,7 @@ let t_of_yojson =
| `Assoc field_yojsons as yojson -> (
let codelens_field = ref Ppx_yojson_conv_lib.Option.None
and extended_hover_field = ref Ppx_yojson_conv_lib.Option.None
and dune_diagnostics_field = ref Ppx_yojson_conv_lib.Option.None
and duplicates = ref []
and extra = ref [] in
let rec iter = function
Expand All @@ -186,6 +261,17 @@ let t_of_yojson =
extended_hover_field := Ppx_yojson_conv_lib.Option.Some fvalue
| Ppx_yojson_conv_lib.Option.Some _ ->
duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
| "duneDiagnostics" -> (
match Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field with
| Ppx_yojson_conv_lib.Option.None ->
let fvalue =
Json.Nullable_option.t_of_yojson
DuneDiagnostics.t_of_yojson
_field_yojson
in
dune_diagnostics_field := Ppx_yojson_conv_lib.Option.Some fvalue
| Ppx_yojson_conv_lib.Option.Some _ ->
duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates)
| _ -> ());
iter tail
| [] -> ()
Expand All @@ -205,9 +291,10 @@ let t_of_yojson =
(Ppx_yojson_conv_lib.( ! ) extra)
yojson
| [] ->
let codelens_value, extended_hover_value =
let codelens_value, extended_hover_value, dune_diagnostics_value =
( Ppx_yojson_conv_lib.( ! ) codelens_field
, Ppx_yojson_conv_lib.( ! ) extended_hover_field )
, Ppx_yojson_conv_lib.( ! ) extended_hover_field
, Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field )
in
{ codelens =
(match codelens_value with
Expand All @@ -217,6 +304,10 @@ let t_of_yojson =
(match extended_hover_value with
| Ppx_yojson_conv_lib.Option.None -> None
| Ppx_yojson_conv_lib.Option.Some v -> v)
; dune_diagnostics =
(match dune_diagnostics_value with
| Ppx_yojson_conv_lib.Option.None -> None
| Ppx_yojson_conv_lib.Option.Some v -> v)
}))
| _ as yojson ->
Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom
Expand All @@ -228,8 +319,21 @@ let _ = t_of_yojson

let yojson_of_t =
(function
| { codelens = v_codelens; extended_hover = v_extended_hover } ->
| { codelens = v_codelens
; extended_hover = v_extended_hover
; dune_diagnostics = v_dune_diagnostics
} ->
let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in
let bnds =
if None = v_dune_diagnostics then bnds
else
let arg =
(Json.Nullable_option.yojson_of_t DuneDiagnostics.yojson_of_t)
v_dune_diagnostics
in
let bnd = ("duneDiagnostics", arg) in
bnd :: bnds
in
let bnds =
if None = v_extended_hover then bnds
else
Expand Down Expand Up @@ -259,4 +363,5 @@ let _ = yojson_of_t
let default =
{ codelens = Some { enable = false }
; extended_hover = Some { enable = false }
; dune_diagnostics = Some { enable = true }
}
23 changes: 17 additions & 6 deletions ocaml-lsp-server/src/diagnostics.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,9 +87,11 @@ type t =
; mutable dirty_uris : Uri_set.t
; related_information : bool
; tags : DiagnosticTag.t list
; mutable report_dune_diagnostics : bool
}

let create (capabilities : PublishDiagnosticsClientCapabilities.t option) send =
let create (capabilities : PublishDiagnosticsClientCapabilities.t option) send
~report_dune_diagnostics =
let related_information, tags =
match capabilities with
| None -> (false, [])
Expand All @@ -105,6 +107,7 @@ let create (capabilities : PublishDiagnosticsClientCapabilities.t option) send =
; send
; related_information
; tags
; report_dune_diagnostics
}

let send =
Expand Down Expand Up @@ -157,11 +160,12 @@ let send =
{ d with source }
else fun _pid x -> x
in
Table.foldi ~init:() t.dune ~f:(fun dune per_dune () ->
Table.iter per_dune ~f:(fun (uri, diagnostic) ->
if Uri_set.mem dirty_uris uri then
let diagnostic = set_dune_source dune.pid diagnostic in
add_dune_diagnostic pending uri diagnostic));
if t.report_dune_diagnostics then
Table.foldi ~init:() t.dune ~f:(fun dune per_dune () ->
Table.iter per_dune ~f:(fun (uri, diagnostic) ->
if Uri_set.mem dirty_uris uri then
let diagnostic = set_dune_source dune.pid diagnostic in
add_dune_diagnostic pending uri diagnostic));
t.dirty_uris <-
(match which with
| `All -> Uri_set.empty
Expand Down Expand Up @@ -359,3 +363,10 @@ let merlin_diagnostics diagnostics merlin =
Range.compare d1.range d2.range))
in
set diagnostics (`Merlin (uri, all_diagnostics))

let set_report_dune_diagnostics t ~report_dune_diagnostics =
t.report_dune_diagnostics <- report_dune_diagnostics;
Table.iter t.dune ~f:(fun per_dune ->
Table.iter per_dune ~f:(fun (uri, _diagnostic) ->
t.dirty_uris <- Uri_set.add t.dirty_uris uri));
send t `All
4 changes: 4 additions & 0 deletions ocaml-lsp-server/src/diagnostics.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ type t
val create :
PublishDiagnosticsClientCapabilities.t option
-> (PublishDiagnosticsParams.t list -> unit Fiber.t)
-> report_dune_diagnostics:bool
-> t

val send : t -> [ `All | `One of Uri.t ] -> unit Fiber.t
Expand Down Expand Up @@ -36,6 +37,9 @@ val tags_of_message :

val merlin_diagnostics : t -> Document.Merlin.t -> unit Fiber.t

val set_report_dune_diagnostics :
t -> report_dune_diagnostics:bool -> unit Fiber.t

(** Exposed for testing *)

val equal_message : string -> string -> bool
18 changes: 17 additions & 1 deletion ocaml-lsp-server/src/ocaml_lsp_server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,6 +209,11 @@ let on_initialize server (ip : InitializeParams.t) =
let state : State.t = Server.state server in
let workspaces = Workspaces.create ip in
let diagnostics =
let report_dune_diagnostics =
match state.configuration.data.dune_diagnostics with
| Some { enable = true } | None -> true
| Some { enable = false } -> false
in
Diagnostics.create
(let open Option.O in
let* td = ip.capabilities.textDocument in
Expand All @@ -222,6 +227,7 @@ let on_initialize server (ip : InitializeParams.t) =
List.iter diagnostics ~f:(fun d ->
Server.Batch.notification batch (PublishDiagnostics d));
Server.Batch.submit batch))
~report_dune_diagnostics
in
let+ dune =
let progress =
Expand Down Expand Up @@ -702,7 +708,17 @@ let on_notification server (notification : Client_notification.t) :
state
| CancelRequest _ -> Fiber.return state
| ChangeConfiguration req ->
let+ configuration = Configuration.update state.configuration req in
let* configuration = Configuration.update state.configuration req in
let+ () =
let report_dune_diagnostics =
match configuration.data.dune_diagnostics with
| Some { enable = true } | None -> true
| Some { enable = false } -> false
in
Diagnostics.set_report_dune_diagnostics
(State.diagnostics state)
~report_dune_diagnostics
in
{ state with configuration }
| DidSaveTextDocument { textDocument = { uri }; _ } -> (
let state = Server.state server in
Expand Down

0 comments on commit c6e6d43

Please sign in to comment.