diff --git a/command.rkt b/command.rkt index 4118aae..904948b 100644 --- a/command.rkt +++ b/command.rkt @@ -1,4 +1,5 @@ -#lang racket +#lang racket/base +(require (for-syntax racket/base)) ;; todo: add command to check validity of installation diff --git a/file-tools.rkt b/file-tools.rkt index 67c50a4..21b5671 100644 --- a/file-tools.rkt +++ b/file-tools.rkt @@ -80,7 +80,7 @@ ;; make paths absolute to test whether files exist, ;; then convert back to relative (define (visible? path) - (not ((->string path) . starts-with? . "."))) + (not ((->string path) . starts-with? . "."))) (define/contract (visible-files dir) (directory-pathish? . -> . (listof path?)) @@ -108,7 +108,7 @@ (module+ test (check-true (has-binary-ext? "foo.MP3")) (check-false (has-binary-ext? "foo.py"))) - + (module+ test (define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt")) @@ -186,59 +186,64 @@ (define/contract (preproc-source? x) (any/c . -> . boolean?) - (has-ext? (->path x) PREPROC_SOURCE_EXT)) + (and (pathish? x) (has-ext? (->path x) PREPROC_SOURCE_EXT))) (module+ test (check-true (preproc-source? "foo.p")) - (check-false (preproc-source? "foo.bar"))) + (check-false (preproc-source? "foo.bar")) + (check-false (preproc-source? #f))) (define/contract (has-preproc-source? x) (any/c . -> . boolean?) - (file-exists? (->preproc-source-path (->path x)))) + (and (pathish? x) (file-exists? (->preproc-source-path (->path x))))) (define/contract (has-decoder-source? x) (any/c . -> . boolean?) - (file-exists? (->decoder-source-path (->path x)))) + (and (pathish? x) (file-exists? (->decoder-source-path (->path x))))) (define/contract (needs-preproc? x) (any/c . -> . boolean?) ; it's a preproc source file, or a file that's the result of a preproc source - (ormap (λ(proc) (proc (->path x))) (list preproc-source? has-preproc-source?))) + (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list preproc-source? has-preproc-source?)))) (define/contract (needs-template? x) (any/c . -> . boolean?) ; it's a pollen source file ; or a file (e.g., html) that has a pollen source file - (ormap (λ(proc) (proc (->path x))) (list decoder-source? has-decoder-source?))) + (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list decoder-source? has-decoder-source?)))) (define/contract (ptree-source? x) (any/c . -> . boolean?) - ((->path x) . has-ext? . PTREE_SOURCE_EXT)) + (and (pathish? x) ((->path x) . has-ext? . PTREE_SOURCE_EXT))) (module+ test (check-true (ptree-source? (format "foo.~a" PTREE_SOURCE_EXT))) - (check-false (ptree-source? (format "~a.foo" PTREE_SOURCE_EXT)))) + (check-false (ptree-source? (format "~a.foo" PTREE_SOURCE_EXT))) + (check-false (ptree-source? #f))) (define/contract (decoder-source? x) (any/c . -> . boolean?) - (has-ext? x DECODER_SOURCE_EXT)) + (and (pathish? x) (has-ext? x DECODER_SOURCE_EXT))) (module+ test (check-true (decoder-source? "foo.pd")) - (check-false (decoder-source? "foo.p"))) + (check-false (decoder-source? "foo.p")) + (check-false (decoder-source? #f))) (define/contract (template-source? x) (any/c . -> . boolean?) - (define-values (dir name ignore) (split-path x)) - (equal? (get (->string name) 0) TEMPLATE_SOURCE_PREFIX)) + (and (pathish? x) + (let-values ([(dir name ignore) (split-path x)]) + (equal? (get (->string name) 0) TEMPLATE_SOURCE_PREFIX)))) (module+ test (check-true (template-source? "-foo.html")) - (check-false (template-source? "foo.html"))) + (check-false (template-source? "foo.html")) + (check-false (template-source? #f))) ;; predicate for files that are eligible to be required @@ -246,7 +251,7 @@ ;; todo: extend this beyond just racket files? (define/contract (project-require-file? x) (any/c . -> . boolean?) - (has-ext? x 'rkt)) + (and (pathish? x) (has-ext? x 'rkt))) (module+ test (check-true (project-require-file? "foo.rkt")) @@ -305,6 +310,6 @@ ;; to identify unsaved sources in DrRacket (define (unsaved-source? path-string) - ((substring (->string path-string) 0 7) . equal? . "unsaved")) + ((substring (->string path-string) 0 7) . equal? . "unsaved")) ;; todo: write tests for project-files-with-ext diff --git a/lang/doclang2_raw.rkt b/lang/doclang2_raw.rkt index 222f3f9..b850b98 100755 --- a/lang/doclang2_raw.rkt +++ b/lang/doclang2_raw.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; A slightly nicer version of doclang where the parameters are keyword-based ;; rather than positional. Delegates off to the original doclang. @@ -7,7 +7,7 @@ (for-syntax racket/base syntax/parse)) -(provide (except-out (all-from-out racket) #%module-begin) +(provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [*module-begin #%module-begin])) ;; Module wrapper ---------------------------------------- diff --git a/main-helper.rkt b/main-helper.rkt index b82bc80..1c162b4 100644 --- a/main-helper.rkt +++ b/main-helper.rkt @@ -1,35 +1,32 @@ -#lang racket -(require racket/contract/region) - -(require (for-syntax racket/rerequire pollen/tools pollen/world)) -(require pollen/tools pollen/world) +#lang racket/base +(require (for-syntax racket/base pollen/tools)) -(provide (all-defined-out)) +(require racket/contract/region) -(module+ test (require rackunit)) +(provide (all-defined-out) (all-from-out racket/contract/region)) (define-for-syntax (put-file-in-require-form file) `(file ,(->string file))) -(define-syntax (require-and-provide-extras stx) + +(define-for-syntax (make-require-extras-syntax stx #:provide? [provide? #f]) (define project-require-files (get-project-require-files)) (if project-require-files (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) (datum->syntax stx `(begin (require ,@files-in-require-form) - (provide (all-from-out ,@files-in-require-form))))) + ,@(if provide? + (list `(provide (all-from-out ,@files-in-require-form))) + '())))) ; if no files to import, do nothing #'(begin))) +(define-syntax (require-and-provide-extras stx) + (make-require-extras-syntax stx #:provide? #t)) + (define-syntax (require-extras stx) - (define project-require-files (get-project-require-files)) - (if project-require-files - (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) - (datum->syntax stx `(begin - (require ,@files-in-require-form)))) - ; if no files to import, do nothing - #'(begin))) + (make-require-extras-syntax stx)) ;; here = path of this file, relative to current directory. @@ -41,8 +38,7 @@ '(begin ;; Even though begin permits defines, ;; This macro might be used in an expression context, - ;; whereupon define would cause an error. - ;; Therefore, best to use let. + ;; whereupon define would cause an error. Therefore, use let. (let* ([ccr (current-contract-region)] ; trick for getting current module name [hp (cond ;; if contract-region is called from within submodule, @@ -60,17 +56,11 @@ ;; and can be made relative by the caller (or otherwise altered). (->string hp))))) -;; todo: update tests -;(module+ test -; (check-equal? (get-here) "main-helper.rkt")) ; Second step: apply a separate syntax transform to the identifier itself ; We can't do this in one step, because if the macro goes from identifier to function definition, ; The macro processor will evaluate the body at compile-time, not at runtime. (define-syntax here-path (λ(stx) (datum->syntax stx '(get-here-path)))) -;; todo: update test -;(module+ test -; (check-equal? here "main-helper.rkt")) diff --git a/main-imports.rkt b/main-imports.rkt index c329d3d..b23a6e6 100644 --- a/main-imports.rkt +++ b/main-imports.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; These are separated from main.rkt as a performance improvement: ;; so they can be imported into the render.rkt namespace diff --git a/main-preproc-imports.rkt b/main-preproc-imports.rkt index ebe859b..c558383 100644 --- a/main-preproc-imports.rkt +++ b/main-preproc-imports.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; These are separated from main-preproc.rkt as a performance improvement: ;; so they can be imported into the render.rkt namespace diff --git a/main-preproc.rkt b/main-preproc.rkt index c7491d1..0f458dc 100644 --- a/main-preproc.rkt +++ b/main-preproc.rkt @@ -1,7 +1,7 @@ -#lang racket +#lang racket/base (require "main-preproc-imports.rkt" "readability.rkt") -(provide (except-out (all-from-out racket) #%module-begin) +(provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [module-begin #%module-begin])) (require (only-in scribble/text output) diff --git a/main.rkt b/main.rkt index 6949cc7..84d4cb6 100644 --- a/main.rkt +++ b/main.rkt @@ -1,6 +1,6 @@ -#lang racket +#lang racket/base (require "main-imports.rkt") -(provide (except-out (all-from-out racket) #%module-begin) +(provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [module-begin #%module-begin])) (define-syntax-rule (module-begin expr ...) diff --git a/ptree.rkt b/ptree.rkt index 13c5317..88da701 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -77,7 +77,7 @@ (define/contract (parent pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c pnode? false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? pnode?)) (and pnode (if (member (->string pnode) (map (λ(x) (->string (if (list? x) (car x) x))) (cdr ptree))) (->string (car ptree)) @@ -94,7 +94,7 @@ (define/contract (children pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c (listof pnode?) false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? (listof pnode?))) (and pnode (if (equal? (->string pnode) (->string (car ptree))) (map (λ(x) (->string (if (list? x) (car x) x))) (cdr ptree)) @@ -109,7 +109,7 @@ (define/contract (siblings pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c (listof string?) false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? (listof string?))) (children (parent pnode ptree) ptree)) @@ -141,7 +141,7 @@ (define/contract (left-adjacents pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c (listof pnode?) false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? (listof pnode?))) (adjacents 'left pnode ptree)) (module+ test @@ -150,11 +150,11 @@ (check-false (left-adjacents 'foo test-ptree))) (define/contract (right-adjacents pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c (listof pnode?) false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? (listof pnode?))) (adjacents 'right pnode ptree)) (define/contract (previous pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c pnode? false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? pnode?)) (let ([result (left-adjacents pnode ptree)]) (and result (last result)))) @@ -165,7 +165,7 @@ (define (next pnode [ptree (current-ptree)]) - (((or/c pnode? false?)) (ptree?) . ->* . (or/c pnode? false?)) + (((or/c false? pnode?)) (ptree?) . ->* . (or/c false? pnode?)) (let ([result (right-adjacents pnode ptree)]) (and result (first result)))) @@ -196,7 +196,7 @@ (define/contract (pnode->url pnode [url-context (current-url-context)]) - ((pnode?) (pathish?) . ->* . (or/c pnode? false?)) + ((pnode?) (pathish?) . ->* . (or/c false? pnode?)) (parameterize ([current-url-context url-context]) (pnode->url/paths pnode (directory-list (current-url-context))))) diff --git a/render.rkt b/render.rkt index cddacc8..0692e30 100644 --- a/render.rkt +++ b/render.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require racket/port racket/file racket/rerequire racket/contract) (require "world.rkt" "tools.rkt" "readability.rkt" "template.rkt") @@ -311,7 +311,7 @@ ;; the eval namespace doesn't have to re-import these ;; because otherwise, most of its time is spent traversing imports. (map (λ(mod-name) (namespace-attach-module original-ns mod-name)) - '(racket + '(racket/base web-server/templates xml/path racket/port @@ -330,7 +330,8 @@ pollen/template pollen/tools pollen/world)) - (namespace-require 'racket) ; use namespace-require for FIRST require, then eval after + (namespace-require 'racket/base) ; use namespace-require for FIRST require, then eval after + (eval '(require (for-syntax racket/base))) (eval eval-string (current-namespace)))) (define/contract (render-source-with-template source-path template-path) diff --git a/startup.rkt b/startup.rkt deleted file mode 100644 index e69de29..0000000 diff --git a/template.rkt b/template.rkt index df7183f..f83a4c8 100644 --- a/template.rkt +++ b/template.rkt @@ -17,7 +17,11 @@ (any/c . -> . boolean?) (or (tagged-xexpr? x) (has-decoder-source? x) - (and (pnode->url x) (has-decoder-source? (pnode->url x))))) + (and (pnode? x) (pnode->url x) (has-decoder-source? (pnode->url x))))) + +(module+ test + (check-false (puttable-item? #t)) + (check-false (puttable-item? #f))) (define/contract (query-key? x) (any/c . -> . boolean?) @@ -39,18 +43,19 @@ (define/contract (find query px) - (query-key? puttable-item? . -> . (or/c xexpr-element? false?)) - (define result (or (find-in-metas px query) (find-in-main px query))) + (query-key? (or/c false? puttable-item?) . -> . (or/c false? xexpr-element?)) + (define result (and px (or (find-in-metas px query) (find-in-main px query)))) (and result (car result))) ;; return false or first element (module+ test (parameterize ([current-directory "tests/template"]) (check-false (find "nonexistent-key" "put")) (check-equal? (find "foo" "put") "bar") - (check-equal? (find "em" "put") "One"))) + (check-equal? (find "em" "put") "One")) + (check-equal? (find "foo" #f) #f)) (define/contract (find-in-metas px key) - (puttable-item? query-key? . -> . (or/c xexpr-elements? false?)) + (puttable-item? query-key? . -> . (or/c false? xexpr-elements?)) (and (has-decoder-source? px) (let ([metas (dynamic-require (->decoder-source-path px) 'metas)] [key (->string key)]) @@ -66,7 +71,7 @@ (define/contract (find-in-main px query) (puttable-item? (or/c query-key? (listof query-key?)) - . -> . (or/c xexpr-elements? false?)) + . -> . (or/c false? xexpr-elements?)) (let* ([px (put px)] ;; make sure query is a list of symbols (required by se-path*/list) [query (map ->symbol (->list query))] @@ -115,7 +120,12 @@ ;; improves the syntax for conditional blocks in templates ;; ordinarily it would be ◊when[condition]{◊list{stuff ...}} ;; now it can be ◊when/block[condition]{stuff ...} -(define (when/block condition . strings) - (if condition (string-append* strings) "")) +;; has to be a macro otherwise body expressions will be evaluated regardless of condition +;; this is bad: if condition is false, expression should exit +(require (for-syntax racket/base)) +(define-syntax (when/block stx) + (syntax-case stx () + [(_ condition body ...) + #'(if condition (string-append* (map ->string (list body ...))) "")])) diff --git a/test-include.rkt b/test-include.rkt deleted file mode 100644 index ee61a9d..0000000 --- a/test-include.rkt +++ /dev/null @@ -1,3 +0,0 @@ -#lang racket - -(include "poldash.css") \ No newline at end of file diff --git a/tests/bound contract/bound.rkt b/tests/bound contract/bound.rkt index 4197f94..36679d2 100644 --- a/tests/bound contract/bound.rkt +++ b/tests/bound contract/bound.rkt @@ -1,4 +1,5 @@ -#lang racket +#lang racket/base +(require (for-syntax racket/base)) (provide bound/c (rename-out (top~ #%top))) diff --git a/tests/bound contract/test.rkt b/tests/bound contract/test.rkt index a3962ba..1763334 100644 --- a/tests/bound contract/test.rkt +++ b/tests/bound contract/test.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base (require "bound.rkt") (bar "hello") ; bar is unbound diff --git a/top.rkt b/top.rkt index ede73cb..a893fdd 100644 --- a/top.rkt +++ b/top.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang racket/base ;; Changes the default behavior of #%top. ;; Unbound identifiers are allowed, and treated as the @@ -6,6 +6,7 @@ ;; To suppress this behavior, use bound/c to wrap any name. ;; If that name isn't already defined, you'll get the usual syntax error. +(require (for-syntax racket/base)) (provide (except-out (all-defined-out) top~) (rename-out (top~ #%top))) diff --git a/world.rkt b/world.rkt index 9f7d467..09bcde6 100644 --- a/world.rkt +++ b/world.rkt @@ -1,4 +1,5 @@ -#lang racket +#lang racket/base +(require racket/list racket/contract) (provide (all-defined-out))