From 21a46b546d804cbc6eed2a427fb66333bd884b3a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 25 Jul 2015 19:56:51 -0700 Subject: [PATCH] change to file-based compile cache (closes #70) --- cache.rkt | 76 ++++++++++------------ command.rkt | 12 ++-- scribblings/world.scrbl | 6 +- server.rkt | 3 +- test/data/escape-ext/directory-require.rkt | 1 + test/data/escape-ext/test.html | 1 - test/test-escape-ext.rkt | 2 +- world.rkt | 6 +- 8 files changed, 53 insertions(+), 54 deletions(-) delete mode 100644 test/data/escape-ext/test.html diff --git a/cache.rkt b/cache.rkt index 5853c22..5f4790f 100644 --- a/cache.rkt +++ b/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) - (build-path (world:current-project-root) (world:current-cache-filename))) +(define (get-cache-dir) + (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)) - (when (file-exists? cache-path) - (delete-file cache-path)) - (current-cache (make-cache))) + (cache-remove #f (get-cache-dir))) -(define (->complete-path path-string) - (path->complete-path (if (string? path-string) (string->path path-string) path-string))) -(define (cache-ref path-string) - (hash-ref (current-cache) (->complete-path path-string))) +(define (path->key source-path [template-path #f]) + ;; 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)) - (define cache-hash (cache-ref path)) - (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)))) + (hash (world:current-main-export) (dynamic-require path (world:current-main-export)) + (world:current-meta-export) (dynamic-require path (world:current-meta-export)))) + + +(define (cached-require path-string subkey) + (define path (with-handlers ([exn:fail? (λ _ (error 'cached-require (format "~a is not a valid path" path-string)))]) + (->complete-path path-string))) - (when (or (not (cache-has-key? path)) - (> (file-or-directory-modify-seconds path) (hash-ref (cache-ref path) 'mod-time))) - (cache path)) + (when (not (file-exists? path)) + (error (format "cached-require: ~a does not exist" path))) - (hash-ref (cache-ref path) key)) \ No newline at end of file + (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)])) diff --git a/command.rkt b/command.rkt index 6e3d7fa..0f9c05c 100644 --- a/command.rkt +++ b/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)) - (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))))) + (when (not (directory-exists? directory)) + (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 ...") + ((dynamic-require 'pollen/server 'start-server)))) (define (handle-publish directory rest-args arg-command-name) diff --git a/scribblings/world.scrbl b/scribblings/world.scrbl index 927131a..78d0cff 100644 --- a/scribblings/world.scrbl +++ b/scribblings/world.scrbl @@ -125,4 +125,8 @@ 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.} \ No newline at end of file +@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.} \ No newline at end of file diff --git a/server.rkt b/server.rkt index 181f8bd..31b7f14 100755 --- a/server.rkt +++ b/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] - [current-cache (make-cache)]) + (parameterize ([error-print-width 1000]) (serve/servlet pollen-servlet #:port (world:current-server-port) #:listen-ip #f diff --git a/test/data/escape-ext/directory-require.rkt b/test/data/escape-ext/directory-require.rkt index 7ee746d..9459bdf 100644 --- a/test/data/escape-ext/directory-require.rkt +++ b/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 #\$)) \ No newline at end of file diff --git a/test/data/escape-ext/test.html b/test/data/escape-ext/test.html deleted file mode 100644 index 30d74d2..0000000 --- a/test/data/escape-ext/test.html +++ /dev/null @@ -1 +0,0 @@ -test \ No newline at end of file diff --git a/test/test-escape-ext.rkt b/test/test-escape-ext.rkt index c4bac02..06fec1c 100644 --- a/test/test-escape-ext.rkt +++ b/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)) diff --git a/world.rkt b/world.rkt index 105a906..3bb9ac1 100644 --- a/world.rkt +++ b/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))) @@ -81,4 +82,7 @@ (define-settable publish-directory-name "publish") -(define-settable extension-escape-char #\!) \ No newline at end of file +(define-settable extension-escape-char #\!) + +(define-settable compile-cache-active #t) +(define-settable compile-cache-max-size (* 5 1024 1024)) ; = 5 megabytes \ No newline at end of file