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/api.sx
|
||||
lib/mod/fed.sx
|
||||
lib/mod/link.sx
|
||||
)
|
||||
|
||||
SUITES=(
|
||||
@@ -26,4 +27,5 @@ SUITES=(
|
||||
"escalation:lib/mod/tests/escalation.sx:(mod-escalation-tests-run!)"
|
||||
"fed:lib/mod/tests/fed.sx:(mod-fed-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",
|
||||
"total_passed": 164,
|
||||
"total_passed": 176,
|
||||
"total_failed": 0,
|
||||
"total": 164,
|
||||
"total": 176,
|
||||
"suites": [
|
||||
{"name":"decide","passed":31,"failed":0,"total":31},
|
||||
{"name":"audit","passed":29,"failed":0,"total":29},
|
||||
{"name":"escalation","passed":46,"failed":0,"total":46},
|
||||
{"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
|
||||
|
||||
**164 / 164 passing** (0 failure(s)).
|
||||
**176 / 176 passing** (0 failure(s)).
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -9,3 +9,4 @@
|
||||
| escalation | 46 | 46 | ok |
|
||||
| fed | 26 | 26 | 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)
|
||||
|
||||
`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
|
||||
|
||||
@@ -147,10 +147,22 @@ lib/mod/fed.sx
|
||||
derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification
|
||||
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}`.
|
||||
- [ ] 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
|
||||
|
||||
- **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
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user