commerce: catalog facts + multidirectional relations + conformance harness (16 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
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>
This commit is contained in:
83
lib/commerce/catalog.sx
Normal file
83
lib/commerce/catalog.sx
Normal file
@@ -0,0 +1,83 @@
|
||||
;; lib/commerce/catalog.sx — catalog snapshot + relational accessors.
|
||||
;;
|
||||
;; A catalog snapshot is an immutable dict:
|
||||
;; {:products (list (list sku price class) ...)
|
||||
;; :variants (list (list sku variant delta) ...)
|
||||
;; :stock (list (list sku variant qty) ...)}
|
||||
;;
|
||||
;; Money is integer minor units (pence/cents). class is a keyword product
|
||||
;; class consumed later by tax and promotion relations. delta is a signed
|
||||
;; price adjustment for a variant; qty is on-hand stock for (sku,variant).
|
||||
;;
|
||||
;; Accessor relations take the snapshot as the first argument and are fully
|
||||
;; multidirectional: (producto cat "widget" p c) binds p,c forward;
|
||||
;; (producto cat s 1000 c) enumerates every sku priced 1000 backward.
|
||||
|
||||
(define empty-catalog {:products (list) :stock (list) :variants (list)})
|
||||
|
||||
(define make-catalog (fn (products variants stock) {:products products :stock stock :variants variants}))
|
||||
|
||||
(define cat-products (fn (cat) (get cat :products)))
|
||||
(define cat-variants (fn (cat) (get cat :variants)))
|
||||
(define cat-stock (fn (cat) (get cat :stock)))
|
||||
|
||||
;; --- core fact relations ---
|
||||
|
||||
(define
|
||||
producto
|
||||
(fn
|
||||
(cat sku price class)
|
||||
(membero (list sku price class) (get cat :products))))
|
||||
|
||||
(define
|
||||
varianto
|
||||
(fn
|
||||
(cat sku variant delta)
|
||||
(membero (list sku variant delta) (get cat :variants))))
|
||||
|
||||
(define
|
||||
stocko
|
||||
(fn
|
||||
(cat sku variant qty)
|
||||
(membero (list sku variant qty) (get cat :stock))))
|
||||
|
||||
;; --- derived relations ---
|
||||
|
||||
(define
|
||||
priceo
|
||||
(fn (cat sku price) (fresh (c) (producto cat sku price c))))
|
||||
|
||||
(define
|
||||
classo
|
||||
(fn (cat sku class) (fresh (p) (producto cat sku p class))))
|
||||
|
||||
;; Effective unit price of a (sku,variant): base + variant delta.
|
||||
(define
|
||||
unit-priceo
|
||||
(fn
|
||||
(cat sku variant price)
|
||||
(fresh
|
||||
(base delta)
|
||||
(priceo cat sku base)
|
||||
(varianto cat sku variant delta)
|
||||
(pluso-i base delta price))))
|
||||
|
||||
;; --- deterministic lookups (first solution under fixed fact order) ---
|
||||
|
||||
(define
|
||||
catalog-price
|
||||
(fn
|
||||
(cat sku)
|
||||
(let
|
||||
((rs (run 1 p (priceo cat sku p))))
|
||||
(if (empty? rs) nil (first rs)))))
|
||||
|
||||
(define
|
||||
catalog-class
|
||||
(fn
|
||||
(cat sku)
|
||||
(let
|
||||
((rs (run 1 c (classo cat sku c))))
|
||||
(if (empty? rs) nil (first rs)))))
|
||||
|
||||
(define catalog-has? (fn (cat sku) (not (nil? (catalog-price cat sku)))))
|
||||
Reference in New Issue
Block a user