From 877137377a61b1abb5b88e85f0e7fc51c0c51c0f Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Mon, 20 Dec 2021 14:25:23 +0100
Subject: [PATCH] initial

---
 app/dune          |  3 ++
 app/main.ml       | 23 ++++++++++++++
 dune-project      |  2 ++
 opam-graph.opam   |  0
 src/dune          |  4 +++
 src/opam_graph.ml | 78 +++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 110 insertions(+)
 create mode 100644 app/dune
 create mode 100644 app/main.ml
 create mode 100644 dune-project
 create mode 100644 opam-graph.opam
 create mode 100644 src/dune
 create mode 100644 src/opam_graph.ml

diff --git a/app/dune b/app/dune
new file mode 100644
index 0000000..21dd2eb
--- /dev/null
+++ b/app/dune
@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (libraries cmdliner logs logs.fmt opam-graph))
\ No newline at end of file
diff --git a/app/main.ml b/app/main.ml
new file mode 100644
index 0000000..425b9aa
--- /dev/null
+++ b/app/main.ml
@@ -0,0 +1,23 @@
+
+let read_file file =
+  try
+    let fh = open_in file in
+    try
+      let content = really_input_string fh (in_channel_length fh) in
+      close_in_noerr fh ;
+      content
+    with _ ->
+      close_in_noerr fh;
+      invalid_arg ("Error reading file: " ^ file)
+  with _ -> invalid_arg ("Error opening file " ^ file)
+
+let () =
+  match Sys.argv with
+  | [| _ ; file |] ->
+    let switch = read_file file in
+    let data = OpamFile.SwitchExport.read_from_string switch in
+    Opam_graph.dependencies data
+  | _ ->
+    print_endline "expecting exactly one argument";
+    exit 1
+
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..08126e9
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,2 @@
+(lang dune 2.6)
+(name opam-graph)
diff --git a/opam-graph.opam b/opam-graph.opam
new file mode 100644
index 0000000..e69de29
diff --git a/src/dune b/src/dune
new file mode 100644
index 0000000..0f484b0
--- /dev/null
+++ b/src/dune
@@ -0,0 +1,4 @@
+(library
+ (name opam_graph)
+ (public_name opam-graph)
+ (libraries opam-core opam-format))
\ No newline at end of file
diff --git a/src/opam_graph.ml b/src/opam_graph.ml
new file mode 100644
index 0000000..471de3e
--- /dev/null
+++ b/src/opam_graph.ml
@@ -0,0 +1,78 @@
+module Set = OpamPackage.Set
+
+type package = OpamPackage.t
+
+let packages (switch : OpamFile.SwitchExport.t) =
+  assert (Set.cardinal switch.selections.sel_pinned = 0);
+  assert (Set.cardinal switch.selections.sel_compiler = 0);
+  assert (Set.subset switch.selections.sel_roots switch.selections.sel_installed);
+  switch.selections.sel_installed
+
+let root (switch : OpamFile.SwitchExport.t) =
+  assert (Set.cardinal switch.selections.sel_roots = 1);
+  Set.choose switch.selections.sel_roots
+
+module Name_set = OpamPackage.Name.Set
+
+let filtered_formula_to_pkgs (_switch : OpamFile.SwitchExport.t)
+    ?(set = Name_set.empty) formula =
+  OpamFormula.fold_left (fun acc (name, _) -> Name_set.add name acc) set formula
+
+let opam (switch : OpamFile.SwitchExport.t) pkg_name =
+  OpamPackage.Name.Map.find pkg_name switch.overlays
+
+(* TODO depexts *)
+(* TODO build / dev packages *)
+(* TODO constraints (os = "linux") *)
+let direct_dependencies (switch : OpamFile.SwitchExport.t) pkg =
+  let opam = opam switch pkg in
+  let set = filtered_formula_to_pkgs switch (OpamFile.OPAM.depends opam) in
+  filtered_formula_to_pkgs switch ~set (OpamFile.OPAM.depopts opam)
+
+module Name_map = OpamPackage.Name.Map
+
+type graph = {
+  nodes : Name_set.t Name_map.t ;
+  top : OpamPackage.Name.t ;
+}
+
+let add_node graph pkg edges =
+  let nodes = Name_map.add pkg edges graph.nodes in
+  { graph with nodes }
+
+let pp_graph ppf graph =
+  Name_map.iter (fun pkg deps ->
+      let top = if pkg = graph.top then "ROOT " else "" in
+      Format.fprintf ppf "%s%s: %s@."
+        top (OpamPackage.Name.to_string pkg)
+        (String.concat ", " (List.map OpamPackage.Name.to_string
+                               (Name_set.elements deps))))
+    graph.nodes
+
+let dependencies (switch : OpamFile.SwitchExport.t) =
+  let root_pkg = root switch in
+  let top = root_pkg.OpamPackage.name in
+  let graph = { top ; nodes = Name_map.empty } in
+  let available = switch.selections.sel_installed in
+  let rec find_deps graph work =
+    match Name_set.choose_opt work with
+    | None -> graph
+    | Some x ->
+      let deps = direct_dependencies switch x in
+      let deps =
+        Name_set.filter (fun name ->
+            OpamPackage.Set.exists
+              (fun pkg -> pkg.OpamPackage.name = name)
+              available)
+          deps
+      in
+      let graph = add_node graph x deps in
+      let work =
+        Name_set.diff
+          (Name_set.union (Name_set.remove x work) deps)
+          (Name_set.of_list (Name_map.keys graph.nodes))
+      in
+      find_deps graph work
+  in
+  let graph = find_deps graph (Name_set.singleton top) in
+  Format.printf "%a" pp_graph graph