giles
25f3734eab
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
catalog.sx — catalog snapshot (products/variants/stock as fact tuples),
relational accessors (producto/varianto/stocko, derived priceo/classo/
unit-priceo) usable forward and backward, deterministic catalog-price/
-class/-has? helpers. Money is integer minor units. conformance.sh runs
suites on the miniKanren stack and emits scoreboard.{json,md}.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
94 lines
2.3 KiB
Plaintext
94 lines
2.3 KiB
Plaintext
;; lib/commerce/tests/catalog.sx — catalog facts + relational accessors.
|
|
;; Uses (commerce-test name got expected) provided by conformance.sh.
|
|
;; Query vars avoid the name `s` (the run-n macro binds `s` internally).
|
|
|
|
(define
|
|
cat
|
|
(make-catalog
|
|
(list
|
|
(list "widget" 1000 :standard)
|
|
(list "gadget" 2500 :standard)
|
|
(list "book" 800 :zero-rated)
|
|
(list "tea" 1000 :reduced))
|
|
(list
|
|
(list "widget" :small -200)
|
|
(list "widget" :large 500)
|
|
(list "gadget" :std 0))
|
|
(list
|
|
(list "widget" :small 5)
|
|
(list "widget" :large 0)
|
|
(list "gadget" :std 12))))
|
|
|
|
;; --- forward lookups ---
|
|
|
|
(commerce-test
|
|
"price-forward"
|
|
(run* p (priceo cat "widget" p))
|
|
(list 1000))
|
|
(commerce-test
|
|
"class-forward"
|
|
(run* c (classo cat "book" c))
|
|
(list :zero-rated))
|
|
(commerce-test
|
|
"product-forward"
|
|
(run* q (fresh (p c) (producto cat "gadget" p c) (== q (list p c))))
|
|
(list (list 2500 :standard)))
|
|
|
|
;; --- backward lookups (the showcase) ---
|
|
|
|
(commerce-test
|
|
"sku-by-price-backward"
|
|
(run* sk (priceo cat sk 1000))
|
|
(list "widget" "tea"))
|
|
|
|
(commerce-test
|
|
"sku-by-class-backward"
|
|
(run* sk (classo cat sk :standard))
|
|
(list "widget" "gadget"))
|
|
|
|
(commerce-test
|
|
"all-prices"
|
|
(run* p (fresh (sk) (priceo cat sk p)))
|
|
(list 1000 2500 800 1000))
|
|
|
|
;; --- variants + effective unit price ---
|
|
|
|
(commerce-test
|
|
"variant-delta-forward"
|
|
(run* d (varianto cat "widget" :small d))
|
|
(list -200))
|
|
|
|
(commerce-test
|
|
"unit-price-small"
|
|
(run* p (unit-priceo cat "widget" :small p))
|
|
(list 800))
|
|
|
|
(commerce-test
|
|
"unit-price-large"
|
|
(run* p (unit-priceo cat "widget" :large p))
|
|
(list 1500))
|
|
|
|
(commerce-test
|
|
"variant-by-delta-backward"
|
|
(run* v (varianto cat "widget" v -200))
|
|
(list :small))
|
|
|
|
;; --- stock ---
|
|
|
|
(commerce-test
|
|
"stock-forward"
|
|
(run* q (stocko cat "widget" :small q))
|
|
(list 5))
|
|
|
|
(commerce-test
|
|
"in-stock-skus-backward"
|
|
(run* sk (fresh (v q) (stocko cat sk v q) (lto-i 0 q)))
|
|
(list "widget" "gadget"))
|
|
|
|
;; --- deterministic helpers ---
|
|
|
|
(commerce-test "catalog-price-helper" (catalog-price cat "gadget") 2500)
|
|
(commerce-test "catalog-class-helper" (catalog-class cat "tea") :reduced)
|
|
(commerce-test "catalog-has-yes" (catalog-has? cat "book") true)
|
|
(commerce-test "catalog-has-no" (catalog-has? cat "nonesuch") false)
|