commerce: discount-aware (net) tax policy (11 tests) — Phase 5 ext
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
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) <noreply@anthropic.com>
This commit is contained in:
80
lib/commerce/nettax.sx
Normal file
80
lib/commerce/nettax.sx
Normal file
@@ -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})))))
|
||||
Reference in New Issue
Block a user