Overview
Comment: | Split cache schema and fetchers into a separate module |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
cb8af9fcd70a9471978978ac9be749a6 |
User & Date: | joel on 2020-02-02 04:20:23 |
Other Links: | manifest | tags |
Context
2020-02-02
| ||
04:53 | Include bold type check-in: 4fecf9d9 user: joel tags: trunk | |
04:20 | Split cache schema and fetchers into a separate module check-in: cb8af9fc user: joel tags: trunk | |
2020-02-01
| ||
22:54 | Remove filter property on home page image, closes [0d5932bd9996832b] check-in: 1129e752 user: joel tags: trunk | |
Changes
Modified blog.rkt from [abf461d1] to [75b9d900].
1 2 3 4 5 6 7 8 | #lang pollen/mode racket/base ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. ;; Builds the paginated “blog” HTML files (blog-pg1.html ...) from the SQLite cache ;; The files will be written out every time this module is evaluated! (see end) | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | #lang pollen/mode racket/base ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. ;; Builds the paginated “blog” HTML files (blog-pg1.html ...) from the SQLite cache ;; The files will be written out every time this module is evaluated! (see end) (require "cache.rkt" "snippets-html.rkt" "dust.rkt" racket/file sugar/list) (provide main) |
︙ | ︙ |
Added cache.rkt version [7fc7c05e].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | #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 <listing-full> <listing-excerpt> <listing-short> 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.: (<listing-full> articles+notes) (define (<listing-full> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) `(style ,@(listing-htmls (query-func 'full #:series s #:limit lim #:order ord)))) ;; ^^^^^ (define (<listing-excerpt> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) `(style ,@(listing-htmls (query-func 'excerpt #:series s #:limit lim #:order ord)))) ;; ^^^^^^^^ (define (<listing-short> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc]) `(style "<ul class=\"article-list\">" ,@(listing-htmls (query-func 'short #:series s #:limit lim #:order ord)) "</ul>")) ;; ^^^^^^ ;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from ;; listing functions (define (unfence html-str) (regexp-replace* #px"<[\\/]{0,1}style>" html-str "")) |
Modified crystalize.rkt from [f45f7570] to [c41782ea].
1 2 3 4 5 | #lang racket/base ; SPDX-License-Identifier: BlueOak-1.0.0 ; This file is licensed under the Blue Oak Model License 1.0.0. | | | > > | | < | > | < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | #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 racket/match racket/string txexpr pollen/template (except-in pollen/core select) ; avoid conflict with deta ) (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))) (define-values (disposition disp-note-id) (notes->last-disposition-values note-txprs)) |
︙ | ︙ | |||
325 326 327 328 329 330 331 | (where (= entry.page ,(symbol->string pagenode)))))) (unless (null? entry-txs) (void (apply insert! cache-conn (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode)))))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 228 229 230 231 232 233 234 235 236 237 238 239 240 241 | (where (= entry.page ,(symbol->string pagenode)))))) (unless (null? entry-txs) (void (apply insert! cache-conn (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode)))))) ;; 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))) (query-exec cache-conn (delete (~> (from cache:series #:as s) |
︙ | ︙ |
Modified keyword-index.rkt from [50258609] to [d37c4752].
︙ | ︙ | |||
10 11 12 13 14 15 16 | racket/list racket/file racket/string db/base net/uri-codec pollen/template) | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | racket/list racket/file racket/string db/base net/uri-codec pollen/template) (require "cache.rkt" "dust.rkt" "snippets-html.rkt") (provide main) ;; Terminology (because these things get confusing fast) ;; |
︙ | ︙ |
Modified makefile from [ceed52b6] to [223b34de].
1 2 3 4 5 6 7 8 9 | # SPDX-License-Identifier: BlueOak-1.0.0 # This file is licensed under the Blue Oak Model License 1.0.0. SHELL = /bin/bash # ~~~ Variables used by rules ~~~ # core-files := pollen.rkt dust.rkt | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | # SPDX-License-Identifier: BlueOak-1.0.0 # This file is licensed under the Blue Oak Model License 1.0.0. SHELL = /bin/bash # ~~~ Variables used by rules ~~~ # core-files := pollen.rkt dust.rkt html-deps := snippets-html.rkt tags-html.rkt crystalize.rkt cache.rkt article-sources := $(wildcard articles/*.poly.pm) articles-html := $(patsubst %.poly.pm, %.html, $(article-sources)) articles-pdf := $(patsubst %.poly.pm, %.pdf, $(article-sources)) series-sources := $(wildcard series/*.poly.pm) series-html := $(patsubst %.poly.pm, %.html, $(series-sources)) |
︙ | ︙ |
Modified pollen.rkt from [ec6e30b5] to [5f7205ca].
︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 | racket/syntax syntax/parse pollen/setup)) (require pollen/tag pollen/setup racket/function "tags-html.rkt" "snippets-html.rkt" "crystalize.rkt") (provide (all-defined-out) | > | > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | racket/syntax syntax/parse pollen/setup)) (require pollen/tag pollen/setup racket/function "cache.rkt" "tags-html.rkt" "snippets-html.rkt" "crystalize.rkt") (provide (all-defined-out) (all-from-out "crystalize.rkt" "snippets-html.rkt" "cache.rkt")) (module setup racket/base (require syntax/modresolve racket/runtime-path pollen/setup) (provide (all-defined-out)) (define poly-targets '(html)) (define block-tags (append '(title style dt note) default-block-tags)) (define-runtime-path tags-html.rkt "tags-html.rkt") (define-runtime-path snippets-html.rkt "snippets-html.rkt") (define-runtime-path dust.rkt "dust.rkt") (define-runtime-path crystalize.rkt "crystalize.rkt") (define-runtime-path cache.rkt "cache.rkt") (define cache-watchlist (map resolve-module-path (list tags-html.rkt snippets-html.rkt dust.rkt cache.rkt crystalize.rkt)))) (case (current-poly-target) [(html) (init-cache-db!)]) ;; Macro for defining tag functions that automatically branch based on the ;; current output format and the list of poly-targets in the setup module. |
︙ | ︙ |
Modified rss-feed.rkt from [ca1031f8] to [502871b7].
︙ | ︙ | |||
8 9 10 11 12 13 14 | (require txexpr racket/match racket/file racket/date racket/string db/base "dust.rkt" | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | (require txexpr racket/match racket/file racket/date racket/string db/base "dust.rkt" "cache.rkt") (provide main) (define feed-author default-authorname) (define feed-author-email "joel@jdueck.net") (define feed-title "The Local Yarn (Beta)") (define feed-site-url "https://thelocalyarn.com") |
︙ | ︙ |