From 73fa68020482576c3ea0b77ae22baedf5ae96712 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 12 Feb 2014 19:42:28 -0800
Subject: [PATCH] switch to racket/base throughout; fix when/block; fix or/c
 false? ... contracts; improve file contracts, etc.

---
 command.rkt                    |  3 ++-
 file-tools.rkt                 | 39 +++++++++++++++++++---------------
 lang/doclang2_raw.rkt          |  4 ++--
 main-helper.rkt                | 38 ++++++++++++---------------------
 main-imports.rkt               |  2 +-
 main-preproc-imports.rkt       |  2 +-
 main-preproc.rkt               |  4 ++--
 main.rkt                       |  4 ++--
 ptree.rkt                      | 16 +++++++-------
 render.rkt                     |  7 +++---
 startup.rkt                    |  0
 template.rkt                   | 26 ++++++++++++++++-------
 test-include.rkt               |  3 ---
 tests/bound contract/bound.rkt |  3 ++-
 tests/bound contract/test.rkt  |  2 +-
 top.rkt                        |  3 ++-
 world.rkt                      |  3 ++-
 17 files changed, 83 insertions(+), 76 deletions(-)
 delete mode 100644 startup.rkt
 delete mode 100644 test-include.rkt

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