various small improvements and fixes

cache.rkt

@@ -12,7 +12,11 @@
 
 
 (define (reset-cache)
-  (cache-remove #f (get-cache-dir)))
+  (for ([path (in-directory)]
+        #:when (and (directory-exists? path)
+                    (equal? (path->string (car (reverse (explode-path path)))) (world:current-cache-dir-name))))
+       (message (format "removing cache directory: ~a" path))
+       (delete-directory/files path)))
 
 
 (define (paths->key source-path [template-path #f])

command.rkt

@@ -64,9 +64,8 @@ version                print the version (~a)" (world:current-server-port) (worl
   (displayln (world:current-pollen-version)))
 
 (define (handle-reset)
-  (display "Resetting cache ...")
+  (displayln "resetting cache ...")
-  ((dynamic-require 'pollen/cache 'reset-cache))
+  ((dynamic-require 'pollen/cache 'reset-cache)))
-  (displayln " done"))
 
 
 (define (handle-render path-args)
@@ -85,14 +84,14 @@ version                print the version (~a)" (world:current-server-port) (worl
               (map very-nice-path
                    (cond
                      [(null? preprocs-and-static-pagetrees)
-                      (displayln (format "Rendering generated pagetree for directory ~a" dir))
+                      (displayln (format "rendering generated pagetree for directory ~a" dir))
                       (cdr (make-project-pagetree dir))]
                      [else
-                      (displayln (format "Rendering preproc & pagetree files in directory ~a" dir))
+                      (displayln (format "rendering preproc & pagetree files in directory ~a" dir))
                       preprocs-and-static-pagetrees])))
             (apply render-batch batch-to-render)))
         (begin ; first arg is a file
-          (displayln (format "Rendering ~a" (string-join (map ->string path-args) " ")))
+          (displayln (format "rendering ~a" (string-join (map ->string path-args) " ")))
           (apply render-batch path-args)))))
 
 (define (handle-start directory [port #f])
@@ -100,7 +99,7 @@ version                print the version (~a)" (world:current-server-port) (worl
     (error (format "~a is not a directory" directory)))
   (parameterize ([world:current-project-root directory]
                  [world:current-server-port (or port world:default-port)])
-    (displayln "Starting project server ...")
+    (displayln "starting project server ...")
     ((dynamic-require 'pollen/server 'start-server))))
 
 

render.rkt

@@ -6,8 +6,7 @@
 ;; used to track renders according to modification dates of component files
 (define mod-date-hash (make-hash))
 
-;; when you want to generate everything fresh, 
+;; when you want to generate everything fresh. 
-;; but without having to #:force everything.
 ;; render functions will always go when no mod-date is found.
 (define (reset-mod-date-hash)
   (set! mod-date-hash (make-hash)))
@@ -80,13 +79,13 @@
     (for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
 
 
-(define/contract+provide (render-from-source-or-output-path so-pathish #:force [force #f])
+(define/contract+provide (render-from-source-or-output-path so-pathish)
-  ((pathish?) (#:force boolean?) . ->* . void?)
+  (pathish? . -> . void?)
   (let ([so-path (->complete-path so-pathish)])  ; so-path = source or output path (could be either) 
     (cond
       [(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)) 
        (let-values ([(source-path output-path) (->source+output-paths so-path)])
-         (render-to-file-if-needed source-path output-path #:force force))]
+         (render-to-file-if-needed source-path output-path))]
       [(pagetree-source? so-path) (render-pagetree so-path)]))
   (void))
 
@@ -106,15 +105,14 @@
   (cond
     [(not (file-exists? output-path)) 'file-missing]
     [(mod-date-missing-or-changed? source-path template-path) 'mod-key-missing-or-changed]
-    [(file-needed-rerequire? source-path) 'file-needed-rerequire]
     [else #f]))
 
 
-(define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f] #:force [force #f])
+(define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f])
-  ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) #:force boolean?) . ->* . void?)  
+  ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)  
   (define output-path (or maybe-output-path (->output-path source-path)))
   (define template-path (get-template-for source-path))
-  (when (or force (render-needed? source-path template-path output-path))
+  (when (render-needed? source-path template-path output-path)
     (render-to-file source-path template-path output-path)))
 
 
@@ -153,7 +151,7 @@
 (define/contract (render-scribble-source source-path)
   (complete-path? . -> . string?)
   (match-define-values (source-dir source-filename _) (split-path source-path))
-  (file-needed-rerequire? source-path)
+  (dynamic-rerequire source-path) ; to suppress namespace caching by dynamic-require below
   (define scribble-render (dynamic-require 'scribble/render 'render))
   (time (parameterize ([current-directory (->complete-path source-dir)])
           ;; if there's a compiled zo file for the Scribble file,
@@ -223,12 +221,6 @@
           (and (filename-extension output-path) (build-path (world:current-server-extras-path) (add-ext (world:current-fallback-template-prefix) (get-ext output-path)))))))) ; fallback template
 
 
-(define/contract (file-needed-rerequire? source-path)
-  (complete-path? . -> . boolean?)
-  (and (not (null-source? source-path)) ; null sources can't be compiled
-       ;; if the file needed to be reloaded, the dependency list will be > 0
-       (> (length (dynamic-rerequire source-path)) 0)))
-
 
 (define/contract (render-through-eval expr-to-eval)
   (list? . -> . (or/c string? bytes?))

server-routes.rkt

@@ -5,7 +5,7 @@
 (require web-server/http/request-structs)
 (require web-server/http/response-structs)
 (require 2htdp/image)
-(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt" "rerequire.rkt")
+(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt")
 
 (module+ test (require rackunit))
 
@@ -13,7 +13,7 @@
 ;;; separated out for ease of testing
 ;;; because it's tedious to start the server just to check a route.
 
-(provide route-dashboard route-xexpr route-default route-404 route-in route-out)
+(provide route-dashboard route-default route-404 route-in route-out)
 
 (define (response/xexpr+doctype xexpr)
   (response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
@@ -57,16 +57,6 @@
     (response/xexpr+doctype (route-proc path))))
 
 
-;; extract main xexpr from a path
-(define/contract (file->xexpr path #:render [wants-render #t])
-  ((complete-path?) (#:render boolean?) . ->* . txexpr?)
-  (when wants-render (render-from-source-or-output-path path))
-  (dynamic-rerequire path) ; stores module mod date; reloads if it's changed
-  (dynamic-require path (world:current-main-export)))
-
-;; todo: rewrite this test, obsolete since filename convention changed
-;;(module+ test
-;;  (check-equal? (file->xexpr (build-path (current-directory) "tests/server-routes/foo.p") #:render #f) '(root "\n" "foo")))
 
 ;; read contents of file to string
 ;; just file->string with a render option
@@ -224,8 +214,7 @@
 ;; default route
 (define (route-default req)  
   (logger req)
-  (define force (->boolean (get-query-value (request-uri req) 'force)))
+  (render-from-source-or-output-path (req->path req))
-  (render-from-source-or-output-path (req->path req) #:force force)
   (next-dispatcher))
 
 
@@ -235,12 +224,3 @@
   (define error-text (format "route-404: Can't find ~a" (->string (req->path req))))
   (message error-text)
   (response/xexpr+doctype `(html ,error-text)))
-
-
-
-;; server route that returns xexpr (before conversion to html)
-(define/contract (xexpr path)
-  (complete-path? . -> . xexpr?)
-  (format-as-code (~v (file->xexpr path))))
-
-(define route-xexpr (route-wrapper xexpr))

server.rkt

@@ -17,7 +17,6 @@
      [((string-arg) ... (? pagetree-source?)) route-dashboard]
      [((string-arg) ... "in" (string-arg)) route-in]
      [((string-arg) ... "out" (string-arg)) route-out]
-     [((string-arg) ... "xexpr" (string-arg)) route-xexpr]
      [else route-default]))
   
   (message (format "Welcome to Pollen ~a" (world:current-pollen-version)) (format "(Racket ~a)" (version)))

test/test-rerequire.rkt

@@ -1,5 +1,5 @@
 #lang at-exp racket/base
-(require rackunit racket/runtime-path pollen/render racket/file racket/system)
+(require rackunit racket/runtime-path pollen/render racket/file racket/system pollen/world)
 
 ;; define-runtime-path only allowed at top level
 (define-runtime-path rerequire-dir "data/rerequire")
@@ -14,14 +14,16 @@
 (copy-file markup.txt.pm pre.txt.pp #t)
 
 ;; test makes sure that file render changes after pollen.rkt changes
-(parameterize ([current-output-port (open-output-string)])
+(parameterize ([current-output-port (open-output-string)]
+               [current-directory rerequire-dir]
+               [world:current-project-root rerequire-dir])
   
   (display-to-file @string-append{#lang racket/base
  (provide id)
  (define (id) "first")} pollen.rkt #:exists 'replace)
   
   (render-to-file-if-needed markup.txt.pm)
-  (check-equal? (file->string markup.txt) "rootfirst")
+  (check-equal? (file->string markup.txt) "(root first)")
   (render-to-file-if-needed pre.txt.pp)
   (check-equal? (file->string pre.txt) "first")
   
@@ -31,7 +33,7 @@
  (define (id) "second")} pollen.rkt #:exists 'replace)
   
   (render-to-file-if-needed markup.txt.pm)
-  (check-equal? (file->string markup.txt) "rootsecond")
+  (check-equal? (file->string markup.txt) "(root second)")
   (render-to-file-if-needed pre.txt.pp)
   (check-equal? (file->string pre.txt) "second"))
 

world.rkt

@@ -7,8 +7,19 @@
 (define current-project-root (make-parameter (current-directory)))
 
 (define directory-require "pollen.rkt")
+
 (define (get-path-to-override)
-  (build-path (current-project-root) directory-require))
+  (define file-with-config-submodule directory-require)
+  (define (dirname path)
+    (let-values ([(dir name dir?) (split-path path)])
+      dir))  
+  (let loop ([dir (current-directory)][path file-with-config-submodule])
+    (and dir ; dir is #f when it hits the top of the filesystem
+         (let ([completed-path (path->complete-path path)]) 
+           (if (file-exists? completed-path)
+               (simplify-path completed-path)
+               (loop (dirname dir) (build-path 'up path)))))))
+
 
 ;; parameters should not be made settable.
 (define-for-syntax config-submodule-name 'config)
@@ -23,7 +34,7 @@
            (define base-name default-value)
            (define fail-thunk-name (λ _ base-name))
            (define current-name (λ _ (with-handlers ([exn:fail? fail-thunk-name])
-                                    (dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))]))
+                                       (dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))]))
 
 (define-settable pollen-version "0.001")