giles
f71af498cf
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
stack.sx — precedence as a separate selection layer, not in the rules. Exclusivity = unordered code pairs; valid-stackings enumerates every legal subset of applicable promos; best-stacking deterministically picks max total discount (stable on ties); stacking-by-totalo answers "which legal stacking yields total D?" backward. Member vs guest falls out of applicable-promos. Completes Phase 2. Total 99/99 across 6 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
128 lines
2.9 KiB
Plaintext
128 lines
2.9 KiB
Plaintext
;; lib/commerce/tests/stack.sx — stacking precedence, exclusivity, best price.
|
|
;; Uses (commerce-test name got expected) provided by conformance.sh.
|
|
|
|
(define
|
|
pcat
|
|
(make-catalog
|
|
(list
|
|
(list "widget" 1000 :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 3)
|
|
(list "book" :none 1)
|
|
(list "tea" :none 6)))
|
|
|
|
(define
|
|
ruleset
|
|
(list
|
|
(list :percent "TEN" :standard 1000)
|
|
(list :percent "TWENTY" :standard 2000)
|
|
(list :fixed "FIVER" 5000 500)
|
|
(list :bundle "B3T" "tea" 3)
|
|
(list :member "MEM" :standard 2500)))
|
|
|
|
;; The three standard-class discounts are mutually exclusive.
|
|
(define
|
|
exclusions
|
|
(list (list "TEN" "TWENTY") (list "TEN" "MEM") (list "TWENTY" "MEM")))
|
|
|
|
;; --- exclusivity predicates ---
|
|
|
|
(commerce-test
|
|
"excluded-pair-direct"
|
|
(excluded-pair? exclusions "TEN" "TWENTY")
|
|
true)
|
|
(commerce-test
|
|
"excluded-pair-symmetric"
|
|
(excluded-pair? exclusions "TWENTY" "TEN")
|
|
true)
|
|
(commerce-test
|
|
"excluded-pair-none"
|
|
(excluded-pair? exclusions "TEN" "FIVER")
|
|
false)
|
|
(commerce-test
|
|
"compatible-yes"
|
|
(compatible? exclusions (list "FIVER" "B3T" "TWENTY"))
|
|
true)
|
|
(commerce-test
|
|
"compatible-no"
|
|
(compatible? exclusions (list "TEN" "TWENTY" "B3T"))
|
|
false)
|
|
|
|
;; --- powerset + valid stackings ---
|
|
|
|
(commerce-test
|
|
"powerset-size"
|
|
(len (powerset (list 1 2 3 4)))
|
|
16)
|
|
|
|
(define gappl (applicable-promos gctx cart ruleset))
|
|
|
|
(commerce-test "applicable-guest-count" (len gappl) 4)
|
|
|
|
;; 16 subsets minus the 4 containing both TEN and TWENTY = 12 legal.
|
|
(commerce-test
|
|
"valid-stackings-count"
|
|
(len (valid-stackings exclusions gappl))
|
|
12)
|
|
|
|
(commerce-test
|
|
"stacking-total"
|
|
(stacking-total (list (list "TWENTY" 600) (list "B3T" 2000)))
|
|
2600)
|
|
|
|
;; --- best price (deterministic selection) ---
|
|
|
|
(commerce-test
|
|
"best-discount-guest"
|
|
(best-promo-discount gctx cart ruleset exclusions)
|
|
3100)
|
|
(commerce-test
|
|
"best-codes-guest"
|
|
(best-promo-codes gctx cart ruleset exclusions)
|
|
(list "TWENTY" "FIVER" "B3T"))
|
|
|
|
;; exclusivity holds: the cheaper conflicting code is dropped.
|
|
(commerce-test
|
|
"best-excludes-ten"
|
|
(some
|
|
(fn (c) (= c "TEN"))
|
|
(best-promo-codes gctx cart ruleset exclusions))
|
|
false)
|
|
|
|
;; --- member vs guest ---
|
|
|
|
(commerce-test
|
|
"best-discount-member"
|
|
(best-promo-discount mctx cart ruleset exclusions)
|
|
3250)
|
|
(commerce-test
|
|
"best-codes-member"
|
|
(best-promo-codes mctx cart ruleset exclusions)
|
|
(list "FIVER" "B3T" "MEM"))
|
|
|
|
;; --- best price backward query (the showcase) ---
|
|
|
|
(commerce-test
|
|
"stacking-by-total-backward"
|
|
(run*
|
|
codes
|
|
(stacking-by-totalo (valid-stackings exclusions gappl) codes 3100))
|
|
(list (list "TWENTY" "FIVER" "B3T")))
|
|
|
|
;; --- edge: no applicable promos ---
|
|
|
|
(commerce-test
|
|
"best-empty"
|
|
(best-promo-discount gctx empty-cart ruleset exclusions)
|
|
0)
|