finish refactoring render (now works)

render.rkt

@@ -1,83 +1,97 @@
 #lang racket/base
-(require (for-syntax racket/base))
+(require racket/file racket/rerequire racket/path racket/match)
-(require racket/port racket/file racket/rerequire racket/path racket/list racket/match)
 (require sugar "file-tools.rkt" "cache.rkt" "world.rkt" "debug.rkt" "ptree.rkt" "project-requires.rkt")
 
-;; for shared use by eval & system
-(define nowhere-port (open-output-nowhere))
 
+;; 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-modification-dates)
+  (set! modification-date-hash (make-hash)))
 
 ;; mod-dates is a hash that takes lists of paths as keys,
 ;; and lists of modification times as values.
-(define mod-dates (make-hash))
+(define modification-date-hash #f)
+(reset-modification-dates)
 
+;; using internal contracts to provide some extra safety (negligible performance hit)
 
-(define (make-mod-dates-key paths)
+(define/contract (make-mod-dates-key paths)
-  (flatten paths))
+  ((listof (or/c #f complete-path?)) . -> . (listof (or/c #f complete-path?)))
+  paths) ; for now, this does nothing; maybe later, it will do more
 
 
-(define (path->mod-date-value path)
+(define/contract (path->mod-date-value path)
-  (and (file-exists? path) ; returns #f if a file doesn't exist
+  ((or/c #f complete-path?) . -> . (or/c #f integer?))
-       (file-or-directory-modify-seconds path)))
+  (and path (file-exists? path) (file-or-directory-modify-seconds path)))
 
 
-(define (store-render-in-mod-dates . rest-paths)
+(define/contract (store-render-in-modification-dates . rest-paths)
+  (() #:rest (listof (or/c #f complete-path?)) . ->* . void?)
   (define key (make-mod-dates-key rest-paths))
-  (hash-set! mod-dates key (map path->mod-date-value key)))
+  (hash-set! modification-date-hash key (map path->mod-date-value key)))
-
-
-;; 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-dates)
-  (set! mod-dates (make-hash)))
 
 
-(define (mod-date-expired? . rest-paths)
+(define/contract (modification-date-expired? . rest-paths)
+  (() #:rest (listof (or/c #f complete-path?)) . ->* . boolean?)
   (define key (make-mod-dates-key rest-paths))
-  (or (not (key . in? . mod-dates))  ; no stored mod date
+  (or (not (key . in? . modification-date-hash))  ; no stored mod date
-      (not (equal? (map path->mod-date-value key) (get mod-dates key))))) ; data has changed
+      (not (equal? (map path->mod-date-value key) (get modification-date-hash key))))) ; data has changed
-
 
 
-(define+provide/contract (render-batch . xs)
+(define/contract+provide (render-batch . xs)
   (() #:rest (listof pathish?) . ->* . void?)
-  ;; This will trigger rendering of all files.
   ;; Why not pass #:force #t through with render?
   ;; Because certain files will pass through multiple times (e.g., templates)
   ;; And with #:force, they would be rendered repeatedly.
-  ;; Using reset-mod-dates is sort of like session control:
+  ;; Using reset-modification-dates is sort of like session control.
-  ;; setting a state that persists through the whole operation.
+  (reset-modification-dates) 
-  (reset-mod-dates) 
+  (for-each render-to-file-if-needed xs))
-  (for-each render-for-dev-server xs))
 
 
-(define+provide/contract (render-for-dev-server pathish #:force [force #f])
+(define/contract+provide (render-for-dev-server pathish #:force [force #f])
   ((pathish?) (#:force boolean?) . ->* . void?)
-  (let ([path (->complete-path pathish)])              
+  (let ([so-path (->complete-path pathish)])  ; so-path = source or output path (could be either) 
     (cond
-      [(ormap (λ(test) (and (test path) (render-to-file path #:force force)))
+      [(ormap (λ(test) (and (test so-path) (render-to-file-if-needed so-path #:force force)))
               (list has/is-null-source? has/is-preproc-source? has/is-markup-source?))]
-      [(ptree-source? path) (let ([ptree (cached-require path world:main-pollen-export)])
+      [(ptree-source? so-path) (let ([ptree (cached-require so-path world:main-pollen-export)])
-                              (for-each (λ(pnode) (render-for-dev-server pnode #:force force)) (ptree->list ptree)))]))
+                                 (for-each (λ(pnode) (render-for-dev-server pnode #:force force)) (ptree->list ptree)))]))
   (void))
 
 
-(define (->source+output-paths source-or-output-path)
+(define/contract (->source+output-paths source-or-output-path)
-  ;; file-proc returns two values
+  (complete-path? . -> . (values complete-path? complete-path?))
+  ;; file-proc returns two values, but ormap only wants one
   (define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc))
                            (list has/is-null-source? has/is-preproc-source? has/is-markup-source?)
                            (list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths)))
   (file-proc source-or-output-path))
 
 
-(define (render-to-file source-or-output-path [maybe-output-path #f] #:force [force #f])
+(define/contract (render-needed? source-path template-path output-path)
+  (complete-path? (or/c #f complete-path?) complete-path? . -> . boolean?)
+  (or (not (file-exists? output-path))
+      (modification-date-expired? source-path template-path)
+      (and (not (null-source? source-path)) (source-needs-rerequire? source-path))))
+
+
+(define/contract+provide (render-to-file-if-needed source-or-output-path #:force [force #f])
+  ((complete-path?) (#:force boolean?) . ->* . void?)  
   (define-values (source-path output-path) (->source+output-paths source-or-output-path))
-  (when maybe-output-path (set! output-path maybe-output-path))
+  (define template-path (get-template-for source-path))
-  (display-to-file (render source-path output-path #:force force) output-path #:exists 'replace))
+  (when (or force (render-needed? source-path template-path output-path))
+    (render-to-file source-path template-path output-path)))
+
+
+(define/contract+provide (render-to-file source-path [template-path #f] [maybe-output-path #f])
+  ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
+  (define output-path (or maybe-output-path (->output-path source-path)))
+  (display-to-file (render source-path template-path) output-path #:exists 'replace))
 
 
-(define (render source-path [output-path #f] #:force [force #f])
+(define/contract+provide (render source-path [template-path #f])
+  ((complete-path?) ((or/c #f complete-path?)) . ->* . bytes?)
   (define render-proc 
     (cond
       [(ormap (λ(test render-proc) (and (test source-path) render-proc))
@@ -85,51 +99,32 @@
               (list render-null-source render-preproc-source render-markup-source))]
       [else (error (format "render: no rendering function found for ~a" source-path))]))
   
-  (define render-needed? 
+  (message (format "render: ~a" (file-name-from-path source-path)))
-    (or force 
+  (store-render-in-modification-dates source-path template-path) ; todo?: this may need to go after render
-        (not (file-exists? (or output-path (->output-path source-path))))
+  (apply render-proc (cons source-path (if template-path (list template-path) null))))
-        (mod-date-expired? source-path) ; todo: markup takes template path as key
-        (source-needs-rerequire? source-path)))
-  
-  (if render-needed?
-      (let ([result (render-proc source-path)])
-        (message (format "Rendered ~a" (file-name-from-path source-path)))
-        (store-render-in-mod-dates source-path)
-        result)
-      (message (->string (file-name-from-path source-path)) "is up to date, using existing copy")))
 
 
 (define/contract (render-null-source source-path)
-  (pathish? . -> . bytes?)
+  (complete-path? . -> . bytes?)
   ;; All this does is copy the source. Hence, "null".
-  ;; todo: add test to avoid copying if unnecessary
+  ;; todo: add test to avoid copying if unnecessary (good idea in case the file is large)
-  ;; (good idea in case the file is large)
+  (file->bytes source-path))
-  (let ([source-path (->path source-path)])
-    (file->bytes source-path)))
 
 
-(define (render-preproc-source source-path)
+(define/contract (render-preproc-source source-path)
-  ;; how we render: import world:main-pollen-export from preproc source file, 
+  (complete-path? . -> . bytes?)
-  ;; which is rendered during source parsing, and write that to output path
   (match-define-values (source-dir _ _) (split-path source-path))
   (time (parameterize ([current-directory (->complete-path source-dir)])
           (render-through-eval `(begin (require pollen/cache)(cached-require ,source-path ',world:main-pollen-export))))))
 
 
-(define (render-markup-source source-path) 
+(define/contract (render-markup-source source-path [maybe-template-path #f]) 
-  
+  ((complete-path?) ((or/c #f complete-path?)) . ->* . bytes?)
-  ;; todo: this won't work with source files nested down one level
+  (match-define-values (source-dir _ _) (split-path source-path)) ; todo: this won't work with source files nested down one level
-  (match-define-values (source-dir _ _) (split-path source-path))
+  (define template-path (or maybe-template-path (get-template-for source-path)))
-  
-  ;; Then the rest: 
-  ;; 1) Set the template. 
-  (define template-path (get-template-for source-path))
   (render-for-dev-server template-path) ; because template might have its own preprocessor source
   
-  ;; TODO: need to check  (mod-date-expired? source-path template-path))
+  (define expr-to-eval 
-  
-  ;; 2) Render the source file with template, if needed
-  (define string-to-eval 
     `(begin 
        (require (for-syntax racket/base))
        (require web-server/templates pollen/cache)
@@ -138,36 +133,36 @@
        (let ([doc (cached-require ,source-path ',world:main-pollen-export)]
              [metas (cached-require ,source-path ',world:meta-pollen-export)])
          (local-require pollen/debug pollen/ptree pollen/template pollen/top)
-         (include-template #:command-char ,world:template-field-delimiter ,(->string template-path)))))
+         (include-template #:command-char ,world:template-field-delimiter ,(->string (find-relative-path source-dir template-path))))))
-  
-  (define result (time (parameterize ([current-directory (->complete-path source-dir)])
-                         (render-through-eval string-to-eval))))
   
-  (let ([ft-path (build-path source-dir world:fallback-template)]) ; delete fallback template if needed
+  (time (parameterize ([current-directory source-dir])
-    (when (file-exists? ft-path) (delete-file ft-path)))
+          (render-through-eval expr-to-eval))))
-  
+
-  result)
 
+(define/contract (templated-source? path)
+  (complete-path? . -> . boolean?)
+  (not (or (null-source? path) (preproc-source? path))))
 
-(define (get-template-for source-path)
+
+(define/contract (get-template-for source-path)
+  (complete-path? . -> . (or/c #f complete-path?))
   (match-define-values (source-dir _ _) (split-path source-path))
-  ;; Build the possible paths and use the first one that either exists, or has a preproc source that exists.
+  (and (templated-source? source-path) ; doesn't make sense if it's not a templated source format
-  (or 
+       (or ; Build the possible paths and use the first one that either exists, or has a preproc source that exists.
-   (ormap (λ(p) (if (ormap file-exists? (list p (->preproc-source-path p))) p #f)) 
+        (ormap (λ(p) (if (ormap file-exists? (list p (->preproc-source-path p))) p #f)) 
-          (filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f 
+               (filter (λ(x) (->boolean x)) ; if any of the possibilities below are invalid, they return #f 
-                  (list                     
+                       (list                     
-                   (parameterize ([current-directory (world:current-project-root)])
+                        (parameterize ([current-directory (world:current-project-root)])
-                     (let ([source-metas (cached-require source-path 'metas)])
+                          (let ([source-metas (cached-require source-path 'metas)])
-                       (and (world:template-meta-key . in? . source-metas)
+                            (and (world:template-meta-key . in? . source-metas)
-                            (build-path source-dir (get source-metas world:template-meta-key))))) ; path based on metas
+                                 (build-path source-dir (get source-metas world:template-meta-key))))) ; path based on metas
-                   (build-path source-dir 
+                        (build-path source-dir 
-                               (add-ext (add-ext world:default-template-prefix (get-ext (->output-path source-path))) world:template-source-ext))))) ; path using default template
+                                    (add-ext (add-ext world:default-template-prefix (get-ext (->output-path source-path))) world:template-source-ext))))) ; path to default template
-   (let ([ft-path (build-path source-dir world:fallback-template)]) ; if none of these work, make fallback template file
+        (build-path (world:current-server-extras-path) world:fallback-template)))) ; fallback template
-     (copy-file (build-path (world:current-server-extras-path) world:fallback-template) ft-path #t)
+
-     ft-path)))
+
-
+(define/contract (source-needs-rerequire? source-path)
-
+  (complete-path? . -> . boolean?)
-(define (source-needs-rerequire? source-path)
   (define-values (source-dir source-name _) (split-path source-path))
   ;; use dynamic-rerequire now to force render for cached-require later,
   ;; otherwise the source file will get cached by compiler
@@ -179,11 +174,9 @@
   (> (len (get-output-string port-for-catching-file-info)) 0))
 
 
-
-
 ;; cache some modules to speed up eval.
 ;; Do it in separate module so as not to pollute this one.
-
+;; todo: macrofy these lists of modules
 (module my-module-cache racket/base
   (require web-server/templates 
            xml
@@ -211,11 +204,13 @@
   (define-namespace-anchor my-module-cache-ns-anchor)
   (provide my-module-cache-ns-anchor))
 
+
 (require 'my-module-cache)
 (define cache-ns (namespace-anchor->namespace my-module-cache-ns-anchor))
 
 
-(define (render-through-eval eval-string)
+(define/contract (render-through-eval expr-to-eval)
+  (list? . -> . bytes?)
   (parameterize ([current-namespace (make-base-namespace)]
                  [current-output-port (current-error-port)]
                  [current-ptree (make-project-ptree (world:current-project-root))]
@@ -242,4 +237,4 @@
                 pollen/world
                 pollen/project-requires 
                 ,@(get-project-require-files)))   
-    (eval eval-string (current-namespace))))
+    (string->bytes/utf-8 (eval expr-to-eval (current-namespace)))))