#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 pollen/setup racket/match "dust.rkt" (except-in pollen/core select)) (provide init-cache-db! cache-conn ; The most eligible bachelor in Neo Yokyo (schema-out cache:article) (schema-out cache:note) (schema-out cache:series) (schema-out cache:index-entry) delete-article! delete-notes! current-plain-title 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))) ;; ;; ~~~ 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 ""))