; Extension — event schema evolution via upcasters.

; v1 "placed" events had {:total N}; v2 wants {:amount N :currency "GBP"}.
(define up-placed (fn (e) (persist/upcast-data e {:amount (get (persist/event-data e) :total) :currency "GBP"})))

(persist-test
  "unregistered type passes through unchanged"
  (let
    ((reg (persist/upcasters)))
    (persist/event-data
      (persist/upcast
        reg
        (persist/event "s" 1 "other" 0 {:x 1}))))
  {:x 1})
(persist-test
  "registered upcaster lifts an old event"
  (let
    ((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (get
      (persist/event-data
        (persist/upcast
          reg
          (persist/event "s" 1 "placed" 0 {:total 50})))
      :amount))
  50)
(persist-test
  "upcaster adds the new field"
  (let
    ((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (get
      (persist/event-data
        (persist/upcast
          reg
          (persist/event "s" 1 "placed" 0 {:total 50})))
      :currency))
  "GBP")
(persist-test
  "upcast preserves stream/seq/type/at"
  (let
    ((reg (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (let
      ((e (persist/upcast reg (persist/event "orders" 7 "placed" 99 {:total 1}))))
      (list
        (persist/event-seq e)
        (persist/event-at e)
        (persist/event-type e))))
  (list 7 99 "placed"))
(persist-test
  "registry is immutable — register returns a new dict"
  (let
    ((r0 (persist/upcasters)))
    (begin
      (persist/register-upcaster r0 "placed" up-placed)
      (has-key? r0 "placed")))
  false)
(persist-test
  "read-upcast lifts every event in a stream"
  (let
    ((b (persist/open))
      (reg
        (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (begin
      (persist/append b "orders" "placed" 0 {:total 10})
      (persist/append b "orders" "placed" 0 {:total 20})
      (let
        ((es (persist/read-upcast b "orders" reg)))
        (list
          (get (persist/event-data (nth es 0)) :amount)
          (get (persist/event-data (nth es 1)) :amount)))))
  (list 10 20))
(persist-test
  "project-upcast folds over the current shape"
  (let
    ((b (persist/open))
      (reg
        (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (begin
      (persist/append b "orders" "placed" 0 {:total 10})
      (persist/append b "orders" "placed" 0 {:total 20})
      (persist/project-upcast
        b
        "orders"
        reg
        (fn (acc e) (+ acc (get (persist/event-data e) :amount)))
        0)))
  30)
(persist-test
  "mixed old and new events fold uniformly"
  (let
    ((b (persist/open))
      (reg
        (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (begin
      (persist/append b "orders" "placed" 0 {:total 5})
      (persist/append b "orders" "placed" 0 {:total 7 :amount 7})
      (persist/project-upcast
        b
        "orders"
        reg
        (fn (acc e) (+ acc (get (persist/event-data e) :amount)))
        0)))
  12)
(persist-test
  "upcast works on the durable backend"
  (let
    ((db (persist/mock-durable (persist/mem-backend)))
      (reg
        (persist/register-upcaster (persist/upcasters) "placed" up-placed)))
    (begin
      (persist/append db "orders" "placed" 0 {:total 42})
      (get
        (persist/event-data
          (nth (persist/read-upcast db "orders" reg) 0))
        :amount)))
  42)