runner+cli: add --watch-{pattern,exclude} flags

koyo-lib/koyo/cli.rkt

@@ -16,7 +16,8 @@
          "console.rkt"
          "generator.rkt"
          "logging.rkt"
-         "runner.rkt")
+         "runner.rkt"
+         (submod "runner.rkt" private))
 
 (define-logger koyo)
 
@@ -40,12 +41,9 @@
      (lambda (p)
        (equal? (file-name-from-path p)
                (string->path "dynamic.rkt")))))
-
-  (match files
-    [(list f0 f ...) f0]
-
-    [(list)
-     (exit-with-errors! "error: could not find a dynamic.rkt module in the current directory")]))
+  (if (pair? files)
+      (car files)
+      (exit-with-errors! "error: could not find a dynamic.rkt module in the current directory")))
 
 (define (infer-project-name dmp)
   (path->string
@@ -189,7 +187,9 @@
        [(not (regexp-match-exact? #rx"[-_a-zA-Z0-9]*" name))
         (exit-with-errors! @~a{error: '@name' cannot be used as project name (invalid collection name)})]
        [(or (directory-exists? name) (file-exists? name))
-        (exit-with-errors! @~a{error: a file called '@name' already exists in the current directory})])
+        (exit-with-errors! @~a{error: a file called '@name' already exists in the current directory})]
+       [else
+        (void)])
 
      name))
 
@@ -242,54 +242,87 @@
   (define recompile? #t)
   (define errortrace? #f)
   (define server-timeout 30)
+  (define watch-patterns null)
+  (define watch-excludes null)
+  (define watch-verbose? #f)
   (define dynamic-module-path
     (command-line
      #:program (current-program-name)
+     #:multi
+     [("--watch-pattern")
+      PATTERN-RE "a regular expression to include files & folders in the watched set"
+      (set! watch-patterns (cons (regexp PATTERN-RE) watch-patterns))]
+     [("--watch-exclude")
+      PATTERN-RE "a regular expression to exclude files & folders from the watched set"
+      (set! watch-excludes (cons (regexp PATTERN-RE) watch-excludes))]
      #:once-each
-     [("--errortrace") "run the application with errortrace"
-                       (set! errortrace? #t)]
-     [("--disable-recompile") "don't recompile changed files on reload"
-                              (set! recompile? #f)]
-     [("--server-timeout") t "server startup timeout in seconds"
-                           (set! server-timeout (or (string->number t) server-timeout))]
+     [("--errortrace")
+      "run the application with errortrace"
+      (set! errortrace? #t)]
+     [("--disable-recompile")
+      "don't recompile changed files on reload"
+      (set! recompile? #f)]
+     [("--server-timeout")
+      t "server startup timeout in seconds"
+      (set! server-timeout (or (string->number t) server-timeout))]
+     [("--log-watched-files")
+      "log which files get watched according to --watch-pattern and --watch-exclude"
+      (set! watch-verbose? #t)]
      #:args ([dynamic-module-path #f])
      (if dynamic-module-path
          (string->path dynamic-module-path)
          (infer-dynamic-module-path))))
 
+  (define watch-file?-proc
+    (if (and (null? watch-patterns)
+             (null? watch-excludes))
+        watch-file?
+        (lambda (p)
+          (define watch?
+            (and
+             (ormap (λ (re) (regexp-match? re p)) watch-patterns)
+             (not (ormap (λ (re) (regexp-match? re p)) watch-excludes))))
+          (begin0 watch?
+            (when (and watch? watch-verbose?)
+              (let ([t (if (directory-exists? p) "directory" "file")])
+                (log-watcher-debug "watching ~a ~a" t p)))))))
+
   (run-forever
    #:recompile? recompile?
    #:errortrace? errortrace?
    #:server-timeout server-timeout
+   #:watch-file?-proc watch-file?-proc
    (path->complete-path dynamic-module-path)))
 
 (define ((handle-unknown command))
   (exit-with-errors! @~a{error: unrecognized command '@command'}))
 
-;; TODO: Make it possible to control the verbosity?
-(define stop-logger
-  (start-logger #:levels '((koyo    . debug)
-                           (runner  . debug)
-                           (watcher . debug))))
-
-(define all-commands
-  (hasheq 'console  handle-console
-          'dist     handle-dist
-          'generate handle-generate
-          'graph    handle-graph
-          'help     handle-help
-          'new      handle-new
-          'serve    handle-serve))
-
-(define-values (command handler args)
-  (match (current-command-line-arguments)
-    [(vector command args ...)
-     (values command (hash-ref all-commands (string->symbol command) (handle-unknown command)) args)]
-
-    [_
-     (values "help" handle-help null)]))
-
-(parameterize ([current-command-line-arguments (list->vector args)]
-               [current-program-name (~a (current-program-name) " " command)])
-  (handler)
-  (stop-logger))
+(module+ main
+  ;; TODO: Make it possible to control the verbosity?
+  (define stop-logger
+    (start-logger
+     #:levels
+     '((koyo    . debug)
+       (runner  . debug)
+       (watcher . debug))))
+
+  (define all-commands
+    (hasheq 'console  handle-console
+            'dist     handle-dist
+            'generate handle-generate
+            'graph    handle-graph
+            'help     handle-help
+            'new      handle-new
+            'serve    handle-serve))
+
+  (define-values (command handler args)
+    (match (current-command-line-arguments)
+      [(vector command args ...) ;; noqa
+       (values command (hash-ref all-commands (string->symbol command) (handle-unknown command)) args)]
+      [_
+       (values "help" handle-help null)]))
+
+  (parameterize ([current-command-line-arguments (list->vector args)]
+                 [current-program-name (~a (current-program-name) " " command)])
+    (handler)
+    (stop-logger)))

koyo-lib/koyo/info.rkt

@@ -1,4 +1,4 @@
 #lang info
 
 (define test-omit-paths '("cli.rkt"))
-(define raco-commands '(("koyo" koyo/cli "run koyo scripts" #f)))
+(define raco-commands '(("koyo" (submod koyo/cli main) "run koyo scripts" #f)))

koyo-lib/koyo/runner.rkt

@@ -16,13 +16,14 @@
    (->* [path-string?]
         [#:recompile? boolean?
          #:errortrace? boolean?
-         #:server-timeout (and/c real? positive?)]
+         #:server-timeout (and/c real? positive?)
+         #:watch-file?-proc (-> (or/c path? path-string?) boolean?)]
         void?)]))
 
 (define-logger runner)
 (define-logger watcher)
 
-(define (track-file? p)
+(define (watch-file? p)
   (if (directory-exists? p)
       (match/values (split-path p)
         [(_ (app path->string (regexp "^\\.")) _) #f]
@@ -35,26 +36,37 @@
         [(#".html" #".sql")        #t]
         [else                      #f])))
 
-(define (collect-tracked-files path)
-  (map simplify-path (find-files track-file? path #:skip-filtered-directory? #t)))
-
-(define (code-change-evt root-path)
-  (apply
-   choice-evt
-   (for/list ([p (in-list (collect-tracked-files root-path))] #:when (file-exists? p))
-     (define chg (filesystem-change-evt p))
-     (nack-guard-evt
-      (lambda (nack)
-        (thread
-         (lambda ()
-           (sync nack)
-           (filesystem-change-evt-cancel chg)))
-        (handle-evt chg (λ (_) p)))))))
+(module+ private
+  (provide log-watcher-debug watch-file?))
+
+(define (code-change-evt root-path watch?)
+  (let ([root-path (simplify-path root-path)])
+    (apply
+     choice-evt
+     (for/list ([p (in-list
+                    (find-files
+                     #:skip-filtered-directory? #t
+                     (lambda (p)
+                       (or
+                        (equal? p root-path)
+                        (watch? p)))
+                     root-path))]
+                #:when (file-exists? p))
+       (define chg
+         (filesystem-change-evt p))
+       (nack-guard-evt
+        (lambda (nack)
+          (thread
+           (lambda ()
+             (sync nack)
+             (filesystem-change-evt-cancel chg)))
+          (handle-evt chg (λ (_) p))))))))
 
 (define (run-forever dynamic-module-path
                      #:recompile? [recompile? #t]
                      #:errortrace? [errortrace? #t]
-                     #:server-timeout [server-timeout 30])
+                     #:server-timeout [server-timeout 30]
+                     #:watch-file?-proc [watch-file? watch-file?]) ;; noqa
   (file-stream-buffer-mode (current-output-port) 'line)
   (file-stream-buffer-mode (current-error-port) 'line)
   (maximize-fd-limit!
@@ -152,10 +164,10 @@
             (lambda (status)
               (when (eq? status 'done-error)
                 (log-runner-warning "application process failed; waiting for changes before reloading")
-                (sync (code-change-evt root-path)))
+                (sync (code-change-evt root-path watch-file?)))
               (process-loop)))
            (handle-evt
-            (code-change-evt root-path)
+            (code-change-evt root-path watch-file?)
             (lambda (changed-path)
               (reload changed-path)
               (unless (symbol? (sync/timeout 0 stopped-evt))
@@ -178,7 +190,7 @@
   (define-values (root-path dynamic-module-path)
     (command-line
      #:program "raco koyo serve"
-     #:args (root-path dynamic-module-path)
+     #:args [root-path dynamic-module-path]
      (values root-path dynamic-module-path)))
 
   (define (display-exn e)