rose-ash/lib/mod/schema.sx

;; lib/mod/schema.sx — report representation + Prolog fact generation.
;;
;; A report is a dict {:id :by :about :reason :evidence :attrs}. :evidence is a
;; list of accumulated evidence entries {:kind :val} (human review, automated
;; scanners). :attrs is a list of attribute names (e.g. "verified") used by
;; negation-as-failure conditions. The engine derives keyword classifications
;; from the reason text and projects the report, its classifications, evidence,
;; and attributes into Prolog facts that policy clauses match against.

(define mod/mk-report (fn (id by about reason) {:attrs (list) :id id :by by :evidence (list) :about about :reason reason}))

(define mod/report-id (fn (r) (get r :id)))
(define mod/report-by (fn (r) (get r :by)))
(define mod/report-about (fn (r) (get r :about)))
(define mod/report-reason (fn (r) (get r :reason)))

(define
  mod/report-evidence
  (fn (r) (let ((e (get r :evidence))) (if (nil? e) (list) e))))

(define
  mod/report-attrs
  (fn (r) (let ((a (get r :attrs))) (if (nil? a) (list) a))))

(define mod/mk-evidence (fn (kind val) {:val val :kind kind}))
(define mod/evidence-kind (fn (e) (get e :kind)))
(define mod/evidence-val (fn (e) (get e :val)))

(define mod/report* (fn (r evs attrs) {:attrs attrs :id (mod/report-id r) :by (mod/report-by r) :evidence evs :about (mod/report-about r) :reason (mod/report-reason r)}))

(define
  mod/with-evidence
  (fn (r evs) (mod/report* r evs (mod/report-attrs r))))

(define
  mod/with-attrs
  (fn (r attrs) (mod/report* r (mod/report-evidence r) attrs)))

(define
  mod/attach-evidence
  (fn
    (r e)
    (mod/with-evidence r (append (mod/report-evidence r) (list e)))))

(define
  mod/attach-attr
  (fn (r a) (mod/with-attrs r (append (mod/report-attrs r) (list a)))))

;; ── substring search (the prolog-loaded env lacks includes?; slice/len do work) ──

(define
  mod/contains-at?
  (fn
    (hay needle hl nl pos)
    (if
      (< hl (+ pos nl))
      false
      (if
        (= (slice hay pos (+ pos nl)) needle)
        true
        (mod/contains-at? hay needle hl nl (+ pos 1))))))

(define
  mod/str-contains?
  (fn
    (hay needle)
    (let
      ((hl (len hay)) (nl (len needle)))
      (if
        (= nl 0)
        true
        (mod/contains-at? hay needle hl nl 0)))))

;; ── evidence derivation (keyword classification) ──

(define
  mod/spam-keywords
  (list "spam" "buy now" "click here" "free money" "viagra" "limited offer"))

(define
  mod/abuse-keywords
  (list "abuse" "harassment" "threat" "slur" "hate speech"))

(define
  mod/any?
  (fn (pred coll) (reduce (fn (acc x) (if acc acc (pred x))) false coll)))

(define
  mod/reason-matches?
  (fn
    (reason kws)
    (let
      ((low (downcase reason)))
      (mod/any? (fn (k) (mod/str-contains? low k)) kws))))

(define
  mod/classify-keywords
  (fn
    (r)
    (let
      ((reason (mod/report-reason r)) (kinds (list)))
      (begin
        (when
          (mod/reason-matches? reason mod/spam-keywords)
          (append! kinds "spam"))
        (when
          (mod/reason-matches? reason mod/abuse-keywords)
          (append! kinds "abuse"))
        kinds))))

(define
  mod/report-count
  (fn
    (about reports)
    (reduce
      (fn
        (acc r)
        (if (= (mod/report-about r) about) (+ acc 1) acc))
      0
      reports)))

;; ── Prolog fact projection ──

(define
  mod/join-with
  (fn
    (sep items)
    (reduce (fn (acc x) (if (= acc "") x (str acc sep x))) "" items)))

(define mod/pl-quote (fn (s) (str "'" s "'")))

(define
  mod/classification-facts
  (fn
    (id kinds)
    (mod/join-with
      "\n"
      (map (fn (k) (str "classification(" id ", " k ").")) kinds))))

(define
  mod/evidence-facts
  (fn
    (id evs)
    (mod/join-with
      "\n"
      (map
        (fn
          (e)
          (str
            "evidence("
            id
            ", "
            (mod/pl-quote (mod/evidence-kind e))
            ", "
            (mod/pl-quote (str (mod/evidence-val e)))
            ")."))
        evs))))

(define
  mod/attr-facts
  (fn
    (id attrs)
    (mod/join-with "\n" (map (fn (a) (str "attr(" id ", " a ").")) attrs))))

(define
  mod/report-facts
  (fn
    (r count)
    (let
      ((id (mod/report-id r))
        (by (mod/pl-quote (mod/report-by r)))
        (about (mod/pl-quote (mod/report-about r))))
      (let
        ((cls (mod/classification-facts id (mod/classify-keywords r)))
          (evs (mod/evidence-facts id (mod/report-evidence r)))
          (ats (mod/attr-facts id (mod/report-attrs r))))
        (mod/join-with
          "\n"
          (list
            (str "report(" id ", " by ", " about ").")
            (str "report_count(" about ", " count ").")
            cls
            evs
            ats))))))