Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -51,10 +51,11 @@ list/articles+notes listing<>-short/articles listing<>-full/articles listing<>-full/articles+notes unfence + sqltools:dbc preheat-series!) ;; ~~~ Private use ~~~ (define DBFILE (build-path (current-project-root) "vitreous.sqlite")) @@ -147,11 +148,11 @@ [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) + (crystalize-index-entries! pagenode doc) ; Note the original doc is used here ;; Values must come in the order defined in table_article_fields (define article-record (list (symbol->string pagenode) title-plain ADDED keyword-index.rkt Index: keyword-index.rkt ================================================================== --- keyword-index.rkt +++ keyword-index.rkt @@ -0,0 +1,117 @@ +#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{ + + + ◊html$-page-head{The Local Yarn: Keyword Index} + ◊html$-page-body-open[] + +