aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-11-10 18:41:57 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-10 23:33:46 +0100
commita3b72a8f1737bbf8c4388cc230571ea5c3831d0b (patch)
tree96c44d2db2c8f52a0177f1e7657bc94c6a48bc7f
parent30288ae57e77cf39c90276708e4920f4f1aea2ca (diff)
downloadguix-a3b72a8f1737bbf8c4388cc230571ea5c3831d0b.tar
guix-a3b72a8f1737bbf8c4388cc230571ea5c3831d0b.tar.gz
ci: Add procedures to access evaluations.
* guix/ci.scm (<checkout>, <evaluation>): New record types. (latest-builds): Add #:evaluation and #:system and honor it. Define 'option'. (json->checkout, json->evaluation, latest-evaluations) (evaluations-for-commit): New procedures.
-rw-r--r--guix/ci.scm74
1 files changed, 71 insertions, 3 deletions
diff --git a/guix/ci.scm b/guix/ci.scm
index 881f3d3927..1727297dd7 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -19,6 +19,7 @@
(define-module (guix ci)
#:use-module (guix http-client)
#:autoload (json parser) (json->scm)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:export (build?
build-id
@@ -27,9 +28,21 @@
build-status
build-timestamp
+ checkout?
+ checkout-commit
+ checkout-input
+
+ evaluation?
+ evaluation-id
+ evaluation-spec
+ evaluation-complete?
+ evaluation-checkouts
+
%query-limit
queued-builds
- latest-builds))
+ latest-builds
+ latest-evaluations
+ evaluation-for-commit))
;;; Commentary:
;;;
@@ -47,6 +60,20 @@
(status build-status) ;integer
(timestamp build-timestamp)) ;integer
+(define-record-type <checkout>
+ (make-checkout commit input)
+ checkout?
+ (commit checkout-commit) ;string (SHA1)
+ (input checkout-input)) ;string (name)
+
+(define-record-type <evaluation>
+ (make-evaluation id spec complete? checkouts)
+ evaluation?
+ (id evaluation-id) ;integer
+ (spec evaluation-spec) ;string
+ (complete? evaluation-complete?) ;Boolean
+ (checkouts evaluation-checkouts)) ;<checkout>*
+
(define %query-limit
;; Max number of builds requested in queries.
1000)
@@ -70,9 +97,50 @@
(number->string limit)))))
(map json->build queue)))
-(define* (latest-builds url #:optional (limit %query-limit))
+(define* (latest-builds url #:optional (limit %query-limit)
+ #:key evaluation system)
+ "Return the latest builds performed by the CI server at URL. If EVALUATION
+is an integer, restrict to builds of EVALUATION. If SYSTEM is true (a system
+string such as \"x86_64-linux\"), restrict to builds for SYSTEM."
+ (define* (option name value #:optional (->string identity))
+ (if value
+ (string-append "&" name "=" (->string value))
+ ""))
+
(let ((latest (json-fetch (string-append url "/api/latestbuilds?nr="
- (number->string limit)))))
+ (number->string limit)
+ (option "evaluation" evaluation
+ number->string)
+ (option "system" system)))))
;; Note: Hydra does not provide a "derivation" field for entries in
;; 'latestbuilds', but Cuirass does.
(map json->build latest)))
+
+(define (json->checkout json)
+ (make-checkout (hash-ref json "commit")
+ (hash-ref json "input")))
+
+(define (json->evaluation json)
+ (make-evaluation (hash-ref json "id")
+ (hash-ref json "specification")
+ (case (hash-ref json "in-progress")
+ ((0) #t)
+ (else #f))
+ (map json->checkout (hash-ref json "checkouts"))))
+
+(define* (latest-evaluations url #:optional (limit %query-limit))
+ "Return the latest evaluations performed by the CI server at URL."
+ (map json->evaluation
+ (json->scm
+ (http-fetch (string-append url "/api/evaluations?nr="
+ (number->string limit))))))
+
+
+(define* (evaluations-for-commit url commit #:optional (limit %query-limit))
+ "Return the evaluations among the latest LIMIT evaluations that have COMMIT
+as one of their inputs."
+ (filter (lambda (evaluation)
+ (find (lambda (checkout)
+ (string=? (checkout-commit checkout) commit))
+ (evaluation-checkouts evaluation)))
+ (latest-evaluations url limit)))