ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

ci: Add jobs history support.

Browse source 
* guix/ci.scm (history?, history-evaluation, history-checkouts, history-jobs,
jobs-history): New procedures.
(<history>): New record.
This commit is contained in:
Mathieu Othacehe 2021-08-22 21:36:29 +02:00
parent 9adb69b089
commit bb5f395a08
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 32 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
guix/ci.scm
View file

@ -59,6 +59,11 @@ (define-module (guix ci)
job-status job-status
job-name job-name
history?
history-evaluation
history-checkouts
history-jobs
%query-limit %query-limit
queued-builds queued-builds
latest-builds latest-builds
@ -66,6 +71,7 @@ (define-module (guix ci)
evaluation-jobs evaluation-jobs
build build
job-build job-build
jobs-history
latest-evaluations latest-evaluations
evaluations-for-commit evaluations-for-commit
@ -127,6 +133,18 @@ (define-json-mapping <job> make-job job?
integer->build-status) integer->build-status)
(name job-name)) ;string (name job-name)) ;string
(define-json-mapping <history> make-history history?
json->history
(evaluation history-evaluation) ;integer
(checkouts history-checkouts "checkouts" ;<checkout>*
(lambda (checkouts)
(map json->checkout
(vector->list checkouts))))
(jobs history-jobs "jobs"
(lambda (jobs)
(map json->job
(vector->list jobs)))))
(define-json-mapping <checkout> make-checkout checkout? (define-json-mapping <checkout> make-checkout checkout?
json->checkout json->checkout
(commit checkout-commit) ;string (SHA1) (commit checkout-commit) ;string (SHA1)
@ -247,8 +265,20 @@ (define (job-build url job)
"Return the build associated with JOB." "Return the build associated with JOB."
(build url (job-build-id job))) (build url (job-build-id job)))
;; TODO: job history: (define* (jobs-history url jobs
;; https://ci.guix.gnu.org/api/jobs/history?spec=master&names=coreutils.x86_64-linux&nr=10 #:key
(specification "master")
(limit 20))
"Return the job history for the SPECIFICATION jobs which names are part of
the JOBS list, from the CI server at URL. Limit the history to the latest
LIMIT evaluations. "
(let ((names (string-join jobs ",")))
(map json->history
(vector->list
(json->scm
(http-fetch
(format #f "~a/api/jobs/history?spec=~a&names=~a&nr=~a"
url specification names (number->string limit))))))))
(define (find-latest-commit-with-substitutes url) (define (find-latest-commit-with-substitutes url)
"Return the latest commit with available substitutes for the Guix package "Return the latest commit with available substitutes for the Guix package