Commit bdb8044c authored by Ludovic Courtès's avatar Ludovic Courtès Committed by ROUBY Pierre-Antoine
Browse files

Use sxml instead of (guix-kernel html).

* guix-jupyter-container.scm (kernel-info->shtml): New procedure.
(kernel-info->html): Rewrite in terms of 'kernel-info->shtml'.
* guix-kernel/html.scm: Remove.
* Makefile.am (SOURCES): Adjust accordingly.
parent a0e49ee1
......@@ -24,7 +24,6 @@ SOURCES = \
guix-kernel/hmac.scm \
guix-kernel/tools.scm \
guix-kernel/magic.scm \
guix-kernel/html.scm \
guix-kernel/jupyter-client.scm \
guix-kernel/jupyter-server.scm \
guix-jupyter-kernel.scm \
......
......@@ -23,10 +23,10 @@
(ice-9 vlist)
(ice-9 futures)
(ice-9 match)
(sxml simple)
(guix-kernel tools)
(guix-kernel hmac)
(guix-kernel magic)
(guix-kernel html)
(guix-kernel jupyter-client)
(guix-kernel jupyter-server))
......@@ -232,30 +232,27 @@
metadata content html
notebook-key count))
(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)
(if (magic-env? code)
(let* ((magic (get-magic-line code))
(list (string-split magic #\ ))
(name (list-ref list 2))
(sep (list-ref list 3))
(env (list-cdr-ref list 4))
(title (string-append "<h3 " (green->html) ">"
"Environment '" name "' is ready !</h3>"))
(err (if (not (equal? sep %magic-separator))
(string-append "<strong><p " (red->html) ">"
"Invalid separator '" sep
"'</p></strong>")
""))
(text (string-append "<p>With package"
(if (> (length env) 1)
"s" "")
":</p>"))
(enum (list->html env)))
(string-append title err text enum))
(string-append "<h3" (red->html) ">"
"Invalid magic environment"
"</h3>")))
(call-with-output-string
(lambda (port)
(sxml->xml (kernel-info->shtml code) port))))
;;
;; Handler.
......
;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(define-module (guix-kernel html)
#:export (list->html
inline-color
red->html
grey->html
blue->html
green->html))
;;
;; Text color.
;;
(define (inline-color color)
(string-append "style=color:" color ";"))
(define (red->html)
(inline-color "red"))
(define (grey->html)
(inline-color "grey"))
(define (blue->html)
(inline-color "blue"))
(define (green->html)
(inline-color "green"))
;;
;; Tools.
;;
(define (list->html list)
"(a b c d) -> <ul><li>a</li><li>b</li>...</ul>"
(define (loop lst)
(cond
((null? lst) "")
(else
(string-append "<li>" (car lst) "</li>"
(loop (cdr lst))))))
(string-append "<ul>" (loop list) "</ul>"))
Supports Markdown
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