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

File keyword-index.rkt artifact 9aa8d227 part of check-in cf26929b


#lang pollen/mode racket/base

;; Copyright (c) 2019 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
;; You may also obtain a copy of the License at
;;
;;       http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; Author contact information:
;;   joel@jdueck.net
;;   https://joeldueck.com
;; -------------------------------------------------------------------------

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