;;~ title    "Merchant violations · hourly triage"
;;~ author   "lacuna"
;;~ version  1
;;~ mode     automation
;;~ flavor   purple
;;~ id       merchant-violations-triage
;;~ touches  (google-merchant)
;;~ summary  "Hourly cron. Pulls list_violations from Google, surfaces new violations as Sakura analysis cards. Each card carries the operator-actionable verbs (fix it / dismiss / hide-forever). Tier-gated to Magic+; quiet-hours-respecting."

;; Hourly triage. The cart subscribes to a cron trigger; the surface
;; reads the resulting cards off the analysis bus and renders them.
;; Cards are grouped by issue type per the GMC plan doc §6 (one card
;; per issue type, not per listing — "Google flagged 3 listings —
;; antique without provenance" reads better than three separate cards).
;;
;; Idempotency: each violation has a stable (product_id, issue_code)
;; key. The cart writes to Cortex with that key; subsequent runs are
;; no-ops for unchanged violations. The operator's hide-forever pref
;; is stored alongside so a dismissed violation never re-surfaces.

(cart 'merchant-violations-triage
  '((author    . "lacuna")
    (version   . 1)
    (touches   . (google-merchant))
    (read-only . #f)))

;; ── start — gate on merchant connection ────────────────────────
;; If the operator isn't connected to GMC, this cron is a no-op.
;; We don't escalate because there's no operator-actionable thing to
;; surface — the cron just exits clean.
(define (start ctx)
  (act 'merchant_center.status '() 'check-merchant-result))

(define (check-merchant-result ctx)
  (let ((status (ctx-result ctx)))
    (cond
      ((not (status-connected? status)) (done))
      ((status-pending-verification? status) (done))
      (else (next 'fetch ctx)))))

;; ── fetch — pull the violations list from Google ──────────────
(define (fetch ctx)
  (act 'merchant_center/violations '() 'check-fetch))

(define (check-fetch ctx)
  (let ((r (ctx-result ctx)))
    (cond
      ((null? r)              (done))
      ((eq? r 'rate-limited)  (after 60 'fetch ctx))
      ((violations-error? r)  (escalate 'fetch-failed (violations-error-detail r)))
      (else                   (next 'group (ctx-set 'violations r ctx))))))

;; ── group — bucket by issue code ──────────────────────────────
;; "antique without provenance" gets one card; "image_link_broken"
;; gets another. Operators triage by issue type because the fix is
;; usually the same across products with the same issue.
(define (group ctx)
  (let* ((rows    (ctx-get 'violations ctx))
         (buckets (group-by 'issue_code rows)))
    (next 'surface (ctx-set 'buckets buckets ctx))))

;; ── surface — emit analysis cards ─────────────────────────────
;; One card per bucket. Each card carries:
;;   · the issue code + human description
;;   · the list of affected product_ids (links into the listing drawer)
;;   · the three Sakura verbs (Act / Dismiss / Hide-forever)
;;   · a pre-filled suggested edit when one is available
;;
;; The surface reads these off the cart bus and renders them in the
;; Analysis tab; the cart itself is done as soon as the events fire.
(define (surface ctx)
  (let loop ((buckets (ctx-get 'buckets ctx)))
    (if (null? buckets)
        (done)
        (let ((bucket (car buckets)))
          (analysis-card
            (bucket-issue-code bucket)
            (bucket-description bucket)
            (bucket-product-ids bucket)
            (bucket-suggested-fix bucket))
          (loop (cdr buckets))))))