;; lib/commerce/stock.sx — stock-constrained reservation. ;; ;; Reservation is a precondition the host checks BEFORE order-begin! (validate → ;; begin), so the order flow stays pure orchestration. Availability is read ;; relationally from the catalog stock facts (catalog.sx stocko); a stock view ;; subtracts already-reserved quantities so concurrent orders can't over-reserve. ;; ;; can-reserve? cat cart — every line fits available stock ;; reservation-shortfalls cat cart — the lines that do not, with detail ;; effective-available cat reservations … — availability net of reservations ;; sufficient-stocko cat sku variant qty — relational "can supply qty?" query ;; Deterministic on-hand stock for a (sku,variant); 0 if absent. (define available-stock (fn (cat sku variant) (let ((rs (run 1 q (stocko cat sku variant q)))) (if (empty? rs) 0 (first rs))))) ;; Units a line cannot fulfil from on-hand stock (0 if it fits). (define line-shortfall (fn (cat line) (let ((short (- (line-qty line) (available-stock cat (line-sku line) (line-variant line))))) (if (< short 0) 0 short)))) (define line-reservable? (fn (cat line) (= (line-shortfall cat line) 0))) ;; Lines that cannot be fully reserved, each with requested/available/short. (define reservation-shortfalls (fn (cat cart) (reduce (fn (acc line) (let ((short (line-shortfall cat line))) (if (> short 0) (append acc (list {:requested (line-qty line) :available (available-stock cat (line-sku line) (line-variant line)) :sku (line-sku line) :variant (line-variant line) :short short})) acc))) (list) cart))) (define can-reserve? (fn (cat cart) (empty? (reservation-shortfalls cat cart)))) ;; Validate → reject; the host gates order-begin! on this. (define reserve-check (fn (cat cart) (if (can-reserve? cat cart) :ok {:shortfalls (reservation-shortfalls cat cart) :rejected :insufficient-stock}))) ;; --- reservation view (concurrent-safety) --- ;; reservations: list of (sku variant qty) already held. (define reserved-qty (fn (reservations sku variant) (reduce (fn (acc r) (if (and (= (first r) sku) (= (nth r 1) variant)) (+ acc (nth r 2)) acc)) 0 reservations))) ;; On-hand minus already-reserved (clamped at 0). (define effective-available (fn (cat reservations sku variant) (let ((eff (- (available-stock cat sku variant) (reserved-qty reservations sku variant)))) (if (< eff 0) 0 eff)))) ;; Can a line be reserved given existing reservations? (define line-reservable-with? (fn (cat reservations line) (<= (line-qty line) (effective-available cat reservations (line-sku line) (line-variant line))))) ;; --- relational availability query (the showcase) --- ;; Succeeds when on-hand stock for (sku,variant) covers qty. Multidirectional ;; over the stock facts: "which variants of widget can supply 5?" is a backward ;; query. (define sufficient-stocko (fn (cat sku variant qty) (fresh (avail) (stocko cat sku variant avail) (lteo-i qty avail))))