| ︙ | | |
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
|
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
|
(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)]
|
| ︙ | | |
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
|
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
|
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
[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
(query-exec (cache-conn)
(delete (~> (from cache:note #:as n)
(where (= n.page ,(symbol->string pagenode))))))
(apply insert! (cache-conn) (map car notes))
(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))))
|
| ︙ | | |
164
165
166
167
168
169
170
171
172
173
174
175
|
187
188
189
190
191
192
193
194
195
196
197
|
-
+
-
|
(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
|
| ︙ | | |
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
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
|
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 "")
(html$-note-in-article note-id note-date content-html author author-url))))
|
| ︙ | | |
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
|
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
|
-
+
-
+
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
|
#: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)))
(delete-index-entries! pagenode)
(save-cache-things! all-entries))
(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))))))))
|
