giles
563fac9e62
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
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>
125 lines
2.9 KiB
Plaintext
125 lines
2.9 KiB
Plaintext
;; 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"))
|