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>
84 lines
2.2 KiB
Plaintext
84 lines
2.2 KiB
Plaintext
;; 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)))))
|