[Wait for OcamlLSP] Disable promotion of .merlin files and work on ocaml-merlin server

CHANGES.md

@@ -97,6 +97,11 @@ Unreleased
   preprocessing, to let merlin know of additional file extensions
   (#3977, @vouillon)
 
+- Stop promoting `.merlin` files. Write per-stanza Merlin configurations in
+  binary form. Add a new subcommand `dune ocaml-merlin` that Merlin can use to
+  query the configuration files. The `allow_approximate_merlin` option is now
+  useless and deprecated. (#3554, @voodoos)
+
 2.7.1 (2/09/2020)
 -----------------
 

bin/ocaml_merlin.ml

@@ -16,12 +16,26 @@ let man =
 let info = Term.info "ocaml-merlin" ~doc ~man
 
 let term =
-  let+ common = Common.term in
+  let+ common = Common.term
+  and+ dump_config =
+    Arg.(
+      value
+      & opt (some string) None
+      & info [ "dump-config" ]
+          ~doc:
+            "Prints the entire content of the merlin configuration for the \
+             given folder in a user friendly form. This is for testing and \
+             debugging purposes only and should not be considered as a stable \
+             ouptut.")
+  in
   Common.set_common common ~targets:[];
   Scheduler.go ~common (fun () ->
       Dune_engine.File_tree.init ~recognize_jbuilder_projects:true
         ~ancestor_vcs:None;
       Dune_rules.Workspace.init ();
-      Dune_rules.Merlin_server.start () |> Fiber.return)
+      ( match dump_config with
+      | Some s -> Dune_rules.Merlin_server.dump s
+      | None -> Dune_rules.Merlin_server.start () )
+      |> Fiber.return)
 
 let command = (term, info)

doc/usage.rst

@@ -148,13 +148,10 @@ the command line. When no targets are specified, ``dune`` builds the
 Resolution
 ----------
 
-All targets that dune knows how to build live in the ``_build``
-directory.  Although, some are sometimes copied to the source tree for
-the need of external tools. These includes:
-
-- ``.merlin`` files
-- ``<package>.install`` files (when either ``-p`` or
-  ``--promote-install-files`` is passed on the command line)
+All targets that dune knows how to build live in the ``_build`` directory.
+Although, some are sometimes copied to the source tree for the need of external
+tools. These includes ``<package>.install`` files when either ``-p`` or
+``--promote-install-files`` is passed on the command line.
 
 As a result, if you want to ask ``dune`` to produce a particular ``.exe``
 file you would have to type:

dune-project

@@ -23,6 +23,7 @@
  (name dune)
  ; The "depends" and "build" field are written in dune.opam.template
  (conflicts
+  (merlin (< 3.4.0))
   (dune-configurator (< 2.3.0))
   (odoc (< 1.3.0))
   (dune-release (< 1.3.0))

dune.opam

@@ -27,6 +27,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 conflicts: [
+  "merlin" {< "3.4.0"}
   "dune-configurator" {< "2.3.0"}
   "odoc" {< "1.3.0"}
   "dune-release" {< "1.3.0"}

src/dune_engine/dune_project.ml

@@ -160,7 +160,6 @@ type t =
   ; implicit_transitive_deps : bool
   ; wrapped_executables : bool
   ; dune_version : Dune_lang.Syntax.Version.t
-  ; allow_approx_merlin : bool
   ; generate_opam_files : bool
   ; file_key : File_key.t
   ; dialects : Dialect.DB.t
@@ -190,8 +189,6 @@ let file_key t = t.file_key
 
 let implicit_transitive_deps t = t.implicit_transitive_deps
 
-let allow_approx_merlin t = t.allow_approx_merlin
-
 let generate_opam_files t = t.generate_opam_files
 
 let dialects t = t.dialects
@@ -211,7 +208,6 @@ let to_dyn
     ; implicit_transitive_deps
     ; wrapped_executables
     ; dune_version
-    ; allow_approx_merlin
     ; generate_opam_files
     ; file_key
     ; dialects
@@ -233,7 +229,6 @@ let to_dyn
     ; ("implicit_transitive_deps", bool implicit_transitive_deps)
     ; ("wrapped_executables", bool wrapped_executables)
     ; ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version)
-    ; ("allow_approx_merlin", bool allow_approx_merlin)
     ; ("generate_opam_files", bool generate_opam_files)
     ; ("file_key", string file_key)
     ; ("dialects", Dialect.DB.to_dyn dialects)
@@ -609,7 +604,6 @@ let infer ~dir packages =
   ; extension_args
   ; parsing_context
   ; dune_version = lang.version
-  ; allow_approx_merlin = true
   ; generate_opam_files = false
   ; file_key
   ; dialects = Dialect.DB.builtin
@@ -647,7 +641,7 @@ end
 
 let anonymous ~dir = infer ~dir Package.Name.Map.empty
 
-let parse ~dir ~lang ~opam_packages ~file =
+let parse ~dir ~lang ~opam_packages ~file ~dir_status =
   fields
     (let+ name = field_o "name" Name.decode
      and+ version = field_o "version" string
@@ -669,9 +663,28 @@ let parse ~dir ~lang ~opam_packages ~file =
      and+ wrapped_executables =
        field_o_b "wrapped_executables"
          ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11))
-     and+ allow_approx_merlin =
-       field_o_b "allow_approximate_merlin"
-         ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9))
+     and+ _allow_approx_merlin =
+       (* TODO DUNE3 remove this field from parsing *)
+       let+ loc = loc
+       and+ f =
+         field_o_b "allow_approximate_merlin"
+           ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9))
+       in
+       let vendored =
+         match dir_status with
+         | Sub_dirs.Status.Vendored -> true
+         | _ -> false
+       in
+       if
+         Option.is_some f
+         && Dune_lang.Syntax.Version.Infix.(lang.version >= (2, 8))
+         && not vendored
+       then
+         Dune_lang.Syntax.Warning.deprecated_in
+           ~extra_info:
+             "It is useless since the Merlin configurations are not ambiguous \
+              anymore."
+           loc lang.syntax (2, 8) ~what:"This field"
      and+ () = Dune_lang.Versioned_file.no_more_lang
      and+ generate_opam_files =
        field_o_b "generate_opam_files"
@@ -784,9 +797,6 @@ let parse ~dir ~lang ~opam_packages ~file =
          ~default:(strict_package_deps_default ~lang)
      in
      let dune_version = lang.version in
-     let allow_approx_merlin =
-       Option.value ~default:(dune_version < (1, 9)) allow_approx_merlin
-     in
      let explicit_js_mode =
        Option.value explicit_js_mode ~default:(explicit_js_mode_default ~lang)
      in
@@ -819,7 +829,6 @@ let parse ~dir ~lang ~opam_packages ~file =
      ; implicit_transitive_deps
      ; wrapped_executables
      ; dune_version
-     ; allow_approx_merlin
      ; generate_opam_files
      ; dialects
      ; explicit_js_mode
@@ -828,12 +837,12 @@ let parse ~dir ~lang ~opam_packages ~file =
      ; cram
      })
 
-let load_dune_project ~dir opam_packages =
+let load_dune_project ~dir opam_packages ~dir_status =
   let file = Path.Source.relative dir filename in
   load_exn (Path.source file) ~f:(fun lang ->
-      parse ~dir ~lang ~opam_packages ~file)
+      parse ~dir ~lang ~opam_packages ~file ~dir_status)
 
-let load ~dir ~files ~infer_from_opam_files =
+let load ~dir ~files ~infer_from_opam_files ~dir_status =
   let opam_packages =
     String.Set.fold files ~init:[] ~f:(fun fn acc ->
         match Package.Name.of_opam_file_basename fn with
@@ -849,7 +858,7 @@ let load ~dir ~files ~infer_from_opam_files =
     |> Package.Name.Map.of_list_exn
   in
   if String.Set.mem files filename then
-    Some (load_dune_project ~dir opam_packages)
+    Some (load_dune_project ~dir opam_packages ~dir_status)
   else if
     Path.Source.is_root dir
     || (infer_from_opam_files && not (Package.Name.Map.is_empty opam_packages))

src/dune_engine/dune_project.mli

@@ -63,8 +63,6 @@ val root : t -> Path.Source.t
 
 val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t
 
-val allow_approx_merlin : t -> bool
-
 val generate_opam_files : t -> bool
 
 val dialects : t -> Dialect.DB.t
@@ -127,6 +125,7 @@ val load :
      dir:Path.Source.t
   -> files:String.Set.t
   -> infer_from_opam_files:bool
+  -> dir_status:Sub_dirs.Status.t
   -> t option
 
 (** Create an anonymous project with no package rooted at the given directory *)

src/dune_engine/file_tree.ml

@@ -564,7 +564,7 @@ end = struct
     let project =
       match
         Dune_project.load ~dir:path ~files:readdir.files
-          ~infer_from_opam_files:true
+          ~infer_from_opam_files:true ~dir_status
       with
       | None -> Dune_project.anonymous ~dir:path
       | Some p -> p
@@ -618,7 +618,8 @@ end = struct
         else
           Option.value
             (Dune_project.load ~dir:path ~files:readdir.files
-               ~infer_from_opam_files:settings.recognize_jbuilder_projects)
+               ~infer_from_opam_files:settings.recognize_jbuilder_projects
+               ~dir_status)
             ~default:parent_dir.project
       in
       let vcs = get_vcs ~default:parent_dir.vcs ~readdir ~path in

src/dune_engine/persistent.ml

@@ -11,6 +11,8 @@ end
 module Make (D : Desc) = struct
   let magic = sprintf "DUNE-%sv%d:" D.name D.version
 
+  let to_string (v : D.t) = Printf.sprintf "%s%s" magic (Marshal.to_string v [])
+
   let dump file (v : D.t) =
     Io.with_file_out file ~f:(fun oc ->
         output_string oc magic;

src/dune_engine/persistent.mli

@@ -28,6 +28,8 @@ end
     [D.name] stored in the persistent file to locate the appropriate pretty
     printer. *)
 module Make (D : Desc) : sig
+  val to_string : D.t -> string
+
   val dump : Path.t -> D.t -> unit
 
   val load : Path.t -> D.t option

src/dune_rules/buildable_rules.ml

@@ -21,7 +21,8 @@ let with_lib_deps (t : Context.t) compile_info ~dir ~f =
   in
   let prefix =
     if t.merlin then
-      Path.Build.relative dir ".merlin-exists"
+      Merlin_ident.merlin_exists_path dir
+        (Lib.Compile.merlin_ident compile_info)
       |> Path.build |> Build.path >>> prefix
     else
       prefix

src/dune_rules/dune_init.ml

@@ -179,7 +179,7 @@ module Init_context = struct
     let project =
       match
         Dune_project.load ~dir:Path.Source.root ~files:String.Set.empty
-          ~infer_from_opam_files:true
+          ~infer_from_opam_files:true ~dir_status:Normal
       with
       | Some p -> p
       | None -> Dune_project.anonymous ~dir:Path.Source.root

src/dune_rules/exe_rules.ml

@@ -180,10 +180,12 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
       ~promote:exes.promote ~embed_in_plugin_libraries
   in
   ( cctx
-  , Merlin.make () ~requires:requires_compile ~flags ~modules
+  , Merlin.make ~requires:requires_compile ~flags ~modules
       ~preprocess:(Preprocess.Per_module.single_preprocess preprocess)
       ~obj_dir
-      ~dialects:(Dune_project.dialects (Scope.project scope)) )
+      ~dialects:(Dune_project.dialects (Scope.project scope))
+      ~ident:(Lib.Compile.merlin_ident compile_info)
+      () )
 
 let compile_info ~scope (exes : Dune_file.Executables.t) =
   let dune_version = Scope.project scope |> Dune_project.dune_version in

src/dune_rules/gen_rules.ml

@@ -225,26 +225,12 @@ let gen_rules sctx dir_contents cctxs expander
     For_stanza.of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope
       ~dir_contents ~expander ~files_to_install
   in
-  let allow_approx_merlin =
-    let dune_project = Scope.project scope in
-    let status =
-      let open Option.O in
-      let+ src_dir = File_tree.find_dir src_dir in
-      File_tree.Dir.status src_dir
-    in
-    let dir_is_vendored =
-      match status with
-      | Some Vendored -> true
-      | _ -> false
-    in
-    dir_is_vendored || Dune_project.allow_approx_merlin dune_project
-  in
-  Option.iter (Merlin.merge_all ~allow_approx_merlin merlins) ~f:(fun m ->
+  List.iter merlins ~f:(fun merlin ->
       let more_src_dirs =
         lib_src_dirs ~dir_contents |> List.rev_append source_dirs
       in
       Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander
-        (Merlin.add_source_dir m src_dir));
+        (Merlin.add_source_dir merlin src_dir));
   List.iter stanzas ~f:(fun stanza ->
       match (stanza : Stanza.t) with
       | Menhir.T m when Expander.eval_blang expander m.enabled_if -> (

src/dune_rules/lib.ml

@@ -1615,6 +1615,7 @@ module Compile = struct
     ; resolved_selects : Resolved_select.t list
     ; lib_deps_info : Lib_deps_info.t
     ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t
+    ; merlin_ident : Merlin_ident.t
     }
 
   let make_lib_deps_info ~user_written_deps ~pps ~kind =
@@ -1662,12 +1663,14 @@ module Compile = struct
         >>= Resolve.compile_closure_with_overlap_checks db
               ~stack:Dep_stack.empty ~forbidden_libraries:Map.empty )
     in
+    let merlin_ident = Merlin_ident.for_lib t.name in
     { direct_requires = requires
     ; requires_link
     ; resolved_selects = t.resolved_selects
     ; pps = t.pps
     ; lib_deps_info
     ; sub_systems = t.sub_systems
+    ; merlin_ident
     }
 
   let direct_requires t = t.direct_requires
@@ -1680,6 +1683,8 @@ module Compile = struct
 
   let lib_deps_info t = t.lib_deps_info
 
+  let merlin_ident t = t.merlin_ident
+
   let sub_systems t =
     Sub_system_name.Map.values t.sub_systems
     |> List.map ~f:(fun (lazy (Sub_system0.Instance.T ((module M), t))) ->
@@ -1831,12 +1836,14 @@ module DB = struct
          |> Result.map_error ~f:(fun e ->
                 Dep_path.prepend_exn e (Executables exes)))
     in
+    let merlin_ident = Merlin_ident.for_exes ~names:(List.map ~f:snd exes) in
     { Compile.direct_requires = res
     ; requires_link
     ; pps
     ; resolved_selects
     ; lib_deps_info
     ; sub_systems = Sub_system_name.Map.empty
+    ; merlin_ident
     }
 
   (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach

src/dune_rules/lib.mli

@@ -143,6 +143,8 @@ module Compile : sig
 
   val lib_deps_info : t -> Lib_deps_info.t
 
+  val merlin_ident : t -> Merlin_ident.t
+
   (** Sub-systems used in this compilation context *)
   val sub_systems : t -> sub_system list
 end

src/dune_rules/lib_rules.ml

@@ -420,10 +420,12 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents
     ; compile_info
     };
   ( cctx
-  , Merlin.make () ~requires:requires_compile ~flags ~modules
+  , Merlin.make ~requires:requires_compile ~flags ~modules
       ~preprocess:(Preprocess.Per_module.single_preprocess preprocess)
       ~libname:(snd lib.name) ~obj_dir
-      ~dialects:(Dune_project.dialects (Scope.project scope)) )
+      ~dialects:(Dune_project.dialects (Scope.project scope))
+      ~ident:(Lib.Compile.merlin_ident compile_info)
+      () )
 
 let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope :
     Compilation_context.t * Merlin.t =