feature(pkg): positional lock dirs args

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

bin/describe/describe_pkg.ml

@@ -120,7 +120,7 @@ module List_locked_dependencies = struct
   let enumerate_lock_dirs_by_path =
     let open Fiber.O in
     let+ workspace = Memo.run (Workspace.workspace ()) in
-    let per_contexts = Pkg_common.lock_dirs_of_workspace workspace in
+    let per_contexts = Pkg_common.Lock_dirs.of_workspace workspace ~chosen_lock_dirs:[] in
     List.filter_map per_contexts ~f:(fun lock_dir_path ->
       if Path.exists (Path.source lock_dir_path)
       then (

bin/pkg/lock.ml

@@ -13,14 +13,15 @@ let solve
   ~solver_env_from_current_system
   ~experimental_translate_opam_filters
   ~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 =
@@ -96,6 +97,7 @@ let lock
   ~opam_repository_url
   ~update_opam_repositories
   ~experimental_translate_opam_filters
+  ~lock_dirs
   =
   let open Fiber.O in
   let* workspace = Memo.run (Workspace.workspace ())
@@ -115,6 +117,7 @@ let lock
     ~solver_env_from_current_system
     ~experimental_translate_opam_filters
     ~version_preference
+    ~lock_dirs
 ;;
 
 let term =
@@ -155,7 +158,7 @@ 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 () ->
@@ -165,7 +168,8 @@ let term =
       ~opam_repository_path
       ~opam_repository_url
       ~update_opam_repositories:(not skip_update)
-      ~experimental_translate_opam_filters)
+      ~experimental_translate_opam_filters
+      ~lock_dirs)
 ;;
 
 let info =

bin/pkg/outdated.ml

@@ -3,11 +3,16 @@ open Pkg_common
 module Lock_dir = Dune_pkg.Lock_dir
 module Opam_repo = Dune_pkg.Opam_repo
 
-let find_outdated_packages ~opam_repository_path ~opam_repository_url ~transitive () =
+let find_outdated_packages
+  ~opam_repository_path
+  ~opam_repository_url
+  ~transitive
+  chosen_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
     |> Fiber.parallel_map ~f:(fun lock_dir_path ->
       (* updating makes sense when checking for outdated packages *)
       let* repos =
@@ -73,11 +78,12 @@ 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 ~opam_repository_path ~opam_repository_url ~transitive
+  @@ fun () ->
+  find_outdated_packages ~opam_repository_path ~opam_repository_url ~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 repositories_of_lock_dir workspace ~lock_dir_path =
   let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
   Option.map lock_dir ~f:(fun lock_dir -> lock_dir.repositories)
@@ -180,3 +172,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:"LOCK_DIRS"
+            ~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
@@ -47,6 +45,27 @@ module Opam_repository_url : sig
   val term : OpamUrl.t option Term.t
 end
 
-(** [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

@@ -14,7 +14,8 @@ let info =
 let enumerate_lock_dirs_by_path () =
   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:[]
   in
   List.filter_map per_contexts ~f:(fun lock_dir_path ->
     if Path.exists (Path.source lock_dir_path)
@@ -69,6 +70,7 @@ let validate_lock_dirs () =
 let term =
   let+ builder = Common.Builder.term in
   let builder = Common.Builder.forbid_builds builder in
+  (* CR-someday alizter: This should accept the Pkg_common.Lock_dirs.term *)
   let common, config = Common.init builder in
   Scheduler.go ~common ~config validate_lock_dirs
 ;;