host: typed Ghost import — POST /import lands old posts as first-class Articles
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m0s

The genesis-import seam for the loops/radar migration (NOTE-blog-types-for-radar.md):
an old Ghost post lands not as bare sx_content but as a TYPED Article.

- host/blog-import-post!(ghost-dict): put! the {slug,title,sx_content,status} record +
  is-a article + Ghost columns -> article :field-values (custom_excerpt->subtitle,
  feature_image->hero) + tags -> tag-posts with tagged edges. Idempotent. The Ghost body
  is already sx_content ((~kg_cards/kg-*) from the Python lexical_to_sx migration), so we
  carry it as-is. host/blog-import-all! for batches.
- POST /import (guarded): body = a text/sx LIST of Ghost column dicts (radar's Postgres
  reader serialises rows to this); imports each typed; -> {:ok true :data {:imported N
  :slugs (...)}}. Runs in the serving handler (IO resolver installed) so the per-post/
  per-tag loops are JIT-safe.

Verified live-path end-to-end (ephemeral SX_SERVING_JIT=1): POST a fixture Ghost post ->
imported 1; the post's edit form is pre-filled (subtitle='An imported standfirst',
hero=the feature image), its page renders the subtitle standfirst via the article template
+ the body, and its tags (News/SX) land in the graph. Tests added; full blog suite still
blocked by box contention.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 15:05:02 +00:00
parent 8f8688805e
commit fac15d6140
2 changed files with 65 additions and 1 deletions

View File

@@ -1281,6 +1281,48 @@
(concat host/blog-rel-kinds (list (get host/blog--rel-cache slug)))))))
(dream-redirect "/meta"))))
;; ── typed Ghost import (the radar genesis-import seam) ──────────────
;; Import ONE Ghost post (a dict of its columns, string keys) as a TYPED host post:
;; the {slug,title,sx_content,status} record + is-a article + Ghost columns mapped onto
;; article :field-values (custom_excerpt->subtitle, feature_image->hero) + tags landed as
;; tag-posts with tagged edges. The Ghost body is ALREADY sx_content (the Python
;; lexical_to_sx migration produced (~kg_cards/kg-*) markup), so we just carry it. So an
;; old Ghost post lands not as bare markup but as a first-class typed Article — fields on
;; the edit form, subtitle as a rendered standfirst, tags in the graph. Idempotent
;; (put!/seed!/relate! are sets). Contract: plans/NOTE-blog-types-for-radar.md.
(define host/blog-import-post!
(fn (gp)
(let ((slug (get gp "slug")) (title (get gp "title")))
(begin
(host/blog-put! slug title (or (get gp "sx_content") "") (or (get gp "status") "published"))
(host/blog-relate! slug "article" "is-a")
(host/blog--set-field-values! slug
{"subtitle" (or (get gp "custom_excerpt") (get gp "excerpt") "")
"hero" (or (get gp "feature_image") "")})
(for-each
(fn (tag)
(let ((tslug (host/blog-slugify tag)))
(begin
(host/blog-seed! tslug tag (str "(article (h1 \"" tag "\"))") "published")
(host/blog-relate! tslug "tag" "is-a")
(host/blog-relate! slug tslug "tagged"))))
(or (get gp "tags") (list)))
slug))))
;; Import a batch; returns the imported slugs.
(define host/blog-import-all!
(fn (posts) (map host/blog-import-post! posts)))
;; POST /import — the genesis-import endpoint. Body = a text/sx LIST of Ghost post dicts
;; (radar's Postgres reader serialises rows to this); imports each as a typed post.
;; -> {:ok true :data {:imported N :slugs (...)}}. Guarded (admin). Runs in the serving
;; handler (IO resolver installed) so the per-post / per-tag loops are JIT-safe.
(define host/blog-import-handler
(fn (req)
(let ((raw (dream-body req)))
(let ((posts (if (or (nil? raw) (= raw "")) (list) (sxtp/-normalize (parse-safe raw)))))
(if (= (type-of posts) "list")
(host/ok {:imported (len posts) :slugs (host/blog-import-all! posts)})
(host/error 400 "expected a text/sx list of Ghost post dicts"))))))
;; GET /<slug>/source — the raw sx_content as text/plain. Posts ARE SX source, so
;; this just hands back the stored markup (public; a published post's source is
;; not secret). 404 if the post is absent.
@@ -1541,7 +1583,8 @@
(dream-post "/:slug/relate" (host/blog--protect-html resolve host/blog-relate-submit))
(dream-post "/:slug/unrelate" (host/blog--protect-html resolve host/blog-unrelate-submit))
(dream-post "/meta/new-type" (host/blog--protect-html resolve host/blog-meta-new-type))
(dream-post "/meta/new-relation" (host/blog--protect-html resolve host/blog-meta-new-relation)))))
(dream-post "/meta/new-relation" (host/blog--protect-html resolve host/blog-meta-new-relation))
(dream-post "/import" (host/blog--protect-html resolve host/blog-import-handler)))))
;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error
;; trapping but NO auth, for validating the editor->host publish loop on the

View File

@@ -716,6 +716,27 @@
(let ((body (dream-resp-body (host-bl-app (host-bl-req "/meta")))))
(list (contains? body ">Image</a>") (contains? body "src:URL, alt:String")))
(list true true))
;; -- typed Ghost import (the radar genesis-import seam) --
(host-bl-test "import-post! lands a Ghost post as a typed Article + fields + tags"
(begin
(host/blog-import-post! {"slug" "g1" "title" "G1" "sx_content" "(article (h1 \"G1\"))"
"status" "published" "custom_excerpt" "A standfirst"
"feature_image" "http://i/h.jpg" "tags" (list "News")})
(list (host/blog-is-a? "g1" "article")
(get (host/blog-field-values-of "g1") "subtitle")
(get (host/blog-field-values-of "g1") "hero")
(contains? (host/blog-out "g1" "tagged") "news")))
(list true "A standfirst" "http://i/h.jpg" true))
(host-bl-test "POST /import (text/sx list of Ghost dicts) lands typed posts"
(begin
(host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx"
"({:slug \"g2\" :title \"G2\" :sx_content \"(p \\\"b\\\")\" :status \"published\" :custom_excerpt \"S2\"})"))
(list (host/blog-is-a? "g2" "article") (get (host/blog-field-values-of "g2") "subtitle")))
(list true "S2"))
(host-bl-test "POST /import rejects a non-list body -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/import" "Bearer good" "text/sx" "{:x 1}")))
400)
(host-bl-test "a post with no schema'd type is vacuously valid"
(host/blog-type-valid? "ppost" "(p \"anything\")") true)
(host-bl-test "edit-submit rejects content violating the type schema (not saved)"