mirror of https://notabug.org/mthl/cuirass.git
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.pull/3/head
parent
d3487acc42
commit
ecffeb7536
|
@ -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 = \
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue