feature: Allow include in install stanza

Signed-off-by: Stephen Sherratt <stephen@sherra.tt>

CHANGES.md

@@ -89,6 +89,8 @@
  Coq 8.16.0, Coq itself has some bugs preventing this to work yet. (#6167 ,
  workarounds #5767, @ejgallego)
 
+- Allow include statement in install stanza (#6139, fixes #256, @gridbugs)
+
 3.4.1 (26-07-2022)
 ------------------
 

doc/dune-files.rst

@@ -1415,6 +1415,37 @@ installed in. If the section above is documented as "with the executable bit
 set", they are installed with mode ``0o755`` (``rwxr-xr-x``); otherwise they are
 installed with mode ``0o644`` (``rw-r--r--``).
 
+Including Files in the Install Stanza
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+You can include external files from the ``files`` and ``dirs`` fields of the
+install stanza:
+
+.. code:: scheme
+
+    (install
+     (files (include foo.sexp))
+     (section share))
+
+Here the file ``foo.sexp`` must contain a single S-expression list, whose
+elements will be included in the list of files or directories to install. That
+is, elements may be of the form:
+
+- ``<filename>``
+- ``(<filename> as <destination>)``
+- ``(include <filename>)``
+
+Included files may be generated by rules. Here is an example of a rule which
+generates a file by listing all the files in a subdirectory ``resources``:
+
+.. code:: scheme
+
+    (rule
+     (deps (source_tree resources))
+     (action
+      (with-stdout-to foo.sexp
+      (system "echo '(' resources/* ')'"))))
+
 Handling of the .exe Extension on Windows
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 

src/dune_rules/artifacts_db.ml

@@ -13,7 +13,11 @@ let get_installed_binaries ~(context : Context.t) stanzas =
   Memo.List.map stanzas ~f:(fun (d : Dune_file.t) ->
       let dir = Path.Build.append_source context.build_dir d.dir in
       let binaries_from_install files =
-        Memo.List.map files ~f:(fun fb ->
+        let* unexpanded_file_bindings =
+          Dune_file.Install_conf.File_entry.expand_include_multi files
+            ~expand_str:(expand_str ~dir) ~dir
+        in
+        Memo.List.map unexpanded_file_bindings ~f:(fun fb ->
             let+ p =
               File_binding.Unexpanded.destination_relative_to_install_path fb
                 ~section:Bin ~expand:(expand_str ~dir)

src/dune_rules/dune_file.ml

@@ -944,10 +944,88 @@ module Plugin = struct
 end
 
 module Install_conf = struct
+  module File_entry = struct
+    type t =
+      | Binding of File_binding.Unexpanded.t
+      | Include of
+          { context : Univ_map.t
+          ; path : String_with_vars.t
+          }
+
+    let decode =
+      let open Dune_lang.Decoder in
+      let decode_binding =
+        let+ binding = File_binding.Unexpanded.decode in
+        Binding binding
+      in
+      let decode_include =
+        sum
+          [ ( "include"
+            , let+ () = Syntax.since Stanza.syntax (3, 5)
+              and+ context = get_all
+              and+ path = String_with_vars.decode in
+              Include { context; path } )
+          ]
+      in
+      decode_binding <|> decode_include
+
+    let load_included_file path ~context =
+      let open Memo.O in
+      let+ contents =
+        Build_system.read_file (Path.build path) ~f:Io.read_file
+      in
+      let ast =
+        Dune_lang.Parser.parse_string contents ~mode:Single
+          ~fname:(Path.Build.to_string path)
+      in
+      let parse = Dune_lang.Decoder.parse decode context in
+      match ast with
+      | List (_loc, terms) -> List.map terms ~f:parse
+      | other ->
+        let loc = Dune_sexp.Ast.loc other in
+        User_error.raise ~loc [ Pp.textf "Expected list, got:\n%s" contents ]
+
+    let expand_include t ~expand_str ~dir =
+      let rec expand_include t ~seen =
+        match t with
+        | Binding binding -> Memo.return [ binding ]
+        | Include { context; path = path_sw } ->
+          let open Memo.O in
+          let* path =
+            expand_str path_sw
+            >>| Path.Build.relative
+                  ~error_loc:(String_with_vars.loc path_sw)
+                  dir
+          in
+          if Path.Build.Set.mem seen path then
+            User_error.raise
+              ~loc:(String_with_vars.loc path_sw)
+              [ Pp.textf "Include loop detected via: %s"
+                  (Path.Build.to_string path)
+              ];
+          let seen = Path.Build.Set.add seen path in
+          let* contents = load_included_file path ~context in
+          Memo.List.concat_map contents ~f:(expand_include ~seen)
+      in
+      expand_include t ~seen:Path.Build.Set.empty
+
+    let expand_include_multi ts ~expand_str ~dir =
+      Memo.List.concat_map ts ~f:(expand_include ~expand_str ~dir)
+
+    let expand t ~expand_str ~dir =
+      let open Memo.O in
+      let* unexpanded = expand_include t ~expand_str ~dir in
+      Memo.List.map unexpanded
+        ~f:(File_binding.Unexpanded.expand ~dir ~f:expand_str)
+
+    let expand_multi ts ~expand_str ~dir =
+      Memo.List.concat_map ts ~f:(expand ~expand_str ~dir)
+  end
+
   type t =
     { section : Install.Section_with_site.t
-    ; files : File_binding.Unexpanded.t list
-    ; dirs : File_binding.Unexpanded.t list
+    ; files : File_entry.t list
+    ; dirs : File_entry.t list
     ; package : Package.t
     ; enabled_if : Blang.t
     }
@@ -956,11 +1034,11 @@ module Install_conf = struct
     fields
       (let+ loc = loc
        and+ section = field "section" Install.Section_with_site.decode
-       and+ files = field_o "files" File_binding.Unexpanded.L.decode
+       and+ files = field_o "files" (repeat File_entry.decode)
        and+ dirs =
          field_o "dirs"
            (Dune_lang.Syntax.since Stanza.syntax (3, 5)
-           >>> File_binding.Unexpanded.L.decode)
+           >>> repeat File_entry.decode)
        and+ package = Stanza_common.Pkg.field ~stanza:"install"
        and+ enabled_if =
          let allowed_vars = Enabled_if.common_vars ~since:(2, 6) in
@@ -975,6 +1053,10 @@ module Install_conf = struct
        in
 
        { section; dirs; files; package; enabled_if })
+
+  let expand_files t = File_entry.expand_multi t.files
+
+  let expand_dirs t = File_entry.expand_multi t.dirs
 end
 
 module Executables = struct
@@ -1134,9 +1216,10 @@ module Executables = struct
           let files =
             List.map2 t.names public_names ~f:(fun (locn, name) (locp, pub) ->
                 Option.map pub ~f:(fun pub ->
-                    File_binding.Unexpanded.make
-                      ~src:(locn, name ^ ext)
-                      ~dst:(locp, pub)))
+                    Install_conf.File_entry.Binding
+                      (File_binding.Unexpanded.make
+                         ~src:(locn, name ^ ext)
+                         ~dst:(locp, pub))))
             |> List.filter_opt
           in
           { Install_conf.section = Section Bin

src/dune_rules/dune_file.mli

@@ -204,13 +204,41 @@ module Plugin : sig
 end
 
 module Install_conf : sig
+  module File_entry : sig
+    type t
+
+    val expand_include_multi :
+         t list
+      -> expand_str:(String_with_vars.t -> string Memo.t)
+      -> dir:Path.Build.t
+      -> File_binding.Unexpanded.t list Memo.t
+
+    val expand_multi :
+         t list
+      -> expand_str:(String_with_vars.t -> string Memo.t)
+      -> dir:Path.Build.t
+      -> File_binding.Expanded.t list Memo.t
+  end
+
   type t =
     { section : Install.Section_with_site.t
-    ; files : File_binding.Unexpanded.t list
-    ; dirs : File_binding.Unexpanded.t list
+    ; files : File_entry.t list
+    ; dirs : File_entry.t list
     ; package : Package.t
     ; enabled_if : Blang.t
     }
+
+  val expand_files :
+       t
+    -> expand_str:(String_with_vars.t -> string Memo.t)
+    -> dir:Path.Build.t
+    -> File_binding.Expanded.t list Memo.t
+
+  val expand_dirs :
+       t
+    -> expand_str:(String_with_vars.t -> string Memo.t)
+    -> dir:Path.Build.t
+    -> File_binding.Expanded.t list Memo.t
 end
 
 module Executables : sig

src/dune_rules/file_binding.ml

@@ -63,44 +63,41 @@ module Unexpanded = struct
     in
     { src; dst }
 
-  module L = struct
-    let decode_file =
-      let open Dune_lang.Decoder in
-      let decode =
-        let+ is_atom =
-          peek_exn >>| function
-          | Atom _ -> true
-          | _ -> false
-        and+ s = String_with_vars.decode
-        and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
-        if (not is_atom) && version < (1, 6) then
-          let what =
-            (if String_with_vars.has_pforms s then "variables"
-            else "quoted strings")
-            |> sprintf "Using %s here"
-          in
-          Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax
-            (1, 6) ~what
-        else s
-      in
-      peek_exn >>= function
-      | Atom _ | Quoted_string _ | Template _ ->
-        decode >>| fun src -> { src; dst = None }
-      | List (_, [ _; Atom (_, A "as"); _ ]) ->
-        enter
-          (let* src = decode in
-           keyword "as"
-           >>> let* dst = decode in
-               return { src; dst = Some dst })
-      | sexp ->
-        User_error.raise ~loc:(Dune_lang.Ast.loc sexp)
-          [ Pp.text
-              "invalid format, <name> or (<name> as <install-as>) expected"
-          ]
-
+  let decode =
+    let open Dune_lang.Decoder in
     let decode =
-      let open Dune_lang.Decoder in
-      repeat decode_file
+      let+ is_atom =
+        peek_exn >>| function
+        | Atom _ -> true
+        | _ -> false
+      and+ s = String_with_vars.decode
+      and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
+      if (not is_atom) && version < (1, 6) then
+        let what =
+          (if String_with_vars.has_pforms s then "variables"
+          else "quoted strings")
+          |> sprintf "Using %s here"
+        in
+        Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax
+          (1, 6) ~what
+      else s
+    in
+    peek_exn >>= function
+    | Atom _ | Quoted_string _ | Template _ ->
+      decode >>| fun src -> { src; dst = None }
+    | List (_, [ _; Atom (_, A "as"); _ ]) ->
+      enter
+        (let* src = decode in
+         keyword "as"
+         >>> let* dst = decode in
+             return { src; dst = Some dst })
+    | sexp ->
+      User_error.raise ~loc:(Dune_lang.Ast.loc sexp)
+        [ Pp.text "Invalid format, <name> or (<name> as <install-as>) expected"
+        ]
+
+  module L = struct
+    let decode = Dune_lang.Decoder.repeat decode
 
     let strings_with_vars { src; dst } = src :: Option.to_list dst
 

src/dune_rules/file_binding.mli

@@ -19,6 +19,8 @@ module Unexpanded : sig
 
   val make : src:Loc.t * string -> dst:Loc.t * string -> t
 
+  val decode : t Dune_lang.Decoder.t
+
   val expand :
        t
     -> dir:Path.Build.t

src/dune_rules/gen_rules.ml

@@ -200,13 +200,17 @@ 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 = _; dirs } =
+  let files_to_install install_conf =
+    let expand_str = Expander.No_deps.expand_str expander in
     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)
+      let* files_expanded =
+        Install_conf.expand_files install_conf ~expand_str ~dir:ctx_dir
+      in
+      let+ dirs_expanded =
+        Install_conf.expand_dirs install_conf ~expand_str ~dir:ctx_dir
+      in
+      List.map (files_expanded @ dirs_expanded) ~f:(fun fb ->
+          File_binding.Expanded.src fb |> Path.build)
     in
     let action =
       let open Action_builder.O in

src/dune_rules/install_rules.ml

@@ -274,14 +274,13 @@ end = struct
         let open Dune_file in
         match (stanza : Stanza.t) with
         | Install i | Executables { install_conf = Some i; _ } ->
-          let path_expander =
-            File_binding.Unexpanded.expand ~dir
-              ~f:(Expander.No_deps.expand_str expander)
-          in
           let section = i.section in
+          let expand_str = Expander.No_deps.expand_str expander in
+          let* files_expanded =
+            Dune_file.Install_conf.expand_files i ~expand_str ~dir
+          in
           let* files =
-            Memo.List.map i.files ~f:(fun unexpanded ->
-                let* fb = path_expander unexpanded in
+            Memo.List.map files_expanded ~f:(fun fb ->
                 let loc = File_binding.Expanded.src_loc fb in
                 let src = File_binding.Expanded.src fb in
                 let dst = File_binding.Expanded.dst fb in
@@ -292,9 +291,11 @@ end = struct
                 in
                 Install.Entry.Sourced.create ~loc entry)
           in
+          let* dirs_expanded =
+            Dune_file.Install_conf.expand_dirs i ~expand_str ~dir
+          in
           let+ files_from_dirs =
-            Memo.List.map i.dirs ~f:(fun unexpanded ->
-                let* fb = path_expander unexpanded in
+            Memo.List.map dirs_expanded ~f:(fun fb ->
                 let loc = File_binding.Expanded.src_loc fb in
                 let src = File_binding.Expanded.src fb in
                 let dst = File_binding.Expanded.dst fb in