;; lib/commerce/tests/promo.sx — promo rules + relational enumeration.
;; Uses (commerce-test name got expected) provided by conformance.sh.

(define
  pcat
  (make-catalog
    (list
      (list "widget" 1000 :standard)
      (list "book" 800 :zero-rated)
      (list "tea" 1000 :reduced))
    (list)
    (list)))

(define gctx (make-pricing-context pcat (list) :uk :guest))
(define mctx (make-pricing-context pcat (list) :uk :member))

(define
  cart
  (list
    (list "widget" :none 3)
    (list "book" :none 1)
    (list "tea" :none 6)))

(define
  ruleset
  (list
    (list :percent "TEN" :standard 1000)
    (list :fixed "FIVER" 5000 500)
    (list :bundle "B3T" "tea" 3)
    (list :member "MEM" :standard 1500)))

;; --- per-type amounts ---

(commerce-test
  "percent-amount"
  (promo-amount gctx cart (list :percent "TEN" :standard 1000))
  300)

(commerce-test
  "fixed-amount-met"
  (promo-amount gctx cart (list :fixed "FIVER" 5000 500))
  500)

(commerce-test
  "fixed-amount-not-met"
  (promo-amount
    gctx
    (list (list "widget" :none 1))
    (list :fixed "FIVER" 5000 500))
  0)

(commerce-test
  "fixed-amount-capped"
  (promo-amount
    gctx
    (list (list "book" :none 1))
    (list :fixed "BIG" 0 9999))
  800)

(commerce-test
  "bundle-amount"
  (promo-amount gctx cart (list :bundle "B3T" "tea" 3))
  2000)

(commerce-test
  "member-amount-guest"
  (promo-amount gctx cart (list :member "MEM" :standard 1500))
  0)

(commerce-test
  "member-amount-member"
  (promo-amount mctx cart (list :member "MEM" :standard 1500))
  450)

;; --- relational enumeration: forward ---

(commerce-test
  "discounto-all-guest"
  (run*
    pair
    (fresh
      (code amount)
      (promo-discounto gctx cart ruleset code amount)
      (== pair (list code amount))))
  (list
    (list "TEN" 300)
    (list "FIVER" 500)
    (list "B3T" 2000)
    (list "MEM" 0)))

(commerce-test
  "applicable-guest"
  (applicable-promos gctx cart ruleset)
  (list
    (list "TEN" 300)
    (list "FIVER" 500)
    (list "B3T" 2000)))

(commerce-test
  "applicable-member"
  (applicable-promos mctx cart ruleset)
  (list
    (list "TEN" 300)
    (list "FIVER" 500)
    (list "B3T" 2000)
    (list "MEM" 450)))

;; --- relational enumeration: backward (the showcase) ---

(commerce-test
  "code-by-discount-2000"
  (run* code (promo-applieso gctx cart ruleset code 2000))
  (list "B3T"))

(commerce-test
  "code-by-discount-500"
  (run* code (promo-applieso gctx cart ruleset code 500))
  (list "FIVER"))

(commerce-test
  "code-by-discount-none"
  (run* code (promo-applieso gctx cart ruleset code 9999))
  (list))

;; --- deterministic helpers ---

(commerce-test
  "amount-for-ten"
  (promo-amount-for gctx cart ruleset "TEN")
  300)
(commerce-test
  "amount-for-mem-guest"
  (promo-amount-for gctx cart ruleset "MEM")
  0)
(commerce-test
  "amount-for-mem-member"
  (promo-amount-for mctx cart ruleset "MEM")
  450)
(commerce-test
  "amount-for-absent"
  (promo-amount-for gctx cart ruleset "NOPE")
  0)