change to file-based compile cache (closes #70)

cache.rkt

@@ -1,58 +1,50 @@
 #lang racket/base
-(require racket/rerequire racket/serialize racket/file "world.rkt")
+(require racket/path racket/function racket/file file/cache sugar/coerce "project.rkt"  "world.rkt" racket/rerequire "debug.rkt")
 
 ;; The cache is a hash with paths as keys.
 ;; The cache values are also hashes, with key/value pairs for that path.
 
-(provide reset-cache current-cache make-cache cached-require cache-ref)
+(provide reset-cache cached-require path->key path->hash)
+(provide (all-from-out racket/rerequire))
 
-(define (get-cache-file-path)
+(define (get-cache-dir)
-  (build-path (world:current-project-root) (world:current-cache-filename)))
+  (build-path (world:current-project-root) (world:current-cache-dir-name)))
 
-(define (make-cache) 
-  (define cache-file-path (get-cache-file-path))
-  (if (file-exists? cache-file-path)
-      (deserialize (file->value cache-file-path))
-      (make-hash)))
-
-(define current-cache (make-parameter (make-cache)))
 
 (define (reset-cache)
-  (define cache-path (get-cache-file-path))
+  (cache-remove #f (get-cache-dir)))
-  (when (file-exists? cache-path)
-    (delete-file cache-path))
-  (current-cache (make-cache)))
 
-(define (->complete-path path-string)
-  (path->complete-path (if (string? path-string) (string->path path-string) path-string)))
 
-(define (cache-ref path-string)
+(define (path->key source-path [template-path #f])
-  (hash-ref (current-cache) (->complete-path path-string)))
+  ;; key is list of file + mod-time pairs
+  (define path-strings (map (compose1 ->string ->complete-path)
+                     (append (list source-path)
+                           (if template-path (list template-path) null)
+                           (or (get-directory-require-files source-path) null))))
+  (map cons path-strings (map file-or-directory-modify-seconds path-strings)))
 
-(define (cache-has-key? path)
-  (hash-has-key? (current-cache) path))
 
-(define (cache path)  
+(define (path->hash path)
   (dynamic-rerequire path)
-  (hash-set! (current-cache) path (make-hash))
+  (hash (world:current-main-export) (dynamic-require path (world:current-main-export))
-  (define cache-hash (cache-ref path))
+         (world:current-meta-export) (dynamic-require path (world:current-meta-export))))
-  (hash-set! cache-hash 'mod-time (file-or-directory-modify-seconds path))
-  (hash-set! cache-hash (world:current-main-export) (dynamic-require path (world:current-main-export)))
-  (hash-set! cache-hash (world:current-meta-export) (dynamic-require path (world:current-meta-export)))
-  (write-to-file (serialize (current-cache)) (get-cache-file-path) #:exists 'replace)
-  (void))
-
-(define (cached-require path-string key)
-  (when (not (current-cache)) (error 'cached-require "No cache set up."))
-  
-  (define path 
-    (with-handlers ([exn:fail? (λ(exn) (error 'cached-require (format "~a is not a valid path" path-string)))])
-      (->complete-path path-string)))  
 
-  (when (not (file-exists? path)) (error (format "cached-require: ~a does not exist" (path->string path))))
 
-  (when (or (not (cache-has-key? path))
+(define (cached-require path-string subkey)
-            (> (file-or-directory-modify-seconds path) (hash-ref (cache-ref path) 'mod-time)))
+  (define path (with-handlers ([exn:fail? (λ _ (error 'cached-require (format "~a is not a valid path" path-string)))])
-    (cache path))
+                 (->complete-path path-string)))
   
-  (hash-ref (cache-ref path) key))
+  (when (not (file-exists? path))
+    (error (format "cached-require: ~a does not exist" path)))
+  
+  (cond
+    [(world:current-compile-cache-active)
+     (define pickup-file (build-path (get-cache-dir) "pickup.rktd"))
+     (cache-file pickup-file #:exists-ok? #t
+                 (path->key path)
+                 (get-cache-dir)
+                 (λ _ (write-to-file (path->hash path) pickup-file #:exists 'replace))
+                 #:max-cache-size (world:current-compile-cache-max-size))
+     (hash-ref (file->value pickup-file) subkey)]
+    [else ; cache inactive
+     (dynamic-require path subkey)]))

command.rkt

@@ -60,7 +60,6 @@ version                print the version (~a)" (world:current-server-port) (worl
 
 (define (handle-render path-args)
   (parameterize ([current-directory (world:current-project-root)])
-    ((dynamic-require 'pollen/cache 'reset-cache))
     (define first-arg (car path-args))
     (if (directory-exists? first-arg)
         (let ([dir first-arg]) ; now we know it's a dir
@@ -86,11 +85,12 @@ version                print the version (~a)" (world:current-server-port) (worl
           (apply (dynamic-require 'pollen/render 'render-batch) path-args)))))
 
 (define (handle-start directory [port #f])
-  (if (not (directory-exists? directory))
+  (when (not (directory-exists? directory))
-      (error (format "~a is not a directory" directory))
+    (error (format "~a is not a directory" directory)))
   (parameterize ([world:current-project-root directory]
                  [world:current-server-port (or port world:default-port)])
-        ((dynamic-require 'pollen/server 'start-server)))))
+    (displayln "Starting project server ...")
+    ((dynamic-require 'pollen/server 'start-server))))
 
 
 (define (handle-publish directory rest-args arg-command-name)

scribblings/world.scrbl

@@ -126,3 +126,7 @@ Default separators used in decoding. The first two are initialized to @racket["\
 @defoverridable[dashboard-css string?]{CSS file used for the dashboard. Initialized to @filepath{poldash.css}.}
 
 @defoverridable[paths-excluded-from-dashboard (listof path?)]{Paths not shown in the Pollen dashboard.}
+
+@defoverridable[compile-cache-active boolean?]{Whether the compile cache, which speeds up interactive sessions by saving compiled versions of Pollen source files, is active. Default is active (@racket[#t]).}
+
+@defoverridable[compile-cache-max-size exact-positive-integer?]{Maximum size of the compile cache. Default is five megabytes.}

server.rkt

@@ -28,8 +28,7 @@
   (message (format "Project dashboard is ~a/~a" server-name (world:current-default-pagetree)))
   (message "Ready to rock")
     
-  (parameterize ([error-print-width 1000]
+  (parameterize ([error-print-width 1000])
-                 [current-cache (make-cache)])
     (serve/servlet pollen-servlet
                    #:port (world:current-server-port)
                    #:listen-ip #f

test/data/escape-ext/directory-require.rkt

@@ -3,4 +3,5 @@
 
 (module config racket/base
   (provide (all-defined-out))
+  (define compile-cache-active #f)
   (define extension-escape-char #\$))

test/data/escape-ext/test.html

@@ -1 +0,0 @@
-test

test/test-escape-ext.rkt

@@ -4,6 +4,7 @@
 ;; define-runtime-path only allowed at top level
 (define-runtime-path test-dir "data/escape-ext")
 (define-runtime-path test-file "data/escape-ext/test$html.pp")
+(define-runtime-path result-file "data/escape-ext/test.html")
 
 ;; `find-exe` avoids reliance on $PATH of the host system
 (define racket-path (find-exe))
@@ -14,7 +15,6 @@
     ;; need to cd first to pick up directory require correctly
     (define cmd-string (format "cd '~a' ; '~a' pollen render '~a'" test-dir raco-path path))
     (with-output-to-string (λ() (system cmd-string))))
-  (define result-file (build-path test-dir "test.html"))
   (when (file-exists? result-file) (delete-file result-file))
   (render test-file)
   (check-true (file-exists? result-file))

world.rkt

@@ -44,6 +44,7 @@
 (define mode-template 'template)
 
 (define-settable cache-filename "pollen.cache")
+(define-settable cache-dir-name "pollen-cache")
 
 (define-settable decodable-extensions (list (current-markup-source-ext) (current-pagetree-source-ext)))
 
@@ -82,3 +83,6 @@
 (define-settable publish-directory-name "publish")
 
 (define-settable extension-escape-char #\!)
+
+(define-settable compile-cache-active #t)
+(define-settable compile-cache-max-size (* 5 1024 1024)) ; = 5 megabytes