architecture diagram on CI

18 files changed, 632 insertions, 1 deletions

diff --git a/.github/workflows/uml.yml b/.github/workflows/uml.yml
new file mode 100644
index 0000000..8850083
--- /dev/null
+++ b/.github/workflows/uml.yml
@@ -0,0 +1,59 @@
+name: UML
+
+on:
+  pull_request:
+  workflow_dispatch:
+
+permissions:
+  contents: write
+
+jobs:
+  blueprint:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout PR branch
+        uses: actions/checkout@v4
+        with:
+          # Check out the PR's source branch (not the detached merge commit) so
+          # the regenerated diagram can be pushed straight back to it.
+          ref: ${{ github.head_ref }}
+
+      - name: Install Nix
+        uses: cachix/install-nix-action@v27
+
+      - name: Generate PlantUML blueprint
+        # --strict fails the job if a @uses/@needs tag names an unknown module.
+        run: |
+          nix shell nixpkgs#perl --command \
+            perl tools/uml_blueprint.pl --src lib --out docs/architecture.puml --strict --no-notes
+
+      - name: Render diagram
+        run: |
+          nix shell nixpkgs#plantuml --command \
+            plantuml -tsvg docs/architecture.puml
+
+      - name: Upload blueprint artifact
+        uses: actions/upload-artifact@v4
+        with:
+          name: architecture-diagram
+          path: |
+            docs/architecture.puml
+            docs/architecture.svg
+
+      - name: Commit updated diagram to the PR branch
+        # Only same-repo PRs can be pushed to; fork PRs get the artifact instead.
+        if: >-
+          github.event_name == 'pull_request' &&
+          github.event.pull_request.head.repo.full_name == github.repository
+        run: |
+          git config user.name  "github-actions[bot]"
+          git config user.email "41898282+github-actions[bot]@users.noreply.github.com"
+          git add docs/architecture.puml docs/architecture.svg
+          if git diff --cached --quiet; then
+            echo "diagram unchanged — nothing to commit"
+          else
+            # [skip ci] stops this auto-commit from retriggering the workflow;
+            # the diff guard above stops it once the diagram stabilises.
+            git commit -m "ci: update architecture diagram [skip ci]"
+            git push origin HEAD:${{ github.head_ref }}
+          fi
diff --git a/docs/architecture.puml b/docs/architecture.puml
new file mode 100644
index 0000000..87b462b
--- /dev/null
+++ b/docs/architecture.puml
@@ -0,0 +1,246 @@
+@startuml
+!theme toy
+title RNT Architecture
+hide empty members
+skinparam classAttributeIconSize 0
+skinparam linetype ortho
+skinparam nodesep 30
+skinparam ranksep 50
+skinparam defaultFontSize 15
+left to right direction
+
+class Condition <<module>> {
+  .. types ..
+  +condition
+  +ps
+  .. values ..
+  +"|=|"
+  +"&"
+  +empty() : ps
+  +condition() : condition
+  +complement() : condition
+  +to_string_hum() : string
+}
+
+class Configuration <<module>> {
+  .. types ..
+  +term
+  +dictionary
+  .. values ..
+  +term_of_sexp() : term
+  +tag_of() : string, Condition.condition result
+  +value_for() : term, Condition.condition result
+  +as_dictionary() : dictionary, Condition.condition result
+  +as_int() : int, Condition.condition result
+  +as_string() : string, Condition.condition result
+}
+
+class Cursor <<module>> {
+  .. types ..
+  +descriptor
+  +cursor
+  .. values ..
+  +open_() : cursor, Concepts.Condition.condition result
+  +next() : Concepts.Tuple.t option, Concepts.Condition.condition result
+  +close() : unit
+}
+
+class FOL <<module>> {
+  .. types ..
+  +path_arg
+  +t
+  +stream
+  +right
+  .. values ..
+  +singleton()
+  +resolve()
+}
+
+class Handle <<module>> {
+  .. types ..
+  +t
+  +handle
+  +cursor
+  .. values ..
+  +open_() : handle, Concepts.Condition.condition result
+  +open_cursor() : cursor, Concepts.Condition.condition result
+  +next() : Concepts.Tuple.t option, Concepts.Condition.condition result
+  +close() : unit
+  +create() : t
+  +object_() : Object.registry
+}
+
+class Hash <<module>> {
+  .. types ..
+  +hash
+  .. values ..
+  +hash_of_value() : hash
+  +hash_equals() : bool
+  +bytes_of_hash() : bytes
+}
+
+class Identity <<module>> {
+  .. values ..
+  +permits() : bool
+  +can_open() : bool
+  +can_close() : bool
+}
+
+class LMDB <<module>> {
+}
+
+class Lifecycle <<module>> {
+  .. types ..
+  +tree
+  +disposal
+  .. values ..
+  +monitor() : tree
+  +pin() : tree
+  +unpin() : tree
+  +is_eligible_for_gc() : bool
+  +contention() : bool
+  +unmonitor() : tree * disposal BatFingerTree.t, Concepts.Condition.condi...
+  +collect() : tree * disposal BatFingerTree.t, Concepts.Condition.condi...
+}
+
+class Namespace <<module>> {
+  .. types ..
+  +tree
+  .. values ..
+  +resolve() : Concepts.Path.t, Concepts.Condition.condition result
+}
+
+class Object <<module>> {
+  .. types ..
+  +multigroup
+  +relation
+  +ephemeral_relation
+  +transaction
+  +session
+  +branch
+  +branch_tree
+  +rnt_object_kind
+  +namespace
+  +rnt_method
+  +rnt_object
+  +registry
+  +rnt_object_tree
+  .. values ..
+  +make_object()
+  +root()
+  +find()
+  +update()
+  +reference_edges()
+  +adjust_references()
+  +is_gc_exempt()
+  +is_runtime()
+  +has_children()
+  +register()
+  +with_namespace()
+  +construct_multigroup()
+  +construct_relation()
+  +unregister()
+}
+
+class Path <<module>> {
+  .. types ..
+  +t
+  .. values ..
+  +empty() : t
+  +of_list() : t
+  +to_list() : string list
+  +snoc() : t
+  +to_string() : string
+  +is_prefix() : bool
+}
+
+class Representation <<module>> {
+  .. types ..
+  +blob
+  .. values ..
+  +blob_of_value() : blob
+  +value_of_blob() : Value.value
+  +blob_of_bytes() : blob
+  +bytes_of_blob() : bytes
+}
+
+class Storage <<module>> {
+  .. types ..
+  +connection
+  +transaction
+}
+
+class Tuple <<module>> {
+  .. types ..
+  +t
+  .. values ..
+  +empty() : t
+  +access() : Value.value option
+  +merge() : t
+  +project() : t
+  +rename() : t
+}
+
+class Utilities <<module>> {
+  .. values ..
+  +"let*"
+  +fmap() : 'b, 'e result
+}
+
+class Value <<module>> {
+  .. types ..
+  +value
+  .. values ..
+  +to_string() : string
+  +equal() : bool
+}
+
+Condition --> Value
+Configuration --> Condition
+Cursor ..> Condition
+Cursor ..> Path
+Cursor *-- Storage
+Cursor ..> Tuple
+Cursor ..> Value
+FOL ..> Condition
+FOL ..> Path
+FOL --> Tuple
+FOL ..> Value
+Handle --> Condition
+Handle *-- Cursor
+Handle --> Object
+Handle ..> Path
+Handle *-- Storage
+Handle ..> Tuple
+Handle ..> Value
+Hash ..> Value
+Identity ..> Object
+LMDB ..> Condition
+LMDB --> Configuration
+LMDB --> Hash
+LMDB --> Representation
+LMDB ..> Storage
+LMDB ..> Value
+Lifecycle ..> Condition
+Lifecycle --> Object
+Lifecycle ..> Path
+Namespace ..> Condition
+Namespace ..> Object
+Namespace ..> Path
+Namespace *-- Storage
+Object --> Condition
+Object --> Path
+Object ..> Value
+Representation ..> Value
+Storage ..> Condition
+Storage ..> Configuration
+Storage ..> Hash
+Storage ..> Representation
+Tuple ..> Value
+
+legend right
+  diamond A *-- B : functor composition (@composes)
+  solid   A --> B : declared call (@uses)
+  dashed  A ..> B : type-only coupling (@needs)
+endlegend
+@enduml
diff --git a/lib/abstract/Storage.ml b/lib/abstract/Storage.ml
index 2358c67..5eaeba3 100644
--- a/lib/abstract/Storage.ml
+++ b/lib/abstract/Storage.ml
@@ -1,3 +1,8 @@
+(* @needs Configuration *)
+(* @needs Condition *)
+(* @needs Hash *)
+(* @needs Representation *)
+
 module type STORAGE = sig
   type connection
   type transaction
diff --git a/lib/backend/execution/FOL.ml b/lib/backend/execution/FOL.ml
index 302285d..7da890d 100644
--- a/lib/backend/execution/FOL.ml
+++ b/lib/backend/execution/FOL.ml
@@ -1,3 +1,8 @@
+(* @uses Tuple -- project, rename, merge over result streams *)
+(* @needs Value *)
+(* @needs Path *)
+(* @needs Condition *)
+
 module Plan = struct
   type path_arg = Var of string | Const of Concepts.Value.value
 
diff --git a/lib/backend/managers/Cursor.ml b/lib/backend/managers/Cursor.ml
index 474387a..7fdbb6f 100644
--- a/lib/backend/managers/Cursor.ml
+++ b/lib/backend/managers/Cursor.ml
@@ -1,3 +1,9 @@
+(* @composes Storage -- functor parameter *)
+(* @needs Path *)
+(* @needs Tuple *)
+(* @needs Value *)
+(* @needs Condition *)
+
 type descriptor =
   | Stored of {merkle_root: string}
   | Ephemeral of {merkle_root: string; dependencies: Concepts.Path.t BatFingerTree.t}
diff --git a/lib/backend/managers/Handle.ml b/lib/backend/managers/Handle.ml
index 872af43..be84972 100644
--- a/lib/backend/managers/Handle.ml
+++ b/lib/backend/managers/Handle.ml
@@ -1,3 +1,11 @@
+(* @composes Storage -- functor parameter *)
+(* @composes Cursor -- applies Cursor.Make (Store) *)
+(* @uses Object -- find, registry/kind inspection *)
+(* @uses Condition -- builds not-a-relation / no-such-object errors *)
+(* @needs Path *)
+(* @needs Tuple *)
+(* @needs Value *)
+
 module type HANDLER = sig
   type t
   type handle
diff --git a/lib/backend/managers/Identity.ml b/lib/backend/managers/Identity.ml
index 3510e3a..bfde226 100644
--- a/lib/backend/managers/Identity.ml
+++ b/lib/backend/managers/Identity.ml
@@ -1,3 +1,5 @@
+(* @needs Object *)
+
 let permits (object_ : Object.registry) (method_ : Object.rnt_method) : bool =
   BatSet.mem method_ object_.Object.entry.Object.methods
 
diff --git a/lib/backend/managers/Lifecycle.ml b/lib/backend/managers/Lifecycle.ml
index 7aa3836..d104249 100644
--- a/lib/backend/managers/Lifecycle.ml
+++ b/lib/backend/managers/Lifecycle.ml
@@ -8,6 +8,10 @@
    the manager surfaces those to the caller as disposals rather than acting on
    storage itself. *)
 
+(* @uses Object -- find/update, unregister, reference_edges, has_children *)
+(* @needs Path *)
+(* @needs Condition *)
+
 type tree = Object.rnt_object_tree
 
 (* A runtime object that was collected and now needs an external teardown the
diff --git a/lib/backend/managers/Namespace.ml b/lib/backend/managers/Namespace.ml
index 61b1eff..a48fef9 100644
--- a/lib/backend/managers/Namespace.ml
+++ b/lib/backend/managers/Namespace.ml
@@ -1,3 +1,8 @@
+(* @composes Storage -- functor parameter *)
+(* @needs Object *)
+(* @needs Path *)
+(* @needs Condition *)
+
 module Make (Store : Abstract.Storage.STORAGE) = struct
   type tree = Object.rnt_object_tree
 
diff --git a/lib/backend/managers/Object.ml b/lib/backend/managers/Object.ml
index 981420b..ae5f5c1 100644
--- a/lib/backend/managers/Object.ml
+++ b/lib/backend/managers/Object.ml
@@ -1,3 +1,7 @@
+(* @uses Path -- snoc, to_string when building registry paths *)
+(* @uses Condition -- builds registry-object/path errors *)
+(* @needs Value *)
+
 type multigroup = {merkle_root: string}
 type relation = {merkle_root: string}
 
diff --git a/lib/backend/storage/LMDB.ml b/lib/backend/storage/LMDB.ml
index 0d7f8d0..ff5eb3d 100644
--- a/lib/backend/storage/LMDB.ml
+++ b/lib/backend/storage/LMDB.ml
@@ -1,3 +1,10 @@
+(* @uses Configuration -- reads config term to connect *)
+(* @uses Hash -- hash keys for get/put *)
+(* @uses Representation -- blob encode/decode *)
+(* @needs Condition *)
+(* @needs Value *)
+(* @needs Storage *)
+
 module C = struct
   open Ctypes
   open PosixTypes
diff --git a/lib/concepts/Condition.ml b/lib/concepts/Condition.ml
index 16f02d0..a9082ad 100644
--- a/lib/concepts/Condition.ml
+++ b/lib/concepts/Condition.ml
@@ -1,3 +1,5 @@
+(* @uses Value -- renders property values in to_string_hum *)
+
 type properties = (string, Value.value) BatMap.t
 type ps = properties -> properties
 
diff --git a/lib/concepts/Configuration.ml b/lib/concepts/Configuration.ml
index 5ca95d5..b2c29eb 100644
--- a/lib/concepts/Configuration.ml
+++ b/lib/concepts/Configuration.ml
@@ -1,3 +1,5 @@
+(* @uses Condition -- builds syntax/type errors *)
+
 open Sexplib.Sexp
 
 type term = Sexplib.Sexp.t
diff --git a/lib/concepts/Hash.ml b/lib/concepts/Hash.ml
index 106e731..f467ee7 100644
--- a/lib/concepts/Hash.ml
+++ b/lib/concepts/Hash.ml
@@ -1,3 +1,5 @@
+(* @needs Value *)
+
 type hash = Digestif.SHA256.t
 
 let hash_of_value (v : Value.value) =
diff --git a/lib/concepts/Representation.ml b/lib/concepts/Representation.ml
index 856ae11..12c3624 100644
--- a/lib/concepts/Representation.ml
+++ b/lib/concepts/Representation.ml
@@ -1,3 +1,5 @@
+(* @needs Value *)
+
 type blob = bytes
 
 let blob_of_bytes (b : bytes) = b
diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
index 3050c13..8fac426 100644
--- a/lib/concepts/Tuple.ml
+++ b/lib/concepts/Tuple.ml
@@ -1,3 +1,5 @@
+(* @needs Value *)
+
 module AttributeMap = BatMap.String
 
 (** A tuple: a finite map from attribute name to attribute. *)
diff --git a/rnt.opam b/rnt.opam
index e800c05..97cdf3b 100644
--- a/rnt.opam
+++ b/rnt.opam
@@ -14,7 +14,6 @@ depends: [
   "batteries"
   "digestif"
   "alcotest" {with-test}
-  "qcheck-alcotest" {with-test}
   "ocaml-lsp-server" {with-dev-setup}
   "odoc" {with-doc}
 ]
diff --git a/tools/uml_blueprint.pl b/tools/uml_blueprint.pl
new file mode 100644
index 0000000..8b40e42
--- /dev/null
+++ b/tools/uml_blueprint.pl
@@ -0,0 +1,271 @@
+#!/usr/bin/env perl
+#
+# uml_blueprint.pl — generate a PlantUML class diagram from OCaml sources.
+#
+# Each module (an *.ml / *.mli file) becomes a class:
+#   - types -> fields
+#   - vals  -> methods (with a best-effort return type)
+#
+# Edges are DECLARED, not guessed. A signature has no bodies, so a call graph
+# cannot be recovered from it, and scraping .ml bodies is a heuristic that lies
+# on aliases, opens and functor params. Instead the author states each edge in a
+# comment tag, anywhere in the module's .ml/.mli:
+#
+#   (* @uses  <Module> [-- <note>] *)   solid  A --> B : <note>   (a real call)
+#   (* @needs <Module> [<Module>...] *) dashed A ..> B            (type-only)
+#
+# Example (lib/backend/managers/Lifecycle.mli):
+#   (* @uses Object -- calls register/unregister *)
+#   (* @needs Path *)
+# yields:
+#   Lifecycle --> Object : calls register/unregister
+#   Lifecycle ..> Path
+#
+# A tag naming an unknown module is reported on stderr (typo guard for CI).
+#
+# Usage: perl tools/uml_blueprint.pl --src lib --out docs/architecture.puml
+
+use strict;
+use warnings;
+use File::Find ();
+use Getopt::Long ();
+
+my $src   = 'lib';
+my $out   = '-';
+my $title = 'RNT Architecture';
+my $strict   = 0;    # --strict:   exit non-zero if a tag names an unknown module
+my $no_notes = 0;    # --no-notes: drop @uses edge labels (pristine edges)
+Getopt::Long::GetOptions(
+  'src=s'    => \$src,
+  'out=s'    => \$out,
+  'title=s'  => \$title,
+  'strict'   => \$strict,
+  'no-notes' => \$no_notes,
+) or die "usage: $0 [--src DIR] [--out FILE] [--title STR] [--strict] [--no-notes]\n";
+
+# ---------------------------------------------------------------------------
+# 1. Discover modules. A module is a capitalised *.ml / *.mli basename.
+# ---------------------------------------------------------------------------
+my %mod;    # base => { ml => path, mli => path }
+File::Find::find(
+  sub {
+    return unless -f $_;
+    return unless /\A([A-Z][A-Za-z0-9_']*)\.(mli?)\z/;
+    $mod{$1}{ $2 eq 'mli' ? 'mli' : 'ml' } = $File::Find::name;
+  },
+  $src
+);
+my %known = map { $_ => 1 } keys %mod;
+die "no OCaml modules found under $src\n" unless %known;
+
+# ---------------------------------------------------------------------------
+# Helpers.
+# ---------------------------------------------------------------------------
+sub slurp {
+  my ($f) = @_;
+  open my $fh, '<', $f or die "$f: $!\n";
+  local $/;
+  return <$fh>;
+}
+
+# Remove OCaml comments (nested (* *)) and string literals, so a keyword inside
+# either cannot masquerade as a member. Tags are read from the RAW text; members
+# from this stripped text.
+sub strip {
+  my ($s) = @_;
+  my ($i, $n, $depth, $keep) = (0, length $s, 0, '');
+  while ($i < $n) {
+    my $two = substr($s, $i, 2);
+    if ($depth == 0 && $two eq '(*') { $depth = 1; $i += 2; next; }
+    if ($depth > 0) {
+      if    ($two eq '(*') { $depth++; $i += 2; next; }
+      elsif ($two eq '*)') { $depth--; $i += 2; next; }
+      $i++;
+      next;
+    }
+    my $c = substr($s, $i, 1);
+    if ($c eq '"') {    # skip a string literal, honouring \" escapes
+      $i++;
+      while ($i < $n) {
+        my $d = substr($s, $i, 1);
+        if    ($d eq '\\') { $i += 2; next; }
+        elsif ($d eq '"')  { $i++; last; }
+        $i++;
+      }
+      $keep .= ' ';
+      next;
+    }
+    $keep .= $c;
+    $i++;
+  }
+  return $keep;
+}
+
+sub clean_name {          # strip the parens off an operator val, e.g. ( |=| )
+  my ($n) = @_;
+  $n =~ s/\A\(\s*//;
+  $n =~ s/\s*\)\z//;
+  return $n;
+}
+
+sub ret_of {              # best-effort return type: text after the last arrow
+  my ($s) = @_;
+  $s =~ s/\s+/ /g;
+  $s = $1 if $s =~ /.*->\s*(.*)\z/s;
+  $s =~ s/[(){}:]/ /g;                    # keep it a valid PlantUML label
+  $s =~ s/\s+/ /g;
+  $s =~ s/\A\s+|\s+\z//g;
+  $s = substr($s, 0, 57) . '...' if length $s > 60;
+  return $s;
+}
+
+sub uniq {
+  my %seen;
+  return grep { !$seen{$_}++ } @_;
+}
+
+# Members from a signature (.mli).
+sub parse_sig {
+  my ($t) = @_;
+  my (@types, @vals);
+  while ($t =~ /(?<![\w'])(?:type|and)\s+(?:\([^)]*\)\s+|'[\w']+\s+)*([a-z_][\w']*)/g) {
+    push @types, $1;
+  }
+  while ($t =~ /(?<![\w'])val\s+(\([^)]*\)|[a-z_][\w']*)\s*:\s*
+                (.*?)(?=(?:\bval\b|\btype\b|\band\b|\bmodule\b|\binclude\b|\bend\b)|\z)/gsx) {
+    push @vals, [ clean_name($1), ret_of($2) ];
+  }
+  return (\@types, \@vals);
+}
+
+# Members from an implementation (.ml) — used when a module has no .mli.
+# Only column-0 `let`/`type` count, so local bindings are ignored.
+sub parse_impl {
+  my ($t) = @_;
+  my (@types, @vals);
+  while ($t =~ /(?<![\w'])(?:type|and)\s+(?:\([^)]*\)\s+|'[\w']+\s+)*([a-z_][\w']*)/g) {
+    push @types, $1;
+  }
+  while ($t =~ /(?:\A|\n)let\s+(?:rec\s+)?(\([^)]*\)|[a-z_][\w']*)/g) {
+    push @vals, [ clean_name($1), '' ];
+  }
+  return (\@types, \@vals);
+}
+
+# Declared edges from tags in the RAW text of a module.
+#   @composes B [-- note] -> ('composes', B, note)   functor param / application
+#   @uses     B [-- note] -> ('uses', B, note)       declared call
+#   @needs    B [C ...]   -> ('needs', B, undef)     type-only coupling
+my $warned = 0;
+sub parse_tags {
+  my ($raw, $self) = @_;
+  my @edges;
+  for my $kw (qw(composes uses)) {
+    while ($raw =~ /\@$kw\s+([A-Z][\w']*)\s*(?:--\s*(.+?))?\s*(?:\*\)|\R|\z)/g) {
+      my ($b, $note) = ($1, $2);
+      $note =~ s/\s+\z// if defined $note;
+      push @edges, [ $kw, $b, $note ];
+    }
+  }
+  while ($raw =~ /\@needs\s+((?:[A-Z][\w']*[,\s]*)+)/g) {
+    push @edges, [ 'needs', $_, undef ] for ($1 =~ /([A-Z][\w']*)/g);
+  }
+  for my $e (@edges) {
+    my $b = $e->[1];
+    if (!$known{$b}) {
+      warn "$self: \@$e->[0] names unknown module '$b'\n";
+      $warned++;
+    }
+  }
+  return grep { $known{ $_->[1] } && $_->[1] ne $self } @edges;
+}
+
+# ---------------------------------------------------------------------------
+# 2. Build classes and edges.
+# ---------------------------------------------------------------------------
+my (%types, %vals, %edges);
+for my $m (keys %mod) {
+  my $raw_sig  = $mod{$m}{mli} ? slurp($mod{$m}{mli}) : '';
+  my $raw_impl = $mod{$m}{ml}  ? slurp($mod{$m}{ml})  : '';
+
+  if ($raw_sig ne '') { ($types{$m}, $vals{$m}) = parse_sig(strip($raw_sig)); }
+  else                { ($types{$m}, $vals{$m}) = parse_impl(strip($raw_impl)); }
+
+  # Tags may live in either file.
+  $edges{$m} = [ parse_tags($raw_sig, $m), parse_tags($raw_impl, $m) ];
+}
+
+# ---------------------------------------------------------------------------
+# 3. Emit PlantUML.
+# ---------------------------------------------------------------------------
+my $fh;
+if ($out eq '-') { $fh = \*STDOUT; }
+else { open $fh, '>', $out or die "$out: $!\n"; }
+
+print {$fh} "\@startuml\n";
+print {$fh} "!theme toy\n";
+print {$fh} "title $title\n";
+print {$fh} "hide empty members\n";
+print {$fh} "skinparam classAttributeIconSize 0\n";
+# Orthogonal routing: straight segments with right-angle turns instead of
+# curved splines. Use "polyline" for straight-but-diagonal edges instead.
+print {$fh} "skinparam linetype ortho\n";
+# Keep the graph compact so it does not shrink to unreadable when fit to width,
+# but leave enough gap that ortho channels do not merge. Larger font offsets the
+# tighter packing.
+print {$fh} "skinparam nodesep 30\n";
+print {$fh} "skinparam ranksep 50\n";
+print {$fh} "skinparam defaultFontSize 15\n";
+print {$fh} "left to right direction\n\n";
+
+for my $m (sort keys %mod) {
+  print {$fh} "class $m <<module>> {\n";
+  my @t = uniq(@{ $types{$m} });
+  if (@t) {
+    print {$fh} "  .. types ..\n";
+    print {$fh} "  +$_\n" for @t;
+  }
+  my @v = uniq(map { $_->[0] } @{ $vals{$m} });
+  my %ret = map { $_->[0] => $_->[1] } @{ $vals{$m} };
+  if (@v) {
+    print {$fh} "  .. values ..\n";
+    for my $name (@v) {
+      if ($name =~ /\A[a-z_][\w']*\z/) {
+        print {$fh} $ret{$name} ? "  +$name() : $ret{$name}\n" : "  +$name()\n";
+      }
+      else { print {$fh} "  +\"$name\"\n"; }    # operator, rendered flat
+    }
+  }
+  print {$fh} "}\n\n";
+}
+
+# One edge per pair: the strongest declared relation wins.
+#   composes (3) *--   >   uses (2) -->   >   needs (1) ..>
+my %rank = (composes => 3, uses => 2, needs => 1);
+my %best;    # "from|to" => [kind, note]
+for my $from (sort keys %mod) {
+  for my $e (@{ $edges{$from} }) {
+    my ($kind, $to, $note) = @$e;
+    my $key = "$from|$to";
+    next if $best{$key} && $rank{ $best{$key}[0] } >= $rank{$kind};
+    $best{$key} = [ $kind, $note ];
+  }
+}
+for my $key (sort keys %best) {
+  my ($from, $to) = split /\|/, $key;
+  my ($kind, $note) = @{ $best{$key} };
+  my $arrow = $kind eq 'composes' ? '*--' : $kind eq 'uses' ? '-->' : '..>';
+  my $label = (!$no_notes && defined $note && $note ne '') ? " : $note" : '';
+  print {$fh} "$from $arrow $to$label\n";
+}
+
+print {$fh} "\nlegend right\n";
+print {$fh} "  diamond A *-- B : functor composition (\@composes)\n";
+print {$fh} "  solid   A --> B : declared call (\@uses)\n";
+print {$fh} "  dashed  A ..> B : type-only coupling (\@needs)\n";
+print {$fh} "endlegend\n";
+print {$fh} "\@enduml\n";
+
+close $fh if $out ne '-';
+
+exit 2 if $strict && $warned;