mirror of https://notabug.org/mthl/cuirass.git
λ all the things!
parent
7ae6ce0690
commit
13db5aa618
|
@ -86,7 +86,7 @@ if required."
|
|||
(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
|
||||
|
@ -108,7 +108,7 @@ if required."
|
|||
(guix-variable 'store 'current-build-output-port))
|
||||
(derivation-path->output-path
|
||||
(guix-variable 'derivations 'derivation-path->output-path)))
|
||||
(map (lambda (job)
|
||||
(map (λ (job)
|
||||
(let ((log-port (tmpfile))
|
||||
(name (job-name job))
|
||||
(drv (job-derivation job)))
|
||||
|
@ -155,13 +155,13 @@ if required."
|
|||
(let ((store ((guix-variable 'store 'open-connection))))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(let ((jobs (evaluate store db spec))
|
||||
(set-build-options
|
||||
(guix-variable 'store 'set-build-options)))
|
||||
(set-build-options store #:use-substitutes? #f)
|
||||
(build-packages store db jobs)))
|
||||
(lambda ()
|
||||
(λ ()
|
||||
((guix-variable 'store 'close-connection) store)
|
||||
(set! %load-path old-path))))))
|
||||
specs)
|
||||
|
|
|
@ -68,7 +68,7 @@ values."
|
|||
(define (call-with-time-display thunk)
|
||||
"Call THUNK and write to the current output port its duration."
|
||||
(call-with-time thunk
|
||||
(lambda (time . results)
|
||||
(λ (time . results)
|
||||
(format #t "~,3f seconds~%"
|
||||
(+ (time-second time)
|
||||
(/ (time-nanosecond time) 1e9)))
|
||||
|
|
|
@ -119,10 +119,8 @@ database object."
|
|||
(let ((db (db-init)))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(lambda ()
|
||||
body ...)
|
||||
(lambda ()
|
||||
(db-close db)))))
|
||||
(λ () body ...)
|
||||
(λ () (db-close db)))))
|
||||
|
||||
(define* (read-quoted-string #:optional port)
|
||||
"Read all of the characters out of PORT and return them as a SQL quoted
|
||||
|
|
|
@ -23,11 +23,15 @@
|
|||
#:export (;; Procedures
|
||||
mkdir-p
|
||||
;; Macros.
|
||||
λ*
|
||||
with-directory-excursion))
|
||||
|
||||
(define-syntax-rule (λ* formals body ...)
|
||||
(lambda* formals body ...))
|
||||
|
||||
(define mkdir-p
|
||||
(let ((not-slash (char-set-complement (char-set #\/))))
|
||||
(lambda* (dir #:optional mode)
|
||||
(λ* (dir #:optional mode)
|
||||
"Create directory DIR and all its ancestors."
|
||||
(let ((absolute? (string-prefix? "/" dir)))
|
||||
(let loop ((components (string-tokenize dir not-slash))
|
||||
|
@ -36,12 +40,12 @@
|
|||
((head tail ...)
|
||||
(let ((dir-name (string-append root "/" head)))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(if mode
|
||||
(mkdir dir-name mode)
|
||||
(mkdir dir-name))
|
||||
(loop tail dir-name))
|
||||
(lambda args
|
||||
(λ args
|
||||
;; On GNU/Hurd we can get EROFS instead of EEXIST here.
|
||||
;; Thus, if we get something other than EEXIST, check
|
||||
;; whether DIR-NAME exists. See
|
||||
|
@ -57,9 +61,6 @@
|
|||
"Run BODY with DIR as the process's current directory."
|
||||
(let ((init (getcwd)))
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(chdir dir))
|
||||
(lambda ()
|
||||
body ...)
|
||||
(lambda ()
|
||||
(chdir init)))))
|
||||
(λ () (chdir dir))
|
||||
(λ () body ...)
|
||||
(λ () (chdir init)))))
|
||||
|
|
Loading…
Reference in New Issue