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

Login
About History Code Code Docs Road Map Issues
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

  ([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 (delete-article! page)
  (query-exec (cache-conn)
              (~> (from cache:article #:as a)
                  (where (= a.page ,(format "~a" page)))
                  delete)))









|
|
|
|








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! #: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

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



























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








|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>














|
>
>
|
>
>
>
>
>
|








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

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

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


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








<
<
<
<
<
<
|
<
<
<
|
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>








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






         [index-entries (extract-index-entries pagenode doc)])



    (append


     (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


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








|
<








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

;; Create cache:note entity

(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

                                                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 "")
     (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 ~~~








<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<








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

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


(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


      [(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.
;; Sub-entries are specified by "!" in the index key
(define (cache-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))

(define (cache-index-entries-only! title pagenode doc)
  (void
   (thread
    (lambda ()
      (call-with-transaction
       (cache-conn)
       (lambda ()
         (cache-index-entries! pagenode doc)
         (delete-article! pagenode)
         (insert-one! (cache-conn)
                       (make-cache:article
                        #:title-plain title
                        #:conceal "blog,feed"
                        #:page pagenode))))))))









|

|

<
|
|
<
<
<








|

|
|
|
|
|
>

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

;; 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 (extract-index-entries pagenode doc)
  (define-values (_ entry-txs) (splitf-txexpr doc index-entry-txpr?))

  (append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode))
          (current-metas-keyword-entries pagenode)))




(define (cache-index-entries-only! title pagenode doc)
  (void
   (thread
    (lambda ()
      (call-with-transaction
       (cache-conn)
       (lambda ()
         (delete-index-entries! pagenode)
         (delete-article! pagenode)
         (apply insert! (cache-conn)
                (make-cache:article
                 #:title-plain title
                 #:conceal "blog,feed"
                 #:page pagenode)
                (extract-index-entries pagenode doc))))))))

This page was generated in about 0.011s by Fossil 2.19 [318ab802db] 2022-05-27 02:05:21