Vendored code support (ocaml#2318)

Vendored code support

doc/dune-files.rst

@@ -887,6 +887,30 @@ instead of this stanza. For example:
 
   (dirs :standard \ <sub-dir1> <sub-dir2> ...)
 
+.. _dune-vendored_dirs:
+
+vendored_dirs (since 1.11)
+-------------------------
+
+Dune supports vendoring of other dune-based projects natively since simply
+copying a project into a subdirectory of your own project will work. Simply
+doing that has a few limitations though. You can workaround those by explicitly
+marking such directories as containing vendored code.
+
+Example:
+
+.. code:: scheme
+
+   (vendored_dirs vendor)
+
+
+Dune will not resolve aliases in vendored directories meaning by default it will
+not build all installable targets, run the test, format or lint the code located
+in such a directory while still building the parts your project depend upon.
+Libraries and executable in vendored directories will also be built with a ``-w
+-a`` flag to suppress all warnings and prevent pollution of your build output.
+
+
 .. _include_subdirs:
 
 include_subdirs

src/bootstrap.boot.ml

@@ -1,5 +1,7 @@
 open Stdune
 
+let bootstrapping = true
+
 let data_only_path p =
   match Path.Source.to_string p with
   | "test" | "example" -> true

src/bootstrap.ml

@@ -1 +1,3 @@
+let bootstrapping = false
+
 let data_only_path _ = false

src/bootstrap.mli

@@ -2,6 +2,9 @@
 
 open Stdune
 
+(** Whether we're currently bootstrapping [dune] *)
+val bootstrapping : bool
+
 (** Treat the following path as if it was declared as a data only path
     in a [dune] file. *)
 val data_only_path : Path.Source.t -> bool

src/build_system.ml

@@ -195,7 +195,7 @@ module Alias0 = struct
 
   let dep_rec_internal ~name ~dir ~ctx_dir =
     Build.lazy_no_targets (lazy (
-      File_tree.Dir.fold dir ~traverse_ignored_dirs:false
+      File_tree.Dir.fold dir ~traverse:Sub_dirs.Status.Set.normal_only
         ~init:(Build.return true)
         ~f:(fun dir acc ->
           let path = Path.Build.append_source ctx_dir (File_tree.Dir.path dir) in
@@ -1277,7 +1277,7 @@ and get_rule t path =
 let all_targets t =
   String.Map.to_list t.contexts
   |> List.fold_left ~init:Path.Build.Set.empty ~f:(fun acc (_, ctx) ->
-    File_tree.fold t.file_tree ~traverse_ignored_dirs:true ~init:acc
+    File_tree.fold t.file_tree ~traverse:Sub_dirs.Status.Set.all ~init:acc
       ~f:(fun dir acc ->
         match
           load_dir

src/dune_load.ml

@@ -265,7 +265,9 @@ let interpret ~dir ~project ~ignore_promoted_rules
 let load ?(ignore_promoted_rules=false) ~ancestor_vcs () =
   let ftree = File_tree.load Path.Source.root ~ancestor_vcs in
   let projects =
-    File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[]
+    File_tree.fold ftree
+      ~traverse:{data_only = false; vendored = true; normal = true}
+      ~init:[]
       ~f:(fun dir acc ->
         let p = File_tree.Dir.project dir in
         if Path.Source.equal

src/file_tree.ml

@@ -91,7 +91,7 @@ let load_jbuild_ignore path =
 module Dir = struct
   type t =
     { path     : Path.Source.t
-    ; ignored  : bool
+    ; status   : Sub_dirs.Status.t
     ; contents : contents Lazy.t
     ; project  : Dune_project.t
     ; vcs      : Vcs.t option
@@ -103,9 +103,9 @@ module Dir = struct
     ; dune_file : Dune_file.t option
     }
 
-  let create ~project ~path ~ignored ~contents ~vcs =
+  let create ~project ~path ~status ~contents ~vcs =
     { path
-    ; ignored
+    ; status
     ; contents
     ; project
     ; vcs
@@ -114,7 +114,8 @@ module Dir = struct
   let contents t = Lazy.force t.contents
 
   let path t = t.path
-  let ignored t = t.ignored
+  let ignored t = t.status = Data_only
+  let vendored t = t.status = Vendored
 
   let files     t = (contents t).files
   let sub_dirs  t = (contents t).sub_dirs
@@ -135,13 +136,14 @@ module Dir = struct
     String.Map.foldi (sub_dirs t) ~init:Path.Source.Set.empty
       ~f:(fun s _ acc -> Path.Source.Set.add acc (Path.Source.relative t.path s))
 
-  let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
-    if not traverse_ignored_dirs && t.ignored then
-      acc
-    else
+  let rec fold t ~traverse ~init:acc ~f =
+    let must_traverse = Sub_dirs.Status.Map.find traverse t.status in
+    if must_traverse then
       let acc = f t acc in
       String.Map.fold (sub_dirs t) ~init:acc ~f:(fun t acc ->
-        fold t ~traverse_ignored_dirs ~init:acc ~f)
+        fold t ~traverse ~init:acc ~f)
+    else
+      acc
 
   let rec dyn_of_contents { files; sub_dirs; dune_file } =
     let open Dyn in
@@ -152,11 +154,11 @@ module Dir = struct
       ; "project", Dyn.opaque
       ]
 
-  and to_dyn { path ; ignored ; contents = lazy contents ; project = _; vcs } =
+  and to_dyn { path ; status ; contents = lazy contents ; project = _; vcs } =
     let open Dyn in
     Record
       [ "path", Path.Source.to_dyn path
-      ; "ignored", Bool ignored
+      ; "status", Sub_dirs.Status.to_dyn status
       ; "contents", dyn_of_contents contents
       ; "vcs", Dyn.Encoder.option Vcs.to_dyn vcs
       ]
@@ -223,11 +225,11 @@ let readdir path =
 
 let load ?(warn_when_seeing_jbuild_file=true) path ~ancestor_vcs =
   let open Result.O in
-  let rec walk path ~dirs_visited ~project:parent_project ~vcs ~data_only
+  let rec walk path ~dirs_visited ~project:parent_project ~vcs ~(dir_status : Sub_dirs.Status.t)
     : (_, _) Result.t =
     let+ { dirs; files } = readdir path in
     let project =
-      if data_only then
+      if dir_status = Data_only then
         parent_project
       else
         Option.value (Dune_project.load ~dir:path ~files)
@@ -249,18 +251,21 @@ let load ?(warn_when_seeing_jbuild_file=true) path ~ancestor_vcs =
     in
     let contents = lazy (
       let dune_file, sub_dirs =
-        if data_only then
+        if dir_status = Data_only then
           (None, Sub_dirs.default)
         else
           let dune_file, sub_dirs =
             match List.filter ["dune"; "jbuild"] ~f:(String.Set.mem files) with
             | [] -> (None, Sub_dirs.default)
             | [fn] ->
               let file = Path.Source.relative path fn in
+              let warn_about_jbuild =
+                warn_when_seeing_jbuild_file && dir_status <> Vendored
+              in
               if fn = "dune" then
                 ignore (Dune_project.ensure_project_file_exists project
                         : Dune_project.created_or_already_exist)
-              else if warn_when_seeing_jbuild_file then
+              else if warn_about_jbuild then
                 (* DUNE2: turn this into an error *)
                 User_warning.emit ~loc:(Loc.in_file (Path.source file))
                   [ Pp.text "jbuild files are deprecated, please \
@@ -300,14 +305,19 @@ let load ?(warn_when_seeing_jbuild_file=true) path ~ancestor_vcs =
         |> List.fold_left ~init:String.Map.empty ~f:(fun acc (fn, path, file) ->
           let status =
             if Bootstrap.data_only_path path then
-              Sub_dirs.Status.Ignored
+              Sub_dirs.Status.Or_ignored.Ignored
             else
               Sub_dirs.status sub_dirs ~dir:fn
           in
           match status with
           | Ignored -> acc
-          | Normal | Data_only ->
-            let data_only = data_only || status = Data_only in
+          | Status status ->
+            let dir_status : Sub_dirs.Status.t =
+              match dir_status, status with
+              | Data_only, _ -> Data_only
+              | Vendored, Normal -> Vendored
+              | _, _ -> status
+            in
             let dirs_visited =
               if Sys.win32 then
                 dirs_visited
@@ -321,19 +331,19 @@ let load ?(warn_when_seeing_jbuild_file=true) path ~ancestor_vcs =
                     (Path.Source.to_string_maybe_quoted path) ]
             in
             match
-              walk path ~dirs_visited ~project ~data_only ~vcs
+              walk path ~dirs_visited ~project ~dir_status ~vcs
             with
             | Ok dir -> String.Map.set acc fn dir
             | Error _ -> acc)
       in
       { Dir. files; sub_dirs; dune_file })
     in
-    Dir.create ~path ~contents ~ignored:data_only ~project ~vcs
+    Dir.create ~path ~contents ~status:dir_status ~project ~vcs
   in
   match
     walk path
       ~dirs_visited:(File.Map.singleton (File.of_source_path path) path)
-      ~data_only:false
+      ~dir_status:Normal
       ~project:(Lazy.force Dune_project.anonymous)
       ~vcs:ancestor_vcs
   with
@@ -382,11 +392,14 @@ let file_exists t path =
 
 let dir_exists t path = Option.is_some (find_dir t path)
 
+let dir_is_vendored t path =
+  Option.map ~f:(fun dir -> Dir.vendored dir) (find_dir t path)
+
 let files_recursively_in t ~prefix_with path =
   match find_dir t path with
   | None -> Path.Set.empty
   | Some dir ->
-    Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
+    Dir.fold dir ~init:Path.Set.empty ~traverse:Sub_dirs.Status.Set.all
       ~f:(fun dir acc ->
         let path = Path.append_source prefix_with (Dir.path dir) in
         String.Set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->

src/file_tree.mli

@@ -42,11 +42,15 @@ module Dir : sig
      or [jbuild-ignore] file in one of its ancestor directories. *)
   val ignored : t -> bool
 
+  (** Whether this directory is vendored or sits within a vendored
+      directory *)
+  val vendored : t -> bool
+
   val vcs : t -> Vcs.t option
 
   val fold
     :  t
-    -> traverse_ignored_dirs:bool
+    -> traverse:Sub_dirs.Status.Set.t
     -> init:'a
     -> f:(t -> 'a -> 'a)
     -> 'a
@@ -72,12 +76,12 @@ val load
   -> ancestor_vcs:Vcs.t option
   -> t
 
-(** Passing [~traverse_ignored_dirs:true] to this functions causes the
+(** Passing [~traverse_data_only_dirs:true] to this functions causes the
     whole source tree to be deeply scanned, including ignored
     sub-trees. *)
 val fold
   :  t
-  -> traverse_ignored_dirs:bool
+  -> traverse:Sub_dirs.Status.Set.t
   -> init:'a
   -> f:(Dir.t -> 'a -> 'a)
   -> 'a
@@ -99,6 +103,10 @@ val files_of : t -> Path.Source.t -> Path.Source.Set.t
 (** [true] iff the path is a directory *)
 val dir_exists : t -> Path.Source.t -> bool
 
+(** [dir_is_vendored t path] tells whether [path] is a vendored directory.
+    Returns [None] if it doesn't describe a directory within [t]. *)
+val dir_is_vendored : t -> Path.Source.t -> bool option
+
 (** [true] iff the path is a file *)
 val file_exists : t -> Path.Source.t -> bool
 

src/gen_rules.ml

@@ -161,7 +161,8 @@ module Gen(P : sig val sctx : Super_context.t end) = struct
     in
     let allow_approx_merlin =
       let dune_project = Scope.project scope in
-      Dune_project.allow_approx_merlin dune_project in
+      let dir_is_vendored = Super_context.dir_is_vendored sctx src_dir in
+      dir_is_vendored || Dune_project.allow_approx_merlin dune_project in
     Option.iter (Merlin.merge_all ~allow_approx_merlin merlins)
       ~f:(fun m ->
         let more_src_dirs =

src/merlin.ml

@@ -37,7 +37,7 @@ module Preprocess = struct
       if Action_dune_lang.compare_no_locs a1 a2 <> Ordering.Eq then
         warn_dropped_pp loc ~allow_approx_merlin
           ~reason:"this action preprocessor is not equivalent to other \
-                   preproocessor specifications.";
+                   preprocessor specifications.";
       Action (loc, a1)
     | Pps _, Action (loc, _)
     | Action (loc, _), Pps _ ->

src/ocaml_flags.ml

@@ -26,6 +26,9 @@ let dev_mode_warnings =
 let default_warnings =
   "-40"
 
+let vendored_warnings =
+  ["-w"; "-a"]
+
 let default_flags ~profile =
   if profile = "dev" then
     [ "-w"; dev_mode_warnings ^ default_warnings
@@ -99,6 +102,8 @@ let append_common t flags = {t with common = t.common >>^ fun l -> l @ flags}
 
 let prepend_common flags t = {t with common = t.common >>^ fun l -> flags @ l}
 
+let with_vendored_warnings t = append_common t vendored_warnings
+
 let common t = t.common
 
 let dump t =

src/ocaml_flags.mli

@@ -29,6 +29,8 @@ val get_for_cm : t -> cm_kind:Cm_kind.t -> (unit, string list) Build.t
 val append_common : t -> string list -> t
 val prepend_common : string list -> t -> t
 
+val with_vendored_warnings : t -> t
+
 val common : t -> (unit, string list) Build.t
 
 val dump : t -> (unit, Dune_lang.t list) Build.t