◊(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
5
6
7
8
9
10

11
12
13
14
15
16
17
..
34
35
36
37
38
39
40

41
42
43
44
45
46
47
; This file is licensed under the Blue Oak Model License 1.0.0.

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

         racket/file
         sugar/list)

(provide main)

;; How many items per blog page
(define per-page 5)
................................................................................
 <nav id="bottom-nav"><ul>◊|page-nav|</ul></nav>

 ◊html$-page-body-close[]
 </html>})

;; Grabs all the articles+notes from the cache and writes out all the blog page files
(define (build-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)])
    (define filename (format "blog-pg~a.html" pagenum))
    (displayln (format "Writing: ~a" filename))







>







 







>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
; This file is licensed under the Blue Oak Model License 1.0.0.

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

;; How many items per blog page
(define per-page 5)
................................................................................
 <nav id="bottom-nav"><ul>◊|page-nav|</ul></nav>

 ◊html$-page-body-close[]
 </html>})

;; 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)])
    (define filename (format "blog-pg~a.html" pagenum))
    (displayln (format "Writing: ~a" filename))

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

66
67
68
69
70
71
72

73
74
75
76
77
78
79
...
267
268
269
270
271
272
273

274
275
276
277
278
279
280
...
339
340
341
342
343
344
345







346
347
348
349
350
351
352
353
354
355
356

357

358
359
360
361
362
363
364
365
366
367
368
369

370
371
372
373
374

375
376

377
378
379
380
381
382
383
   [title-plain          string/f]
   [author               string/f]
   [author-url           string/f]
   [published            string/f]
   [disposition          string/f]
   [content-html         string/f]
   [series-page          symbol/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-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)

                  #:content-html content-html
                  #:listing-full-html (html$-note-listing-full pagenode
                                                               note-id
                                                               title-html
                                                               note-date
                                                               content-html
                                                               author
................................................................................
     (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...)
    [(or (? string? series) (? symbol? series))
     (where q (= a.series-page ,(s->p series)))]      ; WHERE series-page = "item"
    [#t
     (where q (= a.series-page ,(path->string (here-output-path))))]
    [_ q]))








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

      (where-series s)

      (limit ,lim)
      (order-by ([a.published ,ord]))
      (project-onto listing-schema)))

;; Builds a query that returns articles and notes intermingled chronologically
(define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (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)

                 (union
                  (~> (from cache:note #:as N)
                      (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
                              N.published
                              N.series-page)))))

            #:as a)
      (where-series s)

      (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
(define (listing-htmls list-query)
  (for/list ([l (in-entities cache-conn list-query)])







>







 







>







 







>
>
>
>
>
>
>










|
>

>











|
>




|
>


>







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
   [title-plain          string/f]
   [author               string/f]
   [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"
  ([id            id/f #:primary-key #:auto-increment]
   [page          symbol/f]
................................................................................
                  #: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 (html$-note-listing-full pagenode
                                                               note-id
                                                               title-html
                                                               note-date
                                                               content-html
                                                               author
................................................................................
     (where q (in a.series-page ,(map s->p series)))] ; WHERE series-page IN (item1 ...)
    [(or (? string? series) (? symbol? series))
     (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
(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.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
(define (articles+notes type #:series [s #t] #:limit [lim -1] #:order [ord 'desc])
  (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.conceal)
                 (union
                  (~> (from cache:note #:as N)
                      (select (fragment (ast:as (ast:qualified "N" html-field) "html"))
                              N.published
                              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
(define (listing-htmls list-query)
  (for/list ([l (in-entities cache-conn list-query)])

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

17
18
19
20
21
22
23

24
25
26
27
28
29
30
..
62
63
64
65
66
67
68


69
70
71
72
73
74
75

;; 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-id

         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
         tx-strs
         ymd->english
................................................................................
(define (here-output-path)
  (cond [(current-metas)
         (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 ".")]))



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







>







 







>
>







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

;; 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-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
         tx-strs
         ymd->english
................................................................................
(define (here-output-path)
  (cond [(current-metas)
         (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)) ""))
  (cond
    [(non-empty-string? maybe-series)

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

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

(define (vector->rss-item vec)
  (match-define







|







|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
     SELECT `path`, `title`, `published`, `updated`, `author`, `entry_contents` FROM
       (SELECT `page` AS `path`,
               `title_plain` AS `title`,
               `published`,
               `updated`,
               `author`,
               `doc_html` AS `entry_contents`
        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` 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)))

(define (vector->rss-item vec)
  (match-define

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

31
32
33
34
35
36
37

38
39
40
41
42
43
44
45
(define (make-template-contents title)
  ◊string-append{
 #lang pollen

 ◊comment{Copyright ◊(substring date-string 0 4) by ◊|default-authorname|. All Rights Reserved.}

 ◊"◊"(define-meta published "◊date-string")

 ◊"◊"(define-meta series "seriesname")

 ◊"◊"title{◊title}

 Write here!})

(define (main)
  (display "Enter title: ")







>
|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(define (make-template-contents title)
  ◊string-append{
 #lang pollen

 ◊comment{Copyright ◊(substring date-string 0 4) by ◊|default-authorname|. All Rights Reserved.}

 ◊"◊"(define-meta published "◊date-string")
 ◊"◊"(define-meta conceal   "blog,feed")  ; Edit/delete this line when ready to publish
 ◊"◊;"(define-meta series "seriesname")

 ◊"◊"title{◊title}

 Write here!})

(define (main)
  (display "Enter title: ")