commerce: time-windowed promotions (19 tests) — Phase 5 ext
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m9s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m9s
window.sx — a validity window kept separate from the promo tuple (promo.sx untouched): windowed promo (promo from until), inclusive int timestamps, nil = open bound. active-ruleset filters to promos live at `at` and feeds the existing promo/stack/quote pipeline; active-codes is the backward "which codes live at T?" query; windowed-quote is the datetime-aware, deterministic quote. Total 228/228 across 14 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -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")
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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** |
|
||||
|
||||
112
lib/commerce/tests/window.sx
Normal file
112
lib/commerce/tests/window.sx
Normal file
@@ -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)
|
||||
55
lib/commerce/window.sx
Normal file
55
lib/commerce/window.sx
Normal file
@@ -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)))
|
||||
@@ -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-
|
||||
|
||||
Reference in New Issue
Block a user