allow `pollen/pagetree` funcs to take pagetree paths as input

pull/127/head
Matthew Butterick 8 years ago
parent f81da2ac6e
commit 67088229c9

@ -103,8 +103,8 @@
(define+provide/contract (get-pagetree source-path)
(pathish? . -> . pagetree?)
(cached-doc source-path))
((or/c pagetree? pathish?) . -> . pagetree?)
(if (pagetree? source-path) source-path (cached-doc source-path)))
(define+provide load-pagetree get-pagetree) ; bw compat
@ -117,12 +117,13 @@
(load-pagetree pagetree-source)))
(define+provide/contract (parent pnish [pt (current-pagetree)] #:allow-root [allow-root? #f])
(((or/c #f pagenodeish?)) (pagetree? #:allow-root boolean?) . ->* . (or/c #f pagenode?))
(define+provide/contract (parent pnish [pt-or-path (current-pagetree)] #:allow-root [allow-root? #f])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?) #:allow-root boolean?) . ->* . (or/c #f pagenode?))
(define subtree? list?)
(define (topmost-node x) (if (subtree? x) (car x) x))
(define pt (get-pagetree pt-or-path))
(define result
(and pt pnish
(and pnish
(let loop ([pagenode (->pagenode pnish)][subtree pt])
(define current-parent (car subtree))
(define current-children (cdr subtree))
@ -142,10 +143,11 @@
(check-false (parent 'nonexistent-name test-pagetree)))
(define+provide/contract (children p [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(and pt p
(let ([pagenode (->pagenode p)])
(define+provide/contract (children p [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(and pt-or-path p
(let ([pagenode (->pagenode p)]
[pt (get-pagetree pt-or-path)])
(if (eq? pagenode (car pt))
(map (λ(x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ(x) (children pagenode x)) (filter list? pt))))))
@ -159,8 +161,9 @@
(check-false (children 'fooburger test-pagetree)))
(define+provide/contract (siblings pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(define+provide/contract (siblings pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(define pt (get-pagetree pt-or-path))
(children (parent #:allow-root #t pnish pt) pt))
(module-test-external
@ -183,12 +186,12 @@
(check-equal? (pagetree->list test-pagetree) '(foo bar one two three)))
(define (adjacents side pnish [pt (current-pagetree)])
(define (adjacents side pnish [pt-or-path (current-pagetree)])
#;(symbol? pagenodeish? pagetree? . -> . pagenodes?)
(and pt pnish
(and pt-or-path pnish
(let* ([pagenode (->pagenode pnish)]
[proc (if (eq? side 'left) takef takef-right)]
[pagetree-nodes (pagetree->list pt)]
[pagetree-nodes (pagetree->list (get-pagetree pt-or-path))]
;; using `in-pagetree?` would require another flattening
[in-tree? (memq pagenode pagetree-nodes)]
[result (and in-tree? (proc pagetree-nodes (λ(x) (not (eq? pagenode x)))))])
@ -200,9 +203,9 @@
(check-false (adjacents 'right 'node-not-in-pagetree '(pagetree-index one two three))))
(define+provide/contract (previous* pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(adjacents 'left pnish pt))
(define+provide/contract (previous* pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(adjacents 'left pnish (get-pagetree pt-or-path)))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
@ -211,14 +214,15 @@
(check-false (previous* 'foo test-pagetree)))
(define+provide/contract (next* pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(adjacents 'right pnish pt))
(define+provide/contract (next* pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(adjacents 'right pnish (get-pagetree pt-or-path)))
(define+provide/contract (previous pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(let ([result (previous* pnish pt)])
(define+provide/contract (previous pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?))
(let* ([pt (get-pagetree pt-or-path)]
[result (previous* pnish pt)])
(and result (last result))))
(module-test-external
@ -230,9 +234,10 @@
(define+provide/contract (next pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(let ([result (next* pnish pt)])
(define+provide/contract (next pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?))
(let* ([pt (get-pagetree pt-or-path)]
[result (next* pnish pt)])
(and result (first result))))
(module-test-external
@ -251,6 +256,6 @@
(->output-path (find-relative-path (->complete-path starting-dir) (->complete-path path))))
(define+provide/contract (in-pagetree? pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . boolean?)
(and pnish (memq pnish (pagetree->list pt)) #t))
(define+provide/contract (in-pagetree? pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . boolean?)
(and pnish (memq pnish (pagetree->list (get-pagetree pt-or-path))) #t))

@ -1 +1 @@
1468003549
1468266778

@ -319,7 +319,7 @@ A parameter that defines the default pagetree used by pagetree navigation functi
@defproc[
(parent
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f pagenode?)]
Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there isn't one, or if you reach the root of the pagetree.
@ -334,7 +334,7 @@ Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racke
@defproc[
(children
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f pagenode?)]
Find the child pagenodes of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there aren't any.
@ -350,7 +350,7 @@ Find the child pagenodes of @racket[_p] within @racket[_pagetree]. Return @racke
@defproc[
(siblings
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f pagenode?)]
Find the sibling pagenodes of @racket[_p] within @racket[_pagetree]. The list will include @racket[_p] itself. But the function will still return @racket[#f] if @racket[_pagetree] is @racket[#f].
@ -367,13 +367,13 @@ Find the sibling pagenodes of @racket[_p] within @racket[_pagetree]. The list wi
@defproc[
(previous
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f pagenode?)]
@defproc[
(previous*
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f (listof pagenode?))]
)]
Return the pagenode immediately before @racket[_p]. For @racket[previous*], return all the pagenodes before @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored.
@ -393,13 +393,13 @@ Return the pagenode immediately before @racket[_p]. For @racket[previous*], retu
@defproc[
(next
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f pagenode?)]
@defproc[
(next*
[p (or/c #f pagenodeish?)]
[pagetree pagetree? (current-pagetree)])
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
(or/c #f (listof pagenode?))]
)]
Return the pagenode immediately after @racket[_p]. For @racket[next*], return all the pagenodes after @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored.
@ -419,15 +419,15 @@ Return the pagenode immediately after @racket[_p]. For @racket[next*], return al
@defproc[
(get-pagetree
[pagetree-source pathish?])
[pagetree-source (or/c pagetree? pathish?)])
pagetree?
]
Get a pagetree from a @ext[default-pagetree-source-ext] source file, namely @racket[_pagetree-source].
Get a pagetree from a @ext[default-pagetree-source-ext] source file, namely @racket[_pagetree-source]. If @racket[_pagetree-source] is already a pagetree, just pass it through.
@defproc[
(pagetree->list
[pagetree pagetree?])
[pagetree (or/c pagetree? pathish?)])
list?
]
Convert @racket[_pagetree] to a simple list. Uses @racket[flatten], and is thus equivalent to a pre-order depth-first traversal of @racket[_pagetree].
@ -440,8 +440,8 @@ Convert @racket[_pagetree] to a simple list. Uses @racket[flatten], and is thus
@defproc[
(in-pagetree?
[pagenode pagenode?]
[pagetree pagetree? (current-pagetree)])
[pagenode pagenodeish?]
[pagetree (or/c pagetree? pathish?) (current-pagetree)])
boolean?
]
Report whether @racket[_pagenode] is in @racket[_pagetree].

Loading…
Cancel
Save