diff --git a/main-helper.rkt b/main-helper.rkt index 0bcaefc..2b2caef 100644 --- a/main-helper.rkt +++ b/main-helper.rkt @@ -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. diff --git a/predicates.rkt b/predicates.rkt index a233058..e9d101c 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -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]) diff --git a/regenerate.rkt b/regenerate.rkt index 0da25ea..741294c 100644 --- a/regenerate.rkt +++ b/regenerate.rkt @@ -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 ®enerate xs)) diff --git a/tools.rkt b/tools.rkt index 99fcd4e..28d7087 100644 --- a/tools.rkt +++ b/tools.rkt @@ -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