giles
c67aefa211
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m15s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
97 lines
2.5 KiB
Plaintext
97 lines
2.5 KiB
Plaintext
;; lib/relations/api.sx — relationship lifecycle + direct queries over lib/datalog/.
|
|
;;
|
|
;; A relations db is a live Datalog db holding rel(Src,Dst,Kind) facts. Phase 1
|
|
;; uses no rules — direct children/parents are plain queries on the rel
|
|
;; relation. Phase 2's engine.sx adds recursive reachability rules; build-db
|
|
;; will fold them in then.
|
|
;;
|
|
;; 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-rules (list))
|
|
|
|
(define
|
|
relations-build-db
|
|
(fn (facts) (dl-program-data facts relations-rules)))
|
|
|
|
;; Pull one column (by keyword key) out of a list of substitution dicts.
|
|
(define
|
|
relations-pluck
|
|
(fn (substs key) (map (fn (s) (get s key)) substs)))
|
|
|
|
;; 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)))
|