pull/9/head
Matthew Butterick 11 years ago
parent 4246d267c4
commit 9095494bbf

@ -3,13 +3,28 @@
;; use full planet paths because this file is evaluated from source directory,
;; not module directory
(require (for-syntax (planet mb/pollen/tools) (planet mb/pollen/world)))
(require (for-syntax racket/rerequire (planet mb/pollen/tools) (planet mb/pollen/world)))
(require (planet mb/pollen/tools) (planet mb/pollen/world))
(provide (all-defined-out))
(module+ test (require rackunit))
;; use define-for-syntax because this function supports
;; the two syntax transformers below
(define-for-syntax (make-files-in-require-form file-directory)
;; This will be resolved in the context of current-directory.
;; So when called from outside the project directory,
;; current-directory must be properly set with 'parameterize'
(define (insert-directory-into-path path)
;; todo: document why this function is necessary (it definitely is, but I forgot why)
(define-values (start_dir name _ignore) (split-path (path->complete-path path)))
(build-path start_dir file-directory name))
(define files (map insert-directory-into-path (filter (λ(i) (has-ext? i 'rkt)) (directory-list file-directory))))
; this puts files in require form
(map (λ(file) `(file ,(->string file))) files))
;; Look for an EXTRAS_DIR directory local to the source file.
;; and require all the .rkt files therein.
;; optionally provide them.

@ -62,6 +62,14 @@
(any/c . -> . boolean?)
(or (string? x) (tagged-xexpr? x)))
;; Not a great idea to use "plural" (i.e. listlike) contracts.
;; Instead of foobars? use (listof foobar?) as contract
;; Reason is that listof will show you the specific element that fails
;; whereas foobars? will just announce the result for the whole list.
;; Since contracts are intended to tell you why your input is defective,
;; the (listof foobar?) behavior is better.
;; outside of contracts, instead of testing (foobars? list),
;; test (andmap foobar? list)
(define/contract (xexpr-elements? x)
(any/c . -> . boolean?)
@ -87,8 +95,8 @@
(and (xexpr? x) ; meets basic xexpr contract
(match x
[(list (? symbol? name) rest ...) ; is a list starting with a symbol
(or (xexpr-elements? rest) ; the rest is content or ...
(and (xexpr-attr? (car rest)) (xexpr-elements? (cdr rest))))] ; attr + content
(or (andmap xexpr-element? rest) ; the rest is content or ...
(and (xexpr-attr? (car rest)) (andmap xexpr-element? (cdr rest))))] ; attr + content
[else #f])))
(module+ test
@ -178,15 +186,17 @@
;; pmap attr must be ((parent "value"))
(define/contract (pmap-attr? x)
(any/c . -> . boolean?)
(define foo 'bar)
(match x
[(list `(,POLLEN_MAP_PARENT_KEY ,(? string?))) #t]
;; todo: how can I use POLLEN_MAP_PARENT_KEY
[`((parent ,(? string?))) #t]
[else #f]))
(module+ test
(check-true (pmap-attr? `((,POLLEN_MAP_PARENT_KEY "bar"))))
(check-false (pmap-attr? `((,POLLEN_MAP_PARENT_KEY "bar")(foo "bar"))))
(check-true (pmap-attr? '((parent "bar"))))
(check-false (pmap-attr? '((parent "bar") '(foo "bar"))))
(check-false (pmap-attr? '())))
;; pmap location must represent a possible valid filename
(define/contract (pmap-key? x #:loud [loud #f])

@ -102,7 +102,7 @@
(regenerate-with-pmap pmap #:force force))]
[(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path)))
(message "Regenerate: using fallback template")]
[(file-exists? path) (message "Regenerate: passing through" (->string (file-name-from-path path)))]
[(file-exists? path) (message "Regenerate: nothing to be done with" (->string (file-name-from-path path)))]
[else (error "Regenerate couldn't find" (->string (file-name-from-path path)))])))
(for-each &regenerate xs))

@ -11,19 +11,6 @@
;; setup for test cases
(module+ test (require rackunit))
;; helper function for pollen/main and pollen/main-pre
(define (make-files-in-require-form file-directory)
;; This will be resolved in the context of current-directory.
;; So when called from outside the project directory,
;; current-directory must be properly set with 'parameterize'
(define (make-complete-path path)
;; todo: document why this function is necessary (it definitely is, but I forgot why)
(define-values (start_dir name _ignore) (split-path (path->complete-path path)))
(build-path start_dir file-directory name))
(define files (map make-complete-path (filter (λ(i) (has-ext? i 'rkt)) (directory-list file-directory))))
(define files-in-require-form
(map (λ(file) `(file ,(->string file))) files))
files-in-require-form)
;; helper for comparison of values
@ -69,7 +56,10 @@
;; create tagged-xexpr from parts (opposite of break-tagged-xexpr)
(define/contract (make-tagged-xexpr name [attr empty] [content empty])
((symbol?) (xexpr-attr? xexpr-elements?) . ->* . tagged-xexpr?)
; xexpr/c provides a nicer error message,
; but is not sufficient on its own (too permissive)
((symbol?) (xexpr-attr? (listof xexpr-element?))
. ->* . tagged-xexpr?)
(filter-not empty? `(,name ,attr ,@content)))
(module+ test
@ -82,7 +72,8 @@
;; decompose tagged-xexpr into parts (opposite of make-tagged-xexpr)
(define/contract (break-tagged-xexpr nx)
(tagged-xexpr? . -> . (values symbol? xexpr-attr? xexpr-elements?))
(tagged-xexpr? . -> .
(values symbol? xexpr-attr? (listof xexpr-element?)))
(match
; tagged-xexpr may or may not have attr
; if not, add empty attr so that decomposition only handles one case
@ -114,7 +105,7 @@
attr)
(define (tagged-xexpr-elements nx)
(tagged-xexpr? . -> . xexpr-elements?)
(tagged-xexpr? . -> . (listof xexpr-element?))
(define-values (tag attrt elements) (break-tagged-xexpr nx))
elements)
@ -201,7 +192,7 @@
;; function to split tag out of tagged-xexpr
(define/contract (split-tag-from-xexpr tag tx)
(xexpr-tag? tagged-xexpr? . -> . (values xexpr-elements? tagged-xexpr? ))
(xexpr-tag? tagged-xexpr? . -> . (values (listof xexpr-element?) tagged-xexpr? ))
(define matches '())
(define (extract-tag x)
(cond

Loading…
Cancel
Save