giles
7a1696490c
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m0s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
118 lines
3.0 KiB
Plaintext
118 lines
3.0 KiB
Plaintext
;; lib/relations/api.sx — relationship lifecycle + queries over lib/datalog/.
|
|
;;
|
|
;; A relations db is a live Datalog db holding rel(Src,Dst,Kind) facts under the
|
|
;; engine ruleset (lib/relations/engine.sx). Direct children/parents are plain
|
|
;; queries on the rel relation; transitive reachability/roots/leaves/cycles come
|
|
;; from the engine's recursive rules.
|
|
;;
|
|
;; Two surfaces: db-threading core fns (relations-children-of db ...) and a
|
|
;; current-db convenience layer (relations/relate ...) for callers that load a
|
|
;; fact base once and query without passing the db around. This mirrors lib/acl.
|
|
|
|
(define
|
|
relations-build-db
|
|
(fn (facts) (dl-program-data facts relations-rules)))
|
|
|
|
;; Direct children: every Dst with rel(node, Dst, kind).
|
|
(define
|
|
relations-children-of
|
|
(fn
|
|
(db node kind)
|
|
(relations-pluck
|
|
(dl-query db (list (quote rel) node (quote Dst) kind))
|
|
:Dst)))
|
|
|
|
;; Direct parents: every Src with rel(Src, node, kind).
|
|
(define
|
|
relations-parents-of
|
|
(fn
|
|
(db node kind)
|
|
(relations-pluck
|
|
(dl-query db (list (quote rel) (quote Src) node kind))
|
|
:Src)))
|
|
|
|
;; Directly related: neighbours in either direction under kind.
|
|
(define
|
|
relations-related
|
|
(fn
|
|
(db node kind)
|
|
(append
|
|
(relations-children-of db node kind)
|
|
(relations-parents-of db node kind))))
|
|
|
|
;; --- current-db convenience layer ---
|
|
|
|
(define relations-current-db nil)
|
|
|
|
(define
|
|
relations/load!
|
|
(fn
|
|
(facts)
|
|
(do
|
|
(set! relations-current-db (relations-build-db facts))
|
|
relations-current-db)))
|
|
|
|
(define
|
|
relations-ensure-db!
|
|
(fn
|
|
()
|
|
(do
|
|
(when
|
|
(= relations-current-db nil)
|
|
(set! relations-current-db (relations-build-db (list))))
|
|
relations-current-db)))
|
|
|
|
;; Add a relationship to the current db (re-saturates).
|
|
(define
|
|
relations/relate
|
|
(fn
|
|
(src dst kind)
|
|
(dl-assert! (relations-ensure-db!) (relations-rel src dst kind))))
|
|
|
|
;; Remove a relationship from the current db (re-saturates).
|
|
(define
|
|
relations/unrelate
|
|
(fn
|
|
(src dst kind)
|
|
(dl-retract! (relations-ensure-db!) (relations-rel src dst kind))))
|
|
|
|
(define
|
|
relations/children
|
|
(fn (node kind) (relations-children-of (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/parents
|
|
(fn (node kind) (relations-parents-of (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/related
|
|
(fn (node kind) (relations-related (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/descendants
|
|
(fn (node kind) (relations-descendants (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/ancestors
|
|
(fn (node kind) (relations-ancestors (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/reachable?
|
|
(fn (a b kind) (relations-reachable? (relations-ensure-db!) a b kind)))
|
|
|
|
(define
|
|
relations/roots
|
|
(fn (kind) (relations-roots (relations-ensure-db!) kind)))
|
|
|
|
(define
|
|
relations/leaves
|
|
(fn (kind) (relations-leaves (relations-ensure-db!) kind)))
|
|
|
|
(define
|
|
relations/cycle?
|
|
(fn (node kind) (relations-cycle? (relations-ensure-db!) node kind)))
|
|
|
|
(define
|
|
relations/acyclic?
|
|
(fn (kind) (relations-acyclic? (relations-ensure-db!) kind)))
|