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

;; data; a maliciously crafted input could bomb the database. This is acceptable
;; since the database is merely a disposable cache, and since all the input
;; will be coming from me.

(require pollen/setup
         pollen/core
         pollen/template
         pollen/pagetree
         racket/string
         txexpr
         "sqlite-tools.rkt"
         "template-html.rkt"
         "dust.rkt")

;; ~~~ Provides ~~~

(provide spell-of-summoning!
         crystalize-article!)
         crystalize-article!
         article-plain-title)

;; ~~~ Private use ~~~

(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))

;; Since the DB exists to serve as a high-speed cache, the tables are constructed so that
;; the most commonly needed data can be grabbed quickly with extremely simple queries. In
;; the even that you want to do something fancy and custom rather than using the pre-cooked
;; HTML, enough info is provided in the other columns to allow you to do so.
;;
(define table_articles-fields
  '(pagenode
    title_plain
    title_html_flow
    title_specified
    published
    updated
    author
    conceal
    series_pagenode
    noun_singular 
    note_count

(define (crystalize-article! pagenode doc)
  (define pubdate (select-from-metas 'published (current-metas)))
  (define-values (body-txpr note-txprs) (doc->body/notes doc))
  (define doc-html (->html (cdr body-txpr)))
  
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))
  (define title-specified? (non-empty-string? (maybe-meta 'title)))
  (define-values (title-plain title-html-flow)
    (make-article-titles (maybe-meta 'title (default-title pubdate)) disposition))
    (title-plain+html-values body-txpr disposition))
  (define series-node (maybe-meta 'series))
  (define header (html$-article-open title-html-flow pubdate))
  (define header (html$-article-open title-specified? title-html-flow pubdate))

  (define footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs)))
  (define footer (html$-article-close footertext))
  
  (define notes-section-html (crystalize-notes! pagenode title-plain note-txprs))

  ;; Values must come in the order defined in table_article_fields
  (define article-record
    (list (symbol->string pagenode)
          title-plain
          title-html-flow
          (bool->int title-specified?)
          pubdate
          (maybe-meta 'updated)
          (maybe-meta 'author default-authorname)
          (maybe-meta 'conceal)
          series-node
          (maybe-meta 'noun (series-noun))
          (length note-txprs)

  (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
          
  ◊string-append{◊header ◊doc-html ◊notes-section-html ◊footer})

;; ~~~ Article-related helper functions ~~~
;;

;; Given a disposition and title, return both a plain-text and HTML version of the title
(define (make-article-titles title-val disposition)
;; Return both a plain-text and HTML version of a title for the current article,
;; supplying a default if no title was specified in the metas.
(define (title-plain+html-values body-tx disposition)
  (define title (maybe-meta 'title ""))
  (define title-val
    (cond [(and (string? title) (string=? title ""))
           (format "“~a…”" (first-words (tx-strs body-tx) 5))]
          [else title]))
  
  (define disposition-part
    (cond [(non-empty-string? disposition)
           (define-values (mark _) (disposition-values disposition))
           (format "<span class=\"disposition-mark\">~a</span>" mark)]
          [else ""]))
  
  (cond [(txexpr? title-val)

                           " AND `note_id` = ?2), ~a)")
            (list->sql-fields table_notes-fields)
            (list->sql-parameters table_notes-fields)))
  (apply query! save-note-query note-record)
  
  ;; return html$ of note
  (html$-note-in-article note-id note-date content-html author author-url))

(define (article-plain-title pagenode)
  (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))

         attr-present?  ; Test if an attribute is present
         disposition-values
         ymd->english
         ymd->dateformat
         default-authorname
         default-title
         tx-strs
         first-words
         build-note-id
         notes->last-disposition-values
         )

(define default-authorname "Joel Dueck")

(define (default-title date)

(define (tx-strs xpr)
  (cond
    [(txexpr? xpr) (apply string-append (map tx-strs (get-elements xpr)))]
    [(string? xpr) xpr]
    [else ""]))

(define (first-words str n)
  (define trunc
    (apply string-append
         (add-between (take (string-split str) n) " ")))
  ;; Remove trailing punctuation (commas, etc.)
  (regexp-replace #px"\\W+$" trunc ""))

(module+ test
  (require rackunit)
  (define test-metas (hash 'name "Fiver" 'size "Small"))
  (define test-attrs '([name "Hazel"] [rank "Chief"]))

  (parameterize ([current-metas test-metas])
    (check-equal? (maybe-meta 'name) "Fiver") ; present meta

         racket/function
         racket/contract
         sugar/coerce)

(module+ test
  (require rackunit))

(provide (all-from-out db/base db/sqlite3))
(provide sqltools:dbc
         sqltools:log-queries?)

(provide
 (contract-out
  ;; Utility functions
  [log-query                 (string? . -> . void?)]

         html$-note-title
         html$-note-contents
         html$-note-listing-full
         html$-note-in-article
         html$-notes-section)

(define (html$-page-head [title #f])
  (define title-part (if title (format ": ~a" title) ""))
  ◊string-append{<head>
 <title>◊|title|</title>
 <title>◊if[title title ""] </title>
 <meta charset="utf-8" />
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="stylesheet" type="text/css" href="/web-extra/martin.css">
 </head>})

(define (html$-page-body-open)
  ◊string-append{<body><main>
 <a href="/"><header>
 <img src="/web-extra/logo.png" height="103" width="129" class="logo">
 <h1>The Local Yarn</h1>
 </header></a>})

(define (html$-article-open title-html-flow published)
(define (html$-article-open title? title-html-flow published)
  (define published (select-from-metas 'published (current-metas)))
  (cond
    [title-html-flow
    [title?
     ◊string-append{<article class="with-title hentry">
      <h1 class="entry-title">◊|title-html-flow|</h1>
      <p class="time"><a href="#" class="rel-bookmark">
      <time datetime="◊published" class="published">◊ymd->english[published]</time>
      </a></p>
      <section class="entry-content">}]
    [else

<!DOCTYPE html>
<html>
◊spell-of-summoning![]

◊(define article-html (crystalize-article! here doc))
◊(define page-title (article-plain-title here))
◊html$-page-head[(select-from-metas 'title here)]
◊html$-page-head[page-title]

◊html$-page-body-open[]

◊spell-of-summoning![]
◊crystalize-article![here doc]
◊article-html

◊html$-page-body-close[]

</html>