summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-10-24 11:50:57 -0400
committerDavid Thompson <dthompson2@worcester.edu>2021-10-24 11:51:10 -0400
commit380986f85d1d57b7a2d231aad29c876b9835ee78 (patch)
treeff6a6366ab3dfb114f2e5c1282514e45c1033074
parent1a631eb326181f3c53e421ff1b887b3e817f5b20 (diff)
cli: bundle: Allow excluding asset files via regexp match.
-rw-r--r--chickadee/cli/bundle.scm38
1 files changed, 22 insertions, 16 deletions
diff --git a/chickadee/cli/bundle.scm b/chickadee/cli/bundle.scm
index 9d66286..35ffd53 100644
--- a/chickadee/cli/bundle.scm
+++ b/chickadee/cli/bundle.scm
@@ -23,6 +23,7 @@
#:use-module (ice-9 format)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (system base compile)
@@ -158,7 +159,7 @@
(() #t))))
;; Also snarfed from Guix, with some simplifications.
-(define* (copy-recursively source destination)
+(define* (copy-recursively source destination ignore-regexps)
(define strip-source
(let ((len (string-length source)))
(lambda (file)
@@ -166,15 +167,18 @@
(file-system-fold (const #t) ; enter?
(lambda (file stat result) ; leaf
- (let ((dest (string-append destination
- (strip-source file))))
- (format #t "copy ~a → ~a~%" file dest)
- (case (stat:type stat)
- ((symlink)
- (let ((target (readlink file)))
- (symlink target dest)))
- (else
- (copy-file file dest)))))
+ (unless (any (lambda (regexp)
+ (regexp-exec regexp file))
+ ignore-regexps)
+ (let ((dest (string-append destination
+ (strip-source file))))
+ (format #t "copy ~a → ~a~%" file dest)
+ (case (stat:type stat)
+ ((symlink)
+ (let ((target (readlink file)))
+ (symlink target dest)))
+ (else
+ (copy-file file dest))))))
(lambda (dir stat result) ; down
(let ((target (string-append destination
(strip-source dir))))
@@ -252,16 +256,16 @@
(format #t "copy ~a → ~a~%" src dest)
(copy-file src dest)))
-(define (install-assets dirs destdir)
+(define (install-assets dirs destdir ignore-regexps)
(for-each (lambda (dir)
(let ((target (string-append destdir "/" dir)))
- (copy-recursively dir target)))
+ (copy-recursively dir target ignore-regexps)))
dirs))
(define (install-chickadee-data destdir)
(let ((sharedir (string-append destdir "/share/chickadee")))
(mkdir sharedir)
- (copy-recursively %datadir sharedir)))
+ (copy-recursively %datadir sharedir '())))
(define (install-init.scm code method destdir)
(let ((init (string-append destdir "/init.scm")))
@@ -347,7 +351,8 @@ exec bin/guile ~a
"/usr/lib"
"/usr/lib/x86_64-linux-gnu"))
(method . play)
- (play-args . ())))
+ (play-args . ())
+ (ignore-files . ())))
(define %tmpdir (or (getenv "TMPDIR") "/tmp"))
@@ -364,14 +369,15 @@ exec bin/guile ~a
(launcher (assq-ref config 'launcher-name))
(libraries (assq-ref config 'libraries))
(libdirs (assq-ref config 'library-directories))
- (method (assq-ref config 'method)))
+ (method (assq-ref config 'method))
+ (ignore-regexps (map make-regexp (assq-ref config 'ignore-files))))
(mkdir destdir)
(mkdir (string-append destdir "/bin"))
(mkdir (string-append destdir "/lib"))
(mkdir (string-append destdir "/share"))
(install-init.scm code method destdir)
(install-launcher launcher method args destdir)
- (install-assets assets destdir)
+ (install-assets assets destdir ignore-regexps)
(install-guile destdir bindirs)
(install-chickadee-data destdir)
(install-libraries destdir libraries (scan-for-libraries libdirs))