diff --git a/lib/host/behavior.sx b/lib/host/behavior.sx index fc44278a..4ba78505 100644 --- a/lib/host/behavior.sx +++ b/lib/host/behavior.sx @@ -41,13 +41,16 @@ (define behavior/-empty-trace {:emitted (list) :ran (list) :effects (list) :suspended (list) :failed (list) :seen (list)}) -;; run one trigger binding: execute its DAG with the FULL env, then branch on :status. +;; run one trigger binding: execute its DAG with the FULL env, then branch on :status. The runner +;; is the binding's DERIVED runner (get binding :runner) if the registry resolved one (capability +;; selection — P1), else the engine's default :runner. (define behavior/-run-binding (fn (engine activity binding depth acc) (let ((env {:activity activity :actor (get activity :actor) :ctx (behavior/-ctx-of engine activity) :effects (behavior/-effects engine) :binding binding})) - (let ((result ((get (behavior/-runner engine) :run) (get binding :dag) env))) + (let ((runner (or (get binding :runner) (behavior/-runner engine)))) + (let ((result ((get runner :run) (get binding :dag) env))) (let ((acc1 (assoc acc :ran (concat (get acc :ran) (list result)))) (status (or (get result :status) "done"))) (cond @@ -62,7 +65,7 @@ (fn (a eff) (behavior/-dispatch-effect engine eff depth (assoc a :effects (concat (get a :effects) (list eff))))) - acc1 (or (get result :effects) (list)))))))))) + acc1 (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 diff --git a/lib/host/blog.sx b/lib/host/blog.sx index d5540609..514c0e7b 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -161,6 +161,43 @@ (define host/blog--publish-ctx (fn (activity) {"category" (get activity :category) "slug" (get activity :slug)})) +;; ── P1: types DECLARE behavior; the runner is DERIVED from the DAG's capabilities ────── +;; A type-post carries :behavior = a list of flat string-keyed bindings {"verb" "type" "dag"} (like +;; :type-relations). At boot they're gathered into a registry the trigger match consults. :dag NAMES +;; a registered behavior DAG; the runner is chosen by host/flow--select-runner over the fleet — an +;; {effect,branch} composition → exec-runner; a {suspend} DAG → RA once RA-live adds it to the fleet. +(define host/blog--dag-registry {"publish" host/blog--publish-dag}) ;; name -> behavior DAG +(define host/blog--dag-of (fn (name) (get host/blog--dag-registry name))) +;; the runner fleet, cheapest-first. exec-runner only until RA-live stands up a persistent kernel. +(define host/blog--runner-fleet (list host/flow--exec-runner)) +;; per-type behavior declaration, stored on the type-post (string-keyed → persist-safe). +(define host/blog--type-behavior (fn (type) (or (get (host/blog-get type) :behavior) (list)))) +(define host/blog--set-type-behavior! + (fn (type bindings) + (let ((r (host/blog-get type))) (when r (host/blog--write! type (merge r {:behavior bindings})))))) +;; the behavior REGISTRY: every declared binding, gathered at boot (like load-edges!). Scans ALL +;; posts for a :behavior declaration — robust to is-type? state differences across the durable store +;; (a post without :behavior contributes nothing). +(define host/blog--behaviors (list)) +(define host/blog--load-behaviors! + (fn () + (set! host/blog--behaviors + (reduce (fn (acc t) (concat acc (host/blog--type-behavior t))) + (list) (host/blog-slugs))))) +;; match an activity against the registry → resolved bindings {:dag :runner}, runner DERIVED by caps. +;; (A binding whose DAG needs a capability no fleet runner has is SKIPPED — a soft bind failure.) +(define host/blog--match-behaviors + (fn (activity) + (reduce + (fn (acc b) + (if (and (= (get b "verb") (get activity :verb)) + (= (get b "type") (get activity :object-type))) + (let ((dag (host/blog--dag-of (get b "dag")))) + (let ((runner (host/flow--select-runner host/blog--runner-fleet dag))) + (if (nil? runner) acc (concat acc (list {:dag dag :runner runner}))))) + acc)) + (list) host/blog--behaviors))) + ;; ── P0.3: the seam WIRED on the live host ────────────────────────────── ;; The publish ENGINE = the execute-fold runner (flows.sx) + a local-SX on-publish trigger registry ;; + an in-process transport (the activity log = the event source) + the host driver (records each @@ -173,10 +210,11 @@ (define host/blog--transport {:emit (fn (a) (set! host/blog--activity-log (concat host/blog--activity-log (list a)))) :deliver (fn () (list))}) ;; nothing inbound yet — P0 is synchronous +;; P1: the trigger match consults the behavior REGISTRY (built from types' declarations), and each +;; matched binding carries its DERIVED runner (capability selection). Was a hardcoded create+article. (define host/blog--triggers {:register! (fn (spec dag hint) nil) - :match (fn (a) (if (and (= (get a :verb) "create") (= (get a :object-type) "article")) - (list {:dag host/blog--publish-dag}) (list)))}) + :match host/blog--match-behaviors}) ;; P0.3b: the flow log is DURABLE — string-keyed records (dodge the keyword/persist top-level split), ;; persisted to the blog store under one key, so /flows survives a restart. Boot-loaded via ;; host/blog-load-flowlog!. (Whole-list rewrite per effect — fine at P0 volume; cap/rotate later.) @@ -1401,6 +1439,11 @@ ;; tagged — but NOT subtyped (subtype-of is for types). The relation editors + relate ;; handler read this; the metamodel types declare none, so they keep every kind. (host/blog--set-type-relations! "article" (list "related" "is-a" "tagged")) + ;; P1: the "article" type DECLARES its behavior — on-publish (a create of an article) runs the + ;; "publish" DAG. The runner is derived from the DAG's caps ({effect,branch} → exec-runner). This + ;; replaces the hardcoded trigger; host/blog--load-behaviors! gathers it into the registry at boot. + (host/blog--set-type-behavior! "article" + (list {"verb" "create" "type" "article" "dag" "publish"})) ;; ── cards-as-types: the blog content block vocabulary (kg-cards / content-on-sx ;; block kinds) as metamodel types. "card" is the root; each card kind is a subtype ;; with its own fields. These define the editor's card palette + the radar migrator's @@ -2053,6 +2096,26 @@ ;; the READ-ONLY type definition, shown on a type's PUBLIC page so anyone can read what the ;; type is: its fields, each Composition field's block grammar, and the relations its instances ;; may use. (The edit page's host/blog--type-def-editor is the writable form of the same data.) +;; P1: render a type's declared BEHAVIOR bindings + the DERIVED runner for each (visible, not +;; hand-set — the sync/durable classification falls out of the DAG's required capabilities). +(define host/blog--behavior-lines + (fn (slug) + (let ((bs (host/blog--type-behavior slug))) + (if (empty? bs) "" + (cons (quote div) + (cons (quote (:style "margin:0.4em 0 0")) + (cons (quote (b "Behavior: ")) + (map (fn (bd) + (let ((dag (host/blog--dag-of (get bd "dag")))) + (let ((runner (host/flow--select-runner host/blog--runner-fleet dag)) + (caps (host/flow--required-caps dag))) + (quasiquote (span :style "display:block;font-size:0.9em;color:#555" + (unquote (str "on " (get bd "verb") " → " (get bd "dag") " DAG · needs {" + (join ", " caps) "} · runner: " + (if (nil? runner) "NONE (capability unmet)" + (if (contains? (get runner :capabilities) "suspend") + "durable (RA)" "synchronous (exec-fold)"))))))))) + bs)))))))) (define host/blog--type-def-view (fn (slug) (let ((fields (host/blog-fields-of slug)) @@ -2074,7 +2137,8 @@ (unquote (if (> (len fields) 0) (cons (quote ul) (append (quasiquote (:style "margin:0.3em 0")) rows)) (quote (p :style "color:#999;margin:0" "No declared fields.")))) - (p :style "margin:0.4em 0 0" (b "Instances may be linked by: ") (unquote (join ", " rels))))))))) + (p :style "margin:0.4em 0 0" (b "Instances may be linked by: ") (unquote (join ", " rels))) + (unquote (host/blog--behavior-lines slug)))))))) ;; the first n elements of a list. (define host/blog--take (fn (xs n) (let loop ((ys xs) (k n) (acc (list))) diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 02ebac93..ca1a3060 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -185,6 +185,11 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog-seed-types!)\")" EPOCH=$((EPOCH+1)) + # P1: gather the types' declared :behavior bindings into the registry the trigger match + # consults (so publishing an article fires its declared on-publish DAG, runner derived). + echo "(epoch $EPOCH)" + echo "(eval \"(host/blog--load-behaviors!)\")" + EPOCH=$((EPOCH+1)) # Seed a live demo of the composition fold (plans/composition-objects.md): /compose-demo # is one composition object rendered by host/comp-render — renders differently by context. echo "(epoch $EPOCH)" diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index dff3b823..a53eb1f6 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -175,6 +175,17 @@ ;; the relation metadata into the in-memory cache the same way. (host/blog-seed-types!) (host/blog-load-rel-kinds!) +(host/blog--load-behaviors!) ;; P1: gather types' declared behaviors into the registry (as boot does) +(host-bl-test "P1: load-behaviors! gathers the article type's declared on-publish binding" + (list (>= (len host/blog--behaviors) 1) + (contains? (map (fn (b) (get b "dag")) host/blog--behaviors) "publish")) + (list true true)) +(host-bl-test "P1: match-behaviors resolves a create/article activity → a binding with a DERIVED runner" + (let ((ms (host/blog--match-behaviors {:verb "create" :object-type "article"}))) + (list (len ms) (get (get (first ms) :runner) :capabilities))) + (list 1 (list "effect" "branch" "each"))) +(host-bl-test "P1: a non-article activity matches nothing" + (len (host/blog--match-behaviors {:verb "create" :object-type "note"})) 0) (host-bl-test "relate no auth -> redirect to login" (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" nil "application/x-www-form-urlencoded" "other=another-one"))) 303) diff --git a/plans/business-logic-fed-flows.md b/plans/business-logic-fed-flows.md index eacf9c8a..e4c667e8 100644 --- a/plans/business-logic-fed-flows.md +++ b/plans/business-logic-fed-flows.md @@ -197,16 +197,25 @@ without touching the DAG or the wiring. boundary). RECOMMENDATION: a narrow **RA SPIKE** next — prove one dispatch + one suspend/resume/ pump cycle in isolation — de-risks the whole durable/federated half before building P1/P2 on it. -## P1 — types DECLARE behavior (generalize) - -- [ ] The type carries :behavior = [{:on {:verb :object-type :guard} :dag }] — edited in the - type-def editor beside grammar + relations. NO runner hint (the runner is DERIVED from the DAG's - required capabilities). -- [ ] host/blog--engine-for(object) builds the seam engine from the object's type bindings + - registers the triggers, selecting each DAG's MINIMUM runner via artdag/analyze (required-caps) — - a `{effect}`-only DAG runs synchronously; a `wait` node pulls in the Erlang runner automatically. -- [ ] The type-def editor can SHOW each behavior's required capabilities + which runner it resolves - to (the derived sync/durable/distributed classification, visible not hand-set). +## P1 — types DECLARE behavior (generalize) — DONE + LIVE-VERIFIED 2026-07-02 +- [x] The type carries :behavior — a list of flat string-keyed bindings {"verb" "type" "dag"} + (persist-safe, like :type-relations), stored on the type-post (host/blog--type-behavior / + set-type-behavior!). The "article" type declares {"verb" "create" "type" "article" "dag" "publish"}. +- [x] The behavior REGISTRY (host/blog--behaviors) is gathered at boot from ALL posts' declarations + (host/blog--load-behaviors!, in serve.sh after seed-types!); the trigger match (host/blog--triggers + :match = host/blog--match-behaviors) consults it. The hardcoded create+article trigger is GONE. +- [x] The runner is DERIVED, not hinted (DEBT #2 fixed): match-behaviors resolves the :dag via a DAG + registry (host/blog--dag-registry) and picks the runner via host/flow--select-runner over the fleet + (host/blog--runner-fleet = [exec-runner]; RA joins at RA-live). Each binding carries its :runner; + behavior/-run-binding uses it. An {effect,branch} publish-DAG → exec-runner; a {suspend} DAG would + route to RA (proven in ra 9/9 with a 2-runner fleet). +- [x] The type-def view SHOWS each behavior + its derived runner (host/blog--behavior-lines): LIVE at + blog.rose-ash.com/article — "on create → publish DAG · needs {effect, branch} · runner: + synchronous (exec-fold)". Derived + visible, not hand-set. +- LIVE PROOF: published on blog.rose-ash.com → /flows fired validate+notify via the DECLARED path + (registry + derived runner). blog 213/213, full conformance 610/610. FINDING: load-behaviors! must + scan ALL posts, not filter by is-type? (article didn't pass is-type? on the durable store though it + did in-memory) — the type declaration is authoritative, the is-type? classification isn't reliable enough. ## P2 — state-change → activity emission (ALL events, not just publish) @@ -282,6 +291,13 @@ covers everything until a DAG's cost/latency/placement forces the substrate. activities), so business logic can change state, which federates, which triggers more flows. ## Progress log (newest first) +- 2026-07-02 — P1 DONE + LIVE-VERIFIED. Types DECLARE :behavior (stored on the type-post, gathered + into a registry at boot); the trigger match consults the registry; the runner is DERIVED via + host/flow--select-runner over the fleet (DEBT #2 fixed — no hardcoded trigger, no runner hint). The + /article page shows the declared behavior + derived runner. Published live → /flows fired via the + declared path. blog 213/213, conformance 610/610. Finding: load-behaviors! scans ALL posts (not + is-type?-filtered — unreliable on the durable store). NEXT: RA-live (persistent kernel wires RA into + the fleet → durable bindings route to RA), or P2 (all state-change → activity emission). - 2026-07-02 — RA RUNNER BUILT + tested (module + integration). lib/host/ra.sx = a pure-SX seam runner with injected erl-eval (loads in the plain host, mock-testable); marshals our activity → Erlang, drives flow_store, parses done/suspended → the runner contract. Dual-runner ROUTING in