add `raco pollen setup` with cache preheating

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))]))

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))

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.
 

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)