commerce: cart line items + add/remove/set-qty + relational view (18 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
cart.sx — cart as an ordered list of (sku variant qty) lines. Pure operations: cart-add (merge-or-append), cart-set-qty (0 removes), cart-remove, with cart-qty/count/skus/empty? accessors. cart-lineo exposes lines relationally via membero. Total 34/34. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
86
lib/commerce/cart.sx
Normal file
86
lib/commerce/cart.sx
Normal file
@@ -0,0 +1,86 @@
|
|||||||
|
;; lib/commerce/cart.sx — cart as an ordered list of line items.
|
||||||
|
;;
|
||||||
|
;; A cart is a native list of lines; a line is (list sku variant qty).
|
||||||
|
;; All operations are pure: they return a new cart, never mutate. Line
|
||||||
|
;; order is insertion order (stable) so totals are reproducible.
|
||||||
|
;;
|
||||||
|
;; cart-lineo is the relational view — because a line *is* a (sku variant qty)
|
||||||
|
;; tuple, membero queries the cart directly, forward or backward.
|
||||||
|
|
||||||
|
(define empty-cart (list))
|
||||||
|
|
||||||
|
(define make-line (fn (sku variant qty) (list sku variant qty)))
|
||||||
|
(define line-sku (fn (l) (nth l 0)))
|
||||||
|
(define line-variant (fn (l) (nth l 1)))
|
||||||
|
(define line-qty (fn (l) (nth l 2)))
|
||||||
|
|
||||||
|
(define
|
||||||
|
same-line?
|
||||||
|
(fn
|
||||||
|
(l sku variant)
|
||||||
|
(and (= (line-sku l) sku) (= (line-variant l) variant))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
cart-qty
|
||||||
|
(fn
|
||||||
|
(cart sku variant)
|
||||||
|
(let
|
||||||
|
((m (filter (fn (l) (same-line? l sku variant)) cart)))
|
||||||
|
(if (empty? m) 0 (line-qty (first m))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
cart-remove
|
||||||
|
(fn
|
||||||
|
(cart sku variant)
|
||||||
|
(filter (fn (l) (not (same-line? l sku variant))) cart)))
|
||||||
|
|
||||||
|
;; Add qty units; merges into an existing (sku,variant) line in place,
|
||||||
|
;; otherwise appends a new line at the end.
|
||||||
|
(define
|
||||||
|
cart-add
|
||||||
|
(fn
|
||||||
|
(cart sku variant qty)
|
||||||
|
(let
|
||||||
|
((existing (cart-qty cart sku variant)))
|
||||||
|
(if
|
||||||
|
(= existing 0)
|
||||||
|
(append cart (list (make-line sku variant qty)))
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(l)
|
||||||
|
(if
|
||||||
|
(same-line? l sku variant)
|
||||||
|
(make-line sku variant (+ existing qty))
|
||||||
|
l))
|
||||||
|
cart)))))
|
||||||
|
|
||||||
|
;; Set the absolute quantity; qty <= 0 removes the line.
|
||||||
|
(define
|
||||||
|
cart-set-qty
|
||||||
|
(fn
|
||||||
|
(cart sku variant qty)
|
||||||
|
(if
|
||||||
|
(<= qty 0)
|
||||||
|
(cart-remove cart sku variant)
|
||||||
|
(if
|
||||||
|
(= (cart-qty cart sku variant) 0)
|
||||||
|
(append cart (list (make-line sku variant qty)))
|
||||||
|
(map
|
||||||
|
(fn
|
||||||
|
(l)
|
||||||
|
(if (same-line? l sku variant) (make-line sku variant qty) l))
|
||||||
|
cart)))))
|
||||||
|
|
||||||
|
(define cart-empty? (fn (cart) (empty? cart)))
|
||||||
|
(define cart-lines (fn (cart) cart))
|
||||||
|
(define cart-skus (fn (cart) (map line-sku cart)))
|
||||||
|
|
||||||
|
;; Total number of units across all lines.
|
||||||
|
(define
|
||||||
|
cart-count
|
||||||
|
(fn (cart) (reduce (fn (acc l) (+ acc (line-qty l))) 0 cart)))
|
||||||
|
|
||||||
|
;; Relational view of cart lines.
|
||||||
|
(define
|
||||||
|
cart-lineo
|
||||||
|
(fn (cart sku variant qty) (membero (list sku variant qty) cart)))
|
||||||
@@ -17,7 +17,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
|||||||
exit 1
|
exit 1
|
||||||
fi
|
fi
|
||||||
|
|
||||||
SUITES=(catalog)
|
SUITES=(catalog cart)
|
||||||
|
|
||||||
OUT_JSON="lib/commerce/scoreboard.json"
|
OUT_JSON="lib/commerce/scoreboard.json"
|
||||||
OUT_MD="lib/commerce/scoreboard.md"
|
OUT_MD="lib/commerce/scoreboard.md"
|
||||||
@@ -44,6 +44,7 @@ run_suite() {
|
|||||||
(load "lib/minikanren/matche.sx")
|
(load "lib/minikanren/matche.sx")
|
||||||
(load "lib/minikanren/defrel.sx")
|
(load "lib/minikanren/defrel.sx")
|
||||||
(load "lib/commerce/catalog.sx")
|
(load "lib/commerce/catalog.sx")
|
||||||
|
(load "lib/commerce/cart.sx")
|
||||||
(epoch 2)
|
(epoch 2)
|
||||||
(eval "(define ct-pass 0)")
|
(eval "(define ct-pass 0)")
|
||||||
(eval "(define ct-fail 0)")
|
(eval "(define ct-fail 0)")
|
||||||
|
|||||||
@@ -1,8 +1,9 @@
|
|||||||
{
|
{
|
||||||
"suites": {
|
"suites": {
|
||||||
"catalog": {"pass": 16, "fail": 0}
|
"catalog": {"pass": 16, "fail": 0},
|
||||||
|
"cart": {"pass": 18, "fail": 0}
|
||||||
},
|
},
|
||||||
"total_pass": 16,
|
"total_pass": 34,
|
||||||
"total_fail": 0,
|
"total_fail": 0,
|
||||||
"total": 16
|
"total": 34
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -5,4 +5,5 @@ _Generated by `lib/commerce/conformance.sh`_
|
|||||||
| Suite | Pass | Fail | Total |
|
| Suite | Pass | Fail | Total |
|
||||||
|-------|-----:|-----:|------:|
|
|-------|-----:|-----:|------:|
|
||||||
| catalog | 16 | 0 | 16 |
|
| catalog | 16 | 0 | 16 |
|
||||||
| **Total** | **16** | **0** | **16** |
|
| cart | 18 | 0 | 18 |
|
||||||
|
| **Total** | **34** | **0** | **34** |
|
||||||
|
|||||||
103
lib/commerce/tests/cart.sx
Normal file
103
lib/commerce/tests/cart.sx
Normal file
@@ -0,0 +1,103 @@
|
|||||||
|
;; lib/commerce/tests/cart.sx — cart structure + line operations.
|
||||||
|
;; Uses (commerce-test name got expected) provided by conformance.sh.
|
||||||
|
|
||||||
|
;; --- add ---
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"add-to-empty"
|
||||||
|
(cart-add empty-cart "widget" :small 2)
|
||||||
|
(list (list "widget" :small 2)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"add-merges-same-line"
|
||||||
|
(cart-add
|
||||||
|
(cart-add empty-cart "widget" :small 2)
|
||||||
|
"widget"
|
||||||
|
:small 3)
|
||||||
|
(list (list "widget" :small 5)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"add-different-variant-separate"
|
||||||
|
(cart-add
|
||||||
|
(cart-add empty-cart "widget" :small 2)
|
||||||
|
"widget"
|
||||||
|
:large 1)
|
||||||
|
(list (list "widget" :small 2) (list "widget" :large 1)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"add-different-sku-separate"
|
||||||
|
(cart-add
|
||||||
|
(cart-add empty-cart "widget" :small 2)
|
||||||
|
"gadget"
|
||||||
|
:std 1)
|
||||||
|
(list (list "widget" :small 2) (list "gadget" :std 1)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"add-preserves-order"
|
||||||
|
(cart-skus
|
||||||
|
(cart-add
|
||||||
|
(cart-add (cart-add empty-cart "a" :v 1) "b" :v 1)
|
||||||
|
"c"
|
||||||
|
:v 1))
|
||||||
|
(list "a" "b" "c"))
|
||||||
|
|
||||||
|
;; --- qty queries ---
|
||||||
|
|
||||||
|
(define
|
||||||
|
c2
|
||||||
|
(cart-add
|
||||||
|
(cart-add empty-cart "widget" :small 2)
|
||||||
|
"gadget"
|
||||||
|
:std 4))
|
||||||
|
|
||||||
|
(commerce-test "cart-qty-found" (cart-qty c2 "widget" :small) 2)
|
||||||
|
(commerce-test "cart-qty-missing" (cart-qty c2 "widget" :large) 0)
|
||||||
|
(commerce-test "cart-count" (cart-count c2) 6)
|
||||||
|
(commerce-test "cart-empty-yes" (cart-empty? empty-cart) true)
|
||||||
|
(commerce-test "cart-empty-no" (cart-empty? c2) false)
|
||||||
|
|
||||||
|
;; --- set-qty ---
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"set-qty-existing"
|
||||||
|
(cart-set-qty c2 "widget" :small 10)
|
||||||
|
(list (list "widget" :small 10) (list "gadget" :std 4)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"set-qty-new-line"
|
||||||
|
(cart-set-qty empty-cart "book" :std 3)
|
||||||
|
(list (list "book" :std 3)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"set-qty-zero-removes"
|
||||||
|
(cart-set-qty c2 "widget" :small 0)
|
||||||
|
(list (list "gadget" :std 4)))
|
||||||
|
|
||||||
|
;; --- remove ---
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"remove-line"
|
||||||
|
(cart-remove c2 "gadget" :std)
|
||||||
|
(list (list "widget" :small 2)))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"remove-missing-noop"
|
||||||
|
(cart-remove c2 "nope" :std)
|
||||||
|
(list (list "widget" :small 2) (list "gadget" :std 4)))
|
||||||
|
|
||||||
|
;; --- relational view ---
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"cart-lineo-forward"
|
||||||
|
(run* q (cart-lineo c2 "gadget" :std q))
|
||||||
|
(list 4))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"cart-lineo-sku-by-qty-backward"
|
||||||
|
(run* sk (fresh (v) (cart-lineo c2 sk v 4)))
|
||||||
|
(list "gadget"))
|
||||||
|
|
||||||
|
(commerce-test
|
||||||
|
"cart-lineo-all-skus"
|
||||||
|
(run* sk (fresh (v q) (cart-lineo c2 sk v q)))
|
||||||
|
(list "widget" "gadget"))
|
||||||
@@ -21,7 +21,7 @@ reconciliation — all auditable via the event log.
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/commerce/conformance.sh` → **16/16** (1 suite: catalog)
|
`bash lib/commerce/conformance.sh` → **34/34** (2 suites: catalog, cart)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -56,7 +56,7 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
|
|||||||
|
|
||||||
## Phase 1 — Catalog + cart + deterministic totals
|
## Phase 1 — Catalog + cart + deterministic totals
|
||||||
- [x] `catalog.sx` — product/variant/stock as facts
|
- [x] `catalog.sx` — product/variant/stock as facts
|
||||||
- [ ] `cart.sx` — line items, add/remove/qty
|
- [x] `cart.sx` — line items, add/remove/qty
|
||||||
- [ ] `price.sx` — base pricing relation, subtotal; tax
|
- [ ] `price.sx` — base pricing relation, subtotal; tax
|
||||||
- [ ] `api.sx` + tests + scoreboard + conformance.sh
|
- [ ] `api.sx` + tests + scoreboard + conformance.sh
|
||||||
|
|
||||||
@@ -76,6 +76,11 @@ lib/commerce/api.sx ── (commerce/add) (commerce/total) (commerce/checkout)
|
|||||||
- [ ] tests: webhook replay, partial refund, double-charge guard
|
- [ ] tests: webhook replay, partial refund, double-charge guard
|
||||||
|
|
||||||
## Progress log
|
## Progress log
|
||||||
|
- 2026-06-06 — `cart.sx`: cart as an ordered list of (sku variant qty) lines.
|
||||||
|
Pure ops `cart-add` (merges same line / appends), `cart-set-qty` (0 removes),
|
||||||
|
`cart-remove`, plus `cart-qty`/`cart-count`/`cart-skus`/`cart-empty?`.
|
||||||
|
`cart-lineo` is the relational view (membero over the cart) — forward and
|
||||||
|
backward. cart suite 18/18; total 34/34.
|
||||||
- 2026-06-06 — `catalog.sx`: catalog snapshot (products/variants/stock as fact
|
- 2026-06-06 — `catalog.sx`: catalog snapshot (products/variants/stock as fact
|
||||||
tuples) + multidirectional accessor relations (`producto`/`varianto`/`stocko`,
|
tuples) + multidirectional accessor relations (`producto`/`varianto`/`stocko`,
|
||||||
derived `priceo`/`classo`/`unit-priceo`) + deterministic `catalog-price`/
|
derived `priceo`/`classo`/`unit-priceo`) + deterministic `catalog-price`/
|
||||||
|
|||||||
Reference in New Issue
Block a user