◊(Local Yarn Code "Diff")

Differences From Artifact [6da95dad]:

To Artifact [18b3b766]:


12
13
14
15
16
17
18
19


20
21
22
23
24
25
26
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26
27







-
+
+







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

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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







                                               (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))
         [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
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
158
159
160
161
162
163
164

165






166
167


168
169
170

171
172
173
174
175
176
177
178







-
+
-
-
-
-
-
-
+
+
-
-



-
+







  
  (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)
(define (extract-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)))
  (for/list ([n (in-list note-txprs)])
    (make-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 (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))
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
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)])
    (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)))
    (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 ~~~
259
260
261
262
263
264
265
266














264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284







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