◊(Local Yarn Code "Changes On Branch aaa8d600828bcf39")

Login
About History Code Code Docs Road Map Issues
Hide Diff Patch Unified Diff

Changes In Branch cache-faster Excluding Merge-Ins

This is equivalent to a diff from 9998fecb to aaa8d600

2021-02-14
15:35
Break loading cycle in pollen/setup Leaf check-in: d5b9dd58 user: joel tags: trunk
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
01:59
No empty “Further Notes” sections check-in: 542a013e user: joel tags: trunk

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

Modified dust.rkt from [cb0db902] to [831cdf23].

︙︙
19
20
21
22
23
24
25

26
27
28
29
30
31
32

         racket/system
         racket/string)

;; Provides common helper functions used throughout the project

(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available

         here-output-path
         here-source-path
         here-id
         listing-context
         current-series-noun    ; Retrieve noun-singular from current 'series meta, or #f
         current-series-title   ; Retrieve title of series in current 'series meta, or #f
         current-series-pagenode








>








19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

         racket/system
         racket/string)

;; Provides common helper functions used throughout the project

(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available
         set-meta!
         here-output-path
         here-source-path
         here-id
         listing-context
         current-series-noun    ; Retrieve noun-singular from current 'series meta, or #f
         current-series-title   ; Retrieve title of series in current 'series meta, or #f
         current-series-pagenode
︙︙
60
61
62
63
64
65
66





67
68
69
70
71
72
73

(define (default-title body-txprs)
  (format "“~a…”" (first-words body-txprs 5)))

(define (maybe-meta m [missing ""])
  (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
        [else missing]))






;; Return the current source path, relative to (current-project-root)
(define (here-source-path)
  (match (current-metas)
    [(? hash? m)
     (define-values (_ rel-path-parts)
       (drop-common-prefix (explode-path (current-project-root))
                           (explode-path (string->path (hash-ref m 'here-path)))))








>
>
>
>
>








61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

(define (default-title body-txprs)
  (format "“~a…”" (first-words body-txprs 5)))

(define (maybe-meta m [missing ""])
  (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
        [else missing]))

(define (set-meta! key v)
  (define cur-metas (current-metas))
  (and cur-metas
       (current-metas (hash-set! cur-metas key v))))

;; Return the current source path, relative to (current-project-root)
(define (here-source-path)
  (match (current-metas)
    [(? hash? m)
     (define-values (_ rel-path-parts)
       (drop-common-prefix (explode-path (current-project-root))
                           (explode-path (string->path (hash-ref m 'here-path)))))
︙︙

Modified tags-html.rkt from [88b1006b] to [6a584dcf].

︙︙
108
109
110
111
112
113
114
115



116



117


118
119
120
121
122
123
124

  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))

(define (html-title . elements) `(title ,@elements))



(define (html-excerpt . elements) `(excerpt ,@elements))



(define (html-excerpt* . elements) `(excerpt* ,@elements))



(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))









|
>
>
>
|
>
>
>
|
>
>








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

  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))

(define (html-title . elements)
  (set-meta! 'title elements)
  `(title ,@elements))

(define (html-excerpt . elements)
  (set-meta! 'excerpt elements)
  "")

(define (html-excerpt* . elements)
  (set-meta! 'excerpt elements)
  `(@ ,@elements))

(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))
︙︙

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