Index: blog.rkt ================================================================== --- blog.rkt +++ blog.rkt @@ -6,10 +6,11 @@ ;; 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) @@ -36,10 +37,11 @@ ◊html$-page-body-close[] }) ;; Grabs all the articles+notes from the cache and writes out all the blog page files (define (build-blog) + (listing-context 'blog) ; honor conceal directives for the blog (define arts-n-notes (slice-at (listing-htmls (articles+notes 'full #:series #f)) per-page)) (define pagecount (length arts-n-notes)) (for ([pagenum (in-range 1 (+ 1 pagecount))] [page (in-list arts-n-notes)]) Index: crystalize.rkt ================================================================== --- crystalize.rkt +++ crystalize.rkt @@ -68,10 +68,11 @@ [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" @@ -269,10 +270,11 @@ #: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 (html$-note-listing-full pagenode note-id title-html note-date @@ -341,10 +343,17 @@ (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 @@ -351,12 +360,14 @@ (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.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 @@ -364,18 +375,21 @@ (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.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.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 Index: dust.rkt ================================================================== --- dust.rkt +++ dust.rkt @@ -19,10 +19,11 @@ (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-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 make-tag-predicate @@ -64,10 +65,12 @@ (define-values (_ rel-path-parts) (drop-common-prefix (explode-path (current-project-root)) (explode-path (string->path (select-from-metas 'here-path (current-metas)))))) (->output-path (apply build-path rel-path-parts))] [else (string->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)) "")) Index: rss-feed.rkt ================================================================== --- rss-feed.rkt +++ rss-feed.rkt @@ -52,19 +52,19 @@ `title_plain` AS `title`, `published`, `updated`, `author`, `doc_html` AS `entry_contents` - FROM `articles` + FROM `articles` WHERE (NOT (`conceal` LIKE "%all%")) AND (NOT (`conceal` LIKE "%feed%")) UNION SELECT `page` || '#' || `html_anchor` AS `path`, `title_plain` AS `title`, `published`, "" AS `updated`, `author`, `content_html` as `entry_contents` - FROM `notes`) + FROM `notes` WHERE (NOT (`conceal` LIKE "%all%")) AND (NOT (`conceal` LIKE "%feed%"))) ORDER BY `published` DESC LIMIT ~a --- ) (query-rows cache-conn (format select feed-item-limit))) Index: util/newpost.rkt ================================================================== --- util/newpost.rkt +++ util/newpost.rkt @@ -33,11 +33,12 @@ #lang pollen ◊comment{Copyright ◊(substring date-string 0 4) by ◊|default-authorname|. All Rights Reserved.} ◊"◊"(define-meta published "◊date-string") - ◊"◊"(define-meta series "seriesname") + ◊"◊"(define-meta conceal "blog,feed") ; Edit/delete this line when ready to publish + ◊"◊;"(define-meta series "seriesname") ◊"◊"title{◊title} Write here!})