From c0d02c229c4024745510dfecd52d0a096deb8d62 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 13:27:12 +0000 Subject: [PATCH] =?UTF-8?q?relations:=20bulk=20lifecycle=20=E2=80=94=20rel?= =?UTF-8?q?ate-many!=20+=20unrelate-node!=20cascade=20cleanup=20+=2012=20t?= =?UTF-8?q?ests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit unrelate-node! retracts every local edge touching a node (all kinds, both directions); leaves federated peer links alone. 147/147. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/relations/api.sx | 39 +++++++++ lib/relations/conformance.conf | 1 + lib/relations/scoreboard.json | 9 ++- lib/relations/scoreboard.md | 3 +- lib/relations/tests/bulk.sx | 142 +++++++++++++++++++++++++++++++++ plans/relations-on-sx.md | 14 +++- 6 files changed, 202 insertions(+), 6 deletions(-) create mode 100644 lib/relations/tests/bulk.sx diff --git a/lib/relations/api.sx b/lib/relations/api.sx index 61880e00..efea4394 100644 --- a/lib/relations/api.sx +++ b/lib/relations/api.sx @@ -100,3 +100,42 @@ (define relations/connected? (fn (a b kind) (relations-connected? (relations-ensure-db!) a b kind))) + +(define + relations-relate-many! + (fn + (db triples) + (do + (for-each + (fn + (t) + (dl-assert! + db + (relations-rel (first t) (nth t 1) (nth t 2)))) + triples) + db))) + +(define + relations-unrelate-node! + (fn + (db node) + (do + (for-each + (fn + (s) + (dl-retract! db (relations-rel node (get s :Dst) (get s :Kind)))) + (dl-query db (list (quote rel) node (quote Dst) (quote Kind)))) + (for-each + (fn + (s) + (dl-retract! db (relations-rel (get s :Src) node (get s :Kind)))) + (dl-query db (list (quote rel) (quote Src) node (quote Kind)))) + db))) + +(define + relations/relate-many! + (fn (triples) (relations-relate-many! (relations-ensure-db!) triples))) + +(define + relations/unrelate-node! + (fn (node) (relations-unrelate-node! (relations-ensure-db!) node))) diff --git a/lib/relations/conformance.conf b/lib/relations/conformance.conf index 85d32f80..b2607122 100644 --- a/lib/relations/conformance.conf +++ b/lib/relations/conformance.conf @@ -30,4 +30,5 @@ SUITES=( "shape:lib/relations/tests/shape.sx:(relations-shape-tests-run!)" "tree:lib/relations/tests/tree.sx:(relations-tree-tests-run!)" "routes:lib/relations/tests/routes.sx:(relations-routes-tests-run!)" + "bulk:lib/relations/tests/bulk.sx:(relations-bulk-tests-run!)" ) diff --git a/lib/relations/scoreboard.json b/lib/relations/scoreboard.json index 413b177d..260679b4 100644 --- a/lib/relations/scoreboard.json +++ b/lib/relations/scoreboard.json @@ -1,8 +1,8 @@ { "lang": "relations", - "total_passed": 135, + "total_passed": 147, "total_failed": 0, - "total": 135, + "total": 147, "suites": [ {"name":"direct","passed":22,"failed":0,"total":22}, {"name":"reach","passed":24,"failed":0,"total":24}, @@ -10,7 +10,8 @@ {"name":"fed","passed":22,"failed":0,"total":22}, {"name":"shape","passed":18,"failed":0,"total":18}, {"name":"tree","passed":16,"failed":0,"total":16}, - {"name":"routes","passed":9,"failed":0,"total":9} + {"name":"routes","passed":9,"failed":0,"total":9}, + {"name":"bulk","passed":12,"failed":0,"total":12} ], - "generated": "2026-06-07T13:18:20+00:00" + "generated": "2026-06-07T13:26:23+00:00" } diff --git a/lib/relations/scoreboard.md b/lib/relations/scoreboard.md index 44d75fd7..34556212 100644 --- a/lib/relations/scoreboard.md +++ b/lib/relations/scoreboard.md @@ -1,6 +1,6 @@ # relations scoreboard -**135 / 135 passing** (0 failure(s)). +**147 / 147 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -11,3 +11,4 @@ | shape | 18 | 18 | ok | | tree | 16 | 16 | ok | | routes | 9 | 9 | ok | +| bulk | 12 | 12 | ok | diff --git a/lib/relations/tests/bulk.sx b/lib/relations/tests/bulk.sx new file mode 100644 index 00000000..ef6066b8 --- /dev/null +++ b/lib/relations/tests/bulk.sx @@ -0,0 +1,142 @@ +;; lib/relations/tests/bulk.sx — extension: bulk lifecycle (relate-many, +;; unrelate-node cascade cleanup). + +(define relations-bk-pass 0) +(define relations-bk-fail 0) +(define relations-bk-failures (list)) + +(define + relations-bk-check! + (fn + (name got expected) + (if + (= got expected) + (set! relations-bk-pass (+ relations-bk-pass 1)) + (do + (set! relations-bk-fail (+ relations-bk-fail 1)) + (append! + relations-bk-failures + (str name "\n expected: " expected "\n got: " got)))))) + +(define + relations-bk-subset? + (fn + (xs ys) + (cond + ((= (len xs) 0) true) + ((relations-member? (first xs) ys) + (relations-bk-subset? (rest xs) ys)) + (else false)))) + +(define + relations-bk-set=? + (fn + (xs ys) + (and + (= (len xs) (len ys)) + (relations-bk-subset? xs ys) + (relations-bk-subset? ys xs)))) + +(define + relations-bk-run-all! + (fn + () + (do + (let + ((db (relations-build-db (list)))) + (do + (relations-relate-many! + db + (list + (list (quote a) (quote b) (quote parent)) + (list (quote a) (quote c) (quote parent)) + (list (quote x) (quote a) (quote parent)) + (list (quote a) (quote m) (quote member)))) + (relations-bk-check! + "relate-many: parent children of a" + (relations-bk-set=? + (relations-children-of db (quote a) (quote parent)) + (list (quote b) (quote c))) + true) + (relations-bk-check! + "relate-many: member child of a" + (relations-bk-set=? + (relations-children-of db (quote a) (quote member)) + (list (quote m))) + true) + (relations-bk-check! + "relate-many: x is a parent of a" + (relations-bk-set=? + (relations-parents-of db (quote a) (quote parent)) + (list (quote x))) + true) + (relations-unrelate-node! db (quote a)) + (relations-bk-check! + "after cleanup: a has no parent children" + (relations-children-of db (quote a) (quote parent)) + (list)) + (relations-bk-check! + "after cleanup: a has no parent parents" + (relations-parents-of db (quote a) (quote parent)) + (list)) + (relations-bk-check! + "after cleanup: a has no member children" + (relations-children-of db (quote a) (quote member)) + (list)) + (relations-bk-check! + "after cleanup: x no longer points at a" + (relations-children-of db (quote x) (quote parent)) + (list)))) + (let + ((db (relations-build-db (list (relations-rel (quote a) (quote b) (quote parent)) (relations-rel (quote c) (quote d) (quote parent)))))) + (do + (relations-unrelate-node! db (quote a)) + (relations-bk-check! + "cleanup leaves unrelated edge intact" + (relations-bk-set=? + (relations-children-of db (quote c) (quote parent)) + (list (quote d))) + true) + (relations-bk-check! + "cleanup removed the a edge" + (relations-children-of db (quote a) (quote parent)) + (list)))) + (let + ((db (relations-build-db (list (relations-rel (quote a) (quote b) (quote parent)))))) + (do + (relations-unrelate-node! db (quote nobody)) + (relations-bk-check! + "cleanup of unknown node is a no-op" + (relations-bk-set=? + (relations-children-of db (quote a) (quote parent)) + (list (quote b))) + true))) + (do + (relations/load! (list)) + (relations/relate-many! + (list + (list (quote o) (quote i1) (quote member)) + (list (quote o) (quote i2) (quote member)))) + (relations-bk-check! + "api relate-many" + (relations-bk-set=? + (relations/children (quote o) (quote member)) + (list (quote i1) (quote i2))) + true) + (relations/unrelate-node! (quote o)) + (relations-bk-check! + "api unrelate-node" + (relations/children (quote o) (quote member)) + (list)) + (relations/load! (list)))))) + +(define + relations-bulk-tests-run! + (fn + () + (do + (set! relations-bk-pass 0) + (set! relations-bk-fail 0) + (set! relations-bk-failures (list)) + (relations-bk-run-all!) + {:failures relations-bk-failures :total (+ relations-bk-pass relations-bk-fail) :passed relations-bk-pass :failed relations-bk-fail}))) diff --git a/plans/relations-on-sx.md b/plans/relations-on-sx.md index c73e2363..a9a6f1a8 100644 --- a/plans/relations-on-sx.md +++ b/plans/relations-on-sx.md @@ -18,7 +18,7 @@ links. Reuses `lib/datalog/` — does not reimplement the engine. ## Status (rolling) -`bash lib/relations/conformance.sh` → **135/135** (Phases 1–4 complete + extensions) +`bash lib/relations/conformance.sh` → **147/147** (Phases 1–4 complete + extensions) ## Ground rules @@ -110,9 +110,21 @@ lib/relations/federation.sx computed in SX over `reach`/`ancestors`/`rnode`. `lib/relations/tests/tree.sx`. - [x] **route enumeration** — `all-paths` (all simple directed paths a→b, not just the shortest; cycle-safe DFS) in explain.sx. `lib/relations/tests/routes.sx`. +- [x] **bulk lifecycle** — `relate-many!` (batch assert) + `unrelate-node!` (cascade + cleanup: retract every local edge touching a node, all kinds, both directions — + for domain object deletion; leaves federated peer links alone). api.sx, + `lib/relations/tests/bulk.sx`. ## Progress log +- **Extension: bulk lifecycle** (147/147). `relations-relate-many!` (batch + `dl-assert!` over a list of (src dst kind) triples) and `relations-unrelate-node!` + (query `rel` for every edge with the node as src or dst, across all kinds, then + `dl-retract!` each — the cascade-cleanup a domain needs when it deletes the + object a node id names). Federated `peer_rel` links are a peer's assertion and + are deliberately left untouched. + `relations/relate-many!`/`unrelate-node!` + wrappers, `lib/relations/tests/bulk.sx` (12 tests: batch assert, cascade across + kinds/both directions, unrelated edges preserved, unknown-node no-op, api layer). - **Extension: route enumeration** (135/135). `relations-all-paths(db,a,b,kind)` in explain.sx — every simple (no repeated node) directed path a→b, not just the shortest one `relations-path` returns; DFS that skips nodes already on the