host: the adapter seam for business-logic-as-composition (design-first)

lib/host/behavior.sx — the substrate-independent seam every runner/transport/registry/driver
plugs into. An engine bundles four dict-of-functions adapters (trigger-registry, runner,
transport, driver); behavior/process folds an ACTIVITY through the pipeline: emit → match
triggers → run each behavior DAG → dispatch each effect-as-data → recurse on new activities
(loop closure, depth-guarded at 8). Every stage injected, so the same DAG + engine run over the
synchronous op-table runner / Erlang durable / celery-sx / fed-sx transport unchanged.

Reference tests (mock adapters) prove the contract: publish→trigger→runner→effect flows; a
non-matching activity fires nothing (log complete, execution precise); an effect that emits a new
activity re-triggers (loop closes); an unbounded loop is depth-guarded (terminates). Wired into
conformance.sh + serve.sh MODULES. behavior 4/4; full host conformance 575/575.

Next: P0 supplies the REAL adapters (publish activity ← host/blog--publish-activity, local-SX
trigger, sync op-table runner over a publish-DAG, host driver) — same engine.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lib/host/behavior.sx

@@ -0,0 +1,58 @@
+;; lib/host/behavior.sx — the ADAPTER SEAM for business-logic-as-composition.
+;; (plans/business-logic-fed-flows.md.) The invariant is an ACTIVITY (state-change event) + a
+;; behavior DAG; everything between is a swappable adapter, each a dict-of-functions:
+;;
+;;   trigger-registry {:register! (fn spec dag hint)  :match (fn activity -> [binding])}
+;;   runner           {:run (fn dag env -> {:status :results :effects :resume})}
+;;   transport        {:emit (fn activity)            :deliver (fn -> [activity])}
+;;   driver           {:dispatch (fn effect -> [activity])}   ;; may emit NEW activities
+;;
+;; An engine bundles the four. behavior/process folds an activity through the pipeline —
+;; emit → match triggers → run each DAG → dispatch each effect → recurse on new activities
+;; (loop closure, depth-guarded). Returns a TRACE {:emitted :ran :effects} for observation.
+;; Runner/transport/registry/driver are all injected, so the same DAG + engine run over the
+;; synchronous op-table runner, the Erlang durable runner, celery-sx, fed-sx transport, etc.
+
+(define behavior/make-engine (fn (adapters) adapters))     ;; {:triggers :runner :transport :driver}
+(define behavior/-triggers  (fn (e) (get e :triggers)))
+(define behavior/-runner    (fn (e) (get e :runner)))
+(define behavior/-transport (fn (e) (get e :transport)))
+(define behavior/-driver    (fn (e) (get e :driver)))
+(define behavior/-max-depth 8)                              ;; loop-closure guard
+
+;; run one trigger binding: execute its DAG with the activity env, then dispatch each effect.
+(define behavior/-run-binding
+  (fn (engine activity binding depth acc)
+    (let ((result ((get (behavior/-runner engine) :run)
+                   (get binding :dag)
+                   {:activity activity :actor (get activity :actor) :binding binding})))
+      (reduce
+        (fn (a eff)
+          (behavior/-dispatch-effect engine eff depth
+            (assoc a :effects (concat (get a :effects) (list eff)))))
+        (assoc acc :ran (concat (get acc :ran) (list result)))
+        (or (get result :effects) (list))))))
+
+;; dispatch one effect via the driver; recurse on any NEW activities it emits (the loop closes).
+(define behavior/-dispatch-effect
+  (fn (engine eff depth acc)
+    (reduce
+      (fn (a na) (behavior/-step engine na (+ depth 1) a))
+      acc
+      (or ((get (behavior/-driver engine) :dispatch) eff) (list)))))
+
+;; one step: emit the activity, match triggers, run each binding. Depth-guarded.
+(define behavior/-step
+  (fn (engine activity depth acc)
+    (if (> depth behavior/-max-depth) acc
+      (begin
+        ((get (behavior/-transport engine) :emit) activity)
+        (reduce
+          (fn (a binding) (behavior/-run-binding engine activity binding depth a))
+          (assoc acc :emitted (concat (get acc :emitted) (list activity)))
+          (or ((get (behavior/-triggers engine) :match) activity) (list)))))))
+
+;; process an activity through the whole seam. Returns the trace.
+(define behavior/process
+  (fn (engine activity)
+    (behavior/-step engine activity 0 {:emitted (list) :ran (list) :effects (list)})))

lib/host/conformance.sh

@@ -94,6 +94,7 @@ MODULES=(
   "lib/host/relations.sx"
   "lib/host/compose.sx"
   "lib/host/execute.sx"
+  "lib/host/behavior.sx"
   "lib/host/htmlsx.sx"
   "lib/host/blog.sx"
   "lib/host/page.sx"
@@ -112,6 +113,7 @@ SUITES=(
   "relations   host-rl-tests-run!  lib/host/tests/relations.sx"
   "blog        host-bl-tests-run!  lib/host/tests/blog.sx"
   "htmlsx      host-ht-tests-run!  lib/host/tests/htmlsx.sx"
+  "behavior    host-be-tests-run!  lib/host/tests/behavior.sx"
   "compose     host-cp-tests-run!  lib/host/tests/compose.sx"
   "execute     host-ex-tests-run!  lib/host/tests/execute.sx"
   "session     host-se-tests-run!  lib/host/tests/session.sx"

lib/host/serve.sh

@@ -109,6 +109,7 @@ MODULES=(
   "lib/host/relations.sx"
   "lib/host/compose.sx"
   "lib/host/execute.sx"
+  "lib/host/behavior.sx"
   "lib/host/htmlsx.sx"
   "lib/host/blog.sx"
   "lib/host/server.sx"

lib/host/tests/behavior.sx

@@ -0,0 +1,70 @@
+;; lib/host/tests/behavior.sx — the adapter seam (lib/host/behavior.sx). MOCK adapters prove the
+;; pipeline contract (emit → match → run → dispatch → loop-closure) independent of any substrate.
+
+(define host-be-pass 0)
+(define host-be-fail 0)
+(define host-be-fails (list))
+(define host-be-test
+  (fn (name actual expected)
+    (if (= actual expected)
+      (set! host-be-pass (+ host-be-pass 1))
+      (begin
+        (set! host-be-fail (+ host-be-fail 1))
+        (append! host-be-fails {:name name :actual actual :expected expected})))))
+
+;; ── mock adapters: a publish activity fires a runner that emits one notify effect ──
+(define be-transport {:emit (fn (a) nil) :deliver (fn () (list))})
+(define be-triggers
+  {:register! (fn (spec dag hint) nil)
+   :match (fn (a) (if (= (get a :verb) "publish") (list {:dag "publish-dag"}) (list)))})
+(define be-runner
+  {:run (fn (dag env)
+          (if (= dag "publish-dag")
+            {:status "done" :effects (list {:kind "notify" :to (get (get env :activity) :actor)})}
+            {:status "done" :effects (list)}))})
+(define be-driver {:dispatch (fn (eff) (list))})           ;; no follow-up activities
+(define be-engine (behavior/make-engine {:triggers be-triggers :runner be-runner :transport be-transport :driver be-driver}))
+
+(host-be-test "publish activity → trigger → runner → effect flows through the seam"
+  (let ((tr (behavior/process be-engine {:verb "publish" :actor "alice" :object "cid1"})))
+    (list (len (get tr :emitted)) (len (get tr :ran)) (len (get tr :effects))
+          (get (first (get tr :effects)) :kind) (get (first (get tr :effects)) :to)))
+  (list 1 1 1 "notify" "alice"))
+(host-be-test "a non-matching activity fires nothing (log complete, execution precise)"
+  (let ((tr (behavior/process be-engine {:verb "draft" :actor "bob" :object "cid2"})))
+    (list (len (get tr :emitted)) (len (get tr :ran)) (len (get tr :effects))))
+  (list 1 0 0))
+
+;; ── loop closure: an effect's driver emits a NEW activity that re-triggers a second DAG ──
+(define bl-triggers
+  {:register! (fn (spec dag hint) nil)
+   :match (fn (a) (cond ((= (get a :verb) "publish") (list {:dag "pub"}))
+                        ((= (get a :verb) "followup") (list {:dag "fu"}))
+                        (else (list))))})
+(define bl-runner
+  {:run (fn (dag env) (cond ((= dag "pub") {:effects (list {:kind "chain"})})
+                            ((= dag "fu")  {:effects (list {:kind "done"})})
+                            (else {:effects (list)})))})
+(define bl-driver
+  {:dispatch (fn (eff) (if (= (get eff :kind) "chain")
+                         (list {:verb "followup" :actor "a" :object "c2"}) (list)))})
+(define bl-engine (behavior/make-engine {:triggers bl-triggers :runner bl-runner :transport be-transport :driver bl-driver}))
+(host-be-test "loop closure — an effect emits a new activity that re-triggers, bounded"
+  (let ((tr (behavior/process bl-engine {:verb "publish" :actor "a" :object "c1"})))
+    (list (len (get tr :emitted)) (len (get tr :ran)) (map (fn (e) (get e :kind)) (get tr :effects))))
+  (list 2 2 (list "chain" "done")))
+
+;; ── an unbounded loop is depth-guarded (terminates instead of running forever) ──
+(define bi-triggers {:register! (fn (s d h) nil) :match (fn (a) (if (= (get a :verb) "loop") (list {:dag "l"}) (list)))})
+(define bi-runner {:run (fn (dag env) {:effects (list {:kind "again"})})})
+(define bi-driver {:dispatch (fn (eff) (list {:verb "loop" :actor "a" :object "c"}))})
+(define bi-engine (behavior/make-engine {:triggers bi-triggers :runner bi-runner :transport be-transport :driver bi-driver}))
+(host-be-test "an unbounded loop is depth-guarded (terminates)"
+  (let ((tr (behavior/process bi-engine {:verb "loop" :actor "a" :object "c"})))
+    (and (> (len (get tr :emitted)) 1) (<= (len (get tr :emitted)) 10)))
+  true)
+
+(define host-be-tests-run!
+  (fn ()
+    {:total (+ host-be-pass host-be-fail)
+     :passed host-be-pass :failed host-be-fail :fails host-be-fails}))