commerce: catalog facts + multidirectional relations + conformance harness (16 tests)
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:
2026-06-06 23:41:04 +00:00
parent d446562ed1
commit 25f3734eab
6 changed files with 323 additions and 4 deletions

83
lib/commerce/catalog.sx Normal file
View 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)))))

121
lib/commerce/conformance.sh Executable file
View File

@@ -0,0 +1,121 @@
#!/usr/bin/env bash
# lib/commerce/conformance.sh — run commerce test suites in one sx_server
# process per suite, emit scoreboard.json + scoreboard.md.
#
# commerce-on-sx builds pricing/promotion as miniKanren relations, so every
# suite loads the miniKanren stack first, then the commerce modules.
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
SUITES=(catalog)
OUT_JSON="lib/commerce/scoreboard.json"
OUT_MD="lib/commerce/scoreboard.md"
run_suite() {
local suite=$1
local file="lib/commerce/tests/${suite}.sx"
local TMP
TMP=$(mktemp)
cat > "$TMP" << EPOCHS
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/r7rs.sx")
(load "lib/guest/match.sx")
(load "lib/minikanren/unify.sx")
(load "lib/minikanren/stream.sx")
(load "lib/minikanren/goals.sx")
(load "lib/minikanren/fresh.sx")
(load "lib/minikanren/conde.sx")
(load "lib/minikanren/run.sx")
(load "lib/minikanren/relations.sx")
(load "lib/minikanren/project.sx")
(load "lib/minikanren/intarith.sx")
(load "lib/minikanren/matche.sx")
(load "lib/minikanren/defrel.sx")
(load "lib/commerce/catalog.sx")
(epoch 2)
(eval "(define ct-pass 0)")
(eval "(define ct-fail 0)")
(eval "(define ct-fails (list))")
(eval "(define commerce-test (fn (name got expected) (if (= got expected) (set! ct-pass (+ ct-pass 1)) (begin (set! ct-fail (+ ct-fail 1)) (append! ct-fails name)))))")
(epoch 3)
(load "${file}")
(epoch 4)
(eval "(list ct-pass ct-fail)")
(eval "ct-fails")
EPOCHS
local OUTPUT
OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null)
rm -f "$TMP"
# The (list ct-pass ct-fail) result follows its (ok-len 2 N) ack line.
local LINE
LINE=$(echo "$OUTPUT" | grep -oE '^\([0-9]+ [0-9]+\)$' | tail -1)
local P F
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\)$/\1/')
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\)$/\2/')
P=${P:-0}
F=${F:-0}
echo "${P} ${F}"
}
declare -A SUITE_PASS
declare -A SUITE_FAIL
TOTAL_PASS=0
TOTAL_FAIL=0
echo "Running commerce conformance suite..." >&2
for s in "${SUITES[@]}"; do
read -r p f < <(run_suite "$s")
SUITE_PASS[$s]=$p
SUITE_FAIL[$s]=$f
TOTAL_PASS=$((TOTAL_PASS + p))
TOTAL_FAIL=$((TOTAL_FAIL + f))
printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2
done
{
printf '{\n'
printf ' "suites": {\n'
first=1
for s in "${SUITES[@]}"; do
if [ $first -eq 0 ]; then printf ',\n'; fi
printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}"
first=0
done
printf '\n },\n'
printf ' "total_pass": %d,\n' "$TOTAL_PASS"
printf ' "total_fail": %d,\n' "$TOTAL_FAIL"
printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))"
printf '}\n'
} > "$OUT_JSON"
{
printf '# commerce Conformance Scoreboard\n\n'
printf '_Generated by `lib/commerce/conformance.sh`_\n\n'
printf '| Suite | Pass | Fail | Total |\n'
printf '|-------|-----:|-----:|------:|\n'
for s in "${SUITES[@]}"; do
p=${SUITE_PASS[$s]}
f=${SUITE_FAIL[$s]}
printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))"
done
printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))"
} > "$OUT_MD"
echo "Wrote $OUT_JSON and $OUT_MD" >&2
echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2
[ "$TOTAL_FAIL" -eq 0 ]

View File

@@ -0,0 +1,8 @@
{
"suites": {
"catalog": {"pass": 16, "fail": 0}
},
"total_pass": 16,
"total_fail": 0,
"total": 16
}

View File

@@ -0,0 +1,8 @@
# commerce Conformance Scoreboard
_Generated by `lib/commerce/conformance.sh`_
| Suite | Pass | Fail | Total |
|-------|-----:|-----:|------:|
| catalog | 16 | 0 | 16 |
| **Total** | **16** | **0** | **16** |

View File

@@ -0,0 +1,93 @@
;; 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)

View File

@@ -21,7 +21,7 @@ reconciliation — all auditable via the event log.
## Status (rolling)
`bash lib/commerce/conformance.sh`**0/0** (not yet started)
`bash lib/commerce/conformance.sh`**16/16** (1 suite: catalog)
## Ground rules
@@ -55,7 +55,7 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
```
## Phase 1 — Catalog + cart + deterministic totals
- [ ] `catalog.sx` — product/variant/stock as facts
- [x] `catalog.sx` — product/variant/stock as facts
- [ ] `cart.sx` — line items, add/remove/qty
- [ ] `price.sx` — base pricing relation, subtotal; tax
- [ ] `api.sx` + tests + scoreboard + conformance.sh
@@ -76,7 +76,13 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
- [ ] tests: webhook replay, partial refund, double-charge guard
## Progress log
(loop fills this in)
- 2026-06-06 — `catalog.sx`: catalog snapshot (products/variants/stock as fact
tuples) + multidirectional accessor relations (`producto`/`varianto`/`stocko`,
derived `priceo`/`classo`/`unit-priceo`) + deterministic `catalog-price`/
`-class`/`-has?` helpers. `conformance.sh` harness + scoreboard. catalog suite
16/16. Gotcha: minikanren `run-n` macro binds `s` internally — query vars must
avoid `s`; tests compare reified results with `=` (not `equal?`, which fails on
reified lists). Money = integer minor units throughout.
## Blockers
(loop fills this in)
(none)