giles
0f6dbdfc7d
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
upcast.sx: register a pure (event -> event) upcaster per type in an immutable registry; read-upcast/project-upcast lift legacy events to the current shape on read so projections see one shape (no version branching, no history rewrite). upcast-data helper merges new :data fields. 171/171. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
116 lines
3.4 KiB
Plaintext
116 lines
3.4 KiB
Plaintext
; 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)
|