@@ -95,10 +95,11 @@ (define table_articles (make-table-schema "articles" table_articles-fields)) (define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id))) (define table_series (make-table-schema "series" table_series-fields)) +;; Split all ◊note tags out of the Pollen doc (define (doc->body/notes doc) (define (is-note? tx) (and (txexpr? tx) (equal? 'note (get-tag tx)))) (splitf-txexpr doc is-note?)) ;; ~~~ Provided functions: Initializing; Saving posts and notes @@ -119,12 +120,15 @@ (define-values (disposition disp-note-id) (notes->last-disposition-values note-txprs)) (define-values (title-plain title-html-flow) (make-article-titles (maybe-meta 'title (default-title pubdate)) disposition)) + (define series-node (maybe-meta 'series)) (define header (html$-article-open title-html-flow pubdate)) - (define footer (html$-article-close)) + + (define footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))) + (define footer (html$-article-close footertext)) (define notes-section-html (crystalize-notes! pagenode title-plain note-txprs)) ;; Values must come in the order defined in table_article_fields (define article-record @@ -133,11 +137,11 @@ title-html-flow pubdate (maybe-meta 'updated) (maybe-meta 'author default-authorname) (maybe-meta 'conceal) - (maybe-meta 'series) + series-node (maybe-meta 'noun (series-noun)) (length note-txprs) doc-html disposition disp-note-id @@ -147,10 +151,14 @@ (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record) ◊string-append{◊header ◊doc-html ◊notes-section-html ◊footer}) +;; ~~~ Article-related helper functions ~~~ +;; + +;; Given a disposition and title, return both a plain-text and HTML version of the title (define (make-article-titles title-val disposition) (define disposition-part (cond [(non-empty-string? disposition) (define-values (mark _) (disposition-values disposition)) (format "~a" mark)] @@ -158,20 +166,61 @@ (cond [(txexpr? title-val) (values (apply string-append (tx-strs title-val)) (string-append (->html title-val) disposition-part))] [else (values title-val (string-append title-val disposition-part))])) + +;; Convert a bunch of information about an article into some nice English and links. +(define (make-article-footertext pagenode series disposition disp-note-id note-count) + (define s-title (series-title)) + (define s-noun (series-noun)) + (define series-part + (cond [(non-empty-string? series-title) + (format "This is ~a, part of ‘~a’." + s-noun + series + s-title)] + [else ""])) + (define disp-part + (cond [(non-empty-string? disposition) + (define-values (mark verb) (disposition-values disposition)) + (format "Now considered ~a ~a." + pagenode + disp-note-id + mark + verb)] + [else ""])) + (define notes-part + (cond [(note-count . > . 1) + (format "There are ~a notes appended." + pagenode + note-count)] + [(and (note-count . > . 0) (string=? disposition "")) + (format "There is a note appended." + pagenode)] + [else ""])) + (format "~a ~a ~a" series-part disp-part notes-part)) + + +;; ~~~ Notes ~~~ + +;; Save a collection of ◊note tags to the DB, and return the HTML of the complete +;; “Further Notes” section at the end +;; (define (crystalize-notes! pagenode parent-title note-txprs) (define (crystalizer note-tx) (crystalize-note! note-tx (symbol->string pagenode) parent-title)) (cond [((length note-txprs) . > . 0) (define notes-html (map crystalizer note-txprs)) (html$-notes-section notes-html)] [else ""])) +;; Save an individual note to the DB and return the HTML of the complete note as +;; it should appear on an individual article page +;; (define (crystalize-note! note-tx pagenode parent-title-plain) (define-values (_ attrs elems) (txexpr->values note-tx)) (define disposition-attr (maybe-attr 'disposition attrs)) (define note-date (maybe-attr 'date attrs))