summaryrefslogtreecommitdiff
path: root/guix/status.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-02-05 11:24:44 +0100
committerLudovic Courtès <ludo@gnu.org>2019-02-05 12:03:25 +0100
commitba514b601ba6be15b823e0a12d4b6e42f9d2489e (patch)
tree286c42f6202954263a460f5fe44fd59c76da6a38 /guix/status.scm
parentc7465dcb96e8d35fb992f4e14c4e22251b951a98 (diff)
status: Keep track of the current build phase.
* guix/status.scm (<build>)[phase]: New field. (%phase-start-rx): New variable. (update-build): Add clause to match %PHASE-START-RX and adjust the 'phase' field accordingly. * tests/status.scm ("compute-status, build phase"): Add test
Diffstat (limited to 'guix/status.scm')
-rw-r--r--guix/status.scm28
1 files changed, 25 insertions, 3 deletions
diff --git a/guix/status.scm b/guix/status.scm
index 070071d46f..c3c219219d 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -55,6 +55,9 @@
build
build-derivation
build-system
+ build-log-file
+ build-phase
+ build-completion
download?
download
@@ -102,18 +105,20 @@
;; On-going or completed build.
(define-immutable-record-type <build>
- (%build derivation id system log-file completion)
+ (%build derivation id system log-file phase completion)
build?
(derivation build-derivation) ;string (.drv file name)
(id build-id) ;#f | integer
(system build-system) ;string
(log-file build-log-file) ;#f | string
+ (phase build-phase ;#f | symbol
+ set-build-phase)
(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 phase completion)
"Return a new build."
- (%build derivation id system log-file completion))
+ (%build derivation id system log-file phase completion))
;; On-going or completed downloads. Downloads can be stem from substitutes
;; and from "builtin:download" fixed-output derivations.
@@ -144,6 +149,10 @@
(lambda (download)
(string=? item (download-item download))))
+(define %phase-start-rx
+ ;; Match the "starting phase" message emitted by 'gnu-build-system'.
+ (make-regexp "^starting phase [`']([^']+)'"))
+
(define %percentage-line-rx
;; Things like CMake write lines like "[ 10%] gcc -c …". This regexp
;; matches them.
@@ -185,6 +194,19 @@ a completion indication."
(let ((done (string->number (match:substring match 1)))
(total (string->number (match:substring match 3))))
(update (* 100. (/ done total))))))
+ ((regexp-exec %phase-start-rx line)
+ =>
+ (lambda (match)
+ (let ((phase (match:substring match 1))
+ (build (find-build)))
+ (if build
+ (build-status
+ (inherit status)
+ (building
+ (cons (set-build-phase (set-build-completion build #f)
+ (string->symbol phase))
+ (delq build (build-status-building status)))))
+ status))))
(else
status)))