mostalive/firehose
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

emacs lisp script to turn org-roam notes into blog posts

Browse Source 
with acceptance tests
This commit is contained in:
Firehose Bot
2026-10-08 13:40:18 +01:00
parent 38873bde8c
commit 1cd2d062a3
8 changed files with 687 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
scripts/roam-export-blog-test.el
+188
View File
@@ -0,0 +1,188 @@
;;; roam-export-blog-test.el --- ERT tests for roam-export-blog -*- lexical-binding: t; -*-
;;; Commentary:
;; Run with:
;; emacs --batch -Q -l org -l ox-md -l scripts/roam-export-blog.el \
;; -l scripts/roam-export-blog-test.el -f ert-run-tests-batch-and-exit
;;
;; Tests use a fixture vault under scripts/test-fixtures/vault and write
;; output into throw-away firehose repo skeletons under /tmp.
;;; Code:
(require 'ert)
(require 'roam-export-blog)
(defconst reb-test-dir
(directory-file-name (file-name-directory (or load-file-name default-directory))))
(defconst reb-test-repo-root (expand-file-name ".." reb-test-dir))
(defconst reb-test-vault (expand-file-name "test-fixtures/vault" reb-test-dir))
(defun reb-test--file (name)
"Path to fixture file NAME in the test vault."
(expand-file-name name reb-test-vault))
(defun reb-test--new-root ()
"Create a throw-away firehose repo skeleton and return its root."
(let ((root (make-temp-file "/tmp/reb-root-" t)))
(make-directory (expand-file-name "app/priv/blog/engineering" root) t)
(make-directory (expand-file-name "app/priv/static/images/blog" root) t)
root))
(defun reb-test--setup-org-id ()
"Point org-id at a writable temp locations file and index the fixture vault."
(setq org-id-locations-file (make-temp-file "/tmp/reb-orgid-"))
(setq org-id-locations nil)
(org-id-update-id-locations
(mapcar #'reb-test--file '("note.org" "jev.org" "laya.org" "notitle.org")) t))
(defmacro reb-test--with-export (root &rest body)
"Run BODY with a fresh repo ROOT and a pinned export date."
(declare (indent 1))
`(progn
(reb-test--setup-org-id)
(let ((roam-export-blog-firehose-root ,root)
(roam-export-blog--current-date '("2026" "10" "08")))
,@body)))
;;; Pure helpers
(ert-deftest roam-export-blog/slug ()
(should (equal "will-it-blend" (roam-export-blog--slug "Will It Blend")))
(should (equal "improve-diagnostic-in-the-tdd-cycle"
(roam-export-blog--slug "Improve Diagnostic in the TDD cycle")))
(should (equal "v0-2-0-rss-subscribe-links"
(roam-export-blog--slug "v0.2.0 — RSS Subscribe Links"))))
(ert-deftest roam-export-blog/truncate-description-short ()
(should (equal "Short paragraph."
(roam-export-blog--truncate-description "Short paragraph."))))
(ert-deftest roam-export-blog/truncate-description-at-word-boundary ()
(let* ((words (make-list 60 "word"))
(text (string-join words " "))
(result (roam-export-blog--truncate-description text)))
(should (<= (length result) (+ roam-export-blog-description-length 1)))
(should (string-suffix-p "…" result))
(should-not (string-suffix-p " " result))
(should (string-prefix-p "word word" result))))
;;; Roam ref resolution
(ert-deftest roam-export-blog/roam-refs ()
(reb-test--setup-org-id)
(should (equal "https://example.com/jev"
(roam-export-blog--roam-refs (reb-test--file "jev.org"))))
(should (null (roam-export-blog--roam-refs (reb-test--file "laya.org")))))
;;; Aborts
(ert-deftest roam-export-blog/no-title-aborts ()
(let ((root (reb-test--new-root)))
(reb-test--with-export root
(should-error (roam-export-blog--export-file (reb-test--file "notitle.org"))
:type 'user-error)
;; Aborting must not have written any posts.
(should (null
(directory-files-recursively
(expand-file-name "app/priv/blog" root) "\\.md$"))))))
(ert-deftest roam-export-blog/filename-collision-aborts ()
(let ((root (reb-test--new-root)))
(reb-test--with-export root
;; Pre-create the exact target file.
(make-directory
(expand-file-name "app/priv/blog/engineering/2026" root) t)
(write-region "" nil
(expand-file-name
"app/priv/blog/engineering/2026/10-08-will-it-blend.md" root))
(should-error (roam-export-blog--export-file (reb-test--file "note.org"))
:type 'user-error)
;; Aborting must not have copied any images (no side effects).
(should (null
(directory-files-recursively
(expand-file-name "app/priv/static/images/blog" root)
"."))))))
;;; Full export
(ert-deftest roam-export-blog/end-to-end ()
(let ((root (reb-test--new-root))
result path body)
(reb-test--with-export root
(setq result (roam-export-blog--export-file (reb-test--file "note.org"))))
(setq path (car result))
;; Written at the agreed path.
(should (equal (expand-file-name
"app/priv/blog/engineering/2026/10-08-will-it-blend.md" root)
path))
(should (file-exists-p path))
;; Image attachment copied into static images with unchanged content.
(let ((image (expand-file-name "app/priv/static/images/blog/2026/will-it-blend.svg" root)))
(should (file-exists-p image))
(should (equal (with-temp-buffer (insert-file-contents image) (buffer-string))
(with-temp-buffer
(insert-file-contents (reb-test--file ".attach/00/000000-0000-0000-0000-000000000001/will-it-blend.svg"))
(buffer-string)))))
(setq body (with-temp-buffer (insert-file-contents path) (buffer-string)))
;; Frontmatter.
(should (string-match-p "title: \"Will It Blend\"" body))
(should (string-match-p "author: \"Willem van den Ende\"" body))
(should (string-match-p "tags: ~w()" body))
(should (string-match-p
"description: \"Will it Blend was a series of videos promoting a blender brand.\""
body))
(should (string-match-p "image: \"/images/blog/2026/will-it-blend.svg\"" body))
(should (string-match-p "published: false" body))
;; Markdown body.
(should (string-match-p "Will it Blend was a series of videos promoting a blender brand." body))
(should (string-match-p
(regexp-quote "![will-it-blend](/images/blog/2026/will-it-blend.svg)")
body))
(should (string-match-p (regexp-quote "[Jev](https://example.com/jev)") body))
(should (string-match-p "Laya popped up" body))
(should (string-match-p "a missing note vanished" body))
(should (string-match-p "TODO source needed (LinkedIn)" body))
(should (string-match-p "^## I learnt this from Julia$" body))
(should (string-match-p "^> A quoted comment.$" body))
(should (string-match-p "^```elixir$" body))
(should (string-match-p (regexp-quote "**bold**") body))
;; Org syntax must not leak into the markdown.
(should-not (string-match-p "#\\+begin" body))
(should-not (string-match-p "attachment:" body))
(should-not (string-match-p "id:0000" body))
(should-not (string-match-p "A private comment that must not be exported" body))
;; Warnings: dangling ref, ref without ROAM_REFS, ignored non-image
;; attachment.
(should (= 3 (length (cdr result))))
(should (cl-some (lambda (w) (string-match-p "00000000-0000-0000-0000-000000009999" w))
(cdr result)))
(should (cl-some (lambda (w) (string-match-p "00000000-0000-0000-0000-000000000003" w))
(cdr result)))
(should (cl-some (lambda (w) (string-match-p "attached-notes.txt" w))
(cdr result)))))
(ert-deftest roam-export-blog/description-truncated-in-frontmatter ()
(let* ((root (reb-test--new-root))
(vault (make-temp-file "/tmp/reb-vault-" t))
(note (expand-file-name "longpar.org" vault))
(long-text (string-join (make-list 50 "lorem" ) " ")))
(with-temp-file note
(insert ":PROPERTIES:\n:ID: 00000000-0000-0000-0000-000000000005\n:END:\n"
"#+title: Long Paragraph\n\n" long-text "\n"))
(reb-test--with-export root
(let ((result (roam-export-blog--export-file note)))
(let ((body (with-temp-buffer
(insert-file-contents (car result))
(buffer-string))))
(string-match "description: \"\\([^\"]*\\)\"" body)
(let ((desc (match-string 1 body)))
(should (<= (length desc) (+ roam-export-blog-description-length 1)))
(should (string-suffix-p "…" desc))
(should (string-prefix-p "lorem lorem" desc))))))))
(provide 'roam-export-blog-test)
;;; roam-export-blog-test.el ends here