◊(Local Yarn Code "Check-in [187278e6]")

Overview
Comment:Collect cache INSERTs in a transaction, delegate to a thread
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 187278e61908a4e284ef8291912601e64a29008173be48b7f7948d427dcbd831
User & Date: joel on 2020-05-10 21:36:36
Other Links: manifest | tags
Context
2020-05-11
01:55
Bugfix cache-index-entries-only!, add to docs check-in: 70bf798f user: joel tags: trunk
2020-05-10
21:36
Collect cache INSERTs in a transaction, delegate to a thread check-in: 187278e6 user: joel tags: trunk
2020-05-04
02:04
Replace uses of undefined ‘cite’ tag with ‘attrib’ check-in: acdb5b41 user: joel tags: trunk, errata
Changes

Modified crystalize.rkt from [6da95dad] to [18b3b766].

12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
..
62
63
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
...
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
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
...
259
260
261
262
263
264
265
266













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


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

................................................................................
                                               (length (current-notes)))]
         [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-section-html (cache-notes! pagenode title-plain (current-notes))])






    (cache-index-entries! pagenode doc) ; note original doc is used here




    (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
................................................................................
  
  (cond [(ormap non-empty-string? (list series-part disp-part notes-part))
         (string-join (list series-part disp-part notes-part))]
        [else ""]))

;; ~~~ Notes ~~~

(define (cache-notes! pagenode parent-title note-txprs)
  (query-exec (cache-conn) (delete (~> (from cache:note #:as n)
                                       (where (= n.page ,(symbol->string pagenode))))))
  (cond [(not (null? note-txprs))
         (define note-htmls
           (for/list ([n (in-list note-txprs)])
             (cache-note! n pagenode parent-title)))
         (html$-notes-section note-htmls)]
        [else ""]))

;; 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 (cache-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)
    (raise-arguments-error 'note "required attr missing: date" "attrs" attrs))
................................................................................
                                                note-id
                                                title-html
                                                note-date
                                                note-srcline
                                                content-html
                                                author
                                                author-url)])
    (insert-one! (cache-conn)
                 (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 ~~~
................................................................................
  (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))
  




















|
>







 







|
>
>
>
>
>
>
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
<
<
<
<
|
|
<
<



|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
..
63
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
...
158
159
160
161
162
163
164
165




166
167


168
169
170
171
172
173
174
175
176
177
178
...
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
...
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
         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 ""))

................................................................................
                                               (length (current-notes)))]
         [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
................................................................................
  
  (cond [(ormap non-empty-string? (list series-part disp-part notes-part))
         (string-join (list series-part disp-part notes-part))]
        [else ""]))

;; ~~~ 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)
    (raise-arguments-error 'note "required attr missing: date" "attrs" attrs))
................................................................................
                                                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 ~~~
................................................................................
  (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)
         (insert-one! (cache-conn)
                       (make-cache:article
                        #:title-plain title
                        #:conceal (maybe-meta 'conceal)
                        #:page pagenode))))))))