diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index 161a4a64..0a0bd7cf 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 stack quote ledger order recon federation attribution payment) +SUITES=(catalog cart price api promo stack quote ledger order recon federation attribution payment window) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -66,6 +66,7 @@ run_suite() { (load "lib/commerce/promo.sx") (load "lib/commerce/stack.sx") (load "lib/commerce/quote.sx") +(load "lib/commerce/window.sx") (load "lib/commerce/ledger.sx") (load "lib/commerce/order.sx") (load "lib/commerce/payment.sx") diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index eb9fa90f..130ac344 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -12,9 +12,10 @@ "recon": {"pass": 20, "fail": 0}, "federation": {"pass": 12, "fail": 0}, "attribution": {"pass": 16, "fail": 0}, - "payment": {"pass": 7, "fail": 0} + "payment": {"pass": 7, "fail": 0}, + "window": {"pass": 19, "fail": 0} }, - "total_pass": 209, + "total_pass": 228, "total_fail": 0, - "total": 209 + "total": 228 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index ec38636c..5db4004c 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -17,4 +17,5 @@ _Generated by `lib/commerce/conformance.sh`_ | federation | 12 | 0 | 12 | | attribution | 16 | 0 | 16 | | payment | 7 | 0 | 7 | -| **Total** | **209** | **0** | **209** | +| window | 19 | 0 | 19 | +| **Total** | **228** | **0** | **228** | diff --git a/lib/commerce/tests/window.sx b/lib/commerce/tests/window.sx new file mode 100644 index 00000000..dd3e65a8 --- /dev/null +++ b/lib/commerce/tests/window.sx @@ -0,0 +1,112 @@ +;; lib/commerce/tests/window.sx — time-windowed promotions. +;; Uses (commerce-test name got expected) provided by conformance.sh. + +(define + pcat + (make-catalog (list (list "widget" 1000 :standard)) (list) (list))) + +(define gctx (make-pricing-context pcat (list) :uk :guest)) +(define cart (list (list "widget" :none 3))) + +(define ten (list :percent "TEN" :standard 1000)) +(define twenty (list :percent "TWENTY" :standard 2000)) +(define always (list :fixed "ALWAYS" 0 100)) + +(define + windowed + (list + (windowed-promo ten 100 200) + (windowed-promo twenty 150 300) + (windowed-promo always nil nil))) + +(define exclusions (list (list "TEN" "TWENTY"))) + +;; --- wp-active? boundaries (inclusive) --- + +(commerce-test + "active-at-from" + (wp-active? (windowed-promo ten 100 200) 100) + true) +(commerce-test + "active-at-until" + (wp-active? (windowed-promo ten 100 200) 200) + true) +(commerce-test + "inactive-before" + (wp-active? (windowed-promo ten 100 200) 99) + false) +(commerce-test + "inactive-after" + (wp-active? (windowed-promo ten 100 200) 201) + false) +(commerce-test + "open-ended-always" + (wp-active? (windowed-promo always nil nil) 99999) + true) +(commerce-test + "open-lower" + (wp-active? (windowed-promo ten nil 200) 1) + true) +(commerce-test + "open-upper" + (wp-active? (windowed-promo ten 100 nil) 99999) + true) + +;; --- active-ruleset filtering --- + +(commerce-test + "active-ruleset-120" + (active-ruleset windowed 120) + (list ten always)) +(commerce-test + "active-ruleset-160" + (active-ruleset windowed 160) + (list ten twenty always)) +(commerce-test + "active-ruleset-250" + (active-ruleset windowed 250) + (list twenty always)) +(commerce-test + "active-ruleset-50" + (active-ruleset windowed 50) + (list always)) + +;; --- active-codes (backward query) --- + +(commerce-test + "active-codes-120" + (active-codes windowed 120) + (list "TEN" "ALWAYS")) +(commerce-test + "active-codes-160" + (active-codes windowed 160) + (list "TEN" "TWENTY" "ALWAYS")) +(commerce-test + "active-codes-50" + (active-codes windowed 50) + (list "ALWAYS")) + +;; --- windowed-quote: discount changes with time (deterministic) --- +;; subtotal 3000, no tax. TEN=300, TWENTY=600, ALWAYS=100; TEN/TWENTY exclusive. + +(commerce-test + "quote-50" + (quote-discount (windowed-quote gctx cart windowed exclusions 50)) + 100) +(commerce-test + "quote-120" + (quote-discount (windowed-quote gctx cart windowed exclusions 120)) + 400) +(commerce-test + "quote-160" + (quote-discount (windowed-quote gctx cart windowed exclusions 160)) + 700) +(commerce-test + "quote-250" + (quote-discount (windowed-quote gctx cart windowed exclusions 250)) + 700) + +(commerce-test + "quote-total-160" + (quote-total (windowed-quote gctx cart windowed exclusions 160)) + 2300) diff --git a/lib/commerce/window.sx b/lib/commerce/window.sx new file mode 100644 index 00000000..461ee089 --- /dev/null +++ b/lib/commerce/window.sx @@ -0,0 +1,55 @@ +;; lib/commerce/window.sx — time-windowed promotions. +;; +;; A promo's validity window is kept SEPARATE from the promo tuple (so promo.sx +;; is untouched): a windowed promo is (list promo from until) with inclusive +;; integer timestamps (same time model as the ledger `at`). nil from = no lower +;; bound; nil until = open-ended. +;; +;; `active-ruleset` filters a windowed ruleset to the plain promos live at a +;; given time, which feeds straight into promo/stack/quote — so a datetime-aware +;; quote is just the existing pipeline over the active set. Deterministic: the +;; quote is a pure function of (ctx, cart, windowed-ruleset, exclusions, at). + +(define windowed-promo (fn (promo from until) (list promo from until))) + +(define wp-promo (fn (wp) (nth wp 0))) +(define wp-from (fn (wp) (nth wp 1))) +(define wp-until (fn (wp) (nth wp 2))) + +(define + wp-active? + (fn + (wp at) + (let + ((from (wp-from wp)) (until (wp-until wp))) + (and (or (nil? from) (>= at from)) (or (nil? until) (<= at until)))))) + +;; Plain promo tuples live at time `at` — feed into cart-quote / best-promo-*. +(define + active-ruleset + (fn + (windowed at) + (map wp-promo (filter (fn (wp) (wp-active? wp at)) windowed)))) + +;; Relation: which promo codes are active at `at`? (backward query) +(define + active-promoo + (fn + (windowed at code) + (fresh + (wp) + (membero wp windowed) + (project + (wp) + (if (wp-active? wp at) (== code (promo-code (wp-promo wp))) fail))))) + +(define + active-codes + (fn (windowed at) (run* code (active-promoo windowed at code)))) + +;; Datetime-aware quote: the existing pipeline over the time-active ruleset. +(define + windowed-quote + (fn + (ctx cart windowed exclusions at) + (cart-quote ctx cart (active-ruleset windowed at) exclusions))) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index e4cdf920..f344dc0a 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` → **209/209** (13 suites; + payment) — **roadmap complete; Phase 5 extensions in progress** +`bash lib/commerce/conformance.sh` → **228/228** (14 suites; + window) — **roadmap complete; Phase 5 extensions in progress** ## Ground rules @@ -81,8 +81,9 @@ that unlocks the most tests per effort each iteration. - [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.) +- [x] time-windowed promotions — `window.sx`: windowed promo `(promo from until)`, + `active-ruleset`/`active-codes`/`windowed-quote` gate by datetime; feeds the + existing promo/stack/quote pipeline unchanged. Determinism preserved. - [ ] discount-aware tax policy — alternative `cart-quote` computing tax on the net (post-discount) base via proportional class allocation; explicit + tested. - [ ] refund as a flow — refund lifecycle (request → approve → settle) as a second @@ -96,6 +97,13 @@ that unlocks the most tests per effort each iteration. agnostic; `order-settle!(ref, amount)` is the resume seam. ## Progress log +- 2026-06-07 — `window.sx` (Phase 5 ext): time-windowed promotions. A validity + window is kept SEPARATE from the promo tuple — windowed promo `(promo from + until)` (inclusive int timestamps, nil = open bound). `active-ruleset` filters + to the plain promos live at `at` and feeds the existing promo/stack/quote + pipeline unchanged (promo.sx untouched); `active-promoo`/`active-codes` is the + backward "which codes are live at T?" query; `windowed-quote` is the + datetime-aware quote (deterministic in `at`). window suite 19/19; total 228/228. - 2026-06-07 — `payment.sx` (Phase 5 ext, the item the user asked about): provider-neutral payment-request envelope, materialised at the IO edge from the ledger amount + host-supplied currency/return-url — keeps lib/commerce vendor-