;; lib/commerce/tests/stock.sx — stock-constrained reservation.
;; Uses (commerce-test name got expected) provided by conformance.sh.

(define
  cat
  (make-catalog
    (list
      (list "widget" 1000 :standard)
      (list "gadget" 2500 :standard))
    (list)
    (list
      (list "widget" :small 5)
      (list "widget" :large 0)
      (list "gadget" :std 12))))

;; --- availability ---

(commerce-test
  "available-found"
  (available-stock cat "widget" :small)
  5)
(commerce-test
  "available-zero"
  (available-stock cat "widget" :large)
  0)
(commerce-test
  "available-absent"
  (available-stock cat "widget" :none)
  0)

;; --- per-line reservability ---

(commerce-test
  "shortfall-fits"
  (line-shortfall cat (list "widget" :small 5))
  0)
(commerce-test
  "shortfall-over"
  (line-shortfall cat (list "widget" :small 8))
  3)
(commerce-test
  "reservable-yes"
  (line-reservable? cat (list "gadget" :std 12))
  true)
(commerce-test
  "reservable-no"
  (line-reservable? cat (list "widget" :large 1))
  false)

;; --- cart-level reservation check ---

(commerce-test
  "can-reserve-yes"
  (can-reserve?
    cat
    (list (list "widget" :small 5) (list "gadget" :std 2)))
  true)

(commerce-test
  "can-reserve-no"
  (can-reserve? cat (list (list "widget" :small 9)))
  false)

(commerce-test
  "shortfalls-detail"
  (reservation-shortfalls
    cat
    (list (list "widget" :small 9) (list "gadget" :std 2)))
  (list {:requested 9 :available 5 :sku "widget" :variant :small :short 4}))

(commerce-test
  "reserve-check-ok"
  (reserve-check cat (list (list "gadget" :std 1)))
  :ok)

(commerce-test
  "reserve-check-rejected"
  (reserve-check cat (list (list "widget" :large 1)))
  {:shortfalls (list {:requested 1 :available 0 :sku "widget" :variant :large :short 1}) :rejected :insufficient-stock})

;; --- reservation view: concurrent holds reduce availability ---

(define held (list (list "widget" :small 3)))

(commerce-test
  "effective-after-hold"
  (effective-available cat held "widget" :small)
  2)
(commerce-test
  "effective-other-unaffected"
  (effective-available cat held "gadget" :std)
  12)
(commerce-test
  "reservable-with-fits"
  (line-reservable-with? cat held (list "widget" :small 2))
  true)
(commerce-test
  "reservable-with-over"
  (line-reservable-with? cat held (list "widget" :small 3))
  false)

;; --- relational availability query (multidirectional) ---

(commerce-test
  "sufficient-forward"
  (run*
    x
    (fresh () (sufficient-stocko cat "widget" :small 5) (== x true)))
  (list true))

(commerce-test
  "sufficient-forward-over"
  (run*
    x
    (fresh () (sufficient-stocko cat "widget" :small 6) (== x true)))
  (list))

;; backward: which variants of widget can supply 1 unit?
(commerce-test
  "variants-supplying-1"
  (run* v (fresh (q) (stocko cat "widget" v q) (lteo-i 1 q)))
  (list :small))