commerce: stock-constrained reservation (19 tests) — Phase 5 ext
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m17s
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>
This commit is contained in:
106
lib/commerce/stock.sx
Normal file
106
lib/commerce/stock.sx
Normal file
@@ -0,0 +1,106 @@
|
||||
;; 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))))
|
||||
Reference in New Issue
Block a user