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