Index section definitions for the Org-Roam-Blog Engine Package.
§ Index Root Spec (Type)
Elementary index type specificators.
At first I tried a "healthy" typed approach - as far as one can do it in lisp. But later realized that:
Elisp does not use type annotations for struct instance constructors.
The
defmethodhere cannot dispatch ondeftypesBut it can dispatch on
(head thing)And that's what I need, because root specs are simple enough to be represented as
cons-es (well,listsin fact, for there can be extra parameters in the spec).
(defvar org-roam-blog--index-root-speclist '(all node query)
"Spec symbols for ORB Index types.")
(defun org-roam-blog--index-root-spec-p (thing)
"Index Root has a form of cons cell:
CAR is a spec symbol (for dispatch); rest is data for search."
(and (consp thing)
(member (car thing) org-roam-blog--index-root-speclist)))
(deftype org-roam-blog-index-root-spec-type ()
'(satisfies org-roam-blog--index-root-spec-p))
§ Aux definitions for Index constructor
§ Root Spec Errors and Validation
Defining errors that might pop-up in the constructor.
(define-error 'org-roam-blog-index-root-error
"ORB Index Error: Index Root should exist and be valid."
'org-roam-blog-errors)
(define-error 'org-roam-blog-no-queries-error
"ORB Error: Query Roots are not implemented yet."
'org-roam-blog-errors)
Validate the existence of the index root object
(defun org-roam-blog--validate-root-spec (root-spec)
(when (eql (car root-spec) 'query)
(signal 'org-roam-blog-no-queries-error root-spec))
(or (eql (car root-spec) 'all)
(and (eql (car root-spec) 'node)
(org-roam-node-from-id (cadr root-spec)))))
§ Slug Builder
Uses handy utility defined in -utils:
(defun org-roam-blog--slugify-default (string)
"Indes slug-builder; defaults to calling `org-roam-blog-slugify'."
(funcall #'org-roam-blog-slugify string))
§ Guess Index Title based on the root-spec
Title should be known during index construction. Either provided at start or populated from the root.
(cl-defgeneric org-roam-blog--guess-index-title (root-spec)
"Tries to guess a title for index based on its ROOT-SPEC.")
(cl-defmethod org-roam-blog--guess-index-title
((root-spec (head all)))
"ORB Index Instance")
(cl-defmethod org-roam-blog--guess-index-title
((root-spec (head node)))
(org-roam-node-title
(org-roam-node-from-id (cadr root-spec))))
§ Default sort and filter funcs
My handy and reasonable defaults for index filter-fn and sort-fn.
filter-fn is a function to filter out nodes: it takes an org-roam-node,
and when nil is returned the node will be filtered out.
sort-fn is a predicate to sort org-roam-node entries.
(defun org-roam-blog--filter-default (node)
"Default node filtering function for index nodelist construction.
T unless NODE tagged win `noexport'."
(not (member "noexport" (org-roam-node-tags node))))
(defun org-roam-blog--sort-default (node1 node2)
"Default node sorting key for index nodelist construction.
Intended to leave nodes sorted in descending order w/r to date
they were added; compares `org-timestamp' date field in the
property set as `org-roam-blog-default-date-property' record of
the nodes.
T when NODE1 appears added later than NODE2, or if any of the
nodes are missing `org-roam-blog-default-date-property' property
(leaving them in place)."
(let ((ds1 (cdr (assoc org-roam-blog-default-date-property
(org-roam-node-properties node1))))
(ds2 (cdr (assoc org-roam-blog-default-date-property
(org-roam-node-properties node2)))))
(or (null ds1)
(null ds2)
(not (calendar-date-compare ; that thing needs lists of date-lists :/
(list (org-roam-blog-to-calendar-date ds1))
(list (org-roam-blog-to-calendar-date ds2)))))))
§ Definitions for context of Entries of an Index
The method in place of :entry-context-fn of an index outputs a context
hash-table object for an org-roam-node representing an entry.
The following example has somewhat duplicating show-... field in the
context in order to signal mustache.el templates that corresponding lists
must be rendered on page (syntax for lists and booleans in mustache is
the same).
(defun org-roam-blog--entry-context-default (node)
"Default NODE to context hash-table processor."
(let* ((lead-index (org-roam-node--lead-index-for (org-roam-node-id node)))
(backlinks (org-roam-blog--backlinks-to-context node))
(date (cdr (assoc org-roam-blog-default-date-property
(org-roam-node-properties node))))
(tags (mapcar (lambda (tag) (ht ("tag" tag)))
(org-roam-node-tags node)))
(toclevel (cdr (assoc org-roam-blog-toc-level-property
(org-roam-node-properties node))))
(toc (when toclevel (org-roam-blog--toc-to-context
node (string-to-number toclevel)))))
(ht ("title" (org-roam-node-title node))
("lead-index-title" (org-roam-blog-index-title lead-index))
("backlinks" backlinks)
("show-backlinks" (when backlinks t))
("toc" toc)
("show-toc" (when toc t))
("date" date)
("show-date" (when date t))
("tags" tags)
("show-tags" (when tags t))
("self-url" (org-roam-blog--relative-entry-url node lead-index))
("main" (org-roam-blog--htmlize-node-content node)))))
entry-fname-fn outputs endpoint filename for output of an entry context.
(defun org-roam-blog--entry-fname-default (node)
"Default filename builder for entry NODE object."
(->> (org-roam-node-title node)
(org-roam-blog-slugify)
(format "%s.html")))
(defsubst org-roam-blog--entry-fname-with-date (node)
"Alternative filename builder NODE object that prepends the entry date."
(cl-labels
((datestring-to-slug-part
(datestring)
(let ((date (org-roam-blog-to-calendar-date datestring)))
(cl-destructuring-bind (month day year) date
(format "%4d-%02d-%02d-" year month day)))))
(let ((datestring
(cdr (assoc org-roam-blog-default-date-property
(org-roam-node-properties node)))))
(concatenate 'string
(datestring-to-slug-part datestring)
(org-roam-blog--entry-fname-default node)))))
§ Index Struct
By the way, type annotations in elisp influence nothing.
Just a set of hints for self.
Heuristics for index file structure:
No
:templateor:context-fnmeans no index content file is outputted. Suits for sections with only entry items' pages.No
:entry-dirmeans no subdirectory for entry items is made. Entries than go to the corresponding index top subdirectory (defined by the:slugfield).
The group-by field is intended for pagination.
It can be left set to 0 or non-~0~ integer.
(cl-defstruct (org-roam-blog-index (:constructor org-roam-blog-index--create)
(:copier nil))
(root-spec nil :type org-roam-blog-index-root-spec-type)
(title nil :type string)
(slug nil :type string)
(entry-dir org-roam-blog-default-entry-dir-name :type string)
(media-dir org-roam-blog-default-media-dir-name :type string)
(template nil :type string)
(entry-template nil :type string)
(slug-fn #'org-roam-blog--slugify-default
:type function)
(filter-fn #'org-roam-blog--filter-default
:type function)
(sort-fn #'org-roam-blog--sort-default
:type function)
(group-by 0 :type integer)
(context-fn #'org-roam-blog--index-context-default
:type function)
(entry-context-fn #'org-roam-blog--entry-context-default
:type function)
(entry-fname-fn #'org-roam-blog--entry-fname-default
:type function)
(leading t :type boolean))
Index constructor definition.
(cl-defun org-roam-blog-index-create (&rest args)
(condition-case err
(let* ((index (apply #'org-roam-blog-index--create args))
(root-spec (org-roam-blog-index-root-spec index)))
(unless (and root-spec (org-roam-blog--validate-root-spec root-spec))
(signal 'org-roam-blog-index-root-error root-spec))
(unless (org-roam-blog-index-title index)
(setf (org-roam-blog-index-title index)
(org-roam-blog--guess-index-title root-spec)))
(unless (org-roam-blog-index-slug index)
(setf (org-roam-blog-index-slug index)
(funcall (org-roam-blog-index-slug-fn index)
(org-roam-blog-index-title index))))
index)
(org-roam-blog-errors
(message "%s" (error-message-string err))
nil)))
§ Utilities for Blog Index processing
§ Entry list retrieving
Dispatch the preliminary (unfiltered) entry-list retriever.
Further implementation for queries might speed the things up.
(cl-defgeneric org-roam-blog--entry-list-pre-builder (root-spec)
"Initial entry list retriever based on the ROOT-SPEC.")
(cl-defmethod org-roam-blog--entry-list-pre-builder
((root-spec (head all)))
"Just returns `org-roam-node-list' function symbol to get all Roam's nodes."
#'org-roam-node-list)
(cl-defmethod org-roam-blog--entry-list-pre-builder
((root-spec (head node)))
"Returned lambda gets entries' subheadings of the node's heading
as Org-Roam nodes (generate and save their Id's when needed).
The NODE ROOT-SPEC can specify entry heading offset other than 1
via :ENTRY-OFFSET keyword property."
(lambda ()
(with-current-buffer
(org-roam-node-find-noselect
(org-roam-node-from-id (cadr root-spec)) t)
(remove-if #'null
(let ((root-level (org-current-level))
(entry-offset (or (getf root-spec :entry-offset) 1)))
(org-map-entries
(lambda ()
(when (= root-level
(- (org-current-level) entry-offset))
(org-id-get-create)
(when (buffer-modified-p)
(save-buffer)
(org-roam-db-update-file))
(org-roam-node-at-point)))
nil 'tree))))))
Using previously defined dispatches, as well as filter-fn and sort-fn,
the following should return final entry node list for index.
(defun org-roam-blog--index-entry-list (index)
"Return filtered list of Roam entries to be published for INDEX."
(let* ((filter-fn (org-roam-blog-index-filter-fn index))
(sort-fn (org-roam-blog-index-sort-fn index))
(group-by (org-roam-blog-index-group-by index))
(nodes (funcall (org-roam-blog--entry-list-pre-builder
(org-roam-blog-index-root-spec index))))
(nodes (cl-remove-if-not (lambda (n)
(if filter-fn (funcall filter-fn n) t)) nodes))
(_ (when sort-fn (setq nodes (seq-sort sort-fn nodes)))))
(if (zerop group-by)
(list nodes)
(seq-partition nodes group-by))))
§ Default Index context builder
Default index context builder returns a (paginated) list of context tables.
(defsubst org-roam-blog--index-context-default (index &optional entry-list)
"Sample constructor of a context for INDEX.
Set in \"context-fn\" field by default.
Optionally accepts pre-built ENTRY-LIST."
(let* ((title (org-roam-blog-index-title index))
(slug (org-roam-blog-index-slug index))
(entry-dir (org-roam-blog-index-entry-dir index))
(media-dir (org-roam-blog-index-media-dir index))
(entry-list (or entry-list (org-roam-blog--index-entry-list index)))
(page-max (length entry-list)))
(cl-loop for page-num from 1
for entry-group in entry-list
collect (let ((entry-group
(mapcar (org-roam-blog-index-entry-context-fn index)
entry-group))
(prev-page
(if (> page-num 1)
(format "/%s/%s-%s.html"
slug
org-roam-blog-index-filename-prefix
(1- page-num))
"")) ; must result in a string to render in mustache
(next-page
(if (< page-num page-max)
(format "/%s/%s-%s.html"
slug
org-roam-blog-index-filename-prefix
(1+ page-num))
""))) ; must result in a string to render in mustache
(ht ("title" title)
("slug" slug)
("entry-dir" entry-dir)
("media-dir" media-dir)
("entries" entry-group)
("page" page-num)
("page-max" page-max)
("prev-page" prev-page)
("has-prev-page" (not (string-empty-p prev-page)))
("next-page" next-page)
("has-next-page" (not (string-empty-p next-page))))))))
§ Entry context list
(defsubst org-roam-blog--build-entry-context-list (index &optional entry-list)
"Prototype function to get a list of entry contexts for INDEX publishing.
Optionally accepts pre-built grouped ENTRY-LIST, meant be flattened."
(cl-loop for node in (flatten-list
(or entry-list
(org-roam-blog--index-entry-list index)))
collect (list node
(funcall (org-roam-blog-index-entry-context-fn index) node))))
§ TODO Also grab counters for the context here
As logic for index page numbering also goes.
§ Entry relative path (URL)
Definitions that allow to get relative path of an entry inside the resulting site file structure - that for static pages also serves as URL.
(defsubst org-roam-blog--subdir-for-index (index)
"Return relative subdirectory for entry outputs for the INDEX
inside the staging directory."
(if-let ((index-slug (org-roam-blog-index-slug index))
(entry-dir (org-roam-blog-index-entry-dir index)))
(concat index-slug "/" entry-dir)
index-slug))
(defsubst org-roam-blog--relative-entry-url (node index)
"Output relative entry url path for an entry defined by NODE and
an INDEX, implying that this INDEX is a leading one for the NODE."
(let ((fname
(funcall (org-roam-blog-index-entry-fname-fn index) node))
(subdir (org-roam-blog--subdir-for-index index)))
(string-trim (concat "/" subdir "/" fname))))
