Commit f985eaac authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

Environment contents are now displayed by the kernel.

The kernel has access to the manifest, so it can display its actual
contents (including version numbers) upfront, before the environment is
built.

* guix/jupyter/inner-proxy.scm (kernel-info->shtml)
(kernel-info->html): Remove.
(reply-execute-request): Simply reply "Done!".
* guix-jupyter-kernel.scm (manifest->shtml)
(reply-for-environment, create-environment): New procedures.
(reply-execute-request): Call 'create-environment'.
parent 647d5afd
......@@ -105,6 +105,52 @@
;; FIXME: This could be expensive!
(delay (open-default-inferior)))
(define (manifest->shtml manifest name)
"Return SHTML representing the contents of MANIFEST."
`(div
(h3 (@ (style "color: green;"))
"Preparing environment " (tt ,name) " with these packages:")
(ul ,@(map (lambda (entry)
`(li (tt ,(manifest-entry-name entry)
" " ,(manifest-entry-version entry))))
(manifest-entries manifest)))))
(define* (reply-for-environment kernel message
#:key name manifest (count 0))
"Send KERNEL a reply to MESSAGE saying that we're preparing environment
NAME with MANIFEST."
(reply-html kernel message
(call-with-output-string
(lambda (port)
(sxml->xml (manifest->shtml manifest name)
port)))
count))
(define* (create-environment name specs state
#:key kernel message)
"Spawn a new execution environment called NAME and containing SPECS, a list
of package specifications such as \"guile@2.2\". Send appropriate messages
to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
(define manifest
(specifications->manifest (force %inferior) specs))
(format/log "creating new environment ~s~%" name)
;; Reply right away without waiting for the profile to be built.
(reply-for-environment kernel message
#:name name
#:manifest manifest
#:count (proxy-state-execution-count state))
(let* ((store (proxy-state-store state))
(container (run-with-store store
(start-container container-context
name manifest)))
(state (register-proxied name container state)))
(monitor-client container)
(send-message container message)
(increment-execution-count state)))
(define (reply-execute-request kernel kind message state)
(let* ((content (message-content message))
(code (assoc-ref (json-string->scm content) "code"))
......@@ -119,18 +165,9 @@
((_ "environment" name "<-" specs ...)
(match (lookup-proxied name state)
(#f
(format/log "spawning container ~s~%" name)
(let* ((manifest (specifications->manifest (force %inferior)
specs))
(store (proxy-state-store state))
(container (run-with-store store
(start-container container-context
name manifest)))
(state (register-proxied name container state)))
(monitor-client container)
(pub-idle kernel message)
(send-message container message)
(increment-execution-count state)))
(create-environment name specs state
#:kernel kernel
#:message message))
((? kernel? proxy)
(send-message kernel message)
(increment-execution-count state))))
......
......@@ -25,7 +25,6 @@
#:use-module (rnrs bytevectors)
#:use-module (gcrypt base16)
#:use-module (ice-9 match)
#:use-module (sxml simple)
#:use-module (jupyter messages)
#:use-module (jupyter kernels)
#:use-module (jupyter servers)
......@@ -134,28 +133,6 @@
("payload" . [])
("user_expressions" . ,empty-object))))))))
(define (kernel-info->shtml code)
(match (and=> (get-magic-line code) string-tokenize)
((_ "environment" name separator specs ...)
(if (string=? separator %magic-separator)
`(div
(h3 (@ (style "color: green;"))
"Environment " (tt ,name) " is ready!")
"Packages available in the environment: "
(ul ,@(map (lambda (spec)
`(li (tt ,spec)))
specs)))
`(div (@ (style "color: red; font-weight: bold;"))
"Invalid separator " (tt ,separator) ".")))
(#f
`(h3 (@ (style "color: red;"))
"Invalid magic environment."))))
(define (kernel-info->html code)
(call-with-output-string
(lambda (port)
(sxml->xml (kernel-info->shtml code) port))))
;;
;; Handler.
;;
......@@ -182,7 +159,8 @@ stripped."
(cond
((magic-env? code)
(format/log "replying HTML for new environment~%")
(reply-html kernel message (kernel-info->html code) count)
(reply-html kernel message "<p>Done!</p>" count)
(pub-idle kernel message)
(increment-execution-count state))
((magic-run? code)
(local-eval kernel message count)
......
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