Index: cache.rkt ================================================================== --- cache.rkt +++ cache.rkt @@ -84,14 +84,14 @@ [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:index-entry)) +(define (init-cache-db! #:reset? [reset? #f]) + (for ([table (in-list '(cache:article cache:note cache:index-entry))]) + (when reset? (drop-table! (cache-conn) table)) + (create-table! (cache-conn) table))) (define (delete-article! page) (query-exec (cache-conn) (~> (from cache:article #:as a) (where (= a.page ,(format "~a" page))) Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -14,18 +14,44 @@ (except-in pollen/core select) ; avoid conflict with deta ) (require "dust.rkt" "cache.rkt" "snippets-html.rkt") -(provide parse-and-cache-article! +(provide main cache-index-entries-only!) (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 "")) + +;; Rebuild the SQLite cache with all article entities +(define (main) + (define pages (cdr (articles-pagetree))) + (define (getter-thunk) + (define parent (thread-receive)) + (define article (thread-receive)) + (thread-send parent (all-entities article (get-doc article)))) + + (for ([p (in-list pages)]) + (let ([t (thread getter-thunk)]) + (thread-send t (current-thread)) + (thread-send t p))) + + (define entities + (time + (for/vector ([i (in-range (length pages))]) + (thread-receive)))) + + (time (call-with-transaction + (cache-conn) + (lambda () + (init-cache-db! #:reset? #t) + (for ([x (in-vector entities)]) + (for ([e (in-list x)]) + (insert-one! (cache-conn) e))))))) (define (filter-special-tags tx) (match (get-tag tx) ['title (current-title tx) ""] ['excerpt (current-excerpt tx) ""] @@ -36,13 +62,20 @@ (current-disp-id note-id) (current-disposition (attr-ref tx 'disposition))]) (current-notes (cons (attr-set tx 'note-id note-id) (current-notes))) ""] [_ tx])) -;; Save an article and its notes (if any) to the database, and return -;; (values plain-title [rendered HTML of the complete article]) -(define (parse-and-cache-article! pagenode doc) +;; From an article, return a list of cache:article, cache:note and cache:index-entry entities +(define (all-entities pagenode doc) + ;; Reset parameters in case we’re doing multiple articles + (current-title #f) + (current-excerpt #f) + (current-notes '()) + (current-disposition "") + (current-disp-id "") + (current-metas (get-metas pagenode)) + (define body-txpr (decode doc #:txexpr-proc filter-special-tags)) (current-notes (reverse (current-notes))) (let* ([pubdate (select-from-metas 'published (current-metas))] [doc-html (->html body-txpr #:splice? #t)] [title-specified? (if (current-title) #t #f)] @@ -66,42 +99,32 @@ [listing-full (string-append header doc-html footer)] [listing-excerpt (match (current-excerpt) [#f listing-full] [(var e) (string-append header (html$-article-excerpt pagenode e) footer)])] [notes (extract-notes pagenode title-plain (current-notes))] - [notes-section-html (html$-notes-section (map cadr notes))]) - (thread - (lambda () - (call-with-transaction - (cache-conn) - (lambda () - (cache-index-entries! pagenode doc) ; note original doc is used here - (query-exec (cache-conn) - (delete (~> (from cache:note #:as n) - (where (= n.page ,(symbol->string pagenode)))))) - (apply insert! (cache-conn) (map car notes)) - (delete-article! pagenode) - (insert-one! (cache-conn) - (make-cache:article - #:page pagenode - #:title-plain title-plain - #: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 (current-series-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)))))) - (values title-plain (string-append header doc-html notes-section-html footer)))) + [index-entries (extract-index-entries pagenode doc)]) + (append + (cons (make-cache:article + #:page pagenode + #:title-plain title-plain + #: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 (current-series-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) + notes) + index-entries))) (define (check-for-poem-title doc-txpr) (match (car (get-elements doc-txpr)) [(txexpr 'div (list (list 'class "poem")) @@ -164,12 +187,11 @@ (define (extract-notes pagenode parent-title note-txprs) (for/list ([n (in-list note-txprs)]) (make-note n pagenode parent-title))) -;; Save an individual note to the DB and return the HTML of the complete note as -;; it should appear on an individual article page +;; Create cache:note entity (define (make-note note-tx pagenode parent-title-plain) (define-values (_ attrs elems) (txexpr->values note-tx)) (define disposition-attr (maybe-attr 'disposition attrs)) (define note-date (maybe-attr 'date attrs)) @@ -196,27 +218,25 @@ note-date note-srcline content-html author author-url)]) - (list - (make-cache:note - #:page pagenode - #: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 (current-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)))) + (make-cache:note + #:page pagenode + #: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 (current-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 ""))) (define (make-note-title pagenode parent-title-plain) `(note-title "Re: " (a [[class "cross-reference"] [href ,(format "~a~a" web-root pagenode)]] ,parent-title-plain))) @@ -256,30 +276,27 @@ #:entry main #:subentry sub #:page pagenode #:html-anchor "")]))) -;; Save any index entries in doc to the SQLite cache. +;; Build a list of cache:index-entry entities for all entries in the docs or current metas ;; Sub-entries are specified by "!" in the index key -(define (cache-index-entries! pagenode doc) +(define (extract-index-entries pagenode doc) (define-values (_ entry-txs) (splitf-txexpr doc index-entry-txpr?)) - (define all-entries - (append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode)) - (current-metas-keyword-entries pagenode))) - - (delete-index-entries! pagenode) - (save-cache-things! all-entries)) + (append (for/list ([etx (in-list entry-txs)]) (txexpr->index-entry etx pagenode)) + (current-metas-keyword-entries pagenode))) (define (cache-index-entries-only! title pagenode doc) (void (thread (lambda () (call-with-transaction (cache-conn) (lambda () - (cache-index-entries! pagenode doc) + (delete-index-entries! pagenode) (delete-article! pagenode) - (insert-one! (cache-conn) - (make-cache:article - #:title-plain title - #:conceal "blog,feed" - #:page pagenode)))))))) + (apply insert! (cache-conn) + (make-cache:article + #:title-plain title + #:conceal "blog,feed" + #:page pagenode) + (extract-index-entries pagenode doc)))))))) Index: dust.rkt ================================================================== --- dust.rkt +++ dust.rkt @@ -21,10 +21,11 @@ ;; 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 + set-meta! here-output-path here-source-path here-id listing-context current-series-noun ; Retrieve noun-singular from current 'series meta, or #f @@ -62,10 +63,15 @@ (define (maybe-meta m [missing ""]) (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)] [else missing])) +(define (set-meta! key v) + (define cur-metas (current-metas)) + (and cur-metas + (current-metas (hash-set! cur-metas key v)))) + ;; Return the current source path, relative to (current-project-root) (define (here-source-path) (match (current-metas) [(? hash? m) (define-values (_ rel-path-parts) Index: tags-html.rkt ================================================================== --- tags-html.rkt +++ tags-html.rkt @@ -110,13 +110,21 @@ #:block-txexpr-proc detect-newthoughts #:inline-txexpr-proc decode-link-urls #:exclude-tags '(script style pre code))) `(body ,@second-pass)) -(define (html-title . elements) `(title ,@elements)) -(define (html-excerpt . elements) `(excerpt ,@elements)) -(define (html-excerpt* . elements) `(excerpt* ,@elements)) +(define (html-title . elements) + (set-meta! 'title elements) + `(title ,@elements)) + +(define (html-excerpt . elements) + (set-meta! 'excerpt elements) + "") + +(define (html-excerpt* . elements) + (set-meta! 'excerpt elements) + `(@ ,@elements)) (define (html-blockcode attrs elems) (define file (or (assoc 'filename attrs) "")) (define codeblock `(pre [[class "code"]] (code ,@elems))) (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]