diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index abd7cd9c..cae06db6 100755 --- a/lib/commerce/conformance.sh +++ b/lib/commerce/conformance.sh @@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(catalog cart price api promo) +SUITES=(catalog cart price api promo stack) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -48,6 +48,7 @@ run_suite() { (load "lib/commerce/price.sx") (load "lib/commerce/api.sx") (load "lib/commerce/promo.sx") +(load "lib/commerce/stack.sx") (epoch 2) (eval "(define ct-pass 0)") (eval "(define ct-fail 0)") diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 4fca48d8..e7b435ac 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -4,9 +4,10 @@ "cart": {"pass": 18, "fail": 0}, "price": {"pass": 20, "fail": 0}, "api": {"pass": 12, "fail": 0}, - "promo": {"pass": 17, "fail": 0} + "promo": {"pass": 17, "fail": 0}, + "stack": {"pass": 16, "fail": 0} }, - "total_pass": 83, + "total_pass": 99, "total_fail": 0, - "total": 83 + "total": 99 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index a631e4c2..b1009f24 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -9,4 +9,5 @@ _Generated by `lib/commerce/conformance.sh`_ | price | 20 | 0 | 20 | | api | 12 | 0 | 12 | | promo | 17 | 0 | 17 | -| **Total** | **83** | **0** | **83** | +| stack | 16 | 0 | 16 | +| **Total** | **99** | **0** | **99** | diff --git a/lib/commerce/stack.sx b/lib/commerce/stack.sx new file mode 100644 index 00000000..ff45f6c5 --- /dev/null +++ b/lib/commerce/stack.sx @@ -0,0 +1,121 @@ +;; lib/commerce/stack.sx — promotion stacking precedence + best price. +;; +;; Per the miniKanren design rule, precedence is NOT encoded inside the promo +;; rules. promo.sx enumerates which promos apply; this layer enumerates which +;; *combinations* are legal and selects the best one by an explicit cost +;; function (max total discount = min price). +;; +;; Exclusivity is a list of unordered code pairs that may not both apply: +;; exclusions = (list (list code-a code-b) ...) +;; A stacking is a subset of applicable (code amount) pairs containing no +;; excluded pair. valid-stackings enumerates them; best-stacking is the +;; deterministic selection layer; stacking-by-totalo is the backward query +;; ("which legal stacking yields this total discount?"). + +(define + excluded-pair? + (fn + (exclusions a b) + (some + (fn + (p) + (or + (and (= (first p) a) (= (nth p 1) b)) + (and (= (first p) b) (= (nth p 1) a)))) + exclusions))) + +;; True when no two distinct codes in the list are mutually excluded. +(define + compatible? + (fn + (exclusions codes) + (every? + (fn + (a) + (every? + (fn (b) (or (= a b) (not (excluded-pair? exclusions a b)))) + codes)) + codes))) + +;; All subsets of xs, preserving element order. 2^n entries. +(define + powerset + (fn + (xs) + (if + (empty? xs) + (list (list)) + (let + ((r (powerset (cdr xs)))) + (append r (map (fn (s) (cons (first xs) s)) r)))))) + +(define stacking-codes (fn (st) (map first st))) + +(define + stacking-total + (fn + (st) + (reduce (fn (acc pair) (+ acc (nth pair 1))) 0 st))) + +;; Every legal stacking of the applicable (code amount) pairs. +(define + valid-stackings + (fn + (exclusions applicable) + (filter + (fn (st) (compatible? exclusions (stacking-codes st))) + (powerset applicable)))) + +;; Deterministic selection: the legal stacking with the greatest total +;; discount; ties keep the earlier (stable) candidate, so the result is a +;; reproducible function of (exclusions, applicable). +(define + best-stacking + (fn + (exclusions applicable) + (reduce + (fn + (best st) + (if (> (stacking-total st) (stacking-total best)) st best)) + (list) + (valid-stackings exclusions applicable)))) + +(define + best-discount + (fn + (exclusions applicable) + (stacking-total (best-stacking exclusions applicable)))) + +(define + best-codes + (fn + (exclusions applicable) + (stacking-codes (best-stacking exclusions applicable)))) + +;; Backward query: legal stackings (as code lists) whose total discount = D. +(define + stacking-by-totalo + (fn + (stackings codes total) + (fresh + (st) + (membero st stackings) + (project + (st) + (mk-conj + (== codes (stacking-codes st)) + (== total (stacking-total st))))))) + +;; --- top-level entry: best discount for a cart under a ruleset --- + +(define + best-promo-discount + (fn + (ctx cart ruleset exclusions) + (best-discount exclusions (applicable-promos ctx cart ruleset)))) + +(define + best-promo-codes + (fn + (ctx cart ruleset exclusions) + (best-codes exclusions (applicable-promos ctx cart ruleset)))) diff --git a/lib/commerce/tests/stack.sx b/lib/commerce/tests/stack.sx new file mode 100644 index 00000000..07efb2c1 --- /dev/null +++ b/lib/commerce/tests/stack.sx @@ -0,0 +1,127 @@ +;; 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) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index 21b2b701..ee341f99 100644 --- a/plans/commerce-on-sx.md +++ b/plans/commerce-on-sx.md @@ -21,7 +21,7 @@ reconciliation — all auditable via the event log. ## Status (rolling) -`bash lib/commerce/conformance.sh` → **83/83** (5 suites: catalog, cart, price, api, promo) — Phase 1 done, Phase 2 in progress +`bash lib/commerce/conformance.sh` → **99/99** (6 suites: catalog, cart, price, api, promo, stack) — Phases 1-2 done ## Ground rules @@ -62,8 +62,8 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) ## Phase 2 — Promotions (relational) - [x] promo rules: percentage, fixed, bundle, member rate -- [ ] explicit stacking precedence; "best price" backward query -- [ ] tests: stacking order, mutually-exclusive promos, member vs guest +- [x] explicit stacking precedence; "best price" backward query +- [x] tests: stacking order, mutually-exclusive promos, member vs guest ## Phase 3 — Order lifecycle (flow + store) - [ ] order flow: reserve stock → await payment → fulfil @@ -76,6 +76,14 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) - [ ] tests: webhook replay, partial refund, double-charge guard ## Progress log +- 2026-06-07 — `stack.sx` (**Phase 2 complete**): stacking precedence as a + separate selection layer (precedence NOT in the rules, per the miniKanren + design rule). Exclusivity = unordered code pairs; `valid-stackings` enumerates + every legal subset of applicable promos (powerset ∖ excluded combos); + `best-stacking` is the deterministic max-total-discount selection (stable on + ties). `stacking-by-totalo` is the best-price backward query ("which legal + stacking yields total D?"). Member vs guest falls out of applicable-promos. + stack suite 16/16; total 99/99. - 2026-06-07 — `promo.sx` (Phase 2 piece 1): four promo types as tagged tuples `(:percent code class bps)`/`(:fixed code threshold amount)`/`(:bundle code sku n)`/`(:member code class bps)`. Per-promo discount is pure integer arithmetic;