From 1bc58699c107ed672b38e2ae9d7dac51ca1d92be Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 26 Aug 2015 14:13:50 -0700 Subject: [PATCH] add `raco pollen setup` with cache preheating --- cache.rkt | 116 +++++++++++++++++++++++++++++------------ command.rkt | 28 ++++++---- scribblings/raco.scrbl | 34 ++++++++---- world.rkt | 2 +- 4 files changed, 126 insertions(+), 54 deletions(-) diff --git a/cache.rkt b/cache.rkt index 01d0668..19eb212 100644 --- a/cache.rkt +++ b/cache.rkt @@ -1,24 +1,74 @@ #lang racket/base -(require racket/path racket/file compiler/cm file/cache sugar/coerce "project.rkt" "world.rkt" "rerequire.rkt" "cache-ns.rkt" "debug.rkt") +(require racket/path racket/file compiler/cm file/cache sugar/coerce sugar/list "project.rkt" "world.rkt" "rerequire.rkt" "cache-ns.rkt" "debug.rkt" "file.rkt" racket/place) ;; 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 cached-require paths->key) +(provide reset-cache preheat-cache cached-require paths->key) -(define (get-cache-dir) - (build-path (world:current-project-root) (world:current-cache-dir-name))) - - -(define (reset-cache) - (for ([path (in-directory)] +(define (reset-cache [starting-dir (world:current-project-root)]) + (when (or (not (path-string? starting-dir)) (not (directory-exists? starting-dir))) + (error 'reset-cache (format "~a is not a directory" starting-dir))) + (for ([path (in-directory starting-dir)] #: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 (preheat-cache [starting-dir (world:current-project-root)]) + (when (or (not (path-string? starting-dir)) (not (directory-exists? starting-dir))) + (error 'preheat-cache (format "~a is not a directory" starting-dir))) + + (define max-places 8) ; number of parallel processes to spawn at a time + + (define paths-that-should-be-cached (for/list ([path (in-directory starting-dir)] + #:when (or (preproc-source? path) + (markup-source? path) + (markdown-source? path) + (pagetree-source? path))) + path)) + + ;; if a file is already in the cache, no need to hit it again. + ;; this allows partially completed preheat jobs to resume. + (define uncached-paths (filter + (λ(path) + ;; #t = not cached; #f = already cached + ;; seems like it would be slow to load cache.rktd but it's not. + (define-values (_ private-cache-dir) (make-cache-dirs path)) + (define cache-db-file (build-path private-cache-dir "cache.rktd")) + (cond + [(not (file-exists? cache-db-file)) #t] + [else (define cache-db (file->value cache-db-file)) + (not (hash-has-key? cache-db (paths->key path)))])) paths-that-should-be-cached)) + + ;; compile a path inside a place (= parallel processing) + (define (path-into-place path) + (message (format "caching: ~a" (find-relative-path starting-dir path))) + (define p (place ch + (define path (place-channel-get ch)) + (define-values (path-dir path-name _) (split-path path)) + (message (format "compiling: ~a" path-name)) + ;; use #f to signal compile error. Otherwise allow errors to pass. + (define result (with-handlers ([exn:fail? (λ _ (message "~a failed" path-name) #f)]) + (path->hash path))) + (place-channel-put ch result))) + (place-channel-put p path) + p) + + ;; compile the paths in groups, so they can be incrementally saved. + ;; that way, if there's a failure, the progress is preserved. + ;; but the slowest file in a group will prevent further progress. + (for ([path-group (in-list (slice-at uncached-paths max-places))]) + (define path-places (map path-into-place path-group)) + (for ([path (in-list path-group)] + [ppl (in-list path-places)]) + (define result (place-channel-get ppl)) + (when result ; #f is used to signal compile error + (cache-ref! (paths->key path) (λ _ result)))))) + + (define (paths->key source-path [template-path #f]) ;; key is list of file + mod-time pairs, use #f for missing (define path-strings (append (list source-path) @@ -42,11 +92,12 @@ ;; otherwise it gets cached in current namespace. (define drfs (get-directory-require-files path)) (for-each managed-compile-zo (or drfs null)) - + (define-values (path-dir path-name _) (split-path path)) (apply hash (let ([doc-key (world:current-main-export)] [meta-key (world:current-meta-export)]) - (parameterize ([current-namespace (make-base-namespace)]) + (parameterize ([current-namespace (make-base-namespace)] + [current-directory path-dir]) ;; I monkeyed around with using the metas submodule to pull out the metas (for speed) ;; but in practice most files get their doc requested too. ;; so it's just simpler to get both at once and be done with it. @@ -54,7 +105,7 @@ ;; the benefit of not reloading doc when you just need metas. (list doc-key (dynamic-require path doc-key) meta-key (dynamic-require path meta-key)))))) -;; include this from 6.2 for compatibility back to 6.0 (formerly `make-parent-directory*`) + (define (my-make-directory* dir) (let-values ([(base name dir?) (split-path dir)]) (when (and (path? base) (not (directory-exists? base))) @@ -63,16 +114,30 @@ (with-handlers ([exn:fail:filesystem:exists? void]) (make-directory dir))))) -(define (my-make-parent-directory* p) - (unless (path-string? p) - (raise-argument-error 'make-parent-directory "path-string?" p)) - (define-values (base name dir?) (split-path p)) - (when (path? base) - (my-make-directory* base))) - +(define (make-cache-dirs path) + (define-values (path-dir path-filename _) (split-path path)) + (define cache-dir (build-path path-dir (world:current-cache-dir-name))) + (define private-cache-dir (build-path cache-dir "private")) + (my-make-directory* private-cache-dir) ; will also make cache-dir, if needed + (values cache-dir private-cache-dir)) (define ram-cache (make-hash)) + +(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))) + (cache-file dest-file + #:exists-ok? #t + key + private-cache-dir + (λ _ + (write-to-file (path-hash-thunk) dest-file #:exists 'replace)) + #:max-cache-size (world:current-compile-cache-max-size)) + (file->value dest-file)) + (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))) @@ -83,20 +148,7 @@ (cond [(world:current-compile-cache-active) (define key (paths->key path)) - (define cache-dir (get-cache-dir)) - (define private-cache-dir (build-path cache-dir "private")) - ;; cache-dir is also inside current-project-root. So there is a separate pollen-cache in each subdir. - (define dest-file (build-path cache-dir (format "~a.rktd" (find-relative-path (world:current-project-root) path)))) - (my-make-parent-directory* dest-file) - (my-make-directory* private-cache-dir) (hash-ref (hash-ref! ram-cache key (λ _ - (cache-file dest-file - #:exists-ok? #t - key - private-cache-dir - (λ _ - (write-to-file (path->hash path) dest-file #:exists 'replace)) - #:max-cache-size (world:current-compile-cache-max-size)) - (file->value dest-file))) subkey)] + (cache-ref! key (λ _ (path->hash path))))) subkey)] [else (parameterize ([current-namespace (make-base-namespace)]) (dynamic-require path subkey))])) \ No newline at end of file diff --git a/command.rkt b/command.rkt index 927abb1..30a89c0 100644 --- a/command.rkt +++ b/command.rkt @@ -32,7 +32,8 @@ (map very-nice-path (cddr clargs)) null))))] [("version") (handle-version)] - [("reset") (handle-reset)] + [("reset") (handle-reset (get-first-arg-or-current-dir))] + [("setup") (handle-setup (get-first-arg-or-current-dir))] [("clone" "publish") (define rest-args (with-handlers ([exn:fail? (λ _ #f)]) (cddr (vector->list (current-command-line-arguments))))) @@ -56,16 +57,23 @@ render filename render filename only (can be source or output name) publish copy project to desktop without source files publish [dir] [dest] copy project in dir to dest without source files (warning: overwrites existing dest dir) -reset reset compile cache +setup preload cache +reset reset cache version print the version (~a)" (world:current-server-port) (world:current-pollen-version)))) (define (handle-version) (displayln (world:current-pollen-version))) -(define (handle-reset) + +(define (handle-reset directory-maybe) (displayln "resetting cache ...") - ((dynamic-require 'pollen/cache 'reset-cache))) + ((dynamic-require 'pollen/cache 'reset-cache) directory-maybe)) + + +(define (handle-setup directory-maybe) + (displayln "preheating cache ...") + ((dynamic-require 'pollen/cache 'preheat-cache) directory-maybe)) (define (handle-render path-args) @@ -94,16 +102,16 @@ version print the version (~a)" (world:current-server-port) (worl (displayln (format "rendering ~a" (string-join (map ->string path-args) " "))) (apply render-batch path-args))))) -(define (handle-start directory [port #f]) - (when (not (directory-exists? directory)) - (error (format "~a is not a directory" directory))) - (parameterize ([world:current-project-root directory] +(define (handle-start directory-maybe [port #f]) + (when (not (directory-exists? directory-maybe)) + (error (format "~a is not a directory" directory-maybe))) + (parameterize ([world:current-project-root directory-maybe] [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) +(define (handle-publish directory-maybe rest-args arg-command-name) (define target-path (or (and rest-args (not (null? rest-args)) (path->complete-path (string->path (car rest-args)))) @@ -120,7 +128,7 @@ version print the version (~a)" (world:current-server-port) (worl (andmap equal? prefix (take xs (length prefix))))) ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir))) - (define source-dir (simplify-path directory)) + (define source-dir (simplify-path directory-maybe)) (when (not (directory-exists? source-dir)) (error 'publish (format "source directory ~a does not exist" source-dir))) (define target-dir (simplify-path target-path)) diff --git a/scribblings/raco.scrbl b/scribblings/raco.scrbl index f770a66..a14c46e 100644 --- a/scribblings/raco.scrbl +++ b/scribblings/raco.scrbl @@ -13,14 +13,14 @@ Racket provides centralized command-line options through @exec{raco} (short for Once you install Pollen, you can access the following Pollen-specific commands through @racket[raco] using the subcommand @exec{raco pollen}. -@section{Making sure @racket[raco pollen] works} +@section{Making sure @exec{raco pollen} works} Open a terminal window and type: @terminal{ > raco pollen test} -If @racket[raco pollen] is installed correctly, you'll see: +If @exec{raco pollen} is installed correctly, you'll see: @terminal{raco pollen is installed correctly} @@ -36,16 +36,16 @@ If your error is like this: You have a deeper problem with your Racket installation (often a misconfiguration of @code{PATH}). -@section{@racket[raco pollen]} +@section{@exec{raco pollen}} -Same as @racket[raco pollen help]. +Same as @exec{raco pollen help}. -@section{@racket[raco pollen help]} +@section{@exec{raco pollen help}} Displays a list of available commands. -@section{@racket[raco pollen start]} +@section{@exec{raco pollen start}} Start the project server from the current directory using the default port, which is the value of the parameter @racket[world:current-server-port] (by default, port @(format "~a" world:default-port)). @@ -67,7 +67,7 @@ If you want to start in the current directory but with a different port, use @li @terminal{ > raco pollen start . 8088} -@section{@racket[raco pollen render]} +@section{@exec{raco pollen render}} Render all preprocessor source files and then all pagetree files found in the current directory. If none of these files are found, a pagetree will be generated for the directory (which will include all source files) and then rendered. @@ -83,7 +83,7 @@ Alternatively, the command can take a variable number of path arguments. @racket > raco pollen render *.html.pm} -@section{@racket[raco pollen publish]} +@section{@exec{raco pollen publish}} Make a copy of the project directory on the desktop, but without any source files or other Pollen-related files. (This function is pretty lame, and I invite suggestions for improvement.) @@ -93,11 +93,23 @@ Make a copy of the project directory on the desktop, but without any source file If you're already in your project directory and want to publish somewhere other than the desktop, use @racket[raco pollen publish _. _dest-dir]. -@section{@racket[raco pollen reset]} +You can determine the files that get filtered out in a particular project by using @racket[world:current-unpublished-path?]. -Resets Pollen's compile cache. Resetting does not delete the compile cache, but rather just zeroes out the cache database. On the next run, obsolete cache files will be deleted. -@section{@racket[raco pollen version]} +@section{@exec{raco pollen setup}} + +Finds Pollen source files in the current directory, compiles them, and loads the results into the @seclink["Cache" #:doc '(lib "pollen/scribblings/pollen.scrbl")]. This will give you the snappiest performance during an interactive session with the project server. + +Can also be invoked as @racket[raco pollen setup _directory], which will set up a different project @racket[_directory]. + + +@section{@exec{raco pollen reset}} + +Resets Pollen's @seclink["Cache" #:doc '(lib "pollen/scribblings/pollen.scrbl")] by deleting the cache directories. + +Can also be invoked as @racket[raco pollen reset _directory], which will reset a different project @racket[_directory]. + +@section{@exec{raco pollen version}} Would you believe this prints the Pollen version number. diff --git a/world.rkt b/world.rkt index b82b418..f51e260 100644 --- a/world.rkt +++ b/world.rkt @@ -36,7 +36,7 @@ (define current-name (λ _ (with-handlers ([exn:fail? fail-thunk-name]) (dynamic-require `(submod ,(get-path-to-override) config-submodule) 'base-name fail-thunk-name))))))])) -(define-settable pollen-version "0.001") +(define-settable pollen-version "0.1508") (define-settable preproc-source-ext 'pp) (define-settable markup-source-ext 'pm)