@@ -1,125 +1,28 @@ #lang racket/base ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. -(require deta db/base db/sqlite3 threading txexpr gregor) - -(require racket/match +(require deta + db/base + db/sqlite3 + threading + racket/match racket/string - pollen/pagetree + txexpr pollen/template (except-in pollen/core select) ; avoid conflict with deta - pollen/setup) - -(require "dust.rkt" "snippets-html.rkt") - -(provide init-cache-db! - cache-conn ; The most eligible bachelor in Neo Yokyo - parse-and-cache-article! - cache-series! - current-plain-title - (schema-out cache:article) - (schema-out cache:note) - (schema-out cache:series) - (schema-out cache:index-entry) - articles - articles+notes - listing-htmls - - - - unfence) - -;; Cache DB and Schemas - -(define DBFILE (build-path (current-project-root) "vitreous.sqlite")) -(define cache-conn (sqlite3-connect #:database DBFILE #:mode 'create)) - -(define current-plain-title (make-parameter "void")) - -(define-schema cache:article #:table "articles" - ([id id/f #:primary-key #:auto-increment] - [page symbol/f] - [title-plain string/f] - [title-html-flow string/f] - [title-specified? boolean/f] - [published string/f] - [updated string/f] - [author string/f] - [conceal string/f] - [series-page symbol/f] - [noun-singular string/f] - [note-count integer/f] - [doc-html string/f] - [disposition string/f] - [disp-html-anchor string/f] - [listing-full-html string/f] ; full content but without notes - [listing-excerpt-html string/f] ; Not used for now - [listing-short-html string/f])) ; Date and title only - -(define-schema cache:note #:table "notes" - ([id id/f #:primary-key #:auto-increment] - [page symbol/f] - [html-anchor string/f] - [title-html-flow string/f] ; No block-level HTML elements - [title-plain string/f] - [author string/f] - [author-url string/f] - [published string/f] - [disposition string/f] - [content-html string/f] - [series-page symbol/f] - [conceal string/f] - [listing-full-html string/f] - [listing-excerpt-html string/f] ; Not used for now - [listing-short-html string/f])) ; Date and title only - -(define-schema cache:series #:table "series" - ([id id/f #:primary-key #:auto-increment] - [page symbol/f] - [title string/f] - [published string/f] - [noun-plural string/f] - [noun-singular string/f])) - -(define-schema cache:index-entry #:table "index_entries" - ([id id/f #:primary-key #:auto-increment] - [entry string/f] - [subentry string/f] - [page symbol/f] - [html-anchor string/f])) - -(define-schema listing - #:virtual - ([html string/f] - [published date/f] - [series-page symbol/f])) - -(define (init-cache-db!) - (create-table! cache-conn 'cache:article) - (create-table! cache-conn 'cache:note) - (create-table! cache-conn 'cache:series) - (create-table! cache-conn 'cache:index-entry)) - -(define (delete-article! page) - (query-exec cache-conn - (~> (from cache:article #:as a) - (where (= a.page ,(format "~a" page))) - delete))) - -(define (delete-notes! page) - (query-exec cache-conn - (~> (from cache:note #:as n) - (where (= n.page ,(format "~a" page))) - delete))) - +) + +(require "dust.rkt" "cache.rkt" "snippets-html.rkt") + +(provide parse-and-cache-article! + cache-series!) ;; Save an article and its notes (if any) to the database, and return the ;; rendered HTML of the complete article. -;; (define (parse-and-cache-article! pagenode doc) (define-values (doc-no-title maybe-title) (splitf-txexpr doc (make-tag-predicate 'title))) (define-values (body-txpr note-txprs) (splitf-txexpr doc-no-title (make-tag-predicate 'note))) @@ -327,99 +230,10 @@ (void (apply insert! cache-conn (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode)))))) -;; -;; ~~~ Fetching articles and notes ~~~ -;; - -;; (Private use) Conveniece function for the WHERE `series-page` clause -(define (where-series q s) - (define (s->p x) (format "~a/~a.html" series-folder x)) - (match s - [(list series ...) - (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...) - [(or (? string? series) (? symbol? series)) - (where q (= a.series-page ,(s->p series)))] ; WHERE series-page = "item" - [#t - (where q (= a.series-page ,(path->string (here-output-path))))] - [_ q])) - -;; (Private use) Convenience for the WHERE `conceal` NOT LIKE clause -(define (where-not-concealed q) - (define base-clause (where q (not (like a.conceal "%all%")))) - (match (listing-context) - ["" base-clause] - [(var context) (where base-clause (not (like a.conceal ,(format "%~a%" context))))])) - -;; Needed to "parameterize" column names -;; see https://github.com/Bogdanp/deta/issues/14#issuecomment-573344928 -(require (prefix-in ast: deta/private/ast)) - -;; Builds a query to fetch articles -(define (articles type #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) - (define html-field (format "listing_~a_html" type)) - (~> (from cache:article #:as a) - (select (fragment (ast:as (ast:qualified "a" html-field) "html")) - a.published - a.series-page - a.conceal) - (where-series s) - (where-not-concealed) - (limit ,lim) - (order-by ([a.published ,ord])) - (project-onto listing-schema))) - -;; Builds a query that returns articles and notes intermingled chronologically -(define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) - (define html-field (format "listing_~a_html" type)) - (~> (from (subquery - (~> (from cache:article #:as A) - (select (fragment (ast:as (ast:qualified "A" html-field) "html")) - A.published - A.series-page - A.conceal) - (union - (~> (from cache:note #:as N) - (select (fragment (ast:as (ast:qualified "N" html-field) "html")) - N.published - N.series-page - N.conceal))))) - #:as a) - (where-series s) - (where-not-concealed) - (limit ,lim) - (order-by ([a.published ,ord])) - (project-onto listing-schema))) - -;; Get all the a list of the HTML all the results in a query -(define (listing-htmls list-query) - (for/list ([l (in-entities cache-conn list-query)]) - (listing-html l))) - -;; Return cached HTML of articles and/or notes, fenced within a style txexpr to prevent it being -;; escaped by ->html. See also: definition of `unfence` - -;; E.g.: ( articles+notes) -(define ( query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) - `(style ,@(listing-htmls (query-func 'full #:series s #:limit lim #:order ord)))) -;; ^^^^^ - -(define ( query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) - `(style ,@(listing-htmls (query-func 'excerpt #:series s #:limit lim #:order ord)))) -;; ^^^^^^^^ - -(define ( query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) - `(style "
    " - ,@(listing-htmls (query-func 'short #:series s #:limit lim #:order ord)) - "
")) ;; ^^^^^^ - -;; Remove "" introduced by using ->html on docs containing output from -;; listing functions -(define (unfence html-str) - (regexp-replace* #px"<[\\/]{0,1}style>" html-str "")) ;; Save the current article to the `series` table of the SQLite cache ;; Should be called from a template for series pages (define (cache-series!) (define here-page (path->string (here-output-path)))