Skip to content

Commit

Permalink
refactor(pkg): more simplifications (#11241)
Browse files Browse the repository at this point in the history
in the style of dune

Signed-off-by: Rudi Grinberg <[email protected]>
  • Loading branch information
rgrinberg authored Dec 24, 2024
1 parent 00e1bcc commit 0a43607
Show file tree
Hide file tree
Showing 2 changed files with 26 additions and 28 deletions.
30 changes: 15 additions & 15 deletions src/opam-0install/lib/model.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
open Stdune

module Make (Context : S.CONTEXT) = struct
(* Note: [OpamFormula.neg] doesn't work in the [Empty] case, so we just
record whether to negate the result here. *)
Expand Down Expand Up @@ -62,7 +64,7 @@ module Make (Context : S.CONTEXT) = struct
let compare a b =
match a, b with
| Real a, Real b -> OpamPackage.Name.compare a.name b.name
| Virtual (a, _), Virtual (b, _) -> compare a b
| Virtual (a, _), Virtual (b, _) -> Ordering.to_int (Poly.compare a b)
| Real _, Virtual _ -> -1
| Virtual _, Real _ -> 1
;;
Expand All @@ -74,8 +76,7 @@ module Make (Context : S.CONTEXT) = struct

let virtual_impl ~context ~depends () =
let depends =
depends
|> List.map (fun name ->
List.map depends ~f:(fun name ->
let drole = role context name in
let importance = `Essential in
{ drole; importance; restrictions = [] })
Expand All @@ -85,11 +86,10 @@ module Make (Context : S.CONTEXT) = struct

let virtual_role impls =
let impls =
impls
|> List.mapi (fun i ->
function
| VirtualImpl (_, x) -> VirtualImpl (i, x)
| x -> x)
List.mapi impls ~f:(fun i ->
function
| VirtualImpl (_, x) -> VirtualImpl (i, x)
| x -> x)
in
Virtual (object end, impls)
;;
Expand Down Expand Up @@ -142,7 +142,7 @@ module Make (Context : S.CONTEXT) = struct

let conflict_class = function
| RealImpl impl ->
OpamFile.OPAM.conflict_class impl.opam |> List.map OpamPackage.Name.to_string
OpamFile.OPAM.conflict_class impl.opam |> List.map ~f:OpamPackage.Name.to_string
| VirtualImpl _ -> []
| Dummy | Reject _ -> []
;;
Expand Down Expand Up @@ -180,7 +180,7 @@ module Make (Context : S.CONTEXT) = struct
let context = role.context in
let+ impls =
Context.candidates context role.name
>>| List.filter_map (function
>>| List.filter_map ~f:(function
| _, Error _rejection -> None
| version, Ok opam ->
let pkg = OpamPackage.create role.name version in
Expand Down Expand Up @@ -223,10 +223,9 @@ module Make (Context : S.CONTEXT) = struct
match role with
| Virtual _ -> Fiber.return ([], [])
| Real role ->
let context = role.context in
let+ rejects =
Context.candidates context role.name
>>| List.filter_map (function
Context.candidates role.context role.name
>>| List.filter_map ~f:(function
| _, Ok _ -> None
| version, Error reason ->
let pkg = OpamPackage.create role.name version in
Expand All @@ -239,10 +238,11 @@ module Make (Context : S.CONTEXT) = struct
let compare_version a b =
match a, b with
| RealImpl a, RealImpl b -> OpamPackage.compare a.pkg b.pkg
| VirtualImpl (ia, _), VirtualImpl (ib, _) -> compare (ia : int) ib
| VirtualImpl (ia, _), VirtualImpl (ib, _) -> Ordering.to_int (Int.compare ia ib)
| Reject a, Reject b -> OpamPackage.compare a b
| ( (RealImpl _ | Reject _ | VirtualImpl _ | Dummy)
, (RealImpl _ | Reject _ | VirtualImpl _ | Dummy) ) -> compare b a
, (RealImpl _ | Reject _ | VirtualImpl _ | Dummy) ) ->
Ordering.to_int (Poly.compare b a)
;;

let user_restrictions = function
Expand Down
24 changes: 11 additions & 13 deletions src/opam-0install/lib/solver.ml
Original file line number Diff line number Diff line change
@@ -1,17 +1,15 @@
open Fiber.O
open Pp.O

module Make (Context : S.CONTEXT) = struct
open Fiber.O
open Pp.O
module Input = Model.Make (Context)

let requirements ~context pkgs =
let role =
match pkgs with
| [ pkg ] -> Input.role context pkg
| pkgs ->
let impl = Input.virtual_impl ~context ~depends:pkgs () in
Input.virtual_role [ impl ]
in
role
match pkgs with
| [ pkg ] -> Input.role context pkg
| pkgs ->
let impl = Input.virtual_impl ~context ~depends:pkgs () in
Input.virtual_role [ impl ]
;;

module Solver = Zeroinstall_solver.Make (Input)
Expand Down Expand Up @@ -60,7 +58,8 @@ module Make (Context : S.CONTEXT) = struct
++ Pp.cut
++ Pp.enumerate bad ~f:pp_bad
| _ ->
(* In case of unknown packages, no need to print the full diagnostic list, the problem is simpler. *)
(* In case of unknown packages, no need to print the full diagnostic
list, the problem is simpler. *)
Pp.hovbox
(Pp.text "The following packages couldn't be found: "
++ Pp.concat_map ~sep:Pp.space unknown ~f:pp_unknown)
Expand All @@ -78,8 +77,7 @@ module Make (Context : S.CONTEXT) = struct
;;

let packages_of_result sels =
sels
|> Solver.Output.to_map
Solver.Output.to_map sels
|> Solver.Output.RoleMap.to_seq
|> List.of_seq
|> List.filter_map (fun (_role, sel) -> Input.version (Solver.Output.unwrap sel))
Expand Down

0 comments on commit 0a43607

Please sign in to comment.