Implemented prototype UIs via graphviz output + Fixed bug introduced earlier
This commit is contained in:
parent
35ce449452
commit
0b21c30cc2
2 changed files with 95 additions and 17 deletions
12
app/main.ml
12
app/main.ml
|
@ -27,9 +27,15 @@ let () =
|
||||||
let graph = Opam_graph.dependencies data in
|
let graph = Opam_graph.dependencies data in
|
||||||
let dot = Opam_graph.Dot.of_graph graph in
|
let dot = Opam_graph.Dot.of_graph graph in
|
||||||
Format.printf "%a" Opam_graph.Dot.pp dot
|
Format.printf "%a" Opam_graph.Dot.pp dot
|
||||||
| "dot_proto_ui" ->
|
| "proto_ui_transitive" ->
|
||||||
let graph = Opam_graph.Ui_prototype.dependencies data in
|
let transitive = true in
|
||||||
let dot = Opam_graph.Dot.of_graph graph in
|
let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in
|
||||||
|
let dot = Opam_graph.Dot.of_assoc graph in
|
||||||
|
Format.printf "%a" Opam_graph.Dot.pp dot
|
||||||
|
| "proto_ui" ->
|
||||||
|
let transitive = false in
|
||||||
|
let graph = Opam_graph.Ui_prototype.dependencies ~transitive data in
|
||||||
|
let dot = Opam_graph.Dot.of_assoc graph in
|
||||||
Format.printf "%a" Opam_graph.Dot.pp dot
|
Format.printf "%a" Opam_graph.Dot.pp dot
|
||||||
| _ -> failwith "Unsupported output format"
|
| _ -> failwith "Unsupported output format"
|
||||||
)
|
)
|
||||||
|
|
|
@ -18,28 +18,21 @@ let filtered_formula_to_pkgs (_switch : OpamFile.SwitchExport.t)
|
||||||
?(set = Name_set.empty) formula =
|
?(set = Name_set.empty) formula =
|
||||||
OpamFormula.fold_left (fun acc (name, _) -> Name_set.add name acc) set formula
|
OpamFormula.fold_left (fun acc (name, _) -> Name_set.add name acc) set formula
|
||||||
|
|
||||||
let opam (switch : OpamFile.SwitchExport.t) pkg_name =
|
let opam_file (switch : OpamFile.SwitchExport.t) pkg_name =
|
||||||
OpamPackage.Name.Map.find pkg_name switch.overlays
|
OpamPackage.Name.Map.find pkg_name switch.overlays
|
||||||
|
|
||||||
(* TODO depexts *)
|
(* TODO depexts *)
|
||||||
(* TODO build / dev packages *)
|
(* TODO build / dev packages *)
|
||||||
(* TODO constraints (os = "linux") *)
|
(* TODO constraints (os = "linux") *)
|
||||||
let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg =
|
let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg =
|
||||||
let available = switch.selections.sel_installed in
|
let pkg_opam_file = opam_file switch pkg in
|
||||||
let opam = opam switch pkg in
|
let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends pkg_opam_file) in
|
||||||
let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in
|
filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts pkg_opam_file)
|
||||||
filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam)
|
|
||||||
|> Name_set.filter (fun name ->
|
|
||||||
OpamPackage.Set.exists
|
|
||||||
(fun pkg -> pkg.OpamPackage.name = name)
|
|
||||||
available
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg =
|
let transitive_dependencies (switch : OpamFile.SwitchExport.t) pkg =
|
||||||
let available = switch.selections.sel_installed in
|
let available = switch.selections.sel_installed in
|
||||||
let rec aux pkg seen_pkgs =
|
let rec aux pkg seen_pkgs =
|
||||||
let opam = opam switch pkg in
|
let opam = opam_file switch pkg in
|
||||||
let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in
|
let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in
|
||||||
let set = filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) in
|
let set = filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam) in
|
||||||
let transitive_set =
|
let transitive_set =
|
||||||
|
@ -84,6 +77,7 @@ let pp_graph ppf graph =
|
||||||
graph.nodes
|
graph.nodes
|
||||||
|
|
||||||
let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) =
|
let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) =
|
||||||
|
let available = switch.selections.sel_installed in
|
||||||
let root_pkg = root switch in
|
let root_pkg = root switch in
|
||||||
let top = root_pkg.OpamPackage.name in
|
let top = root_pkg.OpamPackage.name in
|
||||||
let graph = { top ; nodes = Name_map.empty } in
|
let graph = { top ; nodes = Name_map.empty } in
|
||||||
|
@ -96,6 +90,14 @@ let dependencies ?(transitive=false) (switch : OpamFile.SwitchExport.t) =
|
||||||
| true -> transitive_dependencies switch x
|
| true -> transitive_dependencies switch x
|
||||||
| false -> direct_dependencies switch x
|
| false -> direct_dependencies switch x
|
||||||
in
|
in
|
||||||
|
let deps =
|
||||||
|
deps
|
||||||
|
|> Name_set.filter (fun name ->
|
||||||
|
OpamPackage.Set.exists
|
||||||
|
(fun pkg -> pkg.OpamPackage.name = name)
|
||||||
|
available
|
||||||
|
)
|
||||||
|
in
|
||||||
let graph = add_node graph x deps in
|
let graph = add_node graph x deps in
|
||||||
let work =
|
let work =
|
||||||
Name_set.diff
|
Name_set.diff
|
||||||
|
@ -135,6 +137,34 @@ module Dot = struct
|
||||||
id = None;
|
id = None;
|
||||||
stmt_list }
|
stmt_list }
|
||||||
|
|
||||||
|
type assoc_graph = (string * (string list)) list
|
||||||
|
|
||||||
|
let of_assoc (graph:assoc_graph) : t =
|
||||||
|
let open Odot in
|
||||||
|
let stmt_list =
|
||||||
|
graph
|
||||||
|
|> List.fold_left (fun acc (pkg, deps) ->
|
||||||
|
let stmt =
|
||||||
|
let pkg_id = Double_quoted_id pkg in
|
||||||
|
let pkg_point = Edge_node_id (pkg_id, None) in
|
||||||
|
let deps_points =
|
||||||
|
deps
|
||||||
|
|> List.map (fun pkg ->
|
||||||
|
let id = Double_quoted_id pkg in
|
||||||
|
Edge_node_id (id, None)
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let edge = pkg_point, deps_points, [] in
|
||||||
|
Stmt_edge edge
|
||||||
|
in
|
||||||
|
stmt :: acc
|
||||||
|
) []
|
||||||
|
in
|
||||||
|
{ strict = false; (*todo test params*)
|
||||||
|
kind = Digraph;
|
||||||
|
id = None;
|
||||||
|
stmt_list }
|
||||||
|
|
||||||
let pp ppf dot =
|
let pp ppf dot =
|
||||||
Format.fprintf ppf "%s" (Odot.string_of_graph dot)
|
Format.fprintf ppf "%s" (Odot.string_of_graph dot)
|
||||||
|
|
||||||
|
@ -142,7 +172,49 @@ end
|
||||||
|
|
||||||
module Ui_prototype = struct
|
module Ui_prototype = struct
|
||||||
|
|
||||||
let dependencies data =
|
let dependencies ?(transitive=true) data =
|
||||||
failwith "todo"
|
let all_direct_deps = dependencies data in
|
||||||
|
let top = all_direct_deps.top in
|
||||||
|
let top_str = OpamPackage.Name.to_string top
|
||||||
|
in
|
||||||
|
let direct_deps =
|
||||||
|
all_direct_deps.nodes
|
||||||
|
|> Name_map.find top
|
||||||
|
in
|
||||||
|
let all_transitive_deps =
|
||||||
|
dependencies ~transitive data in
|
||||||
|
let direct_deps_w_transitive_deps =
|
||||||
|
direct_deps
|
||||||
|
|> Name_set.elements
|
||||||
|
|> List.map (fun direct_dep ->
|
||||||
|
let transitive_deps =
|
||||||
|
all_transitive_deps.nodes
|
||||||
|
|> Name_map.find_opt direct_dep
|
||||||
|
|> (function
|
||||||
|
| None -> Name_set.empty
|
||||||
|
| Some v -> v)
|
||||||
|
|> Name_set.elements
|
||||||
|
|> List.map OpamPackage.Name.to_string
|
||||||
|
in
|
||||||
|
let direct_dep = OpamPackage.Name.to_string direct_dep in
|
||||||
|
direct_dep, transitive_deps
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let uniquified_deps =
|
||||||
|
direct_deps_w_transitive_deps
|
||||||
|
|> List.mapi (fun i (direct_dep, transitive_deps) ->
|
||||||
|
let unique_direct_dep = Printf.sprintf "%s_%d" direct_dep i in
|
||||||
|
let unique_transitive_deps =
|
||||||
|
transitive_deps
|
||||||
|
|> List.mapi (fun i' transitive_dep ->
|
||||||
|
Printf.sprintf "%s_%d.%d" transitive_dep i i'
|
||||||
|
)
|
||||||
|
in
|
||||||
|
unique_direct_dep, unique_transitive_deps
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let unique_direct_deps = uniquified_deps |> List.map fst
|
||||||
|
in
|
||||||
|
(top_str, unique_direct_deps) :: uniquified_deps
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
Loading…
Reference in a new issue