diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index b0a75fa7..a0975685 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) +SUITES=(catalog cart price) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -45,6 +45,7 @@ run_suite() { (load "lib/minikanren/defrel.sx") (load "lib/commerce/catalog.sx") (load "lib/commerce/cart.sx") +(load "lib/commerce/price.sx") (epoch 2) (eval "(define ct-pass 0)") (eval "(define ct-fail 0)") diff --git a/lib/commerce/price.sx b/lib/commerce/price.sx new file mode 100644 index 00000000..a9666ad7 --- /dev/null +++ b/lib/commerce/price.sx @@ -0,0 +1,110 @@ +;; lib/commerce/price.sx — deterministic subtotal + jurisdiction-relational tax. +;; +;; A pricing context bundles the inputs that make a total reproducible: +;; {:catalog CAT :tax-rules RULES :jurisdiction J :customer C} +;; Same context + same cart => identical total, every run. +;; +;; Tax is NOT a hardcoded VAT rate. Rules are facts indexed by +;; (jurisdiction, product-class, customer-class) -> rate-bps +;; where rate-bps is an integer in basis points (2000 = 20%). taxo queries +;; them multidirectionally. Money stays in integer minor units; rounding is +;; half-up per line via integer arithmetic only — never floats. + +(define + make-pricing-context + (fn (catalog tax-rules jurisdiction customer) {:customer customer :jurisdiction jurisdiction :catalog catalog :tax-rules tax-rules})) + +(define ctx-catalog (fn (ctx) (get ctx :catalog))) + +;; --- unit + line pricing --- + +;; Variant delta, defaulting to 0 when the (sku,variant) has no variant fact. +(define + variant-delta + (fn + (cat sku variant) + (let + ((rs (run 1 d (varianto cat sku variant d)))) + (if (empty? rs) 0 (first rs))))) + +;; Effective unit price = base price + variant delta. nil if sku unknown. +(define + line-unit-price + (fn + (cat sku variant) + (let + ((base (catalog-price cat sku))) + (if (nil? base) nil (+ base (variant-delta cat sku variant)))))) + +;; Extended (line) price = unit price * quantity. +(define + line-extended + (fn + (cat line) + (* + (line-unit-price cat (line-sku line) (line-variant line)) + (line-qty line)))) + +(define + cart-subtotal + (fn + (cat cart) + (reduce (fn (acc l) (+ acc (line-extended cat l))) 0 cart))) + +;; --- tax (jurisdiction-relational) --- + +;; rules: (list (list jurisdiction class customer bps) ...) +(define + taxo + (fn + (rules juris class cust bps) + (membero (list juris class cust bps) rules))) + +;; Deterministic rate lookup; 0 when no rule matches. +(define + rate-bps + (fn + (rules juris class cust) + (let + ((rs (run 1 b (taxo rules juris class cust b)))) + (if (empty? rs) 0 (first rs))))) + +;; Apply a basis-point rate to an integer amount, rounding half up. +(define + apply-bps + (fn (amount bps) (quotient (+ (* amount bps) 5000) 10000))) + +(define + line-tax + (fn + (ctx line) + (let + ((cat (ctx-catalog ctx))) + (let + ((class (catalog-class cat (line-sku line)))) + (apply-bps + (line-extended cat line) + (rate-bps + (get ctx :tax-rules) + (get ctx :jurisdiction) + class + (get ctx :customer))))))) + +(define + cart-tax + (fn + (ctx cart) + (reduce (fn (acc l) (+ acc (line-tax ctx l))) 0 cart))) + +;; --- total --- + +;; Returns {:subtotal :discounts :tax :total}. discounts is 0 until Phase 2. +(define + cart-total + (fn + (ctx cart) + (let + ((cat (ctx-catalog ctx))) + (let + ((sub (cart-subtotal cat cart)) (tax (cart-tax ctx cart))) + {:subtotal sub :discounts 0 :total (+ sub tax) :tax tax})))) diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 93ae49ab..3fba68ed 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -1,9 +1,10 @@ { "suites": { "catalog": {"pass": 16, "fail": 0}, - "cart": {"pass": 18, "fail": 0} + "cart": {"pass": 18, "fail": 0}, + "price": {"pass": 20, "fail": 0} }, - "total_pass": 34, + "total_pass": 54, "total_fail": 0, - "total": 34 + "total": 54 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index f6530b99..95bb8501 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -6,4 +6,5 @@ _Generated by `lib/commerce/conformance.sh`_ |-------|-----:|-----:|------:| | catalog | 16 | 0 | 16 | | cart | 18 | 0 | 18 | -| **Total** | **34** | **0** | **34** | +| price | 20 | 0 | 20 | +| **Total** | **54** | **0** | **54** | diff --git a/lib/commerce/tests/price.sx b/lib/commerce/tests/price.sx new file mode 100644 index 00000000..0ba06e0c --- /dev/null +++ b/lib/commerce/tests/price.sx @@ -0,0 +1,100 @@ +;; lib/commerce/tests/price.sx — subtotal + jurisdiction-relational tax. +;; 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 "widget" :small -200) + (list "widget" :large 500)) + (list))) + +(define + rules + (list + (list :uk :standard :guest 2000) + (list :uk :reduced :guest 500) + (list :uk :zero-rated :guest 0) + (list :uk :standard :member 1000) + (list :ie :standard :guest 2300))) + +(define gctx (make-pricing-context pcat rules :uk :guest)) +(define mctx (make-pricing-context pcat rules :uk :member)) + +;; --- unit + line pricing --- + +(commerce-test + "unit-price-variant" + (line-unit-price pcat "widget" :small) + 800) +(commerce-test + "unit-price-no-variant" + (line-unit-price pcat "widget" :none) + 1000) +(commerce-test "unit-price-unknown" (line-unit-price pcat "ghost" :none) nil) +(commerce-test + "line-extended" + (line-extended pcat (list "widget" :small 2)) + 1600) + +;; --- subtotal --- + +(define + cart1 + (list (list "widget" :small 2) (list "book" :none 1))) + +(commerce-test "subtotal" (cart-subtotal pcat cart1) 2400) +(commerce-test "subtotal-empty" (cart-subtotal pcat empty-cart) 0) + +;; --- tax rate lookup (relational, both directions) --- + +(commerce-test + "rate-forward" + (rate-bps rules :uk :standard :guest) + 2000) +(commerce-test + "rate-missing" + (rate-bps rules :fr :standard :guest) + 0) +(commerce-test + "rate-juris-by-bps-backward" + (run* j (fresh (cust) (taxo rules j :standard cust 2300))) + (list :ie)) +(commerce-test + "rate-customer-by-bps-backward" + (run* cust (taxo rules :uk :standard cust 1000)) + (list :member)) + +;; --- apply-bps rounding (half up, integer only) --- + +(commerce-test "bps-exact" (apply-bps 1600 2000) 320) +(commerce-test "bps-round-up" (apply-bps 799 2000) 160) +(commerce-test "bps-zero" (apply-bps 800 0) 0) + +;; --- line + cart tax --- + +(commerce-test + "line-tax-standard" + (line-tax gctx (list "widget" :small 2)) + 320) +(commerce-test + "line-tax-zero-rated" + (line-tax gctx (list "book" :none 1)) + 0) +(commerce-test + "line-tax-member" + (line-tax mctx (list "widget" :small 2)) + 160) +(commerce-test "cart-tax-guest" (cart-tax gctx cart1) 320) + +;; --- total dict (deterministic) --- + +(commerce-test "total-guest" (cart-total gctx cart1) {:subtotal 2400 :discounts 0 :total 2720 :tax 320}) + +(commerce-test "total-member" (cart-total mctx cart1) {:subtotal 2400 :discounts 0 :total 2560 :tax 160}) + +(commerce-test "total-empty" (cart-total gctx empty-cart) {:subtotal 0 :discounts 0 :total 0 :tax 0}) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index c0408b66..58125180 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` → **34/34** (2 suites: catalog, cart) +`bash lib/commerce/conformance.sh` → **54/54** (3 suites: catalog, cart, price) ## Ground rules @@ -57,7 +57,7 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) ## Phase 1 — Catalog + cart + deterministic totals - [x] `catalog.sx` — product/variant/stock as facts - [x] `cart.sx` — line items, add/remove/qty -- [ ] `price.sx` — base pricing relation, subtotal; tax +- [x] `price.sx` — base pricing relation, subtotal; tax - [ ] `api.sx` + tests + scoreboard + conformance.sh ## Phase 2 — Promotions (relational) @@ -76,6 +76,13 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout) - [ ] tests: webhook replay, partial refund, double-charge guard ## Progress log +- 2026-06-06 — `price.sx`: deterministic `cart-subtotal` (Σ unit×qty, variant + delta defaults 0) + jurisdiction-relational tax. `taxo` facts indexed by + (jurisdiction, product-class, customer-class)→bps, queried multidirectionally; + `apply-bps` rounds half-up with integer arithmetic only. `cart-total` returns + `{:subtotal :discounts :tax :total}` (discounts 0 until Phase 2), reproducible + from (context, cart). `=` does structural dict equality (order-independent), so + total dicts compare directly. price suite 20/20; total 54/54. - 2026-06-06 — `cart.sx`: cart as an ordered list of (sku variant qty) lines. Pure ops `cart-add` (merges same line / appends), `cart-set-qty` (0 removes), `cart-remove`, plus `cart-qty`/`cart-count`/`cart-skus`/`cart-empty?`.