Add an option to encourage keeping installed packages if possible

lib-cudf/opam_0install_cudf.ml

@@ -3,6 +3,7 @@ type context = {
   constraints : (Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list;
   prefer_oldest : bool;
   handle_avoid_version : bool;
+  keep_installed : bool;
   fresh_id : int ref;
 }
 
@@ -19,11 +20,20 @@ let version_rev_compare context pkg1 pkg2 =
     else
       Int.compare pkg2.Cudf.version pkg1.Cudf.version
   in
-  if context.handle_avoid_version then
-    match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with
+  let rev_cmp () =
+    if context.handle_avoid_version then
+      match tagged_with_avoid_version pkg1, tagged_with_avoid_version pkg2 with
+      | true, true | false, false -> rev_cmp ()
+      | true, false -> 1
+      | false, true -> -1
+    else
+      rev_cmp ()
+  in
+  if context.keep_installed then
+    match pkg1.Cudf.installed, pkg2.Cudf.installed with
+    | true, false -> -1
+    | false, true -> 1
     | true, true | false, false -> rev_cmp ()
-    | true, false -> 1
-    | false, true -> -1
   else
     rev_cmp ()
 
@@ -92,8 +102,8 @@ 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=false) ~constraints universe =
-  { universe; constraints; prefer_oldest; handle_avoid_version; fresh_id = ref 0 }
+let create ?(prefer_oldest=false) ?(handle_avoid_version=false) ?(keep_installed=false) ~constraints universe =
+  { universe; constraints; prefer_oldest; handle_avoid_version; keep_installed; fresh_id = ref 0 }
 
 let solve context pkgs =
   let req = requirements ~context pkgs in

lib-cudf/opam_0install_cudf.mli

@@ -7,6 +7,7 @@ type diagnostics
 val create :
   ?prefer_oldest:bool ->
   ?handle_avoid_version:bool -> (* TODO: Make it true by default on the next major breaking release *)
+  ?keep_installed:bool -> (* TODO: Make it true by default on the next major breaking release *)
   constraints:(Cudf_types.pkgname * (Cudf_types.relop * Cudf_types.version)) list ->
   Cudf.universe ->
   t
@@ -22,7 +23,13 @@ val create :
     avoid-version flag that opam 2.1 introduced. This makes the solver try
     its best to avoid the versions tagged with this flag.
     This is [false] by default.
-    @before 0.5 the [handle_avoid_version] parameter did not exist. *)
+    @before 0.5 the [handle_avoid_version] parameter did not exist.
+
+    @param keep_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 [keep_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", `Bool true)]};
+
+    {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 ?handle_avoid_version req =
-  let x = Opam_0install_cudf.create ?prefer_oldest ?handle_avoid_version ~constraints:[] universe in
+let solve ?prefer_oldest ?handle_avoid_version ?keep_installed req =
+  let x = Opam_0install_cudf.create ?prefer_oldest ?handle_avoid_version ?keep_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)
@@ -40,7 +45,7 @@ let simple_oldest () =
 let simple_avoid_1 () =
   Alcotest.(check (result (list (pair string int)) string))
     "equal" (Ok [("b", 4)])
-    (solve [("b", `Essential)])
+    (solve ~handle_avoid_version:true [("b", `Essential)])
 
 let oldest_avoid_1 () =
   Alcotest.(check (result (list (pair string int)) string))
@@ -65,7 +70,27 @@ let simple_avoid_3 () =
 let oldest_avoid_3 () =
   Alcotest.(check (result (list (pair string int)) string))
     "equal" (Ok [("d", 1)])
-    (solve ~prefer_oldest:true [("d", `Essential)])
+    (solve ~handle_avoid_version:true ~prefer_oldest:true [("d", `Essential)])
+
+let keep_installed_1 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 2)])
+    (solve ~keep_installed:true [("e", `Essential)])
+
+let keep_installed_2 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 2)])
+    (solve ~keep_installed:true [("e", `Recommended)])
+
+let keep_installed_3 () =
+  Alcotest.(check (result (list (pair string int)) string))
+    "equal" (Ok [("e", 4)])
+    (solve [("e", `Essential)])
+
+let keep_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 keep_installed_1;
+          Alcotest.test_case "normal 2" `Quick keep_installed_2;
+          Alcotest.test_case "normal 3" `Quick keep_installed_3;
+          Alcotest.test_case "normal 4" `Quick keep_installed_4;
+        ] );
     ]