From 7ae6ce069070582e42b669d6a1ecfde5e9b998ba Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 2 Jul 2016 15:34:40 +0200 Subject: Add %package-cachedir parameter. --- bin/cuirass.in | 69 ++++++++++++++++++++++++----------------------- build-aux/pre-inst-env.in | 3 --- src/cuirass/base.scm | 14 +++++++++- tests/base.scm | 4 +++ 4 files changed, 52 insertions(+), 38 deletions(-) diff --git a/bin/cuirass.in b/bin/cuirass.in index ae201d1..84e3f18 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -30,10 +30,10 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (ice-9 getopt-long)) (define* (show-help) - (simple-format #t "Usage: ~a [OPTIONS] [CACHEDIR]" (%program-name)) - (display " -Run Guix job from a git repository cloned in CACHEDIR. + (simple-format #t "Usage: ~a [OPTIONS] ~%" (%program-name)) + (display "Run build jobs. + --cache-directory=DIR Use DIR for storing repository data -f --use-file=FILE Use FILE which defines the job to evaluate -D --database=DB Use DB to store build results. -I, --interval=N Wait N seconds between each evaluation @@ -43,7 +43,8 @@ Run Guix job from a git repository cloned in CACHEDIR. (show-package-information)) (define %options - `((file (single-char #\f) (value #t)) + `((cache-directory (value #t)) + (file (single-char #\f) (value #t)) (database (single-char #\f) (value #t)) (interval (single-char #\I) (value #t)) (version (single-char #\V) (value #f)) @@ -55,39 +56,41 @@ Run Guix job from a git repository cloned in CACHEDIR. (beautify-user-module! m) m)) -(define (fetch-repository cachedir spec) - "Get the latest version of Guix repository. Clone repository in directory -DIR if required." - (or (file-exists? cachedir) (mkdir cachedir)) - (with-directory-excursion cachedir - (let ((name (job-spec-name spec)) - (url (job-spec-url spec)) - (branch (job-spec-branch spec)) - (commit (job-spec-commit spec)) - (tag (job-spec-tag spec))) - (or (file-exists? name) (system* "git" "clone" url name)) - (with-directory-excursion name - (and (zero? (system* "git" "fetch")) - (zero? (system* "git" "reset" "--hard" - (or tag - commit - (string-append "origin/" branch))))))))) +(define (fetch-repository spec) + "Get the latest version of repository specified in SPEC. Clone repository +if required." + (let ((cachedir (%package-cachedir))) + (or (file-exists? cachedir) (mkdir cachedir)) + (with-directory-excursion cachedir + (let ((name (job-spec-name spec)) + (url (job-spec-url spec)) + (branch (job-spec-branch spec)) + (commit (job-spec-commit spec)) + (tag (job-spec-tag spec))) + (or (file-exists? name) (system* "git" "clone" url name)) + (with-directory-excursion name + (and (zero? (system* "git" "fetch")) + (zero? (system* "git" "reset" "--hard" + (or tag + commit + (string-append "origin/" branch)))))))))) -(define (set-load-path! cachedir spec) +(define (set-load-path! spec) "Set %LOAD-PATH to match what is specified in SPEC." (let* ((name (job-spec-name spec)) (path (job-spec-load-path spec)) - (dir (string-join (list cachedir name path) "/"))) + (dir (string-join (list (%package-cachedir) name path) "/"))) (format #t "prepending ~s to the load path~%" dir) (set! %load-path (cons dir %load-path)))) -(define (evaluate store db cachedir spec) +(define (evaluate store db spec) "Evaluate and build package derivations. Return a list a jobs." (save-module-excursion (lambda () (set-current-module %user-module) ;; Handle both relative and absolute file names for SPEC-FILE. - (with-directory-excursion cachedir + (with-directory-excursion + (string-append (%package-cachedir) "/" (job-spec-name spec)) (primitive-load (job-spec-file spec))))) (let* ((proc (module-ref %user-module (job-spec-proc spec))) (jobs (proc store (job-spec-arguments spec)))) @@ -127,7 +130,9 @@ DIR if required." (let ((opts (getopt-long args %options))) (parameterize ((%program-name (car args)) - (%package-database (option-ref opts 'database (%package-database)))) + (%package-database (option-ref opts 'database (%package-database))) + (%package-cachedir + (option-ref opts 'cache-directory (%package-cachedir)))) (cond ((option-ref opts 'help #f) (show-help) @@ -138,24 +143,20 @@ DIR if required." (else (let* ((specfile (option-ref opts 'file "tests/hello-subset.scm")) (interval (option-ref opts 'interval "60")) - (specs (primitive-load specfile)) - (args (option-ref opts '() #f)) - (cachedir (if (null? args) - (getenv "CUIRASS_CACHEDIR") - (car args)))) + (specs (primitive-load specfile))) (with-database db (while #t (for-each (λ (spec) - (fetch-repository cachedir spec) + (fetch-repository spec) (let ((old-path %load-path)) (and (job-spec-load-path spec) - (set-load-path! cachedir spec)) + (set-load-path! spec)) (let ((store ((guix-variable 'store 'open-connection)))) (dynamic-wind (const #t) (lambda () - (let ((jobs (evaluate store db cachedir spec)) + (let ((jobs (evaluate store db spec)) (set-build-options (guix-variable 'store 'set-build-options))) (set-build-options store #:use-substitutes? #f) diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in index 5b61cb2..b92a1a1 100644 --- a/build-aux/pre-inst-env.in +++ b/build-aux/pre-inst-env.in @@ -27,7 +27,4 @@ export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH PATH="$abs_top_builddir/bin:$PATH" export PATH -CUIRASS_CACHEDIR="$abs_top_builddir/cache" -export CUIRASS_CACHEDIR - exec "$@" diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 8e6ea36..c3fe733 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -25,7 +25,8 @@ guix-variable call-with-time-display ;; Parameters. - %program-name)) + %program-name + %package-cachedir)) (define %program-name ;; Similar in spirit to Gnulib 'progname' module. @@ -37,6 +38,17 @@ ((string-rindex val #\/) => (λ (idx) (substring val (1+ idx)))) (else val))))) +(define %package-cachedir + ;; Define to location of cache directory of this package. + (make-parameter (or (getenv "CUIRASS_CACHEDIR") + (string-append (or (getenv "HOME") ".") + "/.cache/cuirass")) + (λ (val) + (if (string? val) + val + (scm-error 'wrong-type-arg + "%package-cachedir" "Not a string: ~S" (list #f) #f))))) + (define (guix-variable module name) "Dynamically link variable NAME under Guix module MODULE and return it. Note: this is used instead of `@', because when using `@' in an uncompiled diff --git a/tests/base.scm b/tests/base.scm index 4557bb8..fb3bfd1 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -23,3 +23,7 @@ (test-error "invalid program name" 'wrong-type-arg (%program-name #f)) + +(test-error "invalid cache directory" + 'wrong-type-arg + (%package-cachedir #f)) -- cgit v1.2.3