Improve OpamAction API to make clearer when metadata is updated or not.

Improve the display of 'opam install' as well.

src/client/opamAction.ml

@@ -226,12 +226,20 @@ let compilation_env t opam =
   ] @ env0 in
   OpamState.add_to_env t env1 (OpamFile.OPAM.build_env opam)
 
+let flush_metadata t ~installed ~installed_roots =
+  OpamFile.Installed.write
+    (OpamPath.Switch.installed t.root t.switch)
+    installed;
+  OpamFile.Installed_roots.write
+    (OpamPath.Switch.installed_roots t.root t.switch)
+    installed_roots
+
 (* Remove a given package *)
 (* This will be done by the parent process, so theoritically we are
    allowed to modify the global state of OPAM here. However, for
    consistency reasons, this is done in the main function only. *)
-let remove_package_aux ~rm_build t nv =
-  log "deleting %s" (OpamPackage.to_string nv);
+let remove_package_aux t ~update_metadata ~rm_build nv =
+  log "Removing %s (%b)" (OpamPackage.to_string nv) update_metadata;
   let name = OpamPackage.name nv in
 
   (* Run the remove script *)
@@ -240,7 +248,8 @@ let remove_package_aux ~rm_build t nv =
     let opam = OpamState.opam t nv in
     let env = compilation_env t opam in
     match OpamState.filter_commands t (OpamFile.OPAM.remove opam) with
-    | []     -> ()
+    | []     ->
+      OpamGlobals.msg "Uninstalling %s.\n" (OpamPackage.to_string nv);
     | remove ->
       OpamGlobals.msg "Uninstalling %s:\n" (OpamPackage.to_string nv);
       let p_build = OpamPath.Switch.build t.root t.switch nv in
@@ -328,36 +337,50 @@ let remove_package_aux ~rm_build t nv =
 
   (* Remove the pinned cache *)
   log "Removing the pinned cache";
-  OpamFilename.rmdir (OpamPath.Switch.pinned_dir t.root t.switch name)
+  OpamFilename.rmdir (OpamPath.Switch.pinned_dir t.root t.switch name);
+
+  (* Update the metadata *)
+  if update_metadata then (
+    let installed = OpamPackage.Set.remove nv t.installed in
+    let installed_roots = OpamPackage.Set.remove nv t.installed_roots in
+    flush_metadata t ~installed ~installed_roots
+  )
 
-let remove_package ~rm_build t nv =
+let remove_package t ~update_metadata ~rm_build nv =
   if not !OpamGlobals.fake then
-    remove_package_aux ~rm_build t nv
+    remove_package_aux t ~update_metadata ~rm_build nv
 
 (* Uninstall all the current packages in a solution  *)
-let remove_all_packages t sol =
+let remove_all_packages t ~update_metadata sol =
   let open PackageActionGraph in
   let deleted = ref [] in
   let delete nv =
+    if !deleted = [] then
+      OpamGlobals.msg "\n=-=-= Removing Packages =-=-=\n";
     deleted := nv :: !deleted;
-    try remove_package ~rm_build:true t nv;
+    try remove_package t ~rm_build:true ~update_metadata:false nv;
     with _ -> () in
   let action n =
     match n with
     | To_change (Some nv, _)
     | To_recompile nv
     | To_delete nv        -> delete nv
     | To_change (None, _) -> () in
-
   List.iter delete sol.to_remove;
   PackageActionGraph.iter_vertex action sol.to_process;
-  OpamPackage.Set.of_list !deleted
+  let deleted = OpamPackage.Set.of_list !deleted in
+  if update_metadata then (
+    let installed = OpamPackage.Set.diff t.installed deleted in
+    let installed_roots = OpamPackage.Set.diff t.installed_roots deleted in
+    flush_metadata t ~installed ~installed_roots
+  );
+  deleted
 
 (* Build and install a package. In case of error, simply return the
    error traces, and let the repo in a state that the user can
    explore.  Do not try to recover yet. *)
-let build_and_install_package_aux t nv =
-  OpamGlobals.msg "\n=-=-= %s =-=-=\n" (OpamPackage.to_string nv);
+let build_and_install_package_aux t ~update_metadata nv =
+  OpamGlobals.msg "\n=-=-= Installing %s =-=-=\n" (OpamPackage.to_string nv);
 
   let opam = OpamState.opam t nv in
 
@@ -428,6 +451,13 @@ let build_and_install_package_aux t nv =
     (* If everyting went fine, finally install the package. *)
     install_package t nv;
 
+    (* update the metadata *)
+    if update_metadata then (
+      let installed = OpamPackage.Set.add nv t.installed in
+      let installed_roots = OpamPackage.Set.add nv t.installed_roots in
+      flush_metadata t ~installed ~installed_roots
+    )
+
   with e ->
     let cause = match e with
       | Sys.Break -> "was aborted"
@@ -436,9 +466,9 @@ let build_and_install_package_aux t nv =
     OpamGlobals.error
       "The compilation of %s %s."
       (OpamPackage.to_string nv) cause;
-    remove_package ~rm_build:false t nv;
+    remove_package ~rm_build:false ~update_metadata:false t nv;
     raise e
 
-let build_and_install_package t nv =
+let build_and_install_package t ~update_metadata nv =
   if not !OpamGlobals.fake then
-    build_and_install_package_aux t nv
+    build_and_install_package_aux t ~update_metadata nv

src/client/opamAction.mli

@@ -19,12 +19,12 @@ open OpamTypes
 open OpamState.Types
 
 (** Build and install a package. *)
-val build_and_install_package: t -> package -> unit
+val build_and_install_package: t -> update_metadata:bool -> package -> unit
 
 (** Remove a package. *)
-val remove_package: rm_build:bool -> t -> package -> unit
+val remove_package: t -> update_metadata:bool -> rm_build:bool -> package -> unit
 
 (** Remove all the packages from a solution. This includes the package
    to delete, to upgrade and to recompile. Return the set of all deleted
    packages. *)
-val remove_all_packages: t -> solution -> package_set
+val remove_all_packages: t -> update_metadata:bool -> solution -> package_set

src/client/opamClient.ml

@@ -782,7 +782,7 @@ let remove names =
       atoms in
 
   if does_not_exist <> [] then (
-    List.iter (OpamAction.remove_package ~rm_build:true t) does_not_exist;
+    List.iter (OpamAction.remove_package ~rm_build:true ~update_metadata:false t) does_not_exist;
     let installed_f = OpamPath.Switch.installed t.root t.switch in
     let installed = OpamFile.Installed.read installed_f in
     let installed = OpamPackage.Set.filter (fun nv -> not (List.mem nv does_not_exist)) installed in

src/client/opamSolution.ml

@@ -173,16 +173,14 @@ let can_try_to_recover_from_error l =
 (* Try to recover from errors by installing either the old packages or
    by reinstalling the current ones. This can also fail but if it
    succeeds OPAM should remains in a consistent state. *)
-let recover_from_error t add_to_install = function
+let recover_from_error = function
   | To_delete _          -> ()
   | To_recompile nv
   | To_change (Some nv, _)
   | To_change (None, nv) ->
-    try
-      OpamAction.build_and_install_package t nv;
-      add_to_install nv
-    with _ ->
-      ()
+    let t = OpamState.load_state "recover-from-error" in
+    try OpamAction.build_and_install_package t ~update_metadata:true nv
+    with _ -> ()
 
 (* Mean function for applying solver solutions. One main process is
    deleting the packages and updating the global state of
@@ -209,18 +207,19 @@ let parallel_apply t action solution =
      OPAM consistent (as the user is free to kill OPAM at every
      moment). We are not guaranteed to always be consistent, but we
      try hard to be.*)
-  let flush () =
-    OpamFile.Installed.write (OpamPath.Switch.installed t.root t.switch) !installed;
-    OpamFile.Installed_roots.write (OpamPath.Switch.installed_roots t.root t.switch) !installed_roots in
-
   let add_to_install nv =
     installed := OpamPackage.Set.add nv !installed;
-    if OpamPackage.Name.Set.mem (OpamPackage.name nv) root_installs then
-      installed_roots := OpamPackage.Set.add nv !installed_roots in
-
-  let rm_from_install nv =
-    installed := OpamPackage.Set.remove nv !installed;
-    installed_roots := OpamPackage.Set.remove nv !installed_roots in
+    let installed_f = OpamPath.Switch.installed t.root t.switch in
+    OpamFile.Installed.write installed_f !installed;
+    if OpamPackage.Name.Set.mem (OpamPackage.name nv) root_installs then (
+      installed_roots := OpamPackage.Set.add nv !installed_roots;
+      let installed_roots_f = OpamPath.Switch.installed_roots t.root t.switch in
+      OpamFile.Installed_roots.write installed_roots_f !installed_roots;
+    ) in
+
+  let remove_from_install deleted =
+    installed := OpamPackage.Set.diff !installed deleted;
+    installed_roots := OpamPackage.Set.diff !installed_roots deleted in
 
   (* Installation and recompilation are done by child the processes *)
   let child n =
@@ -231,7 +230,7 @@ let parallel_apply t action solution =
     let t = OpamState.load_state "child" in
     match n with
     | To_change (_, nv)
-    | To_recompile nv   -> OpamAction.build_and_install_package t nv
+    | To_recompile nv   -> OpamAction.build_and_install_package ~update_metadata:false t nv
     | To_delete _       -> assert false in
 
   (* Not pre-condition (yet ?) *)
@@ -242,21 +241,20 @@ let parallel_apply t action solution =
   let post = function
     | To_delete _       -> assert false
     | To_recompile nv
-    | To_change (_, nv) -> add_to_install nv; flush () in
+    | To_change (_, nv) -> add_to_install nv in
 
   try
-
     let jobs = OpamFile.Config.jobs t.config in
     (* 1/ We remove all installed packages appearing in the solution. *)
-    let deleted = OpamAction.remove_all_packages t solution in
-    OpamPackage.Set.iter rm_from_install deleted;
-    flush ();
+    let deleted = OpamAction.remove_all_packages t ~update_metadata:true solution in
+    remove_from_install deleted;
+
     (* 2/ We install the new packages *)
     PackageActionGraph.Parallel.parallel_iter jobs solution.to_process ~pre ~child ~post;
     if !OpamGlobals.fake then
       OpamGlobals.msg "Simulation complete.\n";
-    OK
 
+    OK
   with
   | PackageActionGraph.Parallel.Cyclic actions ->
     let packages = List.map (List.map action_contents) actions in
@@ -277,11 +275,8 @@ let parallel_apply t action solution =
     if can_try_to_recover_from_error errors then (
       let pkgs = List.map (fst |> action_contents |> OpamPackage.to_string) errors in
       OpamGlobals.msg "==== ERROR RECOVERY [%s] ====\n" (String.concat ", " pkgs);
-      let recover nv =
-        recover_from_error t add_to_install nv;
-        flush () in
-      List.iter recover (List.map fst errors);
-      List.iter recover remaining;
+      List.iter recover_from_error (List.map fst errors);
+      List.iter recover_from_error remaining;
     );
     List.iter display_error errors;
     Error (List.map fst errors @ remaining)