feature: install dir

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: 175956A3-5AAE-466E-874C-12198E224F96

otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.ml

@@ -146,6 +146,8 @@ module Unix_error = struct
   module Detailed = struct
     type nonrec t = t * string * string
 
+    let raise (e, x, y) = raise (Unix.Unix_error (e, x, y))
+
     let create error ~syscall ~arg = (error, syscall, arg)
 
     let catch f x =

otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.mli

@@ -11,6 +11,8 @@ module Unix_error : sig
   module Detailed : sig
     type nonrec t = t * string * string
 
+    val raise : t -> 'a
+
     val create : Unix.error -> syscall:string -> arg:string -> t
 
     (** Apply a function to an argument, catching a detailed Unix error. *)

src/dune_engine/action_builder.ml

@@ -240,6 +240,13 @@ let symlink ~src ~dst =
   with_file_targets ~file_targets:[ dst ]
     (path src >>> return (Action.Full.make (Action.Symlink (src, dst))))
 
+let symlink_dir ~src ~dst =
+  with_targets
+    ~targets:
+      (Targets.create ~files:Path.Build.Set.empty
+         ~dirs:(Path.Build.Set.singleton dst))
+    (path src >>> return (Action.Full.make (Action.Symlink (src, dst))))
+
 let create_file ?(perm = Action.File_perm.Normal) fn =
   with_file_targets ~file_targets:[ fn ]
     (return

src/dune_engine/action_builder.mli

@@ -168,6 +168,8 @@ val copy : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t
 
 val symlink : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t
 
+val symlink_dir : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t
+
 val create_file :
   ?perm:Action.File_perm.t -> Path.Build.t -> Action.Full.t With_targets.t
 

src/dune_engine/cached_digest.ml

@@ -333,7 +333,7 @@ let remove path =
   Path.Table.remove cache.table path
 
 module Untracked = struct
-  let source_or_external_file = peek_or_refresh_file ~allow_dirs:false
+  let source_or_external_file = peek_or_refresh_file ~allow_dirs:true
 
   let invalidate_cached_timestamp path =
     let cache = Lazy.force cache in

src/dune_rules/coq_rules.ml

@@ -639,8 +639,10 @@ let coq_plugins_install_rules ~scope ~package ~dst_dir (s : Theory.t) =
              let dst =
                Path.Local.(to_string (relative dst_dir plugin_file_basename))
              in
-             let entry = Install.Entry.make Section.Lib_root ~dst plugin_file in
-             (* TODO this [loc] should come from [s.buildable.libraries] *)
+             let entry =
+               (* TODO this [loc] should come from [s.buildable.libraries] *)
+               Install.Entry.make Section.Lib_root ~dst ~kind:`File plugin_file
+             in
              Install.Entry.Sourced.create ~loc entry)
     else []
   in
@@ -678,6 +680,7 @@ let install_rules ~sctx ~dir s =
     let make_entry (orig_file : Path.Build.t) (dst_file : string) =
       let entry =
         Install.Entry.make Section.Lib_root ~dst:(to_dst dst_file) orig_file
+          ~kind:`File
       in
       Install.Entry.Sourced.create ~loc entry
     in

src/dune_rules/dune_file.ml

@@ -937,20 +937,34 @@ module Install_conf = struct
   type t =
     { section : Install.Section_with_site.t
     ; files : File_binding.Unexpanded.t list
+    ; dirs : File_binding.Unexpanded.t list
     ; package : Package.t
     ; enabled_if : Blang.t
     }
 
   let decode =
     fields
-      (let+ section = field "section" Install.Section_with_site.decode
-       and+ files = field "files" File_binding.Unexpanded.L.decode
+      (let+ loc = loc
+       and+ section = field "section" Install.Section_with_site.decode
+       and+ files = field_o "files" File_binding.Unexpanded.L.decode
+       and+ dirs =
+         field_o "dirs"
+           (Dune_lang.Syntax.since Stanza.syntax (3, 3)
+           >>> File_binding.Unexpanded.L.decode)
        and+ package = Stanza_common.Pkg.field ~stanza:"install"
        and+ enabled_if =
          let allowed_vars = Enabled_if.common_vars ~since:(2, 6) in
          Enabled_if.decode ~allowed_vars ~since:(Some (2, 6)) ()
        in
-       { section; files; package; enabled_if })
+       let files, dirs =
+         match (files, dirs) with
+         | None, None ->
+           User_error.raise ~loc [ Pp.textf "dirs or files must be set" ]
+         | _, _ ->
+           (Option.value files ~default:[], Option.value dirs ~default:[])
+       in
+
+       { section; dirs; files; package; enabled_if })
 end
 
 module Promote = struct
@@ -1145,7 +1159,12 @@ module Executables = struct
                       ~dst:(locp, pub)))
             |> List.filter_opt
           in
-          { Install_conf.section = Section Bin; files; package; enabled_if })
+          { Install_conf.section = Section Bin
+          ; files
+          ; dirs = []
+          ; package
+          ; enabled_if
+          })
   end
 
   module Link_mode = struct

src/dune_rules/dune_file.mli

@@ -206,6 +206,7 @@ module Install_conf : sig
   type t =
     { section : Install.Section_with_site.t
     ; files : File_binding.Unexpanded.t list
+    ; dirs : File_binding.Unexpanded.t list
     ; package : Package.t
     ; enabled_if : Blang.t
     }

src/dune_rules/gen_rules.ml

@@ -201,14 +201,15 @@ let define_all_alias ~dir ~project ~js_targets =
 let gen_rules sctx dir_contents cctxs expander
     { Dune_file.dir = src_dir; stanzas; project } ~dir:ctx_dir =
   let files_to_install
-      { Install_conf.section = _; files; package = _; enabled_if = _ } =
-    Memo.List.map files ~f:(fun fb ->
-        File_binding.Unexpanded.expand_src ~dir:ctx_dir fb
-          ~f:(Expander.No_deps.expand_str expander)
-        >>| Path.build)
-    >>= fun files ->
+      { Install_conf.section = _; files; package = _; enabled_if = _; dirs } =
+    let* files_and_dirs =
+      Memo.List.map (files @ dirs) ~f:(fun fb ->
+          File_binding.Unexpanded.expand_src ~dir:ctx_dir fb
+            ~f:(Expander.No_deps.expand_str expander)
+          >>| Path.build)
+    in
     Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir)
-      (Action_builder.paths files)
+      (Action_builder.paths files_and_dirs)
   in
   let* { For_stanza.merlin = merlins
        ; cctx = cctxs
@@ -459,9 +460,10 @@ let gen_rules ctx_or_install ~dir components =
   | Install ctx ->
     with_context ctx ~f:(fun sctx ->
         let+ subdirs, rules = Install_rules.symlink_rules sctx ~dir in
+        let directory_targets = Rules.directory_targets rules in
         Build_config.Rules
           { build_dir_only_sub_dirs = subdirs
-          ; directory_targets = Path.Build.Map.empty
+          ; directory_targets
           ; rules = Memo.return rules
           })
   | Context ctx ->

src/dune_rules/install.ml

@@ -9,6 +9,8 @@ module Dst : sig
 
   val to_string : t -> string
 
+  val concat_all : t -> string list -> t
+
   val add_prefix : string -> t -> t
 
   val to_install_file :
@@ -31,6 +33,8 @@ end = struct
 
   let to_string t = t
 
+  let concat_all t suffixes = List.fold_left suffixes ~init:t ~f:Filename.concat
+
   let add_prefix p t = Filename.concat p t
 
   let explicit t = t
@@ -247,10 +251,13 @@ end
 module Entry = struct
   type 'src t =
     { src : 'src
+    ; kind : [ `File | `Directory ]
     ; dst : Dst.t
     ; section : Section.t
     }
 
+  let map_dst t ~f = { t with dst = f t.dst }
+
   module Sourced = struct
     type source =
       | User of Loc.t
@@ -270,11 +277,12 @@ module Entry = struct
       }
   end
 
-  let compare compare_src { src; dst; section } t =
+  let compare compare_src { src; dst; section; kind } t =
     let open Ordering.O in
     let= () = Section.compare section t.section in
     let= () = Dst.compare dst t.dst in
-    compare_src src t.src
+    let= () = compare_src src t.src in
+    Poly.compare kind t.kind
 
   let adjust_dst_gen =
     let error (source_pform : Dune_lang.Template.Pform.t) =
@@ -329,13 +337,14 @@ module Entry = struct
       ~src_suffix:(Full (Path.to_string (Path.build src)))
       ~dst ~section
 
-  let make section ?dst src =
+  let make section ?dst ~kind src =
     let dst = adjust_dst' ~src ~dst ~section in
-    { src; dst; section }
+    { src; dst; section; kind }
 
-  let make_with_site section ?dst get_section src =
+  let make_with_site (section : Section_with_site.t) ?dst get_section ~kind src
+      =
     match section with
-    | Section_with_site.Section section -> Memo.return (make section ?dst src)
+    | Section section -> Memo.return (make section ?dst ~kind src)
     | Site { pkg; site; loc } ->
       let open Memo.O in
       let+ section = get_section ~loc ~pkg ~site in
@@ -364,7 +373,7 @@ module Entry = struct
         | Man
         | Misc -> (section, dst)
       in
-      { src; dst; section }
+      { src; dst; section; kind }
 
   let set_src t src = { t with src }
 
@@ -387,6 +396,7 @@ module Entry = struct
     { src
     ; section
     ; dst = Dst.of_install_file ~section ~src_basename:(Path.basename src) dst
+    ; kind = `File
     }
 end
 

src/dune_rules/install.mli

@@ -6,6 +6,8 @@ module Dst : sig
 
   val to_string : t -> string
 
+  val concat_all : t -> string list -> t
+
   include Dune_lang.Conv.S with type t := t
 
   val to_dyn : t -> Dyn.t
@@ -91,6 +93,7 @@ end
 module Entry : sig
   type 'src t = private
     { src : 'src
+    ; kind : [ `File | `Directory ]
     ; dst : Dst.t
     ; section : Section.t
     }
@@ -116,7 +119,12 @@ module Entry : sig
     -> section:Section.t
     -> Dst.t
 
-  val make : Section.t -> ?dst:string -> Path.Build.t -> Path.Build.t t
+  val make :
+       Section.t
+    -> ?dst:string
+    -> kind:[ `File | `Directory ]
+    -> Path.Build.t
+    -> Path.Build.t t
 
   val make_with_site :
        Section_with_site.t
@@ -125,11 +133,14 @@ module Entry : sig
         -> pkg:Dune_engine.Package.Name.t
         -> site:Dune_engine.Section.Site.t
         -> Section.t Memo.t)
+    -> kind:[ `File | `Directory ]
     -> Path.Build.t
     -> Path.Build.t t Memo.t
 
   val set_src : _ t -> 'src -> 'src t
 
+  val map_dst : 'a t -> f:(Dst.t -> Dst.t) -> 'a t
+
   val relative_installed_path : _ t -> paths:Section.Paths.t -> Path.t
 
   val add_install_prefix :