nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

status: Use 'define-immutable-record-type' and its functional setters. 

* guix/status.scm (<build>): Define using
'define-immutable-record-type', and add 'set-build-completion' binding.
(update-build)[set-completion]: Remove.
Use 'set-build-completion' instead.
This commit is contained in:
Ludovic Courtès 2019-02-05 10:51:23 +01:00
parent f5fdc54d3a
commit c7465dcb96
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 5 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
guix/status.scm
View File

@ -30,6 +30,7 @@
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
@ -100,14 +101,15 @@
(default '()))) (default '())))
;; On-going or completed build. ;; On-going or completed build.
(define-record-type <build> (define-immutable-record-type <build>
(%build derivation id system log-file completion) (%build derivation id system log-file completion)
build? build?
(derivation build-derivation) ;string (.drv file name) (derivation build-derivation) ;string (.drv file name)
(id build-id) ;#f | integer (id build-id) ;#f | integer
(system build-system) ;string (system build-system) ;string
(log-file build-log-file) ;#f | string (log-file build-log-file) ;#f | string
(completion build-completion)) ;#f | integer (percentage) (completion build-completion ;#f | integer (percentage)
set-build-completion))
(define* (build derivation system #:key id log-file completion) (define* (build derivation system #:key id log-file completion)
"Return a new build." "Return a new build."
@ -156,13 +158,6 @@
(define (update-build status id line) (define (update-build status id line)
"Update STATUS based on LINE, a build output line for ID that might contain "Update STATUS based on LINE, a build output line for ID that might contain
a completion indication." a completion indication."
(define (set-completion b %)
(build (build-derivation b)
(build-system b)
#:id (build-id b)
#:log-file (build-log-file b)
#:completion %))
(define (find-build) (define (find-build)
(find (lambda (build) (find (lambda (build)
(and (build-id build) (and (build-id build)
@ -173,7 +168,7 @@ a completion indication."
(let ((build (find-build))) (let ((build (find-build)))
(build-status (build-status
(inherit status) (inherit status)
(building (cons (set-completion build %) (building (cons (set-build-completion build %)
(delq build (build-status-building status))))))) (delq build (build-status-building status)))))))
(cond ((string-any #\nul line) (cond ((string-any #\nul line)