;; 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}))))