diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 89ea84417f2..046efb156f4 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -726,8 +726,8 @@ let tree ?(why=false) cli = let default = OpamTreeCommand.(if why then ReverseDeps else Deps) in mk_vflag default ~cli ~section:tree_docs [ cli_from cli2_2, OpamTreeCommand.Deps, ["deps"], - "Draw a dependency forest, starting from the explicitly-installed packages \ - (this is the default)."; + "Draw a dependency forest, starting from the packages not required by \ + any other packages (this is the default)."; cli_from cli2_2, OpamTreeCommand.ReverseDeps, ["rev-deps"], "Draw a reverse-dependency forest, starting from the packages required by \ more than two explicitly-installed packages."; diff --git a/src/client/opamTreeCommand.ml b/src/client/opamTreeCommand.ml index 2d7a08a5637..a05bd33a772 100644 --- a/src/client/opamTreeCommand.ml +++ b/src/client/opamTreeCommand.ml @@ -47,9 +47,7 @@ let installed st names = ) [] |> OpamPackage.Set.of_list let build_condition_map st (universe: OpamTypes.universe) = - st.installed - |> OpamPackage.Set.to_seq - |> Seq.map (fun package -> + OpamPackage.Set.fold (fun package cmap -> let map = universe.u_depends |> OpamPackage.Map.find package @@ -64,14 +62,14 @@ let build_condition_map st (universe: OpamTypes.universe) = |> List.filter_map (fun (name, co) -> co |> Option.map (fun c -> name, c)) |> OpamPackage.Name.Map.of_list in - package, map) - |> OpamPackage.Map.of_seq + cmap |> OpamPackage.Map.add package map + ) st.installed OpamPackage.Map.empty type usage = | As_leaves | As_roots -let restrict_leaves st fold_succ_or_pred names roots graph = +let cut_leaves st fold_succ_or_pred names roots graph = let go package set = fold_succ_or_pred (fun p state -> state |> OpamPackage.Set.add p @@ -92,9 +90,11 @@ let build_deps_forest st names_usage names = ~depopts:false ~build:false ~post:false ~installed:true universe in - let root = st.installed_roots in + let root = + st.installed |> OpamPackage.Set.filter (fun p -> OpamSolver.PkgGraph.in_degree graph p = 0) + in if names_usage = As_leaves then - restrict_leaves st OpamSolver.PkgGraph.fold_pred names root graph + cut_leaves st OpamSolver.PkgGraph.fold_pred names root graph else if OpamPackage.Set.is_empty names then root, graph else @@ -139,7 +139,7 @@ let build_revdeps_forest st names_usage names : revdeps node forest = st.installed |> OpamPackage.Set.filter (fun p -> OpamSolver.PkgGraph.in_degree graph p > 1) in if names_usage = As_leaves then - restrict_leaves st OpamSolver.PkgGraph.fold_succ names root graph + cut_leaves st OpamSolver.PkgGraph.fold_succ names root graph else if OpamPackage.Set.is_empty names then root, graph else @@ -190,7 +190,7 @@ let build st mode names_usage names = | Deps -> DepsForest (build_deps_forest st names_usage names) | ReverseDeps -> RevdepsForest (build_revdeps_forest st names_usage names) -let string_of_condition (relop, version) = +let string_of_constraint (relop, version) = Printf.sprintf "(%s %s)" (OpamPrinter.FullPos.relop_kind relop) (OpamPackage.Version.to_string version) let print_deps = function @@ -200,7 +200,7 @@ let print_deps = function let dup = if is_dup then " (*)" else "" in match satisfies with | None -> Printf.sprintf "%s%s" p dup - | Some c -> Printf.sprintf "%s %s%s" p (string_of_condition c) dup + | Some c -> Printf.sprintf "%s %s%s" p (string_of_constraint c) dup let print_revdeps = function | Root p -> OpamPackage.to_string p @@ -209,11 +209,14 @@ let print_revdeps = function let dup = if is_dup then " (*)" else "" in match demands with | None -> Printf.sprintf "%s%s" p dup - | Some c -> Printf.sprintf "%s %s%s" (string_of_condition c) p dup + | Some c -> Printf.sprintf "%s %s%s" (string_of_constraint c) p dup let print (forest: result) = match forest with - | DepsForest trees -> - trees |> List.iter (Tree.print ~printer:print_deps) - | RevdepsForest trees -> - trees |> List.iter (Tree.print ~printer:print_revdeps) \ No newline at end of file + | DepsForest (tree :: trees) -> + Tree.print ~printer:print_deps tree; + trees |> List.iter (fun tree -> print_newline (); Tree.print ~printer:print_deps tree) + | RevdepsForest (tree :: trees) -> + Tree.print ~printer:print_revdeps tree; + trees |> List.iter (fun tree -> print_newline (); Tree.print ~printer:print_revdeps tree) + | _ -> () \ No newline at end of file