From 0ba729911793bf51daa725315bfec2bf19706a47 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Sat, 25 Feb 2017 01:45:41 +0000
Subject: [PATCH] Handle installation into multiple contexts at once

---
 bin/main.ml  | 37 ++++++++++++++++++++++++-------------
 src/main.ml  |  2 ++
 src/main.mli |  1 +
 3 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index 4b5d0a27..56dfdffc 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -206,8 +206,8 @@ let runtest =
           $ Arg.(value & pos_all string ["."] name_))
   , Term.info "runtest" ~doc ~man:help_secs)
 
-let opam_installer (setup : Main.setup) =
-  match Context.which setup.context "opam-installer" with
+let opam_installer () =
+  match Bin.which "opam-installer" with
   | None ->
     die "\
 Sorry, you need the opam-installer tool to be able to install or
@@ -216,19 +216,24 @@ uninstall packages.
 I couldn't find the opam-installer binary :-("
   | Some fn -> fn
 
-let get_prefix (setup : Main.setup) ~from_command_line =
+let get_prefix context ~from_command_line =
   match from_command_line with
   | Some p -> Future.return (Path.of_string p)
-  | None -> Context.install_prefix setup.context
+  | None -> Context.install_prefix context
 
 let install_uninstall ~what =
   let doc = sprintf "%s packages using opam-installer." (String.capitalize what) in
   let name_ = Arg.info [] ~docv:"PACKAGE" in
   let go common prefix pkgs =
     set_common common;
+    let opam_installer = opam_installer () in
     Future.Scheduler.go ~log:(create_log ())
       (Main.setup () >>= fun setup ->
-       let opam_installer = opam_installer setup in
+       let pkgs =
+         match pkgs with
+         | [] -> String_map.keys setup.packages
+         | l  -> l
+       in
        let install_files, missing_install_files =
          List.partition_map pkgs ~f:(fun pkg ->
            let fn = resolve_package_install setup pkg in
@@ -245,15 +250,21 @@ let install_uninstall ~what =
               (List.map missing_install_files ~f:(sprintf "- %s")))
            (String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install")))
        end;
-       get_prefix setup ~from_command_line:prefix >>= fun prefix ->
+       (match setup.all_contexts, prefix with
+        | _ :: _ :: _, Some _ ->
+          die "Cannot specify --prefix when installing into multiple contexts!"
+        | _ -> ());
        Future.all_unit
-         (List.map install_files ~f:(fun path ->
-            Future.run (Path.to_string opam_installer)
-              [ sprintf "-%c" what.[0]
-              ; "--prefix"
-              ; Path.to_string prefix
-              ; Path.to_string path
-              ])))
+         (List.map setup.all_contexts ~f:(fun context ->
+            get_prefix context ~from_command_line:prefix >>= fun prefix ->
+            Future.all_unit
+              (List.map install_files ~f:(fun path ->
+                   Future.run (Path.to_string opam_installer)
+                     [ sprintf "-%c" what.[0]
+                     ; "--prefix"
+                     ; Path.to_string prefix
+                     ; Path.to_string path
+                     ])))))
   in
   ( Term.(const go
           $ common
diff --git a/src/main.ml b/src/main.ml
index 767f777d..07a9e656 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -5,6 +5,7 @@ type setup =
   { build_system : Build_system.t
   ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
   ; context      : Context.t
+  ; all_contexts : Context.t list
   ; packages     : Package.t String_map.t
   }
 
@@ -35,6 +36,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps () =
   return { build_system
          ; stanzas
          ; context = default_context
+         ; all_contexts = contexts
          ; packages
          }
 
diff --git a/src/main.mli b/src/main.mli
index a1aa5cba..caed131f 100644
--- a/src/main.mli
+++ b/src/main.mli
@@ -4,6 +4,7 @@ type setup =
   { build_system   : Build_system.t
   ; stanzas        : (Path.t * Jbuild_types.Stanza.t list) list
   ; context        : Context.t
+  ; all_contexts   : Context.t list
   ; packages       : Package.t String_map.t
   }