◊(Local Yarn Code "Check-in [cb8af9fc]")

#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 the paginated “blog” HTML files (blog-pg1.html ...) from the SQLite cache
;; The files will be written out every time this module is evaluated! (see end)

(require "crystalize.rkt"
         "snippets-html.rkt"
         "dust.rkt"
         racket/file
         sugar/list)

(provide main)

#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]
   [conceal              string/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))

(define (delete-article! page)
  (query-exec cache-conn
              (~> (from cache:article #:as a)
                  (where (= a.page ,(format "~a" page)))
                  delete)))

(define (delete-notes! page)
  (query-exec cache-conn
              (~> (from cache:note #:as n)
                  (where (= n.page ,(format "~a" page)))
                  delete)))


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

                                     (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]))

;; (Private use) Convenience for the WHERE `conceal` NOT LIKE clause
(define (where-not-concealed q)
  (define base-clause (where q (not (like a.conceal "%all%"))))
  (match (listing-context)
    ["" base-clause]
    [(var context) (where base-clause (not (like a.conceal ,(format "%~a%" context))))]))

;; 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
              a.conceal)
      (where-series s)
      (where-not-concealed)
      (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
                         A.conceal)
                 (union
                  (~> (from cache:note #:as N)
                      (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
                              N.published
                              N.series-page
                              N.conceal)))))
            #:as a)
      (where-series s)
      (where-not-concealed)
      (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)

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

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

SHELL = /bin/bash

# ~~~ Variables used by rules ~~~
#

core-files := pollen.rkt dust.rkt
html-deps  := snippets-html.rkt tags-html.rkt crystalize.rkt

article-sources := $(wildcard articles/*.poly.pm)
articles-html   := $(patsubst %.poly.pm, %.html, $(article-sources))
articles-pdf    := $(patsubst %.poly.pm, %.pdf,  $(article-sources))

series-sources  := $(wildcard series/*.poly.pm)
series-html     := $(patsubst %.poly.pm, %.html, $(series-sources))

                     racket/syntax
                     syntax/parse
                     pollen/setup))

(require pollen/tag
         pollen/setup
         racket/function

         "tags-html.rkt"
         "snippets-html.rkt"
         "crystalize.rkt")

(provide (all-defined-out)
         (all-from-out "crystalize.rkt" "snippets-html.rkt"))

(module setup racket/base
  (require syntax/modresolve
           racket/runtime-path
           pollen/setup)
  (provide (all-defined-out))
  (define poly-targets '(html))
  (define block-tags (append '(title style dt note) default-block-tags))

  (define-runtime-path tags-html.rkt     "tags-html.rkt")
  (define-runtime-path snippets-html.rkt "snippets-html.rkt")
  (define-runtime-path dust.rkt          "dust.rkt")
  (define-runtime-path crystalize.rkt    "crystalize.rkt")

  (define cache-watchlist
    (map resolve-module-path
         (list tags-html.rkt
               snippets-html.rkt
               dust.rkt

               crystalize.rkt))))

(case (current-poly-target)
  [(html) (init-cache-db!)])

;; Macro for defining tag functions that automatically branch based on the 
;; current output format and the list of poly-targets in the setup module.

(require txexpr
         racket/match
         racket/file
         racket/date
         racket/string
         db/base
         "dust.rkt"
         "crystalize.rkt")

(provide main)

(define feed-author default-authorname)
(define feed-author-email "[email protected]")
(define feed-title "The Local Yarn (Beta)")
(define feed-site-url "https://thelocalyarn.com")