diff --git a/otherlibs/stdune/src/list.ml b/otherlibs/stdune/src/list.ml index d7483eee9bb..93fa131738b 100644 --- a/otherlibs/stdune/src/list.ml +++ b/otherlibs/stdune/src/list.ml @@ -262,3 +262,14 @@ let intersperse xs ~sep = in loop [] xs ;; + +let rec partition_three xs ~f = + match xs with + | [] -> [], [], [] + | first :: rest -> + let xs, ys, zs = partition_three ~f rest in + (match f first with + | `Left x -> x :: xs, ys, zs + | `Middle y -> xs, y :: ys, zs + | `Right z -> xs, ys, z :: zs) +;; diff --git a/otherlibs/stdune/src/list.mli b/otherlibs/stdune/src/list.mli index 67158294711..238b44063c6 100644 --- a/otherlibs/stdune/src/list.mli +++ b/otherlibs/stdune/src/list.mli @@ -18,6 +18,11 @@ val concat_map : 'a t -> f:('a -> 'b t) -> 'b t val partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b t * 'c t val rev_partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b t * 'c t +val partition_three + : 'a t + -> f:('a -> [ `Left of 'x | `Middle of 'y | `Right of 'z ]) + -> 'x list * 'y list * 'z list + type ('a, 'b) skip_or_either = | Skip | Left of 'a diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index f5c8f3c512d..dfeda685005 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -448,8 +448,8 @@ module Solver = struct let implementations = function | Virtual (_, impls) -> Fiber.return { impls } | Real role -> - let context = role.context in let+ impls = + let context = role.context in Context.candidates context role.name >>| List.filter_map ~f:(function | _, Error _rejection -> None @@ -570,21 +570,10 @@ module Solver = struct | None -> Error req ;; - let rec partition_three f = function - | [] -> [], [], [] - | first :: rest -> - let xs, ys, zs = partition_three f rest in - (match f first with - | `Left x -> x :: xs, ys, zs - | `Middle y -> xs, y :: ys, zs - | `Right z -> xs, ys, z :: zs) - ;; - let pp_rolemap ~verbose reasons = let good, bad, unknown = - reasons - |> Solver.Output.RoleMap.bindings - |> partition_three (fun (role, component) -> + Solver.Output.RoleMap.bindings reasons + |> List.partition_three ~f:(fun (role, component) -> match Diagnostics.Component.selected_impl component with | Some impl when Diagnostics.Component.notes component = [] -> `Left impl | _ ->