◊(Local Yarn Code "Diff")

Differences From Artifact [43f7824f]:

To Artifact [23ec4654]:


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 "" "")]))