observe.tri (1767B)
1 !import base as B 2 !import io as IO 3 !import handlers as H 4 !export run 5 !export result 6 7 -- Test observer: retain source diagnostics as data and record attempted events. 8 -- This is NOT the production terminal-outcome runner. Host failures/cancellation 9 -- still terminate normally; only H.view diagnostics are observed as Results. 10 -- State is explicit and sequential, never a native slot or shared child cell. 11 walk current events = let 12 finish reply = IO.pure [reply events] 13 bad = B.err (H.diagnostic "invalid-view" t t t []) t 14 in case current of 15 (100, value) = finish (B.ok value t) 16 (103, problem) = finish (B.err problem t) 17 (106, [["test.trace" "record" event] labels next]) = walk (next t) (B.pair event events) 18 (106, [["host.io" "run" action] labels next]) = case B.checkContract (B.listOf B.anyC) labels of 19 ((t t), _) = IO.bind action (reply : walk (next reply) events) 20 _ = finish bad 21 (106, [[service operation argument] labels next]) = finish 22 (B.err (H.diagnostic "unhandled-request" service operation argument labels) t) 23 (107, [labels body next]) = case B.checkContract (B.listOf B.anyC) labels of 24 ((t t), _) = IO.bind (IO.scope (owner : walk (body owner) events)) (observed : case observed of 25 [((t t), (value, t)) following] = walk (next value) following 26 [failure following] = IO.pure [failure following] 27 _ = IO.fail "Invalid test observation") 28 _ = finish bad 29 (108, _) = finish (B.err (H.diagnostic "state-boundary" "test.trace" "record" "No implicit child state" []) t) 30 _ = finish bad 31 run action events = walk (H.view action) events 32 result action = IO.bind (run action []) (observed : case observed of 33 [reply _] = IO.pure reply 34 _ = IO.fail "Invalid test observation")