diff --git a/README.md b/README.md index 2d80b24..1908da1 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,31 @@ # package-zipper -Zips a package based on the information in info.rkt \ No newline at end of file +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 . +``` diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..63a508b --- /dev/null +++ b/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") diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..6266b21 --- /dev/null +++ b/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")))) diff --git a/scribblings/package-zipper.scrbl b/scribblings/package-zipper.scrbl new file mode 100644 index 0000000..4b13317 --- /dev/null +++ b/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. +}