From a9d8711101fb71521e522d9bfe977ee8e2503922 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 12:08:04 +0000 Subject: [PATCH] =?UTF-8?q?commerce:=20discount-aware=20(net)=20tax=20poli?= =?UTF-8?q?cy=20(11=20tests)=20=E2=80=94=20Phase=205=20ext?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit nettax.sx — alternative to quote.sx's gross-tax default: cart-quote-net taxes the net (post-discount) base. allocate-discount spreads the basket discount across lines by extended-price share with a deterministic largest-remainder pass so per-line shares sum exactly to the discount; each line taxed on its net at its class rate. Both policies reproducible; pick per jurisdiction. Total 239/239 across 15 suites. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/commerce/conformance.sh | 3 +- lib/commerce/nettax.sx | 80 +++++++++++++++++++++++++++++++ lib/commerce/scoreboard.json | 7 +-- lib/commerce/scoreboard.md | 3 +- lib/commerce/tests/nettax.sx | 92 ++++++++++++++++++++++++++++++++++++ plans/commerce-on-sx.md | 14 ++++-- 6 files changed, 191 insertions(+), 8 deletions(-) create mode 100644 lib/commerce/nettax.sx create mode 100644 lib/commerce/tests/nettax.sx diff --git a/lib/commerce/conformance.sh b/lib/commerce/conformance.sh index 0a0bd7cf..52ae2d5d 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 window) +SUITES=(catalog cart price api promo stack quote ledger order recon federation attribution payment window nettax) OUT_JSON="lib/commerce/scoreboard.json" OUT_MD="lib/commerce/scoreboard.md" @@ -67,6 +67,7 @@ run_suite() { (load "lib/commerce/stack.sx") (load "lib/commerce/quote.sx") (load "lib/commerce/window.sx") +(load "lib/commerce/nettax.sx") (load "lib/commerce/ledger.sx") (load "lib/commerce/order.sx") (load "lib/commerce/payment.sx") diff --git a/lib/commerce/nettax.sx b/lib/commerce/nettax.sx new file mode 100644 index 00000000..55154b8b --- /dev/null +++ b/lib/commerce/nettax.sx @@ -0,0 +1,80 @@ +;; lib/commerce/nettax.sx — discount-aware tax (alternative policy). +;; +;; price.sx / quote.sx tax the GROSS per-line amounts (discount reduces payable +;; but not the tax base). This module is the alternative explicit policy: tax the +;; NET (post-discount) base. The basket-level discount is allocated across lines +;; in proportion to each line's extended price, with a deterministic +;; largest-remainder pass so per-line shares sum EXACTLY to the discount; tax is +;; then charged on each line's net at its class rate. +;; +;; Both policies are reproducible from (ctx, cart, ruleset, exclusions); pick the +;; one the jurisdiction requires. cart-quote-net mirrors cart-quote's shape. + +(define ct-sum (fn (xs) (reduce (fn (a x) (+ a x)) 0 xs))) + +;; Add 1 to the first `rem` elements (deterministic remainder distribution). +(define + ct-add-rem + (fn + (xs rem) + (cond + ((empty? xs) (list)) + ((> rem 0) + (cons + (+ (first xs) 1) + (ct-add-rem (rest xs) (- rem 1)))) + (:else xs)))) + +;; Per-line discount allocation (parallel to cart), summing exactly to +;; total-discount, proportional to line-extended share. +(define + allocate-discount + (fn + (cat cart total-discount) + (let + ((sub (cart-subtotal cat cart))) + (if + (= sub 0) + (map (fn (l) 0) cart) + (let + ((floors (map (fn (l) (quotient (* total-discount (line-extended cat l)) sub)) cart))) + (ct-add-rem floors (- total-discount (ct-sum floors)))))))) + +;; Tax on one line's net (extended - allocated discount), clamped at 0. +(define + net-line-tax + (fn + (ctx line alloc) + (let + ((cat (ctx-catalog ctx))) + (let + ((net (- (line-extended cat line) alloc))) + (apply-bps + (if (< net 0) 0 net) + (rate-bps + (get ctx :tax-rules) + (get ctx :jurisdiction) + (catalog-class cat (line-sku line)) + (get ctx :customer))))))) + +(define + net-tax + (fn + (ctx cart allocations) + (ct-sum + (map (fn (line alloc) (net-line-tax ctx line alloc)) cart allocations)))) + +;; Discount-aware quote: tax computed on the net (post-discount) base. +(define + cart-quote-net + (fn + (ctx cart ruleset exclusions) + (let + ((cat (ctx-catalog ctx))) + (let + ((sub (cart-subtotal cat cart)) + (disc (best-promo-discount ctx cart ruleset exclusions)) + (codes (best-promo-codes ctx cart ruleset exclusions))) + (let + ((tax (net-tax ctx cart (allocate-discount cat cart disc)))) + {:codes codes :subtotal sub :discount disc :total (+ (- sub disc) tax) :tax tax}))))) diff --git a/lib/commerce/scoreboard.json b/lib/commerce/scoreboard.json index 130ac344..9f691d44 100644 --- a/lib/commerce/scoreboard.json +++ b/lib/commerce/scoreboard.json @@ -13,9 +13,10 @@ "federation": {"pass": 12, "fail": 0}, "attribution": {"pass": 16, "fail": 0}, "payment": {"pass": 7, "fail": 0}, - "window": {"pass": 19, "fail": 0} + "window": {"pass": 19, "fail": 0}, + "nettax": {"pass": 11, "fail": 0} }, - "total_pass": 228, + "total_pass": 239, "total_fail": 0, - "total": 228 + "total": 239 } diff --git a/lib/commerce/scoreboard.md b/lib/commerce/scoreboard.md index 5db4004c..15246c32 100644 --- a/lib/commerce/scoreboard.md +++ b/lib/commerce/scoreboard.md @@ -18,4 +18,5 @@ _Generated by `lib/commerce/conformance.sh`_ | attribution | 16 | 0 | 16 | | payment | 7 | 0 | 7 | | window | 19 | 0 | 19 | -| **Total** | **228** | **0** | **228** | +| nettax | 11 | 0 | 11 | +| **Total** | **239** | **0** | **239** | diff --git a/lib/commerce/tests/nettax.sx b/lib/commerce/tests/nettax.sx new file mode 100644 index 00000000..182865bd --- /dev/null +++ b/lib/commerce/tests/nettax.sx @@ -0,0 +1,92 @@ +;; lib/commerce/tests/nettax.sx — discount-aware (net) tax policy. +;; Uses (commerce-test name got expected) provided by conformance.sh. + +(define + pcat + (make-catalog + (list + (list "widget" 1000 :standard) + (list "tea" 1000 :reduced)) + (list) + (list))) + +(define + rules + (list + (list :uk :standard :guest 2000) + (list :uk :reduced :guest 500))) + +(define gctx (make-pricing-context pcat rules :uk :guest)) + +;; widget x3 = 3000 (standard), tea x6 = 6000 (reduced); subtotal 9000 +(define + cart + (list (list "widget" :none 3) (list "tea" :none 6))) + +(define ruleset (list (list :percent "TEN" :standard 1000))) + +;; --- allocation: proportional, sums exactly to the discount --- + +(commerce-test + "allocate-even" + (allocate-discount pcat cart 300) + (list 100 200)) +(commerce-test + "allocate-sums-to-discount" + (ct-sum (allocate-discount pcat cart 300)) + 300) + +;; remainder distribution: 100 over (3000,6000)/9000 = (33,66) rem 1 -> (34,66) +(commerce-test + "allocate-remainder" + (allocate-discount pcat cart 100) + (list 34 66)) +(commerce-test + "allocate-remainder-sums" + (ct-sum (allocate-discount pcat cart 100)) + 100) + +(commerce-test + "allocate-zero" + (allocate-discount pcat cart 0) + (list 0 0)) +(commerce-test + "allocate-empty" + (allocate-discount pcat empty-cart 0) + (list)) + +;; --- net tax vs gross tax --- +;; discount = TEN 10% of standard 3000 = 300, allocated (100 200). +;; net: widget 2900@20%=580, tea 5800@5%=290 -> net tax 870 (gross was 900). + +(commerce-test + "net-quote" + (cart-quote-net gctx cart ruleset (list)) + {:codes (list "TEN") :subtotal 9000 :discount 300 :total 9570 :tax 870}) + +;; same cart through the gross policy taxes 900 (the documented default) +(commerce-test + "gross-quote-for-contrast" + (quote-tax (cart-quote gctx cart ruleset (list))) + 900) + +(commerce-test + "net-tax-lower" + (quote-tax (cart-quote-net gctx cart ruleset (list))) + 870) + +;; --- no discount: net policy == gross policy --- + +(commerce-test + "no-discount-net-equals-gross" + (= + (cart-quote-net gctx cart (list) (list)) + (cart-quote gctx cart (list) (list))) + true) + +;; --- empty cart --- + +(commerce-test + "net-empty" + (cart-quote-net gctx empty-cart ruleset (list)) + {:codes (list) :subtotal 0 :discount 0 :total 0 :tax 0}) diff --git a/plans/commerce-on-sx.md b/plans/commerce-on-sx.md index f344dc0a..bb9eba79 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` → **228/228** (14 suites; + window) — **roadmap complete; Phase 5 extensions in progress** +`bash lib/commerce/conformance.sh` → **239/239** (15 suites; + nettax) — **roadmap complete; Phase 5 extensions in progress** ## Ground rules @@ -84,8 +84,9 @@ that unlocks the most tests per effort each iteration. - [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. +- [x] discount-aware tax policy — `nettax.sx`: `cart-quote-net` taxes the net + (post-discount) base; `allocate-discount` spreads the basket discount across + lines by extended share with largest-remainder so per-line shares sum exactly. - [ ] refund as a flow — refund lifecycle (request → approve → settle) as a second flow-on-sx flow, recorded in the ledger; idempotent. - [ ] stock-constrained reservation — order-begin! fails (railway `fail`) when @@ -97,6 +98,13 @@ that unlocks the most tests per effort each iteration. agnostic; `order-settle!(ref, amount)` is the resume seam. ## Progress log +- 2026-06-07 — `nettax.sx` (Phase 5 ext): discount-aware tax — the alternative to + quote.sx's gross-tax default. `cart-quote-net` taxes the NET (post-discount) + base. `allocate-discount` spreads the basket-level discount across lines in + proportion to extended price with a deterministic largest-remainder pass so + per-line shares sum EXACTLY to the discount; each line is then taxed on its net + at its class rate. Both policies reproducible from inputs; pick per jurisdiction. + nettax suite 11/11; total 239/239 (15 suites). - 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