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
|
#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
racket/match
racket/string
txexpr
pollen/template
(except-in pollen/core select) ; avoid conflict with deta
)
(require "dust.rkt" "cache.rkt" "snippets-html.rkt")
(provide parse-and-cache-article!
cache-series!)
;; 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))
|
<
|
|
|
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
|
#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
threading
racket/match
racket/string
txexpr
pollen/template
(except-in pollen/core select) ; avoid conflict with deta
)
(require "dust.rkt" "cache.rkt" "snippets-html.rkt")
(provide parse-and-cache-article!
cache-series!)
;; 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-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))
|
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
|
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)
(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 (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"))
|
<
|
|
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
|
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
(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 (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))
(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"))
|