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>
111 lines
2.9 KiB
Plaintext
111 lines
2.9 KiB
Plaintext
;; 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}))))
|