Add (copy_files <glob>) stanza (#35)

Add (copy_files <glob>) and (copy_files# <glob>) stanzas. These
stanzas setup rules for copying files from a sub-directory to the
current directory.

This provides a reasonable way to support multi-directory
library/executables in jbuilder.

doc/jbuild.rst

@@ -511,6 +511,22 @@ stanza, if the source file has extension ``.exe`` or ``.bc``, then
 Jbuilder implicitly adds the ``.exe`` extension to the destination, if
 not already present.
 
+copy_files
+----------
+
+The ``copy_files`` and ``copy_files#`` stanzas allow to specify that
+files from another directory could be copied if needed to the current
+directory.
+
+The syntax is as follows:
+
+.. code:: scheme
+
+    (copy_files <glob>)
+
+``<glob>`` represents the set of files to copy, see the :ref:`glob
+<glob>` for details.
+
 Common items
 ============
 

src/action.ml

@@ -54,6 +54,8 @@ struct
       ; cstr_loc "copy-and-add-line-directive" (path @> path @> nil) (fun loc src dst ->
           Loc.warn loc "copy-and-add-line-directive is deprecated, use copy# instead";
           Copy_and_add_line_directive (src, dst))
+      ; cstr "copy#" (path @> path @> nil) (fun src dst ->
+          Copy_and_add_line_directive (src, dst))
       ; cstr "system" (string @> nil) (fun cmd -> System cmd)
       ; cstr "bash"   (string @> nil) (fun cmd -> Bash   cmd)
       ; cstr "write-file" (path @> string @> nil) (fun fn s -> Write_file (fn, s))

src/build.ml

@@ -255,6 +255,11 @@ let copy ~src ~dst =
   path src >>>
   action ~targets:[dst] (Copy (src, dst))
 
+let copy_and_add_line_directive ~src ~dst =
+  path src >>>
+  action ~targets:[dst]
+    (Copy_and_add_line_directive (src, dst))
+
 let symlink ~src ~dst =
   path src >>>
   action ~targets:[dst] (Symlink (src, dst))

src/build.mli

@@ -108,6 +108,7 @@ val write_file : Path.t -> string -> (unit, Action.t) t
 val write_file_dyn : Path.t -> (string, Action.t) t
 
 val copy : src:Path.t -> dst:Path.t -> (unit, Action.t) t
+val copy_and_add_line_directive : src:Path.t -> dst:Path.t -> (unit, Action.t) t
 
 val symlink : src:Path.t -> dst:Path.t -> (unit, Action.t) t
 

src/gen_rules.ml

@@ -421,6 +421,7 @@ module Gen(P : Params) = struct
     ; flags
     ; preprocess = Buildable.single_preprocess lib.buildable
     ; libname = Some lib.name
+    ; source_dirs = Path.Set.empty
     }
 
   (* +-----------------------------------------------------------------+
@@ -539,6 +540,7 @@ module Gen(P : Params) = struct
     ; flags      = Ocaml_flags.common flags
     ; preprocess = Buildable.single_preprocess exes.buildable
     ; libname    = None
+    ; source_dirs = Path.Set.empty
     }
 
   (* +-----------------------------------------------------------------+
@@ -599,6 +601,51 @@ module Gen(P : Params) = struct
            ; Build.create_file digest_path
            ])
 
+  let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope =
+    let loc = String_with_vars.loc def.glob in
+    let glob_in_src =
+      let src_glob = SC.expand_vars sctx ~dir def.glob ~scope in
+      Path.relative src_dir src_glob ~error_loc:loc
+    in
+    (* The following condition is required for merlin to work.
+       Additionally, the order in which the rules are evaluated only
+       ensures that [sources_and_targets_known_so_far] returns the
+       right answer for sub-directories only. *)
+    if not (Path.is_descendant glob_in_src ~of_:src_dir) then
+      Loc.fail loc "%s is not a sub-directory of %s"
+        (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir);
+    let glob = Path.basename glob_in_src in
+    let src_in_src = Path.parent glob_in_src in
+    let re =
+      match Glob_lexer.parse_string glob with
+      | Ok re ->
+        Re.compile re
+      | Error (_pos, msg) ->
+        Loc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg
+    in
+    (* add rules *)
+    let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_in_src in
+    let src_in_build = Path.append ctx.build_dir src_in_src in
+    String_set.iter files ~f:(fun basename ->
+      let matches = Re.execp re basename in
+      if matches then
+        let file_src = Path.relative src_in_build basename in
+        let file_dst = Path.relative dir basename in
+        SC.add_rule sctx
+          ((if def.add_line_directive
+            then Build.copy_and_add_line_directive
+            else Build.copy)
+             ~src:file_src
+             ~dst:file_dst)
+    );
+    { Merlin.requires = Build.return []
+    ; flags           = Build.return []
+    ; preprocess      = Jbuild.Preprocess.No_preprocessing
+    ; libname         = None
+    ; source_dirs     = Path.Set.singleton src_in_src
+    }
+
+
   (* +-----------------------------------------------------------------+
      | Modules listing                                                 |
      +-----------------------------------------------------------------+ *)
@@ -704,12 +751,16 @@ Add it to your jbuild file to remove this warning.
   let rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope } =
     (* Interpret user rules and other simple stanzas first in order to populate the known
        target table, which is needed for guessing the list of modules. *)
-    List.iter stanzas ~f:(fun stanza ->
-      let dir = ctx_dir in
-      match (stanza : Stanza.t) with
-      | Rule         rule  -> user_rule   rule  ~dir ~scope
-      | Alias        alias -> alias_rules alias ~dir ~scope
-      | Library _ | Executables _ | Provides _ | Install _ -> ());
+    let merlins =
+      List.filter_map stanzas ~f:(fun stanza ->
+        let dir = ctx_dir in
+        match (stanza : Stanza.t) with
+        | Rule         rule  -> user_rule   rule  ~dir ~scope; None
+        | Alias        alias -> alias_rules alias ~dir ~scope; None
+        | Copy_files def ->
+          Some (copy_files_rules def ~src_dir ~dir ~scope)
+        | Library _ | Executables _ | Provides _ | Install _ -> None)
+    in
     let files = lazy (
       let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_dir in
       (* Manually add files generated by the (select ...) dependencies since we haven't
@@ -727,15 +778,17 @@ Add it to your jbuild file to remove this warning.
       guess_modules ~dir:src_dir
         ~files:(Lazy.force files))
     in
-    List.filter_map stanzas ~f:(fun stanza ->
+    List.fold_left stanzas ~init:merlins ~f:(fun merlins stanza ->
       let dir = ctx_dir in
       match (stanza : Stanza.t) with
       | Library lib ->
-        Some (library_rules lib ~dir ~all_modules:(Lazy.force all_modules)
-                ~files:(Lazy.force files) ~scope)
+        library_rules lib ~dir ~all_modules:(Lazy.force all_modules)
+          ~files:(Lazy.force files) ~scope
+        :: merlins
       | Executables exes ->
-        Some (executables_rules exes ~dir ~all_modules:(Lazy.force all_modules) ~scope)
-      | _ -> None)
+        executables_rules exes ~dir ~all_modules:(Lazy.force all_modules) ~scope
+        :: merlins
+      | _ -> merlins)
     |> Merlin.merge_all
     |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir);
     Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
@@ -745,7 +798,15 @@ Add it to your jbuild file to remove this warning.
       Utop.add_module_rules sctx ~dir merlin.requires;
     )
 
-  let () = List.iter (SC.stanzas sctx) ~f:rules
+  let () =
+    (* Sort the list of stanzas by directory so that we traverse
+       subdirectories first.
+
+       This is required for correctly interpreting [copy_files]. *)
+    let subtree_smaller x y =
+      Path.compare y.SC.Dir_with_jbuild.src_dir x.SC.Dir_with_jbuild.src_dir in
+    let stanzas = List.sort ~cmp:subtree_smaller (SC.stanzas sctx) in
+    List.iter stanzas ~f:rules
   let () =
     SC.add_rules sctx (Js_of_ocaml_rules.setup_separate_compilation_rules sctx)
   let () = Odoc.setup_css_rule sctx

src/jbuild.ml

@@ -886,6 +886,14 @@ module Alias_conf = struct
          })
 end
 
+module Copy_files = struct
+  type t = { add_line_directive : bool
+           ; glob : String_with_vars.t
+           }
+
+  let v1 = String_with_vars.t
+end
+
 module Stanza = struct
   type t =
     | Library     of Library.t
@@ -894,6 +902,7 @@ module Stanza = struct
     | Provides    of Provides.t
     | Install     of Install_conf.t
     | Alias       of Alias_conf.t
+    | Copy_files  of Copy_files.t
 
   let rules l = List.map l ~f:(fun x -> Rule x)
 
@@ -913,6 +922,10 @@ module Stanza = struct
       ; cstr_loc "menhir"    (Menhir.v1   @> nil) (fun loc x -> rules (Menhir.v1_to_rule loc x))
       ; cstr "install"     (Install_conf.v1 pkgs @> nil) (fun x -> [Install     x])
       ; cstr "alias"       (Alias_conf.v1 pkgs @> nil)   (fun x -> [Alias       x])
+      ; cstr "copy_files" (Copy_files.v1 @> nil)
+          (fun glob -> [Copy_files {add_line_directive = false; glob}])
+      ; cstr "copy_files#" (Copy_files.v1 @> nil)
+          (fun glob -> [Copy_files {add_line_directive = true; glob}])
       (* Just for validation and error messages *)
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
       ]

src/jbuild.mli

@@ -222,6 +222,13 @@ module Alias_conf : sig
     }
 end
 
+module Copy_files : sig
+  type t =
+    { add_line_directive : bool
+    ; glob : String_with_vars.t
+    }
+end
+
 module Stanza : sig
   type t =
     | Library     of Library.t
@@ -230,6 +237,7 @@ module Stanza : sig
     | Provides    of Provides.t
     | Install     of Install_conf.t
     | Alias       of Alias_conf.t
+    | Copy_files  of Copy_files.t
 end
 
 module Stanzas : sig

src/merlin.ml

@@ -9,6 +9,7 @@ type t =
   ; flags      : (unit, string list) Build.t
   ; preprocess : Jbuild.Preprocess.t
   ; libname    : string option
+  ; source_dirs: Path.Set.t
   }
 
 (* This must be forced after we change the cwd to the workspace root *)
@@ -55,6 +56,12 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
               internals, ("PKG " ^ pkg.name) :: externals
           )
         in
+        let source_dirs =
+          Path.Set.fold t.source_dirs ~init:[] ~f:(fun path acc ->
+            let path = Path.reach path ~from:remaindir in
+            ("S " ^ path)::acc
+          )
+        in
         let flags =
           match flags with
           | [] -> []
@@ -65,6 +72,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
         let dot_merlin =
           List.concat
             [ [ "B " ^ (Path.reach dir ~from:remaindir) ]
+            ; source_dirs
             ; internals
             ; externals
             ; flags
@@ -94,9 +102,10 @@ let merge_two a b =
       else
         No_preprocessing
   ; libname =
-      match a.libname with
-      | Some _ as x -> x
-      | None -> b.libname
+      (match a.libname with
+       | Some _ as x -> x
+       | None -> b.libname)
+  ; source_dirs = Path.Set.union a.source_dirs b.source_dirs
   }
 
 let merge_all = function

src/merlin.mli

@@ -5,6 +5,7 @@ type t =
   ; flags      : (unit, string list) Build.t
   ; preprocess : Jbuild.Preprocess.t
   ; libname    : string option
+  ; source_dirs: Path.Set.t
   }
 
 val merge_all : t list -> t option

src/path.mli

@@ -37,6 +37,7 @@ val t : t Sexp.Of_sexp.t
 val sexp_of_t : t Sexp.To_sexp.t
 
 val compare : t -> t -> int
+(** a directory is smaller than its descendants *)
 
 module Set : Set.S with type elt = t
 module Map : Map.S with type key = t

test/blackbox-tests/jbuild

@@ -64,3 +64,10 @@
   (action
    (chdir test-cases/lib-available
     (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
+
+(alias
+ ((name runtest)
+  (deps ((files_recursively_in test-cases/copy_files)))
+  (action
+   (chdir test-cases/copy_files
+    (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))

test/blackbox-tests/test-cases/copy_files/jbuild

@@ -0,0 +1,6 @@
+(jbuild_version 1)
+
+(copy_files# lexers/*.ml{,i})
+
+(executables
+ ((names (test))))

test/blackbox-tests/test-cases/copy_files/lexers/jbuild

@@ -0,0 +1,3 @@
+(jbuild_version 1)
+
+(ocamllex (lexer1))

test/blackbox-tests/test-cases/copy_files/lexers/lexer1.mll

@@ -0,0 +1,6 @@
+{
+}
+
+rule lex = parse
+  | _   { true  }
+  | eof { false }

test/blackbox-tests/test-cases/copy_files/run.t

@@ -0,0 +1,8 @@
+  $ $JBUILDER build -j1 test.exe .merlin --root . --debug-dependency-path
+      ocamllex lexers/lexer1.ml
+      ocamldep test.depends.ocamldep-output
+        ocamlc lexer1.{cmi,cmo,cmt}
+      ocamlopt lexer1.{cmx,o}
+        ocamlc test.{cmi,cmo,cmt}
+      ocamlopt test.{cmx,o}
+      ocamlopt test.exe

test/blackbox-tests/test-cases/copy_files/test.ml

@@ -0,0 +1 @@
+include Lexer1