giles
9cfca1d008
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Completes the host ABI from work-queue to driver loop: the host supplies only a (kind payload) -> answer dispatch fn; flow-drive-host services one tick of pending requests, flow-run-host ticks until quiescent (bounded). Tested via the art-dag render -> human-review -> publish pipeline driven entirely by flow-run-host. The art-dag integration is now: define dispatch, call flow-run-host. 166/166, 11 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
107 lines
5.5 KiB
Plaintext
107 lines
5.5 KiB
Plaintext
;; lib/flow/tests/host.sx — Phase 8: host integration ABI (request/await/host-queue/driver).
|
|
|
|
(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 (manual resumes) ────────
|
|
(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)
|
|
|
|
;; ── reference driver: host supplies only a dispatch fn ──────────
|
|
(flow-hst-test
|
|
"flow-drive-host: one tick services every pending request"
|
|
(flow-hst
|
|
"(flow/start (lambda (x) (await-render x)) 5) (define n (flow-drive-host (lambda (k p) (list (quote done) p)))) (list n (flow/status 1) (flow/result 1))")
|
|
(list 1 "done" (list "done" 5)))
|
|
(flow-hst-test
|
|
"flow-run-host: drives a render -> human pipeline to completion"
|
|
(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 serviced (flow-run-host (lambda (kind payload) (if (eq? kind (quote render)) (list (quote art) payload) (quote approve))) 10)) (list serviced (flow/status id) (flow/result id))")
|
|
(list 2 "done" "published"))
|
|
(flow-hst-test
|
|
"flow-run-host: returns 0 when nothing is pending"
|
|
(flow-hst "(flow-run-host (lambda (k p) p) 5)")
|
|
0)
|
|
(flow-hst-test
|
|
"flow-run-host: respects the maxticks bound"
|
|
(flow-hst
|
|
"(defflow pipe2 (sequence (lambda (r) (await-render r)) (lambda (a) (await-human a)) (lambda (d) d))) (define id (car (cdr (flow/start pipe2 1)))) (define serviced (flow-run-host (lambda (k p) p) 1)) (list serviced (flow/status id))")
|
|
(list 1 "suspended"))
|
|
|
|
(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}))
|