Local Yarn Code

Check-in [d7659912]
Overview
Comment:Add ◊index tag, save index entries to cache db. Addresses [5daecde7]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: d76599127fa594324b515877c3fed2581664e287e1e98481dce530628198ccf3
User & Date: joel on 2019-05-05 12:46:23
Other Links: manifest | tags
Context
2019-05-05
14:38
Add styles for keyword index links check-in: 1947b407 user: joel tags: trunk
12:46
Add ◊index tag, save index entries to cache db. Addresses [5daecde7] check-in: d7659912 user: joel tags: trunk
2019-04-30
19:20
Rename listing functions check-in: 552ad2a9 user: joel tags: trunk
Changes

Modified code-docs/dust.scrbl from [63fa6d30] to [f9a0825d].

54
55
56
57
58
59
60












61
62
63
64
65
66
67
@tt{.html} targets of the source documents.

@defproc[(here-output-path) path?]

Returns the path to the current output file, relative to @racket[current-project-root]. If no metas
are available, raises an error. This is like what you can get from the @tt{here} variable that Pollen
provides, except it is available outside templates.













@section{Metas and @code{txexpr}s}

@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]

Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.







>
>
>
>
>
>
>
>
>
>
>
>







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
@tt{.html} targets of the source documents.

@defproc[(here-output-path) path?]

Returns the path to the current output file, relative to @racket[current-project-root]. If no metas
are available, raises an error. This is like what you can get from the @tt{here} variable that Pollen
provides, except it is available outside templates.

@defproc[(here-id [suffix (or/c (listof string?) string? #f) #f]) string?]

Returns the 8-character prefix of the SHA1 hash of the current document’s output path. If no metas
are available, raises an error. If @racket[_suffix] evaluates to a string or a list of strings, they
are appended verbatim to the end of the hash.

This ID is used when creating URL fragment links within an article, such as for footnotes and index
entries. As long as the web version of the article is not moved to a new URL, the ID will remain the
same, which ensures deep links using the ID don’t break. The ID also ensures each article’s internal
links will be unique, so that links do not collide when multiple articles are being shown on
a single HTML page.

@section{Metas and @code{txexpr}s}

@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]

Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.

Modified code-docs/pollen.scrbl from [8e12d00a] to [a48aad25].

178
179
180
181
182
183
184



















185
186
187
188
189
190
191
  #lang pollen

  ◊dialogue{
    ◊say["Tavi"]{You also write fiction, or you used to. Do you still?}
    ◊say["Lorde"]{The thing is, when I write now, it comes out as songs.}
  }
}|




















@defproc[(note [#:date date-str non-empty-string?]
               [#:author author string? ""]
               [#:author-url author-url string? ""]
               [#:disposition disp-str string? ""]) txexpr?]

Add a note to the “Further Notes” section of the article. Notes are like blog comments but are







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
  #lang pollen

  ◊dialogue{
    ◊say["Tavi"]{You also write fiction, or you used to. Do you still?}
    ◊say["Lorde"]{The thing is, when I write now, it comes out as songs.}
  }
}|

@defproc[(index [heading string?] [elements xexpr?] ...) txexpr?]

Creates an entry in the keyword index under @racket[_heading] that points back to this spot in the
document. If @racket[_elements] is not empty, the web edition of the document will use it as the
contents of an understated hyperlink to back to @racket[_heading] in the keyword index.

The example below will create two index entries, one under the heading “compassion” and one under
the heading “cats”:

@codeblock|{
  #lang pollen

  “I have a theory which I suspect is rather immoral,” Smiley 
  went on, more lightly. “Each of us has only a quantum of 
  ◊index["compassion"]{compassion}. That if we lavish our concern
  on every stray ◊index["cats"] cat we never get to the centre of 
  things. What do you think of it?” 
}|

@defproc[(note [#:date date-str non-empty-string?]
               [#:author author string? ""]
               [#:author-url author-url string? ""]
               [#:disposition disp-str string? ""]) txexpr?]

Add a note to the “Further Notes” section of the article. Notes are like blog comments but are

Modified crystalize.rkt from [0c40f48a] to [17c941d5].

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
...
135
136
137
138
139
140
141


142
143
144
145
146
147
148
...
334
335
336
337
338
339
340






















341
342
343
344
345
346
347

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







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




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

;; 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)))
................................................................................
         [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)])



    ;; 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?)
................................................................................
  
  ;; return html$ of note
  (html$-note-in-article note-id note-date content-html author author-url))

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























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







>
>
>
>
>
>




>
>
>







|







 







>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
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

(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)))
................................................................................
         [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 body-txpr)

    ;; 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?)
................................................................................
  
  ;; return html$ of note
  (html$-note-in-article note-id note-date content-html author author-url))

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

;; ~~~ Keyword Index Entries ~~~

;; (private) Save any index entries in doc to the cache
(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)])
        (list (attr-ref entry-tx 'data-index-entry)
              "" ; subentries not yet implemented
              (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

Modified dust.rkt from [62b90e17] to [c44ac1c4].

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
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
..
96
97
98
99
100
101
102








103
104
105
106
107
108
109
;; -------------------------------------------------------------------------

(require pollen/core
         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec

         gregor
         txexpr
         racket/list
         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

         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         invalidate-series
         make-tag-predicate
         tx-strs
         ymd->english
................................................................................

(define default-authorname "Joel Dueck")
(define series-folder "series")
(define articles-folder "articles")

(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 output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
................................................................................
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))

(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))









;; “Touches” the last-modified date on the current article’s series, if there is one

(define (invalidate-series)
  (define series-name (maybe-meta 'series #f))
  (when series-name
    (define series-file (build-path (current-project-root)







>











>







 







<







 







>
>
>
>
>
>
>
>







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
..
61
62
63
64
65
66
67

68
69
70
71
72
73
74
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
;; -------------------------------------------------------------------------

(require pollen/core
         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec
         file/sha1
         gregor
         txexpr
         racket/list
         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-id
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         invalidate-series
         make-tag-predicate
         tx-strs
         ymd->english
................................................................................

(define default-authorname "Joel Dueck")
(define series-folder "series")
(define articles-folder "articles")

(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 output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
................................................................................
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))

(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))

;; Generates a short ID for the current article
(define (here-id [suffix #f])
  (define here-hash
    (substring (bytes->hex-string (sha1-bytes (path->bytes (here-output-path)))) 0 8))
  (cond [(list? suffix) (apply string-append here-hash suffix)]
        [(string? suffix) (string-append here-hash suffix)]
        [else here-hash]))

;; “Touches” the last-modified date on the current article’s series, if there is one

(define (invalidate-series)
  (define series-name (maybe-meta 'series #f))
  (when series-name
    (define series-file (build-path (current-project-root)

Modified pollen.rkt from [4eb79d88] to [76ee6f63].

110
111
112
113
114
115
116

117
118
119
120
121
122
123
(poly-branch-tag smallcaps)
(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)

(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)







>







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(poly-branch-tag smallcaps)
(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)
(poly-branch-tag index)
(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)

Modified tags-html.rkt from [a9c3097d] to [5a9bf33f].

24
25
26
27
28
29
30

31
32
33
34
35
36
37
..
72
73
74
75
76
77
78

79
80
81
82
83
84
85
...
111
112
113
114
115
116
117






118
119
120
121
122
123
124
;; Tag functions used by pollen.rkt when HTML is the output format.

(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag

         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)

;; Customized paragraph decoder replaces single newlines within paragraphs
................................................................................
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode

         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
................................................................................
  `(body ,@second-pass))

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







(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))

(define (html-verse attrs elems)
  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]







>







 







>







 







>
>
>
>
>
>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
;; Tag functions used by pollen.rkt when HTML is the output format.

(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag
         net/uri-codec
         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)

;; Customized paragraph decoder replaces single newlines within paragraphs
................................................................................
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-index
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
................................................................................
  `(body ,@second-pass))

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

(define (html-index . elems)
  `(a [[id ,(here-id (list "_idx-" (uri-encode (car elems))))]
       [data-index-entry ,(car elems)]
       [class "index-link"]]
      ,@(cdr elems)))

(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))

(define (html-verse attrs elems)
  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]