33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
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
|
+
+
+
+
+
|
(require pollen/setup
pollen/core
pollen/template
racket/string
racket/function
txexpr
db/base
"sqlite-tools.rkt"
"snippets-html.rkt"
"dust.rkt")
;; ~~~ Provides ~~~
(provide spell-of-summoning!
crystalize-article!
article-plain-title
list-short/articles
list-full/articles
list-full/articles+notes
unfence
preheat-series!)
;; ~~~ Private use ~~~
(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))
|
83
84
85
86
87
88
89
90
91
92
|
88
89
90
91
92
93
94
95
96
97
98
|
+
|
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
|
122
123
124
125
126
127
128
129
130
131
132
|
128
129
130
131
132
133
134
135
136
137
138
|
-
+
|
(let* ([pubdate (select-from-metas 'published (current-metas))]
[doc-html (->html (cdr body-txpr))]
[title-specified? (not (equal? '() maybe-title))]
[title-val (if (not (null? maybe-title)) (car maybe-title) maybe-title)]
[title-tx (make-article-title title-val body-txpr disposition disp-note-id)]
[title-html (->html title-tx)]
[title-html (apply string-append (map ->html (get-elements title-tx)))]
[title-plain (tx-strs title-tx)]
[series-node (series-pagenode)]
[header (html$-article-open title-specified? title-tx pubdate)]
[footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]
[footer (html$-article-close footertext)]
|
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
doc-html
disposition
disp-note-id
(string-append header doc-html footer)
"" ; listing_excerpt_html: Not yet used
"")) ; listing_short_html: Not yet used
(html$-article-listing-short (symbol->string pagenode) pubdate title-plain))) ; 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)))
;; ~~~ 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-path)) s)])
(format "WHERE `series_pagenode` IN ~a" (list->sql-values series)))]
[(string? s)
(format "WHERE `series_pagenode` IS \"~a/~a.html\"" series-path s)]
[(equal? s #t)
(format "WHERE `series_pagenode` IS \"~a\"" (here-output-path))]
[else ""]))
;; (private) 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` FROM `articles`
UNION SELECT
`~a`,`date` AS `published` FROM `notes`
~a ORDER BY `published` ~a LIMIT ~a)
@@@@@
)
(query-list (sqltools:dbc) (format select type type type (where/series s) order limit)))
;; (private) 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 (list-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 (list-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 (list-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 ~~~
;;
;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title supplied-title body-tx disposition disp-note-id)
|
256
257
258
259
260
261
262
263
264
265
|
314
315
316
317
318
319
320
321
322
323
324
|
+
|
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
|
