giles
f71af498cf
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
stack.sx — precedence as a separate selection layer, not in the rules. Exclusivity = unordered code pairs; valid-stackings enumerates every legal subset of applicable promos; best-stacking deterministically picks max total discount (stable on ties); stacking-by-totalo answers "which legal stacking yields total D?" backward. Member vs guest falls out of applicable-promos. Completes Phase 2. Total 99/99 across 6 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
122 lines
3.1 KiB
Plaintext
122 lines
3.1 KiB
Plaintext
;; lib/commerce/stack.sx — promotion stacking precedence + best price.
|
|
;;
|
|
;; Per the miniKanren design rule, precedence is NOT encoded inside the promo
|
|
;; rules. promo.sx enumerates which promos apply; this layer enumerates which
|
|
;; *combinations* are legal and selects the best one by an explicit cost
|
|
;; function (max total discount = min price).
|
|
;;
|
|
;; Exclusivity is a list of unordered code pairs that may not both apply:
|
|
;; exclusions = (list (list code-a code-b) ...)
|
|
;; A stacking is a subset of applicable (code amount) pairs containing no
|
|
;; excluded pair. valid-stackings enumerates them; best-stacking is the
|
|
;; deterministic selection layer; stacking-by-totalo is the backward query
|
|
;; ("which legal stacking yields this total discount?").
|
|
|
|
(define
|
|
excluded-pair?
|
|
(fn
|
|
(exclusions a b)
|
|
(some
|
|
(fn
|
|
(p)
|
|
(or
|
|
(and (= (first p) a) (= (nth p 1) b))
|
|
(and (= (first p) b) (= (nth p 1) a))))
|
|
exclusions)))
|
|
|
|
;; True when no two distinct codes in the list are mutually excluded.
|
|
(define
|
|
compatible?
|
|
(fn
|
|
(exclusions codes)
|
|
(every?
|
|
(fn
|
|
(a)
|
|
(every?
|
|
(fn (b) (or (= a b) (not (excluded-pair? exclusions a b))))
|
|
codes))
|
|
codes)))
|
|
|
|
;; All subsets of xs, preserving element order. 2^n entries.
|
|
(define
|
|
powerset
|
|
(fn
|
|
(xs)
|
|
(if
|
|
(empty? xs)
|
|
(list (list))
|
|
(let
|
|
((r (powerset (cdr xs))))
|
|
(append r (map (fn (s) (cons (first xs) s)) r))))))
|
|
|
|
(define stacking-codes (fn (st) (map first st)))
|
|
|
|
(define
|
|
stacking-total
|
|
(fn
|
|
(st)
|
|
(reduce (fn (acc pair) (+ acc (nth pair 1))) 0 st)))
|
|
|
|
;; Every legal stacking of the applicable (code amount) pairs.
|
|
(define
|
|
valid-stackings
|
|
(fn
|
|
(exclusions applicable)
|
|
(filter
|
|
(fn (st) (compatible? exclusions (stacking-codes st)))
|
|
(powerset applicable))))
|
|
|
|
;; Deterministic selection: the legal stacking with the greatest total
|
|
;; discount; ties keep the earlier (stable) candidate, so the result is a
|
|
;; reproducible function of (exclusions, applicable).
|
|
(define
|
|
best-stacking
|
|
(fn
|
|
(exclusions applicable)
|
|
(reduce
|
|
(fn
|
|
(best st)
|
|
(if (> (stacking-total st) (stacking-total best)) st best))
|
|
(list)
|
|
(valid-stackings exclusions applicable))))
|
|
|
|
(define
|
|
best-discount
|
|
(fn
|
|
(exclusions applicable)
|
|
(stacking-total (best-stacking exclusions applicable))))
|
|
|
|
(define
|
|
best-codes
|
|
(fn
|
|
(exclusions applicable)
|
|
(stacking-codes (best-stacking exclusions applicable))))
|
|
|
|
;; Backward query: legal stackings (as code lists) whose total discount = D.
|
|
(define
|
|
stacking-by-totalo
|
|
(fn
|
|
(stackings codes total)
|
|
(fresh
|
|
(st)
|
|
(membero st stackings)
|
|
(project
|
|
(st)
|
|
(mk-conj
|
|
(== codes (stacking-codes st))
|
|
(== total (stacking-total st)))))))
|
|
|
|
;; --- top-level entry: best discount for a cart under a ruleset ---
|
|
|
|
(define
|
|
best-promo-discount
|
|
(fn
|
|
(ctx cart ruleset exclusions)
|
|
(best-discount exclusions (applicable-promos ctx cart ruleset))))
|
|
|
|
(define
|
|
best-promo-codes
|
|
(fn
|
|
(ctx cart ruleset exclusions)
|
|
(best-codes exclusions (applicable-promos ctx cart ruleset))))
|