Changes In Branch deta-refactor Excluding Merge-Ins
This is equivalent to a diff from f06db447 to e90a714a
2020-01-13
| ||
19:38 | Merge deta refactor branch check-in: c06d4f58 user: joel tags: trunk | |
01:04 | Fix cache db filename, index page Leaf check-in: e90a714a user: joel tags: deta-refactor | |
00:52 | Fix series caching check-in: 624e5e2b user: joel tags: deta-refactor | |
00:27 | Redo everything cache-related check-in: 62f4a12e user: joel tags: deta-refactor | |
2019-08-19
| ||
21:36 | Add RSS feed. Closes [5cca77420922765f] check-in: f06db447 user: joel tags: trunk | |
21:33 | Add title-plain for notes; small refactor of note title generation check-in: 286673cf user: joel tags: trunk | |
Modified blog.rkt from [1ddb51ef] to [1dda01dc].
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
<nav id="bottom-nav"><ul>◊|page-nav|</ul></nav> ◊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)) (for ([pagenum (in-range 1 (+ 1 pagecount))] [page (in-list articles+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 #:exists 'replace))) (define (main) ;; Do it! (build-blog)) |
| < < | | |
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
<nav id="bottom-nav"><ul>◊|page-nav|</ul></nav> ◊html$-page-body-close[] </html>}) ;; Grabs all the articles+notes from the cache and writes out all the blog page files (define (build-blog) (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 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 #:exists 'replace))) (define (main) ;; Do it! (build-blog)) |
Modified code-docs/crystalize.scrbl from [ff8f9919] to [146fa5fb].
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
...
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
|
@(require (for-label "../pollen.rkt" "../dust.rkt" "../crystalize.rkt" racket/base racket/contract racket/string txexpr pollen/template pollen/pagetree sugar/coerce)) @title{@filepath{crystalize.rkt}} @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. 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?] 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 @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 reason for enclosing the results in a @racket['style] txexpr is to prevent the HTML from being 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?] Like @racket[listing<>-full/articles] except that notes and articles are combined side by side in the results. @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 up-to-date value. |
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
<
|
<
<
<
<
<
<
<
<
<
<
|
<
<
>
|
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>
|
|
|
>
>
|
|
|
<
<
<
<
|
|
>
>
>
>
>
>
>
>
>
|
|
|
>
>
>
>
<
<
>
>
>
>
>
>
|
|
|
|
>
|
|
<
|
|
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
..
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
|
@(require (for-label "../pollen.rkt" "../dust.rkt" "../crystalize.rkt" racket/base racket/contract racket/string deta txexpr pollen/template pollen/pagetree sugar/coerce)) @title{@filepath{crystalize.rkt}} @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. 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[(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 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 their @tt{series_pagenode} column in the SQLite cache. ................................................................................ The reason for enclosing the results in a @racket['style] txexpr is to prevent the HTML from being 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]. @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. 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 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. |
Modified code-docs/dust.scrbl from [d5eab31d] to [dfcfb9ab].
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 |
(define doc '(root (p "If I had been astonished at first catching a glimpse of so outlandish an " "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?] 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?] 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?] 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?)] If the current article specifies a @racket['series] meta, and if a corresponding @filepath{.poly.pm} |
| | | |
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 |
(define doc '(root (p "If I had been astonished at first catching a glimpse of so outlandish an " "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[(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-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-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?)] If the current article specifies a @racket['series] meta, and if a corresponding @filepath{.poly.pm} |
Modified code-docs/main.scrbl from [1a5ea062] to [6cbd40b5].
26 27 28 29 30 31 32 33 34 35 36 |
@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"]
|
< |
26 27 28 29 30 31 32 33 34 35 |
@local-table-of-contents[] @include-section["overview.scrbl"] @include-section["pollen.scrbl"] @; pollen.rkt @include-section["dust.scrbl"] @; dust.rkt @include-section["snippets-html.scrbl"] @; you get the idea @include-section["crystalize.scrbl"] |
Deleted code-docs/sqlite-tools.scrbl version [9cc80fcd].
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 |
#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. |
< < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Modified crystalize.rkt from [0131cbe3] to [cb633ea2].
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 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 ... 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 ... 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 |
#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 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 ~~~ (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)) ;; 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-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))] [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) (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 '()])) ;; 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)))] [else (get-elements supplied-title)])) ................................................................................ (define-values (mark _) (disposition-values disposition)) `(a [[class "disposition-mark"] [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 ""])) (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 disp-note-id verb)] ................................................................................ (format "There is <a href=\"/~a#furthernotes\">a note</a> appended." pagenode)] [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)] [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)) ;; 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))) (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)) (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" "") ;; "entry!sub" → '("entry" "sub") ;; "entry!sub!why?!? '("entry" "sub") (define (split-entry str) (define splits (string-split str "!")) (list (car splits) (cadr (append splits (list ""))))) ;; 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?)) ; 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)) ;; 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)) |
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < > | > > > > > | < | < < < > > > | | | | | | | | | | | | | | | < < < < < > > < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < | < < < < > | < < < > > > | | | < < > | | | | | | < | | | | | | | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < < < < < | | | | > > > | > > > > > > > > > > | > > > > > | < > > > > > | < < < < < < < > > > > > > > > > < > > > < < < < > > > > > > | < < > > > > > > > > > > > > | < > > > | < < < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < | > > > > > > > | | | | < |
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 ... 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 ... 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 |
#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 racket/string pollen/pagetree 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 <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] [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 (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)] [header (html$-article-open pagenode title-specified? title-tx pubdate)] [series-node (metas-series-pagenode)] [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))] [footer (html$-article-close footertext)] [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))) (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)))] [else (get-elements supplied-title)])) ................................................................................ (define-values (mark _) (disposition-values disposition)) `(a [[class "disposition-mark"] [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 series-part (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 disp-note-id verb)] ................................................................................ (format "There is <a href=\"/~a#furthernotes\">a note</a> appended." pagenode)] [else ""])) (cond [(ormap non-empty-string? (list series-part disp-part notes-part)) (string-join (list series-part disp-part notes-part))] [else ""])) ;; ~~~ Notes ~~~ (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 (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) (>= (length (string-split disposition-attr)) 2)) (raise-arguments-error 'note "must be in format \"[symbol] [past-tense-verb]\"" "disposition attr" disposition-attr)) (define-values (disp-mark disp-verb) (disposition-values disposition-attr)) (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))) ;; ~~~ 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" "") ;; "entry!sub" → '("entry" "sub") ;; "entry!sub!why?!? '("entry" "sub") (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 (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-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 (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 ""))))) |
Modified dust.rkt from [4209ef85] to [c096eb0e].
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
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
|
;; Provides common helper functions used throughout the project
(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
invalidate-series
make-tag-predicate
tx-strs
ymd->english
ymd->dateformat
default-authorname
default-title
................................................................................
(drop-common-prefix (explode-path (current-project-root))
(explode-path (string->path (select-from-metas 'here-path (current-metas))))))
(->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 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))
(case series-pnode
['|| ""] ; no series specified
[else (or (select-from-metas 'noun-singular series-pnode) "")]))
(define (series-title)
(define series-pnode (series-pagenode))
(case series-pnode
['|| ""] ; no series specified
[else (or (select-from-metas 'title series-pnode) "")]))
;; Generates a short ID for the current article
(define (here-id [suffix #f])
(define here-hash
|
|
|
|
|
|
|
|
|
|
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
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
|
;; Provides common helper functions used throughout the project (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-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 default-authorname default-title ................................................................................ (drop-common-prefix (explode-path (current-project-root)) (explode-path (string->path (select-from-metas 'here-path (current-metas)))))) (->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 (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-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-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 (define (here-id [suffix #f]) (define here-hash |
Modified index.html.pp from [930470e2] to [6ce20187].
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
◊; SPDX-License-Identifier: BlueOak-1.0.0 ◊; 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 (series-item->txpr s) (match-define (list n pagenode title) s) `(li (a [[href ,pagenode]] (i ,title)))) ◊(define (series-grouped-list) ;; Produces '((("noun1" "p.html" "Title") ("noun1" "q.html" "Title")) (("noun2" ...) ...)) ................................................................................ your own or someone else’s. ◊em{I’ve seen this before} says the voice on the other end. ¶ Everything (almost) is ◊link[1]{arranged in time order, newest first}. There are also a few arranged into named collections: ◊url[1]{/blog-pg1.html} }) ◊(crystalize-index-entries! '|index.html| front-page-body) <main> ◊(->html front-page-body #:splice? #t) ◊(->html (series-grouped-list)) </main> </body> </html> |
|
|
|
|
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
◊; SPDX-License-Identifier: BlueOak-1.0.0 ◊; 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, 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)))) ◊(define (series-grouped-list) ;; Produces '((("noun1" "p.html" "Title") ("noun1" "q.html" "Title")) (("noun2" ...) ...)) ................................................................................ your own or someone else’s. ◊em{I’ve seen this before} says the voice on the other end. ¶ Everything (almost) is ◊link[1]{arranged in time order, newest first}. There are also a few arranged into named collections: ◊url[1]{/blog-pg1.html} }) ◊; 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> |
Modified keyword-index.rkt from [433d5c8d] to [50258609].
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
156
157
158
159
160
161
162
163
164
165
166
167
168
|
(cond [(non-empty-string? subhead) (add-new-subentry e record)] [else (add-entry-link e record)])) ;; 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 ORDER BY entry COLLATE NOCASE ASC, subentry COLLATE NOCASE ASC;}) (query-rows (sqltools:dbc) 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) (define collated (for/fold ([entries (list (new-entry (first records)))] ................................................................................ <div id="keywordindex"> ◊the-index </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)) |
|
|
|
|
<
|
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
156
157
158
159
160
161
162
163
164
165
166
167
|
(cond [(non-empty-string? subhead) (add-new-subentry e record)] [else (add-entry-link e record)])) ;; 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.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 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) (define collated (for/fold ([entries (list (new-entry (first records)))] ................................................................................ <div id="keywordindex"> ◊the-index </div> ◊html$-page-body-close[] </html>}) (define (main) (displayln "Writing keyword-index.html…") (display-to-file (html$-keywordindex-page (html$-index (group-entries (fetch-entries)))) "keyword-index.html" #:mode 'text #:exists 'replace)) |
Modified pollen.rkt from [cbfc059e] to [ec6e30b5].
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
(map resolve-module-path
(list tags-html.rkt
snippets-html.rkt
dust.rkt
crystalize.rkt))))
(case (current-poly-target)
[(html) (spell-of-summoning!)])
;; 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.
;;
(define-syntax (poly-branch-kwargs-tag stx)
(syntax-parse stx
|
| |
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
(map resolve-module-path
(list tags-html.rkt
snippets-html.rkt
dust.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.
;; Use this macro when you know you will need keyword arguments.
;;
(define-syntax (poly-branch-kwargs-tag stx)
(syntax-parse stx
|
Modified rss-feed.rkt from [e414aebe] to [9efceb86].
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
..
97
98
99
100
101
102
103
104
105
|
(date->string now #t))) (string-append timestamp "Z")) ;; 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`, `title_plain` AS `title`, `published`, `updated`, `author`, `doc_html` AS `entry-contents` FROM `articles` UNION SELECT `pagenode` || '#' || `note_id` AS `path`, `title_plain` AS `title`, `date` AS `published`, "" AS `updated`, `author`, `content_html` as `entry-contents` FROM `notes`) ORDER BY `published` DESC LIMIT ~a --- ) (query-rows (sqltools:dbc) (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)) (define update-ts (cond [(non-empty-string? updated) updated] ................................................................................ (name ,feed-author) (email ,@(email-encode feed-author-email))) ,@(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)) |
|
|
|
|
|
|
|
<
|
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
..
97
98
99
100
101
102
103
104
|
(date->string now #t))) (string-append timestamp "Z")) ;; 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 `page` AS `path`, `title_plain` AS `title`, `published`, `updated`, `author`, `doc_html` AS `entry_contents` FROM `articles` UNION SELECT `page` || '#' || `html_anchor` AS `path`, `title_plain` AS `title`, `published`, "" AS `updated`, `author`, `content_html` as `entry_contents` FROM `notes`) ORDER BY `published` DESC LIMIT ~a --- ) (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)) (define update-ts (cond [(non-empty-string? updated) updated] ................................................................................ (name ,feed-author) (email ,@(email-encode feed-author-email))) ,@(map vector->rss-item (fetch-rows)))) (string-append "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" (xexpr->string feed-xpr))) (define (main) (display-to-file (rss-feed) "feed.xml" #:mode 'text #:exists 'replace)) |
Modified series/template.html.p from [00a0ebd1] to [7a674800].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
<!DOCTYPE html>
<html lang="en">
◊crystalize-series!
◊html$-page-head[(select-from-metas 'title metas)]
◊html$-page-body-open["series-page"]
◊(unfence (->html doc #:splice? #t))
◊html$-page-body-close[]
</html>
|
| |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
<!DOCTYPE html> <html lang="en"> ◊cache-series![] ◊html$-page-head[(select-from-metas 'title metas)] ◊html$-page-body-open["series-page"] ◊(unfence (->html doc #:splice? #t)) ◊html$-page-body-close[] </html> |
Modified snippets-html.rkt from [2b13836e] to [9386bc7c].
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
(define maybe-author-class (cond [(string=? author default-authorname) "by-proprietor"] [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"> <time datetime="◊date">◊ymd->english[date]</time> </a></p> <section class="entry-content"> <div class="p-content p-name">◊|contents|</div> ◊author-part </section> </article>}) |
| |
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
(define maybe-author-class (cond [(string=? author default-authorname) "by-proprietor"] [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="/◊(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 </section> </article>}) |
Deleted sqlite-tools.rkt version [f4b3e603].
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 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 |
#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)) |
< < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Modified template.html.p from [d6041578] to [f2509ece].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
<!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] ◊html$-page-body-open[] ◊article-html ◊html$-page-body-close[] </html> |
< | < | |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 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 (parse-and-cache-article! here doc)) ◊html$-page-head[(current-plain-title)] ◊html$-page-body-open[] ◊article-html ◊html$-page-body-close[] </html> |