hans/package-zipper
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Exclude compiled and exclude optional exclude list.

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-03 11:25:51 +02:00
parent 8d91aa86d2
commit a37af10e26
5 changed files with 173 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+3
View File
@@ -15,3 +15,6 @@ compiled/
# Dependency tracking files
*.dep
/scribblings/*.css
/scribblings/*.js
/scribblings/*.html
README.md
+18 -3
View File
@@ -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
case-insensitive.
The built-in directory and extension comparisons are 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
+1 -1
View File
@@ -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
+126 -19
View File
@@ -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.
(string-in? ".git" components)
;; Git administration and generated Racket bytecode directories.
(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
+25 -3
View File
@@ -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