Local Yarn Code

Check-in [d7ebf012]
Overview
Comment:Support sub-entries in keyword index. Finishes [5daecde7]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: d7ebf0129f0161ee6f02d9c790d04ac84f925c25225f357e486760f9b9ebcf28
User & Date: joel on 2019-06-01 20:30:47
Other Links: manifest | tags
Context
2019-06-01
20:43
[713fa32699] Make footnote links unique sitewide check-in: 62024c96 user: joel tags: trunk
20:30
Support sub-entries in keyword index. Finishes [5daecde7] check-in: d7ebf012 user: joel tags: trunk
2019-05-27
21:50
Make ◊index tag syntax more concise check-in: cffdbbee user: joel tags: trunk
Changes

Modified crystalize.rkt from [9b9ee238] to [bd3a0100].

14
15
16
17
18
19
20

21
22
23
24
25
26
27
...
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
;; will be coming from me.

(require pollen/setup
         pollen/core
         pollen/template
         racket/string
         racket/function

         txexpr
         db/base
         "sqlite-tools.rkt"
         "snippets-html.rkt"
         "dust.rkt")

;; ~~~ Provides ~~~
................................................................................
  (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.







>







 







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













|
|
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
...
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
;; 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 ~~~
................................................................................
  (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) 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 "")))))

;; (private) 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.

Modified keyword-index.rkt from [f4c58968] to [433d5c8d].

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

;; Builds an HTML page containing the keyword index for all ◊index entries in
;; the articles, by pulling them out of the SQLite cache DB.

(require racket/match
         racket/list
         racket/file

         db/base
         net/uri-codec
         pollen/template)

(require "crystalize.rkt"

         "snippets-html.rkt")

(provide main)

















































































;; Get the index entries from the SQLite cache, return them as a list of vectors
(define (fetch-entries)
  (define q
    ◊string-append{
 SELECT entry, subentry, a.rowid, "/" || k.pagenode || "#" || anchor AS href, title_plain
 FROM keywordindex k INNER JOIN articles a
 ON a.pagenode = k.pagenode
 ORDER BY entry COLLATE NOCASE ASC;})
  (query-rows (sqltools:dbc) q))

;; Convert a vector (row) into a txexpr representing a link to the original article
(define (make-link row)
  `(a [[href ,(vector-ref row 3)]
       [title ,(vector-ref row 4)]]
      ,(number->string (vector-ref row 2))))

;(require sugar/debug)

;; Convert a list of vectors from the cache DB into a list of the form:
;; (list (cons FIRST-LETTER
;;             (list (cons KEYWORD
;;                         (list LINKS ...))
;;                   ...))
;;       ...)

(define (group-entries data)
  (define collated-list
    (for/fold ([entry-table null]
               #:result (reverse entry-table))
              ([row (in-list data)])
      (define this-entry (vector-ref row 0))
      (cond [(and (not (null? entry-table))
                  (string-ci=? (first (first entry-table)) this-entry))
             (match-define (cons (list last-entry last-list) rest-entries) entry-table)
             (cons `(,last-entry ,(append last-list (list (make-link row)))) rest-entries)]
            [else
             (cons `(,this-entry ,(list (make-link row)))
                   entry-table)])))
  (define (first-letter entry)
    (char-upcase (first (string->list (first entry)))))
  






  (for/list ([letter-group (in-list (group-by first-letter collated-list))])
    (list (first-letter (first letter-group)) letter-group)))


(define (entry+links->txexpr entry)
  (match-define (list entry-word links) entry)
  `(li [[id ,(uri-encode (string-downcase entry-word))]]
       ,entry-word nbsp




       ,@(add-between links ", ")))

;; Return the complete HTML for the keyword index. Each letter group begins with a heading for the
;; letter, followed by a definition list for its entries.
(define (html$-index entries)
  (define groups
    (for/list ([letter-group (in-list entries)])
      (match-define (list letter-char entries) letter-group)
      `(section (h2 ,(list->string (list letter-char)))
                (ul ,@(map entry+links->txexpr entries)))))
  (apply string-append (map ->html groups)))


(define (html$-keywordindex-page the-index)
  ◊string-append{
 <!DOCTYPE html>
 <html lang="en">
 ◊html$-page-head{The Local Yarn: Keyword Index}
 ◊html$-page-body-open[]








>





>




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



|


|


<
<
<
<
<
<
<
<

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


>
|
<
<
<
>
>
>
>
|



|

|


|


>







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

;; Builds an HTML page containing the keyword index for all ◊index entries in
;; the articles, by pulling them out of the SQLite cache DB.

(require racket/match
         racket/list
         racket/file
         racket/string
         db/base
         net/uri-codec
         pollen/template)

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

(provide main)

;; Terminology (because these things get confusing fast)
;;
;; Index HEADING:    A word or phrase that appears in the index
;; Index SUBHEADING: A Heading that appears under another Heading
;; Index LINK:       The connection between a particular Article and a Heading.
;;                   In the Index, represented by a URL+fragment back into the Article.
;;                   In the Article, represented by a URL+fragment to the Heading in the Index.
;; Index ENTRY:      A Heading, a unique ID, a list of Links, and a list of Subheading-entries
;; Index RECORD:     A simple vector representing a Link the way it is fetched from the SQLite
;;                   cache: #("heading" "subheading" NUMBER "/absolute-path.html#id_fragment" "Article Title")

(struct entry (heading      ; String
               id           ; String
               links        ; List
               subentries) #:transparent) ; List of entry structs

;; Get the first letter of an entry’s heading
(define (first-letter e)
  (char-upcase (first (string->list (entry-heading e)))))

;; Format the ID for back-linking to a particular entry on the keyword index page
(define (format-entry-id head subhead)
  (define maybe-sub
    (cond [(non-empty-string? subhead) (string-append "!" subhead)]
          [else ""]))
  (uri-encode (string-downcase (string-append head maybe-sub))))

;; Convert a Record into a txexpr representing a link to the original article
(define (make-link rec)
  (match-define (vector _ _ num link-url article-title) rec)
  `(a [[href ,link-url]
       [title ,article-title]]
      ,(number->string num)))

;; See if a Record belongs under an entry's heading or under an entry's subheading.
;; For subheadings, only checks the first one! This is because we rely on the records
;; being pre-alphabetized as they are fetched from the SQLite cache, and being
;; processed in order.
(define (test-match e record)
  (match-define (vector record-head record-subhead _ _ _) record)
  (define heading-match?
    (string-ci=? (entry-heading e) record-head))
  (define subheading-match?
    (and heading-match?
         (not (null? (entry-subentries e)))
         (non-empty-string? record-subhead)
         (string-ci=? (entry-heading (first (entry-subentries e))) record-subhead)))
  
  (cond [(and heading-match? subheading-match?)   'existing-subhead]
        [(and heading-match?
              (non-empty-string? record-subhead)) 'new-subhead]
        [heading-match?                           'heading]
        [else                                     'not-a-match]))

;; Add a record’s link to the front of an entry’s list of links
(define (add-entry-link e rec)
  (define existing-links (entry-links e))
  (struct-copy entry e [links (cons (make-link rec) existing-links)]))

;; Add a record’s link to the first subheading given in an entry.
(define (add-to-first-subentry e record)
  (match-define (entry _ _ _ (cons last-sub rest-subs)) e)
  (define updated-sub (add-entry-link last-sub record))
  (struct-copy entry e [subentries (cons updated-sub rest-subs)]))

;; Add a record's link to a new subheading in an entry
(define (add-new-subentry e record)
  (match-define (vector head subhead _ _ _) record)
  (define subhead-id (format-entry-id head subhead))
  (define new-sub (entry subhead subhead-id (list (make-link record)) '()))
  (struct-copy entry e [subentries (list new-sub)]))

;; Make a new entry from a record, placing its link in either the main entry
;; or in a new sub-entry.
(define (new-entry record)
  (match-define (vector head subhead _ _ _) record)
  (define e (entry head (format-entry-id head "") '() '()))
  (cond [(non-empty-string? subhead) (add-new-subentry e record)]
        [else (add-entry-link e record)]))

;; Get the index entries from the SQLite cache, return them as a list of vectors (Records!)
(define (fetch-entries)
  (define q
    ◊string-append{
 SELECT entry, subentry, a.rowid, "◊web-root" || k.pagenode || "#" || anchor AS href, title_plain
 FROM keywordindex k INNER JOIN articles a
 ON a.pagenode = k.pagenode
 ORDER BY entry COLLATE NOCASE ASC, subentry COLLATE NOCASE ASC;})
  (query-rows (sqltools:dbc) q))









;; Convert a list of vectors from the cache DB into a list of the form:
;; ((FIRST-LETTER (entries ...)) ...)




;; The method relies on the records being pre-sorted by the SQL query.
(define (group-entries records)
  (define collated
    (for/fold ([entries (list (new-entry (first records)))]
               #:result (reverse entries))
              ([row (in-list (rest records))])











      (match-define (cons last-entry rest-entries) entries)
      (case (test-match last-entry row)
        [(existing-subhead) (cons (add-to-first-subentry last-entry row) rest-entries)]
        [(new-subhead)      (cons (add-new-subentry last-entry row) rest-entries)]
        [(heading)          (cons (add-entry-link last-entry row) rest-entries)]
        [else               (cons (new-entry row) entries)])))
  (for/list ([letter-group (in-list (group-by first-letter collated))])
    (list (first-letter (first letter-group)) letter-group)))

;; Convert an entry into a list item, recursively adding subentries
(define (entry->txexpr e)



  (match-define (entry head id links subentries) e)
  (define sub-txs
    (cond [(null? subentries) ""]
          [else `(ul ,@(map entry->txexpr subentries))]))
  `(li [[id ,id]] ,head nbsp ,@(add-between links ", ") ,sub-txs))

;; Return the complete HTML for the keyword index. Each letter group begins with a heading for the
;; letter, followed by a definition list for its entries.
(define (html$-index grouped-entries)
  (define groups
    (for/list ([letter-group (in-list grouped-entries)])
      (match-define (list letter-char entries) letter-group)
      `(section (h2 ,(list->string (list letter-char)))
                (ul ,@(map entry->txexpr entries)))))
  (apply string-append (map ->html groups)))

;; Build the complete HTML page
(define (html$-keywordindex-page the-index)
  ◊string-append{
 <!DOCTYPE html>
 <html lang="en">
 ◊html$-page-head{The Local Yarn: Keyword Index}
 ◊html$-page-body-open[]

Modified web-extra/martin.css.pp from [6d089e00] to [dda0dce8].

648
649
650
651
652
653
654





655
656
657
658
659
660
661
    }

    #keywordindex ul {
        margin-top: 0;
        list-style-type: none;
        padding: 0;
    }






    /* End of mobile-first typography and layout */
}


/* Here’s where we start getting funky for any viewport wider than mobile portrait.
   An iPhone 6 is 667px wide in landscape mode, so that’s our breakpoint. */







>
>
>
>
>







648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
    }

    #keywordindex ul {
        margin-top: 0;
        list-style-type: none;
        padding: 0;
    }

    #keywordindex ul ul {
        margin-left: 0.5em;
        font-size: smaller;
    }

    /* End of mobile-first typography and layout */
}


/* Here’s where we start getting funky for any viewport wider than mobile portrait.
   An iPhone 6 is 667px wide in landscape mode, so that’s our breakpoint. */