Index: blog.rkt
==================================================================
--- blog.rkt
+++ blog.rkt
@@ -36,17 +36,15 @@
◊html$-page-body-close[]
</html>})
;; Grabs all the articles+notes from the cache and writes out all the blog page files
(define (build-blog)
- (spell-of-summoning!) ; Turn on the DB
-
- (define articles+notes (slice-at (list/articles+notes 'listing_full_html #:series #f) per-page))
- (define pagecount (length articles+notes))
+ (define arts-n-notes (slice-at (listing-htmls (articles+notes 'full #:series #f)) per-page))
+ (define pagecount (length arts-n-notes))
(for ([pagenum (in-range 1 (+ 1 pagecount))]
- [page (in-list articles+notes)])
+ [page (in-list arts-n-notes)])
(define filename (format "blog-pg~a.html" pagenum))
(displayln (format "Writing: ~a" filename))
(display-to-file (blog-page (apply string-append page) pagenum pagecount)
filename
#:mode 'text
Index: code-docs/crystalize.scrbl
==================================================================
--- code-docs/crystalize.scrbl
+++ code-docs/crystalize.scrbl
@@ -9,10 +9,11 @@
"../dust.rkt"
"../crystalize.rkt"
racket/base
racket/contract
racket/string
+ deta
txexpr
pollen/template
pollen/pagetree
sugar/coerce))
@@ -20,86 +21,61 @@
@defmodule["crystalize.rkt" #:packages ()]
“Crystalizing” is an extra layer in between docs and templates that destructures the doc and stores
it in various pieces in a SQLite cache. Individual articles save chunks of rendered HTML to the
-cache when their individual pages are rendered. The SQLite cache is then referenced by any page that
-collects multiple articles and notes together. This is much faster than fetching docs and metas
-through Pollen’s cache and re-converting them to HTML.
-
-@defproc[(spell-of-summoning!) void?]
-
-Initializes the SQLite database cache file. This involves creating the file
-(@filepath{vitreous.sqlite}) if it does not exist, and running queries to create tables in the
-database if they do not exist.
+cache when their individual pages are rendered. When pulling together listings of articles in
+different contexts that need to be filtered and sorted, a SQL query is much faster than trolling
+through the Pollen cache for matching docs and regenerating the HTML.
+
+@defproc[(init-cache-db!) void?]
+
+Initializes the SQLite database cache file (named @filepath{vitreous.sqlite} and located in the
+project root folder) by running queries to create tables in the database if they do not exist. (The
+file itself is created at the module level.)
This function is called automatically in @filepath{pollen.rkt} whenever HTML is the target output.
-@defproc[(crystalize-article! [pagenode pagenode?] [doc txexpr?]) non-empty-string?]
+@defproc[(parse-and-cache-article! [pagenode pagenode?] [doc txexpr?]) non-empty-string?]
Returns a string containing the HTML of @racket[_doc]. @margin-note{This is one function that breaks
-my convention of using a prefix of @tt{html$-} for functions that return strings of HTML.}
-Privately, it does a lot of other work. The article is saved to the SQLite cache. If the article
-specifies a @racket['series] meta, information about that series is fetched and used in the
-rendering of the article. If there are @racket[note]s in the doc, they are parsed and saved
-individually to the SQLite cache. If any of the notes use the @code{#:disposition} attribute,
-information about the disposition is parsed out and used in the rendering of the article.
-
-@defproc[(crystalize-series!) void?]
-
-Saves metas for the current series page in the SQLite cache. Meant to be called from the HTML
-template for “Series” pages (Pollen documents located in @racket[series-folder]).
-
-@defproc[(crystalize-index-entries! [pagenode pagenode?] [doc txexpr?]) void?]
-
-Saves any @racket[index] enries entries in @racket[_doc] to the SQLite cache.
-
-@margin-note{This function was originally private; I provided it out only so it could be called
-manually from @tt{index.html.pp}.}
-
-@deftogether[(@defproc[(list/articles [type (or/c 'listing_full_html
- 'listing_short_html
- 'listing_excerpt_html)]
- [#:series series (or/c string? boolean?) #t]
- [#:limit limit stringish? -1]
- [order string? "DESC"]) (listof string?)]
- @defproc[(list/articles+notes [type (or/c 'listing_full_html
- 'listing_short_html
- 'listing_excerpt_html)]
- [#:series series (or/c string? boolean?) #t]
- [#:limit limit stringish? -1]
- [order string? "DESC"]) (listof string?)])]
-
-Fetches the HTML for all articles from the SQLite cache and returns a list of strings containing the
-HTML for each. The articles will be ordered by publish date according to @racket[_order] and
-optionally limited to the series specified in @racket[_series].
-
-If @racket[_series] expression evaluates to @racket[#f], articles will not be filtered by series. If
-it evaluates to @racket[#t] (the default), articles will be filtered by those that specify the
-current output of @racket[here-output-path] in their @tt{series_pagenode} column in the SQLite
-cache. If a string is supplied, articles will be filtered by those containing that exact value in
-their @tt{series_pagenode} column in the SQLite cache.
-
-The @racket[_order] expression must evaluate to either @racket["ASC"] or @racket["DESC"] and the
-@racket[_limit] expressions must evaluate to a value suitable for use in the @tt{LIMIT} clause of
-@ext-link["https://sqlite.org/lang_select.html"]{a SQLite @tt{SELECT} statement}. An expression that
-evaluates to a negative integer (the default) is the same as having no limit.
-
-@deftogether[(@defproc[(listing<>-short/articles [#:series series (or/c string? boolean?) #t]
- [#:limit limit stringish? -1]
- [order string? "DESC"]) txexpr?]
- @defproc[(listing<>-full/articles [#:series series (or/c string? boolean?) #t]
- [#:limit limit stringish? -1]
- [order string? "DESC"]) txexpr?])]
-
-@margin-note{Notice how the functions that start with @tt{list/} return lists and the functions that
-start with @tt{listing<>} return fenced HTML strings. Maybe this is ugly, but it helps me keep these
-otherwise too-similar sets of functions straight in my head.}
-
-Fetches the HTML for all articles from the SQLite cache and returns the HTML strings fenced inside
-a @racket['style] tagged X-expression. The articles will be ordered by publish date according to
+my convention of using a prefix of @tt{html$-} for functions that return a single string of HTML.}
+
+Privately, it does a lot of other work. The article is analyzed, additional metadata is constructed,
+and it is saved to the SQLite cache. If the article specifies a @racket['series] meta, information
+about that series is fetched and used in the rendering of the article. If there are @racket[note]s
+in the doc, they are parsed and saved individually to the SQLite cache. If any of the notes use the
+@code{#:disposition} attribute, information about the disposition is parsed out and used in the
+rendering of the article.
+
+@deftogether[(@defproc[(<listing-full>
+ [query-func (-> any/c query?)]
+ [#:series series (or/c string? (listof string? boolean?)) #t]
+ [#:limit limit integer? -1]
+ [order stringish? 'desc]) txexpr?]
+ @defproc[(<listing-excerpt>
+ [query-func (-> any/c query?)]
+ [#:series series (or/c string? (listof string? boolean?)) #t]
+ [#:limit limit integer? -1]
+ [order stringish? 'desc]) txexpr?]
+ @defproc[(<listing-short>
+ [query-func (-> any/c query?)]
+ [#:series series (or/c string? (listof string? boolean?)) #t]
+ [#:limit limit integer? -1]
+ [order stringish? 'desc]) txexpr?])]
+
+Fetches the HTML for items from the SQLite cache and returns the HTML strings fenced inside
+a @racket['style] tagged X-expression. The items will be ordered by publish date according to
@racket[_order] and optionally limited to the series specified in @racket[_series].
+
+The @racket[_query-func] should be either @racket[articles], which will create a listing of articles
+only, or @racket[articles+notes], which will include notes intermingled with articles.
+
+@margin-note{Note that the signature shown for the @racket[_query-func] argument above is
+incomplete. If you choose to pass a function other than @racket[articles] or
+@racket[articles+notes], you must use a function with exactly the same signature as those
+functions.}
If @racket[_series] expression evaluates to @racket[#f], articles will not be filtered by series. If
it evaluates to @racket[#t] (the default), articles will be filtered by those that specify the
current output of @racket[here-output-path] in their @tt{series_pagenode} column in the SQLite
cache. If a string is supplied, articles will be filtered by those containing that exact value in
@@ -114,29 +90,38 @@
escaped by @racket[->html] in the template. This tag was picked for the job because there will
generally never be a need to include any actual CSS information inside a @tt{<style>} tag in any
page, so it can be safely filtered out later. To remove the enclosing @tt{<style>} tag, see
@racket[unfence].
-@defproc[(listing<>-full/articles+notes [#:series series (or/c string? #f) #f]
- [#:limit limit exact-integer? -1]
- [order string? "DESC"]) txexpr?]
+@deftogether[(@defproc[(articles [type (or/c 'full 'excerpt 'short)]
+ [#:series series (or/c string? (listof string? boolean?)) #t]
+ [#:limit limit integer? -1]
+ [order stringish? 'desc]) query?]
+ @defproc[(articles+notes [type (or/c 'full 'excerpt 'short)]
+ [#:series series (or/c string? (listof string? boolean?)) #t]
+ [#:limit limit integer? -1]
+ [order stringish? 'desc]) query?])]
+
+Create a query that fetches either articles only (@racket[articles]) or articles and notes
+intermingled (@racket[articles+notes]), sorted by publish date and optionally limited to
+a particular series.
-Like @racket[listing<>-full/articles] except that notes and articles are combined side by side in
-the results.
+Typically you will pass these functions by name to listing functions like @racket[<listing-full>]
+rather than calling them directly.
@defproc[(unfence [html string?]) string?]
Returns @racket[_html] with all occurrences of @racket["<style>"] and @racket["</style>"] removed.
The contents of the style tags are left intact.
-Use this with strings returned from @racket[->html] when called on docs containing
-@racket[listing<>-full/articles] or its siblings.
-
-@defproc[(article-plain-title [pagenode pagenode?]) non-empty-string?]
-
-Fetches the “plain” title (i.e., with no HTML markup) for the given article from the SQLite cache.
-If the article did not specify a title, a default title is supplied. If the article contained
-a @racket[note] that used the @code{#:disposition} attribute, the disposition-mark may be included
-in the title.
-
-Note that this needs to be called @emph{after} @racket[crystalize-article!] in order to get an
+Use this with strings returned from @racket[->html] when called on docs that use the
+@racket[<listing-full>] tag function or its siblings.
+
+@defparam[current-plain-title non-empty-string? #:value "void"]
+
+Contains (or sets) the “plain” title (i.e., with no HTML markup) for the current article based on
+analysis done by @racket[parse-and-cache-article!]. If the article did not specify a title,
+a default title is supplied. If the article contained a @racket[note] that used the
+@code{#:disposition} attribute, the disposition-mark may be included in the title.
+
+Note that this needs to be called @emph{after} @racket[parse-and-cache-article!] in order to get an
up-to-date value.
Index: code-docs/dust.scrbl
==================================================================
--- code-docs/dust.scrbl
+++ code-docs/dust.scrbl
@@ -159,21 +159,21 @@
"individual as Queequeg circulating among the polite society of a civilized "
"town, that astonishment soon departed upon taking my first daylight "
"stroll through the streets of New Bedford…")))
(default-title (get-elements doc))]
-@defproc[(series-pagenode) pagenode?]
+@defproc[(metas-series-pagenode) pagenode?]
If @code{(current-metas)} has the key @racket['series], converts its value to the pagenode pointing to
that series, otherwise returns @racket['||].
-@defproc[(series-noun) string?]
+@defproc[(series-metas-noun) string?]
If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta
value for @racket['noun-singular], then return it, otherwise return @racket[""].
-@defproc[(series-title) string?]
+@defproc[(series-metas-title) string?]
If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta
value for @racket['title], then return it, otherwise return @racket[""].
@defproc[(invalidate-series) (or/c void? boolean?)]
Index: code-docs/main.scrbl
==================================================================
--- code-docs/main.scrbl
+++ code-docs/main.scrbl
@@ -28,9 +28,8 @@
@local-table-of-contents[]
@include-section["overview.scrbl"]
@include-section["pollen.scrbl"] @; pollen.rkt
@include-section["dust.scrbl"] @; dust.rkt
-@include-section["sqlite-tools.scrbl"] @; sqlite-tools.rkt
@include-section["snippets-html.scrbl"] @; you get the idea
@include-section["crystalize.scrbl"]
DELETED code-docs/sqlite-tools.scrbl
Index: code-docs/sqlite-tools.scrbl
==================================================================
--- code-docs/sqlite-tools.scrbl
+++ code-docs/sqlite-tools.scrbl
@@ -1,200 +0,0 @@
-#lang scribble/manual
-
-@; SPDX-License-Identifier: BlueOak-1.0.0
-@; This file is licensed under the Blue Oak Model License 1.0.0.
-
-@(require "scribble-helpers.rkt"
- scribble/example)
-
-@(require (for-label "../pollen.rkt"
- "../sqlite-tools.rkt"
- racket/base
- racket/contract
- db
- sugar/coerce))
-
-@(define my-eval (make-base-eval))
-@(my-eval '(require "sqlite-tools.rkt"))
-
-@title{@filepath{sqlite-tools.rkt}}
-
-@defmodule["sqlite-tools.rkt" #:packages ()]
-
-Provides a very light set of utility functions for managing a single SQLite database. These
-functions are completely agnostic as to the database schema.
-
-It is important to note, these functions are @bold{not safe} for use with data provided by untrusted
-users! In many places they use @racket[format] to blindly insert table and field names, which is
-dangerous (see @secref["dbsec-sql-injection" #:doc '(lib "db/scribblings/db.scrbl")]). It’s fine for
-this project, since its only use of a database is as a disposable cache that can be safely deleted
-and regenerated at any time, and there are no users except me.
-
-@section{Parameters}
-
-@defparam[sqltools:dbc con connection? #:value "No DB connection!"]
-
-The current database connection. This module assumes a single active connection and stores it in
-this parameter so you don’t have to pass it to a function every time you execute a query. It’s
-provided here so you can use it directly with the functions provided by @racketmodname[db] (all of
-which are re-provided by this module for convenience).
-
-@defboolparam[sqltools:log-queries? v #:value #f]
-
-A kill-switch that determines whether @racket[log-query] does anything.
-
-@section{SQL building-blocks}
-
-@defproc[(log-query [str string?]) void?]
-
-Prints @racket[_str] to standard output with @racket[println], but only if
-@racket[(sqltools:log-queries?)] is not @code{#f}.
-
-This is called by every function in this module that actually executes database queries (i.e., those
-whose names end in @tt{!}), so if you need to you can see what’s actually being sent to the
-database.
-
-@defproc[(backtick [str stringish?]) string?]
-
-Returns @racket[_str] surrounded by backticks.
-
-@examples[#:eval my-eval
-(backtick "field")]
-
-@defproc[(list->sql-fields [lst (listof stringish?)]) string?]
-
-Given a list of values, returns a single string containing the list elements in order, surrounded
-by backticks and separated by commas.
-
-@examples[#:eval my-eval
-(list->sql-fields '("id" "name" "address"))
-(list->sql-fields '(or use symbols))]
-
-@defproc[(list->sql-values [lst (listof any/c)]) string?]
-
-Given a list of values, return a string containing those values separated by commas inside a pair of
-parentheses. Any string values in the list will be surrounded by quote marks.
-
-@examples[#:eval my-eval
-(list->sql-values '(0 "hello" NULL 34))]
-
-@defproc[(list->sql-parameters [lst (listof stringish?)]) string?]
-
-Given a list of values, return a single string with numbered parameter placeholders, suitable for
-use in a parameterized SQL query.
-
-@examples[#:eval my-eval
-(list->sql-parameters '(name rank serial))]
-
-@deftogether[(@defproc[(bool->int [b any/c]) exact-integer?]
- @defproc[(int->bool [i exact-integer?]) boolean?])]
-
-SQLite has no “boolean” column type (in fact SQLite has no column types, period), so boolean values
-must be converted to/from the values @code{1} or @code{0}. When converting @emph{from} boolean,
-@code{#f} becomes @code{0} and any other value becomes @code{1}. When converting integers @emph{to}
-boolean, @code{0} becomes @code{#f} and any other value becomes @code{#t}.
-
-@examples[#:eval my-eval
-(bool->int #t)
-(bool->int "")
-(bool->int #f)
-(int->bool 1)
-(int->bool -100)
-(int->bool 0)]
-
-@defproc[(vector->hash [vec vector?] [fields (listof symbolish?)]) hash?]
-
-Returns a hash table which uses the values in @racket[_fields] as keys and the vector elements as
-the values. If @racket[_vec] and @racket[_fields] do not have the same number of elements, the
-returned hash will have only as many key/value pairs as the one with the fewest elements.
-
-The functions in Racket’s @racketmodname[db] module return query results as @seclink["vectors" #:doc
-'(lib "scribblings/reference/reference.scrbl")]{vectors}, but it is much easier to make use of them
-as hash tables, with the field names as keys.
-
-@examples[#:eval my-eval
-(vector->hash '#("Yossarian" "Cpt" "Z-247") '(name rank serial))
-
-(code:comment @#,elem{When v and fields are unequal in length:})
-(vector->hash '#("a" "b" "c") '(1 2))
-(vector->hash '#("a" "b") '(1 2 3))]
-
-@section{Tools for making query strings}
-
-These functions don’t actually do anything to the database. They just convert lists into various
-kinds of SQL query strings. This way you can use lists to define what you want from the database
-instead of writing out the queries by hand.
-
-Again, these functions use @racket[format] to build query strings, so they aren’t safe to use with
-user-supplied data; see the warning at the top of this document.
-
-@defproc[(make-table-schema [tablename string?]
- [fields (listof stringish?)]
- [#:primary-key-cols pk-cols (listof stringish?) '()])
- string?]
-
-Given a table name and a list of fields, returns a string containing the SQLite-flavored query that
-will create that table with those fields. If @racket[_pk-cols] is empty, the first value in
-@racket[_fields] is designated in the query as the primary key.
-
-@examples[#:eval my-eval
-(make-table-schema "vals" '(a b c))
-(make-table-schema "vals" '(a b c) #:primary-key-cols '(a b))]
-
-@defproc[(make-insert/replace-query [table stringish?] [fields (listof stringish?)]) string?]
-
-Returns a SQLite-flavored query for inserting/updating a record. The list of values to insert is
-parameterized so it can be used in conjunction with a @racket[list] of values.
-
-@examples[#:eval my-eval
-(make-insert/replace-query 'vals '(a b c))]
-
-This query relies on the fact that in SQLite every table contains a @tt{rowid} column by default.
-For more information on why/how the query works, see
-@ext-link["https://sqlite.org/lang_insert.html"]{the SQLite docs for @tt{INSERT}}.
-
-@defproc[(make-insert-rows-query [table stringish?] [fields (listof stringish?)] [rows (listof
-(listof any/c))]) string?]
-
-Returns a SQLite query string for inserting multiple rows.
-
-@examples[#:eval my-eval
-(make-insert-rows-query 'people '(id name) '((1 "Alice") (2 "Bob")))]
-
-@defproc[(make-select-query [table stringish?] [fields (listof stringish?)] [#:where where-clause
-stringish?]) string?]
-
-Returns a SQLite query string for selecting rows from the database.
-
-@examples[#:eval my-eval
-(make-select-query 'vals '(a b c) #:where 1)]
-
-@section{Query functions}
-
-These functions actually execute queries on the currently active database connection stored in the
-@racket[sqltools:dbc] parameter.
-
-@defproc[(init-db! [filename (or/c path-string? 'memory 'temporary)] [query statement?] ...) void?]
-
-Initialize the database connection using @racket[sqlite3-connect] with @racket['create] mode. The
-filename may be followed by any number of queries which will immediately be executed on the
-database; this can be useful for initializing tables and other setup tasks.
-
-The database connection will be stored in the @racket[sqltools:dbc] parameter. If that parameter
-already holds an active connection, it will be @racket[disconnect]ed and then replaced with the new
-connection.
-
-@defproc[(query! [query-statement statement?] [parameters any/c] ...) void?]
-
-Executes a SQL statement using the current connection.
-
-@defproc*[([(select-rows! [query statement?] [fieldnames (listof stringish?)]) (listof hash?)]
- [(select-rows! [table stringish?] [fieldnames (listof stringish?)] [where-clause
- stringish?]) (listof hash?)])]
-
-Execute a SQL query that returns rows from the database, either using a raw query (first form
-above), or using a table name, field names, and a @racket[_where-clause] (second form above).
-Returns a list of hashes whose keys are the values supplied in @racket[_fieldnames].
-
-In the first form, @racket[_fieldnames] should list @emph{in order} all the fields that will be
-returned by the query. If this isn’t done, the keys for each row’s hash will likely point to values
-for the wrong fields.
Index: crystalize.rkt
==================================================================
--- crystalize.rkt
+++ crystalize.rkt
@@ -1,242 +1,169 @@
#lang racket/base
; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.
-;; Provides functions for fast preserving and fetching of article/series data.
-;; → Docs and metas go in (saved to SQLite database)
-;; HTML comes out →
-;; Calling sites have no notion of the database or schema.
-
-;; The functions provided by sqlite-tools.rkt are not safe for user-provided
-;; data; a maliciously crafted input could bomb the database. This is acceptable
-;; since the database is merely a disposable cache, and since all the input
-;; will be coming from me.
-
-(require pollen/setup
- pollen/core
+(require deta db/base db/sqlite3 threading txexpr gregor)
+
+(require racket/match
+ racket/string
+ pollen/pagetree
pollen/template
- racket/string
- racket/function
- racket/list
- txexpr
- db/base
- "sqlite-tools.rkt"
- "snippets-html.rkt"
- "dust.rkt")
-
-;; ~~~ Provides ~~~
-
-(provide spell-of-summoning!
- crystalize-article!
- crystalize-series!
- crystalize-index-entries!
- article-plain-title
- list/articles
- list/articles+notes
- listing<>-short/articles
- listing<>-full/articles
- listing<>-full/articles+notes
- unfence
- sqltools:dbc
- preheat-series!)
-
-;; ~~~ Private use ~~~
+ (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
+ <listing-full>
+ <listing-excerpt>
+ <listing-short>
+ unfence)
+
+;; Cache DB and Schemas
(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))
-
-;; Since the DB exists to serve as a high-speed cache, the tables are constructed so that
-;; the most commonly needed data can be grabbed quickly with extremely simple queries. In
-;; the even that you want to do something fancy and custom rather than using the pre-cooked
-;; HTML, enough info is provided in the other columns to allow you to do so.
-;;
-(define table_articles-fields
- '(pagenode
- title_plain
- title_html_flow
- title_specified
- published
- updated
- author
- conceal
- series_pagenode
- noun_singular
- note_count
- doc_html
- disposition
- disposition_note_id
- listing_full_html ; Contains full content in default HTML format, but without notes
- listing_excerpt_html ; Not used for now
- listing_short_html)) ; Date and title only
-
-(define table_notes-fields
- '(pagenode
- note_id
- title_html_flow
- title_plain
- author
- author_url
- date
- disposition
- content_html
- series_pagenode
- listing_full_html
- listing_excerpt_html ; Not used for now
- listing_short_html))
-
-(define table_series-fields
- '(pagenode
- title
- published
- noun_plural
- noun_singular))
-
-(define table_keywordindex-fields
- '(entry
- subentry
- pagenode
- anchor))
-
-(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))
-(define table_keywordindex (make-table-schema "keywordindex"
- table_keywordindex-fields
- #:primary-key-cols '(pagenode anchor)))
-
-;; ~~~ Provided functions: Initializing; Saving posts and notes
-
-;; Initialize the database connection, creating the database if it doesn’t
-;; exist, and executing the table schema queries
-;;
-(define (spell-of-summoning!)
- (init-db! DBFILE table_articles table_notes table_series table_keywordindex))
+(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]
+ [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))
;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
-(define (crystalize-article! pagenode doc)
- (define-values
- (doc2 maybe-title) (splitf-txexpr doc (make-tag-predicate 'title)))
- (define-values
- (body-txpr note-txprs) (splitf-txexpr doc2 (make-tag-predicate 'note)))
+(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))
-
+
(let* ([pubdate (select-from-metas 'published (current-metas))]
[doc-html (->html body-txpr #:splice? #t)]
[title-specified? (not (equal? '() maybe-title))]
[title-val (if (not (null? maybe-title)) (car maybe-title) (check-for-poem-title doc))]
[title-tx (make-article-title pagenode title-val body-txpr disposition disp-note-id)]
[title-html (->html title-tx #:splice? #t)]
[title-plain (tx-strs title-tx)]
- [series-node (series-pagenode)]
[header (html$-article-open pagenode title-specified? title-tx pubdate)]
- [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]
+ [series-node (metas-series-pagenode)]
+ [footertext (make-article-footertext pagenode
+ series-node
+ disposition
+ disp-note-id
+ (length note-txprs))]
[footer (html$-article-close footertext)]
- [notes-section-html (crystalize-notes! pagenode title-plain note-txprs)])
-
- (crystalize-index-entries! pagenode doc) ; Note the original doc is used here
-
- ;; Values must come in the order defined in table_article_fields
- (define article-record
- (list (symbol->string pagenode)
- title-plain
- title-html
- (bool->int title-specified?)
- pubdate
- (maybe-meta 'updated)
- (maybe-meta 'author default-authorname)
- (maybe-meta 'conceal)
- (symbol->string series-node)
- (maybe-meta 'noun (series-noun))
- (length note-txprs)
- doc-html
- disposition
- disp-note-id
- (string-append header doc-html footer)
- "" ; listing_excerpt_html: Not yet used
- (html$-article-listing-short pagenode pubdate title-html)))
-
- (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
-
+ [listing-short (html$-article-listing-short pagenode pubdate title-html)]
+ [notes-section-html (cache-notes! pagenode title-plain note-txprs)])
+ (cache-index-entries! pagenode doc) ; note original doc is used here
+ (current-plain-title title-plain)
+ (insert-one! cache-conn
+ (make-cache:article
+ #:page pagenode
+ #:title-plain title-plain
+ #:title-html-flow title-html
+ #:title-specified? title-specified?
+ #:published pubdate
+ #:updated (maybe-meta 'updated)
+ #:author (maybe-meta 'author default-authorname)
+ #:conceal (maybe-meta 'conceal)
+ #:series-page series-node
+ #:noun-singular (maybe-meta 'noun (series-metas-noun))
+ #:note-count (length note-txprs)
+ #:doc-html doc-html
+ #:disposition disposition
+ #:disp-html-anchor disp-note-id
+ #:listing-full-html (string-append header doc-html footer)
+ #:listing-excerpt-html ""
+ #:listing-short-html listing-short))
(string-append header doc-html notes-section-html footer)))
-;; ~~~ Retrieve listings of articles and notes ~~~
-;; ~~~ (Mainly for use on Series pages ~~~
-
-;; (private) Create a WHERE clause matching a single series or list of series
-(define (where/series s)
- (cond [(list? s)
- (let ([series (map (curry (format "~a/~a.html" series-folder)) s)])
- (format "WHERE `series_pagenode` IN ~a" (list->sql-values series)))]
- [(string? s)
- (format "WHERE `series_pagenode` IS \"~a/~a.html\"" series-folder s)]
- [(equal? s #t)
- (format "WHERE `series_pagenode` IS \"~a\"" (here-output-path))]
- [else ""]))
-
-;; Return a combined list of articles and notes sorted by date
-(define (list/articles+notes type #:series [s #t] #:limit [limit -1] [order "DESC"])
- (define select #<<@@@@@
- SELECT `~a` FROM
- (SELECT `~a`, `published`, `series_pagenode` FROM `articles`
- UNION SELECT
- `~a`,`date` AS `published`, `series_pagenode` FROM `notes`)
- ~a ORDER BY `published` ~a LIMIT ~a
-@@@@@
- )
- (query-list (sqltools:dbc) (format select type type type (where/series s) order limit)))
-
-;; Return a list of articles only, sorted by date
-(define (list/articles type #:series [s #t] #:limit [limit -1] [order "DESC"])
- (define select "SELECT `~a` FROM `articles` ~a ORDER BY `published` ~a LIMIT ~a")
- (query-list (sqltools:dbc) (format select type (where/series s) order limit)))
-
-;; ~~~~
-;; 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`
-
-(define (listing<>-short/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
- `(style "<ul class=\"article-list\">"
- ,@(list/articles "listing_short_html" #:series s #:limit limit order)
- "</ul>"))
-
-(define (listing<>-full/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
- `(style ,@(list/articles "listing_full_html" #:series s #:limit limit order)))
-
-;; Return a combined list of articles and notes (“full content” version) sorted by date
-(define (listing<>-full/articles+notes #:series [s #t] #:limit [limit -1] [order "DESC"])
- `(style ,@(list/articles+notes "listing_full_html" #:series s #:limit limit order)))
-
-;; 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 ""))
-
-;; ~~~ Article-related helper functions ~~~
-;;
-
-;; If the first element is a titled poem, the poem’s title can be used for the article title.
-(define (check-for-poem-title doc)
- (define e1 (car (get-elements doc)))
- (define e2 (if (null? (get-elements e1))
- '()
- (car (get-elements e1))))
- (cond
- [(and (txexpr? e1)
- (equal? 'div (get-tag e1))
- (attrs-have-key? e1 'class)
- (string=? "poem" (attr-ref e1 'class))
- (not (null? e2))
- (txexpr? e2)
- (equal? 'p (get-tag e2))
- (attrs-have-key? e2 'class)
- (string=? "verse-heading" (attr-ref e2 'class)))
- `(title (span [[class "smallcaps"]] "‘" ,@(get-elements e2) "’"))]
- [else '()]))
+(define (check-for-poem-title doc-txpr)
+ (match (car (get-elements doc-txpr))
+ [(txexpr 'div
+ (list (list 'class "poem"))
+ (list* (txexpr 'p
+ (list (list 'class "verse-heading"))
+ heading-elems)
+ _))
+ `(title (span [[class "smallcaps"]] "‘" ,@heading-elems "’"))]
+ [_ '()]))
;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title pagenode supplied-title body-tx disposition disp-note-id)
(define title-elems
(cond [(null? supplied-title) (list (default-title (get-elements body-tx)))]
@@ -249,22 +176,21 @@
[href ,(format "~a~a#~a" web-root pagenode disp-note-id)]]
,mark)]
[else ""]))
;; Returns a txexpr, the tag will be discarded by the template/snippets
`(title ,@title-elems ,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? s-title)
- (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
- s-noun
- series
- s-title)]
- [else ""]))
+ (match (series-metas-title)
+ [(? non-empty-string? s-title)
+ (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
+ (series-metas-noun)
+ series
+ s-title)]
+ [_ ""]))
(define disp-part
(cond [(non-empty-string? disposition)
(define-values (mark verb) (disposition-values disposition))
(format "Now considered <a href=\"/~a#~a\">~a</a>."
pagenode
@@ -282,91 +208,74 @@
[else ""]))
(cond [(ormap non-empty-string? (list series-part disp-part notes-part))
(string-join (list series-part disp-part notes-part))]
[else ""]))
-
;; ~~~ 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)]
+(define (cache-notes! pagenode parent-title note-txprs)
+ (query-exec cache-conn (delete (~> (from cache:note #:as n)
+ (where (= n.page ,(symbol->string pagenode))))))
+ (cond [(not (null? note-txprs))
+ (define note-htmls
+ (for/list ([n (in-list note-txprs)])
+ (cache-note! n pagenode parent-title)))
+ (html$-notes-section note-htmls)]
[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 (cache-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))
;; Check required attributes
(unless (non-empty-string? note-date)
(raise-arguments-error 'note "required attr missing: date" "attrs" attrs))
(unless (or (string=? "" disposition-attr)
- (and ((length (string-split disposition-attr)) . >= . 2)))
+ (>= (length (string-split disposition-attr)) 2))
(raise-arguments-error 'note
"must be in format \"[symbol] [past-tense-verb]\""
"disposition attr"
disposition-attr))
-
- ;; Parse out remaining columns
- (define author (maybe-attr 'author attrs default-authorname))
- (define note-id (build-note-id note-tx))
- (define title-tx (make-note-title pagenode parent-title-plain))
- (define title-html-flow (->html title-tx #:splice? #t))
- (define title-plain (tx-strs title-tx))
- (define author-url (maybe-attr 'author-url attrs))
(define-values (disp-mark disp-verb) (disposition-values disposition-attr))
- (define content-html (html$-note-contents disp-mark disp-verb (get-elements note-tx)))
- (define listing-full-html
- (html$-note-listing-full pagenode note-id title-html-flow note-date content-html author author-url))
-
- (define note-record
- (list pagenode
- note-id
- title-html-flow
- title-plain
- author
- author-url
- note-date
- disposition-attr
- content-html
- (symbol->string (series-pagenode))
- listing-full-html
- "" ; listing_excerpt_html: Not used for now
- "")) ; listing_short_html: Not used for now
-
- ;; save to db
- (define save-note-query
- (format (string-append "INSERT OR REPLACE INTO `notes` (`rowid`, ~a) "
- "VALUES ((SELECT `rowid` FROM `notes` WHERE `pagenode` = ?1"
- " AND `note_id` = ?2), ~a)")
- (list->sql-fields table_notes-fields)
- (list->sql-parameters table_notes-fields)))
- (apply query! save-note-query note-record)
-
- ;; return html$ of note
- (html$-note-in-article note-id note-date content-html author author-url))
+ (let* ([note-id (build-note-id note-tx)]
+ [title-tx (make-note-title pagenode parent-title-plain)]
+ [title-html (->html title-tx #:splice? #t)]
+ [author (maybe-attr 'author attrs default-authorname)]
+ [author-url (maybe-attr 'author-url attrs)]
+ [content-html (html$-note-contents disp-mark disp-verb elems)])
+ (insert-one! cache-conn
+ (make-cache:note
+ #:page pagenode
+ #:html-anchor note-id
+ #:title-html-flow title-html
+ #:title-plain (tx-strs title-tx)
+ #:published note-date
+ #:author author
+ #:author-url author-url
+ #:disposition disposition-attr
+ #:series-page (metas-series-pagenode)
+ #:content-html content-html
+ #:listing-full-html (html$-note-listing-full pagenode
+ note-id
+ title-html
+ note-date
+ content-html
+ author
+ author-url)
+ #:listing-excerpt-html ""
+ #:listing-short-html ""))
+ (html$-note-in-article note-id note-date content-html author author-url)))
(define (make-note-title pagenode parent-title-plain)
`(note-title "Re: " (a [[class "cross-reference"]
[href ,(format "~a~a" web-root pagenode)]]
,parent-title-plain)))
-(define (article-plain-title pagenode)
- (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))
-
;; ~~~ Keyword Index Entries ~~~
;; (private) Convert an entry key into a list of at most two elements,
;; a main entry and a sub-entry.
;; "entry" → '("entry" "")
@@ -375,55 +284,125 @@
(define (split-entry str)
(define splits (string-split str "!"))
(list (car splits)
(cadr (append splits (list "")))))
+(define (index-entry-txpr? tx)
+ (and (txexpr? tx)
+ (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index
+ (attr-ref tx 'data-index-entry #f)))
+
+(define (txexpr->index-entry tx pagenode)
+ (match (split-entry (attr-ref tx 'data-index-entry))
+ [(list main sub)
+ (make-cache:index-entry
+ #:entry main
+ #:subentry sub
+ #:page pagenode
+ #:html-anchor (attr-ref tx 'id))]))
+
;; Save any index entries in doc to the SQLite cache.
;; Sub-entries are specified by "!" in the index key
-(define (crystalize-index-entries! pagenode doc)
- (define (index-entry? tx)
- (and (txexpr? tx)
- (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index
- (attr-ref tx 'data-index-entry #f)))
- (define-values (_ entries) (splitf-txexpr doc index-entry?))
-
+(define (cache-index-entries! pagenode doc)
+ (define-values (_ entry-txs) (splitf-txexpr doc index-entry-txpr?))
; Naive idempotence: delete and re-insert all index entries every time doc is rendered.
- (query! "DELETE FROM `keywordindex` WHERE `pagenode` = ?1" (symbol->string pagenode))
-
- (unless (null? entries)
- (define entry-rows
- (for/list ([entry-tx (in-list entries)])
- (define entry-parts (split-entry (attr-ref entry-tx 'data-index-entry)))
- (list (first entry-parts)
- (second entry-parts)
- (symbol->string pagenode)
- (attr-ref entry-tx 'id))))
- (query! (make-insert-rows-query "keywordindex" table_keywordindex-fields entry-rows))))
-
-;; ~~~ Series ~~~
-
-;; Preloads the SQLite cache with info about each series.
-;; I may not actually need this but I’m leaving it for now.
-(define (preheat-series!)
- (query! "DELETE FROM `series`")
- (define series-values
- (for/list ([series-pagenode (in-list (cdr (series-pagetree)))])
- (define series-metas (get-metas series-pagenode))
- (list (symbol->string series-pagenode)
- (hash-ref series-metas 'title)
- (hash-ref series-metas 'published)
- (hash-ref series-metas 'noun-plural "")
- (hash-ref series-metas 'noun-singular ""))))
- (define sql$-insert (make-insert-rows-query 'series table_series-fields series-values))
- (displayln sql$-insert)
- (query! sql$-insert))
+ (query-exec cache-conn (delete (~> (from cache:index-entry #:as entry)
+ (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))))))
+
+;;
+;; ~~~ 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]))
+
+;; 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)
+ (where-series s)
+ (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)
+ (union
+ (~> (from cache:note #:as N)
+ (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
+ N.published
+ N.series-page)))))
+ #:as a)
+ (where-series s)
+ (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 ""))
;; Save the current article to the `series` table of the SQLite cache
;; Should be called from a template for series pages
-(define (crystalize-series!)
- (define series-row
- (list (path->string (here-output-path))
- (hash-ref (current-metas) 'title)
- (hash-ref (current-metas) 'published "")
- (hash-ref (current-metas) 'noun-plural "")
- (hash-ref (current-metas) 'noun-singular "")))
- (apply query! (make-insert/replace-query 'series table_series-fields) series-row))
+(define (cache-series!)
+ (define here-page (path->string (here-output-path)))
+ (query-exec cache-conn
+ (delete (~> (from cache:series #:as s)
+ (where (= s.page ,here-page)))))
+ (void
+ (insert-one! cache-conn
+ (make-cache:series
+ #:page (string->symbol here-page)
+ #:title (hash-ref (current-metas) 'title)
+ #:published (hash-ref (current-metas) 'published "")
+ #:noun-plural (hash-ref (current-metas) 'noun-plural "")
+ #:noun-singular (hash-ref (current-metas) 'noun-singular "")))))
Index: dust.rkt
==================================================================
--- dust.rkt
+++ dust.rkt
@@ -19,13 +19,13 @@
(provide maybe-meta ; Select from (current-metas) or default value ("") if not available
maybe-attr ; Return an attribute’s value or a default ("") if not available
here-output-path
here-id
- series-noun ; Retrieve noun-singular from current 'series meta, or ""
- series-title ; Retrieve title of series in current 'series meta, or ""
- series-pagenode
+ series-metas-noun ; Retrieve noun-singular from current 'series meta, or ""
+ series-metas-title ; Retrieve title of series in current 'series meta, or ""
+ metas-series-pagenode
invalidate-series
make-tag-predicate
tx-strs
ymd->english
ymd->dateformat
@@ -67,25 +67,25 @@
(->output-path (apply build-path rel-path-parts))]
[else (string->path ".")]))
;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
-(define (series-pagenode)
+(define (metas-series-pagenode)
(define maybe-series (or (select-from-metas 'series (current-metas)) ""))
(cond
[(non-empty-string? maybe-series)
(->pagenode (format "~a/~a.html" series-folder maybe-series))]
[else '||]))
-(define (series-noun)
- (define series-pnode (series-pagenode))
+(define (series-metas-noun)
+ (define series-pnode (metas-series-pagenode))
(case series-pnode
['|| ""] ; no series specified
[else (or (select-from-metas 'noun-singular series-pnode) "")]))
-(define (series-title)
- (define series-pnode (series-pagenode))
+(define (series-metas-title)
+ (define series-pnode (metas-series-pagenode))
(case series-pnode
['|| ""] ; no series specified
[else (or (select-from-metas 'title series-pnode) "")]))
;; Generates a short ID for the current article
Index: index.html.pp
==================================================================
--- index.html.pp
+++ index.html.pp
@@ -4,12 +4,12 @@
◊; This file is licensed under the Blue Oak Model License 1.0.0.
◊(require pollen/template db/base racket/list racket/match)
◊(define (fetch-series)
- (define q "SELECT noun_plural, pagenode, title FROM series ORDER BY noun_plural DESC")
- (query-rows (sqltools:dbc) q))
+ (define q "SELECT noun_plural, page, title FROM series ORDER BY noun_plural DESC")
+ (query-rows cache-conn q))
◊(define (series-item->txpr s)
(match-define (list n pagenode title) s)
`(li (a [[href ,pagenode]] (i ,title))))
@@ -86,13 +86,13 @@
collections:
◊url[1]{/blog-pg1.html}
})
-◊(crystalize-index-entries! '|index.html| front-page-body)
+◊; stop for now: (crystalize-index-entries! '|index.html| front-page-body)
<main>
◊(->html front-page-body #:splice? #t)
◊(->html (series-grouped-list))
</main>
</body>
</html>
Index: keyword-index.rkt
==================================================================
--- keyword-index.rkt
+++ keyword-index.rkt
@@ -102,15 +102,15 @@
;; Get the index entries from the SQLite cache, return them as a list of vectors (Records!)
(define (fetch-entries)
(define q
◊string-append{
- SELECT entry, subentry, a.rowid, "◊web-root" || k.pagenode || "#" || anchor AS href, title_plain
- FROM keywordindex k INNER JOIN articles a
- ON a.pagenode = k.pagenode
+ SELECT entry, subentry, a.rowid, "◊web-root" || k.page || "#" || html_anchor AS href, title_plain
+ FROM index_entries k INNER JOIN articles a
+ ON a.page = k.page
ORDER BY entry COLLATE NOCASE ASC, subentry COLLATE NOCASE ASC;})
- (query-rows (sqltools:dbc) q))
+ (query-rows cache-conn q))
;; Convert a list of vectors from the cache DB into a list of the form:
;; ((FIRST-LETTER (entries ...)) ...)
;; The method relies on the records being pre-sorted by the SQL query.
(define (group-entries records)
@@ -158,11 +158,10 @@
</div>
◊html$-page-body-close[]
</html>})
(define (main)
- (spell-of-summoning!) ; Turn on DB
(displayln "Writing keyword-index.html…")
(display-to-file (html$-keywordindex-page (html$-index (group-entries (fetch-entries))))
"keyword-index.html"
#:mode 'text
#:exists 'replace))
Index: pollen.rkt
==================================================================
--- pollen.rkt
+++ pollen.rkt
@@ -38,11 +38,11 @@
snippets-html.rkt
dust.rkt
crystalize.rkt))))
(case (current-poly-target)
- [(html) (spell-of-summoning!)])
+ [(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.
;; Use this macro when you know you will need keyword arguments.
;;
Index: rss-feed.rkt
==================================================================
--- rss-feed.rkt
+++ rss-feed.rkt
@@ -45,30 +45,30 @@
;; Get the data out of the SQLite cache as vectors
(define (fetch-rows)
(define fields '(pagenode title_plain published updated author doc_html))
(define select #<<---
- SELECT `path`, `title`, `published`, `updated`, `author`, `entry-contents` FROM
- (SELECT `pagenode` AS `path`,
+ SELECT `path`, `title`, `published`, `updated`, `author`, `entry_contents` FROM
+ (SELECT `page` AS `path`,
`title_plain` AS `title`,
`published`,
`updated`,
`author`,
- `doc_html` AS `entry-contents`
+ `doc_html` AS `entry_contents`
FROM `articles`
UNION
- SELECT `pagenode` || '#' || `note_id` AS `path`,
+ SELECT `page` || '#' || `html_anchor` AS `path`,
`title_plain` AS `title`,
- `date` AS `published`,
+ `published`,
"" AS `updated`,
`author`,
- `content_html` as `entry-contents`
+ `content_html` as `entry_contents`
FROM `notes`)
ORDER BY `published` DESC LIMIT ~a
---
)
- (query-rows (sqltools:dbc) (format select feed-item-limit)))
+ (query-rows cache-conn (format select feed-item-limit)))
(define (vector->rss-item vec)
(match-define
(vector path title published updated author contents) vec)
(define entry-url (string-append feed-site-url web-root path))
@@ -99,7 +99,6 @@
,@(map vector->rss-item (fetch-rows))))
(string-append "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
(xexpr->string feed-xpr)))
(define (main)
- (spell-of-summoning!) ; Turn on the cache DB connection
(display-to-file (rss-feed) "feed.xml" #:mode 'text #:exists 'replace))
Index: series/template.html.p
==================================================================
--- series/template.html.p
+++ series/template.html.p
@@ -1,8 +1,8 @@
<!DOCTYPE html>
<html lang="en">
-◊crystalize-series!
+◊cache-series![]
◊html$-page-head[(select-from-metas 'title metas)]
◊html$-page-body-open["series-page"]
◊(unfence (->html doc #:splice? #t))
Index: snippets-html.rkt
==================================================================
--- snippets-html.rkt
+++ snippets-html.rkt
@@ -113,11 +113,11 @@
[else ""]))
◊string-append{
<article class="with-title ◊maybe-author-class hentry">
<h1 class="entry-title note-full">◊|title-html-flow|</h1>
- <p class="time"><a href="/◊|pagenode|#◊note-id" class="rel-bookmark note-permlink">
+ <p class="time"><a href="/◊(symbol->string pagenode)#◊note-id" class="rel-bookmark note-permlink">
<time datetime="◊date">◊ymd->english[date]</time>
</a></p>
<section class="entry-content">
<div class="p-content p-name">◊|contents|</div>
◊author-part
DELETED sqlite-tools.rkt
Index: sqlite-tools.rkt
==================================================================
--- sqlite-tools.rkt
+++ sqlite-tools.rkt
@@ -1,258 +0,0 @@
-#lang racket/base
-
-; SPDX-License-Identifier: BlueOak-1.0.0
-; This file is licensed under the Blue Oak Model License 1.0.0.
-
-;; Provides a very light set of utility functions for a SQLite database.
-;; These functions are completely agnostic as to the database schema.
-;; These functions are NOT SAFE for use with data provided by untrusted users!
-
-(require db/sqlite3
- db/base
- racket/list
- racket/match
- racket/function
- racket/contract
- sugar/coerce)
-
-(module+ test
- (require rackunit))
-
-(provide sqltools:dbc
- sqltools:log-queries?)
-
-(provide
- (contract-out
- ;; Utility functions
- [log-query (string? . -> . void?)]
- [vector->hash (vector? (listof symbolish?) . -> . hash?)]
- [backtick (stringish? . -> . string?)]
- [list->sql-fields ((listof stringish?) . -> . string?)]
- [list->sql-values ((listof stringish?) . -> . string?)]
- [list->sql-parameters ((listof any/c) . -> . string?)]
- [bool->int (any/c . -> . exact-integer?)]
- [int->bool (exact-integer? . -> . boolean?)]
-
- ;; Simple SQL makers
- [make-table-schema ((string? (listof stringish?))
- (#:primary-key-cols (listof stringish?))
- . ->* . string?)]
- [make-insert/replace-query (stringish? (listof stringish?) . -> . string?)]
- [make-insert-rows-query (stringish? (listof stringish?) (listof (listof stringish?)) . -> . string?)]
- [make-select-query (stringish? (listof stringish?) #:where stringish? . -> . string?)]
-
- ;; Database operations
- [init-db! ((pathish?) () #:rest (listof string?) . ->* . void?)]
- [query! ((string?) () #:rest (listof any/c) . ->* . void?)]
- [select-rows! (case->
- (stringish? (listof stringish?) any/c . -> . (or/c empty? hash?))
- (string? (listof stringish?) . -> . (or/c empty? hash?)))]))
-
-;; ~~~ Private use ~~~
-
-(define uninitialized-connection "No DB connection!")
-(define (weave xs ys)
- (for/fold [(woven null)
- #:result (reverse woven)]
- ([x (in-list xs)]
- [y (in-list ys)])
- (cons y (cons x woven))))
-
-(define (sql-val v)
- (cond [(string? v) (string-append "\"" v "\"")]
- [else (format "~a" v)]))
-
-;; ~~~ Provided parameters ~~~
-
-(define sqltools:dbc (make-parameter uninitialized-connection))
-(define sqltools:log-queries? (make-parameter #f))
-
-;; ~~~ Provided utility functions ~~~
-
-(define (backtick str) (format "`~a`" str))
-(define (list->sql-fields fields) (apply string-append (add-between (map backtick fields) ", ")))
-(define (list->sql-values vals)
- (string-append "(" (apply string-append (add-between (map sql-val vals) ", ")) ")"))
-(define (list->sql-parameters fields)
- (apply string-append (add-between (map (λ(x) (format "?~a" (add1 x))) (range (length fields))) ", ")))
-
-;; For storing/reading boolean values (SQLite uses integers)
-(define (bool->int b?)
- (cond [b? 1] [else 0]))
-
-(define (int->bool i)
- (not (= i 0)))
-
-;; TESTING: utility functions…
-(module+ test
- (check-equal? (backtick "field") "`field`")
- (check-equal? (list->sql-fields '("f1" "f2" "f3")) "`f1`, `f2`, `f3`")
- (check-equal? (list->sql-fields '(f1 f2 f3)) "`f1`, `f2`, `f3`") ; Can use symbols too
- (check-equal? (list->sql-parameters '("name" "rank" "serial")) "?1, ?2, ?3")
- (check-equal? (list->sql-parameters '(name rank serial)) "?1, ?2, ?3")
- (check-equal? (list->sql-values '(100 "hello" 3)) "(100, \"hello\", 3)")
- (check-equal? (weave '(x y z) '(1 2 3)) '(x 1 y 2 z 3))
-
- (check-equal? (bool->int #f) 0)
- (check-equal? (bool->int #t) 1)
- (check-equal? (bool->int "xblargh") 1)
- (check-equal? (int->bool 0) #f)
- (check-equal? (int->bool 1) #t)
- (check-equal? (int->bool -1) #t)
- (check-equal? (int->bool 37) #t)
- (check-exn exn:fail? (lambda () (int->bool "x"))))
-
-;; ~~~ Public functions ~~~
-
-;; Prints to stdout if logging is on
-(define (log-query q) (unless (not (sqltools:log-queries?)) (println q)))
-
-;; Using a list of field names, convert a vector into a hash that uses the
-;; field names (in symbol form) for keys.
-;; Racket’s db functions all return vectors; hashes are much easier to use.
-;; If fields and v are not equal in length, the unpairable elements are omitted
-;; from the hash!
-(define (vector->hash v fields)
- (cond [(zero? (vector-length v)) null]
- [else (let ([keys (map ->symbol fields)]
- [vals (vector->list v)])
- (apply hash (weave keys vals)))]))
-
-;; TESTING: vector->hash...
-(module+ test
- (let ([test-row '#("Joe" "PFC" 123)]
- [test-cols-SYMBOL '(name rank serial)]
- [test-cols-STRING '("name" "rank" "serial")]
- [desired-result '#hash((serial . 123) (rank . "PFC") (name . "Joe"))])
- (check-equal? (vector->hash test-row test-cols-SYMBOL) desired-result)
- (check-equal? (vector->hash test-row test-cols-STRING) desired-result))
-
- ;; Behavior when v and fields are unequal in length:
- (check-equal? (vector->hash '#("foo" "bar") '(a b c))
- '#hash((a . "foo") (b . "bar")))
- (check-equal? (vector->hash '#("foo" "bar" "baz") '(a b))
- '#hash((a . "foo") (b . "bar"))))
-
-;; Create a simple table schema from a list of fields, optionally specifying
-;; primary key
-(define (make-table-schema tablename fields #:primary-key-cols [primary-cols '()])
- (define primary-key
- (format "PRIMARY KEY (~a)"
- (list->sql-fields (if (empty? primary-cols) (list (first fields)) primary-cols))))
- (format "CREATE TABLE IF NOT EXISTS `~a` (~a, ~a);"
- tablename
- (list->sql-fields fields)
- primary-key))
-
-;; Create a query that inserts a row if it doesn’t exist (based on the first
-;; column only), or updates it if it does. The returned query is parameterized,
-;; and must be used with a list of values equal in length to the number of
-;; fields given.
-(define (make-insert/replace-query tablename fields)
- (format "INSERT OR REPLACE INTO `~a` (`rowid`, ~a) VALUES ((SELECT `rowid` FROM `~a` WHERE `~a`= ?1), ~a)"
- tablename
- (list->sql-fields fields)
- tablename
- (first fields)
- (list->sql-parameters fields)))
-
-;; Create a query that inserts multiple rows.
-(define (make-insert-rows-query tablename fields rows)
- (define row-values
- (apply string-append (add-between (map list->sql-values rows) ", ")))
- (format "INSERT INTO `~a` (~a) VALUES ~a;" tablename (list->sql-fields fields) row-values))
-
-;; Simple row selection
-(define (make-select-query table fields #:where where-clause)
- (format "SELECT ~a FROM `~a` WHERE ~a"
- (list->sql-fields fields)
- table
- where-clause))
-
-;; TESTING: SQL query makers...
-(module+ test
- (check-equal? (make-table-schema 'posts '(title date))
- "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`title`));")
- (check-equal? (make-table-schema "posts" '("title" "date"))
- "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`title`));")
- (check-equal? (make-table-schema 'posts '(title date) #:primary-key-cols '(author date))
- "CREATE TABLE IF NOT EXISTS `posts` (`title`, `date`, PRIMARY KEY (`author`, `date`));")
-
- (check-equal? (make-insert/replace-query 'posts '(author title))
- (string-append "INSERT OR REPLACE INTO `posts` (`rowid`, `author`, `title`) "
- "VALUES ((SELECT `rowid` FROM `posts` WHERE `author`= ?1), ?1, ?2)"))
-
- (check-equal? (make-insert-rows-query 'series '(id name num) '((1 "Journal" 11) (2 "Ideas" 4)))
- (string-append "INSERT INTO `series` (`id`, `name`, `num`) "
- "VALUES (1, \"Journal\", 11), (2, \"Ideas\", 4);"))
-
- (check-equal? (make-select-query 'posts '(author title) #:where 1)
- "SELECT `author`, `title` FROM `posts` WHERE 1"))
-
-(define (good-connection?)
- (and (connection? (sqltools:dbc)) (connected? (sqltools:dbc))))
-
-;; Initialize the database connection, creating the database if it does not yet exist
-;; and running any provided queries (e.g., "CREATE TABLE IF NOT EXISTS...")
-(define (init-db! filename . qs)
- (cond [(good-connection?) (disconnect (sqltools:dbc))])
- (sqltools:dbc (sqlite3-connect #:database filename #:mode 'create))
- (unless (empty? qs)
- (for ([q (in-list qs)])
- (query! q))))
-
-;; Run a query with logging (if enabled) and return the result
-(define (query! q . parameters)
- (unless (good-connection?) (error "(query!) DB not connected"))
- (log-query q)
- (cond [(empty? parameters) (query-exec (sqltools:dbc) q)]
- [else (apply query-exec (sqltools:dbc) q parameters)]))
-
-;; Run a SELECT query, return a hash with field names as keys
-(define select-rows!
- (case-lambda
- ;; Use arbitrary query
- [(query fieldnames)
- (unless (good-connection?) (error "(select-rows!) DB not connected"))
- (log-query query)
- (define result (query-rows (sqltools:dbc) query))
- (map (curryr vector->hash fieldnames) result)]
-
- ;; Use a simple SELECT FROM WHERE template
- [(table fields where-clause)
- (unless (good-connection?) (error "(select-rows!) DB not connected"))
- (define query (make-select-query table fields #:where where-clause))
- (log-query query)
- (define result (query-rows (sqltools:dbc) query))
- (map (curryr vector->hash fields) result)]))
-
-;; TESTING: database connection state and queries
-(module+ test
- (define TESTDB "SQLITE-TOOLS-TEST.sqlite")
-
- ;; Check that things start out uninitialized and that queries don’t work
- (check-equal? (sqltools:dbc) uninitialized-connection)
- (check-false (file-exists? TESTDB))
- (check-exn exn:fail? (lambda () (query! "SELECT 1")))
- (check-exn exn:fail? (lambda () (select-rows! 'posts '(title) 1)))
-
- ;; Initialize db connection, create file with no schema
- (test-begin
- (check-equal? (init-db! TESTDB) (void))
- (check-true (file-exists? TESTDB))
- (delete-file TESTDB))
-
- ;; Initialize new db/connection, create file with schema, check that
- ;; simple queries return expected results
- (test-begin
- (check-equal? (init-db! TESTDB (make-table-schema 'posts '(title date))) (void))
- (check-true (file-exists? TESTDB))
- (check-equal? (select-rows! (make-select-query 'posts '(title date) #:where 1) '(title date)) null)
- (check-equal? (query! (make-insert/replace-query 'posts '(title date)) "Hello" "2018-08-10") (void))
- (check-equal? (select-rows! 'posts '(title date) "`date`='2018-08-10'")
- '(#hash((title . "Hello") (date . "2018-08-10")))))
-
- ;; Clean up
- (disconnect (sqltools:dbc))
- (sqltools:dbc uninitialized-connection)
- (delete-file TESTDB))
Index: template.html.p
==================================================================
--- template.html.p
+++ template.html.p
@@ -1,17 +1,15 @@
<!DOCTYPE html>
◊; SPDX-License-Identifier: BlueOak-1.0.0
◊; This file is licensed under the Blue Oak Model License 1.0.0.
<html lang="en">
-
-◊(define article-html (crystalize-article! here doc))
-◊(define page-title (article-plain-title here))
-◊html$-page-head[page-title]
+◊(define article-html (parse-and-cache-article! here doc))
+◊html$-page-head[(current-plain-title)]
◊html$-page-body-open[]
◊article-html
◊html$-page-body-close[]
</html>