giles
da349b169e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m17s
stock.sx — reservation as a precondition the host checks before order-begin! (validate -> begin), keeping the flow pure. available-stock reads catalog stock facts; can-reserve?/reserve-check/reservation-shortfalls gate a cart; effective-available nets out concurrent reservations so orders can't over-reserve; sufficient-stocko is the multidirectional availability query. Total 258/258 across 16 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
107 lines
3.2 KiB
Plaintext
107 lines
3.2 KiB
Plaintext
;; 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))))
|