Add an option to encourage keeping installed packages if possible

src/opam_0install_cudf.ml

@@ -4,13 +4,23 @@ let tagged_with_avoid_version pkg =
     | _ -> false
   ) pkg.Cudf.pkg_extra
 
-let version_rev_compare ~prefer_oldest ~handle_avoid_version =
+let version_rev_compare ~prefer_oldest ~handle_avoid_version ~prefer_installed =
   let cmp =
     if prefer_oldest then
       fun pkg1 pkg2 -> Int.compare pkg1.Cudf.version pkg2.Cudf.version
     else
       fun pkg1 pkg2 -> Int.compare pkg2.Cudf.version pkg1.Cudf.version
   in
+  let cmp =
+    if prefer_installed then
+      fun pkg1 pkg2 ->
+        match pkg1.Cudf.installed, pkg2.Cudf.installed with
+        | true, true | false, false -> cmp pkg1 pkg2
+        | true, false -> -1
+        | false, true -> 1
+    else
+      cmp
+  in
   if handle_avoid_version then
     fun pkg1 pkg2 ->
       match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with
@@ -90,12 +100,12 @@ type t = Context.t
 type selections = Solver.Output.t
 type diagnostics = Input.requirements   (* So we can run another solve *)
 
-let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ~constraints universe =
+let create ?(prefer_oldest=false) ?(handle_avoid_version=true) ?(prefer_installed=false) ~constraints universe =
   {
     Context.universe;
     constraints;
     fresh_id = ref 0;
-    version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version;
+    version_rev_compare = version_rev_compare ~prefer_oldest ~handle_avoid_version ~prefer_installed;
   }
 
 let solve context pkgs =

src/opam_0install_cudf.mli

@@ -7,6 +7,7 @@ type diagnostics
 val create :
   ?prefer_oldest:bool ->
   ?handle_avoid_version:bool ->
+  ?prefer_installed:bool ->
   constraints:(Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list ->
   Cudf.universe ->
   t
@@ -16,7 +17,13 @@ val create :
     @param prefer_oldest if [true] the solver is set to return the least
     up-to-date version of each package, if a solution exists. This is [false] by
     default.
-    @before 0.4 the [prefer_oldest] parameter did not exist. *)
+    @before 0.4 the [prefer_oldest] parameter did not exist.
+
+    @param prefer_installed if [true] the solver will try to prioritize keeping
+    the versions of packages installed at their current version instead of
+    the latest possible version.
+    This is [false] by default.
+    @before 0.5 the [prefer_installed] parameter did not exist. *)
 
 val solve :
   t ->

test/cudf/test.ml

@@ -19,10 +19,15 @@ let universe =
     {Cudf.default_package with package = "d"; version = 2};
     {Cudf.default_package with package = "d"; version = 3};
     {Cudf.default_package with package = "d"; version = 4; pkg_extra = [("avoid-version", `Int 1)]};
+
+    {Cudf.default_package with package = "e"; version = 1};
+    {Cudf.default_package with package = "e"; version = 2; installed = true};
+    {Cudf.default_package with package = "e"; version = 3};
+    {Cudf.default_package with package = "e"; version = 4};
   ]
 
-let solve ?prefer_oldest req =
-  let x = Opam_0install_cudf.create ?prefer_oldest ~constraints:[] universe in
+let solve ?prefer_oldest ?prefer_installed req =
+  let x = Opam_0install_cudf.create ?prefer_oldest ?prefer_installed ~constraints:[] universe in
   match Opam_0install_cudf.solve x req with
   | Ok sel -> Ok (Opam_0install_cudf.packages_of_result sel)
   | Error diag -> Error (Opam_0install_cudf.diagnostics ~verbose:true diag)
@@ -67,6 +72,26 @@ let oldest_avoid_3 () =
     "equal" (Ok [("d", 1)])
     (solve ~prefer_oldest:true [("d", `Essential)])
 
+let prefer_installed_1 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 2)])
+    (solve ~prefer_installed:true [("e", `Essential)])
+
+let prefer_installed_2 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 2)])
+    (solve ~prefer_installed:true [("e", `Recommended)])
+
+let prefer_installed_3 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 4)])
+    (solve [("e", `Essential)])
+
+let prefer_installed_4 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 4)])
+    (solve [("e", `Recommended)])
+
 let () =
   Alcotest.run "cudf"
     [
@@ -84,4 +109,11 @@ let () =
           Alcotest.test_case "normal 3" `Quick simple_avoid_3;
           Alcotest.test_case "oldest 3" `Quick oldest_avoid_3;
         ] );
+      ( "keep-installed",
+        [
+          Alcotest.test_case "normal 1" `Quick prefer_installed_1;
+          Alcotest.test_case "normal 2" `Quick prefer_installed_2;
+          Alcotest.test_case "normal 3" `Quick prefer_installed_3;
+          Alcotest.test_case "normal 4" `Quick prefer_installed_4;
+        ] );
     ]