Initial import

README.md

@@ -1,3 +1,31 @@
 # package-zipper
 
-Zips a package based on the information in info.rkt
+Creates a clean, versioned ZIP archive of the current Racket package.
+
+```racket
+(require package-zipper)
+(zip-package)
+```
+
+`zip-package` reads `version` from the current directory's `info.rkt`.
+For a directory named `racket-upnp` with version `"5.0"`, it creates:
+
+```text
+../racket-upnp-5.0.zip
+```
+
+The ZIP recursively contains the package files, except for:
+
+- `.git`
+- names ending in `~`
+- names ending in `.bak`
+- `.html`, `.js`, and `.css` files below `scribblings` or `scribbles`
+
+The comparisons for `.bak` and the Scribble web extensions are
+case-insensitive.
+
+Install this source directory as a linked package during development:
+
+```sh
+raco pkg install --auto --link .
+```

info.rkt

@@ -0,0 +1,14 @@
+#lang info
+
+(define collection "package-zipper")
+(define deps
+  '("base"))
+(define build-deps
+  '("rackunit-lib"
+    "racket-doc"
+    "scribble-lib"))
+(define scribblings
+  '(("scribblings/package-zipper.scrbl" ())))
+(define pkg-desc
+  "Create a clean, versioned ZIP archive of the current Racket package.")
+(define version "0.1")

main.rkt

@@ -0,0 +1,149 @@
+#lang racket/base
+
+(require file/zip
+         racket/file
+         racket/list
+         racket/path
+         racket/string
+         setup/getinfo)
+
+(provide zip-package)
+
+(define scribble-directory-names
+  '("scribblings" "scribbles" "scrbl"))
+
+(define scribble-generated-extensions
+  '(".html" ".js" ".css"))
+
+(define (path-component-strings path)
+  (for/list ([part (in-list (explode-path path))]
+             #:when (path? part))
+    (string-downcase (path-element->string part))))
+
+(define (string-in? value strings)
+  (for/or ([candidate (in-list strings)])
+    (string=? value candidate)))
+
+(define (excluded-path? path)
+  (define components (path-component-strings path))
+  (define name
+    (if (null? components)
+        ""
+        (last components)))
+  (define extension
+    (let ([ext (path-get-extension path)])
+      (and ext
+           (string-downcase
+            (bytes->string/utf-8 ext)))))
+
+  (or
+   ;; Git administration directory or file.
+   (string-in? ".git" components)
+
+   ;; Common editor and manual backup files.
+   (string-suffix? name "~")
+   (string-suffix? name ".bak")
+
+   ;; Generated Scribble web output.
+   (and extension
+        (for/or ([component (in-list components)])
+          (string-in? component scribble-directory-names))
+        (string-in? extension scribble-generated-extensions))))
+
+(define (package-paths source-directory)
+  (parameterize ([current-directory source-directory])
+    (find-files (lambda (path)
+                  (not (excluded-path? path)))
+                #f
+                #:skip-filtered-directory? #t
+                #:follow-links? #f)))
+
+(define (directory-name+parent directory)
+  (define-values (parent name _must-be-directory?)
+    (split-path (path->directory-path directory)))
+
+  (unless (and (path? parent) (path? name))
+    (raise-arguments-error
+     'zip-package
+     "cannot determine a package name and parent directory"
+     "directory" directory))
+
+  (values (path-element->string name) parent))
+
+(define (package-version source-directory)
+  (define get-info (get-info/full source-directory))
+
+  (unless get-info
+    (raise-arguments-error
+     'zip-package
+     "the package directory has no info.rkt"
+     "directory" source-directory))
+
+  (define version
+    (get-info 'version (lambda () #f)))
+
+  (unless (and (string? version)
+               (not (string=? version "")))
+    (raise-arguments-error
+     'zip-package
+     "info.rkt has no non-empty string value for version"
+     "directory" source-directory
+     "version" version))
+
+  version)
+
+(define (zip-package [directory (current-directory)])
+  (define source-directory
+    (simplify-path
+     (path->complete-path directory)
+     #t))
+
+  (unless (directory-exists? source-directory)
+    (raise-argument-error
+     'zip-package
+     "directory-exists?"
+     directory))
+
+  (define-values (package-name parent-directory)
+    (directory-name+parent source-directory))
+  (define version
+    (package-version source-directory))
+  (define output-path
+    (build-path parent-directory
+                (format "~a-~a.zip"
+                        package-name
+                        version)))
+  (define paths
+    (package-paths source-directory))
+
+  (when (file-exists? output-path)
+    (delete-file output-path))
+
+  (parameterize ([current-directory source-directory])
+    (call-with-output-file output-path
+      (lambda (out)
+        ;; Keep package files at the archive root, as expected for a
+        ;; directly installable Racket package archive.
+        (zip->output paths out))
+      #:mode 'binary))
+
+  (printf "Created ~a\n" (path->string output-path))
+  output-path)
+
+(module+ test
+  (require rackunit)
+
+  (check-true
+   (excluded-path? (string->path ".git/config")))
+  (check-true
+   (excluded-path? (string->path "private/source.rkt~")))
+  (check-true
+   (excluded-path? (string->path "private/source.BAK")))
+  (check-true
+   (excluded-path? (string->path "scribblings/index.html")))
+  (check-true
+   (excluded-path? (string->path "scribbles/manual.JS")))
+  (check-false
+   (excluded-path? (string->path "web/index.html")))
+  (check-false
+   (excluded-path? (string->path "scribblings/package.scrbl"))))

scribblings/package-zipper.scrbl

@@ -0,0 +1,33 @@
+#lang scribble/manual
+
+@(require (for-label package-zipper
+                     racket/base))
+
+@title{Package Zipper}
+@author{Hans Dijkema}
+
+@defmodule[package-zipper]
+
+@defproc[(zip-package [directory path-string? (current-directory)])
+         path?]{
+
+Reads @filepath{info.rkt} in @racket[directory], obtains its
+@racket['version] value, and creates a ZIP archive in the parent directory.
+
+The output filename is formed from the package directory name and version. For
+example, package directory @filepath{racket-upnp} with version @tt{5.0} produces
+@filepath{racket-upnp-5.0.zip}.
+
+The directory is archived recursively. The following paths are omitted:
+
+@itemlist[
+ @item{@filepath{.git} 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}
+]
+
+The package files are stored at the root of the archive. An existing archive
+with the same name is replaced. The resulting complete path is returned.
+}