feature(pkg): dune pkg outdated

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]>

bin/pkg.ml

@@ -3,17 +3,12 @@ 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 Outdated_packages = Dune_pkg.Outdated_packages
 
-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 context_term ~doc =
+  Arg.(value & opt (some Arg.context_name) None & info [ "context" ] ~docv:"CONTEXT" ~doc)
 ;;
 
 module Version_preference = struct
@@ -260,7 +255,11 @@ module Print_solver_env = struct
 
   let term =
     let+ (common : Common.t) = Common.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
@@ -404,6 +403,16 @@ module Lock = struct
                ]))
   ;;
 
+  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
+    Package.Name.Map.map dune_package_map ~f:Package.to_opam_file
+  ;;
+
   let solve
     per_context
     ~opam_repository_path
@@ -416,14 +425,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
-       Package.Name.Map.map dune_package_map ~f:Package.to_opam_file
-     in
+    (let* local_packages = find_local_packages in
      let+ solutions =
        Fiber.parallel_map
          per_context
@@ -515,7 +517,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
@@ -559,6 +565,106 @@ module Lock = struct
   let command = Cmd.v info term
 end
 
+module Outdated = struct
+  let find_outdated_packages
+    ~context_name_arg
+    ~all_contexts_arg
+    ~opam_repository_path
+    ~opam_repository_url
+    ~transitive
+    ()
+    =
+    let open Fiber.O in
+    let* per_context =
+      Per_context.choose ~context_name_arg ~all_contexts_arg ~version_preference_arg:None
+    in
+    List.mapi
+      per_context
+      ~f:
+        (fun
+          per_context_index
+          { Per_context.lock_dir_path
+          ; version_preference = _
+          ; repos
+          ; solver_env = solver_env_from_context
+          ; context_common = { name = context_name; _ }
+          }
+        ->
+        let solver_env =
+          Print_solver_env.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 repos solver_env ~opam_repository_path ~opam_repository_url
+        and+ local_packages = Lock.find_local_packages in
+        let lock_dir = Lock_dir.read_disk lock_dir_path in
+        let results = Outdated_packages.find ~repos ~local_packages lock_dir in
+        Console.print (Outdated_packages.pp ~transitive ~lock_dir_path results);
+        let default_spacing =
+          if per_context_index < List.length per_context - 1 then [ Pp.nop ] else []
+        in
+        Console.print (Outdated_packages.raise_errors results ~default:default_spacing))
+    |> Fiber.all_concurrently_unit
+  ;;
+
+  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
+    @@ find_outdated_packages
+         ~context_name_arg
+         ~all_contexts_arg
+         ~opam_repository_path
+         ~opam_repository_url
+         ~transitive
+  ;;
+
+  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 =
@@ -570,4 +676,4 @@ let info =
   Cmd.info "pkg" ~doc ~man
 ;;
 
-let group = Cmd.group info [ Lock.command; Print_solver_env.command ]
+let group = Cmd.group info [ Lock.command; Print_solver_env.command; Outdated.command ]

src/dune_pkg/dune_pkg.ml

@@ -11,3 +11,4 @@ module Substs = Substs
 module Sys_poll = Sys_poll
 module Version_preference = Version_preference
 module Pkg_workspace = Workspace
+module Outdated_packages = Outdated_packages

src/dune_pkg/opam_repo.ml

@@ -55,6 +55,12 @@ let repo_id t =
   serializable.repo_id
 ;;
 
+let source t =
+  let open Option.O in
+  let+ serializable = serializable t in
+  serializable.source
+;;
+
 let validate_repo_file opam_repo_dir_path =
   let opam_repo_file_path = opam_repo_dir_path / "repo" in
   let repo =

src/dune_pkg/opam_repo.mli

@@ -22,6 +22,7 @@ val of_opam_repo_dir_path
   -> t
 
 val repo_id : t -> Repository_id.t option
+val source : t -> string option
 val serializable : t -> Serializable.t option
 
 (** Load package metadata for a single package *)