◊(Local Yarn Code "Check-in [5256383c]")

Overview
Comment:Add pagetree constants to dust.rkt
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 5256383cd7dec27634518b79bfedb416c4a3a175aa2df2f265c46bc4154671e8
User & Date: joel on 2019-03-03 22:51:10
Other Links: manifest | tags
Context
2019-03-04
00:38
Add SQL query maker to insert multiple rows check-in: b9830871 user: joel tags: trunk
2019-03-03
22:51
Add pagetree constants to dust.rkt check-in: 5256383c user: joel tags: trunk
21:35
Tell Fossil to ignore Pollen docs for now check-in: 0d3ef4aa user: joel tags: trunk
Changes

Modified code-docs/dust.scrbl from [14a49bec] to [d66853e3].

13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

40

41
42
43










44
45
46
47
48
49
50
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

42
43


44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60







+




















+
-
+

-
-
+
+
+
+
+
+
+
+
+
+







@(require (for-label "../pollen.rkt"
                     "../dust.rkt"
                     racket/base
                     txexpr
                     sugar/coerce
                     pollen/tag
                     pollen/setup
                     pollen/pagetree
                     pollen/core))

@(define dust-eval (make-base-eval))
@(dust-eval '(require "dust.rkt"))

@title{@filepath{dust.rkt}}

@defmodule["dust.rkt" #:packages ()]

This is where I put constants and helper functions that are needed pretty much everywhere in the
project. In a simpler project these would go in @seclink["pollen-rkt"]{@filepath{pollen.rkt}} but
here I have other modules sitting “behind” that one in the @tt{require} chain.

@section{Constants}

@defthing[default-authorname string? #:value "Joel Dueck"]

Used as the default author name for @code{note}s, and (possibly in the future) for articles
generally.

@deftogether[(@defthing[articles-path path-string? #:value "articles"]
@defthing[series-path/ path-string? #:value "series/"]
              @defthing[series-path   path-string? #:value "series"])]

The path of the folder that contains the Pollen documents defining Series, relative to the project’s
document root.
The path of the folder that contains the Pollen source documents for Articles and Series
respectively, relative to the project’s document root.

@deftogether[(@defthing[articles-pagetree pagetree?]
              @defthing[series-pagetree pagetree?])]

These are project-wide pagetrees: @racket[articles-pagetree] contains a pagenode for every Pollen
document contained in @racket[articles-path], and @racket[series-pagetree] contains a pagenode for
every Pollen document in @racket[series-path]. The pagenodes themselves point to the rendered
@tt{.html} targets of the source documents.

@section{Metas and @code{txexpr}s}

@defproc[(attr-present? [name symbol?] [attrs (listof pair?)]) boolean?]

Shortsightedly redundant to @code{attrs-have-key?}. Returns @code{#t} if @racket[_name] is one of
the attributes present in @racket[_attrs], otherwise returns @code{#f}. 

Modified dust.rkt from [b26678f7] to [c1bae001].

32
33
34
35
36
37
38
39

40
41
42


43
44
45



46
47
48

49
50
51
52


53
54
55
56
57
58
59


60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
76
77
78



















79
80
81
82
83
84
85
32
33
34
35
36
37
38

39
40
41
42
43
44



45
46
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110







-
+



+
+
-
-
-
+
+
+



+



-
+
+







+
+




-
+














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







;; 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
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         attr-present?  ; Test if an attribute is present
         disposition-values
         tx-strs
         ymd->english
         ymd->dateformat
         default-authorname
         default-title
         articles-path
         series-path/
         default-title
         tx-strs
         series-path
         articles-pagetree
         series-pagetree
         first-words
         build-note-id
         notes->last-disposition-values
         disposition-values
         )

(define default-authorname "Joel Dueck")
(define series-path/ "series/")
(define series-path "series")
(define articles-path "articles")

(define (default-title date)
  (format "Entry of ~a" (ymd->dateformat date "d MMM YYYY")))

(define (maybe-meta m [missing ""])
  (or (select-from-metas m (current-metas)) missing))

;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
(define (series-pagenode)
  (define maybe-series (or (select-from-metas 'series (current-metas)) ""))
  (cond
    [(non-empty-string? maybe-series)
     (->pagenode (string-append series-path/ maybe-series ".html"))]
     (->pagenode (string-append series-path "/" maybe-series ".html"))]
    [else '||]))

(define (series-noun)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))

(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))

;; ~~~ Project-wide Pagetrees ~~~

(define (include-in-pagetree folder extension)
  (define (matching-file? f)
    (string-suffix? f extension))
  (define (file->output-pagenode f)
    (string->symbol (format "~a/~a" folder (string-replace f extension ".html"))))

  (define file-strs (map path->string (directory-list folder)))
  (map file->output-pagenode (filter matching-file? file-strs)))

(define articles-pagetree
  `(root ,@(include-in-pagetree articles-path ".poly.pm")))

(define series-pagetree
  `(root ,@(include-in-pagetree series-path ".poly.pm")))

;; ~~~ Convenience functions for tagged x-expressions ~~~

(define (attr-present? name attrs)
  (for/or ([attr-pair (in-list attrs)])
          (equal? name (car attr-pair))))

(define (maybe-attr name attrs [missing ""])
  (define result (assoc name attrs))
  (cond