◊(Local Yarn Code "Check-in [4b2c827f]")

Overview
Comment:A start on improving build times
Timelines: family | ancestors | descendants | both | cache-faster
Files: files | file ages | folders
SHA3-256: 4b2c827f985f317135a7114996da25482c71a51502fc38f12ee552f4d024f476
User & Date: joel on 2020-07-03 20:59:30
Other Links: branch diff | manifest | tags
Context
2021-02-14
03:14
Use metas? Leaf check-in: aaa8d600 user: joel tags: cache-faster
2020-07-03
20:59
A start on improving build times check-in: 4b2c827f user: joel tags: cache-faster
2020-05-11
02:01
Render home page from pollen/markup (Fixes [629a9c063beb5809]) check-in: 9998fecb user: joel tags: trunk
Changes

Modified cache.rkt from [3893f276] to [f6c8c8de].

82
83
84
85
86
87
88
89
90
91
92




93
94
95
96
97
98
99
82
83
84
85
86
87
88




89
90
91
92
93
94
95
96
97
98
99







-
-
-
-
+
+
+
+







  ([path        string/f]
   [title       string/f]
   [author      string/f]
   [published   string/f]
   [updated     string/f]
   [html        string/f]))

(define (init-cache-db!)
  (create-table! (cache-conn) 'cache:article)
  (create-table! (cache-conn) 'cache:note)
  (create-table! (cache-conn) 'cache:index-entry))
(define (init-cache-db! #:reset? [reset? #f])
  (for ([table (in-list '(cache:article cache:note cache:index-entry))])
    (when reset? (drop-table! (cache-conn) table))
    (create-table! (cache-conn) table)))

(define (delete-article! page)
  (query-exec (cache-conn)
              (~> (from cache:article #:as a)
                  (where (= a.page ,(format "~a" page)))
                  delete)))

Modified crystalize.rkt from [4e54a177] to [7c40c653].

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))))))))