◊(Local Yarn Code "keyword-index.rkt at [b6a4e42a]")

File keyword-index.rkt artifact f4c58968 part of check-in b6a4e42a


#lang pollen/mode racket/base

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

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

 <div id="keywordindex">
 ◊the-index
 </div>
 ◊html$-page-body-close[]
 </html>})

(define (main)
  (spell-of-summoning!) ; Turn on DB
  (displayln "Writing keyword-index.html…")
  (display-to-file (html$-keywordindex-page (html$-index (group-entries (fetch-entries))))
                   "keyword-index.html"
                   #:mode 'text
                   #:exists 'replace))