summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-06-10 23:33:16 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-06-10 23:39:27 +0200
commitecffeb75360134139092cd9d78d2f9387f0124e6 (patch)
treef19fd578717d58646addd9a6191c53f3058333db
parentd3487acc4286c7cc36547b3329dabd8749a0dd35 (diff)
downloadcuirass-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.am1
-rw-r--r--bin/cuirass.in16
-rw-r--r--src/cuirass/job.scm32
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