Make rebuilding customizable and avoid catching all exceptions

There are several reasons why `frog.rkt` might not be loadable. We
only want to show a nice warning that users should initialize the
project when the exception is filesystem-related. Other errors like
syntax errors / unbound ids should not be caught.

Improve --watch flag by allowing users to customize whether or not
they want to trigger a rebuild or not. The default behavior is
backward-compatible with the current behavior.

Make --watch withstands exceptions. Beep without new line.

THANKS.md

@@ -12,7 +12,7 @@ Thanks to the following people for contributing pull requests!
 - [Tim Bradshaw](https://github.com/tfeb)
 - [Konrad Hinsen](https://github.com/khinsen)
 - [Leif Andersen](https://github.com/LeifAndersen)
-- [sorawee](https://github.com/sorawee)
+- [Sorawee Porncharoenwase](https://github.com/sorawee)
 - [Jordan Johnson](https://github.com/RenaissanceBug)
 - [Gabriel Scherer](https://github.com/gasche)
 - [Brian Mastenbrook](https://github.com/bmastenbrook)

frog/config/private/load.rkt

@@ -20,7 +20,7 @@
 
         (define (load top)
           (define frog.rkt (build-path top "frog.rkt"))
-          (let ([fn (with-handlers ([exn:fail? cannot-find-frog.rkt])
+          (let ([fn (with-handlers ([exn:fail:filesystem? cannot-find-frog.rkt])
                       (dynamic-require frog.rkt 'id))])
             (when fn (set! id fn))) ...)
         (provide load))))

frog/frog.scrbl

@@ -924,6 +924,19 @@ This may be an absolute or relative path. If relative, it's relative
 to the project top directory, i.e. to where @secref["config"] is
 located.}
 
+@defparam[current-rebuild?
+          rebuild?
+          (path? (or/c 'create 'delete 'modify) . -> . boolean?)]{
+The procedure to test if a file change during a watch needs a rebuild.
+
+If Frog is run with the @tt{-w} or @tt{--watch} flag, @racket[rebuild?] will be invoked
+on every file change (create, delete, modify) in the project. If @racket[rebuild?]
+returns @racket[#f], then Frog will not rebuild the project
+(for this particular change). Otherwise, Frog will rebuild the project.
+
+By default, any file change will trigger a rebuild, except the case where
+the changed file has an extension either @tt{html}, @tt{txt}, or @tt{xml},
+as it is likely that the file will be an output.}
 
 @section[#:tag "body-enhancers"]{Body enhancers}
 

frog/private/main.rkt

@@ -28,7 +28,7 @@
          "serialize-posts.rkt"
          "stale.rkt"
          "tags.rkt"
-         "util.rkt"
+         (except-in "util.rkt" path-get-extension)
          "verbosity.rkt"
          "watch-dir.rkt")
 
@@ -115,10 +115,11 @@
      #:once-each
      [("-w" "--watch")
       (""
-       "(Experimental: Only rebuilds some files.)"
-       "Supply this flag before -s/--serve or -p/--preview."
-       "Watch for changed files, and generate again."
-       "(You'll need to refresh the browser yourself.)")
+       "(Experimental!) Supply this flag before -s/--serve or -p/--preview."
+       "Watch for changed files, and regenerate the project."
+       "(You'll need to refresh the browser yourself.)"
+       "Customize which files should trigger the regeneration"
+       "by using current-rebuild?")
       (set! watch? #t)]
      [("--port") number
       (""
@@ -387,13 +388,11 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (watch-callback path what)
-  (match (path->string path)
-    ;; Output file
-    [(pregexp "\\.(?:html|xml|txt)") (void)]
-    ;; Source file
-    [_ (build)
-       (displayln #"\007")])) ;beep (hopefully)
+(define (watch-callback path change-type)
+  (when ((current-rebuild?) path change-type)
+    (with-handlers ([exn:fail? (compose1 displayln exn->string)])
+      (build))
+    (display #"\007"))) ; beep (hopefully)
 
 (define (serve #:launch-browser? launch-browser?
                #:watch? watch?

frog/private/non-posts.rkt

@@ -13,7 +13,7 @@
          "read-scribble.rkt"
          "stale.rkt"
          "template.rkt"
-         "util.rkt"
+         (except-in "util.rkt" path-get-extension)
          "verbosity.rkt"
          "xexpr2text.rkt")
 

frog/private/params.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require racket/match)
+(require racket/match
+         "./util.rkt")
 
 (provide (all-defined-out))
 
@@ -31,3 +32,7 @@
 (define current-posts-index-uri (make-parameter "/index.html"))
 (define current-source-dir (make-parameter "_src"))
 (define current-output-dir (make-parameter "."))
+(define current-rebuild?
+  (make-parameter
+   (λ (path change-type)
+     (not (member (path-get-extension path) '(#".html" #".txt" #".xml"))))))

frog/private/util.rkt

@@ -15,7 +15,9 @@
          delete-file*
          delete-files*
          in-slice
-         split-common-prefix)
+         split-common-prefix
+         path-get-extension
+         exn->string)
 
 ;; Less typing, and also returns its value so good for sticking in
 ;; threading macros for debugging.
@@ -87,6 +89,35 @@
   (with-handlers ([exn:fail? (λ _ -split-common-prefix)])
     (dynamic-require 'racket/list 'split-common-prefix)))
 
+;; NOTE: these functions are copied from
+;; https://github.com/racket/racket/blob/master/racket/collects/racket/path.rkt
+;; once we decide to drop the support of versions below 6.5, delete them
+;; and switch to use path-get-extension from racket/path instead
+(define (file-name who name dir-ok?)
+  (unless (or (path-string? name)
+              (path-for-some-system? name))
+    (raise-argument-error who "(or/c path-string? path-for-some-system?)" name))
+  (let-values ([(base file dir?) (split-path name)])
+    (and (or dir-ok? (not dir?))
+         (path-for-some-system? file) file)))
+(define (path-get-extension name)
+  (let* ([name (file-name 'path-get-extension name #t)]
+         [name (and name (path->bytes name))])
+    (cond [(and name (regexp-match #rx#"(?<=.)([.][^.]+)$" name)) => cadr]
+          [else #f])))
+
+
+;; NOTE: these functions are copied from
+;; https://github.com/racket/racket/blob/master/racket/collects/racket/exn.rkt
+;; once we decide to drop the support of versions below 6.3, delete them
+;; and switch to use exn->string from racket/exn instead
+(define (exn->string exn)
+  (if (exn? exn)
+      (parameterize ([current-error-port (open-output-string)])
+        ((error-display-handler) (exn-message exn) exn)
+        (get-output-string (current-error-port)))
+      (format "~s\n" exn)))
+
 (module+ test
   (require rackunit)
   (define-syntax-rule (check-equal-values? generating-expr expected)