mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
ci: Add jobs history support.
* guix/ci.scm (history?, history-evaluation, history-checkouts, history-jobs, jobs-history): New procedures. (<history>): New record.
This commit is contained in:
parent
9adb69b089
commit
bb5f395a08
1 changed files with 32 additions and 2 deletions
34
guix/ci.scm
34
guix/ci.scm
|
@ -59,6 +59,11 @@ (define-module (guix ci)
|
|||
job-status
|
||||
job-name
|
||||
|
||||
history?
|
||||
history-evaluation
|
||||
history-checkouts
|
||||
history-jobs
|
||||
|
||||
%query-limit
|
||||
queued-builds
|
||||
latest-builds
|
||||
|
@ -66,6 +71,7 @@ (define-module (guix ci)
|
|||
evaluation-jobs
|
||||
build
|
||||
job-build
|
||||
jobs-history
|
||||
latest-evaluations
|
||||
evaluations-for-commit
|
||||
|
||||
|
@ -127,6 +133,18 @@ (define-json-mapping <job> make-job job?
|
|||
integer->build-status)
|
||||
(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?
|
||||
json->checkout
|
||||
(commit checkout-commit) ;string (SHA1)
|
||||
|
@ -247,8 +265,20 @@ (define (job-build url job)
|
|||
"Return the build associated with JOB."
|
||||
(build url (job-build-id job)))
|
||||
|
||||
;; TODO: job history:
|
||||
;; https://ci.guix.gnu.org/api/jobs/history?spec=master&names=coreutils.x86_64-linux&nr=10
|
||||
(define* (jobs-history url jobs
|
||||
#: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)
|
||||
"Return the latest commit with available substitutes for the Guix package
|
||||
|
|
Loading…
Reference in a new issue