Skip to content

Commit

Permalink
feature(pkg): dune pkg outdated
Browse files Browse the repository at this point in the history 
We add a `dune pkg outdated` package that will display outdated package
dependencies with respect to the condigured opam repositories.

It comes with a --transitive flag that shows all outdated transitive
deps.

Signed-off-by: Ali Caglayan <[email protected]>
  • Loading branch information
@Alizter
Alizter committed Sep 29, 2023
1 parent aff8994 commit 81cea41
Show file tree
Hide file tree
Showing 12 changed files with 973 additions and 72 deletions.
298 changes: 227 additions & 71 deletions bin/pkg.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,13 @@ module Lock_dir = Dune_pkg.Lock_dir
module Fetch = Dune_pkg.Fetch
module Opam_repo = Dune_pkg.Opam_repo
module Repository_id = Dune_pkg.Repository_id
module Pkg_workspace = Dune_pkg.Pkg_workspace
module Opam_solver = Dune_pkg.Opam_solver
module Better_candidate = Dune_pkg.Better_candidate

let context_term ~doc =
Arg.(value & opt (some Arg.context_name) None & info [ "context" ] ~docv:"CONTEXT" ~doc)
;;

module Lock = struct
module Opam_repository_path = struct
Expand Down Expand Up @@ -261,18 +268,6 @@ module Lock = struct
Dune_pkg.Solver_env.set_sys solver_env_from_context sys
;;

let context_term =
Arg.(
value
& opt (some Arg.context_name) None
& info
[ "context" ]
~docv:"CONTEXT"
~doc:
"Generate the lockdir associated with this context (the default context will \
be used if this is omitted)")
;;

let print_solver_env
per_context
~sys_bindings_from_current_system
Expand Down Expand Up @@ -302,6 +297,76 @@ module Lock = struct
])
;;

let get_repository_of_path path =
let repo_id = Repository_id.of_path path in
Opam_repo.of_opam_repo_dir_path ~source:None ~repo_id path
;;

let get_repository_of_url url =
let repo = Fetch.Opam_repository.of_url url in
let open Fiber.O in
let+ opam_repository = Fetch.Opam_repository.path repo in
match opam_repository with
| Ok { path; repo_id } ->
Opam_repo.of_opam_repo_dir_path ~source:(Some (OpamUrl.to_string url)) ~repo_id path
| Error _ ->
User_error.raise
[ Pp.textf
"Can't determine the location of the opam-repository '%s'"
(OpamUrl.to_string url)
]
;;

let get_repositorys_from_workspace solver_env repos =
(* read from workspace *)
Dune_pkg.Solver_env.repos solver_env
|> Fiber.parallel_map ~f:(fun name ->
match Dune_pkg.Pkg_workspace.Repository.Name.Map.find repos name with
| None ->
(* TODO: have loc for this failure? *)
User_error.raise
[ Pp.textf "Repository '%s' is not a known repository"
@@ Dune_pkg.Pkg_workspace.Repository.Name.to_string name
]
| Some repo ->
let url = Dune_pkg.Pkg_workspace.Repository.opam_url repo in
let repo = Fetch.Opam_repository.of_url url in
let open Fiber.O in
let+ opam_repository = Fetch.Opam_repository.path repo in
(match opam_repository with
| Ok { path; repo_id } ->
Opam_repo.of_opam_repo_dir_path
~source:(Some (OpamUrl.to_string url))
~repo_id
path
| Error _ ->
User_error.raise
[ Pp.textf "Can't determine the location of the opam-repository '%s'"
@@ Dune_pkg.Pkg_workspace.Repository.Name.to_string name
]))
;;

let get_repos ~opam_repository_path ~opam_repository_url ~solver_env repos =
let open Fiber.O in
match opam_repository_path, opam_repository_url with
| Some _, Some _ ->
(* in theory you can set both, but how to prioritize them? *)
User_error.raise [ Pp.text "Can't specify both path and URL to an opam-repository" ]
| Some path, None -> Fiber.return [ get_repository_of_path path ]
| None, Some url -> get_repository_of_url url >>| List.singleton
| None, None -> get_repositorys_from_workspace solver_env repos
;;

let find_local_packages =
let open Fiber.O in
let+ dune_package_map =
let+ source_dir = Memo.run (Source_tree.root ()) in
let project = Source_tree.Dir.project source_dir in
Dune_project.packages project
in
opam_file_map_of_dune_package_map dune_package_map
;;

let solve
per_context
~opam_repository_path
Expand All @@ -314,14 +379,7 @@ module Lock = struct
(* 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 =
let+ dune_package_map =
let+ source_dir = Memo.run (Source_tree.root ()) in
let project = Source_tree.Dir.project source_dir in
Dune_project.packages project
in
opam_file_map_of_dune_package_map dune_package_map
in
(let* local_packages = find_local_packages in
let+ solutions =
Fiber.parallel_map
per_context
Expand All @@ -342,55 +400,7 @@ module Lock = struct
~use_env_from_current_system
in
let+ repos =
match opam_repository_path, opam_repository_url with
| Some _, Some _ ->
(* in theory you can set both, but how to prioritize them? *)
User_error.raise
[ Pp.text "Can't specify both path and URL to an opam-repository" ]
| Some path, None ->
let repo_id = Repository_id.of_path path in
Fiber.return
@@ [ Opam_repo.of_opam_repo_dir_path ~source:None ~repo_id path ]
| None, Some url ->
let repo = Fetch.Opam_repository.of_url url in
let+ opam_repository = Fetch.Opam_repository.path repo in
(match opam_repository with
| Ok { path; repo_id } ->
[ Opam_repo.of_opam_repo_dir_path
~source:(Some (OpamUrl.to_string url))
~repo_id
path
]
| Error _ ->
User_error.raise
[ Pp.text "Can't determine the location of the opam-repository" ])
| None, None ->
(* read from workspace *)
Dune_pkg.Solver_env.repos solver_env
|> Fiber.parallel_map ~f:(fun name ->
match Dune_pkg.Pkg_workspace.Repository.Name.Map.find repos name with
| None ->
(* TODO: have loc for this failure? *)
User_error.raise
[ Pp.textf "Repository '%s' is not a known repository"
@@ Dune_pkg.Pkg_workspace.Repository.Name.to_string name
]
| Some repo ->
let url = Dune_pkg.Pkg_workspace.Repository.opam_url repo in
let repo = Fetch.Opam_repository.of_url url in
let+ opam_repository = Fetch.Opam_repository.path repo in
(match opam_repository with
| Ok { path; repo_id } ->
Opam_repo.of_opam_repo_dir_path
~source:(Some (OpamUrl.to_string url))
~repo_id
path
| Error _ ->
User_error.raise
[ Pp.textf
"Can't determine the location of the opam-repository '%s'"
@@ Dune_pkg.Pkg_workspace.Repository.Name.to_string name
]))
get_repos ~opam_repository_path ~opam_repository_url ~solver_env repos
in
match
Dune_pkg.Opam_solver.solve_lock_dir
Expand Down Expand Up @@ -431,7 +441,11 @@ module Lock = struct
let+ (common : Common.t) = Common.term
and+ opam_repository_path = Opam_repository_path.term
and+ opam_repository_url = Opam_repository_url.term
and+ context_name = context_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
Expand Down Expand Up @@ -505,6 +519,148 @@ module Lock = struct
let command = Cmd.v info term
end

module Outdated = struct
let term =
let+ (common : Common.t) = Common.term
and+ context_name_arg =
context_term ~doc:"Check for outdated packages in this context"
and+ all_contexts_arg =
Arg.(
value
& flag
& info [ "all-contexts" ] ~doc:"Check for outdated packages in all contexts")
and+ opam_repository_path = Lock.Opam_repository_path.term
and+ opam_repository_url = Lock.Opam_repository_url.term
and+ transitive =
Arg.(
value
& flag
& info
[ "transitive" ]
~doc:"Check for outdated packages in transitive dependencies")
in
let common = Common.forbid_builds common in
let config = Common.init common in
Scheduler.go ~common ~config
@@ fun () ->
let open Fiber.O in
let* per_context =
Lock.Per_context.choose
~context_name_arg
~all_contexts_arg
~version_preference_arg:None
in
List.mapi
per_context
~f:
(fun
per_context_index
{ Lock.Per_context.lock_dir_path
; version_preference
; repos
; solver_env = solver_env_from_context
; context_common = { name = context_name; _ }
}
->
let solver_env =
Lock.merge_current_system_bindings_into_solver_env_from_context
~context_name
~solver_env_from_context
~sys_bindings_from_current_system:
Dune_pkg.Solver_env.Variable.Sys.Bindings.empty
~use_env_from_current_system:false
in
let* repos =
Lock.get_repos ~opam_repository_path ~opam_repository_url ~solver_env repos
and+ local_packages = Lock.find_local_packages in
let lock_dir = Lock_dir.read_disk lock_dir_path in
let+ results =
lock_dir.packages
|> Dune_lang.Package_name.Map.to_list_map ~f:(fun _ pkg -> pkg)
|> Fiber.parallel_map ~f:(fun pkg ->
let+ () = Fiber.return () in
Opam_solver.better_candidate
~solver_env
~repos
~local_packages
~version_preference
pkg)
in
Console.print (Better_candidate.outdated_status ~transitive lock_dir_path results);
List.iter
(Better_candidate.outdated_packages results)
~f:(fun (is_immediate_dep_of_local_package, name, version, new_version) ->
(* If --transitive is passed, then we always print the available package. If
not, then we only print it if it is an immediate dependency of a local
package. *)
if transitive || is_immediate_dep_of_local_package
then
(* CR-someday alizter: Create table printing helpers in Console and use
those to align output. *)
Console.print
[ Pp.hbox
@@ Pp.concat
[ Pp.verbatim (Dune_lang.Package_name.to_string name)
; Pp.space
; Pp.tag
(User_message.Style.Ansi_styles [ `Fg_bright_red ])
(Pp.verbatim version)
; Pp.text " < "
; Pp.tag
(User_message.Style.Ansi_styles [ `Fg_bright_green ])
(Pp.verbatim new_version)
]
]);
(* The following messages will include extra spacing if they are not the last
context. *)
let extra_spacing =
if per_context_index < List.length per_context - 1 then [ Pp.nop ] else []
in
(* Finally raise any errors from packages not being found in the repos. *)
match Better_candidate.packages_that_were_not_found results with
| [] -> Console.print extra_spacing
| [ pkg_name ] ->
User_error.raise
([ Pp.textf
"%s was not found in the configured repositories."
(Dune_lang.Package_name.to_string pkg_name)
]
@ extra_spacing)
| pkg_names ->
User_error.raise
([ Pp.text
"The following packages were not found in the configured repositories:"
; Pp.enumerate pkg_names ~f:(fun name ->
Dune_lang.Package_name.to_string name |> Pp.verbatim)
]
@ extra_spacing))
|> Fiber.all_concurrently_unit
;;

let info =
let doc = "Check for outdated packages" in
let man =
[ `S "DESCRIPTION"
; `P
"List packages in from lock directory that have newer versions available. By \
default, only direct dependencies are checked. The $(b,--transitive) flag can \
be used to check transitive dependencies as well."
; `P "For example:"
; `Pre " \\$ dune pkg outdated"
; `Noblank
; `Pre " Outdated packages in dune.lock:"
; `Noblank
; `Pre " ocaml 5.1.1 < 5.2.0"
; `Noblank
; `Pre " dune 3.7.1 < 3.11.0"
]
in
Cmd.info "outdated" ~doc ~man
;;

let command = Cmd.v info term
end

let info =
let doc = "Experimental package management" in
let man =
Expand All @@ -516,4 +672,4 @@ let info =
Cmd.info "pkg" ~doc ~man
;;

let group = Cmd.group info [ Lock.command ]
let group = Cmd.group info [ Lock.command; Outdated.command ]
Loading

0 comments on commit 81cea41

Please sign in to comment.