◊(Local Yarn Code "Diff")

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