1
2
3
4
5
6
7
8
|
#lang pollen/mode racket/base
;; Copyright (c) 2018 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
|
|
|
1
2
3
4
5
6
7
8
|
#lang racket/base
;; Copyright (c) 2018 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
|
| ︙ | | | ︙ | |
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
"snippets-html.rkt"
"dust.rkt")
;; ~~~ Provides ~~~
(provide spell-of-summoning!
crystalize-article!
article-plain-title)
;; ~~~ 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
|
|
>
|
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
"snippets-html.rkt"
"dust.rkt")
;; ~~~ Provides ~~~
(provide spell-of-summoning!
crystalize-article!
article-plain-title
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
|
| ︙ | | | ︙ | |
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
disp-note-id
(string-append header doc-html footer)
"" ; listing_excerpt_html: Not yet used
"")) ; listing_short_html: Not yet used
(apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
◊string-append{◊header ◊doc-html ◊notes-section-html ◊footer})
;; ~~~ Article-related helper functions ~~~
;;
;; Return both a plain-text and HTML version of a title for the current article,
;; supplying a default if no title was specified in the metas.
(define (title-plain+html-values body-tx disposition)
|
|
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
disp-note-id
(string-append header doc-html footer)
"" ; listing_excerpt_html: Not yet used
"")) ; listing_short_html: Not yet used
(apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
(string-append header doc-html notes-section-html footer))
;; ~~~ Article-related helper functions ~~~
;;
;; Return both a plain-text and HTML version of a title for the current article,
;; supplying a default if no title was specified in the metas.
(define (title-plain+html-values body-tx disposition)
|
| ︙ | | | ︙ | |
279
280
281
282
283
284
285
|
(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 (article-plain-title pagenode)
(query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(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 (article-plain-title pagenode)
(query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))
;; ~~~ 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))
|
