fix: optional binaries handling

We wait until the binaries are resolved to determine if they are
optional or not.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: da705232-7f02-4a6e-8775-bbc164aff6a6 -->

src/dune_rules/artifacts.ml

@@ -8,6 +8,7 @@ type origin =
   { binding : File_binding.Unexpanded.t
   ; dir : Path.Build.t
   ; dst : Path.Local.t
+  ; enabled_if : bool Memo.t
   }
 
 type where =
@@ -16,7 +17,7 @@ type where =
 
 type path =
   | Resolved of Path.Build.t
-  | Origin of origin
+  | Origin of origin list
 
 type local_bins = path Filename.Map.t
 
@@ -44,12 +45,31 @@ let analyze_binary t name =
     let* local_bins = Memo.Lazy.force t.local_bins in
     (match Filename.Map.find local_bins name with
      | Some (Resolved p) -> Memo.return (`Resolved (Path.build p))
-     | Some (Origin o) -> Memo.return (`Origin o)
      | None ->
        Context.which t.context name
        >>| (function
         | None -> `None
-        | Some path -> `Resolved path))
+        | Some path -> `Resolved path)
+     | Some (Origin origins) ->
+       Memo.parallel_map origins ~f:(fun origin ->
+         origin.enabled_if
+         >>| function
+         | true -> Some origin
+         | false -> None)
+       >>| List.filter_opt
+       >>| (function
+        | [] -> `None
+        | [ x ] -> `Origin x
+        | x :: rest ->
+          let loc x = File_binding.Unexpanded.loc x.binding in
+          User_error.raise
+            ~loc:(loc x)
+            [ Pp.textf
+                "binary %S is available from more than one definition. It is also \
+                 available in:"
+                name
+            ; Pp.enumerate rest ~f:(fun x -> Pp.verbatim (Loc.to_file_colon_line (loc x)))
+            ]))
 ;;
 
 let binary t ?hint ?(where = Install_dir) ~loc name =
@@ -60,7 +80,7 @@ let binary t ?hint ?(where = Install_dir) ~loc name =
     let context = Context.name t.context in
     Memo.return
     @@ Error (Action.Prog.Not_found.create ~program:name ?hint ~context ~loc ())
-  | `Origin { dir; binding; dst } ->
+  | `Origin { dir; binding; dst; enabled_if = _ } ->
     (match where with
      | Install_dir ->
        let install_dir = Install.Context.bin_dir ~context:(Context.name t.context) in
@@ -100,13 +120,15 @@ let create =
     then Option.value ~default:name (String.drop_suffix name ~suffix:".exe")
     else name
   in
-  fun (context : Context.t) ~local_bins ->
+  fun (context : Context.t)
+    ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
     let local_bins =
       Memo.lazy_ (fun () ->
         let+ local_bins = Memo.Lazy.force local_bins in
-        Filename.Map.foldi local_bins ~init:Filename.Map.empty ~f:(fun name origin acc ->
-          let key = drop_suffix name in
-          Filename.Map.set acc key (Origin origin)))
+        Filename.Map.to_list_map local_bins ~f:(fun name sources ->
+          let sources = Appendable_list.to_list sources in
+          drop_suffix name, Origin sources)
+        |> Filename.Map.of_list_exn)
     in
     { context; local_bins }
 ;;

src/dune_rules/artifacts.mli

@@ -6,6 +6,7 @@ type origin =
   { binding : File_binding.Unexpanded.t
   ; dir : Path.Build.t
   ; dst : Path.Local.t
+  ; enabled_if : bool Memo.t
   }
 
 type where =
@@ -35,7 +36,11 @@ val binary
 
 val binary_available : t -> string -> bool Memo.t
 val add_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list -> t
-val create : Context.t -> local_bins:origin Filename.Map.t Memo.Lazy.t -> t
+
+val create
+  :  Context.t
+  -> local_bins:origin Appendable_list.t Filename.Map.t Memo.Lazy.t
+  -> t
 
 val expand
   : (context:Context.t -> dir:Path.Build.t -> String_with_vars.t -> string Memo.t) Fdecl.t

src/dune_rules/artifacts_db.ml

@@ -36,7 +36,7 @@ let available_exes ~dir (exes : Dune_file.Executables.t) =
 ;;
 
 let get_installed_binaries ~(context : Context.t) stanzas =
-  let merge _ _ x = Some x in
+  let merge _ x y = Some (Appendable_list.( @ ) x y) in
   let open Memo.O in
   let expand ~dir sw = Expander.With_reduced_var_set.expand ~context ~dir sw in
   let expand_str ~dir sw = Expander.With_reduced_var_set.expand_str ~context ~dir sw in
@@ -45,7 +45,7 @@ let get_installed_binaries ~(context : Context.t) stanzas =
   in
   Memo.List.map stanzas ~f:(fun (d : Dune_file.t) ->
     let dir = Path.Build.append_source (Context.build_dir context) d.dir in
-    let binaries_from_install files =
+    let binaries_from_install ~enabled_if files =
       let* unexpanded_file_bindings =
         Install_entry.File.to_file_bindings_unexpanded files ~expand:(expand ~dir) ~dir
       in
@@ -60,29 +60,35 @@ let get_installed_binaries ~(context : Context.t) stanzas =
         let dst = Path.Local.of_string (Install.Entry.Dst.to_string p) in
         if Path.Local.is_root (Path.Local.parent_exn dst)
         then (
-          let origin = { Artifacts.binding = fb; dir; dst } in
+          let origin = { Artifacts.binding = fb; dir; dst; enabled_if } in
           Some (Path.Local.basename dst, origin))
         else None)
       >>| List.filter_opt
-      >>| Filename.Map.of_list_reduce ~f:(fun _ y -> y)
+      >>| Filename.Map.of_list_reduce ~f:(fun _ y ->
+        (* CR-rgrinberg: we shouldn't allow duplicate bindings, but where's the
+           correct place for this validation? *)
+        y)
+      >>| Filename.Map.map ~f:Appendable_list.singleton
     in
     Memo.List.map d.stanzas ~f:(fun stanza ->
       match Stanza.repr stanza with
-      | Install_conf.T { section = Section Bin; files; _ } -> binaries_from_install files
+      | Install_conf.T { section = Section Bin; files; _ } ->
+        binaries_from_install ~enabled_if:(Memo.return true) files
       | Dune_file.Executables.T
           ({ install_conf = Some { section = Section Bin; files; _ }; _ } as exes) ->
-        let* available =
-          let* enabled_if =
+        let enabled_if =
+          let enabled_if =
             Expander.With_reduced_var_set.eval_blang ~context ~dir exes.enabled_if
           in
-          match enabled_if with
-          | false -> Memo.return false
+          match exes.optional with
+          | false -> enabled_if
           | true ->
-            (match exes.optional with
-             | false -> Memo.return true
+            enabled_if
+            >>= (function
+             | false -> Memo.return false
              | true -> available_exes ~dir exes)
         in
-        if available then binaries_from_install files else Memo.return Filename.Map.empty
+        binaries_from_install ~enabled_if files
       | _ -> Memo.return Filename.Map.empty)
     >>| Filename.Map.union_all ~f:merge)
   >>| Filename.Map.union_all ~f:merge

src/dune_rules/file_binding.ml

@@ -115,6 +115,7 @@ end
 module Unexpanded = struct
   type nonrec t = (String_with_vars.t, String_with_vars.t) t
 
+  let loc t = String_with_vars.loc t.src
   let to_dyn = to_dyn String_with_vars.to_dyn String_with_vars.to_dyn
   let equal = equal String_with_vars.equal_no_loc String_with_vars.equal_no_loc
 

src/dune_rules/file_binding.mli

@@ -21,6 +21,7 @@ module Unexpanded : sig
 
   val to_dyn : t -> Dyn.t
   val equal : t -> t -> bool
+  val loc : t -> Loc.t
 
   val make
     :  src:Loc.t * string