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)))))
|
||||
121
lib/commerce/conformance.sh
Executable file
121
lib/commerce/conformance.sh
Executable 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 ]
|
||||
8
lib/commerce/scoreboard.json
Normal file
8
lib/commerce/scoreboard.json
Normal file
@@ -0,0 +1,8 @@
|
||||
{
|
||||
"suites": {
|
||||
"catalog": {"pass": 16, "fail": 0}
|
||||
},
|
||||
"total_pass": 16,
|
||||
"total_fail": 0,
|
||||
"total": 16
|
||||
}
|
||||
8
lib/commerce/scoreboard.md
Normal file
8
lib/commerce/scoreboard.md
Normal 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** |
|
||||
93
lib/commerce/tests/catalog.sx
Normal file
93
lib/commerce/tests/catalog.sx
Normal 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)
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user