Add support for the avoid-version flag

ocaml-opam · Jul 31, 2024 · fdcc05a · fdcc05a
1 parent fa71b3a
commit fdcc05a
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 10 deletions.
diff --git a/src/opam_0install_cudf.ml b/src/opam_0install_cudf.ml
@@ -1,11 +1,39 @@
+let tagged_with_avoid_version pkg =
+  List.exists (function
+    | "avoid-version", (`Int 1 | `Bool true) -> true
+    | _ -> false
+  ) pkg.Cudf.pkg_extra
+
+let version_rev_compare ~prefer_oldest ~handle_avoid_version =
+  (* Unrolled for performance purpose *)
+  if prefer_oldest then
+    if handle_avoid_version then
+      fun pkg1 pkg2 ->
+        match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with
+        | true, true | false, false -> Int.compare pkg1.Cudf.version pkg2.Cudf.version
+        | true, false -> 1
+        | false, true -> -1
+    else
+      fun pkg1 pkg2 ->
+        Int.compare pkg1.Cudf.version pkg2.Cudf.version
+  else if handle_avoid_version then
+    fun pkg1 pkg2 ->
+      match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with
+      | true, true | false, false -> Int.compare pkg2.Cudf.version pkg1.Cudf.version
+      | true, false -> 1
+      | false, true -> -1
+  else
+    fun pkg1 pkg2 ->
+      Int.compare pkg2.Cudf.version pkg1.Cudf.version
+
 module Context = struct
   type rejection = UserConstraint of Cudf_types.vpkg
 
   type t = {
     universe : Cudf.universe;
     constraints : (Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list;
-    prefer_oldest : bool;
     fresh_id : int ref;
+    version_rev_compare : Cudf.package -> Cudf.package -> int;
   }
 
   let user_restrictions t name =
@@ -16,19 +44,13 @@ module Context = struct
         acc
     ) [] t.constraints
 
-  let version_compare t pkg1 pkg2 =
-    if t.prefer_oldest then
-      Int.compare pkg1.Cudf.version pkg2.Cudf.version
-    else
-      Int.compare pkg2.Cudf.version pkg1.Cudf.version
-
   let candidates t name =
     let user_constraints = user_restrictions t name in
     match Cudf.lookup_packages t.universe name with
     | [] ->
         [] (* Package not found *)
     | versions ->
-        List.fast_sort (version_compare t) versions (* Higher versions are preferred. *)
+        List.fast_sort t.version_rev_compare versions (* Higher versions are preferred. *)
         |> List.map (fun pkg ->
           let rec check_constr = function
             | [] -> (pkg.Cudf.version, Ok pkg)
@@ -74,8 +96,13 @@ type t = Context.t
 type selections = Solver.Output.t
 type diagnostics = Input.requirements   (* So we can run another solve *)
 
-let create ?(prefer_oldest=false) ~constraints universe =
-  { Context.universe; constraints; prefer_oldest; fresh_id = ref 0 }
+let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ~constraints universe =
+  {
+    Context.universe;
+    constraints;
+    fresh_id = ref 0;
+    version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version;
+  }
 
 let solve context pkgs =
   let req = requirements ~context pkgs in

diff --git a/src/opam_0install_cudf.mli b/src/opam_0install_cudf.mli
@@ -6,6 +6,7 @@ type diagnostics
 
 val create :
   ?prefer_oldest:bool ->
+  ?handle_avoid_version:bool ->
   constraints:(Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list ->
   Cudf.universe ->
   t