mod: Ext 4 — report linking + dedup (Prolog-backed retrieval), 176/176
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/related-ids and mod/reporters-of find reports about a subject via a Prolog relational query (report(Id, _, 'subject')) — the policy substrate reused for retrieval. mod/dedup-reports collapses identical reports by a normalized reporter|subject|reason key; mod/distinct-reporters-of counts unique reporters. Own suite (tests/link.sx). +12 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -18,6 +18,7 @@ PRELOADS=(
|
|||||||
lib/mod/audit.sx
|
lib/mod/audit.sx
|
||||||
lib/mod/api.sx
|
lib/mod/api.sx
|
||||||
lib/mod/fed.sx
|
lib/mod/fed.sx
|
||||||
|
lib/mod/link.sx
|
||||||
)
|
)
|
||||||
|
|
||||||
SUITES=(
|
SUITES=(
|
||||||
@@ -26,4 +27,5 @@ SUITES=(
|
|||||||
"escalation:lib/mod/tests/escalation.sx:(mod-escalation-tests-run!)"
|
"escalation:lib/mod/tests/escalation.sx:(mod-escalation-tests-run!)"
|
||||||
"fed:lib/mod/tests/fed.sx:(mod-fed-tests-run!)"
|
"fed:lib/mod/tests/fed.sx:(mod-fed-tests-run!)"
|
||||||
"extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)"
|
"extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)"
|
||||||
|
"link:lib/mod/tests/link.sx:(mod-link-tests-run!)"
|
||||||
)
|
)
|
||||||
|
|||||||
92
lib/mod/link.sx
Normal file
92
lib/mod/link.sx
Normal file
@@ -0,0 +1,92 @@
|
|||||||
|
;; lib/mod/link.sx — report linking + deduplication.
|
||||||
|
;;
|
||||||
|
;; Reports about the same subject form a cluster; identical reports (same
|
||||||
|
;; reporter + subject + reason) are duplicates. Linking is Prolog-backed: all
|
||||||
|
;; report facts are loaded and related ids are found by unification — the same
|
||||||
|
;; relational substrate the policy engine uses, here for retrieval rather than
|
||||||
|
;; decision. Dedup is pure SX over a normalized link key.
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/link-key
|
||||||
|
(fn
|
||||||
|
(r)
|
||||||
|
(str
|
||||||
|
(mod/report-by r)
|
||||||
|
"|"
|
||||||
|
(mod/report-about r)
|
||||||
|
"|"
|
||||||
|
(downcase (mod/report-reason r)))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/dedup-reports
|
||||||
|
(fn
|
||||||
|
(reports)
|
||||||
|
(reduce
|
||||||
|
(fn
|
||||||
|
(acc r)
|
||||||
|
(if
|
||||||
|
(mod/any? (fn (x) (= (mod/link-key x) (mod/link-key r))) acc)
|
||||||
|
acc
|
||||||
|
(append acc (list r))))
|
||||||
|
(list)
|
||||||
|
reports)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/duplicate-count
|
||||||
|
(fn (reports) (- (len reports) (len (mod/dedup-reports reports)))))
|
||||||
|
|
||||||
|
;; ── Prolog-backed relational retrieval ──
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/report-rel-facts
|
||||||
|
(fn
|
||||||
|
(reports)
|
||||||
|
(mod/join-with
|
||||||
|
"\n"
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(r)
|
||||||
|
(str
|
||||||
|
"report("
|
||||||
|
(mod/report-id r)
|
||||||
|
", "
|
||||||
|
(mod/pl-quote (mod/report-by r))
|
||||||
|
", "
|
||||||
|
(mod/pl-quote (mod/report-about r))
|
||||||
|
")."))
|
||||||
|
reports))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/related-ids
|
||||||
|
(fn
|
||||||
|
(subject reports)
|
||||||
|
(let
|
||||||
|
((db (pl-load (mod/report-rel-facts reports))))
|
||||||
|
(map
|
||||||
|
(fn (sol) (dict-get sol "Id"))
|
||||||
|
(pl-query-all db (str "report(Id, _, " (mod/pl-quote subject) ")"))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/reporters-of
|
||||||
|
(fn
|
||||||
|
(subject reports)
|
||||||
|
(let
|
||||||
|
((db (pl-load (mod/report-rel-facts reports))))
|
||||||
|
(map
|
||||||
|
(fn (sol) (dict-get sol "By"))
|
||||||
|
(pl-query-all db (str "report(_, By, " (mod/pl-quote subject) ")"))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/distinct
|
||||||
|
(fn
|
||||||
|
(items)
|
||||||
|
(reduce
|
||||||
|
(fn
|
||||||
|
(acc x)
|
||||||
|
(if (mod/any? (fn (y) (= y x)) acc) acc (append acc (list x))))
|
||||||
|
(list)
|
||||||
|
items)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod/distinct-reporters-of
|
||||||
|
(fn (subject reports) (mod/distinct (mod/reporters-of subject reports))))
|
||||||
@@ -1,14 +1,15 @@
|
|||||||
{
|
{
|
||||||
"lang": "mod",
|
"lang": "mod",
|
||||||
"total_passed": 164,
|
"total_passed": 176,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 164,
|
"total": 176,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"decide","passed":31,"failed":0,"total":31},
|
{"name":"decide","passed":31,"failed":0,"total":31},
|
||||||
{"name":"audit","passed":29,"failed":0,"total":29},
|
{"name":"audit","passed":29,"failed":0,"total":29},
|
||||||
{"name":"escalation","passed":46,"failed":0,"total":46},
|
{"name":"escalation","passed":46,"failed":0,"total":46},
|
||||||
{"name":"fed","passed":26,"failed":0,"total":26},
|
{"name":"fed","passed":26,"failed":0,"total":26},
|
||||||
{"name":"extensions","passed":32,"failed":0,"total":32}
|
{"name":"extensions","passed":32,"failed":0,"total":32},
|
||||||
|
{"name":"link","passed":12,"failed":0,"total":12}
|
||||||
],
|
],
|
||||||
"generated": "2026-06-06T18:05:54+00:00"
|
"generated": "2026-06-06T18:09:14+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# mod scoreboard
|
# mod scoreboard
|
||||||
|
|
||||||
**164 / 164 passing** (0 failure(s)).
|
**176 / 176 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
@@ -9,3 +9,4 @@
|
|||||||
| escalation | 46 | 46 | ok |
|
| escalation | 46 | 46 | ok |
|
||||||
| fed | 26 | 26 | ok |
|
| fed | 26 | 26 | ok |
|
||||||
| extensions | 32 | 32 | ok |
|
| extensions | 32 | 32 | ok |
|
||||||
|
| link | 12 | 12 | ok |
|
||||||
|
|||||||
86
lib/mod/tests/link.sx
Normal file
86
lib/mod/tests/link.sx
Normal file
@@ -0,0 +1,86 @@
|
|||||||
|
;; lib/mod/tests/link.sx — Ext 4: report linking + dedup.
|
||||||
|
|
||||||
|
(define mod-lnk-count 0)
|
||||||
|
(define mod-lnk-pass 0)
|
||||||
|
(define mod-lnk-fail 0)
|
||||||
|
(define mod-lnk-failures (list))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mod-lnk-test!
|
||||||
|
(fn
|
||||||
|
(name got expected)
|
||||||
|
(begin
|
||||||
|
(set! mod-lnk-count (+ mod-lnk-count 1))
|
||||||
|
(if
|
||||||
|
(= got expected)
|
||||||
|
(set! mod-lnk-pass (+ mod-lnk-pass 1))
|
||||||
|
(begin
|
||||||
|
(set! mod-lnk-fail (+ mod-lnk-fail 1))
|
||||||
|
(append!
|
||||||
|
mod-lnk-failures
|
||||||
|
(str name "\n expected: " expected "\n got: " got)))))))
|
||||||
|
|
||||||
|
;; ── link-key + dedup ──
|
||||||
|
|
||||||
|
(define mod-lnk-a (mod/mk-report "r1" "alice" "bob" "this is spam"))
|
||||||
|
(define mod-lnk-a2 (mod/mk-report "r2" "alice" "bob" "THIS IS SPAM"))
|
||||||
|
(define mod-lnk-b (mod/mk-report "r3" "carol" "bob" "abuse"))
|
||||||
|
(define mod-lnk-c (mod/mk-report "r4" "alice" "eve" "this is spam"))
|
||||||
|
|
||||||
|
(mod-lnk-test!
|
||||||
|
"identical reports share a link key (case-insensitive reason)"
|
||||||
|
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-a2))
|
||||||
|
true)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"different reporter → different key"
|
||||||
|
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-b))
|
||||||
|
false)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"different subject → different key"
|
||||||
|
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-c))
|
||||||
|
false)
|
||||||
|
|
||||||
|
(define mod-lnk-set (list mod-lnk-a mod-lnk-a2 mod-lnk-b mod-lnk-c))
|
||||||
|
(mod-lnk-test!
|
||||||
|
"dedup collapses identical reports"
|
||||||
|
(len (mod/dedup-reports mod-lnk-set))
|
||||||
|
3)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"duplicate-count counts collapsed"
|
||||||
|
(mod/duplicate-count mod-lnk-set)
|
||||||
|
1)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"dedup of all-distinct keeps all"
|
||||||
|
(len (mod/dedup-reports (list mod-lnk-a mod-lnk-b mod-lnk-c)))
|
||||||
|
3)
|
||||||
|
|
||||||
|
;; ── Prolog-backed relational linking ──
|
||||||
|
|
||||||
|
(mod-lnk-test!
|
||||||
|
"related-ids finds all reports about subject"
|
||||||
|
(len (mod/related-ids "bob" mod-lnk-set))
|
||||||
|
3)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"related-ids returns the ids"
|
||||||
|
(mod/related-ids "eve" mod-lnk-set)
|
||||||
|
(list "r4"))
|
||||||
|
(mod-lnk-test!
|
||||||
|
"related-ids empty for unknown subject"
|
||||||
|
(mod/related-ids "nobody" mod-lnk-set)
|
||||||
|
(list))
|
||||||
|
|
||||||
|
;; reporters: bob reported by alice (x2) + carol → 3 raw, 2 distinct
|
||||||
|
(mod-lnk-test!
|
||||||
|
"reporters-of counts all reports"
|
||||||
|
(len (mod/reporters-of "bob" mod-lnk-set))
|
||||||
|
3)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"distinct reporters-of dedups reporters"
|
||||||
|
(len (mod/distinct-reporters-of "bob" mod-lnk-set))
|
||||||
|
2)
|
||||||
|
(mod-lnk-test!
|
||||||
|
"distinct utility removes dups"
|
||||||
|
(mod/distinct (list "a" "b" "a" "c" "b"))
|
||||||
|
(list "a" "b" "c"))
|
||||||
|
|
||||||
|
(define mod-link-tests-run! (fn () {:failures mod-lnk-failures :total mod-lnk-count :passed mod-lnk-pass :failed mod-lnk-fail}))
|
||||||
@@ -16,7 +16,7 @@ federation extension.
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/mod/conformance.sh` → **164/164** (roadmap done + extensions in progress)
|
`bash lib/mod/conformance.sh` → **176/176** (roadmap + 4 extensions complete)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -147,10 +147,22 @@ lib/mod/fed.sx
|
|||||||
derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification
|
derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification
|
||||||
bindings. E.g. `Report rc: escalate (rule: repeated-escalate)` … `[proved]
|
bindings. E.g. `Report rc: escalate (rule: repeated-escalate)` … `[proved]
|
||||||
report(rc, B, S), report_count(S, N), N >= 3 {B=ann, N=3, S=dave}`.
|
report(rc, B, S), report_count(S, N), N >= 3 {B=ann, N=3, S=dave}`.
|
||||||
- [ ] Ext 4 — report linking / dedup (relations between reports about one subject)
|
- [x] **Ext 4 — report linking / dedup** (`lib/mod/link.sx`, +12). `mod/related-ids`
|
||||||
|
and `mod/reporters-of` find reports about a subject via a Prolog relational query
|
||||||
|
(`report(Id, _, 'subject')`) — the policy substrate reused for retrieval.
|
||||||
|
`mod/dedup-reports` collapses identical reports (reporter|subject|reason key,
|
||||||
|
case-insensitive); `mod/distinct-reporters-of` counts unique reporters.
|
||||||
|
|
||||||
## Progress log
|
## Progress log
|
||||||
|
|
||||||
|
- **Ext 4 — report linking / dedup, 176/176** (+12). Relational retrieval
|
||||||
|
(`related-ids`, `reporters-of`) reuses the Prolog substrate for *querying* report
|
||||||
|
clusters, not just deciding them — `report(Id, _, 'subject')` by unification.
|
||||||
|
Dedup is pure SX over a normalized link key. Own suite (`tests/link.sx`) — going
|
||||||
|
forward, new extensions get their own test file rather than growing
|
||||||
|
`extensions.sx`. With roadmap + 4 extensions the subsystem now spans schema →
|
||||||
|
policy DSL (6 condition types) → engine + proofs → audit → lifecycle →
|
||||||
|
federation → explanation → linking, all on the green `lib/prolog` substrate.
|
||||||
- **Ext 3 — proof explanation, 164/164** (+10). `mod/explain` turns the Phase-2
|
- **Ext 3 — proof explanation, 164/164** (+10). `mod/explain` turns the Phase-2
|
||||||
proof tree into human-readable text — the audit trail's "why" made legible. Pure
|
proof tree into human-readable text — the audit trail's "why" made legible. Pure
|
||||||
SX over existing decision data; no engine change. Renders unification bindings
|
SX over existing decision data; no engine change. Renders unification bindings
|
||||||
|
|||||||
Reference in New Issue
Block a user