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

Overview
Comment:Remove attr-present (redundant)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: fdc4797490ff4a0c4a1e6a84f8080e414d396f5a1b9d3a4950ff71a28de62338
User & Date: joel on 2019-03-31 20:19:00
Other Links: manifest | tags
Context
2019-04-04
15:48
Merge alternate header/logo concept check-in: 5dbeca0e user: joel tags: trunk
15:22
Subtler header + new logo concept Leaf check-in: 671acdae user: joel tags: alt-logo
2019-03-31
20:19
Remove attr-present (redundant) check-in: fdc47974 user: joel tags: trunk
2019-03-24
00:50
Correct scribble doc for select-rows! check-in: 4e28f613 user: joel tags: trunk
Changes

Modified code-docs/dust.scrbl from [d396f326] to [3dab2a11].

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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}. 

@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]

Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.

I had to write this because @racket[attr-ref] wants a whole tagged X-expression (not just the
attributes); also, by default it raises an exception when @racket[_key] is missing, rather than







<
<
<
<
<







51
52
53
54
55
56
57





58
59
60
61
62
63
64
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[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]

Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.

I had to write this because @racket[attr-ref] wants a whole tagged X-expression (not just the
attributes); also, by default it raises an exception when @racket[_key] is missing, rather than

Modified dust.rkt from [43f7824f] to [23ec4654].

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; 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







<







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

         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
  `(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.







<
<
<
<







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







<
<







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







|







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