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

#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
         pollen/setup
         racket/match
         (rename-in racket/list
                    (group-by group-list-by))
         "dust.rkt"
         (except-in pollen/core select))

(provide init-cache-db!
         cache-conn                     ; The most eligible bachelor in Neo Yokyo
         (schema-out cache:article)
         (schema-out cache:note)
         (schema-out cache:series)
         (schema-out cache:index-entry)
         (schema-out listing)
         delete-article!
         delete-notes!
         articles
         articles+notes
         listing-htmls
         fenced-listing
         unfence
         preheat-series!
         series-grouped-list)

;; Cache DB and Schemas

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

(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]
   [content-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"

   [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
  ([path        string/f]
   [title       string/f]
   [author      string/f]
   [published   string/f]
   [updated     string/f]
   [html        string/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 (fenced-listing q)
  `(style ,@(listing-htmls q)))

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

;;
;;  ~~~ Fetching series ~~~
;;
(define (series-grouped-list)
  (~> (for/list ([row (in-entities (cache-conn) 
                                   (order-by (from cache:series #:as s)
                                             ([s.noun-plural #:asc])))]) row)
      (group-list-by cache:series-noun-plural _ string-ci=?)))

;; Preloads the SQLite cache with info about each series.
;; I may not actually need this but I’m leaving it for now.
(define (preheat-series!)
  (query-exec (cache-conn)
              (~> (from cache:series #:as s)
                  (where 1)
                  delete))
  (define series-rows
    (for/list ([series-pagenode (in-list (cdr (series-pagetree)))])
      (define series-metas (get-metas series-pagenode))
      (make-cache:series
       #:page series-pagenode
       #:title (hash-ref series-metas 'title)
       #:published (hash-ref series-metas 'published "")
       #:noun-plural (hash-ref series-metas 'noun-plural "")
       #:noun-singular (hash-ref series-metas 'noun-singular ""))))
  (void (apply insert! (cache-conn) series-rows)))

Creates and initializes the SQLite database cache file (named @filepath{vitreous.sqlite} and located
in the project root folder) by running queries to create tables in the database if they do not
exist.

}

@defproc[(preheat-series!) void?]{

Save info about each series in @racket[series-folder] to the cache.

}

@section{Retrieving cached data}

Some of this looks a little wacky, but it’s a case of putting a little extra complextity into the
back end to make things simple on the front end. These functions are most commonly used inside the
@emph{body} of a Pollen document (i.e., series pages). 

@filebox["series/my-series.poly.pm"

The contents of the style tags are left intact.

Use this in templates with strings returned from @racket[->html] when called on docs that use the
@racket[fenced-listing] tag function.

}

@defproc[(series-grouped-list) (listof (listof cache:series?))]{

Return a list of lists of all @racket[cache:series] in the cache database. The series are grouped so
that series using the same value in the @tt{noun_plural} column appear together.

}

@section{Deleting records}

@deftogether[(@defproc[(delete-article! [page stringish?]) void?]
              @defproc[(delete-notes!   [page stringish?]) void?])]{
              
Delete a particular article, or all notes for a particular article, respectively.

                        [listing-full-html    string/f]
                        [listing-excerpt-html string/f]
                        [listing-short-html   string/f])
                       #:constructor-name make-cache:note]{

Table holding cached information on notes.

}

@defstruct*[cache:series ([id            id/f]
                          [page          symbol/f]
                          [title         string/f]
                          [published     string/f]
                          [noun-plural   string/f]
                          [noun-singular string/f])
                         #:constructor-name make-cache:series]{

Table holding cached information on series.

}

@defstruct*[cache:index-entry ([id id/f]
                               [entry       string/f]
                               [subentry    string/f]
                               [page        symbol/f]
                               [html-anchor string/f])

and saved to the SQLite cache and saved using @racket[make-cache:article]. If the article specifies
a @racket['series] meta, information about that series is fetched and used in the rendering of the
article. If there are @racket[note]s or @racket[index] tags in the doc, they are parsed and saved
individually to the SQLite cache (using @racket[make-cache:note] and
@racket[make-cache:index-entry]). If any of the notes use the @code{#:disposition} attribute,
information about the disposition is parsed out and used in the rendering of the article. 

}

@defproc[(cache-series!) void?]{

Attempts to look up certain values in @racket[current-metas] which we expect to be defined on
a typical series page, and saves them to the cache using @racket[make-cache:series]. If @tt{title}
is not defined in the current metas, you’ll get an error. If any of the others are missing, an empty
string is used.

}

#lang scribble/manual

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

@(require "scribble-helpers.rkt"
          scribble/example)

@(require (for-label "../pollen.rkt"
                     "../dust.rkt"
                     "../cache.rkt"

                     racket/base
                     racket/contract
                     txexpr
                     sugar/coerce
                     pollen/tag
                     pollen/setup
                     pollen/pagetree

(define doc 
  '(root (p "If I had been astonished at first catching a glimpse of so outlandish an "
            "individual as Queequeg circulating among the polite society of a civilized "
            "town, that astonishment soon departed upon taking my first daylight "
            "stroll through the streets of New Bedford…")))
(default-title (get-elements doc))]

@defproc[(metas-series-pagenode) pagenode?]

If @code{(current-metas)} has the key @racket['series], converts its value to the pagenode pointing to
that series, otherwise returns @racket['||].





@defproc[(series-metas-noun) string?]


If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta

value for @racket['noun-singular], then return it, otherwise return @racket[""].

@defproc[(series-metas-title) string?]

If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta

value for @racket['title], then return it, otherwise return @racket[""].

@defproc[(invalidate-series) (or/c void? boolean?)]

If the current article specifies a @racket['series] meta, and if a corresponding @filepath{.poly.pm}
file exists in @racket[series-folder], attempts to “touch” the last-modified timestamp on that file,
returning @racket[#t] on success or @racket[#f] on failure. If either precondition is not true,
returns @|void-const|.

cached metas of every article looking for matching articles.

@local-table-of-contents[]

@include-section["tour.scrbl"]
@include-section["design.scrbl"]
@include-section["pollen.scrbl"]  @; pollen.rkt

@include-section["dust.scrbl"]    @; dust.rkt
@include-section["snippets-html.scrbl"] @; you get the idea
@include-section["cache.scrbl"]
@include-section["crystalize.scrbl"]
@include-section["other-files.scrbl"]

         pollen/template
         pollen/decode
         (except-in pollen/core select) ; avoid conflict with deta
         )

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

(provide parse-and-cache-article!
         cache-series!)

(define current-title       (make-parameter #f))
(define current-excerpt     (make-parameter #f))
(define current-notes       (make-parameter '()))
(define current-disposition (make-parameter ""))
(define current-disp-id     (make-parameter ""))

                                          title-val
                                          body-txpr
                                          (current-disposition)
                                          (current-disp-id))]
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]
         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]
         [series-node (metas-series-pagenode)]
         [footertext  (make-article-footertext pagenode
                                               series-node
                                               (current-disposition)
                                               (current-disp-id)
                                               (length (current-notes)))]
         [footer (html$-article-close footertext)]
         [listing-short (html$-article-listing-short pagenode pubdate title-html)]

                  #:title-html-flow title-html
                  #:title-specified? title-specified?
                  #:published pubdate
                  #:updated (maybe-meta 'updated)
                  #:author (maybe-meta 'author default-authorname)
                  #:conceal (maybe-meta 'conceal)
                  #:series-page series-node
                  #:noun-singular (maybe-meta 'noun (series-metas-noun))
                  #:note-count (length (current-notes))
                  #:content-html doc-html
                  #:disposition (current-disposition)
                  #:disp-html-anchor (current-disp-id)
                  #:listing-full-html listing-full
                  #:listing-excerpt-html listing-excerpt
                  #:listing-short-html listing-short))

          [else ""]))
  ;; Returns a txexpr, the tag will be discarded by the template/snippets
  `(title ,@title-elems ,disposition-part))

;; Convert a bunch of information about an article into some nice English and links.
(define (make-article-footertext pagenode series disposition disp-note-id note-count)
  (define series-part
    (match (series-metas-title)
      [(? non-empty-string? s-title)
       (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
               (series-metas-noun)
               series
               s-title)]
      [_ ""]))
  (define disp-part
    (cond [(non-empty-string? disposition)
           (define-values (mark verb) (disposition-values disposition))
           (format "Now considered <a href=\"/~a#~a\">~a</a>."

                  #:html-anchor note-id
                  #: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)
                  #:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
                  #:content-html content-html
                  #:listing-full-html listing-full
                  #:listing-excerpt-html listing-full
                  #:listing-short-html ""))
    (html$-note-in-article note-id note-date content-html author author-url)))

  (query-exec (cache-conn) (delete (~> (from cache:index-entry #:as entry)
                                       (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))))))


;; 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)
                          (where (= s.page ,here-page)))))
  (void
   (insert-one! (cache-conn)
                (make-cache:series
                 #:page (string->symbol here-page)
                 #:title (hash-ref (current-metas) 'title)
                 #:published (hash-ref (current-metas) 'published "")
                 #:noun-plural (hash-ref (current-metas) 'noun-plural "")
                 #:noun-singular (hash-ref (current-metas) 'noun-singular "")))))

#lang racket/base

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

(require pollen/core

         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec

         file/sha1
         gregor
         txexpr
         racket/list
         racket/match
         racket/port
         racket/system
         racket/string)

;; Provides common helper functions used throughout the project

(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available
         here-output-path
         here-source-path
         here-id
         listing-context
         series-metas-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-metas-title   ; Retrieve title of series in current 'series meta, or ""
         metas-series-pagenode
         invalidate-series
         checked-in?
         make-tag-predicate
         tx-strs
         ymd->english
         ymd->dateformat
         default-authorname

(define (here-output-path)
  (->output-path (here-source-path)))

(define listing-context (make-parameter ""))

;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
(define (metas-series-pagenode)
  (define maybe-series (or (select-from-metas 'series (current-metas)) ""))
  (cond
    [(non-empty-string? maybe-series)
     (->pagenode (format "~a/~a.html" series-folder maybe-series))]

    [else '||]))

(define (series-metas-noun)
  (define series-pnode (metas-series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))


(define (series-metas-title)
  (define series-pnode (metas-series-pagenode)) 

  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))

(define article-ids (make-hash))

;; Generates a short ID for the current article
(define (here-id [suffix #f])
  (define maybe-hash (hash-ref article-ids (here-output-path) #f))
  (define here-hash

# 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 cache.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))

  (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-runtime-path cache.rkt         "cache.rkt")

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

               crystalize.rkt))))

;; Macro for defining tag functions that automatically branch based on the 
;; current output format and the list of poly-targets in the setup module.
;; Use this macro when you know you will need keyword arguments.
;;
(define-syntax (poly-branch-kwargs-tag stx)

<!DOCTYPE html>
<html lang="en">
◊cache-series![]
◊html$-page-head[(select-from-metas 'title metas)]

◊html$-page-body-open["series-page"]

◊(unfence (->html doc #:splice? #t))

◊html$-page-body-close[]

         pollen/decode
         pollen/private/version
         racket/string
         racket/function
         racket/list
         txexpr
         "cache.rkt"

         "dust.rkt")

(provide html$-page-head
         html$-page-body-open
         html$-series-list
         html$-article-open
         html$-article-close

    (if (eq? pagecount pagenum)
        "<li class=\"nav-text inactive-link\">Older&rarr;</li>"
        (page-func (+ pagenum 1) "Older&thinsp;&rarr;" "nav-text")))

  (string-join `(,prev-link ,@page-group ,next-link)))

(define (series->txpr s)
  `(li (a [[href ,(string-append web-root (symbol->string (cache:series-page s)))]]
          (i ,(cache:series-title s)))))

(define (html$-series-list)
  (define series-list-items
    (for/list ([group (in-list (series-grouped-list))])
      `(div (h2 ,(cache:series-noun-plural (first group))) (ul ,@(map series->txpr group)))))
  (->html `(section [[class "column-list"] [style "margin-top: 1.3rem"]] ,@series-list-items)))

#lang racket/base

(require racket/file
         pollen/setup
         "../cache.rkt"
         "../snippets-html.rkt")

(provide main)

(define (main)
  (init-cache-db!)
  (preheat-series!)
  
  (display-to-file (html$-page-footer)
                   (build-path (current-project-root) "scribbled" "site-footer.html")
                   #:exists 'replace))