Merge pull request #9343 from Alizter/ps/branch/pkg__remove_context_a…

…rguments

pkg: remove context arguments

bin/common.ml

@@ -47,8 +47,6 @@ let debug_backtraces =
 
 let default_build_dir = "_build"
 
-(* Allow options from term1 or exclusively options from term2. If the user
-   passes options from both terms, an error is reported. *)
 let one_of term1 term2 =
   Term.ret
   @@ let+ x, args1 = Term.with_used_args term1

bin/common.mli

@@ -87,3 +87,7 @@ module Let_syntax : sig
   val ( let+ ) : 'a Cmdliner.Term.t -> ('a -> 'b) -> 'b Cmdliner.Term.t
   val ( and+ ) : 'a Cmdliner.Term.t -> 'b Cmdliner.Term.t -> ('a * 'b) Cmdliner.Term.t
 end
+
+(** [one_of term1 term2] allows options from [term1] or exclusively options from
+    [term2]. If the user passes options from both terms, an error is reported. *)
+val one_of : 'a Cmdliner.Term.t -> 'a Cmdliner.Term.t -> 'a Cmdliner.Term.t

bin/describe/describe_pkg.ml

@@ -2,23 +2,12 @@ open Import
 module Lock_dir = Dune_pkg.Lock_dir
 module Local_package = Dune_pkg.Local_package
 
-module Lock = struct
-  let term =
+module Show_lock = struct
+  let print_lock lock_dir_arg () =
+    let open Fiber.O in
     let+ lock_dir_paths =
-      Arg.(
-        value
-        & pos_all string []
-        & info
-            ~doc:
-              "The paths of the the lock directories to be inspected. Defaults to the \
-               lock directory specified in the default context."
-            ~docv:"LOCKDIRS"
-            [])
-    in
-    let lock_dir_paths =
-      match List.map lock_dir_paths ~f:Path.Source.of_string with
-      | [] -> [ Lock_dir.default_path ]
-      | lock_dir_paths -> lock_dir_paths
+      Memo.run (Workspace.workspace ())
+      >>| Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dir_arg
     in
     Console.print
     @@ List.map lock_dir_paths ~f:(fun lock_dir_path ->
@@ -33,6 +22,14 @@ module Lock = struct
       |> Pp.vbox)
   ;;
 
+  let term =
+    let+ builder = Common.Builder.term
+    and+ lock_dir_arg = Pkg_common.Lock_dirs_arg.term in
+    let builder = Common.Builder.forbid_builds builder in
+    let common, config = Common.init builder in
+    Scheduler.go ~common ~config @@ print_lock lock_dir_arg
+  ;;
+
   let command =
     let doc = "Display packages in a lock file" in
     let info = Cmd.info ~doc "lock" in
@@ -117,15 +114,11 @@ module List_locked_dependencies = struct
     |> Pp.vbox
   ;;
 
-  let enumerate_lock_dirs_by_path ~context_name_arg ~all_contexts_arg =
+  let enumerate_lock_dirs_by_path ~lock_dirs =
     let open Fiber.O in
-    let+ per_contexts =
-      Pkg_common.Per_context.choose
-        ~context_name_arg
-        ~all_contexts_arg
-        ~version_preference_arg:None
-    in
-    List.filter_map per_contexts ~f:(fun { Pkg_common.Per_context.lock_dir_path; _ } ->
+    let+ workspace = Memo.run (Workspace.workspace ()) in
+    let lock_dirs = Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs workspace in
+    List.filter_map lock_dirs ~f:(fun lock_dir_path ->
       if Path.exists (Path.source lock_dir_path)
       then (
         try Some (lock_dir_path, Lock_dir.read_disk lock_dir_path) with
@@ -140,10 +133,9 @@ module List_locked_dependencies = struct
       else None)
   ;;
 
-  let list_locked_dependencies ~context_name_arg ~all_contexts_arg ~transitive =
+  let list_locked_dependencies ~transitive ~lock_dirs () =
     let open Fiber.O in
-    let+ lock_dirs_by_path =
-      enumerate_lock_dirs_by_path ~context_name_arg ~all_contexts_arg
+    let+ lock_dirs_by_path = enumerate_lock_dirs_by_path ~lock_dirs
     and+ local_packages = Pkg_common.find_local_packages in
     let pp =
       Pp.concat
@@ -171,12 +163,6 @@ module List_locked_dependencies = struct
 
   let term =
     let+ builder = Common.Builder.term
-    and+ context_name =
-      Pkg_common.context_term
-        ~doc:"Print information about the lockdir associated with this context"
-    and+ all_contexts =
-      Arg.(
-        value & flag & info [ "all-contexts" ] ~doc:"Print information about all lockdirs")
     and+ transitive =
       Arg.(
         value
@@ -186,15 +172,10 @@ module List_locked_dependencies = struct
             ~doc:
               "Display transitive dependencies (by default only immediate dependencies \
                are displayed)")
-    in
+    and+ lock_dirs = Pkg_common.Lock_dirs_arg.term in
     let builder = Common.Builder.forbid_builds builder in
     let common, config = Common.init builder in
-    Scheduler.go ~common ~config
-    @@ fun () ->
-    list_locked_dependencies
-      ~context_name_arg:context_name
-      ~all_contexts_arg:all_contexts
-      ~transitive
+    Scheduler.go ~common ~config @@ list_locked_dependencies ~transitive ~lock_dirs
   ;;
 
   let command = Cmd.v info term
@@ -205,5 +186,5 @@ let command =
   let info = Cmd.info ~doc "pkg" in
   Cmd.group
     info
-    [ Lock.command; List_locked_dependencies.command; Dependency_hash.command ]
+    [ Show_lock.command; List_locked_dependencies.command; Dependency_hash.command ]
 ;;

bin/pkg/lock.ml

@@ -5,108 +5,81 @@ module Opam_repo = Dune_pkg.Opam_repo
 module Repository_id = Dune_pkg.Repository_id
 module Lock_dir = Dune_pkg.Lock_dir
 
-let contexts_with_dup_lock_dir_paths ts =
-  List.map ts ~f:(fun { Per_context.lock_dir_path; context_common; _ } ->
-    lock_dir_path, context_common)
-  |> Path.Source.Map.of_list_multi
-  |> Path.Source.Map.to_list
-  |> List.find_opt ~f:(fun (_, context_commons) -> List.length context_commons > 1)
-;;
-
-let check_for_dup_lock_dir_paths ts =
-  contexts_with_dup_lock_dir_paths ts
-  |> Option.iter ~f:(fun (lock_dir_path, context_commons) ->
-    let loc = (List.hd context_commons : Workspace.Context.Common.t).loc in
-    User_error.raise
-      ~loc
-      ([ Pp.text
-           "Refusing to proceed as multiple selected contexts would create a lock dir at \
-            the same path."
-       ; Pp.textf
-           "These contexts all create a lock dir: %s"
-           (Path.Source.to_string_maybe_quoted lock_dir_path)
-       ]
-       @ List.map context_commons ~f:(fun (c : Dune_rules.Workspace.Context.Common.t) ->
-         Pp.textf
-           "- %s (defined at %s)"
-           (Context_name.to_string c.name |> String.maybe_quoted)
-           (Loc.to_file_colon_line c.loc))))
-;;
-
-let solve per_context ~update_opam_repositories ~solver_env_from_current_system =
+let solve
+  workspace
+  ~update_opam_repositories
+  ~solver_env_from_current_system
+  ~version_preference
+  ~lock_dirs_arg
+  =
   let open Fiber.O in
-  check_for_dup_lock_dir_paths per_context;
   (* a list of thunks that will perform all the file IO side
      effects after performing validation so that if materializing any
      lockdir would fail then no side effect takes place. *)
   (let* local_packages = find_local_packages in
    let+ solutions =
-     Fiber.parallel_map
-       per_context
-       ~f:
-         (fun
-           { Per_context.lock_dir_path
-           ; version_preference
-           ; repos
-           ; solver_env = solver_env_from_context
-           ; unset_solver_vars = unset_solver_vars_from_context
-           ; context_common = { name = context_name; _ }
-           ; constraints
-           ; repositories
-           }
-         ->
-         let solver_env =
-           solver_env
-             ~solver_env_from_context
-             ~solver_env_from_current_system
-             ~unset_solver_vars_from_context
-         in
-         let* repos = get_repos repos ~repositories ~update_opam_repositories in
-         let overlay =
-           Console.Status_line.add_overlay (Constant (Pp.text "Solving for Build Plan"))
+     Pkg_common.Lock_dirs_arg.lock_dirs_of_workspace lock_dirs_arg workspace
+     |> Fiber.parallel_map ~f:(fun lock_dir_path ->
+       let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
+       let solver_env =
+         solver_env
+           ~solver_env_from_context:
+             (Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env))
+           ~solver_env_from_current_system
+           ~unset_solver_vars_from_context:
+             (unset_solver_vars_of_workspace workspace ~lock_dir_path)
+       in
+       let* repos =
+         get_repos
+           (repositories_of_workspace workspace)
+           ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+           ~update_opam_repositories
+       in
+       let overlay =
+         Console.Status_line.add_overlay (Constant (Pp.text "Solving for Build Plan"))
+       in
+       Fiber.finalize
+         ~finally:(fun () ->
+           Console.Status_line.remove_overlay overlay;
+           Fiber.return ())
+         (fun () ->
+           Dune_pkg.Opam_solver.solve_lock_dir
+             solver_env
+             (Pkg_common.Version_preference.choose
+                ~from_arg:version_preference
+                ~from_context:
+                  (Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.version_preference)))
+             repos
+             ~local_packages:
+               (Package_name.Map.map local_packages ~f:Dune_pkg.Local_package.for_solver)
+             ~constraints:(constraints_of_workspace workspace ~lock_dir_path))
+       >>= function
+       | Error (`Diagnostic_message message) ->
+         Fiber.return (Error (lock_dir_path, message))
+       | Ok { lock_dir; files; _ } ->
+         let summary_message =
+           User_message.make
+             [ Pp.tag
+                 User_message.Style.Success
+                 (Pp.textf
+                    "Solution for %s:"
+                    (Path.Source.to_string_maybe_quoted lock_dir_path))
+             ; (match Package_name.Map.values lock_dir.packages with
+                | [] ->
+                  Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
+                | packages -> pp_packages packages)
+             ]
          in
-         Fiber.finalize
-           ~finally:(fun () ->
-             Console.Status_line.remove_overlay overlay;
-             Fiber.return ())
-           (fun () ->
-             Dune_pkg.Opam_solver.solve_lock_dir
-               solver_env
-               version_preference
-               repos
-               ~local_packages:
-                 (Package_name.Map.map
-                    local_packages
-                    ~f:Dune_pkg.Local_package.for_solver)
-               ~constraints)
-         >>= function
-         | Error (`Diagnostic_message message) ->
-           Fiber.return (Error (context_name, message))
-         | Ok { lock_dir; files; _ } ->
-           let summary_message =
-             User_message.make
-               [ Pp.tag
-                   User_message.Style.Success
-                   (Pp.textf
-                      "Solution for %s:"
-                      (Path.Source.to_string_maybe_quoted lock_dir_path))
-               ; (match Package_name.Map.values lock_dir.packages with
-                  | [] ->
-                    Pp.tag User_message.Style.Warning
-                    @@ Pp.text "(no dependencies to lock)"
-                  | packages -> pp_packages packages)
-               ]
-           in
-           let+ lock_dir = Lock_dir.compute_missing_checksums lock_dir in
-           Ok (Lock_dir.Write_disk.prepare ~lock_dir_path ~files lock_dir, summary_message))
+         let+ lock_dir = Lock_dir.compute_missing_checksums lock_dir in
+         Ok (Lock_dir.Write_disk.prepare ~lock_dir_path ~files lock_dir, summary_message))
    in
    Result.List.all solutions)
   >>| function
-  | Error (context_name, message) ->
+  | Error (lock_dir_path, message) ->
     User_error.raise
       [ Pp.textf
-          "Unable to solve dependencies in build context: %s"
-          (Dune_engine.Context_name.to_string context_name |> String.maybe_quoted)
+          "Unable to solve dependencies for %s:"
+          (Path.Source.to_string_maybe_quoted lock_dir_path)
       ; message
       ]
   | Ok write_disks_with_summaries ->
@@ -117,18 +90,13 @@ let solve per_context ~update_opam_repositories ~solver_env_from_current_system
 ;;
 
 let lock
-  ~context_name
-  ~all_contexts
   ~dont_poll_system_solver_variables
   ~version_preference
   ~update_opam_repositories
+  ~lock_dirs_arg
   =
   let open Fiber.O in
-  let* per_context =
-    Per_context.choose
-      ~context_name_arg:context_name
-      ~all_contexts_arg:all_contexts
-      ~version_preference_arg:version_preference
+  let* workspace = Memo.run (Workspace.workspace ())
   and* solver_env_from_current_system =
     if dont_poll_system_solver_variables
     then Fiber.return None
@@ -137,19 +105,16 @@ let lock
         ~path:(Env_path.path Stdune.Env.initial)
       >>| Option.some
   in
-  solve per_context ~update_opam_repositories ~solver_env_from_current_system
+  solve
+    workspace
+    ~update_opam_repositories
+    ~solver_env_from_current_system
+    ~version_preference
+    ~lock_dirs_arg
 ;;
 
 let term =
   let+ builder = Common.Builder.term
-  and+ context_name =
-    context_term
-      ~doc:
-        "Generate the lockdir associated with this context (the default context will be \
-         used if this is omitted)"
-  and+ all_contexts =
-    Arg.(
-      value & flag & info [ "all-contexts" ] ~doc:"Generate the lockdir for all contexts")
   and+ version_preference = Version_preference.term
   and+ dont_poll_system_solver_variables =
     Arg.(
@@ -173,16 +138,15 @@ let term =
           ~doc:
             "Do not fetch updates of opam repositories, will use the cached opam \
              metadata. This allows offline use if the repositories are cached locally.")
-  in
+  and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
   Scheduler.go ~common ~config (fun () ->
     lock
-      ~context_name
-      ~all_contexts
       ~dont_poll_system_solver_variables
       ~version_preference
-      ~update_opam_repositories:(not skip_update))
+      ~update_opam_repositories:(not skip_update)
+      ~lock_dirs_arg)
 ;;
 
 let info =