Commit 3ca22d80 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

kernel: Report build progress via "display_data" messages.

* guix/jupyter/kernel.scm (sxml->html-string, build-event-reporter)
(call-with-build-progress-report): New procedures.
(with-build-progress-report): New macro.
* guix-jupyter-kernel.scm (create-environment): Use
'with-build-progress-report'.
<top level>: Add call to 'set-build-options'.
parent f67aa2be
......@@ -412,11 +412,12 @@ to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
#:manifest manifest
#:count counter)
(let ((profile (run-with-store store
(mlet %store-monad ((drv (profile-derivation manifest)))
(mbegin %store-monad
(built-derivations (list drv)) ;XXX: somewhat ugly
(return drv))))))
(let ((profile (with-build-progress-report kernel message
(run-with-store store
(mlet %store-monad ((drv (profile-derivation manifest)))
(mbegin %store-monad
(built-derivations (list drv)) ;XXX: somewhat ugly
(return drv)))))))
(match (available-kernel-specs (derivation->output-path profile)
(list (string-append
(derivation->output-path profile)
......@@ -730,7 +731,18 @@ environment ~s (PID ~s)~%"
(format/log "Guix kernel started (PID ~a)~%" (getpid))
(with-store store
;; Enable "build traces" so we can use (guix status) to track build and
;; download events.
(set-build-options store
#:print-build-trace #t
#:print-extended-build-trace? #t
#:multiplexed-build-output? #t)
(serve-kernels (list kernel)
(proxy-request-handler dispatch-route)
(set-proxy-state-property (proxy-state kernel)
%store-property store))))
;; Local Variables:
;; eval: (put 'with-build-progress-report 'scheme-indent-function 2)
;; End:
......@@ -16,12 +16,14 @@
(define-module (guix jupyter kernel)
#:use-module (guix jupyter containers)
#:use-module (guix jupyter logging)
#:use-module (jupyter messages)
#:use-module (jupyter kernels)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix modules)
#:use-module (guix status)
#:use-module ((guix self) #:select (make-config.scm))
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix build syscalls) #:select (mkdtemp!))
......@@ -30,12 +32,15 @@
#:use-module ((gnu build linux-container) #:select (%namespaces))
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (sxml simple)
#:use-module (json parser)
#:use-module (json builder)
#:export (%language-info
%kernel-info-reply
spawn-kernel/container))
spawn-kernel/container
with-build-progress-report))
;;; Commentary:
;;;
......@@ -181,3 +186,75 @@ monadic value, a <kernel> connected to that process."
(return (set-kernel-properties (set-kernel-pid kernel pid)
`((home . ,home)
(directory . ,root))))))
;;;
;;; Reporting build events.
;;;
(define (sxml->html-string sxml)
(call-with-output-string
(lambda (port)
(sxml->xml sxml port))))
(define (build-event-reporter kernel message display-id)
"Return build event report procedure suitable for 'with-status-report'."
(define (report-event shtml)
(send-message kernel
(reply message "update_display_data"
(scm->json-string
`(("data"
. (("text/html"
. ,(sxml->html-string shtml))))
("metadata" . ())
("transient"
. (("display_id" . ,display-id))))))
#:kernel-socket kernel-iopub))
(lambda (event old-status new-status)
(match event
(('build-started drv . _)
(format/log "build started: ~a~%" drv)
(report-event `(div "Building " (code ,drv) "...")))
(('download-started item . _)
(format/log "download started: ~a~%" item)
(report-event `(div "Downloading " (code ,item) "...")))
(_
#f))))
(define (call-with-build-progress-report kernel message thunk)
(define display-id
(gensym "progress"))
;; Send an initial "display_data" message with DISPLAY-ID.
(send-message kernel
(reply message "display_data"
(scm->json-string
`(("data"
. (("text/html"
. ,(sxml->html-string
`(div "Preparing things...")))))
("metadata" . ())
("transient"
. (("display_id" . ,display-id))))))
#:kernel-socket kernel-iopub)
;; From then on, send "update_display_data" messages with DISPLAY-ID.
(let ((result (with-status-report (build-event-reporter kernel message
display-id)
(thunk))))
(send-message kernel
(reply message "update_display_data"
(scm->json-string
`(("data"
. (("text/html" . "Done!")))
("metadata" . ())
("transient"
. (("display_id" . ,display-id))))))
#:kernel-socket kernel-iopub)
result))
(define-syntax-rule (with-build-progress-report kernel message exp ...)
"Evaluate EXP in a context where build events are reported to KERNEL as a
reply to MESSAGE."
(call-with-build-progress-report kernel message (lambda () exp ...)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment