commerce: line-level discount attribution (16 tests) — Phase 5 ext

attribution.sx — the briefing's marquee "which line item triggered this
discount?" backward query. promo-lines gives each promo's pure scope
(percent/member -> class lines, bundle -> sku lines, fixed -> order-level);
promo-toucheso relates (code, line) for applying promos, run forward
(lines-for-code) and backward (codes-for-line). Additive; promo amounts
unchanged. Total 201/201 across 12 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/commerce/attribution.sx

@@ -0,0 +1,100 @@
+;; 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))))))

lib/commerce/conformance.sh

@@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then
   exit 1
 fi
 
-SUITES=(catalog cart price api promo stack quote ledger order recon federation)
+SUITES=(catalog cart price api promo stack quote ledger order recon federation attribution)
 
 OUT_JSON="lib/commerce/scoreboard.json"
 OUT_MD="lib/commerce/scoreboard.md"
@@ -70,6 +70,7 @@ run_suite() {
 (load "lib/commerce/order.sx")
 (load "lib/commerce/recon.sx")
 (load "lib/commerce/federation.sx")
+(load "lib/commerce/attribution.sx")
 (epoch 2)
 (eval "(define ct-pass 0)")
 (eval "(define ct-fail 0)")

lib/commerce/scoreboard.json

@@ -10,9 +10,10 @@
     "ledger": {"pass": 20, "fail": 0},
     "order": {"pass": 21, "fail": 0},
     "recon": {"pass": 20, "fail": 0},
-    "federation": {"pass": 12, "fail": 0}
+    "federation": {"pass": 12, "fail": 0},
+    "attribution": {"pass": 16, "fail": 0}
   },
-  "total_pass": 185,
+  "total_pass": 201,
   "total_fail": 0,
-  "total": 185
+  "total": 201
 }

lib/commerce/scoreboard.md

@@ -15,4 +15,5 @@ _Generated by `lib/commerce/conformance.sh`_
 | order | 21 | 0 | 21 |
 | recon | 20 | 0 | 20 |
 | federation | 12 | 0 | 12 |
-| **Total** | **185** | **0** | **185** |
+| attribution | 16 | 0 | 16 |
+| **Total** | **201** | **0** | **201** |

lib/commerce/tests/attribution.sx

@@ -0,0 +1,124 @@
+;; lib/commerce/tests/attribution.sx — line-level discount attribution.
+;; Uses (commerce-test name got expected) provided by conformance.sh.
+
+(define
+  pcat
+  (make-catalog
+    (list
+      (list "widget" 1000 :standard)
+      (list "gizmo" 2000 :standard)
+      (list "book" 800 :zero-rated)
+      (list "tea" 1000 :reduced))
+    (list)
+    (list)))
+
+(define gctx (make-pricing-context pcat (list) :uk :guest))
+(define mctx (make-pricing-context pcat (list) :uk :member))
+
+(define
+  cart
+  (list
+    (list "widget" :none 2)
+    (list "gizmo" :none 1)
+    (list "book" :none 1)
+    (list "tea" :none 6)))
+
+(define
+  ruleset
+  (list
+    (list :percent "TEN" :standard 1000)
+    (list :percent "TWENTY" :standard 2000)
+    (list :bundle "B3T" "tea" 3)
+    (list :fixed "FIVE" 0 500)
+    (list :member "MEM" :standard 1500)))
+
+(define w-line (list "widget" :none 2))
+(define t-line (list "tea" :none 6))
+(define bk-line (list "book" :none 1))
+
+;; --- scope helpers ---
+
+(commerce-test
+  "class-lines-standard"
+  (class-lines gctx cart :standard)
+  (list (list "widget" :none 2) (list "gizmo" :none 1)))
+
+(commerce-test
+  "promo-lines-bundle"
+  (promo-lines gctx cart (list :bundle "B3T" "tea" 3))
+  (list (list "tea" :none 6)))
+
+(commerce-test
+  "promo-lines-fixed-none"
+  (promo-lines gctx cart (list :fixed "FIVE" 0 500))
+  (list))
+
+;; --- forward: which lines does a code touch? ---
+
+(commerce-test
+  "lines-for-ten"
+  (lines-for-code gctx cart ruleset "TEN")
+  (list (list "widget" :none 2) (list "gizmo" :none 1)))
+
+(commerce-test
+  "lines-for-bundle"
+  (lines-for-code gctx cart ruleset "B3T")
+  (list (list "tea" :none 6)))
+
+(commerce-test
+  "lines-for-fixed-empty"
+  (lines-for-code gctx cart ruleset "FIVE")
+  (list))
+(commerce-test
+  "lines-for-mem-guest-empty"
+  (lines-for-code gctx cart ruleset "MEM")
+  (list))
+
+;; --- backward: which codes touch this line? (the showcase) ---
+
+(commerce-test
+  "codes-for-widget-guest"
+  (codes-for-line gctx cart ruleset w-line)
+  (list "TEN" "TWENTY"))
+
+(commerce-test
+  "codes-for-tea"
+  (codes-for-line gctx cart ruleset t-line)
+  (list "B3T"))
+(commerce-test
+  "codes-for-book-none"
+  (codes-for-line gctx cart ruleset bk-line)
+  (list))
+
+;; member sees the member rate too
+(commerce-test
+  "codes-for-widget-member"
+  (codes-for-line mctx cart ruleset w-line)
+  (list "TEN" "TWENTY" "MEM"))
+
+(commerce-test
+  "lines-for-mem-member"
+  (lines-for-code mctx cart ruleset "MEM")
+  (list (list "widget" :none 2) (list "gizmo" :none 1)))
+
+;; --- predicate ---
+
+(commerce-test
+  "touched-yes"
+  (line-touched-by? gctx cart ruleset "TEN" w-line)
+  true)
+(commerce-test
+  "touched-no-wrong-class"
+  (line-touched-by? gctx cart ruleset "B3T" w-line)
+  false)
+(commerce-test
+  "touched-no-guest-mem"
+  (line-touched-by? gctx cart ruleset "MEM" w-line)
+  false)
+
+;; --- order-level (fixed) codes ---
+
+(commerce-test
+  "order-level"
+  (order-level-codes gctx cart ruleset)
+  (list "FIVE"))

plans/commerce-on-sx.md

@@ -21,7 +21,7 @@ reconciliation — all auditable via the event log.
 
 ## Status (rolling)
 
-`bash lib/commerce/conformance.sh` → **185/185** (11 suites: catalog, cart, price, api, promo, stack, quote, ledger, order, recon, federation) — **Phases 1-4 done (roadmap complete)**
+`bash lib/commerce/conformance.sh` → **201/201** (12 suites; + attribution) — **roadmap complete; Phase 5 extensions in progress**
 
 ## Ground rules
 
@@ -78,9 +78,9 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
 ## Phase 5 — Extensions (backlog; base roadmap complete)
 Thesis-aligned deepenings of the relational/composition showcase. Pick the one
 that unlocks the most tests per effort each iteration.
-- [ ] line-level discount attribution — "which line item triggered this discount?"
-  as a backward miniKanren query (briefing gotcha; promos currently apply at
-  class level). Refactor promo amounts to also yield per-line attribution.
+- [x] line-level discount attribution — "which line item triggered this discount?"
+  as a backward miniKanren query (`attribution.sx`: `promo-toucheso` relation,
+  `lines-for-code`/`codes-for-line` both directions, `order-level-codes` for fixed).
 - [ ] time-windowed promotions — promos gated by a validity window; quote takes a
   datetime, determinism preserved. (quote.sx already documents datetime intent.)
 - [ ] discount-aware tax policy — alternative `cart-quote` computing tax on the
@@ -97,6 +97,14 @@ that unlocks the most tests per effort each iteration.
   Keeps lib/commerce provider-agnostic; enables multi-provider support in the core.
 
 ## Progress log
+- 2026-06-07 — `attribution.sx` (Phase 5 ext): line-level discount attribution —
+  the briefing's marquee "which line item triggered this discount?" query.
+  `promo-lines` is the pure per-promo scope (percent/member → class lines, bundle
+  → sku lines, fixed → order-level/none); `promo-toucheso` relates (code, line)
+  for applying promos, run forward (`lines-for-code`) and backward
+  (`codes-for-line`). `order-level-codes` lists applying fixed promos; predicate
+  `line-touched-by?`. Additive — promo.sx amounts unchanged. attribution suite
+  16/16; total 201/201 (12 suites).
 - 2026-06-07 — `recon.sx` + `federation.sx` (**Phase 4 complete — roadmap done**).
   `recon.sx`: reconciliation as relational queries over the ledger. Per-order
   summary tuples (id total paid refunded net status); `recon-statuso`/`neto`/