︙ | | |
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
-
|
;; 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 ""
series-pagenode
attr-present? ; Test if an attribute is present
make-tag-predicate
tx-strs
ymd->english
ymd->dateformat
default-authorname
default-title
articles-path
|
︙ | | |
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
-
-
-
-
|
`(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
[(pair? result) (cadr result)]
[else missing]))
;; Returns a function will test if a txexpr's tag matches the given symbol.
|
︙ | | |
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
-
-
|
(define test-attrs '([name "Hazel"] [rank "Chief"]))
(parameterize ([current-metas test-metas])
(check-equal? (maybe-meta 'name) "Fiver") ; present meta
(check-equal? (maybe-meta 'age) "") ; missing meta
(check-equal? (maybe-meta 'age 2) 2)) ; alternate default value
(check-equal? (attr-present? 'name test-attrs) #t)
(check-equal? (attr-present? 'dingus test-attrs) #f)
(check-equal? (maybe-attr 'rank test-attrs) "Chief")
(check-equal? (maybe-attr 'dingus test-attrs) "")
(check-equal? (maybe-attr 'dingus test-attrs "zippy") "zippy"))
;; Return the first N words out of a list of txexprs. This function will unpack the strings out of
;; the elements of one txexpr at a time until it finds the requested number of words. It aims to be
;; both reliable and fast for any size of list you pass it, and smart about the punctuation it
|
︙ | | |
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
-
+
|
(define (build-note-id txpr)
(string-append (maybe-attr 'date (get-attrs txpr))
"_"
(uri-encode (maybe-attr 'author (get-attrs txpr) default-authorname))))
;; Extract the last disposition (if any), and the ID of the disposing note, out of a list of notes
(define (notes->last-disposition-values txprs)
(define (contains-disposition? tx) (attr-present? 'disposition (get-attrs tx)))
(define (contains-disposition? tx) (attrs-have-key? tx 'disposition))
(define disp-notes (filter contains-disposition? txprs))
(cond [(not (empty? disp-notes))
(define latest-disposition-note (last disp-notes))
(values (attr-ref latest-disposition-note 'disposition)
(build-note-id latest-disposition-note))]
[else (values "" "")]))
|
︙ | | |