diff options
author | Mathieu Lirzin <mthl@gnu.org> | 2016-06-10 23:33:16 +0200 |
---|---|---|
committer | Mathieu Lirzin <mthl@gnu.org> | 2016-06-10 23:39:27 +0200 |
commit | ecffeb75360134139092cd9d78d2f9387f0124e6 (patch) | |
tree | f19fd578717d58646addd9a6191c53f3058333db | |
parent | d3487acc4286c7cc36547b3329dabd8749a0dd35 (diff) | |
download | cuirass-ecffeb75360134139092cd9d78d2f9387f0124e6.tar cuirass-ecffeb75360134139092cd9d78d2f9387f0124e6.tar.gz |
job: Add <job> record type.
* src/cuirass/job.scm: New file.
* Makefile.am (dist_pkgmodule_DATA): Add it.
* bin/cuirass.in (evaluate, build-packages): Use it.
-rw-r--r-- | Makefile.am | 1 | ||||
-rw-r--r-- | bin/cuirass.in | 16 | ||||
-rw-r--r-- | src/cuirass/job.scm | 32 |
3 files changed, 42 insertions, 7 deletions
diff --git a/Makefile.am b/Makefile.am index 5c1490b..4dd954a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -5,6 +5,7 @@ noinst_SCRIPTS = pre-inst-env dist_pkgmodule_DATA = \ src/cuirass/base.scm \ + src/cuirass/job.scm \ src/cuirass/ui.scm nodist_pkgmodule_DATA = \ diff --git a/bin/cuirass.in b/bin/cuirass.in index ea55264..862bcc7 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -22,6 +22,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. (use-modules (cuirass base) + (cuirass job) (cuirass ui) (ice-9 getopt-long) (ice-9 match)) @@ -74,12 +75,11 @@ DIR if required." m)) (define (build-packages store jobs) - "Build JOBS which is a list of job. ((job-symbol pair ...) ...)" - (map (lambda (thing) - (let ((name (symbol->string (car thing))) - (drv (cdadr thing))) - (format #t "building ~A => ~A~%" name drv) - ((guix-variable 'derivations 'build-derivations) store (list drv)))) + "Build JOBS which is a list of <job> objects." + (map (match-lambda + (($ <job> name drv) + (format #t "building ~A => ~A~%" name drv) + ((guix-variable 'derivations 'build-derivations) store (list drv)))) jobs)) (define (evaluate dir spec) @@ -101,7 +101,9 @@ DIR if required." (map (lambda (job thunk) (format (current-error-port) "evaluating '~a'... " job) (force-output (current-error-port)) - (cons job (call-with-time-display thunk))) + (make-job (symbol->string job) + (assoc-ref (call-with-time-display thunk) + 'derivation))) names thunks))))) (lambda () ((guix-variable 'store 'close-connection) store))))) diff --git a/src/cuirass/job.scm b/src/cuirass/job.scm new file mode 100644 index 0000000..4efba9e --- /dev/null +++ b/src/cuirass/job.scm @@ -0,0 +1,32 @@ +;;;; job.scm - data structures for jobs +;;; +;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; +;;; This file is part of Cuirass. +;;; +;;; Cuirass is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Cuirass is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. + +(define-module (cuirass job) + #:use-module (srfi srfi-9) + #:export (<job> + make-job + job? + job-name + job-derivation)) + +(define-record-type <job> + (make-job name derivation) + job? + (name job-name) ;string + (derivation job-derivation)) ;string |