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

Refactor the logging setup out of process-load-new-guix-revision-job

Browse source 
To simplify both procedures.
This commit is contained in:
Christopher Baines 2020-02-24 18:46:53 +00:00
parent 0c726b9fe7
commit cee9acaa87
1 changed files with 48 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

89
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1554,6 +1554,37 @@ SKIP LOCKED")
(f store))) (f store)))
(define (setup-logging id thunk)
(let* ((previous-output-port (current-output-port))
(previous-error-port (current-error-port))
(result
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A logging" id)
(lambda (logging-conn)
(insert-empty-log-entry logging-conn id)
(let ((logging-port
(log-port id logging-conn
#:delete-existing-log-parts? #t)))
(set-current-output-port logging-port)
(set-current-error-port logging-port)
(let ((result
(parameterize ((current-build-output-port logging-port)
(real-error-port previous-error-port)
(inferior-error-port
(setup-port-for-inferior-error-output
id previous-error-port)))
(thunk))))
(combine-log-parts! logging-conn id)
(drop-log-parts-sequence logging-conn id)
;; This can happen with GC, so do it explicitly
(close-port logging-port)
result))))))
(set-current-output-port previous-output-port)
(set-current-error-port previous-error-port)
result))
(define (process-load-new-guix-revision-job id) (define (process-load-new-guix-revision-job id)
(with-postgresql-connection (with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A" id) (simple-format #f "load-new-guix-revision ~A" id)
@ -1584,47 +1615,23 @@ SKIP LOCKED")
(log-time (log-time
(string-append "loading revision " commit) (string-append "loading revision " commit)
(lambda () (lambda ()
(let* ((previous-output-port (current-output-port)) (setup-logging
(previous-error-port (current-error-port)) id
(result (lambda ()
(with-postgresql-connection (catch #t
(simple-format #f "load-new-guix-revision ~A logging" id) (lambda ()
(lambda (logging-conn) (with-store-connection
(insert-empty-log-entry logging-conn id) (lambda (store)
(let ((logging-port (load-new-guix-revision conn
(log-port id logging-conn store
#:delete-existing-log-parts? #t))) git-repository-id
(set-current-output-port logging-port) commit))))
(set-current-error-port logging-port) (lambda (key . args)
(let ((result (simple-format
(parameterize ((current-build-output-port logging-port) (current-error-port)
(real-error-port previous-error-port) "error: load-new-guix-revision: ~A ~A\n"
(inferior-error-port key args)
(setup-port-for-inferior-error-output id previous-error-port))) #f))))))
(catch #t
(lambda ()
(with-store-connection
(lambda (store)
(load-new-guix-revision conn
store
git-repository-id
commit))))
(lambda (key . args)
(simple-format
(current-error-port)
"error: load-new-guix-revision: ~A ~A\n"
key args)
#f)))))
(combine-log-parts! logging-conn id)
(drop-log-parts-sequence logging-conn id)
;; This can happen with GC, so do it explicitly
(close-port logging-port)
result))))))
(set-current-output-port previous-output-port)
(set-current-error-port previous-error-port)
result)))
#t)) #t))
(begin (begin
(record-job-succeeded conn id) (record-job-succeeded conn id)