rose-ash/lib/mod/policy.sx

;; lib/mod/policy.sx — moderation rules → Prolog clauses.
;;
;; A rule is {:name :action :when}. :when is a list of condition forms; each
;; compiles to a Prolog goal. The conditions in a :when list are ANDed (joined by
;; ", "); :not negates and :any (a list of sub-conditions) disjoins — so the
;; condition language is a small boolean algebra over the leaf predicates.
;; Rule order is precedence: the engine queries with pl-query-one, so the first
;; clause that proves wins. The final default rule has an empty body (true) so
;; every report yields at least :keep — "no rule matched" is a real result, not a
;; query failure.
;;
;; cond->goal takes an id-term so the same condition can be compiled with the
;; head variable "Id" (for clause bodies) or a concrete report id (for proof-tree
;; goal-by-goal re-querying in the engine).
;;
;; Precedence (top wins): exoneration evidence (appeal override) > confirmed-abuse
;; evidence (human review) > spam/abuse classification > repeated-report count >
;; default keep.

(define mod/mk-rule (fn (name action conds) {:when conds :name name :action action}))

(define mod/rule-name (fn (r) (get r :name)))
(define mod/rule-action (fn (r) (get r :action)))
(define mod/rule-when (fn (r) (get r :when)))

(define
  mod/default-rules
  (list
    (mod/mk-rule
      "exonerated-keep"
      :keep (list (list :evidence "exonerated")))
    (mod/mk-rule
      "reviewer-remove"
      :remove (list (list :evidence "confirmed-abuse")))
    (mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
    (mod/mk-rule
      "abuse-remove"
      :remove (list (list :classification "abuse")))
    (mod/mk-rule
      "repeated-escalate"
      :escalate (list (list :count-at-least 3)))
    (mod/mk-rule "default-keep" :keep (list))))

;; ── condition → Prolog goal ──
;;
;; (:classification "spam")  → classification(Id, spam)
;; (:evidence "kind")        → evidence(Id, 'kind', _)
;; (:attr "verified")        → attr(Id, verified)
;; (:not <cond>)             → not(<cond>)                        (negation)
;; (:any (list c1 c2 ...))   → (g1 ; g2 ; ...)                    (disjunction)
;; (:count-at-least 3)       → report(Id, B, S), report_count(S, N), N >= 3
;; (:score-at-least 5)       → aggregate_all(sum(W), signal(Id, _, W), T), T >= 5
;; (:reporters-at-least 2)   → report(Id, _, Sr), setof(Br, report(_, Br, Sr), Bsr),
;;                             length(Bsr, Nr), Nr >= 2   (quorum engine)
;; (:burst-at-least 3)       → report(Id, _, Sb), burst_count(Sb, Nb), Nb >= 3
;;                             (temporal engine)

(define
  mod/cond->goal
  (fn
    (c idterm)
    (let
      ((tag (first c)))
      (cond
        ((= tag :classification)
          (str "classification(" idterm ", " (nth c 1) ")"))
        ((= tag :evidence)
          (str
            "evidence("
            idterm
            ", "
            (mod/pl-quote (nth c 1))
            ", _)"))
        ((= tag :attr) (str "attr(" idterm ", " (nth c 1) ")"))
        ((= tag :not)
          (str "not(" (mod/cond->goal (nth c 1) idterm) ")"))
        ((= tag :any)
          (str
            "("
            (mod/join-with
              " ; "
              (map
                (fn (sub) (mod/cond->goal sub idterm))
                (nth c 1)))
            ")"))
        ((= tag :count-at-least)
          (str
            "report("
            idterm
            ", B, S), report_count(S, N), N >= "
            (nth c 1)))
        ((= tag :score-at-least)
          (str
            "aggregate_all(sum(W), signal("
            idterm
            ", _, W), T), T >= "
            (nth c 1)))
        ((= tag :reporters-at-least)
          (str
            "report("
            idterm
            ", _, Sr), setof(Br, report(_, Br, Sr), Bsr), "
            "length(Bsr, Nr), Nr >= "
            (nth c 1)))
        ((= tag :burst-at-least)
          (str
            "report("
            idterm
            ", _, Sb), burst_count(Sb, Nb), Nb >= "
            (nth c 1)))
        (true "true")))))

(define
  mod/conds->body
  (fn
    (conds idterm)
    (if
      (empty? conds)
      "true"
      (mod/join-with ", " (map (fn (c) (mod/cond->goal c idterm)) conds)))))

(define
  mod/rule->clause
  (fn
    (r)
    (str
      "policy_action(Id, "
      (mod/rule-action r)
      ", '"
      (mod/rule-name r)
      "') :- "
      (mod/conds->body (mod/rule-when r) "Id")
      ".")))

(define
  mod/rules->program
  (fn (rules) (mod/join-with "\n" (map mod/rule->clause rules))))