Exclude compiled and exclude optional exclude list.

.gitignore

@@ -15,3 +15,6 @@ compiled/
 # Dependency tracking files
 *.dep
 
+/scribblings/*.css
+/scribblings/*.js
+/scribblings/*.html

README.md

@@ -17,12 +17,27 @@ For a directory named `racket-upnp` with version `"5.0"`, it creates:
 The ZIP recursively contains the package files, except for:
 
 - `.git`
+- `compiled`
 - names ending in `~`
 - names ending in `.bak`
-- `.html`, `.js`, and `.css` files below `scribblings` or `scribbles`
+- `.html`, `.js`, and `.css` files below `scribblings`, `scribbles`, or `scrbl`
 
-The comparisons for `.bak` and the Scribble web extensions are
+The built-in directory and extension comparisons are case-insensitive.
-case-insensitive.
+
+Additional exclusions can be supplied with `#:exclude`:
+
+```racket
+(zip-package
+ #:exclude
+ (list "tmp"
+       (string->path "examples/generated")
+       #rx"^tests/data/"))
+```
+
+An exclusion string matches a file or directory name anywhere in the relative
+path. A path value matches that relative path and everything below it. A regular
+expression is matched against the complete relative path, using `/` as the path
+separator. Custom string and path comparisons are case-sensitive.
 
 Install this source directory as a linked package during development:
 

info.rkt

@@ -11,4 +11,4 @@
   '(("scribblings/package-zipper.scrbl" ())))
 (define pkg-desc
   "Create a clean, versioned ZIP archive of the current Racket package.")
-(define version "0.1")
+(define version "0.2")

main.rkt

@@ -9,6 +9,9 @@
 
 (provide zip-package)
 
+(define excluded-directory-names
+  '(".git" "compiled"))
+
 (define scribble-directory-names
   '("scribblings" "scribbles" "scrbl"))
 
@@ -18,18 +21,52 @@
 (define (path-component-strings path)
   (for/list ([part (in-list (explode-path path))]
              #:when (path? part))
-    (string-downcase (path-element->string part))))
+    (path-element->string part)))
 
 (define (string-in? value strings)
   (for/or ([candidate (in-list strings)])
     (string=? value candidate)))
 
-(define (excluded-path? path)
+(define (path-prefix? prefix components)
+  (and (<= (length prefix) (length components))
+       (equal? prefix (take components (length prefix)))))
+
+(define (relative-path-string components)
+  (string-join components "/"))
+
+(define (regexp-matches? rx value)
+  (if (byte-regexp? rx)
+      (regexp-match? rx (string->bytes/utf-8 value))
+      (regexp-match? rx value)))
+
+(define (custom-excluded-path? path exclude)
   (define components (path-component-strings path))
+  (define path-string (relative-path-string components))
+
+  (for/or ([entry (in-list exclude)])
+    (cond
+      ;; A string matches a file or directory name anywhere in the path.
+      [(string? entry)
+       (string-in? entry components)]
+
+      ;; A path matches that relative path and everything below it.
+      [(path? entry)
+       (path-prefix?
+        (path-component-strings (simplify-path entry #f))
+        components)]
+
+      ;; A regexp is applied to a platform-independent relative path.
+      [else
+       (regexp-matches? entry path-string)])))
+
+(define (excluded-path? path exclude)
+  (define components (path-component-strings path))
+  (define lower-components
+    (map string-downcase components))
   (define name
-    (if (null? components)
+    (if (null? lower-components)
         ""
-        (last components)))
+        (last lower-components)))
   (define extension
     (let ([ext (path-get-extension path)])
       (and ext
@@ -37,8 +74,9 @@
             (bytes->string/utf-8 ext)))))
 
   (or
-   ;; Git administration directory or file.
+   ;; Git administration and generated Racket bytecode directories.
-   (string-in? ".git" components)
+   (for/or ([component (in-list lower-components)])
+     (string-in? component excluded-directory-names))
 
    ;; Common editor and manual backup files.
    (string-suffix? name "~")
@@ -46,14 +84,53 @@
 
    ;; Generated Scribble web output.
    (and extension
-        (for/or ([component (in-list components)])
+        (for/or ([component (in-list lower-components)])
           (string-in? component scribble-directory-names))
-        (string-in? extension scribble-generated-extensions))))
+        (string-in? extension scribble-generated-extensions))
 
-(define (package-paths source-directory)
+   ;; Additional exclusions supplied by the caller.
+   (custom-excluded-path? path exclude)))
+
+(define (validate-exclude exclude)
+  (unless (list? exclude)
+    (raise-argument-error
+     'zip-package
+     "list?"
+     exclude))
+
+  (for ([entry (in-list exclude)])
+    (unless (or (string? entry)
+                (path? entry)
+                (regexp? entry)
+                (byte-regexp? entry))
+      (raise-arguments-error
+       'zip-package
+       "an exclude entry is not a string, path, or regular expression"
+       "entry" entry
+       "exclude" exclude))
+
+    (when (path? entry)
+      (define simplified-entry
+        (simplify-path entry #f))
+      (define parts
+        (explode-path simplified-entry))
+
+      (when (or (complete-path? simplified-entry)
+                (null? (path-component-strings simplified-entry))
+                (for/or ([part (in-list parts)])
+                  (not (path? part))))
+        (raise-arguments-error
+         'zip-package
+         "an exclude path must be a non-empty relative subpath without '..'"
+         "entry" entry
+         "exclude" exclude))))
+
+  exclude)
+
+(define (package-paths source-directory exclude)
   (parameterize ([current-directory source-directory])
     (find-files (lambda (path)
-                  (not (excluded-path? path)))
+                  (not (excluded-path? path exclude)))
                 #f
                 #:skip-filtered-directory? #t
                 #:follow-links? #f)))
@@ -92,11 +169,14 @@
 
   version)
 
-(define (zip-package [directory (current-directory)])
+(define (zip-package [directory (current-directory)]
+                     #:exclude [exclude null])
   (define source-directory
     (simplify-path
      (path->complete-path directory)
      #t))
+  (define checked-exclude
+    (validate-exclude exclude))
 
   (unless (directory-exists? source-directory)
     (raise-argument-error
@@ -114,7 +194,7 @@
                         package-name
                         version)))
   (define paths
-    (package-paths source-directory))
+    (package-paths source-directory checked-exclude))
 
   (when (file-exists? output-path)
     (delete-file output-path))
@@ -133,17 +213,44 @@
 (module+ test
   (require rackunit)
 
+  (define no-custom-exclude null)
+
   (check-true
-   (excluded-path? (string->path ".git/config")))
+   (excluded-path? (string->path ".git/config") no-custom-exclude))
   (check-true
-   (excluded-path? (string->path "private/source.rkt~")))
+   (excluded-path? (string->path "compiled/main_rkt.zo") no-custom-exclude))
   (check-true
-   (excluded-path? (string->path "private/source.BAK")))
+   (excluded-path? (string->path "private/compiled/helper_rkt.zo")
+                   no-custom-exclude))
   (check-true
-   (excluded-path? (string->path "scribblings/index.html")))
+   (excluded-path? (string->path "private/source.rkt~") no-custom-exclude))
   (check-true
-   (excluded-path? (string->path "scribbles/manual.JS")))
+   (excluded-path? (string->path "private/source.BAK") no-custom-exclude))
+  (check-true
+   (excluded-path? (string->path "scribblings/index.html") no-custom-exclude))
+  (check-true
+   (excluded-path? (string->path "scribbles/manual.JS") no-custom-exclude))
   (check-false
-   (excluded-path? (string->path "web/index.html")))
+   (excluded-path? (string->path "web/index.html") no-custom-exclude))
   (check-false
-   (excluded-path? (string->path "scribblings/package.scrbl"))))
+   (excluded-path? (string->path "scribblings/package.scrbl")
+                   no-custom-exclude))
+
+  (check-true
+   (excluded-path? (string->path "private/generated/result.txt")
+                   '("generated")))
+  (check-false
+   (excluded-path? (string->path "private/generated-result.txt")
+                   '("generated")))
+  (check-true
+   (excluded-path? (string->path "examples/generated/result.txt")
+                   (list (string->path "examples/generated"))))
+  (check-false
+   (excluded-path? (string->path "private/generated/result.txt")
+                   (list (string->path "examples/generated"))))
+  (check-true
+   (excluded-path? (string->path "tests/data/example.json")
+                   (list #rx"^tests/data/")))
+  (check-false
+   (excluded-path? (string->path "tests/example.json")
+                   (list #rx"^tests/data/"))))

scribblings/package-zipper.scrbl

@@ -1,14 +1,18 @@
 #lang scribble/manual
 
 @(require (for-label package-zipper
-                     racket/base))
+                     racket/base
+                     racket/contract/base))
 
 @title{Package Zipper}
 @author{Hans Dijkema}
 
 @defmodule[package-zipper]
 
-@defproc[(zip-package [directory path-string? (current-directory)])
+@defproc[(zip-package [directory path-string? (current-directory)]
+                      [#:exclude exclude
+                       (listof (or/c string? path? regexp? byte-regexp?))
+                       null])
          path?]{
 
 Reads @filepath{info.rkt} in @racket[directory], obtains its
@@ -22,10 +26,28 @@ The directory is archived recursively. The following paths are omitted:
 
 @itemlist[
  @item{@filepath{.git} directories and files}
+ @item{@filepath{compiled} directories and files}
  @item{names ending in @tt{~}}
  @item{names ending in @tt{.bak}, without regard to case}
  @item{@tt{.html}, @tt{.js}, and @tt{.css} files below directories named
-       @filepath{scribblings} or @filepath{scribbles}, without regard to case}
+       @filepath{scribblings}, @filepath{scribbles}, or @filepath{scrbl},
+       without regard to case}
+]
+
+The optional @racket[exclude] list adds exclusions. A string matches an equal
+file or directory name anywhere in the relative path. A relative path value
+matches that path and everything below it. A regular expression is applied to
+the complete relative path, with @litchar{/} as the path separator. Custom
+string and path comparisons are case-sensitive.
+
+For example:
+
+@racketblock[
+(zip-package
+ #:exclude
+ (list "tmp"
+       (string->path "examples/generated")
+       #rx"^tests/data/"))
 ]
 
 The package files are stored at the root of the archive. An existing archive