;; lib/host/tests/execute.sx — the EXECUTE-fold (lib/host/execute.sx): a second interpreter ;; over the SAME seq/alt/each composition algebra as the render-fold, proving the algebra is ;; domain-agnostic (plans/composition-objects.md step 7). Leaves are effects; the fold ;; returns an effect log. Reuses compose.sx's when-predicates / field resolver / each source. (define host-ex-pass 0) (define host-ex-fail 0) (define host-ex-fails (list)) (define host-ex-test (fn (name actual expected) (if (= actual expected) (set! host-ex-pass (+ host-ex-pass 1)) (begin (set! host-ex-fail (+ host-ex-fail 1)) (append! host-ex-fails {:name name :actual actual :expected expected}))))) ;; the verbs of an effect log, in order (effect records are {:verb :args}). (define ex-verbs (fn (effects) (map (fn (e) (get e :verb)) effects))) (define ex-args (fn (effects) (map (fn (e) (get e :args)) effects))) ;; -- seq: steps in order -- (host-ex-test "seq runs effects in order" (ex-verbs (host/exec-run (quote (seq (effect a) (effect b) (effect c))) {})) (list "a" "b" "c")) (host-ex-test "nested seq flattens in order" (ex-verbs (host/exec-run (quote (seq (effect a) (seq (effect b) (effect c)) (effect d))) {})) (list "a" "b" "c" "d")) ;; -- alt + when: branch (reusing the render-fold's predicate set) -- (host-ex-test "alt runs the first branch whose when holds" (ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect publish)) (else (effect hold)))) {"auth" "y"})) (list "publish")) (host-ex-test "alt falls through to else when no when holds" (ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect publish)) (else (effect hold)))) {})) (list "hold")) (host-ex-test "alt eq predicate branches on a context value" (ex-verbs (host/exec-run (quote (alt (when (eq "role" "admin") (effect grant)) (else (effect deny)))) {"role" "admin"})) (list "grant")) ;; -- each: for-each over the (reused) source, with field resolution from the item -- (host-ex-test "each runs the body per item (for-each)" (ex-verbs (host/exec-run (quote (each (items {:email "a"} {:email "b"}) (effect notify))) {})) (list "notify" "notify")) (host-ex-test "effect args resolve (field K) from the current item" (ex-args (host/exec-run (quote (each (items {:email "a@x"} {:email "b@x"}) (effect notify (field :email)))) {})) (list (list "a@x") (list "b@x"))) (host-ex-test "effect args resolve (field K) from the context, and literals pass through" (ex-args (host/exec-run (quote (seq (effect log (field :who) "done"))) {"who" "alice"})) (list (list "alice" "done"))) ;; -- robustness: non-effect leaves / unknown heads produce no effects -- (host-ex-test "a non-list node yields no effects" (host/exec-run "bare" {}) (list)) (host-ex-test "an unknown combinator head yields no effects" (host/exec-run (quote (frobnicate 1 2)) {}) (list)) ;; -- the KEYSTONE: ONE control skeleton, folded TWO ways. Same alt+when, same context, the ;; SAME branch is chosen (both use host/comp--pred?); render emits HTML, execute emits an ;; effect. The composition algebra is domain-agnostic — render and behaviour are two folds. -- (host-ex-test "same skeleton folds two ways — render picks the branch, execute picks the SAME branch (authed)" (let ((ctx {"auth" "y"})) (list (host/comp-render (quote (alt (when (has "auth") (text "in")) (else (text "out")))) ctx) (ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect enter)) (else (effect leave)))) ctx)))) (list "in" (list "enter"))) (host-ex-test "same skeleton folds two ways — the else branch agrees across folds (anon)" (let ((ctx {})) (list (host/comp-render (quote (alt (when (has "auth") (text "in")) (else (text "out")))) ctx) (ex-verbs (host/exec-run (quote (alt (when (has "auth") (effect enter)) (else (effect leave)))) ctx)))) (list "out" (list "leave"))) ;; -- a small workflow: validate -> (branch on status) -> notify each recipient. Proves the ;; behaviour model is just an execute-fold over a composition object. -- (host-ex-test "a publish workflow runs as one execute-fold over the composition" (ex-verbs (host/exec-run (quote (seq (effect validate (field :slug)) (alt (when (eq "status" "ready") (effect publish (field :slug))) (else (effect hold (field :slug)))) (each (items {:to "a"} {:to "b"}) (effect notify (field :to))))) {"slug" "post-1" "status" "ready"})) (list "validate" "publish" "notify" "notify")) (define host-ex-tests-run! (fn () {:total (+ host-ex-pass host-ex-fail) :passed host-ex-pass :failed host-ex-fail :fails host-ex-fails}))