diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-10-20 12:00:41 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-10-20 23:07:37 +0200 |
commit | 4056cd9480416f38e06f98fdf5acea7c82a4c886 (patch) | |
tree | 8c9f7c96e7f750932d8799e2e7c9c8e40890ff46 | |
parent | c5d83bee93542427f7b680554bcf947d0ae6dae6 (diff) |
ci: Add 'start-time' and 'stop-time' to <build> records.
* guix/ci.scm (seconds->date): New procedure.
(<build>)[start-time, stop-time]: New fields.
(build-duration): New procedure.
-rw-r--r-- | guix/ci.scm | 23 |
1 files changed, 22 insertions, 1 deletions
diff --git a/guix/ci.scm b/guix/ci.scm index 88b80f781d..ecdffde2d1 100644 --- a/guix/ci.scm +++ b/guix/ci.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -24,6 +24,7 @@ #:select (resolve-uri-reference)) #:use-module (json) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (ice-9 match) #:use-module (web uri) #:use-module (guix i18n) @@ -42,6 +43,9 @@ build-system build-status build-timestamp + build-start-time + build-stop-time + build-duration build-products checkout? @@ -84,6 +88,11 @@ ;;; ;;; Code: +(define (seconds->date seconds) + "Given SECONDS, a number of seconds since 1970-01-01, return the +corresponding date object." + (time-utc->date (make-time time-utc 0 seconds))) + (define-json-mapping <build-product> make-build-product build-product? json->build-product @@ -118,6 +127,10 @@ (status build-status "buildstatus" ;symbol integer->build-status) (timestamp build-timestamp) ;integer + (start-time build-start-time "starttime" ;date + seconds->date) + (stop-time build-stop-time "stoptime" ;date + seconds->date) (products build-products "buildproducts" ;<build-product>* (lambda (products) (map json->build-product @@ -201,6 +214,14 @@ api-agnostic." (define* (json-api-fetch base-url path #:rest query) (json-fetch (apply api-url base-url path query))) +(define (build-duration build) + "Return the duration in seconds of BUILD." + (define duration + (time-difference (date->time-utc (build-stop-time build)) + (date->time-utc (build-start-time build)))) + + (time-second duration)) + (define* (queued-builds url #:optional (limit %query-limit)) "Return the list of queued derivations on URL." (let ((queue |