pkg: print portable solutions grouped by platform (#12620)

The message that prints after solving lists each package in the
solution. When a solution is portable, it's possible (though hopefully
rare) that the version of a package included in a solution will be
different depending on the platform. This led to multiple versions of
the same package appearing in the message for non-obvious reasons, which
some found confusing.

This commit changes the message when portable lockdirs are enabled, such
that the packages common to all platforms are printed together, and each
set of platform-specific dependencies is printetd separately from the
common dependencies.

Signed-off-by: Stephen Sherratt <[email protected]>

Author: gridbugs

bin/pkg/lock.ml

@@ -114,12 +114,14 @@ let solve_multiple_platforms
   let+ results =
     Fiber.parallel_map solve_for_platforms ~f:(fun platform_env ->
       let solver_env = Dune_pkg.Solver_env.extend portable_solver_env platform_env in
-      solve_for_env solver_env)
+      let+ solver_result = solve_for_env solver_env in
+      Result.map_error solver_result ~f:(fun (`Diagnostic_message message) ->
+        platform_env, message))
   in
   let solver_results, errors =
     List.partition_map results ~f:(function
       | Ok result -> Left result
-      | Error (`Diagnostic_message message) -> Right message)
+      | Error e -> Right e)
   in
   match solver_results, errors with
   | [], [] -> Code_error.raise "Solver did not run for any platforms." []
@@ -133,6 +135,77 @@ let solve_multiple_platforms
     else `Partial (merged_solver_result, errors)
 ;;
 
+let summary_message
+      ~portable_lock_dir
+      ~lock_dir_path
+      ~(lock_dir : Lock_dir.t)
+      ~maybe_perf_stats
+      ~maybe_unsolved_platforms_message
+  =
+  if portable_lock_dir
+  then (
+    let pkgs_by_platform = Lock_dir.Packages.pkgs_by_platform lock_dir.packages in
+    let opam_package_sets_by_platform =
+      Dune_pkg.Solver_env.Map.map pkgs_by_platform ~f:(fun pkgs ->
+        List.map pkgs ~f:(fun (pkg : Dune_pkg.Lock_dir.Pkg.t) ->
+          OpamPackage.create
+            (Dune_pkg.Package_name.to_opam_package_name pkg.info.name)
+            (Dune_pkg.Package_version.to_opam_package_version pkg.info.version))
+        |> OpamPackage.Set.of_list)
+    in
+    let common_packages =
+      Dune_pkg.Solver_env.Map.values opam_package_sets_by_platform
+      |> List.reduce ~f:OpamPackage.Set.inter
+      |> Option.value ~default:OpamPackage.Set.empty
+    in
+    let pp_package_set package_set =
+      if OpamPackage.Set.is_empty package_set
+      then Pp.tag User_message.Style.Warning @@ Pp.text "(none)"
+      else
+        Pp.enumerate (OpamPackage.Set.elements package_set) ~f:(fun opam_package ->
+          Pp.text (OpamPackage.to_string opam_package))
+    in
+    let uncommon_packages_by_platform =
+      Dune_pkg.Solver_env.Map.map opam_package_sets_by_platform ~f:(fun package_set ->
+        OpamPackage.Set.diff package_set common_packages)
+      |> Dune_pkg.Solver_env.Map.filteri ~f:(fun _ package_set ->
+        not (OpamPackage.Set.is_empty package_set))
+    in
+    let maybe_uncommon_packages =
+      if Dune_pkg.Solver_env.Map.is_empty uncommon_packages_by_platform
+      then []
+      else
+        Pp.nop
+        :: Pp.text "Additionally, some packages will only be built on specific platforms."
+        :: (Dune_pkg.Solver_env.Map.to_list uncommon_packages_by_platform
+            |> List.concat_map ~f:(fun (platform, packages) ->
+              [ Pp.nop
+              ; Pp.concat [ Dune_pkg.Solver_env.pp_oneline platform; Pp.text ":" ]
+              ; pp_package_set packages
+              ]))
+    in
+    (Pp.tag
+       User_message.Style.Success
+       (Pp.textf "Solution for %s" (Path.to_string_maybe_quoted lock_dir_path))
+     :: Pp.nop
+     :: Pp.text "This solution supports the following platforms:"
+     :: Pp.enumerate (snd lock_dir.solved_for_platforms) ~f:Dune_pkg.Solver_env.pp_oneline
+     :: Pp.nop
+     :: Pp.text "Dependencies on all supported platforms:"
+     :: pp_package_set common_packages
+     :: (maybe_uncommon_packages @ maybe_perf_stats))
+    @ maybe_unsolved_platforms_message)
+  else
+    (Pp.tag
+       User_message.Style.Success
+       (Pp.textf "Solution for %s:" (Path.to_string_maybe_quoted lock_dir_path))
+     :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
+         | [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
+         | packages -> pp_packages packages)
+     :: maybe_perf_stats)
+    @ maybe_unsolved_platforms_message
+;;
+
 let solve_lock_dir
       workspace
       ~local_packages
@@ -211,14 +284,32 @@ let solve_lock_dir
     | `All_error messages -> Error messages
     | `All_ok solver_result -> Ok (solver_result, [])
     | `Partial (solver_result, errors) ->
-      Log.info errors;
+      Log.info
+      @@ List.map errors ~f:(fun (platform, solver_error) ->
+        Pp.concat
+          ~sep:Pp.newline
+          [ Pp.box @@ Pp.text "Failed to find package solution for platform:"
+          ; Dune_pkg.Solver_env.pp platform
+          ; solver_error
+          ]);
       Ok
         ( solver_result
         , [ Pp.nop
-          ; Pp.text
-              "No solution was found for some platforms. See the log or run with \
-               --verbose for more details."
-            |> Pp.tag User_message.Style.Warning
+          ; Pp.tag User_message.Style.Warning
+            @@ Pp.concat
+                 ~sep:Pp.newline
+                 [ Pp.box
+                   @@ Pp.text "No package solution was found for some requsted platforms."
+                 ; Pp.nop
+                 ; Pp.box @@ Pp.text "Platforms with no solution:"
+                 ; Pp.enumerate errors ~f:(fun (platform, _) ->
+                     Dune_pkg.Solver_env.pp_oneline platform)
+                 ; Pp.nop
+                 ; Pp.box
+                   @@ Pp.text
+                        "See the log or run with --verbose for more details. Configure \
+                         platforms to solve for in the dune-workspace file."
+                 ]
           ] )
   in
   match solver_result with
@@ -245,15 +336,12 @@ let solve_lock_dir
     in
     let summary_message =
       User_message.make
-        ((Pp.tag
-            User_message.Style.Success
-            (Pp.textf "Solution for %s:" (Path.to_string_maybe_quoted lock_dir_path))
-          :: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
-              | [] ->
-                Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
-              | packages -> pp_packages packages)
-          :: maybe_perf_stats)
-         @ maybe_unsolved_platforms_message)
+        (summary_message
+           ~portable_lock_dir
+           ~lock_dir_path
+           ~lock_dir
+           ~maybe_perf_stats
+           ~maybe_unsolved_platforms_message)
     in
     progress_state := None;
     let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in
@@ -308,7 +396,8 @@ let solve
   | Error errors ->
     User_error.raise
       ([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
-       @ List.concat_map errors ~f:(fun (path, messages) ->
+       @ List.concat_map errors ~f:(fun (path, messages_by_platform) ->
+         let messages = List.map messages_by_platform ~f:snd in
          [ Pp.textf "Lock directory %s:" (Path.to_string_maybe_quoted path)
          ; Pp.hovbox (Pp.concat ~sep:Pp.newline messages)
          ]))

src/dune_pkg/lock_dir.ml

@@ -1022,6 +1022,13 @@ module Packages = struct
       |> List.find ~f:(Pkg.is_enabled_on_platform ~platform))
   ;;
 
+  let pkgs_by_platform t =
+    to_pkg_list t
+    |> List.fold_left ~init:Solver_env.Map.empty ~f:(fun acc (pkg : Pkg.t) ->
+      List.fold_left pkg.enabled_on_platforms ~init:acc ~f:(fun acc platform ->
+        Solver_env.Map.add_multi acc platform pkg))
+  ;;
+
   let merge a b =
     Package_name.Map.merge a b ~f:(fun _ a b ->
       match a, b with

src/dune_pkg/lock_dir.mli

@@ -89,6 +89,9 @@ module Packages : sig
 
   val to_pkg_list : t -> Pkg.t list
   val pkgs_on_platform_by_name : t -> platform:Solver_env.t -> Pkg.t Package_name.Map.t
+
+  (** All the packages grouped by the platforms where they are enabled. *)
+  val pkgs_by_platform : t -> Pkg.t list Solver_env.Map.t
 end
 
 type t = private

src/dune_pkg/solver_env.ml

@@ -104,6 +104,19 @@ let pp t =
         (String.maybe_quoted (Variable_value.to_string value)))
 ;;
 
+let pp_oneline t =
+  if Package_variable_name.Map.is_empty t
+  then Pp.text "(empty)"
+  else
+    Pp.concat
+      ~sep:(Pp.text "; ")
+      (List.map (Package_variable_name.Map.to_list t) ~f:(fun (variable, value) ->
+         Pp.textf
+           "%s = %s"
+           (Package_variable_name.to_string variable)
+           (String.maybe_quoted (Variable_value.to_string value))))
+;;
+
 let unset = Package_variable_name.Map.remove
 
 let unset_multi t variable_names =

src/dune_pkg/solver_env.mli

@@ -29,6 +29,7 @@ val extend : t -> t -> t
 val with_defaults : t
 
 val pp : t -> 'a Pp.t
+val pp_oneline : t -> 'a Pp.t
 val unset_multi : t -> Package_variable_name.Set.t -> t
 
 (** [remove_all_except t names] returns an environment with the same bindings

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-basic.t

@@ -34,7 +34,17 @@ Create a package that writes a different value to some files depending on the os
   > EOF
 
   $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
-  Solution for dune.lock:
+  Solution for dune.lock
+  
+  This solution supports the following platforms:
+  - arch = x86_64; os = linux
+  - arch = arm64; os = linux
+  - arch = x86_64; os = macos
+  - arch = arm64; os = macos
+  - arch = x86_64; os = win32
+  - arch = arm64; os = win32
+  
+  Dependencies on all supported platforms:
   - foo.0.0.1
 
   $ cat ${default_lock_dir}/lock.dune

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-custom-platforms.t

@@ -46,7 +46,12 @@ Create a custom dune-workspace to solve for openbsd.
   > EOF
 
   $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
-  Solution for dune.lock:
+  Solution for dune.lock
+  
+  This solution supports the following platforms:
+  - arch = x86_64; os = openbsd
+  
+  Dependencies on all supported platforms:
   - foo.0.0.1
 
   $ cat ${default_lock_dir}/lock.dune

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-custom-solver-env.t

@@ -49,7 +49,23 @@ Set up a project that depends on the package:
 
 Solve the project:
   $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
-  Solution for dune.lock:
+  Solution for dune.lock
+  
+  This solution supports the following platforms:
+  - arch = x86_64; os = linux; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  - arch = arm64; os = linux; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  - arch = x86_64; os = macos; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  - arch = arm64; os = macos; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  - arch = x86_64; os = win32; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  - arch = arm64; os = win32; sys-ocaml-version =
+    5.4.0+solver-env-version-override
+  
+  Dependencies on all supported platforms:
   - foo.0.0.1
 
 Confirming that the build action creates the conditional file:

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-depexts-basic.t

@@ -22,7 +22,17 @@ Demonstrate various cases representing depexts in lockfiles.
   > EOF
 
   $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
-  Solution for dune.lock:
+  Solution for dune.lock
+  
+  This solution supports the following platforms:
+  - arch = x86_64; os = linux
+  - arch = arm64; os = linux
+  - arch = x86_64; os = macos
+  - arch = arm64; os = macos
+  - arch = x86_64; os = win32
+  - arch = arm64; os = win32
+  
+  Dependencies on all supported platforms:
   - foo.0.0.1
 
   $ cat ${default_lock_dir}/foo.0.0.1.pkg

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-depexts-pkg-config.t

@@ -52,7 +52,14 @@ correct depext names can be chosen for the current distro at build time.
   > EOF
 
   $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
-  Solution for dune.lock:
+  Solution for dune.lock
+  
+  This solution supports the following platforms:
+  - arch = x86_64; os = macos; os-distribution = homebrew; os-family = homebrew
+  - arch = x86_64; os = linux
+  - arch = x86_64; os = win32; os-distribution = cygwin; os-family = windows
+  
+  Dependencies on all supported platforms:
   - conf-pkg-config.0.0.1
 
 Print the name of the depext on a variety of os/distro/versions: