Deduplicate solver errors when generating portable lockdirs

When generating portable lockdirs the solver runs multiple times. Dune
collects any errors from the solver and prints them to the terminal in
the event that no solution was found on any platforms, and logs them
printing a warning if no solution was found on some but not all
platforms. This can create a situation where the same error is printed
multiple times, since many solver errors are platform agnostic.

This change groups solver errors by the contents of their message when
generating portable lockdirs. Each solver error is printed a single
time, along with the list of platforms on which it occurred.

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

Author: gridbugs

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)