relations: bulk lifecycle — relate-many! + unrelate-node! cascade cleanup + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
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) <noreply@anthropic.com>
This commit is contained in:
@@ -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)))
|
||||
|
||||
@@ -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!)"
|
||||
)
|
||||
|
||||
@@ -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"
|
||||
}
|
||||
|
||||
@@ -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 |
|
||||
|
||||
142
lib/relations/tests/bulk.sx
Normal file
142
lib/relations/tests/bulk.sx
Normal file
@@ -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})))
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user