giles
3cbf33d2d2
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
The seam for hooking flow to art-dag and human-in-the-loop later. (request kind payload) suspends with a typed (flow-request kind payload) envelope and returns the host's resume value; await-human/await-render sugar. (flow-host-requests) is the host work queue: (id kind payload) for every suspended flow awaiting a host effect; request?/request-kind/request-payload parse a tag. Tests include the art-dag-shaped driver loop (render -> human-review -> publish). Host owns IO+persistence; flow only requests (replay-safe). 162/162 across 11 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
88 lines
4.3 KiB
Plaintext
88 lines
4.3 KiB
Plaintext
;; lib/flow/tests/host.sx — Phase 8: host integration ABI (request/await/host-queue).
|
|
|
|
(define flow-hst-pass 0)
|
|
(define flow-hst-fail 0)
|
|
(define flow-hst-fails (list))
|
|
|
|
(define
|
|
flow-hst-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! flow-hst-pass (+ flow-hst-pass 1))
|
|
(begin
|
|
(set! flow-hst-fail (+ flow-hst-fail 1))
|
|
(append! flow-hst-fails {:name name :expected expected :actual actual})))))
|
|
|
|
(define flow-hst (fn (src) (flow-run src)))
|
|
|
|
;; ── request envelope ────────────────────────────────────────────
|
|
(flow-hst-test
|
|
"request: suspends with a typed envelope"
|
|
(flow-hst
|
|
"(car (cdr (cdr (flow/start (lambda (x) (request (quote render) x)) 5))))")
|
|
(list "flow-request" "render" 5))
|
|
(flow-hst-test
|
|
"request?: recognizes an envelope"
|
|
(flow-hst "(request? (list (quote flow-request) (quote human) 1))")
|
|
true)
|
|
(flow-hst-test
|
|
"request?: a plain tag is not a request"
|
|
(flow-hst "(request? (list (quote review) 1))")
|
|
false)
|
|
(flow-hst-test
|
|
"request-kind / request-payload: parse the envelope"
|
|
(flow-hst
|
|
"(define t (list (quote flow-request) (quote render) (list (quote recipe) 7))) (list (request-kind t) (request-payload t))")
|
|
(list "render" (list "recipe" 7)))
|
|
|
|
;; ── named decision points ───────────────────────────────────────
|
|
(flow-hst-test
|
|
"await-human: is a request of kind human"
|
|
(flow-hst
|
|
"(car (cdr (cdr (flow/start (lambda (x) (await-human x)) (quote approve?)))))")
|
|
(list "flow-request" "human" "approve?"))
|
|
(flow-hst-test
|
|
"await-render: is a request of kind render"
|
|
(flow-hst
|
|
"(car (cdr (cdr (flow/start (lambda (x) (await-render x)) (quote recipe)))))")
|
|
(list "flow-request" "render" "recipe"))
|
|
(flow-hst-test
|
|
"request: the host's resume value flows back into the flow"
|
|
(flow-hst
|
|
"(defflow f (sequence (lambda (x) (await-render x)) (lambda (art) (list (quote got) art)))) (define id (car (cdr (flow/start f 1)))) (flow/resume id (quote the-artifact))")
|
|
(list "got" "the-artifact"))
|
|
|
|
;; ── host work queue ─────────────────────────────────────────────
|
|
(flow-hst-test
|
|
"flow-host-requests: lists (id kind payload) for pending requests"
|
|
(flow-hst
|
|
"(flow/start (lambda (x) (await-render x)) 99) (flow-host-requests)")
|
|
(list (list 1 "render" 99)))
|
|
(flow-hst-test
|
|
"flow-host-requests: excludes bare (non-request) suspends"
|
|
(flow-hst
|
|
"(defflow a (lambda (x) (await-render x))) (defflow b (lambda (x) (suspend (quote plain)))) (flow/start a 1) (flow/start b 2) (flow-host-requests)")
|
|
(list (list 1 "render" 1)))
|
|
|
|
;; ── the art-dag-shaped host driver loop ─────────────────────────
|
|
;; A host: poll requests, dispatch by kind (render -> compute; human -> decide),
|
|
;; resume with the result. Drives a render -> human-review -> publish pipeline.
|
|
(flow-hst-test
|
|
"host driver: render then human-review then publish"
|
|
(flow-hst
|
|
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 99)))) (define r1 (flow-host-requests)) (flow/resume id (list (quote art) 99)) (define r2 (flow-host-requests)) (flow/resume id (quote approve)) (list r1 r2 (flow/status id) (flow/result id))")
|
|
(list
|
|
(list (list 1 "render" 99))
|
|
(list (list 1 "human" (list "review" (list "art" 99))))
|
|
"done"
|
|
"published"))
|
|
(flow-hst-test
|
|
"host driver: rejection at the human gate yields a failure"
|
|
(flow-hst
|
|
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 1)))) (flow/resume id (quote artifact)) (failed? (flow/resume id (quote reject)))")
|
|
true)
|
|
|
|
(define flow-hst-tests-run! (fn () {:total (+ flow-hst-pass flow-hst-fail) :passed flow-hst-pass :failed flow-hst-fail :fails flow-hst-fails}))
|