diff --git a/CHANGES.md b/CHANGES.md index 44854ecf2d8..7535bf47d35 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -56,6 +56,10 @@ Unreleased - Cleanup temporary files after running `$ dune exec`. (#4260, fixes #4243, @rgrinberg) +- Add a new subcommand `dune ocaml dump-dot-merlin` that prints a mix of all the + merlin configuration of a directory (defaulting to the current directory) in + the Merlin configuration syntax. (#4250, @voodoos) + 2.8.2 (21/01/2021) ------------------ diff --git a/bin/ocaml.ml b/bin/ocaml.ml index 0605784e0e6..8457c1febcb 100644 --- a/bin/ocaml.ml +++ b/bin/ocaml.ml @@ -6,6 +6,7 @@ let group = ( Term.Group.Group [ in_group Utop.command ; in_group Ocaml_merlin.command + ; in_group Ocaml_merlin.Dump_dot_merlin.command ; in_group Top.command ] , info ) diff --git a/bin/ocaml_merlin.ml b/bin/ocaml_merlin.ml index c1610f29697..e4ffae7de05 100644 --- a/bin/ocaml_merlin.ml +++ b/bin/ocaml_merlin.ml @@ -20,7 +20,7 @@ let term = and+ dump_config = Arg.( value - & opt (some string) None + & opt ~vopt:(Some ".") (some string) None & info [ "dump-config" ] ~doc: "Prints the entire content of the merlin configuration for the \ @@ -29,17 +29,57 @@ let term = ouptut.") in Common.set_common common ~log_file:No_log_file ~targets:[]; - Scheduler.go ~common (fun () -> - Dune_engine.File_tree.init ~recognize_jbuilder_projects:true - ~ancestor_vcs:None; - let x = Common.x common in - let workspace_file = - Common.workspace_file common |> Option.map ~f:Arg.Path.path - in - Dune_rules.Workspace.init ?x ?workspace_file (); - ( match dump_config with - | Some s -> Dune_rules.Merlin_server.dump s - | None -> Dune_rules.Merlin_server.start () ) - |> Fiber.return) + Dune_engine.File_tree.init ~recognize_jbuilder_projects:true + ~ancestor_vcs:None; + let x = Common.x common in + let workspace_file = + Common.workspace_file common |> Option.map ~f:Arg.Path.path + in + Dune_rules.Workspace.init ?x ?workspace_file (); + match dump_config with + | Some s -> Dune_rules.Merlin_server.dump s + | None -> Dune_rules.Merlin_server.start () let command = (term, info) + +module Dump_dot_merlin = struct + let doc = "Print Merlin configuration" + + let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune ocaml dump-dot-merlin) will attempt to read previously + generated configuration in a source folder, merge them and print + it to the standard output in Merlin configuration syntax. The + output of this command should always be checked and adapted to + the project needs afterward.|} + ; Common.footer + ] + + let info = Term.info "dump-dot-merlin" ~doc ~man + + let term = + let+ common = Common.term + and+ path = + Arg.( + value + & pos 0 (some string) None + & info [] ~docv:"PATH" + ~doc: + "The path to the folder of which the configuration should be \ + printed. Defaults to the current directory.") + in + Common.set_common common ~log_file:No_log_file ~targets:[]; + Dune_engine.File_tree.init ~recognize_jbuilder_projects:true + ~ancestor_vcs:None; + let x = Common.x common in + let workspace_file = + Common.workspace_file common |> Option.map ~f:Arg.Path.path + in + Dune_rules.Workspace.init ?x ?workspace_file (); + match path with + | Some s -> Dune_rules.Merlin_server.dump_dot_merlin s + | None -> Dune_rules.Merlin_server.dump_dot_merlin "." + + let command = (term, info) +end diff --git a/bin/ocaml_merlin.mli b/bin/ocaml_merlin.mli index 6d988967f3a..da88812c8e8 100644 --- a/bin/ocaml_merlin.mli +++ b/bin/ocaml_merlin.mli @@ -1 +1,5 @@ val command : unit Cmdliner.Term.t * Cmdliner.Term.info + +module Dump_dot_merlin : sig + val command : unit Cmdliner.Term.t * Cmdliner.Term.info +end diff --git a/doc/usage.rst b/doc/usage.rst index 5f91fb92d04..0123df9916e 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -542,3 +542,51 @@ The `--prefix` directory should be used to specify the destination. If you are using plugins that depends on installed libraries which are not dependencies of the executables -- so libraries that need to be loaded at runtime -- you must copy the libraries manually to the destination directory. + +Querying Merlin configuration +============================= + +Since version 2.8 Dune does not promote ``.merlin`` files to the source +directories any more. Instead these configurations are stored in the `_build` +folder and Merlin communicates directly with Dune to obtain its configuration +via the `ocaml-merlin` subcommand. The Merlin configuration is now stanza +specific allowing finer control. The following commands are not needed for +normal use of Dune and Merlin but can provide insightful informations when +debugging or configuring non-standard projects. + +Printing the configuration +-------------------------- + +It is possible to manually query the generated configuration for debugging +purposes: + +:: + + $ dune ocaml-merlin --dump-config + +This command will print the distinct configuration of each module present in the +current directory. This directory must be in a Dune workspace and the project +must be already built. The configuration will be encoded as a s-expressions, which +are used to communicate with Merlin. + +Printing an approximated ``.merlin`` +------------------------------------ + +It is also possible to print the configuration of the current folder in the +Merlin configuration syntax by running the following command: + +:: + + $ dune ocaml dump-dot-merlin > .merlin + +In that case only one configuration will be printed which is the result of a +coarse merge of the configurations of the various modules present in the current +folder. This folder must be in a Dune workspace and the project must be already +built. Preprocessing directives and other flags will be commented out and must +be un-commented afterward. This feature does not aim at writing exact or correct +``.merlin`` files, its sole purpose is to lessen the burden of writing the +configuration from scratch. + +Both these commands also support an optional path to specify the target +directory. This directory must be in a Dune workspace and the project must have +already been built. diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 7975e6203ff..0c7035598f2 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -78,6 +78,50 @@ module Processed = struct (List.concat [ stdlib_dir; exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ]) + let quote_for_dot_merlin s = + let s = + if Sys.win32 then + (* We need this hack because merlin unescapes backslashes (except when + protected by single quotes). It is only a problem on windows because + Filename.quote is using double quotes. *) + String.escape_only '\\' s + else + s + in + if String.need_quoting s then + Filename.quote s + else + s + + let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions = + let serialize_path p = Path.to_absolute_filename p in + let b = Buffer.create 256 in + let printf = Printf.bprintf b in + let print = Buffer.add_string b in + Buffer.clear b; + print "EXCLUDE_QUERY_DIR\n"; + printf "STDLIB %s\n" (serialize_path stdlib_dir); + Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); + Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); + List.iter extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> + printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf)); + + (* We print all FLG directives as comments *) + List.iter pp_configs + ~f: + (Module_name.Per_item.fold ~init:() ~f:(fun pp () -> + Option.iter pp ~f:(fun { flag; args } -> + printf "# FLG %s\n" (flag ^ " " ^ quote_for_dot_merlin args)))); + + List.iter flags ~f:(fun flags -> + match flags with + | [] -> () + | flags -> + print "# FLG"; + List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); + print "\n"); + Buffer.contents b + let get { modules; pp_config; config } ~filename = let fname = Filename.remove_extension filename |> String.lowercase in List.find_opt modules ~f:(fun name -> @@ -101,6 +145,37 @@ module Processed = struct ++ Pp.newline in Format.printf "%a%!" Pp.to_fmt (Pp.concat_map modules ~f:pp_one) + + let print_generic_dot_merlin paths = + let configs = List.filter_map paths ~f:load_file in + match configs with + | [] -> Printf.eprintf "No merlin config found" + | init :: tl -> + let pp_configs, obj_dirs, src_dirs, flags, extensions = + (* We merge what is easy to merge and ignore the rest *) + List.fold_left tl + ~init: + ( [ init.pp_config ] + , init.config.obj_dirs + , init.config.src_dirs + , [ init.config.flags ] + , init.config.extensions ) + ~f: + (fun (acc_pp, acc_obj, acc_src, acc_flags, acc_ext) + { modules = _ + ; pp_config + ; config = + { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions } + } -> + ( pp_config :: acc_pp + , Path.Set.union acc_obj obj_dirs + , Path.Set.union acc_src src_dirs + , flags :: acc_flags + , extensions @ acc_ext )) + in + Printf.printf "%s\n" + (to_dot_merlin init.config.stdlib_dir pp_configs flags obj_dirs src_dirs + extensions) end module Unprocessed = struct diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 2259b020312..6c4fffa9449 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -19,8 +19,14 @@ module Processed : sig val load_file : Path.t -> t option + (** [print_file path] reads the configuration at path [path] and print it as a + s-expression *) val print_file : Path.t -> unit + (** [print_generic_dot_merlin paths] will merge the given configurations and + print the resulting configuration in dot-merlin syntax. *) + val print_generic_dot_merlin : Path.t list -> unit + val get : t -> filename:string -> Sexp.t option end diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index 2ec265831b7..70f11089c40 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -132,6 +132,13 @@ let dump s = List.iter (get_merlin_files_paths path) ~f:Merlin.Processed.print_file | Error mess -> Printf.eprintf "%s\n%!" mess +let dump_dot_merlin s = + match to_local s with + | Ok path -> + let files = get_merlin_files_paths path in + Merlin.Processed.print_generic_dot_merlin files + | Error mess -> Printf.eprintf "%s\n%!" mess + let start () = let rec main () = match Commands.read_input stdin with diff --git a/src/dune_rules/merlin_server.mli b/src/dune_rules/merlin_server.mli index 408706b5b26..9c434c4fddb 100644 --- a/src/dune_rules/merlin_server.mli +++ b/src/dune_rules/merlin_server.mli @@ -3,6 +3,8 @@ open! Dune_engine val dump : string -> unit +val dump_dot_merlin : string -> unit + (** Once started the server will wait for commands on stdin, read the requested merlin dot file and return its content on stdout. The server will halt when reiceving EOF of a bad csexp. *) diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/dune-project b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/dune-project new file mode 100644 index 00000000000..c2e46604eed --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/dune-project @@ -0,0 +1 @@ +(lang dune 2.8) diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/p p/dune b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/p p/dune new file mode 100644 index 00000000000..92bc0106c3b --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/p p/dune @@ -0,0 +1,2 @@ +(executable + (name pp)) diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/p p/pp.ml b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/p p/pp.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t new file mode 100644 index 00000000000..c8967622dc9 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t @@ -0,0 +1,18 @@ + $ dune build + $ dune ocaml dump-dot-merlin src\ with\ spaces | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' + EXCLUDE_QUERY_DIR + STDLIB OPAM_PREFIX/lib/ocaml + B $TESTCASE_ROOT/_build/default/src with spaces/.foo.eobjs/byte + S $TESTCASE_ROOT/src with spaces + # FLG -pp ''\''$TESTCASE_ROOT/_build/default/p p/pp.exe'\''' + # FLG -open Dune__exe -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs + + $ dune ocaml dump-dot-merlin "p p" | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' + EXCLUDE_QUERY_DIR + STDLIB OPAM_PREFIX/lib/ocaml + B $TESTCASE_ROOT/_build/default/p p/.pp.eobjs/byte + S $TESTCASE_ROOT/p p + # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs + diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/bar.ml b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/bar.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/dune b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/dune new file mode 100644 index 00000000000..7e0e227379b --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/dune @@ -0,0 +1,3 @@ +(executables (names foo bar) + (preprocess (per_module + ((action (run "p p/pp.exe"%{input-file})) bar)))) diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/foo.ml b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/src with spaces/foo.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t b/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t index 9824f8e8bf0..ad82dc4cd2b 100644 --- a/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t @@ -28,6 +28,5 @@ Dune ocaml-merlin also accepts paths relative to the current directory $ dune ocaml-merlin --dump-config="." --root=".." | > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' | > head -n 2 - Entering directory '..' Foo ((STDLIB OPAM_PREFIX/lib/ocaml) diff --git a/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t b/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t index 777d48c56ec..dc5cd722984 100644 --- a/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t @@ -58,20 +58,6 @@ -keep-locs))) FIXME : module Foo is not unbound - $ ocamlmerlin single errors -filename foo.ml < foo.ml | jq ".value" - [ - { - "start": { - "line": 1, - "col": 10 - }, - "end": { - "line": 1, - "col": 25 - }, - "type": "typer", - "sub": [], - "valid": true, - "message": "Unbound module Foo" - } - ] +This test is disabled because it depends on root detection and is not reproducible. +$ ocamlmerlin single errors -filename foo.ml < foo.ml | jq ".value.message" +"Unbound module Foo"