◊(Local Yarn Code "Diff")

#lang racket/base

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

(require deta db/base db/sqlite3 threading txexpr gregor)



(require racket/match
         racket/string
         pollen/pagetree
         pollen/template
         (except-in pollen/core select) ; avoid conflict with deta
         pollen/setup)


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

(provide init-cache-db!
         cache-conn            ; The most eligible bachelor in Neo Yokyo
         parse-and-cache-article!
         cache-series!
         current-plain-title
         (schema-out cache:article)
         (schema-out cache:note)
         (schema-out cache:series)
         (schema-out cache:index-entry)
         articles
         articles+notes
         listing-htmls
         <listing-full>
         <listing-excerpt>
         <listing-short>
         unfence)

;; Cache DB and Schemas

(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))
(define cache-conn (sqlite3-connect #:database DBFILE #:mode 'create))

(define current-plain-title (make-parameter "void"))

(define-schema cache:article #:table "articles"
  ([id                   id/f #:primary-key #:auto-increment]
   [page                 symbol/f]
   [title-plain          string/f]
   [title-html-flow      string/f]
   [title-specified?     boolean/f]
   [published            string/f]
   [updated              string/f]
   [author               string/f]
   [conceal              string/f]
   [series-page          symbol/f]
   [noun-singular        string/f]
   [note-count           integer/f]
   [doc-html             string/f]
   [disposition          string/f]
   [disp-html-anchor     string/f]
   [listing-full-html    string/f]   ; full content but without notes
   [listing-excerpt-html string/f]   ; Not used for now
   [listing-short-html   string/f])) ; Date and title only

(define-schema cache:note #:table "notes"
  ([id                   id/f #:primary-key #:auto-increment]
   [page                 symbol/f]
   [html-anchor          string/f]
   [title-html-flow      string/f] ; No block-level HTML elements
   [title-plain          string/f]
   [author               string/f]
   [author-url           string/f]
   [published            string/f]
   [disposition          string/f]
   [content-html         string/f]
   [series-page          symbol/f]
   [listing-full-html    string/f]
   [listing-excerpt-html string/f]   ; Not used for now
   [listing-short-html   string/f])) ; Date and title only

(define-schema cache:series #:table "series"
  ([id            id/f #:primary-key #:auto-increment]
   [page          symbol/f]
   [title         string/f]
   [published     string/f]
   [noun-plural   string/f]
   [noun-singular string/f]))

(define-schema cache:index-entry #:table "index_entries"
  ([id          id/f #:primary-key #:auto-increment]
   [entry       string/f]
   [subentry    string/f]
   [page        symbol/f]
   [html-anchor string/f]))

(define-schema listing
  #:virtual
  ([html        string/f]
   [published   date/f]
   [series-page symbol/f]))

(define (init-cache-db!)
  (create-table! cache-conn 'cache:article)
  (create-table! cache-conn 'cache:note)
  (create-table! cache-conn 'cache:series)
  (create-table! cache-conn 'cache:index-entry))

;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
(define (parse-and-cache-article! pagenode doc)
  (define-values (doc-no-title maybe-title)
    (splitf-txexpr doc (make-tag-predicate 'title)))
  (define-values (body-txpr note-txprs)
    (splitf-txexpr doc-no-title (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))

                                               disp-note-id
                                               (length note-txprs))]
         [footer (html$-article-close footertext)]
         [listing-short (html$-article-listing-short pagenode pubdate title-html)]
         [notes-section-html (cache-notes! pagenode title-plain note-txprs)])
    (cache-index-entries! pagenode doc) ; note original doc is used here
    (current-plain-title title-plain)

    (insert-one! cache-conn
                 (make-cache:article
                  #:page pagenode
                  #:title-plain title-plain
                  #:title-html-flow title-html
                  #:title-specified? title-specified?
                  #:published pubdate

                  #:title-html-flow title-html
                  #:title-plain (tx-strs title-tx)
                  #:published note-date
                  #:author author
                  #:author-url author-url
                  #:disposition disposition-attr
                  #:series-page (metas-series-pagenode)

                  #:content-html content-html
                  #:listing-full-html (html$-note-listing-full pagenode
                                                               note-id
                                                               title-html
                                                               note-date
                                                               content-html
                                                               author

                                     (where (= entry.page ,(symbol->string pagenode))))))
  (unless (null? entry-txs)
    (void
     (apply insert! cache-conn
            (for/list ([etx (in-list entry-txs)])
              (txexpr->index-entry etx pagenode))))))

;;
;;  ~~~ Fetching articles and notes ~~~
;;

;; (Private use) Conveniece function for the WHERE `series-page` clause
(define (where-series q s)
  (define (s->p x) (format "~a/~a.html" series-folder x))
  (match s
    [(list series ...)
     (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...)
    [(or (? string? series) (? symbol? series))
     (where q (= a.series-page ,(s->p series)))]      ; WHERE series-page = "item"
    [#t
     (where q (= a.series-page ,(path->string (here-output-path))))]
    [_ q]))

;; Needed to "parameterize" column names
;; see https://github.com/Bogdanp/deta/issues/14#issuecomment-573344928
(require (prefix-in ast: deta/private/ast))

;; Builds a query to fetch articles
(define (articles type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (define html-field (format "listing_~a_html" type))
  (~> (from cache:article #:as a)
      (select (fragment (ast:as (ast:qualified "a" html-field) "html"))
              a.published
              a.series-page)
      (where-series s)
      (limit ,lim)
      (order-by ([a.published ,ord]))
      (project-onto listing-schema)))

;; Builds a query that returns articles and notes intermingled chronologically
(define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (define html-field (format "listing_~a_html" type))
  (~> (from (subquery
             (~> (from cache:article #:as A)
                 (select (fragment (ast:as (ast:qualified "A" html-field) "html"))
                         A.published
                         A.series-page)
                 (union
                  (~> (from cache:note #:as N)
                      (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
                              N.published
                              N.series-page)))))
            #:as a)
      (where-series s)
      (limit ,lim)
      (order-by ([a.published ,ord]))
      (project-onto listing-schema)))

;; Get all the a list of the HTML all the results in a query
(define (listing-htmls list-query)
  (for/list ([l (in-entities cache-conn list-query)])
    (listing-html l)))

;; Return cached HTML of articles and/or notes, fenced within a style txexpr to prevent it being
;; escaped by ->html. See also: definition of `unfence`

;; E.g.: (<listing-full> articles+notes)
(define (<listing-full> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style ,@(listing-htmls (query-func 'full #:series s #:limit lim #:order ord))))
;;                                     ^^^^^

(define (<listing-excerpt> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style ,@(listing-htmls (query-func 'excerpt #:series s #:limit lim #:order ord))))
;;                                     ^^^^^^^^

(define (<listing-short> query-func #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  `(style "<ul class=\"article-list\">"
          ,@(listing-htmls (query-func 'short #:series s #:limit lim #:order ord))
          "</ul>")) ;;                 ^^^^^^

;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from
;; listing functions
(define (unfence html-str)
  (regexp-replace* #px"<[\\/]{0,1}style>" html-str ""))

;; Save the current article to the `series` table of the SQLite cache
;; Should be called from a template for series pages
(define (cache-series!)
  (define here-page (path->string (here-output-path)))
  (query-exec cache-conn
              (delete (~> (from cache:series #:as s)