giles
a9d8711101
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>
81 lines
2.6 KiB
Plaintext
81 lines
2.6 KiB
Plaintext
;; 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})))))
|