Skip to content

Commit

Permalink
refactor(pkg): move [partition_three] to [Stdune.List] (#11280)
Browse files Browse the repository at this point in the history
Signed-off-by: Rudi Grinberg <[email protected]>
  • Loading branch information
rgrinberg authored Jan 9, 2025
1 parent 610047d commit 098117d
Show file tree
Hide file tree
Showing 3 changed files with 19 additions and 14 deletions.
11 changes: 11 additions & 0 deletions otherlibs/stdune/src/list.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
;;
5 changes: 5 additions & 0 deletions otherlibs/stdune/src/list.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
17 changes: 3 additions & 14 deletions src/dune_pkg/opam_solver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
| _ ->
Expand Down

0 comments on commit 098117d

Please sign in to comment.