53 lines
1.9 KiB
Scheme
53 lines
1.9 KiB
Scheme
|
;; It expects Guile-JSON 1.x.
|
|||
|
;; Run as ‘guix pull -C FILE’.
|
|||
|
|
|||
|
(use-modules (guix http-client)
|
|||
|
(json)
|
|||
|
(srfi srfi-1)
|
|||
|
(ice-9 match))
|
|||
|
|
|||
|
(define (latest-evaluations jobset)
|
|||
|
"Return the latest evaluations of JOBSET."
|
|||
|
(filter (lambda (json)
|
|||
|
(string=? (hash-ref json "specification") jobset))
|
|||
|
(json->scm
|
|||
|
(http-fetch
|
|||
|
"https://berlin.guixsd.org/api/evaluations?nr=30"))))
|
|||
|
|
|||
|
(define (evaluation-complete? number)
|
|||
|
"Return true if evaluation NUMBER completed and all its builds were
|
|||
|
successful."
|
|||
|
(let ((builds (json->scm
|
|||
|
(http-fetch
|
|||
|
(string-append
|
|||
|
"https://berlin.guixsd.org/api/latestbuilds?nr=30&evaluation="
|
|||
|
(number->string number))))))
|
|||
|
(every (lambda (build)
|
|||
|
;; Zero means build success.
|
|||
|
(= (hash-ref build "buildstatus") 0))
|
|||
|
builds)))
|
|||
|
|
|||
|
(define (latest-commit-successfully-built)
|
|||
|
"Return the latest commit for which substitutes are (potentially)
|
|||
|
available."
|
|||
|
(let* ((evaluations (latest-evaluations "guix-modular-master"))
|
|||
|
(candidates (filter-map (lambda (json)
|
|||
|
(match (hash-ref json "checkouts")
|
|||
|
((checkout)
|
|||
|
(cons (hash-ref json "id")
|
|||
|
(hash-ref checkout "commit")))
|
|||
|
(_ #f)))
|
|||
|
evaluations)))
|
|||
|
(any (match-lambda
|
|||
|
((evaluation . commit)
|
|||
|
(and (evaluation-complete? evaluation)
|
|||
|
commit)))
|
|||
|
candidates)))
|
|||
|
|
|||
|
;; Pull the latest commit fully built on berlin.guixsd.org.
|
|||
|
;; WARNING: This could downgrade your system!
|
|||
|
(list (channel
|
|||
|
(name 'guix)
|
|||
|
(url "https://git.savannah.gnu.org/git/guix.git")
|
|||
|
(commit (pk 'commit (latest-commit-successfully-built)))))
|