roburio -> robur-coop

Reviewed-on: https://git.robur.io/robur/opam-graph/pulls/10

CHANGES.md

@@ -0,0 +1,7 @@
+# v0.1.1 (2023-01-30)
+
+- dune-project: lower dune requirement to 2.0
+
+# v0.1.0 (2023-01-30)
+
+- initial release

LICENSE.md

@@ -0,0 +1,3 @@
+Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

README.md

@@ -0,0 +1,3 @@
+# opam-graph
+
+Visualizes dependencies of "opam switch export" as dot or svg.

app/dune

@@ -1,4 +1,4 @@
 (executable
  (name main)
- (public_name opam_graph)
+ (public_name opam-graph)
  (libraries cmdliner logs logs.fmt fmt.cli fmt.tty logs.cli opam-graph))

app/main.ml

@@ -12,24 +12,39 @@ let read_file file =
   with _ -> invalid_arg ("Error opening file " ^ file)
 
 let jump () transitive file output_format =
+  let module G = Opam_graph in
   let switch = read_file file in
   let data = OpamFile.SwitchExport.read_from_string switch in
   match output_format with
   | `Text ->
-    let graph = Opam_graph.dependencies ~transitive data in
-    Format.printf "%a" Opam_graph.pp_graph graph
+    let graph = G.dependencies ~transitive data in
+    Format.printf "%a" G.pp_graph graph
   | `Dot ->
-    let graph = Opam_graph.dependencies ~transitive data in
-    let dot = Opam_graph.Render.Dot.of_graph graph in
-    Format.printf "%a" Opam_graph.Render.Dot.pp dot
+    let graph = G.dependencies ~transitive data in
+    let dot = G.Render.Dot.of_graph graph in
+    Format.printf "%a" G.Render.Dot.pp dot
   | `Dot_ui ->
-    let graph = Opam_graph.Ui.dependencies ~transitive data in
-    let dot = Opam_graph.Render.Dot.of_assoc graph in
-    Format.printf "%a" Opam_graph.Render.Dot.pp dot
+    let graph = G.Ui.dependencies ~transitive data in
+    let dot = G.Render.Dot.of_assoc graph in
+    Format.printf "%a" G.Render.Dot.pp dot
   | `Html ->
-    let graph = Opam_graph.Ui.dependencies ~transitive data in
-    let html = Opam_graph.Render.Html.of_assoc graph in
-    Format.printf "%a" Opam_graph.Render.Html.pp html
+    let graph = G.Ui.dependencies ~transitive data in
+    let sharing_stats =
+      data
+      |> G.dependencies ~transitive:false
+      |> G.calc_sharing_stats in
+    let override_css = "\
+      .deps-svg-wrap {\
+        background: rgb(60, 60, 87); \
+      }\
+    "
+    in
+    let html =
+      G.Render.Html.of_assoc
+        ~override_css
+        ~sharing_stats graph
+    in
+    Format.printf "%a" G.Render.Html.pp html
 
 let setup_log style_renderer level =
   Fmt_tty.setup_std_outputs ?style_renderer ();
@@ -62,8 +77,15 @@ let file =
   Arg.(required & pos 0 (some file) None & info [ ] ~doc ~docv:"FILE")
 
 let cmd =
-  let term = Term.(const jump $ setup_log $ transitive $ file $ output_format) in
-  let info = Cmd.info "opam_graph" ~version:"%%VERSION%%" in
+  let term = Term.(
+    const jump
+    $ setup_log
+    $ transitive
+    $ file
+    $ output_format
+  ) in
+  let version = Fmt.str "%d" Opam_graph.visualization_version in
+  let info = Cmd.info "opam-graph" ~version in
   Cmd.v info term
 
 let () = Cmd.eval cmd |> exit

dune-project

@@ -1,2 +1,2 @@
-(lang dune 2.6)
+(lang dune 2.0)
 (name opam-graph)

opam-graph.opam

@@ -1,9 +1,9 @@
 opam-version: "2.0"
 maintainer: "Robur <team@robur.coop>"
 authors: ["Robur <team@robur.coop>"]
-homepage: "https://git.robur.io/robur/opam-graph"
-dev-repo: "git+https://git.robur.io/robur/opam-graph.git"
-bug-reports: "https://github.com/roburio/opam-graph/issues"
+homepage: "https://git.robur.coop/robur/opam-graph"
+dev-repo: "git+https://git.robur.coop/robur/opam-graph.git"
+bug-reports: "https://github.com/robur-coop/opam-graph/issues"
 license: "ISC"
 
 depends: [
@@ -13,18 +13,20 @@ depends: [
   "fmt" {>= "0.8.7"}
   "logs"
   "opam-core"
-  "opam-format"
+  "opam-format" {>= "2.1.1"}
   "ocamldot"
-  "rresult"
-  "tyxml"
+  "tyxml" {>= "4.3.0"}
   "gg"
 ]
 build: [
   ["dune" "subst"] {dev}
   ["dune" "build" "-p" name "-j" jobs]
+  ["sh" "-ex" "packaging/FreeBSD/create_package.sh"] {os = "freebsd"}
+  ["sh" "-ex" "packaging/debian/create_package.sh"] {os-family = "debian"}
 ]
 
 synopsis: "Graphing dependencies of opam packages"
 description: """
-This package outputs graphs (in svg and dot) of opam packages.
+This package outputs dependency graphs (in svg and dot) of opam package
+universes (opam switch export).
 """

packaging/FreeBSD/MANIFEST

@@ -0,0 +1,15 @@
+name: opam-graph
+version: %%VERSION_NUM%%
+origin: local/opam-graph
+comment: Opam graph visualization tool
+www: https://git.robur.coop/robur/opam-graph
+maintainer: Robur <team@robur.coop>
+prefix: /usr/local
+licenselogic: single
+licenses: [ISCL]
+flatsize: %%FLATSIZE%%
+categories: [local]
+desc = <<EOD
+Graphing dependencies of opam packages in svg and dot
+
+EOD;

packaging/FreeBSD/create_package.sh

@@ -0,0 +1,42 @@
+#!/bin/sh -e
+
+# only execute anything if either
+# - running under orb with package = opam-graph
+# - not running under opam at all
+if [ "$ORB_BUILDING_PACKAGE" != "opam-graph" -a "$OPAM_PACKAGE_NAME" != "" ]; then
+    exit 0;
+fi
+
+basedir=$(realpath "$(dirname "$0")"/../..)
+pdir=$basedir/packaging/FreeBSD
+bdir=$basedir/_build/install/default/bin
+tmpd=$basedir/_build/stage
+manifest=$tmpd/+MANIFEST
+rootdir=$tmpd/rootdir
+bindir=$rootdir/usr/local/bin
+
+trap 'rm -rf $tmpd' 0 INT EXIT
+
+mkdir -p "$bindir"
+
+install -U "$bdir/opam-graph" "$bindir/opam-graph"
+
+flatsize=$(find "$rootdir" -type f -exec stat -f %z {} + |
+               awk 'BEGIN {s=0} {s+=$1} END {print s}')
+
+sed -e "s:%%FLATSIZE%%:${flatsize}:" -e "/^[Vv]ersion:/s/-/./g" "$pdir/MANIFEST" > "$manifest"
+
+{
+    printf '\nfiles {\n'
+    find "$rootdir" -type f -exec sha256 -r {} + | sort |
+        awk '{print "    " $2 ": \"" $1 "\","}'
+    fidn "$rootdir" -type l | sort |
+        awk '{print "    " $1 ": -,"}'
+    printf '}\n'
+} | sed -e "s:${rootdir}::" >> "$manifest"
+
+export SOURCE_DATE_EPOCH=$(git log -1 --pretty=format:%ct)
+pkg create -r "$rootdir" -M "$manifest" -o "$basedir/"
+mv "$basedir"/opam-graph-*.pkg "$basedir/opam-graph.pkg"
+echo 'bin: [ "opam-graph.pkg" ]' > "$basedir/opam-graph.install"
+echo 'doc: [ "README.md" ]' >> "$basedir/opam-graph.install"

packaging/debian/changelog

@@ -0,0 +1,5 @@
+opam-graph (%%VERSION_NUM%%) unstable; urgency=medium
+
+  * Initial release
+
+  --Robur team <team@robur.coop>

packaging/debian/control

@@ -0,0 +1,12 @@
+Package: opam-graph
+Version: %%VERSION_NUM%%
+Section: unknown
+Priority: optional
+Maintainer: Robur Team <team@robur.coop>
+Standards-Version: 4.4.1
+Homepage: https://git.robur.coop/robur/opam-graph
+Vcs-Browser: https://git.robur.coop/robur/opam-graph
+Vcs-Git: https://git.robur.coop/robur/opam-graph.git
+Architecture: FIXME
+Description: Graphing dependencies of opam packages
+  This package outputs graphs (in svg and dot) of opam packages.

packaging/debian/copyright

@@ -0,0 +1,8 @@
+Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
+Upstream-Name: opam-graph
+Upstream-Contact: Robur Team <team@robur.coop>
+Source: https://git.robur.coop/robur/opam-graph
+
+Files: *
+Copyright: "Robur Team <team@robur.coop>"
+License: ISC

packaging/debian/create_package.sh

@@ -0,0 +1,32 @@
+#!/bin/sh -e
+
+# only execute anything if either
+# - running under orb with package = opam-graph
+# - not running under opam at all
+if [ "$ORB_BUILDING_PACKAGE" != "opam-graph" -a "$OPAM_PACKAGE_NAME" != "" ]; then
+    exit 0;
+fi
+
+basedir=$(realpath "$(dirname "$0")"/../..)
+bdir=$basedir/_build/install/default/bin
+tmpd=$basedir/_build/stage
+rootdir=$tmpd/rootdir
+bindir=$rootdir/usr/bin
+debiandir=$rootdir/DEBIAN
+
+trap 'rm -rf $tmpd' 0 INT EXIT
+
+mkdir -p "$debiandir" "$bindir"
+
+install "$bdir/opam-graph" "$bindir/opam-graph"
+
+# install debian metadata
+install -m 0644 $basedir/packaging/debian/control $debiandir/control
+install -m 0644 $basedir/packaging/debian/changelog $debiandir/changelog
+install -m 0644 $basedir/packaging/debian/copyright $debiandir/copyright
+
+ARCH=$(dpkg-architecture -q DEB_TARGET_ARCH)
+sed -i -e "s/^Architecture:.*/Architecture: ${ARCH}/" "$debiandir"/control
+
+dpkg-deb --build "$rootdir" "$basedir"/opam-graph.deb
+echo 'bin: [ "opam-graph.deb" ]' > "$basedir/opam-graph.install"

src/dune

@@ -1,5 +1,5 @@
 (library
  (name opam_graph)
  (public_name opam-graph)
- (libraries opam-core opam-format dot rresult tyxml gg)
+ (libraries opam-core opam-format dot tyxml gg)
  )

src/opam_graph.ml

@@ -1,10 +1,16 @@
 
+let visualization_version = 1
+(** Remember to increment this when anything changes that can affect the
+    visualization, e.g.:
+      * algorithm change
+      * UI change
+      * certain library-dependency changes
+*)
+
 let sprintf = Printf.sprintf
 
 module OSet = OpamPackage.Set
 
-type package = OpamPackage.t
-
 let packages (switch : OpamFile.SwitchExport.t) =
   assert (OSet.cardinal switch.selections.sel_pinned = 0);
   assert (OSet.cardinal switch.selections.sel_compiler = 0);
@@ -79,26 +85,99 @@ let pp_graph ppf graph =
                                (Name_set.elements deps))))
     graph.nodes
 
+let deps_of_opam =
+  let open OpamParserTypes.FullPos in
+  let ( let* ) = Result.bind in
+  let extract_pkg = function
+    | { pelem = String s ; _ } -> Ok (OpamPackage.Name.of_string s)
+    | _ -> Error (`Msg "expected a string")
+  in
+  let extract_list = function
+    | { pelem = List { pelem = deps ; _ } ; _ } ->
+      List.fold_left (fun acc d ->
+          let* acc = acc in
+          let* dep = extract_pkg d in
+          Ok (Name_set.add dep acc))
+        (Ok Name_set.empty) deps
+    | _ -> Error (`Msg "expected a list of strings")
+  in
+  let extract_deps = function
+    | { pelem = List { pelem = [ name ; deps ] ; _ } ; _ } ->
+      let* name = extract_pkg name in
+      let* deps = extract_list deps in
+      Ok (name, deps)
+    | { pelem = List { pelem = _lbody ; _ } ; _ } ->
+      Error (`Msg "expected exactly two strings")
+    | _ -> Error (`Msg "expected a pair of strings")
+  in
+  function
+  | { pelem = List { pelem = lbody ; _ } ; _ } ->
+    let* data =
+      List.fold_left (fun acc v ->
+          let* acc = acc in
+          let* deps = extract_deps v in
+          Ok (deps :: acc))
+        (Ok []) lbody
+    in
+    Ok (List.rev data)
+  | _ -> Error (`Msg "expected a list")
+
+let retrieve_deps switch top =
+  let orb_deps = "x-orb-dependencies" in
+  let pkg_opam_file = opam_file switch top in
+  match OpamFile.OPAM.extended pkg_opam_file orb_deps deps_of_opam with
+  | None -> None
+  | Some Error `Msg _msg -> None
+  | Some Ok data ->
+    Some
+      (List.fold_left (fun acc (name, deps) ->
+           Name_map.add name deps acc)
+          Name_map.empty data)
+
 let dependencies ~transitive (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 dep_map = retrieve_deps switch top 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 = match transitive with
-        | true -> transitive_dependencies switch x
-        | false -> direct_dependencies switch x
-      in
       let deps =
-        deps
-        |> Name_set.filter (fun name ->
-          OpamPackage.Set.exists
-            (fun pkg -> pkg.OpamPackage.name = name)
-            available
-        )
+        match dep_map with
+        | None ->
+          let deps =
+            match transitive with
+            | true -> transitive_dependencies switch x
+            | false -> direct_dependencies switch x
+          in
+          deps
+          |> Name_set.filter (fun name ->
+              OpamPackage.Set.exists
+                (fun pkg -> pkg.OpamPackage.name = name)
+                  available
+            )
+        | Some map ->
+          let rec find_it seen work acc =
+            match Name_set.choose_opt work with
+            | None -> acc
+            | Some x ->
+              let seen = Name_set.add x seen
+              and work = Name_set.remove x work
+              in
+              match Name_map.find_opt x map with
+              | None -> find_it seen work acc
+              | Some deps ->
+                let work =
+                  if transitive then
+                    Name_set.union deps work
+                  else
+                    work
+                in
+                find_it seen work (Name_set.union deps acc)
+          in
+          find_it Name_set.empty (Name_set.singleton x) Name_set.empty
       in
       let graph = add_node graph x deps in
       let work =
@@ -145,7 +224,7 @@ module Ui = struct
       |> Name_map.find root
     in
     let all_transitive_deps =
-      if transitive = false then all_direct_deps else 
+      if transitive = false then all_direct_deps else
         dependencies ~transitive data
     in
     let direct_deps_w_transitive_deps =
@@ -443,7 +522,7 @@ svg {
     let make_direct_dep_edge_css dep =
       let dep = scoped_class dep in
       sprintf {|
-.deps-direct_dep.deps-edge.%s:hover ~ 
+.deps-direct_dep.deps-edge.%s:hover ~
 .deps-direct_dep.deps-node.%s {
   transform: scale(2);
 }
@@ -689,7 +768,7 @@ svg {
     let make_shared_deps_css_aux ~dep ~shared_deps =
       shared_deps |> Seq.map (fun shared_dep ->
         sprintf {|
-.deps-direct_dep.%s:hover ~ 
+.deps-direct_dep.%s:hover ~
 .deps-node.deps-layer2_dep.%s {
   fill: #5454ff;
   filter: brightness(1.0) !important;
@@ -791,7 +870,7 @@ svg {
         css :: acc
       ) sharing_stats []
       |> merge_css
-    
+
     let of_assoc ~(sharing_stats:assoc_stats) (graph:assoc_graph) : _ output =
       match graph with
       | [] -> { svg_content = []; svg_attr = []; css = "" }