giles
29955831be
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
price.sx — cart-subtotal (unit price = base + variant delta, default 0),
taxo facts indexed by (jurisdiction, product-class, customer-class) -> bps
queried both directions, apply-bps half-up integer rounding, cart-total
returning {:subtotal :discounts :tax :total} reproducible from
(context, cart). Total 54/54.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
101 lines
2.6 KiB
Plaintext
101 lines
2.6 KiB
Plaintext
;; 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})
|