host P0.3: wire the seam into the live publish path (LIVE-VERIFIED)
Publishing a post now fires the on-publish behavior DAG through the seam. host/blog--{transport
(activity log), triggers (on-publish: create+article → publish-DAG), driver (records each effect in
the flow log), publish-engine (behavior/make-engine over the four adapters + the execute-fold runner
+ publish-ctx), fire-publish!, maybe-publish!}. Both write handlers (form-submit POST /new,
edit-submit POST /:slug/edit) detect the draft→published TRANSITION (fire-once) in the handler body
and run behavior/process. GET /flows renders the flow log (the effect-as-data the driver dispatched).
LIVE PROOF: logged in + POST /new on blog.rose-ash.com → /flows shows 'validate' + 'notify' (the
publish-DAG branched on the default urgent category), driven end-to-end by the real behavior engine.
Every piece is a seam adapter — swapping the runner for Erlang (RA) or the transport for fed-sx (TA)
federates this same wiring unchanged.
blog 207/207 (+4 P0.3), full host conformance 595/595. GAP: flow log is in-memory (P0.3b = persist).
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -145,6 +145,43 @@
|
||||
(define host/blog--publish-ctx
|
||||
(fn (activity) (let ((o (get activity :object))) {"category" (get o :category) "slug" (get o :slug)})))
|
||||
|
||||
;; ── 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
|
||||
;; effect in the flow log). Publishing a post (draft→published, fire-once) builds the activity and
|
||||
;; runs it through behavior/process → the DAG's effects surface on /flows. In-memory logs for P0
|
||||
;; (durable-store backing is the follow-up). Every piece is a seam adapter — swap the runner for
|
||||
;; Erlang (RA) or the transport for fed-sx (TA) and this same wiring federates, unchanged.
|
||||
(define host/blog--activity-log (list)) ;; every publish activity emitted (the event source)
|
||||
(define host/blog--flow-log (list)) ;; what the flows DID (the driver's effect records)
|
||||
(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
|
||||
(define host/blog--triggers
|
||||
{:register! (fn (spec dag hint) nil)
|
||||
:match (fn (a) (if (and (= (get a :type) "create") (= (get (get a :object) :type) "article"))
|
||||
(list {:dag host/blog--publish-dag}) (list)))})
|
||||
(define host/blog--driver
|
||||
{:dispatch (fn (eff)
|
||||
(begin (set! host/blog--flow-log
|
||||
(concat host/blog--flow-log
|
||||
(list {:verb (get eff :verb) :args (get eff :args)})))
|
||||
(list)))}) ;; record the effect; no follow-up activities (P0)
|
||||
(define host/blog--publish-engine
|
||||
(behavior/make-engine {:triggers host/blog--triggers :runner host/flow--exec-runner
|
||||
:transport host/blog--transport :driver host/blog--driver
|
||||
:ctx-of host/blog--publish-ctx}))
|
||||
;; fire the publish flow for a slug: build the activity, run it through the seam. Returns the trace.
|
||||
(define host/blog--fire-publish!
|
||||
(fn (slug)
|
||||
(let ((a (host/blog--publish-activity slug)))
|
||||
(if (nil? a) nil (behavior/process host/blog--publish-engine a)))))
|
||||
;; the draft→published TRANSITION (fire-once): only a non-published → published shift fires the flow.
|
||||
(define host/blog--maybe-publish!
|
||||
(fn (slug prev-status new-status)
|
||||
(if (and (not (= prev-status "published")) (= new-status "published"))
|
||||
(host/blog--fire-publish! slug) nil)))
|
||||
|
||||
;; ── render ──────────────────────────────────────────────────────────
|
||||
;; A post's sx_content is SX element markup -> HTML via render-page (which supplies
|
||||
;; the server env so components resolve + keyword attrs are kept).
|
||||
@@ -2376,9 +2413,12 @@
|
||||
(p (a :href "/new" "Back")))))))
|
||||
(else
|
||||
(let ((slug (host/blog-slugify title)))
|
||||
(begin
|
||||
(host/blog-put! slug title (or sx-content "") status)
|
||||
(dream-redirect (str "/" slug "/")))))))))
|
||||
(let ((prev (host/blog-get slug)))
|
||||
(begin
|
||||
(host/blog-put! slug title (or sx-content "") status)
|
||||
;; P0.3: a draft→published transition fires the publish flow through the seam.
|
||||
(host/blog--maybe-publish! slug (if prev (get prev :status) nil) status)
|
||||
(dream-redirect (str "/" slug "/"))))))))))
|
||||
|
||||
;; The JSON CRUD /posts (create/update/delete) was DELETED in the greenfield
|
||||
;; SX-native pivot (plans/relations-as-posts.md, "SX all the way out") — it was a
|
||||
@@ -2593,6 +2633,8 @@
|
||||
(if (= (len issues) 0)
|
||||
(begin
|
||||
(host/blog-put! slug title sx-content status)
|
||||
;; P0.3: a draft→published transition fires the publish flow through the seam.
|
||||
(host/blog--maybe-publish! slug (get r :status) status)
|
||||
;; store the typed field values from the generic, type-driven form (Slice 8b)
|
||||
(host/blog--set-field-values! slug
|
||||
(reduce (fn (acc f)
|
||||
@@ -2609,6 +2651,26 @@
|
||||
(unquote (cons (quote ul) issue-items))
|
||||
(p (a :href (unquote (str "/" slug "/edit")) "Back"))))))))))))))
|
||||
|
||||
;; ── /flows — P0.3 acceptance surface ─────────────────────────────────
|
||||
;; What the publish workflows DID: each effect-as-data record the host driver dispatched, produced
|
||||
;; by running the on-publish DAG through the seam. Publishing a post appends here (live proof the
|
||||
;; behavior engine fired). Public read.
|
||||
(define host/blog-flows
|
||||
(fn (req)
|
||||
(host/blog--resp req 200
|
||||
(host/blog--page req "Flows"
|
||||
(quasiquote
|
||||
(div (h1 "Flows")
|
||||
(p "Effect-as-data from publish workflows — the seam: on-publish → publish-DAG → effects.")
|
||||
(unquote
|
||||
(if (= (len host/blog--flow-log) 0)
|
||||
(quote (p (em "No flows yet — publish a post to fire the on-publish DAG.")))
|
||||
(cons (quote ul)
|
||||
(map (fn (e)
|
||||
(quasiquote (li (strong (unquote (get e :verb))) " "
|
||||
(unquote (if (> (len (get e :args)) 0) (str (first (get e :args))) "")))))
|
||||
host/blog--flow-log))))))))))
|
||||
|
||||
;; ── routes ──────────────────────────────────────────────────────────
|
||||
;; Public reads + the create form. /, /posts, /new BEFORE /:slug (catch-all).
|
||||
;; MUST be mounted LAST in the app so domain routes (/feed, /health) win.
|
||||
@@ -2620,6 +2682,7 @@
|
||||
(dream-get "/tags" host/blog-tags-index)
|
||||
(dream-get "/meta" host/blog-meta-index)
|
||||
(dream-get "/workflow-demo" host/blog-workflow-demo)
|
||||
(dream-get "/flows" host/blog-flows)
|
||||
(dream-get "/:slug/source" host/blog-source)
|
||||
(dream-get "/:slug/relate-options" host/blog-relate-options)
|
||||
(dream-get "/:slug" host/blog-post)))
|
||||
|
||||
Reference in New Issue
Block a user