Skip to content

Commit

Permalink
Communicate READER to merlin for configured dialects (ocaml#8567)
Browse files Browse the repository at this point in the history 
* refactor: best effort to track orig module sources

This is going to be useful for more granular merlin configs.

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* refactor: per file merlin configs, communicate merlin reader

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* test: promote merlin tests

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* test: add merlin/dialect.t tests

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* test: add a test focusing on merlin's configuration various granularity levels

Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>
Signed-off-by: Andrey Popp <8mayday@gmail.com>
Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>

* test: tweak the prev commit (to be squashed)

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* wip: Module.File.t not to encode orig_path

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* merlin: lookup fallback with extensionless filename

Relying on `.ml` extension present is not something we can do, instead
store same config with and without extension and on lookup do a fallback
with no extension.

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* Apply suggestions from code review

Co-authored-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Signed-off-by: Andrey Popp <8mayday@gmail.com>

* Extract `handle_ml_kind` to the outside scope.

Co-authored-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Signed-off-by: Andrey Popp <8mayday@gmail.com>

* Use Filename.Extension.t for file extensions

Co-authored-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Signed-off-by: Andrey Popp <8mayday@gmail.com>

* tests: update merlin/dialect tests

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* More descriptive naming in Module

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* promote tests

due to dune 3.16

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* merlin: test merlin config for promoted modules

Signed-off-by: Andrey Popp <8mayday@gmail.com>

* doc: describe changes

Signed-off-by: Andrey Popp <8mayday@gmail.com>

---------

Signed-off-by: Andrey Popp <8mayday@gmail.com>
Signed-off-by: Ulysse Gérard <thevoodoos@gmail.com>
Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Co-authored-by: Ulysse Gérard <thevoodoos@gmail.com>
Co-authored-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
  • Loading branch information
@andreypopp @voodoos @anmonteiro
3 people committed Nov 17, 2024
1 parent 91772ec commit c46ace9
Show file tree
Hide file tree
Showing 31 changed files with 1,148 additions and 77 deletions.
3 changes: 3 additions & 0 deletions doc/changes/8567.md
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
- merlin: add optional `(merlin_reader CMD)` construct to `(dialect)` stanza to
configure a merlin reader (#8567, @andreypopp)

90 changes: 63 additions & 27 deletions src/dune_rules/dialect.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,10 @@ module File_kind = struct
; preprocess : (Loc.t * Action.t) option
; format : (Loc.t * Action.t * string list) option
; print_ast : (Loc.t * Action.t) option
; merlin_reader : (Loc.t * string list) option
}

let encode { kind; extension; preprocess; format; print_ast } =
let encode { kind; extension; preprocess; format; print_ast; merlin_reader } =
let open Dune_lang.Encoder in
let kind =
string
Expand All @@ -33,17 +34,19 @@ module File_kind = struct
"print_ast"
Action.encode
(Option.map ~f:(fun (_, x) -> x) print_ast)
; field_o "merlin_reader" (list string) (Option.map ~f:snd merlin_reader)
])
;;

let to_dyn { kind; extension; preprocess; format; print_ast } =
let to_dyn { kind; extension; preprocess; format; print_ast; merlin_reader } =
let open Dyn in
record
[ "kind", Ml_kind.to_dyn kind
; "extension", string extension
; "preprocess", option (fun (_, x) -> Action.to_dyn x) preprocess
; "format", option (fun (_, x, y) -> pair Action.to_dyn (list string) (x, y)) format
; "print_ast", option (fun (_, x) -> Action.to_dyn x) print_ast
; "merlin_reader", option (fun (_, x) -> list string x) merlin_reader
]
;;
end
Expand Down Expand Up @@ -85,13 +88,17 @@ let decode =
"format"
(map ~f:(fun (loc, x) -> loc, x, []) (located Action.decode_dune_file))
and+ print_ast = field_o "print_ast" (located Action.decode_dune_file)
and+ merlin_reader =
field_o
"merlin_reader"
(Dune_lang.Syntax.since Stanza.syntax (3, 16) >>> located (repeat1 string))
and+ syntax_ver = Syntax.get_exn Stanza.syntax in
let ver = 3, 9 in
if syntax_ver < ver && Option.is_some (String.index_from extension 1 '.')
then (
let what = "the possibility of defining extensions containing periods" in
Syntax.Error.since loc Stanza.syntax ver ~what);
{ File_kind.kind; extension; preprocess; format; print_ast }
{ File_kind.kind; extension; preprocess; format; print_ast; merlin_reader }
in
fields
(let+ name = field "name" string
Expand Down Expand Up @@ -143,6 +150,13 @@ let print_ast { file_kinds; _ } ml_kind =
x.print_ast
;;

let merlin_reader { file_kinds; _ } ml_kind =
let open Option.O in
let* dialect = Ml_kind.Dict.get file_kinds ml_kind in
let+ _, merlin_reader = dialect.merlin_reader in
merlin_reader
;;

let ocaml =
let format kind =
let flag_of_kind = function
Expand Down Expand Up @@ -180,6 +194,7 @@ let ocaml =
, format kind
, [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ] )
; print_ast = Some (Loc.none, print_ast kind)
; merlin_reader = None
}
in
let intf = Some (file_kind Ml_kind.Intf ".mli") in
Expand Down Expand Up @@ -222,6 +237,7 @@ let reason =
; preprocess = Some (Loc.none, preprocess)
; format = Some (Loc.none, format, [])
; print_ast = Some (Loc.none, print_ast)
; merlin_reader = None
}
in
let intf = Some (file_kind Ml_kind.Intf ".rei") in
Expand Down Expand Up @@ -251,6 +267,7 @@ let rescript =
; preprocess = Some (Loc.none, preprocess)
; format = Some (Loc.none, format, [])
; print_ast = None
; merlin_reader = None
}
in
let intf = Some (file_kind Ml_kind.Intf ".resi") in
Expand All @@ -271,43 +288,62 @@ module DB = struct
type t =
{ by_name : dialect String.Map.t
; by_extension : dialect Filename.Extension.Map.t
; mutable extensions_for_merlin : string option Ml_kind.Dict.t list option
; for_merlin : for_merlin Lazy.t
}

and for_merlin =
{ extensions : Filename.Extension.t option Ml_kind.Dict.t list
; readers : Filename.Extension.t list String.Map.t
}

let fold { by_name; _ } = String.Map.fold by_name

let empty =
{ by_name = String.Map.empty
; by_extension = Filename.Extension.Map.empty
; extensions_for_merlin = None
; for_merlin = lazy { extensions = []; readers = String.Map.empty }
}
;;

let set_extensions_for_merlin t =
let v =
fold t ~init:[] ~f:(fun d s ->
let impl = extension d Ml_kind.Impl in
let intf = extension d Ml_kind.Intf in
if (* Only include dialects with no preprocessing and skip default file
extensions *)
preprocess d Ml_kind.Impl <> None
|| preprocess d Ml_kind.Intf <> None
|| (impl = extension ocaml Ml_kind.Impl && intf = extension ocaml Ml_kind.Intf)
then s
else { Ml_kind.Dict.impl; intf } :: s)
|> List.sort ~compare:(Ml_kind.Dict.compare (Option.compare String.compare))
let compute_for_merlin =
let handle_ml_kind ~dialect kind readers =
let ext = extension dialect kind in
if ext = extension ocaml kind
then (* this is standard dialect, exclude *) None, readers
else (
match ext, merlin_reader dialect kind with
| Some ext, Some reader -> Some ext, String.Map.add_exn readers ext reader
| _ ->
if preprocess dialect kind <> None
then (* we have preprocessor defined *) None, readers
else ext, readers)
in
t.extensions_for_merlin <- Some v;
v
fun by_name ->
let extensions, readers =
String.Map.fold
by_name
~init:([], String.Map.empty)
~f:(fun dialect (extensions, readers) ->
let impl, readers = handle_ml_kind ~dialect Ml_kind.Impl readers in
let intf, readers = handle_ml_kind ~dialect Ml_kind.Intf readers in
let extensions =
match impl, intf with
| None, None -> extensions
| _ -> { Ml_kind.Dict.impl; intf } :: extensions
in
extensions, readers)
in
let extensions =
List.sort
~compare:(Ml_kind.Dict.compare (Option.compare String.compare))
extensions
in
{ extensions; readers }
;;

let extensions_for_merlin t =
match t.extensions_for_merlin with
| Some s -> s
| None -> set_extensions_for_merlin t
;;
let for_merlin t = Lazy.force t.for_merlin

let add { by_name; by_extension; extensions_for_merlin = _ } ~loc dialect =
let add { by_name; by_extension; for_merlin = _ } ~loc dialect =
let by_name =
match String.Map.add by_name dialect.name dialect with
| Ok by_name -> by_name
Expand All @@ -331,7 +367,7 @@ module DB = struct
let by_extension =
add_ext (add_ext by_extension dialect.file_kinds.intf) dialect.file_kinds.impl
in
{ by_name; by_extension; extensions_for_merlin = None }
{ by_name; by_extension; for_merlin = lazy (compute_for_merlin by_name) }
;;

let of_list dialects = List.fold_left ~f:(add ~loc:Loc.none) ~init:empty dialects
Expand Down
8 changes: 7 additions & 1 deletion src/dune_rules/dialect.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,8 +43,14 @@ module DB : sig
val find_by_name : t -> string -> dialect option
val find_by_extension : t -> Filename.Extension.t -> (dialect * Ml_kind.t) option
val fold : t -> init:'a -> f:(dialect -> 'a -> 'a) -> 'a
val extensions_for_merlin : t -> Filename.Extension.t option Ml_kind.Dict.t list
val to_dyn : t -> Dyn.t
val builtin : t
val is_default : t -> bool

type for_merlin =
{ extensions : string option Ml_kind.Dict.t list
; readers : Filename.Extension.t list String.Map.t
}

val for_merlin : t -> for_merlin
end
Loading

0 comments on commit c46ace9

Please sign in to comment.