Deduplicate solver errors when generating portable lockdirs

bin/pkg/lock.ml

@@ -84,6 +84,33 @@ let resolve_project_pins project_pins =
   Pin.resolve project_pins ~scan_project
 ;;
 
+module Platforms_by_message = struct
+  module Message_map = Map.Make (struct
+      type t = User_message.Style.t Pp.t
+
+      let to_dyn = Pp.to_dyn User_message.Style.to_dyn
+      let compare = Pp.compare ~compare:User_message.Style.compare
+    end)
+
+  (* Map messages to the list of platforms for which those messages are
+     relevant. If a dependency problem has no solution on any platform, it's
+     likely that the error from the solver will be identical across all
+     platforms. We don't want to print the same error message once for each
+     platform, so this type collects messages and the platforms for which they
+     are relevant, deduplicating common messages. *)
+  type t = Solver_env.t list Message_map.t
+
+  let singleton message platform : t = Message_map.singleton message [ platform ]
+
+  let to_list (t : t) : (User_message.Style.t Pp.t * Solver_env.t list) list =
+    Message_map.to_list t
+  ;;
+
+  let union_all ts : t = Message_map.union_all ts ~f:(fun _ a b -> Some (a @ b))
+  let all_platforms (t : t) = Message_map.values t |> List.concat
+  let all_messages (t : t) = Message_map.keys t
+end
+
 let solve_multiple_platforms
       base_solver_env
       version_preference
@@ -117,7 +144,7 @@ let solve_multiple_platforms
       let solver_env = Solver_env.extend portable_solver_env platform_env in
       let+ solver_result = solve_for_env solver_env in
       Result.map_error solver_result ~f:(fun (`Diagnostic_message message) ->
-        platform_env, message))
+        Platforms_by_message.singleton message platform_env))
   in
   let solver_results, errors =
     List.partition_map results ~f:(function
@@ -126,14 +153,14 @@ let solve_multiple_platforms
   in
   match solver_results, errors with
   | [], [] -> Code_error.raise "Solver did not run for any platforms." []
-  | [], errors -> `All_error errors
+  | [], errors -> `All_error (Platforms_by_message.union_all errors)
   | x :: xs, errors ->
     let merged_solver_result =
       List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge
     in
     if List.is_empty errors
     then `All_ok merged_solver_result
-    else `Partial (merged_solver_result, errors)
+    else `Partial (merged_solver_result, Platforms_by_message.union_all errors)
 ;;
 
 let summary_message
@@ -207,6 +234,23 @@ let summary_message
     @ maybe_unsolved_platforms_message
 ;;
 
+let pp_solve_errors_by_platforms platforms_by_message =
+  Platforms_by_message.to_list platforms_by_message
+  |> List.map ~f:(fun (solver_error, platforms) ->
+    Pp.concat
+      ~sep:Pp.cut
+      [ Pp.nop
+      ; Pp.box
+        @@ Pp.text
+             "The dependency solver failed to find a solution for the following \
+              platforms:"
+      ; Pp.enumerate platforms ~f:Solver_env.pp_oneline
+      ; Pp.box @@ Pp.text "...with this error:"
+      ; solver_error
+      ]
+    |> Pp.vbox)
+;;
+
 let solve_lock_dir
       workspace
       ~local_packages
@@ -285,14 +329,7 @@ let solve_lock_dir
     | `All_error messages -> Error messages
     | `All_ok solver_result -> Ok (solver_result, [])
     | `Partial (solver_result, 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:"
-          ; Solver_env.pp platform
-          ; solver_error
-          ]);
+      Log.info @@ pp_solve_errors_by_platforms errors;
       Ok
         ( solver_result
         , [ Pp.nop
@@ -303,8 +340,9 @@ let solve_lock_dir
                    @@ 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, _) ->
-                     Solver_env.pp_oneline platform)
+                 ; Pp.enumerate
+                     (Platforms_by_message.all_platforms errors)
+                     ~f:Solver_env.pp_oneline
                  ; Pp.nop
                  ; Pp.box
                    @@ Pp.text
@@ -395,13 +433,24 @@ let solve
    | _ -> Error errors)
   >>| function
   | Error errors ->
-    User_error.raise
-      ([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
-       @ 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)
-         ]))
+    if portable_lock_dir
+    then
+      User_error.raise
+        (List.concat_map errors ~f:(fun (path, errors) ->
+           [ Pp.box
+             @@ Pp.textf
+                  "Unable to solve dependencies while generating lock directory: %s"
+                  (Path.to_string_maybe_quoted path)
+           ; Pp.vbox (Pp.concat ~sep:Pp.cut (pp_solve_errors_by_platforms errors))
+           ]))
+    else
+      User_error.raise
+        ([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
+         @ List.concat_map errors ~f:(fun (path, errors) ->
+           let messages = Platforms_by_message.all_messages errors in
+           [ Pp.textf "Lock directory %s:" (Path.to_string_maybe_quoted path)
+           ; Pp.vbox (Pp.concat ~sep:Pp.cut messages)
+           ]))
   | Ok write_disks_with_summaries ->
     let write_disk_list, summary_messages = List.split write_disks_with_summaries in
     List.iter summary_messages ~f:Console.print_user_message;

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-no-solution.t

@@ -0,0 +1,86 @@
+Demonstrate the case where a project can't be solved at all.
+
+  $ . ../helpers.sh
+  $ mkrepo
+  $ add_mock_repo_if_needed
+
+Make some packages that can't be coinstalled:
+  $ mkpkg a <<EOF
+  > depends: [
+  >  "c" {= "0.1"}
+  > ]
+  > EOF
+
+  $ mkpkg b <<EOF
+  > depends: [
+  >  "c" {= "0.2"}
+  > ]
+  > EOF
+
+  $ mkpkg c "0.2"
+
+Depend on a pair of packages which can't be coinstalled:
+  $ cat > dune-project <<EOF
+  > (lang dune 3.18)
+  > (package
+  >  (name foo)
+  >  (depends a b))
+  > EOF
+
+Solver error when solving fails with the same error on all platforms:
+  $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
+  Error:
+  Unable to solve dependencies while generating lock directory: dune.lock
+
+  The dependency solver failed to find a solution for 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
+  ...with this error:
+  Couldn't solve the package dependency formula.
+  Selected candidates: a.0.0.1 b.0.0.1 foo.dev
+  - c -> (problem)
+      a 0.0.1 requires = 0.1
+      Rejected candidates:
+        c.0.2: Incompatible with restriction: = 0.1
+  [1]
+
+Modify the "a" package so the solver error is different on different platforms:
+  $ mkpkg a <<EOF
+  > depends: [
+  >  "c" {= "0.1" & os = "linux"}
+  >  "c" {= "0.3" & os != "linux"}
+  > ]
+  > EOF
+
+This time there will be two different solver errors. Both will be printed along
+with the platforms where they are relevant:
+  $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock
+  Error:
+  Unable to solve dependencies while generating lock directory: dune.lock
+
+  The dependency solver failed to find a solution for the following platforms:
+  - arch = x86_64; os = linux
+  - arch = arm64; os = linux
+  ...with this error:
+  Couldn't solve the package dependency formula.
+  Selected candidates: a.0.0.1 b.0.0.1 foo.dev
+  - c -> (problem)
+      a 0.0.1 requires = 0.1
+      Rejected candidates:
+        c.0.2: Incompatible with restriction: = 0.1
+
+  The dependency solver failed to find a solution for the following platforms:
+  - arch = x86_64; os = macos
+  - arch = arm64; os = macos
+  - arch = x86_64; os = win32
+  ...with this error:
+  Couldn't solve the package dependency formula.
+  Selected candidates: a.0.0.1 b.0.0.1 foo.dev
+  - c -> (problem)
+      a 0.0.1 requires = 0.3
+      Rejected candidates:
+        c.0.2: Incompatible with restriction: = 0.3
+  [1]

test/blackbox-tests/test-cases/pkg/portable-lockdirs/portable-lockdirs-partial-solve.t

@@ -53,23 +53,12 @@ to solve for macos, linux, and windows by default.
   solve for in the dune-workspace file.
 
 The log file will contain errors about the package being unavailable.
-  $ sed -n -e "/Couldn't solve the package dependency formula./,\$p" _build/log
-  # Couldn't solve the package dependency formula.
-  # Selected candidates: x.dev
-  # - foo -> (problem)
-  #     No usable implementations:
-  #       foo.0.0.1: Availability condition not satisfied
-  # Failed to find package solution for platform:
-  # - arch = arm64
-  # - os = linux
-  # Couldn't solve the package dependency formula.
-  # Selected candidates: x.dev
-  # - foo -> (problem)
-  #     No usable implementations:
-  #       foo.0.0.1: Availability condition not satisfied
-  # Failed to find package solution for platform:
-  # - arch = x86_64
-  # - os = win32
+  $ sed -n -e "/The dependency solver failed to find a solution for the following platforms:/,\$p" _build/log
+  # The dependency solver failed to find a solution for the following platforms:
+  # - arch = x86_64; os = linux
+  # - arch = arm64; os = linux
+  # - arch = x86_64; os = win32
+  # ...with this error:
   # Couldn't solve the package dependency formula.
   # Selected candidates: x.dev
   # - foo -> (problem)