feature(pkg): positional lock dirs args

Signed-off-by: Ali Caglayan <[email protected]>

bin/describe/describe_pkg.ml

@@ -2,21 +2,11 @@ open Import
 module Lock_dir = Dune_pkg.Lock_dir
 module Local_package = Dune_pkg.Local_package
 
-module Lock = struct
+module Show_lock = struct
   let term =
-    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 = Pkg_common.Lock_dirs.term in
     let lock_dir_paths =
-      match List.map lock_dir_paths ~f:Path.Source.of_string with
+      match lock_dir_paths with
       | [] -> [ Lock_dir.default_path ]
       | lock_dir_paths -> lock_dir_paths
     in
@@ -117,11 +107,13 @@ module List_locked_dependencies = struct
     |> Pp.vbox
   ;;
 
-  let enumerate_lock_dirs_by_path =
+  let enumerate_lock_dirs_by_path ~lock_dirs =
     let open Fiber.O in
     let+ workspace = Memo.run (Workspace.workspace ()) in
-    let per_contexts = Pkg_common.lock_dirs_of_workspace workspace in
-    List.filter_map per_contexts ~f:(fun lock_dir_path ->
+    let lock_dirs =
+      Pkg_common.Lock_dirs.of_workspace workspace ~chosen_lock_dirs:lock_dirs
+    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
@@ -136,9 +128,9 @@ module List_locked_dependencies = struct
       else None)
   ;;
 
-  let list_locked_dependencies ~transitive =
+  let list_locked_dependencies ~transitive ~lock_dirs () =
     let open Fiber.O in
-    let+ lock_dirs_by_path = enumerate_lock_dirs_by_path
+    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
@@ -175,10 +167,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.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 ~transitive
+    Scheduler.go ~common ~config @@ list_locked_dependencies ~transitive ~lock_dirs
   ;;
 
   let command = Cmd.v info term
@@ -189,5 +181,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

@@ -10,14 +10,15 @@ let solve
   ~update_opam_repositories
   ~solver_env_from_current_system
   ~version_preference
+  ~lock_dirs
   =
   let open Fiber.O in
   (* 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 =
-     lock_dirs_of_workspace workspace
+     Lock_dirs.of_workspace workspace ~chosen_lock_dirs:lock_dirs
      |> Fiber.parallel_map ~f:(fun lock_dir_path ->
        let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
        let solver_env =
@@ -84,7 +85,12 @@ let solve
     List.iter write_disk_list ~f:Lock_dir.Write_disk.commit
 ;;
 
-let lock ~dont_poll_system_solver_variables ~version_preference ~update_opam_repositories =
+let lock
+  ~dont_poll_system_solver_variables
+  ~version_preference
+  ~update_opam_repositories
+  ~lock_dirs
+  =
   let open Fiber.O in
   let* workspace = Memo.run (Workspace.workspace ())
   and* solver_env_from_current_system =
@@ -100,6 +106,7 @@ let lock ~dont_poll_system_solver_variables ~version_preference ~update_opam_rep
     ~update_opam_repositories
     ~solver_env_from_current_system
     ~version_preference
+    ~lock_dirs
 ;;
 
 let term =
@@ -127,14 +134,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 = Lock_dirs.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
   Scheduler.go ~common ~config (fun () ->
     lock
       ~dont_poll_system_solver_variables
       ~version_preference
-      ~update_opam_repositories:(not skip_update))
+      ~update_opam_repositories:(not skip_update)
+      ~lock_dirs)
 ;;
 
 let info =

bin/pkg/outdated.ml

@@ -3,11 +3,11 @@ open Pkg_common
 module Lock_dir = Dune_pkg.Lock_dir
 module Opam_repo = Dune_pkg.Opam_repo
 
-let find_outdated_packages ~transitive () =
+let find_outdated_packages ~transitive ~lock_dirs () =
   let open Fiber.O in
   let+ pps, not_founds =
     let* workspace = Memo.run (Workspace.workspace ()) in
-    lock_dirs_of_workspace workspace
+    Lock_dirs.of_workspace workspace ~chosen_lock_dirs:lock_dirs
     |> Fiber.parallel_map ~f:(fun lock_dir_path ->
       (* updating makes sense when checking for outdated packages *)
       let* repos =
@@ -69,10 +69,10 @@ let term =
       & info
           [ "transitive" ]
           ~doc:"Check for outdated packages in transitive dependencies")
-  in
+  and+ lock_dirs = Lock_dirs.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
-  Scheduler.go ~common ~config @@ find_outdated_packages ~transitive
+  Scheduler.go ~common ~config @@ find_outdated_packages ~transitive ~lock_dirs
 ;;
 
 let info =

bin/pkg/pkg_common.ml

@@ -43,14 +43,6 @@ let repositories_of_workspace (workspace : Workspace.t) =
   |> Dune_pkg.Pkg_workspace.Repository.Name.Map.of_list_exn
 ;;
 
-let lock_dirs_of_workspace (workspace : Workspace.t) =
-  List.filter_map workspace.contexts ~f:(function
-    | Workspace.Context.Default { lock_dir; base = _ } ->
-      let lock_dir_path = Option.value lock_dir ~default:Dune_pkg.Lock_dir.default_path in
-      Some lock_dir_path
-    | Opam _ -> None)
-;;
-
 let constraints_of_workspace (workspace : Workspace.t) ~lock_dir_path =
   let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
   match lock_dir with
@@ -119,3 +111,50 @@ let pp_packages packages =
     ~f:(fun { Lock_dir.Pkg.info = { Lock_dir.Pkg_info.name; version; _ }; _ } ->
       Pp.verbatim (Package_name.to_string name ^ "." ^ Package_version.to_string version))
 ;;
+
+module Lock_dirs = struct
+  let term =
+    let+ arg =
+      Arg.(
+        value
+        & pos_all string []
+        & info
+            []
+            ~docv:"LOCKDIRS"
+            ~doc:"Lock directories to check for outdated packages. Defaults to dune.lock.")
+    in
+    List.map arg ~f:Path.Source.of_string
+  ;;
+
+  let of_workspace (workspace : Workspace.t) ~chosen_lock_dirs =
+    let workspace_lock_dirs =
+      List.filter_map workspace.contexts ~f:(function
+        | Workspace.Context.Default { lock_dir; base = _ } ->
+          let lock_dir_path =
+            Option.value lock_dir ~default:Dune_pkg.Lock_dir.default_path
+          in
+          Some lock_dir_path
+        | Opam _ -> None)
+    in
+    match chosen_lock_dirs with
+    | [] -> workspace_lock_dirs
+    | _ ->
+      let workspace_lock_dirs_set = Path.Source.Set.of_list workspace_lock_dirs in
+      let chosen_lock_dirs_set = Path.Source.Set.of_list chosen_lock_dirs in
+      if Path.Source.Set.is_subset chosen_lock_dirs_set ~of_:workspace_lock_dirs_set
+      then chosen_lock_dirs
+      else (
+        let unknown_lock_dirs =
+          Path.Source.Set.diff chosen_lock_dirs_set workspace_lock_dirs_set
+          |> Path.Source.Set.to_list
+        in
+        let f x = Path.pp (Path.source x) in
+        User_error.raise
+          [ Pp.text
+              "The following directories are not lock directories in this workspace:"
+          ; Pp.enumerate unknown_lock_dirs ~f
+          ; Pp.text "This workspace contains the following lock directories:"
+          ; Pp.enumerate workspace_lock_dirs ~f
+          ])
+  ;;
+end

bin/pkg/pkg_common.mli

@@ -22,8 +22,6 @@ val repositories_of_workspace
   :  Workspace.t
   -> Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t
 
-val lock_dirs_of_workspace : Workspace.t -> Path.Source.t list
-
 val repositories_of_lock_dir
   :  Workspace.t
   -> lock_dir_path:Path.Source.t
@@ -42,6 +40,27 @@ val get_repos
 
 val find_local_packages : Dune_pkg.Local_package.t Package_name.Map.t Fiber.t
 
-(** [pp_packages lock_dir] returns a list of pretty-printed packages
-    occuring in [lock_dir]. *)
+module Lock_dirs : sig
+  (** [Lock_dirs.term] is a command-line argument that can be used to specify
+      the lock directories to consider. This can then be passed as
+      [~chosen_lock_dirs] to [Lock_dirs.of_workspace].*)
+  val term : Path.Source.t list Term.t
+
+  (** [Lock_dirs.of_workspace workspace ~chosen_lock_dirs] returns the list of
+      lock directories that should be considered for various operations. If
+      [chosen_lock_dirs] is empty, then all lock directories are considered.
+
+      The [workspace] argument is used to determine the list of all lock lock
+      directories.
+
+      A user error is raised if the [chosen_lock_dirs] are not a subset of the
+      lock directories of the workspace. *)
+  val of_workspace
+    :  Workspace.t
+    -> chosen_lock_dirs:Path.Source.t list
+    -> Path.Source.t list
+end
+
+(** [pp_packages lock_dir] returns a list of pretty-printed packages occuring in
+    [lock_dir]. *)
 val pp_packages : Dune_pkg.Lock_dir.Pkg.t list -> 'a Pp.t

bin/pkg/print_solver_env.ml

@@ -15,7 +15,7 @@ let print_solver_env_for_lock_dir workspace ~solver_env_from_current_system lock
     ]
 ;;
 
-let print_solver_env ~dont_poll_system_solver_variables =
+let print_solver_env ~dont_poll_system_solver_variables ~lock_dirs =
   let open Fiber.O in
   let+ workspace = Memo.run (Workspace.workspace ())
   and+ solver_env_from_current_system =
@@ -26,7 +26,7 @@ let print_solver_env ~dont_poll_system_solver_variables =
         ~path:(Env_path.path Stdune.Env.initial)
       >>| Option.some
   in
-  let lock_dirs = lock_dirs_of_workspace workspace in
+  let lock_dirs = Lock_dirs.of_workspace workspace ~chosen_lock_dirs:lock_dirs in
   List.iter
     lock_dirs
     ~f:(print_solver_env_for_lock_dir workspace ~solver_env_from_current_system)
@@ -47,11 +47,11 @@ let term =
              \"undefined\" which is treated as false. For example if a dependency has a \
              filter `{os = \"linux\"}` and the variable \"os\" is unset, the dependency \
              will be excluded. ")
-  in
+  and+ lock_dirs = Lock_dirs.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
   Scheduler.go ~common ~config (fun () ->
-    print_solver_env ~dont_poll_system_solver_variables)
+    print_solver_env ~dont_poll_system_solver_variables ~lock_dirs)
 ;;
 
 let info =

bin/pkg/validate_lock_dir.ml

@@ -11,10 +11,14 @@ let info =
   Cmd.info "validate-lockdir" ~doc ~man
 ;;
 
-let enumerate_lock_dirs_by_path () =
+(* CR-someday alizter: The logic here is a little more complicated than it needs
+   to be and can be simplified. *)
+
+let enumerate_lock_dirs_by_path ~lock_dirs () =
   let open Fiber.O in
   let+ per_contexts =
-    Memo.run (Workspace.workspace ()) >>| Pkg_common.lock_dirs_of_workspace
+    Memo.run (Workspace.workspace ())
+    >>| Pkg_common.Lock_dirs.of_workspace ~chosen_lock_dirs:lock_dirs
   in
   List.filter_map per_contexts ~f:(fun lock_dir_path ->
     if Path.exists (Path.source lock_dir_path)
@@ -24,9 +28,9 @@ let enumerate_lock_dirs_by_path () =
     else None)
 ;;
 
-let validate_lock_dirs () =
+let validate_lock_dirs ~lock_dirs () =
   let open Fiber.O in
-  let+ lock_dirs_by_path = enumerate_lock_dirs_by_path ()
+  let+ lock_dirs_by_path = enumerate_lock_dirs_by_path ~lock_dirs ()
   and+ local_packages = Pkg_common.find_local_packages in
   if List.is_empty lock_dirs_by_path
   then Console.print [ Pp.text "No lockdirs to validate." ]
@@ -67,10 +71,11 @@ let validate_lock_dirs () =
 ;;
 
 let term =
-  let+ builder = Common.Builder.term in
+  let+ builder = Common.Builder.term
+  and+ lock_dirs = Pkg_common.Lock_dirs.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
-  Scheduler.go ~common ~config validate_lock_dirs
+  Scheduler.go ~common ~config @@ validate_lock_dirs ~lock_dirs
 ;;
 
 let command = Cmd.v info term