From a37af10e26e2d8facb1173af1909846019b7dfd0 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 3 Aug 2026 11:25:51 +0200 Subject: [PATCH] Exclude compiled and exclude optional exclude list. --- .gitignore | 3 + README.md | 21 ++++- info.rkt | 2 +- main.rkt | 145 +++++++++++++++++++++++++++---- scribblings/package-zipper.scrbl | 28 +++++- 5 files changed, 173 insertions(+), 26 deletions(-) diff --git a/.gitignore b/.gitignore index 39a4f9c..f27da57 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,6 @@ compiled/ # Dependency tracking files *.dep +/scribblings/*.css +/scribblings/*.js +/scribblings/*.html diff --git a/README.md b/README.md index 1908da1..5330888 100644 --- a/README.md +++ b/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 -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: diff --git a/info.rkt b/info.rkt index 63a508b..59393d0 100644 --- a/info.rkt +++ b/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") diff --git a/main.rkt b/main.rkt index 6266b21..7a71614 100644 --- a/main.rkt +++ b/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. - (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/")))) diff --git a/scribblings/package-zipper.scrbl b/scribblings/package-zipper.scrbl index 4b13317..ec8fcff 100644 --- a/scribblings/package-zipper.scrbl +++ b/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