Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Improve the message displayed to the user when we reinstall packages.

Now OPAM display either:
* the root causes of the reinstall (ie. the package which caused the reinstallation)
* or the fact that the package has been modified upstream
  • Loading branch information...
commit 396f0b5b84e21cdf60cde926963ea9647e1a6e81 1 parent 006293e
@samoht samoht authored
View
2  src/client/opamClient.ml
@@ -868,7 +868,7 @@ let reinstall names =
let universe = OpamState.universe t Depends in
OpamSolver.forward_dependencies ~depopts:true ~installed:true universe reinstall in
let to_process =
- List.map (fun pkg -> To_recompile pkg) (List.rev depends) in
+ List.map (fun pkg -> To_recompile (pkg,[])) (List.rev depends) in
let solution = OpamSolution.apply_solution t (OpamSolver.sequential_solution to_process) in
OpamSolution.error_if_no_solution solution
View
12 src/client/opamSolution.ml
@@ -541,9 +541,9 @@ let apply_solution ?(force = false) t sol =
let child n =
let t = OpamState.load_state () in
match n with
- | To_change (o, nv) -> proceed_to_change t o nv
- | To_recompile nv -> proceed_to_recompile t nv
- | To_delete _ -> assert false in
+ | To_change (o, nv) -> proceed_to_change t o nv
+ | To_recompile (nv,_) -> proceed_to_recompile t nv
+ | To_delete _ -> assert false in
let pre _ = () in
@@ -577,7 +577,7 @@ let apply_solution ?(force = false) t sol =
with _ ->
())
| To_change (None, _) -> ()
- | To_recompile nv ->
+ | To_recompile (nv,_) ->
(* this case is quite tricky. We have to remove all the packages
depending in nv, as they will be broken if nv is uninstalled. *)
let universe = OpamState.universe t Depends in
@@ -603,7 +603,7 @@ let apply_solution ?(force = false) t sol =
else
f "downgrading to" nv
| To_change (None, nv) -> f "installing" nv
- | To_recompile nv -> f "recompiling" nv
+ | To_recompile (nv,_) -> f "recompiling" nv
| To_delete nv -> f "removing" nv in
let string_of_errors errors =
@@ -611,7 +611,7 @@ let apply_solution ?(force = false) t sol =
let packages =
List.map (function
| To_change (_,nv)
- | To_recompile nv
+ | To_recompile (nv,_)
| To_delete nv -> nv
) actions in
match packages with
View
38 src/core/opamMisc.ml
@@ -26,7 +26,7 @@ module type MAP = sig
val to_string: ('a -> string) -> 'a t -> string
val values: 'a t -> 'a list
val keys: 'a t -> key list
- val merge_max: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ val union: ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
val of_list: (key * 'a) list -> 'a t
end
module type ABSTRACT = sig
@@ -89,21 +89,21 @@ module Map = struct
let keys map = List.map fst (bindings map)
- let merge_max f =
- merge
- (fun k -> function
- | None -> fun x -> x
- | Some o1 -> function
- | None -> Some o1
- | Some o2 -> f k o1 o2)
-
- let to_string string_of_value m =
- let s (k,v) = Printf.sprintf "%s:%s" (O.to_string k) (string_of_value v) in
- let l = fold (fun k v l -> s (k,v)::l) m [] in
- string_of_list (fun x -> x) l
+ let union f m1 m2 =
+ M.fold (fun k v m ->
+ if M.mem k m then
+ M.add k (f v (M.find k m)) (M.remove k m)
+ else
+ M.add k v m
+ ) m1 m2
+
+ let to_string string_of_value m =
+ let s (k,v) = Printf.sprintf "%s:%s" (O.to_string k) (string_of_value v) in
+ let l = fold (fun k v l -> s (k,v)::l) m [] in
+ string_of_list (fun x -> x) l
- let of_list l =
- List.fold_left (fun map (k,v) -> add k v map) empty l
+ let of_list l =
+ List.fold_left (fun map (k,v) -> add k v map) empty l
end
@@ -153,6 +153,14 @@ module OP = struct
let (|>) f g x = g (f x)
+ let (@@) l1 l2 =
+ let rec aux acc = function
+ | [] -> List.rev acc
+ | [h] -> List.rev (h::acc)
+ | h1::(h2::_ as t) ->
+ if h1 = h2 then aux acc t else aux (h1::acc) t in
+ aux [] (List.sort compare (l1 @ l2))
+
end
let strip str =
View
18 src/core/opamMisc.mli
@@ -53,11 +53,11 @@ module type MAP = sig
(** Return the keys in the map. *)
val keys: 'a t -> key list
- (** Same as [merge] but only keys that appear in both maps
- are given in the merging function *)
- (** WARNING : Besides [key], the function could receive
- some [v1] and some [v2] such that [v1 = v2] holds. *)
- val merge_max: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+ (** A key will be in the union of [m1] and [m2] if it is appears
+ either [m1] or [m2], with the corresponding value. If a key
+ appears in both [m1] and [m2], then the resulting value is built
+ using the function given as argument. *)
+ val union: ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t
(** Convert an assoc list to a map *)
val of_list: (key * 'a) list -> 'a t
@@ -177,12 +177,18 @@ val filter_map: ('a -> 'b option) -> 'a list -> 'b list
(** Insert a value in an ordered list *)
val insert: ('a -> 'a -> int) -> 'a -> 'a list -> 'a list
-(** Lazy environment *)
+(** Lazy environment variable *)
val getenv: string -> string
+(** Lazy environment *)
+val env: unit -> (string * string) list
+
module OP: sig
(** Pipe operator *)
val (|>): ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
+ (** concatenation with uniqness. Elements are sorted. *)
+ val (@@): 'a list -> 'a list -> 'a list
+
end
View
14 src/core/opamTypes.ml
@@ -13,6 +13,8 @@
(* *)
(***********************************************************************)
+open OpamMisc.OP
+
type basename = OpamFilename.Base.t
type dirname = OpamFilename.Dir.t
@@ -333,7 +335,7 @@ type file = {
type 'a action =
| To_change of 'a option * 'a
| To_delete of 'a
- | To_recompile of 'a
+ | To_recompile of 'a * 'a list
module type ACTION_GRAPH = sig
@@ -368,7 +370,7 @@ module MakeActionGraph (Pkg: PKG) = struct
type t = Pkg.t action
let package = function
| To_change (_, p)
- | To_recompile p
+ | To_recompile (p, _)
| To_delete p -> p
let compare t1 t2 = Pkg.compare (package t1) (package t2)
let hash t = Pkg.hash (package t)
@@ -390,6 +392,10 @@ end
module PackageAction = struct
include OpamPackage
+
+ let string_of_names ps =
+ String.concat ", " (List.map (OpamPackage.name |> OpamPackage.Name.to_string) ps)
+
let string_of_action = function
| To_change (None, p) -> Printf.sprintf " - install %s" (OpamPackage.to_string p)
| To_change (Some o, p) ->
@@ -400,7 +406,9 @@ module PackageAction = struct
f "upgrade"
else
f "downgrade"
- | To_recompile p -> Printf.sprintf " - recompile %s" (OpamPackage.to_string p)
+ | To_recompile (p, []) -> Printf.sprintf " - recompile %s (cause: upstream change)" (OpamPackage.to_string p)
+ | To_recompile (p, [c]) -> Printf.sprintf " - recompile %s (cause: %s)" (OpamPackage.to_string p) (string_of_names [c])
+ | To_recompile (p, c) -> Printf.sprintf " - recompile %s (causes: %s)" (OpamPackage.to_string p) (string_of_names c)
| To_delete p -> Printf.sprintf " - delete %s" (OpamPackage.to_string p)
end
View
7 src/core/opamTypes.mli
@@ -171,8 +171,11 @@ type 'a action =
(** The package must be deleted. *)
| To_delete of 'a
- (** The package is already installed, but it must be recompiled. *)
- | To_recompile of 'a
+ (** The package is already installed, but it must be recompiled.
+ The second parameter is the collection of packages causing the
+ reinstallation. An empty list means that the package has been
+ modified upstream. *)
+ | To_recompile of 'a * 'a list
(** Graph of package actions *)
module type ACTION_GRAPH = sig
View
63 src/solver/opamCudf.ml
@@ -14,6 +14,7 @@
(***********************************************************************)
open OpamTypes
+open OpamMisc.OP
let log fmt = OpamGlobals.log "SOLVER" fmt
@@ -28,7 +29,7 @@ let string_of_action action =
f "upgrade"
else
f "downgrade"
- | To_recompile p -> Printf.sprintf " - recompile %s" (aux p)
+ | To_recompile (p,_) -> Printf.sprintf " - recompile %s" (aux p)
| To_delete p -> Printf.sprintf " - delete %s" (aux p)
let string_of_actions l =
@@ -336,7 +337,9 @@ module Diff = struct
end
(* Transform a diff from current to final state into a list of
- actions *)
+ actions. At this point, the transitive closure of actions has not
+ yet been taken, so the only reinstallation action we get come from
+ upstream changes. *)
let actions_of_diff diff =
Hashtbl.fold (fun pkgname s acc ->
let add x = x :: acc in
@@ -353,7 +356,7 @@ let actions_of_diff diff =
| None , Some p , _ -> add (To_change (None, p))
| Some p , None , _ -> add (To_delete p)
| Some p_old, Some p_new , _ -> add (To_change (Some p_old, p_new))
- | None , None , Some p -> add (To_recompile p)
+ | None , None , Some p -> add (To_recompile (p, []))
| None , None , None -> acc
) diff []
@@ -374,11 +377,17 @@ let create_graph filter universe =
let u = Cudf.load_universe pkgs in
Graph.of_universe u
-(* Build the graph of actions.
- - [simple_universe] is the graph with 'depends' only
- - [complex_universe] is the graph with 'depends' + 'depopts' *)
-let solution_of_actions ~simple_universe ~complete_universe actions =
- log "graph_of_actions actions=%s" (string_of_actions actions);
+(*
+ Compute a full solution from a set of root actions. This means:
+ 1/ computing the right sequence of removal.
+ 2/ computing the transitive closure of reinstallations.
+
+ Parameters:
+ - [simple _universe] is the graph with 'depends' only
+ - [complex_universe] is the graph with 'depends' + 'depopts'
+*)
+let solution_of_actions ~simple_universe ~complete_universe root_actions =
+ log "graph_of_actions root_actions=%s" (string_of_actions root_actions);
(* The packages to remove or upgrade *)
let to_remove_or_upgrade =
@@ -386,29 +395,29 @@ let solution_of_actions ~simple_universe ~complete_universe actions =
| To_change (Some pkg, _)
| To_delete pkg -> Some pkg
| _ -> None
- ) actions in
+ ) root_actions in
(* the packages to remove *)
let to_remove =
Set.of_list (OpamMisc.filter_map (function
| To_delete pkg -> Some pkg
| _ -> None
- ) actions) in
+ ) root_actions) in
(* the packages to recompile *)
let to_recompile =
- Set.of_list (OpamMisc.filter_map (function
- | To_recompile pkg -> Some pkg
+ Map.of_list (OpamMisc.filter_map (function
+ | To_recompile (pkg,causes) -> Some (pkg, causes)
| _ -> None
- ) actions) in
+ ) root_actions) in
(* compute initial packages to install *)
let to_process_init =
Map.of_list (OpamMisc.filter_map (function
- | To_recompile pkg
+ | To_recompile (pkg,_)
| To_change (_, pkg) as act -> Some (pkg, act)
| To_delete _ -> None
- ) actions) in
+ ) root_actions) in
let complete_graph =
let g =
@@ -421,7 +430,8 @@ let solution_of_actions ~simple_universe ~complete_universe actions =
let to_recompile =
Set.fold (fun pkg to_recompile ->
let succ = Graph.succ complete_graph pkg in
- Set.union to_recompile (Set.of_list succ)
+ let succ = List.map (fun s -> s, [pkg]) succ in
+ Map.union (@@) to_recompile (Map.of_list succ)
) to_remove to_recompile in
let to_remove =
@@ -432,12 +442,25 @@ let solution_of_actions ~simple_universe ~complete_universe actions =
Graph.Topo.fold
(fun pkg (to_recompile, to_process_map) ->
let add_succ pkg action =
- (Set.union to_recompile (Set.of_list (Graph.succ complete_graph pkg)),
- Map.add pkg action (Map.remove pkg to_process_map)) in
+ let succ = Graph.succ complete_graph pkg in
+ let succ =
+ List.map (fun s ->
+ if Map.mem pkg to_recompile then
+ (* look for the root causes *)
+ let causes = Map.find pkg to_recompile in
+ (s, causes)
+ else
+ (* the root cause is pkg itself *)
+ (s, [pkg])
+ ) succ in
+ let to_recompile = Map.union (@@) to_recompile (Map.of_list succ) in
+ let to_process_map = Map.add pkg action (Map.remove pkg to_process_map) in
+ to_recompile, to_process_map in
if Map.mem pkg to_process_init then
add_succ pkg (Map.find pkg to_process_init)
- else if Set.mem pkg to_recompile then
- add_succ pkg (To_recompile pkg)
+ else if Map.mem pkg to_recompile then
+ let causes = Map.find pkg to_recompile in
+ add_succ pkg (To_recompile (pkg, causes))
else
to_recompile, to_process_map)
complete_graph
View
2  src/solver/opamSolver.ml
@@ -127,7 +127,7 @@ let map_action f = function
| To_change (Some x, y) -> To_change (Some (f x), f y)
| To_change (None, y) -> To_change (None, f y)
| To_delete y -> To_delete (f y)
- | To_recompile y -> To_recompile (f y)
+ | To_recompile (y, l) -> To_recompile (f y, List.map f l)
let graph cudf2opam cudf_graph =
let size = OpamCudf.ActionGraph.nb_vertex cudf_graph in
Please sign in to comment.
Something went wrong with that request. Please try again.