cache output files

pollen/cache.rkt

@@ -10,9 +10,8 @@
 
 (define (cache-directory? path)
   (and (directory-exists? path)
-       (let* ([last (compose1 car reverse)]
-              [last-path-element (path->string (last (explode-path path)))])
-         (member last-path-element default-cache-names))))
+       (member (path->string (for/last ([p (in-list (explode-path path))])
+                               p)) default-cache-names)))
 
 (define+provide (reset-cache [starting-dir (current-project-root)])
   (unless (and (path-string? starting-dir) (directory-exists? starting-dir))
@@ -37,7 +36,10 @@
       (cond
         [(setup:compile-cache-active path)
          (define key (paths->key path))
-         (hash-ref (hash-ref! ram-cache key (λ () (cache-ref! key (λ () (path->hash path))))) subkey)]
+         (define (convert-path-to-cache-record) (path->hash path))
+         (define (get-cache-record) (cache-ref! key convert-path-to-cache-record))
+         (define ram-cache-record (hash-ref! ram-cache key get-cache-record))
+         (hash-ref ram-cache-record subkey)]
         [else (parameterize ([current-namespace (make-base-namespace)])
                 (namespace-attach-module (namespace-anchor->namespace cache-module-ns) 'pollen/setup) ; brings in params
                 (dynamic-require path subkey))]))))

pollen/private/cache-utils.rkt

@@ -4,33 +4,41 @@
          "project.rkt"
          file/cache
          racket/file
+         racket/list
          sugar/coerce
          sugar/test
          compiler/cm)
 (provide (all-defined-out))
 
-(define (paths->key source-path [template-path #f])
+(define (paths->key source-path [template-path #f] [output-path #f])
   ;; can't use relative paths for cache keys because source files include `here-path` which is absolute.
   ;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates)
   ;; but would actually be invalid (because the `here-path` names are wrong).
   ;; key is list of file + mod-time pairs, use #f for missing
-  (define path-strings (list* source-path
-                              ;; if template has a source file, track that instead
-                              (and template-path (or (get-source template-path) template-path))
-                              ;; is either list of files or (list #f)
-                              (->list (get-directory-require-files source-path))))
-  (define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))
+  
+  ;; we don't include output-path in path-strings-to-track
+  ;; because we don't want to attach a mod date
+  ;; because cache validity is not sensitive to mod date of output path
+  ;; (in fact we would expect it to be earlier, since we want to rely on an earlier version)
+  (define path-strings-to-track (list* source-path
+                                       ;; if template has a source file, track that instead
+                                       (and template-path (or (get-source template-path) template-path))
+                                       ;; is either list of files or (list #f)
+                                       (->list (get-directory-require-files source-path))))
   (define pollen-env (getenv default-env-name))
+  (define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))
   (define path+mod-time-pairs
-    (for/list ([ps (in-list path-strings)])
-              (cond
-                [ps (define cp (->complete-path ps))
-                    (cons (path->string cp) (file-or-directory-modify-seconds cp #f (λ () 0)))]
-                [else #f])))
-  (list* pollen-env poly-flag path+mod-time-pairs))
+    (for/list ([ps (in-list path-strings-to-track)])
+      (cond
+        [ps (define cp (->complete-path ps))
+            (cons (path->string cp) (file-or-directory-modify-seconds cp #f (λ () 0)))]
+        [else #f])))
+  (list* pollen-env poly-flag (and output-path (path->string output-path)) path+mod-time-pairs))
+
 
+(define (key->source-path key) (car (fourth key)))
 
-(define (key->source-path key) (car (caddr key)))
+(define (key->output-path key) (third key))
 
 
 (module-test-internal
@@ -77,16 +85,28 @@
   (my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
   (values cache-dir private-cache-dir))
 
-(define (cache-ref! key path-hash-thunk)
-  (define path (key->source-path key))
-  (define-values (cache-dir private-cache-dir) (make-cache-dirs path))
-  (define-values (path-dir path-filename _) (split-path path))
-  (define dest-file (build-path cache-dir (format "~a.rktd" path-filename)))
+(define (cache-ref! key path-hash-thunk
+                    #:dest-path [path-for-dest 'source]
+                    #:notify-cache-use [notify-proc void])
+  (define dest-path ((case path-for-dest
+                       [(source) key->source-path]
+                       [(output) key->output-path]) key))
+  (define-values (cache-dir private-cache-dir) (make-cache-dirs dest-path))
+  (define-values (dest-path-dir dest-path-filename _) (split-path dest-path))
+  (define dest-file (build-path cache-dir (format "~a.rktd" dest-path-filename)))
+  (define (fetch-dest-file) (write-to-file (path-hash-thunk) dest-file #:exists 'replace))
+  #|
+`cache-file` looks for a file in private-cache-dir previously cached with key
+(which in this case carries modification dates and POLLEN env).
+If a cached file is found, copies it to dest-file (which must not exist already, unless exists-ok? is true)
+Otherwise, fetch-dest-file is called; if dest-file exists after calling fetch-dest-file,
+it is copied to private-cache-dir and recorded with key.
+|#
   (cache-file dest-file
               #:exists-ok? #t
               key
               private-cache-dir
-              (λ ()
-                (write-to-file (path-hash-thunk) dest-file #:exists 'replace))
+              fetch-dest-file
+              #:notify-cache-use notify-proc
               #:max-cache-size (setup:compile-cache-max-size))
   (file->value dest-file))

pollen/private/ts.rktd

@@ -1 +1 @@
-1509570373
+1509918830

pollen/render.rkt

@@ -80,6 +80,7 @@
       [(pagetree-source? so-path) (render-pagenodes so-path)]))
   (void))
 
+(define render-ram-cache (make-hash))
 
 ;; note that output and template order is reversed from typical
 (define (render-to-file-base caller
@@ -99,7 +100,20 @@
       [(not (setup:render-cache-active source-path)) 'render-cache-deactivated]
       [else #f]))
   (when render-needed?
-    (define render-result (render source-path template-path output-path)) ; will either be string or bytes
+    (define render-result
+      (let ([key (paths->key source-path template-path output-path)])
+      (hash-ref! render-ram-cache
+                 ;; within a session, this will prevent repeat players like "template.html.p"
+                 ;; from hitting the file cache repeatedly
+                 key
+                 (λ () 
+                   (cache-ref! key
+                               (λ () (render source-path template-path output-path))
+                               #:dest-path 'output
+                               #:notify-cache-use
+                               (λ (str)
+                                 (message (format "rendering: /~a (from cache)"
+                                                  (find-relative-path (current-project-root) output-path))))))))) ; will either be string or bytes
     (display-to-file render-result output-path
                      #:exists 'replace
                      #:mode (if (string? render-result) 'text 'binary))))
@@ -134,7 +148,7 @@
   (define render-proc (for/first ([test (in-list tests)]
                                   [render-proc (in-list render-procs)]
                                   #:when (test source-path))
-                                 render-proc))
+                        render-proc))
   (unless render-proc
     (raise-argument-error 'render (format "valid rendering function for ~a" source-path) render-proc))
   
@@ -243,7 +257,7 @@
   (define (file-exists-or-has-source? p) ; p could be #f
     (and p (for/first ([proc (in-list (list identity ->preproc-source-path ->null-source-path))]
                        #:when (file-exists? (proc p)))
-                      p)))
+             p)))
   
   (define (get-template)
     (define source-dir (dirname source-path))