giles
3764b62206
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/trace-rules evaluates a report against every rule, returning each rule's proved/unproved status + goal-by-goal derivation (an unproved rule shows which goal failed). mod/first-proved = winner (matches engine precedence, cross-checked), mod/proved-rules the firing set, mod/trace-report a [fires]/[ - ] rendering. Answers 'why didn't my rule fire?' without instrumenting the engine. +15 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
57 lines
1.6 KiB
Plaintext
57 lines
1.6 KiB
Plaintext
;; lib/mod/trace.sx — policy dry-run diagnostics.
|
|
;;
|
|
;; decide-report returns the winning rule; a policy author debugging "why didn't
|
|
;; my rule fire?" needs the whole picture. mod/trace-rules evaluates a report
|
|
;; against every rule and reports each rule's proved/unproved status plus its
|
|
;; goal-by-goal derivation — so an unproved rule shows exactly which goal failed.
|
|
;; The winner is the first proved rule (same precedence as the engine).
|
|
|
|
(define
|
|
mod/trace-rules
|
|
(fn
|
|
(r reports rules)
|
|
(let
|
|
((count (mod/report-count (mod/report-about r) reports))
|
|
(id (mod/report-id r)))
|
|
(let
|
|
((db (pl-load (mod/build-program r count rules))))
|
|
(let
|
|
((proved-names (map (fn (s) (dict-get s "Rule")) (pl-query-all db (str "policy_action(" id ", _, Rule)")))))
|
|
(map
|
|
(fn (rule) (let ((nm (mod/rule-name rule))) {:proved (mod/member? nm proved-names) :goals (mod/proof-goals db id (mod/rule-when rule)) :action (mod/rule-action rule) :rule nm}))
|
|
rules))))))
|
|
|
|
(define
|
|
mod/first-proved
|
|
(fn
|
|
(trace)
|
|
(reduce
|
|
(fn (acc t) (if (nil? acc) (if (get t :proved) t acc) acc))
|
|
nil
|
|
trace)))
|
|
|
|
(define
|
|
mod/proved-rules
|
|
(fn
|
|
(trace)
|
|
(reduce
|
|
(fn
|
|
(acc t)
|
|
(if (get t :proved) (append acc (list (get t :rule))) acc))
|
|
(list)
|
|
trace)))
|
|
|
|
(define
|
|
mod/trace-row
|
|
(fn
|
|
(t)
|
|
(str
|
|
(if (get t :proved) "[fires] " "[ - ] ")
|
|
(get t :rule)
|
|
" → "
|
|
(get t :action))))
|
|
|
|
(define
|
|
mod/trace-report
|
|
(fn (trace) (mod/join-with "\n" (map mod/trace-row trace))))
|