◊(Local Yarn Code "Diff")

Differences From Artifact [0131cbe3]:

To Artifact [950c4fe1]:


1
2
3
4
5
6
7
8
9
10
11
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
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
110
111
112


113

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

135




136

137
138
139
140
141

142
143
144
145
146
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
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
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
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
267
268
269
270
271
272
#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.

;; Provides functions for fast preserving and fetching of article/series data.
;;  → Docs and metas go in (saved to SQLite database)
;;    HTML comes out →
;; Calling sites have no notion of the database or schema.

;; The functions provided by sqlite-tools.rkt are not safe for user-provided
;; data; a maliciously crafted input could bomb the database. This is acceptable
;; since the database is merely a disposable cache, and since all the input
;; will be coming from me.

(require pollen/setup

         pollen/core
         pollen/template
         racket/string
         racket/function
         racket/list
         txexpr
         db/base
         "sqlite-tools.rkt"
         "snippets-html.rkt"
         "dust.rkt")

;; ~~~ Provides ~~~

(provide spell-of-summoning!
         crystalize-article!
         crystalize-series!
         crystalize-index-entries!
         article-plain-title




         list/articles
         list/articles+notes
         listing<>-short/articles
         listing<>-full/articles

         listing<>-full/articles+notes
         unfence
         sqltools:dbc
         preheat-series!)

;; ~~~ Private use ~~~

(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))


;; Since the DB exists to serve as a high-speed cache, the tables are constructed so that
;; the most commonly needed data can be grabbed quickly with extremely simple queries. In
;; the even that you want to do something fancy and custom rather than using the pre-cooked
;; HTML, enough info is provided in the other columns to allow you to do so.
;;
(define table_articles-fields

  '(pagenode
    title_plain
    title_html_flow
    title_specified
    published
    updated
    author
    conceal
    series_pagenode
    noun_singular 
    note_count
    doc_html
    disposition
    disposition_note_id
    listing_full_html    ; Contains full content in default HTML format, but without notes
    listing_excerpt_html ; Not used for now
    listing_short_html)) ; Date and title only

(define table_notes-fields

  '(pagenode
    note_id
    title_html_flow

    title_plain
    author
    author_url
    date

    disposition
    content_html
    series_pagenode
    listing_full_html
    listing_excerpt_html  ; Not used for now
    listing_short_html))

(define table_series-fields
  '(pagenode
    title
    published
    noun_plural
    noun_singular))






(define table_keywordindex-fields

  '(entry
    subentry
    pagenode
    anchor))

(define table_articles (make-table-schema "articles" table_articles-fields))
(define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id)))
(define table_series (make-table-schema "series" table_series-fields))
(define table_keywordindex (make-table-schema "keywordindex"
                                              table_keywordindex-fields
                                              #:primary-key-cols '(pagenode anchor)))

;; ~~~ Provided functions: Initializing; Saving posts and notes




;; Initialize the database connection, creating the database if it doesn’t
;; exist, and executing the table schema queries
;;
(define (spell-of-summoning!)


  (init-db! DBFILE table_articles table_notes table_series table_keywordindex))


;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
(define (crystalize-article! pagenode doc)
  (define-values
    (doc2 maybe-title) (splitf-txexpr doc (make-tag-predicate 'title)))
  (define-values 
    (body-txpr note-txprs) (splitf-txexpr doc2 (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))
  
  (let* ([pubdate (select-from-metas 'published (current-metas))]
         [doc-html    (->html body-txpr #:splice? #t)]
         [title-specified? (not (equal? '() maybe-title))]
         [title-val   (if (not (null? maybe-title)) (car maybe-title) (check-for-poem-title doc))]
         [title-tx    (make-article-title pagenode title-val body-txpr disposition disp-note-id)]
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]
         [series-node (series-pagenode)]
         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]

         [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]




         [footer (html$-article-close footertext)]

         [notes-section-html (crystalize-notes! pagenode title-plain note-txprs)])

    (crystalize-index-entries! pagenode doc) ; Note the original doc is used here

    ;; Values must come in the order defined in table_article_fields

    (define article-record
      (list (symbol->string pagenode)
            title-plain
            title-html
            (bool->int title-specified?)
            pubdate
            (maybe-meta 'updated)
            (maybe-meta 'author default-authorname)
            (maybe-meta 'conceal)
            (symbol->string series-node)
            (maybe-meta 'noun (series-noun))
            (length note-txprs)
            doc-html
            disposition
            disp-note-id
            (string-append header doc-html footer)
            "" ; listing_excerpt_html: Not yet used
            (html$-article-listing-short pagenode pubdate title-html)))

    (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
          
    (string-append header doc-html notes-section-html footer)))

;; ~~~ Retrieve listings of articles and notes ~~~
;; ~~~ (Mainly for use on Series pages         ~~~

;; (private) Create a WHERE clause matching a single series or list of series
(define (where/series s)
  (cond [(list? s)
         (let ([series (map (curry (format "~a/~a.html" series-folder)) s)])
           (format "WHERE `series_pagenode` IN ~a" (list->sql-values series)))]
        [(string? s)
         (format "WHERE `series_pagenode` IS \"~a/~a.html\"" series-folder s)]
        [(equal? s #t)
         (format "WHERE `series_pagenode` IS \"~a\"" (here-output-path))]
        [else ""]))

;; Return a combined list of articles and notes sorted by date
(define (list/articles+notes type #:series [s #t] #:limit [limit -1] [order "DESC"])
  (define select #<<@@@@@
     SELECT `~a` FROM
       (SELECT `~a`, `published`, `series_pagenode` FROM `articles`
        UNION SELECT
        `~a`,`date` AS `published`, `series_pagenode` FROM `notes`)
        ~a ORDER BY `published` ~a LIMIT ~a
@@@@@
    )
  (query-list (sqltools:dbc) (format select type type type (where/series s) order limit)))

;; Return a list of articles only, sorted by date
(define (list/articles type #:series [s #t] #:limit [limit -1] [order "DESC"])
  (define select "SELECT `~a` FROM `articles` ~a ORDER BY `published` ~a LIMIT ~a")
  (query-list (sqltools:dbc) (format select type (where/series s) order limit)))

;; ~~~~
;; Return cached HTML of articles and/or notes, fenced within a style txexpr to prevent it being
;; escaped by ->html. See also: definition of `unfence`

(define (listing<>-short/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style "<ul class=\"article-list\">"
          ,@(list/articles "listing_short_html" #:series s #:limit limit order)
          "</ul>"))

(define (listing<>-full/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style ,@(list/articles "listing_full_html" #:series s #:limit limit order)))

;; Return a combined list of articles and notes (“full content” version) sorted by date
(define (listing<>-full/articles+notes #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style ,@(list/articles+notes "listing_full_html" #:series s #:limit limit order)))

;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from
;; listing functions
(define (unfence html-str)
  (regexp-replace* #px"<[\\/]{0,1}style>" html-str ""))

;; ~~~ Article-related helper functions ~~~
;;

;; If the first element is a titled poem, the poem’s title can be used for the article title.
(define (check-for-poem-title doc)
  (define e1 (car (get-elements doc)))
  (define e2 (if (null? (get-elements e1))
                 '()
                 (car (get-elements e1))))
  (cond
    [(and (txexpr? e1)
          (equal? 'div (get-tag e1))
          (attrs-have-key? e1 'class)
          (string=? "poem" (attr-ref e1 'class))
          (not (null? e2))
          (txexpr? e2)
          (equal? 'p (get-tag e2))
          (attrs-have-key? e2 'class)
          (string=? "verse-heading" (attr-ref e2 'class)))

     `(title (span [[class "smallcaps"]] "‘" ,@(get-elements e2) "’"))]
    [else '()]))

;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title pagenode supplied-title body-tx disposition disp-note-id)
  (define title-elems
    (cond [(null? supplied-title) (list (default-title (get-elements body-tx)))]
          [else (get-elements supplied-title)]))
  
  (define disposition-part
    (cond [(non-empty-string? disposition)
           (define-values (mark _) (disposition-values disposition))
           `(a [[class "disposition-mark"] 
                [href ,(format "~a~a#~a" web-root pagenode disp-note-id)]] 
               ,mark)]
          [else ""]))
  ;; Returns a txexpr, the tag will be discarded by the template/snippets
  `(title ,@title-elems ,disposition-part))
  
;; Convert a bunch of information about an article into some nice English and links.
(define (make-article-footertext pagenode series disposition disp-note-id note-count)
  (define s-title (series-title))
  (define s-noun (series-noun))
  (define series-part

    (cond [(non-empty-string? s-title)
           (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
                   s-noun
                   series
                   s-title)]
          [else ""]))
  (define disp-part
    (cond [(non-empty-string? disposition)
           (define-values (mark verb) (disposition-values disposition))
           (format "Now considered <a href=\"/~a#~a\">~a</a>."
                   pagenode
                   disp-note-id
                   verb)]





<
<
<
<
|
<
<
<
<

|
>
|

|
<
<
<
|
|
|
<

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

|

|
>

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

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

|
<
|
<
<
<
>
>
>
>
>

|
>
|
|
|
|

<
<
<
|
<
<
|
<
>
>
>

<
<
<
|
>
>
|
>




|
|
|
|
|


|







<

>
|
>
>
>
>

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


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
















|


<
<

>
|
|
|
|
|
|







1
2
3
4
5




6




7
8
9
10
11
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
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
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130
131

132
133

134
135
136
137
138
139
140
141
142
143
144
145
146
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
174
175
176
177
178
179
180
181
182
183


184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#lang racket/base

; SPDX-License-Identifier: BlueOak-1.0.0
; This file is licensed under the Blue Oak Model License 1.0.0.





(require deta db/base db/sqlite3 threading txexpr gregor)





(require racket/match
         racket/string
         pollen/pagetree
         pollen/template
         (except-in pollen/core select) ; avoid conflict with deta



         pollen/setup)

(require "dust.rkt" "snippets-html.rkt")


(provide init-cache-db!
         cache-conn            ; The most eligible bachelor in Neo Yokyo

         parse-and-cache-article!
         cache-series!

         current-plain-title
         (schema-out cache:article)
         (schema-out cache:note)
         (schema-out cache:series)
         (schema-out cache:index-entry)
         articles
         articles+notes
         listing-htmls
         <listing-full>
         <listing-excerpt>
         <listing-short>
         unfence)



;; Cache DB and Schemas

(define DBFILE (build-path (current-project-root) "vitreous2.sqlite"))
(define cache-conn (sqlite3-connect #:database DBFILE #:mode 'create))

(define current-plain-title (make-parameter "void"))




(define-schema cache:article #:table "articles"
  ([id                   id/f #:primary-key #:auto-increment]
   [page                 symbol/f]
   [title-plain          string/f]
   [title-html-flow      string/f]
   [title-specified?     boolean/f]
   [published            string/f]
   [updated              string/f]
   [author               string/f]
   [conceal              string/f]
   [series-page          symbol/f]
   [noun-singular        string/f]
   [note-count           integer/f]
   [doc-html             string/f]
   [disposition          string/f]
   [disp-html-anchor     string/f]
   [listing-full-html    string/f]   ; full content but without notes
   [listing-excerpt-html string/f]   ; Not used for now
   [listing-short-html   string/f])) ; Date and title only

(define-schema cache:note #:table "notes"
  ([id                   id/f #:primary-key #:auto-increment]
   [page                 symbol/f]

   [html-anchor          string/f]
   [title-html-flow      string/f] ; No block-level HTML elements
   [title-plain          string/f]
   [author               string/f]
   [author-url           string/f]

   [published            string/f]
   [disposition          string/f]
   [content-html         string/f]
   [series-page          symbol/f]
   [listing-full-html    string/f]
   [listing-excerpt-html string/f]   ; Not used for now
   [listing-short-html   string/f])) ; Date and title only

(define-schema cache:series #:table "series"

  ([id            id/f #:primary-key #:auto-increment]



   [page          symbol/f]
   [title         string/f]
   [published     string/f]
   [noun-plural   string/f]
   [noun-singular string/f]))

(define-schema cache:index-entry #:table "index_entries"
  ([id          id/f #:primary-key #:auto-increment]
   [entry       string/f]
   [subentry    string/f]
   [page        symbol/f]
   [html-anchor string/f]))




(define-schema listing


  #:virtual

  ([html        string/f]
   [published   date/f]
   [series-page symbol/f]))




(define (init-cache-db!)
  (create-table! cache-conn 'cache:article)
  (create-table! cache-conn 'cache:note)
  (create-table! cache-conn 'cache:series)
  (create-table! cache-conn 'cache:index-entry))

;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
(define (parse-and-cache-article! pagenode doc)
  (define-values (doc-no-title maybe-title)
    (splitf-txexpr doc (make-tag-predicate 'title)))
  (define-values (body-txpr note-txprs)
    (splitf-txexpr doc-no-title (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))

  (let* ([pubdate (select-from-metas 'published (current-metas))]
         [doc-html    (->html body-txpr #:splice? #t)]
         [title-specified? (not (equal? '() maybe-title))]
         [title-val   (if (not (null? maybe-title)) (car maybe-title) (check-for-poem-title doc))]
         [title-tx    (make-article-title pagenode title-val body-txpr disposition disp-note-id)]
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]

         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]
         [series-node (metas-series-pagenode)]
         [footertext  (make-article-footertext pagenode
                                               series-node
                                               disposition
                                               disp-note-id
                                               (length note-txprs))]
         [footer (html$-article-close footertext)]
         [listing-short (html$-article-listing-short pagenode pubdate title-html)]
         [notes-section-html (cache-notes! pagenode title-plain note-txprs)])

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

    (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 (series-metas-noun))
                  #:note-count (length note-txprs)
                  #:doc-html doc-html
                  #:disposition disposition
                  #:disp-html-anchor disp-note-id
                  #:listing-full-html (string-append header doc-html footer)


                  #:listing-excerpt-html ""

                  #:listing-short-html listing-short))
    (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"))
                            heading-elems)
                    _))
     `(title (span [[class "smallcaps"]] "‘" ,@heading-elems "’"))]
    [_ '()]))

;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title pagenode supplied-title body-tx disposition disp-note-id)
  (define title-elems
    (cond [(null? supplied-title) (list (default-title (get-elements body-tx)))]
          [else (get-elements supplied-title)]))
  
  (define disposition-part
    (cond [(non-empty-string? disposition)
           (define-values (mark _) (disposition-values disposition))
           `(a [[class "disposition-mark"] 
                [href ,(format "~a~a#~a" web-root pagenode disp-note-id)]] 
               ,mark)]
          [else ""]))
  ;; Returns a txexpr, the tag will be discarded by the template/snippets
  `(title ,@title-elems ,disposition-part))

;; Convert a bunch of information about an article into some nice English and links.
(define (make-article-footertext pagenode series disposition disp-note-id note-count)


  (define series-part
    (match (series-metas-title)
      [(? non-empty-string? s-title)
       (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
               (series-metas-noun)
               series
               s-title)]
      [_ ""]))
  (define disp-part
    (cond [(non-empty-string? disposition)
           (define-values (mark verb) (disposition-values disposition))
           (format "Now considered <a href=\"/~a#~a\">~a</a>."
                   pagenode
                   disp-note-id
                   verb)]
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295

296
297
298
299


300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335
336
337

338
339
340
341

342
343
344
345
346
347
348

349
350
351
352
353
354
355
356

357

358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387








388




389
390
391
392

393
394
395
396



397









398

399



400











401

402
403

404
405


406




407

408



409

410

411
412


413




414



415




416

417
418


419
420
421
422
423
424







425
426
427
428
429
           (format "There is <a href=\"/~a#furthernotes\">a note</a> appended."
                   pagenode)]
          [else ""]))
  
  (cond [(ormap non-empty-string? (list series-part disp-part notes-part))
         (string-join (list series-part disp-part notes-part))]
        [else ""]))
    

;; ~~~ Notes ~~~

;; Save a collection of ◊note tags to the DB, and return the HTML of the complete
;; “Further Notes” section at the end
;;
(define (crystalize-notes! pagenode parent-title note-txprs)
  (define (crystalizer note-tx)

    (crystalize-note! note-tx (symbol->string pagenode) parent-title))
  
  (cond [((length note-txprs) . > . 0)
         (define notes-html (map crystalizer note-txprs))


         (html$-notes-section notes-html)]
        [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 (crystalize-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))
  (unless (or (string=? "" disposition-attr)
              (and ((length (string-split disposition-attr)) . >= . 2)))
    (raise-arguments-error 'note
                           "must be in format \"[symbol] [past-tense-verb]\""
                           "disposition attr"
                           disposition-attr))
  
  ;; Parse out remaining columns
  (define author (maybe-attr 'author attrs default-authorname))
  (define note-id (build-note-id note-tx))
  (define title-tx (make-note-title pagenode parent-title-plain))
  (define title-html-flow (->html title-tx #:splice? #t))
  (define title-plain (tx-strs title-tx))

  (define author-url (maybe-attr 'author-url attrs))
  (define-values (disp-mark disp-verb) (disposition-values disposition-attr))
  (define content-html (html$-note-contents disp-mark disp-verb (get-elements note-tx)))
  (define listing-full-html
    (html$-note-listing-full pagenode note-id title-html-flow note-date content-html author author-url))

  (define note-record
    (list pagenode
          note-id
          title-html-flow
          title-plain

          author
          author-url
          note-date
          disposition-attr

          content-html
          (symbol->string (series-pagenode))
          listing-full-html
          "" ; listing_excerpt_html: Not used for now
          "")) ; listing_short_html: Not used for now
  
  ;; save to db

  (define save-note-query
    (format (string-append "INSERT OR REPLACE INTO `notes` (`rowid`, ~a) "
                           "VALUES ((SELECT `rowid` FROM `notes` WHERE `pagenode` = ?1"
                           " AND `note_id` = ?2), ~a)")
            (list->sql-fields table_notes-fields)
            (list->sql-parameters table_notes-fields)))
  (apply query! save-note-query note-record)
  

  ;; return html$ of note

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

(define (article-plain-title pagenode)
  (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))

;; ~~~ Keyword Index Entries ~~~

;; (private) Convert an entry key into a list of at most two elements,
;; a main entry and a sub-entry.
;;   "entry" → '("entry" "")
;;   "entry!sub" → '("entry" "sub")
;;   "entry!sub!why?!? '("entry" "sub")
(define (split-entry str)
  (define splits (string-split str "!"))
  (list (car splits)
        (cadr (append splits (list "")))))

;; Save any index entries in doc to the SQLite cache.
;; Sub-entries are specified by "!" in the index key
(define (crystalize-index-entries! pagenode doc)
  (define (index-entry? tx)
    (and (txexpr? tx)
         (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index
         (attr-ref tx 'data-index-entry #f)))
  (define-values (_ entries) (splitf-txexpr doc index-entry?))













  ; Naive idempotence: delete and re-insert all index entries every time doc is rendered.
  (query! "DELETE FROM `keywordindex` WHERE `pagenode` = ?1" (symbol->string pagenode))
  
  (unless (null? entries)

    (define entry-rows
      (for/list ([entry-tx (in-list entries)])
        (define entry-parts (split-entry (attr-ref entry-tx 'data-index-entry)))
        (list (first entry-parts)



              (second entry-parts)









              (symbol->string pagenode)

              (attr-ref entry-tx 'id))))



    (query! (make-insert-rows-query "keywordindex" table_keywordindex-fields entry-rows))))













;; ~~~ Series ~~~


;; Preloads the SQLite cache with info about each series.
;; I may not actually need this but I’m leaving it for now.


(define (preheat-series!)




  (query! "DELETE FROM `series`")

  (define series-values



    (for/list ([series-pagenode (in-list (cdr (series-pagetree)))])

      (define series-metas (get-metas series-pagenode))

      (list (symbol->string series-pagenode)
            (hash-ref series-metas 'title)


            (hash-ref series-metas 'published)




            (hash-ref series-metas 'noun-plural "")



            (hash-ref series-metas 'noun-singular ""))))




  (define sql$-insert (make-insert-rows-query 'series table_series-fields series-values))

  (displayln sql$-insert)
  (query! sql$-insert))



;; Save the current article to the `series` table of the SQLite cache
;; Should be called from a template for series pages
(define (crystalize-series!)
  (define series-row
    (list (path->string (here-output-path))







          (hash-ref (current-metas) 'title)
          (hash-ref (current-metas) 'published "")
          (hash-ref (current-metas) 'noun-plural "")
          (hash-ref (current-metas) 'noun-singular "")))
  (apply query! (make-insert/replace-query 'series table_series-fields) series-row))







<



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




<
|








|




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






<
<
<












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

>
>
>
>

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

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



|
<
|
>
>
>
>
>
>
>
|
|
|
|
<
206
207
208
209
210
211
212

213
214
215



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
245

246
247

248


249
250
251
252
253
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
286
287
288



289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390

391
392
393
394
395
396

397
398
399
400
401
402
403
404
405
406
407
408

           (format "There is <a href=\"/~a#furthernotes\">a note</a> appended."
                   pagenode)]
          [else ""]))
  
  (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))
  (unless (or (string=? "" disposition-attr)
              (>= (length (string-split disposition-attr)) 2))
    (raise-arguments-error 'note
                           "must be in format \"[symbol] [past-tense-verb]\""
                           "disposition attr"
                           disposition-attr))
  (define-values (disp-mark disp-verb) (disposition-values disposition-attr))


  (let* ([note-id (build-note-id note-tx)]
         [title-tx (make-note-title pagenode parent-title-plain)]
         [title-html (->html title-tx #:splice? #t)]

         [author (maybe-attr 'author attrs default-authorname)]
         [author-url (maybe-attr 'author-url attrs)]

         [content-html (html$-note-contents disp-mark disp-verb elems)])


    (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 (metas-series-pagenode)
                  #:content-html content-html

                  #:listing-full-html (html$-note-listing-full pagenode


                                                               note-id

                                                               title-html
                                                               note-date


                                                               content-html



                                                               author
                                                               author-url)
                  #:listing-excerpt-html ""
                  #: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 ~~~

;; (private) Convert an entry key into a list of at most two elements,
;; a main entry and a sub-entry.
;;   "entry" → '("entry" "")
;;   "entry!sub" → '("entry" "sub")
;;   "entry!sub!why?!? '("entry" "sub")
(define (split-entry str)
  (define splits (string-split str "!"))
  (list (car splits)
        (cadr (append splits (list "")))))




(define (index-entry-txpr? tx)
  (and (txexpr? tx)
       (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index
       (attr-ref tx 'data-index-entry #f)))

(define (txexpr->index-entry tx pagenode)
  (match (split-entry (attr-ref tx 'data-index-entry))
    [(list main sub)
     (make-cache:index-entry
      #:entry main
      #:subentry sub
      #:page pagenode
      #:html-anchor (attr-ref tx 'id))]))

;; 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?))
  ; Naive idempotence: delete and re-insert all index entries every time doc is rendered.
  (query-exec cache-conn (delete (~> (from cache:index-entry #:as entry)
                                     (where (= entry.page ,(symbol->string pagenode))))))
  (unless (null? entry-txs)
    (void
     (apply insert! cache-conn
            (for/list ([etx (in-list entry-txs)])
              (txexpr->index-entry etx pagenode))))))

;;
;;  ~~~ Fetching articles and notes ~~~
;;

;; (Private use) Conveniece function for the WHERE `series-page` clause
(define (where-series q s)
  (define (s->p x) (format "~a/~a.html" series-folder x))
  (match s
    [(list series ...)
     (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...)
    [(or (? string? series) (? symbol? series))
     (where q (= a.series-page ,(s->p series)))]      ; WHERE series-page = "item"
    [#t
     (where q (= a.series-page ,(path->string (here-output-path))))]
    [_ q]))

;; Needed to "parameterize" column names
;; see https://github.com/Bogdanp/deta/issues/14#issuecomment-573344928
(require (prefix-in ast: deta/private/ast))

;; Builds a query to fetch articles
(define (articles type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (define html-field (format "listing_~a_html" type))
  (~> (from cache:article #:as a)
      (select (fragment (ast:as (ast:qualified "a" html-field) "html"))
              a.published
              a.series-page)
      (where-series s)
      (limit ,lim)
      (order-by ([a.published ,ord]))
      (project-onto listing-schema)))

;; Builds a query that returns articles and notes intermingled chronologically
(define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (define html-field (format "listing_~a_html" type))
  (~> (from (subquery
             (~> (from cache:article #:as A)

                 (select (fragment (ast:as (ast:qualified "A" html-field) "html"))
                         A.published
                         A.series-page)
                 (union
                  (~> (from cache:note #:as N)
                      (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
                              N.published
                              N.series-page)))))
            #:as a)
      (where-series s)
      (limit ,lim)
      (order-by ([a.published ,ord]))
      (project-onto listing-schema)))

;; Get all the a list of the HTML all the results in a query
(define (listing-htmls list-query)
  (for/list ([l (in-entities cache-conn list-query)])
    (listing-html l)))

;; Return cached HTML of articles and/or notes, fenced within a style txexpr to prevent it being
;; escaped by ->html. See also: definition of `unfence`

;; E.g.: (<listing-full> articles+notes)
(define (<listing-full> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style ,@(listing-htmls (query-func 'full #:series s #:limit lim #:order ord))))
;;                                     ^^^^^

(define (<listing-excerpt> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style ,@(listing-htmls (query-func 'excerpt #:series s #:limit lim #:order ord))))
;;                                     ^^^^^^^^

(define (<listing-short> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style "<ul class=\"article-list\">"
          ,@(listing-htmls (query-func 'short #:series s #:limit lim #:order ord))
          "</ul>")) ;;                 ^^^^^^

;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from
;; listing functions

(define (unfence html-str)
  (regexp-replace* #px"<[\\/]{0,1}style>" html-str ""))

;; Save the current article to the `series` table of the SQLite cache
;; Should be called from a template for series pages
(define (cache-series!)

  (define here-page (path->string (here-output-path)))
  (query-exec cache-conn
              (delete (~> (from cache:series #:as s)
                          (where (= s.page ,here-page)))))
  (void
   (insert-one! cache-conn
                (make-cache:series
                 #:page (string->symbol here-page)
                 #:title (hash-ref (current-metas) 'title)
                 #:published (hash-ref (current-metas) 'published "")
                 #:noun-plural (hash-ref (current-metas) 'noun-plural "")
                 #:noun-singular (hash-ref (current-metas) 'noun-singular "")))))