Improve verbose output for fetching build information

This commit is contained in:
Christopher Baines 2020-11-01 21:53:04 +00:00
parent 6235c6e33b
commit 5674f8838d

View file

@ -211,7 +211,8 @@ WHERE derivation_output_details.path = $1"
id id
revision-commits)))) revision-commits))))
(define (insert-build-statuses-from-data conn build-server-id build-id data) (define* (insert-build-statuses-from-data conn build-server-id build-id data
#:key verbose?)
(define stop-statuses (define stop-statuses
(lset-difference string=? (lset-difference string=?
build-status-strings build-status-strings
@ -235,8 +236,17 @@ WHERE derivation_output_details.path = $1"
(assoc-ref data "starttime")) (assoc-ref data "starttime"))
(stoptime (stoptime
(assoc-ref data "stoptime"))) (assoc-ref data "stoptime")))
(when verbose?
(simple-format #t "debug: existing statuses: ~A, new status: ~A\n"
existing-status-entries
status-string))
(map (match-lambda (map (match-lambda
((timestamp status) ((timestamp status)
(when verbose?
(simple-format
#t
"debug: inserting status: ~A\n" status))
(insert-build-status conn build-id timestamp status))) (insert-build-status conn build-id timestamp status)))
(filter (filter
list? list?
@ -263,25 +273,24 @@ WHERE derivation_output_details.path = $1"
((build-id derivation-file-name) ((build-id derivation-file-name)
(match (fetch-build url derivation-file-name) (match (fetch-build url derivation-file-name)
(#f (#f
(display ".") (if (verbose-output?)
(display "debug: no build found\n")
(display "."))
#f) #f)
(() (()
(display ".") (if (verbose-output?)
(display "debug: no build found\n")
(display "."))
#f) #f)
(data (data
(insert-build-statuses-from-data (insert-build-statuses-from-data
conn conn
build-server-id build-server-id
build-id build-id
data) data
(if (verbose-output?) #:verbose? (verbose-output?))
(simple-format (current-error-port) (unless (verbose-output?)
"debug: status: ~A\n" (display "-"))))
(assq-ref build-statuses
(or (assoc-ref data "buildstatus")
;; status is for the /output/ requests
(assoc-ref data "status"))))
(display "-"))))
;; Try not to make to many requests at once ;; Try not to make to many requests at once
(usleep 200))) (usleep 200)))
(select-pending-builds conn build-server-id))) (select-pending-builds conn build-server-id)))