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

Overview
Comment:Add support for concealing articles/notes in different listing contexts (finishes [1f6233035e7d8cc8])
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 8bd52721dd066a310a30894b5e5f4b46e9a2bcbc12be6bb5923dafafa501fecf
User & Date: joel on 2020-01-26 23:31:56
Original Comment: Add support for concealing articles/notes in different listing contexts (finishes 1f6233035e7d8cc8)
Other Links: manifest | tags
Context
2020-02-01
22:54
Remove filter property on home page image, closes [0d5932bd9996832b] check-in: 1129e752 user: joel tags: trunk
2020-01-26
23:31
Add support for concealing articles/notes in different listing contexts (finishes [1f6233035e7d8cc8]) check-in: 8bd52721 user: joel tags: trunk
2020-01-22
04:41
Enable/improve browser print media styles in CSS check-in: ffd04247 user: joel tags: trunk
Changes

Modified blog.rkt from [1dda01dc] to [abf461d1].

     4      4   ; This file is licensed under the Blue Oak Model License 1.0.0.
     5      5   
     6      6   ;; Builds the paginated “blog” HTML files (blog-pg1.html ...) from the SQLite cache
     7      7   ;; The files will be written out every time this module is evaluated! (see end)
     8      8   
     9      9   (require "crystalize.rkt"
    10     10            "snippets-html.rkt"
           11  +         "dust.rkt"
    11     12            racket/file
    12     13            sugar/list)
    13     14   
    14     15   (provide main)
    15     16   
    16     17   ;; How many items per blog page
    17     18   (define per-page 5)
................................................................................
    34     35    <nav id="bottom-nav"><ul>◊|page-nav|</ul></nav>
    35     36   
    36     37    ◊html$-page-body-close[]
    37     38    </html>})
    38     39   
    39     40   ;; Grabs all the articles+notes from the cache and writes out all the blog page files
    40     41   (define (build-blog)
           42  +  (listing-context 'blog) ; honor conceal directives for the blog
    41     43     (define arts-n-notes (slice-at (listing-htmls (articles+notes 'full #:series #f)) per-page))
    42     44     (define pagecount (length arts-n-notes))
    43     45     
    44     46     (for ([pagenum (in-range 1 (+ 1 pagecount))]
    45     47           [page    (in-list arts-n-notes)])
    46     48       (define filename (format "blog-pg~a.html" pagenum))
    47     49       (displayln (format "Writing: ~a" filename))

Modified crystalize.rkt from [08bca5d2] to [f45f7570].

    66     66      [title-plain          string/f]
    67     67      [author               string/f]
    68     68      [author-url           string/f]
    69     69      [published            string/f]
    70     70      [disposition          string/f]
    71     71      [content-html         string/f]
    72     72      [series-page          symbol/f]
           73  +   [conceal              string/f]
    73     74      [listing-full-html    string/f]
    74     75      [listing-excerpt-html string/f]   ; Not used for now
    75     76      [listing-short-html   string/f])) ; Date and title only
    76     77   
    77     78   (define-schema cache:series #:table "series"
    78     79     ([id            id/f #:primary-key #:auto-increment]
    79     80      [page          symbol/f]
................................................................................
   267    268                     #:title-html-flow title-html
   268    269                     #:title-plain (tx-strs title-tx)
   269    270                     #:published note-date
   270    271                     #:author author
   271    272                     #:author-url author-url
   272    273                     #:disposition disposition-attr
   273    274                     #:series-page (metas-series-pagenode)
          275  +                  #:conceal (or (maybe-attr 'conceal attrs #f) (maybe-meta 'conceal))
   274    276                     #:content-html content-html
   275    277                     #:listing-full-html (html$-note-listing-full pagenode
   276    278                                                                  note-id
   277    279                                                                  title-html
   278    280                                                                  note-date
   279    281                                                                  content-html
   280    282                                                                  author
................................................................................
   339    341        (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...)
   340    342       [(or (? string? series) (? symbol? series))
   341    343        (where q (= a.series-page ,(s->p series)))]      ; WHERE series-page = "item"
   342    344       [#t
   343    345        (where q (= a.series-page ,(path->string (here-output-path))))]
   344    346       [_ q]))
   345    347   
          348  +;; (Private use) Convenience for the WHERE `conceal` NOT LIKE clause
          349  +(define (where-not-concealed q)
          350  +  (define base-clause (where q (not (like a.conceal "%all%"))))
          351  +  (match (listing-context)
          352  +    ["" base-clause]
          353  +    [(var context) (where base-clause (not (like a.conceal ,(format "%~a%" context))))]))
          354  +
   346    355   ;; Needed to "parameterize" column names
   347    356   ;; see https://github.com/Bogdanp/deta/issues/14#issuecomment-573344928
   348    357   (require (prefix-in ast: deta/private/ast))
   349    358   
   350    359   ;; Builds a query to fetch articles
   351    360   (define (articles type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
   352    361     (define html-field (format "listing_~a_html" type))
   353    362     (~> (from cache:article #:as a)
   354    363         (select (fragment (ast:as (ast:qualified "a" html-field) "html"))
   355    364                 a.published
   356         -              a.series-page)
          365  +              a.series-page
          366  +              a.conceal)
   357    367         (where-series s)
          368  +      (where-not-concealed)
   358    369         (limit ,lim)
   359    370         (order-by ([a.published ,ord]))
   360    371         (project-onto listing-schema)))
   361    372   
   362    373   ;; Builds a query that returns articles and notes intermingled chronologically
   363    374   (define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
   364    375     (define html-field (format "listing_~a_html" type))
   365    376     (~> (from (subquery
   366    377                (~> (from cache:article #:as A)
   367    378                    (select (fragment (ast:as (ast:qualified "A" html-field) "html"))
   368    379                            A.published
   369         -                         A.series-page)
          380  +                         A.series-page
          381  +                         A.conceal)
   370    382                    (union
   371    383                     (~> (from cache:note #:as N)
   372    384                         (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
   373    385                                 N.published
   374         -                              N.series-page)))))
          386  +                              N.series-page
          387  +                              N.conceal)))))
   375    388               #:as a)
   376    389         (where-series s)
          390  +      (where-not-concealed)
   377    391         (limit ,lim)
   378    392         (order-by ([a.published ,ord]))
   379    393         (project-onto listing-schema)))
   380    394   
   381    395   ;; Get all the a list of the HTML all the results in a query
   382    396   (define (listing-htmls list-query)
   383    397     (for/list ([l (in-entities cache-conn list-query)])

Modified dust.rkt from [c096eb0e] to [dffdbbe2].

    17     17   
    18     18   ;; Provides common helper functions used throughout the project
    19     19   
    20     20   (provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
    21     21            maybe-attr     ; Return an attribute’s value or a default ("") if not available
    22     22            here-output-path
    23     23            here-id
           24  +         listing-context
    24     25            series-metas-noun    ; Retrieve noun-singular from current 'series meta, or ""
    25     26            series-metas-title   ; Retrieve title of series in current 'series meta, or ""
    26     27            metas-series-pagenode
    27     28            invalidate-series
    28     29            make-tag-predicate
    29     30            tx-strs
    30     31            ymd->english
................................................................................
    62     63   (define (here-output-path)
    63     64     (cond [(current-metas)
    64     65            (define-values (_ rel-path-parts)
    65     66              (drop-common-prefix (explode-path (current-project-root))
    66     67                                  (explode-path (string->path (select-from-metas 'here-path (current-metas))))))
    67     68            (->output-path (apply build-path rel-path-parts))]
    68     69           [else (string->path ".")]))
           70  +
           71  +(define listing-context (make-parameter ""))
    69     72   
    70     73   ;; Checks current-metas for a 'series meta and returns the pagenode of that series,
    71     74   ;; or '|| if no series is specified.
    72     75   (define (metas-series-pagenode)
    73     76     (define maybe-series (or (select-from-metas 'series (current-metas)) ""))
    74     77     (cond
    75     78       [(non-empty-string? maybe-series)

Modified rss-feed.rkt from [9efceb86] to [ca1031f8].

    50     50        SELECT `path`, `title`, `published`, `updated`, `author`, `entry_contents` FROM
    51     51          (SELECT `page` AS `path`,
    52     52                  `title_plain` AS `title`,
    53     53                  `published`,
    54     54                  `updated`,
    55     55                  `author`,
    56     56                  `doc_html` AS `entry_contents`
    57         -        FROM `articles`
           57  +        FROM `articles` WHERE (NOT (`conceal` LIKE "%all%")) AND (NOT (`conceal` LIKE "%feed%"))
    58     58           UNION
    59     59           SELECT `page` || '#' || `html_anchor` AS `path`,
    60     60                  `title_plain` AS `title`,
    61     61                  `published`,
    62     62                  "" AS `updated`,
    63     63                  `author`,
    64     64                  `content_html` as `entry_contents`
    65         -        FROM `notes`)
           65  +        FROM `notes` WHERE (NOT (`conceal` LIKE "%all%")) AND (NOT (`conceal` LIKE "%feed%")))
    66     66           ORDER BY `published` DESC LIMIT ~a
    67     67   ---
    68     68       )
    69     69     (query-rows cache-conn (format select feed-item-limit)))
    70     70   
    71     71   (define (vector->rss-item vec)
    72     72     (match-define

Modified util/newpost.rkt from [89e8b78f] to [d7b70e83].

    31     31   (define (make-template-contents title)
    32     32     ◊string-append{
    33     33    #lang pollen
    34     34   
    35     35    ◊comment{Copyright ◊(substring date-string 0 4) by ◊|default-authorname|. All Rights Reserved.}
    36     36   
    37     37    ◊"◊"(define-meta published "◊date-string")
    38         - ◊"◊"(define-meta series "seriesname")
           38  + ◊"◊"(define-meta conceal   "blog,feed")  ; Edit/delete this line when ready to publish
           39  + ◊"◊;"(define-meta series "seriesname")
    39     40   
    40     41    ◊"◊"title{◊title}
    41     42   
    42     43    Write here!})
    43     44   
    44     45   (define (main)
    45     46     (display "Enter title: ")