Skip to content

GitLab

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

kernels: Change 'reply-html' to 'reply-shtml'. 

* jupyter/kernels.scm (sxml->html-string): New procedure.
(reply-html): Rename to...
(reply-shtml): ... this.  Expect SHTML instead of HTML and adjust
accordingly.  Adjust all callers.
* guix/jupyter/kernel.scm (sxml->html-string): Remove.
* guix-jupyter-kernel.scm (sxml->html-string): Remove.
parent 79b774e6
Hide whitespace changes
Inline Side-by-side
guix-jupyter-kernel.scm
View file @ d9497412
......@@ -28,7 +28,6 @@
(srfi srfi-71)
(rnrs bytevectors)
(ice-9 match)
(sxml simple)
(texinfo)
(texinfo html)
(guix build syscalls)
......@@ -102,16 +101,6 @@ was already an inferior associated with STATE, close it."
state
(set-proxy-state-inferior state (open-default-inferior))))
;;
;; HTML.
;;
(define (sxml->html-string sxml)
(call-with-output-string
(lambda (port)
(sxml->xml sxml port))))
;;
;; Handlers.
;;
......@@ -142,9 +131,9 @@ was already an inferior associated with STATE, close it."
#:key name manifest (count 0))
"Send KERNEL a reply to MESSAGE saying that we're preparing environment
NAME with MANIFEST."
(reply-html kernel message
(sxml->html-string (manifest->shtml manifest name))
count))
(reply-shtml kernel message
(manifest->shtml manifest name)
count))
(define* (reply-for-environment-kernel kernel message
#:key name specs (count 0))
......@@ -183,12 +172,11 @@ to CHANNELS in PROFILE."
(() channels)
(lst lst))
channels)))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div
(bold "Switched to these Guix channels:")
,(channels->shtml instances)))
count)))
,(channels->shtml instances))
count)))
(define* (search-inferior-packages inferior patterns
#:key (max-results 20))
......@@ -263,21 +251,19 @@ list of regular expressions (strings)."
(for-each (cut make-regexp <> regexp/icase) patterns)
(let ((lst (search-inferior-packages inferior patterns)))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(p (table
,@(map (match-lambda
((name version synopsis)
`(tr (td ,(ref name)) (td ,version)
(td ,(synopsis->shtml synopsis)))))
lst))))
count)))
lst)))
count)))
(lambda (key . args)
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div (@ (class "ansi-red-fg"))
"Invalid regular expression."))
count))))
"Invalid regular expression.")
count))))
(define* (reply-channel-description kernel message inferior
#:key (count 0))
......@@ -288,20 +274,19 @@ channels currently used by INFERIOR."
(current-profile))
inferior))
(channels (profile-channels profile)))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div
(bold "Using these Guix channels:")
,(channels->shtml channels)))
count)))
,(channels->shtml channels))
count)))
(define* (reply-for-channel-failure kernel message channels error
#:key (count 0))
"Send KERNEL a reply saying we failed to switch to CHANNELS."
(reply-html kernel message
(string-append "Failed to switch to channels: "
(git-error-message error) ".")
count))
(reply-shtml kernel message
(string-append "Failed to switch to channels: "
(git-error-message error) ".")
count))
(define (link/copy source target)
"Make the file SOURCE available as TARGET, either by creating a hard link
......@@ -335,34 +320,29 @@ HASH of type HASH-ALGO."
(proxy-state-execution-count state))
(cond ((not algo)
(reply-html kernel message
(sxml->html-string
`(bold "Unknown hash algorithm."))
count)
(reply-shtml kernel message
`(bold "Unknown hash algorithm.")
count)
state)
((not hash/bv)
(reply-html kernel message
(sxml->html-string
`(bold "Invalid hexadecimal string."))
count)
(reply-shtml kernel message
`(bold "Invalid hexadecimal string.")
count)
state)
((not (= (bytevector-length hash/bv) (hash-size algo)))
(reply-html kernel message
(sxml->html-string
'(bold "Invalid hash length."))
count)
(reply-shtml kernel message
'(bold "Invalid hash length.")
count)
state)
((not (proxy-state-default-environment state))
(reply-html kernel message
(sxml->html-string
'(bold "No current environment to download to."))
count))
(reply-shtml kernel message
'(bold "No current environment to download to.")
count))
(else
(guard (c ((store-protocol-error? c)
(reply-html kernel message
(sxml->html-string
`(bold ,(store-protocol-error-message c)))
count)
(reply-shtml kernel message
`(bold ,(store-protocol-error-message c))
count)
state))
(format/log "downloading from '~a'...~%" url)
(let* ((store (proxy-state-store state))
......@@ -379,14 +359,13 @@ HASH of type HASH-ALGO."
(format/log "copying '~a' to '~a/~a'~%"
item home file)
(link/copy item (string-append home "/" file))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(bold "File " (code ,file)
" from "
(a (@ (href ,url)) ,url)
" is now available in environment "
(code ,environment) "."))
count)
(code ,environment) ".")
count)
(increment-execution-count state))))))
(define* (create-environment name specs state
......@@ -435,16 +414,14 @@ to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
(set-proxy-state-default-environment (increment-execution-count state)
name)))
(()
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(bold "No kernel found in environment "
(code ,name) "!"))
counter)
(code ,name) "!")
counter)
;; TODO: Send "error".
state)
((lst ...)
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div
(bold "Found " ,(length lst)
" kernels in environment "
......@@ -453,8 +430,8 @@ to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
`(li ,(kernel-specs-display-name specs)))
lst))
"Which one should we use? Please create an "
"environment containing exactly one kernel."))
counter)
"environment containing exactly one kernel.")
counter)
;; TODO: Send "error".
state))))
......@@ -484,23 +461,21 @@ stripped."
((";;guix" "environment" name "<-" specs ...)
(guard (c ((package-not-found-error? c)
(let ((package (package-not-found-error-name c)))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div (@ (class "ansi-red-fg"))
"Package " (code ,package)
" not found."))
" not found.")
count))
state)
((output-not-found-error? c)
(let ((output (output-not-found-error-output c))
(package (output-not-found-error-package c)))
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div (@ (class "ansi-red-fg"))
"Output " (code ,output)
" of package " (code ,package)
" not found."))
count)
" not found.")
count)
state)))
(let ((state (ensure-proxy-state-inferior state)))
(match (lookup-proxied name state)
......@@ -520,11 +495,9 @@ stripped."
((";;guix" "environment" name)
(match (lookup-proxied name state)
(#f
(reply-html kernel message
(sxml->html-string
`(bold "Unknown environment "
(code ,name) "."))
count)
(reply-shtml kernel message
`(bold "Unknown environment " (code ,name) ".")
count)
(increment-execution-count state))
((? kernel? proxy)
(format/log "evaluating code in container ~s (PID ~s)~%"
......@@ -580,10 +553,9 @@ stripped."
#:url url #:hash-algo algo #:hash hash
#:file file))
((";;guix" _ ...)
(reply-html kernel message
(sxml->html-string
`(bold "Invalid " (code "guix") " magic."))
count)
(reply-shtml kernel message
`(bold "Invalid " (code "guix") " magic.")
count)
(increment-execution-count state))
(_
(match (proxy-state-default-environment state)
......@@ -594,15 +566,14 @@ stripped."
(send-message proxied message #:kernel-socket kind)
(increment-execution-count state)))
(#f
(reply-html kernel message
(sxml->html-string
(reply-shtml kernel message
`(div "You have not selected an execution environment
yet. You can create one by entering a “magic command” in a cell as follows:"
(p (code ";;guix environment my-environment <- \
python-ipykernel"))
"Subsequent cells will be executed by the "
"IPython kernel in this environment."))
count)
"IPython kernel in this environment.")
count)
state))))))
(define (environment-from-magic line)
......
guix/jupyter/kernel.scm
View file @ d9497412
......@@ -192,11 +192,6 @@ monadic value, a <kernel> connected to that process."
;;; 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)
......
jupyter/kernels.scm
View file @ d9497412
......@@ -27,6 +27,7 @@
#:use-module (simple-zmq)
#:use-module (json parser)
#:use-module (json builder)
#:use-module (sxml simple)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
......@@ -88,7 +89,8 @@
pub-busy
pub-idle
reply-html
sxml->html-string
reply-shtml
close-kernel))
......@@ -465,13 +467,19 @@ identity (bytevector)."
;; Reply.
;;
(define (reply-html kernel message html count)
"Reply to MESSAGE with HTML."
(define (sxml->html-string sxml)
(call-with-output-string
(lambda (port)
(sxml->xml sxml port))))
(define (reply-shtml kernel message shtml count)
"Reply to MESSAGE with SHTML."
(let ((code (assoc-ref (json-string->scm (message-content message))
"code"))
(empty-object '())
(counter (+ count 1)) ;execution counter
(html (sxml->html-string shtml))
(send (lambda (socket type content)
(send-message kernel
(reply message type
......
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