︙ | | |
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
|
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
|
pollen/template
pollen/decode
(except-in pollen/core select) ; avoid conflict with deta
)
(require "dust.rkt" "cache.rkt" "snippets-html.rkt")
(provide parse-and-cache-article!
(provide main
cache-index-entries-only!)
(define current-title (make-parameter #f))
(define current-excerpt (make-parameter #f))
(define current-notes (make-parameter '()))
(define current-disposition (make-parameter ""))
(define current-disp-id (make-parameter ""))
;; Rebuild the SQLite cache with all article entities
(define (main)
(define pages (cdr (articles-pagetree)))
(define (getter-thunk)
(define parent (thread-receive))
(define article (thread-receive))
(thread-send parent (all-entities article (get-doc article))))
(for ([p (in-list pages)])
(let ([t (thread getter-thunk)])
(thread-send t (current-thread))
(thread-send t p)))
(define entities
(time
(for/vector ([i (in-range (length pages))])
(thread-receive))))
(time (call-with-transaction
(cache-conn)
(lambda ()
(init-cache-db! #:reset? #t)
(for ([x (in-vector entities)])
(for ([e (in-list x)])
(insert-one! (cache-conn) e)))))))
(define (filter-special-tags tx)
(match (get-tag tx)
['title (current-title tx) ""]
['excerpt (current-excerpt tx) ""]
['excerpt* (current-excerpt tx) `(@ ,@(get-elements tx))] ; splice contents back in
['note
(define note-id (build-note-id tx))
(cond [(attrs-have-key? tx 'disposition)
(current-disp-id note-id)
(current-disposition (attr-ref tx 'disposition))])
(current-notes (cons (attr-set tx 'note-id note-id) (current-notes))) ""]
[_ tx]))
;; Save an article and its notes (if any) to the database, and return
;; (values plain-title [rendered HTML of the complete article])
(define (parse-and-cache-article! pagenode doc)
;; From an article, return a list of cache:article, cache:note and cache:index-entry entities
(define (all-entities pagenode doc)
;; Reset parameters in case we’re doing multiple articles
(current-title #f)
(current-excerpt #f)
(current-notes '())
(current-disposition "")
(current-disp-id "")
(current-metas (get-metas pagenode))
(define body-txpr (decode doc #:txexpr-proc filter-special-tags))
(current-notes (reverse (current-notes)))
(let* ([pubdate (select-from-metas 'published (current-metas))]
[doc-html (->html body-txpr #:splice? #t)]
[title-specified? (if (current-title) #t #f)]
[title-val (or (current-title) (check-for-poem-title doc))]
[title-tx (make-article-title pagenode
|
︙ | | |
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
|
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
|
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
[footer (html$-article-close footertext)]
[listing-short (html$-article-listing-short pagenode pubdate title-html)]
[listing-full (string-append header doc-html footer)]
[listing-excerpt (match (current-excerpt)
[#f listing-full]
[(var e) (string-append header (html$-article-excerpt pagenode e) footer)])]
[notes (extract-notes pagenode title-plain (current-notes))]
[notes-section-html (html$-notes-section (map cadr notes))])
(thread
(lambda ()
(call-with-transaction
(cache-conn)
(lambda ()
(cache-index-entries! pagenode doc) ; note original doc is used here
[index-entries (extract-index-entries pagenode doc)])
(query-exec (cache-conn)
(delete (~> (from cache:note #:as n)
(where (= n.page ,(symbol->string pagenode))))))
(apply insert! (cache-conn) (map car notes))
(append
(delete-article! pagenode)
(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 (current-series-noun))
#:note-count (length (current-notes))
#:content-html doc-html
#:disposition (current-disposition)
#:disp-html-anchor (current-disp-id)
#:listing-full-html listing-full
#:listing-excerpt-html listing-excerpt
#:listing-short-html listing-short))))))
(values title-plain (string-append header doc-html notes-section-html footer))))
(cons (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 (current-series-noun))
#:note-count (length (current-notes))
#:content-html doc-html
#:disposition (current-disposition)
#:disp-html-anchor (current-disp-id)
#:listing-full-html listing-full
#:listing-excerpt-html listing-excerpt
#:listing-short-html listing-short)
notes)
index-entries)))
(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"))
|
︙ | | |
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
-
+
-
|
;; ~~~ Notes ~~~
(define (extract-notes pagenode parent-title note-txprs)
(for/list ([n (in-list note-txprs)])
(make-note n pagenode parent-title)))
;; Save an individual note to the DB and return the HTML of the complete note as
;; Create cache:note entity
;; it should appear on an individual article page
(define (make-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)
|
︙ | | |
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
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
|
note-id
title-html
note-date
note-srcline
content-html
author
author-url)])
(list
(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 (current-series-pagenode)
#:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
#:content-html content-html
#:listing-full-html listing-full
#:listing-excerpt-html listing-full
#:listing-short-html "")
(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 (current-series-pagenode)
#:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
#:content-html content-html
#:listing-full-html listing-full
#:listing-excerpt-html listing-full
#: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 ~~~
|
︙ | | |
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
|
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
|
-
+
-
+
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
|
[(list main sub)
(make-cache:index-entry
#:entry main
#:subentry sub
#:page pagenode
#:html-anchor "")])))
;; Save any index entries in doc to the SQLite cache.
;; Build a list of cache:index-entry entities for all entries in the docs or current metas
;; Sub-entries are specified by "!" in the index key
(define (cache-index-entries! pagenode doc)
(define (extract-index-entries pagenode doc)
(define-values (_ entry-txs) (splitf-txexpr doc index-entry-txpr?))
(define all-entries
(append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode))
(current-metas-keyword-entries pagenode)))
(append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode))
(current-metas-keyword-entries pagenode)))
(delete-index-entries! pagenode)
(save-cache-things! all-entries))
(define (cache-index-entries-only! title pagenode doc)
(void
(thread
(lambda ()
(call-with-transaction
(cache-conn)
(lambda ()
(cache-index-entries! pagenode doc)
(delete-index-entries! pagenode)
(delete-article! pagenode)
(insert-one! (cache-conn)
(make-cache:article
#:title-plain title
#:conceal "blog,feed"
#:page pagenode))))))))
(apply insert! (cache-conn)
(make-cache:article
#:title-plain title
#:conceal "blog,feed"
#:page pagenode)
(extract-index-entries pagenode doc))))))))
|