cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve logging in builds.scm

Browse source
This commit is contained in:
Christopher Baines 2019-03-07 21:51:19 +00:00
parent bbf8cc1c34
commit ccb429c8b9
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
1 changed files with 13 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

17
guix-data-service/builds.scm
View file

@ -23,7 +23,9 @@
build-servers)))) build-servers))))
(define (query-build-server conn id url) (define (query-build-server conn id url)
(simple-format #t "\nFetching pending builds\n")
(process-pending-builds conn id url) (process-pending-builds conn id url)
(simple-format #t "\nFetching unseen derivations\n")
(process-derivations conn id url)) (process-derivations conn id url))
(define (process-pending-builds conn build-server-id url) (define (process-pending-builds conn build-server-id url)
@ -74,6 +76,9 @@
((or #f #()) ((or #f #())
(match (fetch-queued-builds-for-derivation url derivation-file-name) (match (fetch-queued-builds-for-derivation url derivation-file-name)
((or #f #()) ((or #f #())
(simple-format #t "\nwarning: couldn't find build for ~A on ~A\n"
derivation-file-name
url)
#f) #f)
(#(status) (#(status)
status))) status)))
@ -88,7 +93,7 @@
(lambda args (lambda args
(display args) (display args)
(newline) (newline)
(simple-format #t "error parsing: ~A\n" string) (simple-format #t "\nerror parsing: ~A\n" string)
#f))) #f)))
(define (fetch-latest-builds-for-derivation base-url derivation-file-name) (define (fetch-latest-builds-for-derivation base-url derivation-file-name)
@ -104,7 +109,7 @@
(json-string->scm (json-string->scm
(bytevector->string body "utf-8"))) (bytevector->string body "utf-8")))
(else (else
(simple-format #t "error: response code ~A: ~A\n" url code) (simple-format #t "\nerror: response code ~A: ~A\n" url code)
#f))))) #f)))))
(define (fetch-queued-builds-for-derivation base-url derivation-file-name) (define (fetch-queued-builds-for-derivation base-url derivation-file-name)
@ -120,7 +125,7 @@
(json-string->scm (json-string->scm
(bytevector->string body "utf-8"))) (bytevector->string body "utf-8")))
(else (else
(simple-format #t "error: response code ~A: ~A\n" url code) (simple-format #t "\nerror: response code ~A: ~A\n" url code)
#f))))) #f)))))
(define (fetch-build url id) (define (fetch-build url id)
@ -132,7 +137,11 @@
((eq? (response-code response) 200) ((eq? (response-code response) 200)
(json-string->scm (json-string->scm
(bytevector->string body "utf-8"))) (bytevector->string body "utf-8")))
(else #f)))) (else
(simple-format #t "\nwarning: couldn't find build ~A on ~A\n"
id
url)
#f))))
(define (select-pending-builds conn build-server-id) (define (select-pending-builds conn build-server-id)
(define query (define query