;; lib/commerce/attribution.sx — line-level discount attribution.
;;
;; The briefing's marquee backward query: "which line item triggered this
;; discount?". promo.sx computes discount amounts at the class/order level;
;; this layer answers the *scope* question relationally and in both directions:
;;   forward  — which lines does code C touch?   (lines-for-code)
;;   backward — which codes touch this line?     (codes-for-line)
;; Both are the same relation promo-toucheso run with different vars bound.
;;
;; A :fixed promo is order-level (touches no single line); query those with
;; order-level-codes. Only promos that actually apply (amount > 0) touch lines.

;; Lines whose sku is in product-class `cls`.
(define
  class-lines
  (fn
    (ctx cart cls)
    (filter
      (fn (l) (= (catalog-class (ctx-catalog ctx) (line-sku l)) cls))
      cart)))

;; The lines a promo applies to (its scope). :fixed is order-level → no lines.
(define
  promo-lines
  (fn
    (ctx cart p)
    (let
      ((k (promo-kind p)))
      (cond
        ((= k :percent) (class-lines ctx cart (nth p 2)))
        ((= k :member)
          (if
            (= (get ctx :customer) :member)
            (class-lines ctx cart (nth p 2))
            (list)))
        ((= k :bundle)
          (filter (fn (l) (= (line-sku l) (nth p 2))) cart))
        (:else (list))))))

;; Relation: promo `code` touches `line`. Only applying promos (amount > 0)
;; touch anything, so an inapplicable promo contributes no pairs.
(define
  promo-toucheso
  (fn
    (ctx cart ruleset code line)
    (fresh
      (p)
      (membero p ruleset)
      (project
        (p)
        (if
          (> (promo-amount ctx cart p) 0)
          (mk-conj
            (== code (promo-code p))
            (membero line (promo-lines ctx cart p)))
          fail)))))

;; --- query helpers ---

(define
  lines-for-code
  (fn
    (ctx cart ruleset code)
    (run* line (promo-toucheso ctx cart ruleset code line))))

(define
  codes-for-line
  (fn
    (ctx cart ruleset line)
    (run* code (promo-toucheso ctx cart ruleset code line))))

(define
  line-touched-by?
  (fn
    (ctx cart ruleset code line)
    (not
      (empty?
        (run
          1
          c
          (mk-conj (promo-toucheso ctx cart ruleset code line) (== c true)))))))

;; Applying order-level (:fixed) promos — discounts with no single line.
(define
  order-level-codes
  (fn
    (ctx cart ruleset)
    (run*
      code
      (fresh
        (p)
        (membero p ruleset)
        (project
          (p)
          (if
            (and
              (> (promo-amount ctx cart p) 0)
              (= (promo-kind p) :fixed))
            (== code (promo-code p))
            fail))))))