♻️ Make uses-token the vocabulary's three-place relation

The experiment entry records the rule as (uses-token ?s ?tok ?attr),
with the applying property a rule variable rather than a per-shape
attribute walk; the two-place form was this port's own invention.
shapes-using-token now reads the property from the rule's third place.

AI-assisted-by: claude-fable-5
This commit is contained in:
Álvaro Tejero Cantero 2026-08-21 09:29:25 +02:00
parent 6ab6034abf
commit 0d11aa3f01
No known key found for this signature in database
3 changed files with 24 additions and 34 deletions

View File

@ -114,11 +114,13 @@
[?s :shape/container ?c]
[?c :container/kind :page]]]
;; UsesToken over the folded encoding; the closed vocabulary is
;; embedded as data so the rule stays engine-portable
[(vector '(uses-token ?s ?tok)
'[?s ?a ?n]
[(list 'contains? overlay/token-attrs '?a)]
;; UsesToken over the folded encoding, the vocabulary's one
;; three-place relation: ?attr carries the applying property's folded
;; attribute. The closed vocabulary is embedded as data so the rule
;; stays engine-portable.
[(vector '(uses-token ?s ?tok ?attr)
'[?s ?attr ?n]
[(list 'contains? overlay/token-attrs '?attr)]
'[?tok :token/name ?n])]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -314,37 +316,25 @@
[?s :shape/id ?id]]
db typography-id))
(defn- applied-props
"The applied-token properties under which `eid` carries `token-name`,
recovered from the folded attributes of the entity."
[db eid token-name]
(let [e (d/entity db eid)]
(into []
(keep (fn [attr]
(when (= token-name (get e attr))
(overlay/token-attr->prop attr))))
overlay/token-attrs)))
(defn shapes-using-token
"Applied-token uses of the token named `token-name`, as
[container-id shape-id property] triples (the LinkAppliedTokens
question). The relation comes from the `uses-token` rule; the property
is recovered from the folded attributes per matched shape."
question). The whole answer comes from the three-place `uses-token`
rule; the property is the third rule variable, translated back from
the folded attribute."
[db token-name]
(let [pairs (d/q '[:find ?cid ?id ?s
:in $ % ?name
:where
[?tok :token/name ?name]
(uses-token ?s ?tok)
[?s :shape/container ?c]
[?c :container/id ?cid]
[?s :shape/id ?id]]
db rules token-name)]
(into #{}
(mapcat (fn [[cid id eid]]
(map (fn [prop] [cid id prop])
(applied-props db eid token-name))))
pairs)))
(into #{}
(map (fn [[cid id attr]]
[cid id (overlay/token-attr->prop attr)]))
(d/q '[:find ?cid ?id ?attr
:in $ % ?name
:where
[?tok :token/name ?name]
(uses-token ?s ?tok ?attr)
[?s :shape/container ?c]
[?c :container/id ?cid]
[?s :shape/id ?id]]
db rules token-name)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; inventory and parity

View File

@ -92,7 +92,7 @@
(t/is (= #{"Child A" "Child B"} (set (map first rows)))))
(let [{:keys [rows]} (console/run-query
db
"[:find ?name :in $ % :where (uses-token ?s ?tok) [?tok :token/name ?name]]")]
"[:find ?name :in $ % :where (uses-token ?s ?tok ?a) [?tok :token/name ?name]]")]
(t/is (empty? rows)))))
(t/deftest the-old-rule-name-is-rejected

View File

@ -802,7 +802,7 @@
:in $ % ?name
:where
[?tok :token/name ?name]
(uses-token ?s ?tok)
(uses-token ?s ?tok ?a)
[?s :shape/container ?c]
[?c :container/id ?cid]
[?s :shape/id ?id]]]