giles
35957d779f
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>
104 lines
2.3 KiB
Plaintext
104 lines
2.3 KiB
Plaintext
;; 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"))
|