Commit 8c6ac7f0 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

messages: Add JSON-mapped record types for "kernel_info_reply".

* jupyter/messages.scm (%current-protocol-version): New variable.
(<language-info>, <kernel-info-reply>): New record types.
* guix/jupyter/kernel.scm: New file.
* Makefile.am (SOURCES): Add it.
* guix-jupyter-kernel.scm (KERNEL-INFO): Remove.
(reply-kernel-info-request): Use 'kernel-info-reply->json'.
* tests/kernels.scm ("kernel_info_request"): Use
'json->kernel-info-reply' and associated record types.
parent b01b7af1
......@@ -21,6 +21,7 @@ moddir=@guilemoduledir@
godir=@guileobjectdir@
SOURCES = \
guix/jupyter/kernel.scm \
guix/jupyter/logging.scm \
guix/jupyter/proxy.scm \
jupyter/json.scm \
......
......@@ -35,6 +35,7 @@
(jupyter servers)
(guix jupyter logging)
(guix jupyter proxy)
(guix jupyter kernel)
(guix-kernel magic)
(guix-kernel environ))
......@@ -79,26 +80,12 @@
(define (ignore-request kernel kind message state)
state)
(define KERNEL-INFO
`(("protocol_version" . "5.3.0")
("implementation" . "Guix Jupyter kernel")
("implementation_version" . "0.0.2")
("language_info" .
(("name" . "guile")
("version" . ,(effective-version))
("mimetype" . "application/x-scheme")
("file_extension" . ".scm")
("pygments_lexer" . "scheme")
("codemirror_mode" . "scheme")))
("banner" . "Guix kernel")
("help_links" .
(("Gitlab Inria" .
"https://gitlab.inria.fr/guix-hpc/guix-kernel")))))
;; Send kernel-info.
(define (reply-kernel-info-request kernel kind message state)
(send-message kernel (reply message "kernel_info_reply"
(scm->json-string KERNEL-INFO)))
(send-message kernel
(reply message "kernel_info_reply"
(scm->json-string
(kernel-info-reply->json %kernel-info-reply))))
state)
(define (reply-execute-request kernel kind message state)
......
;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 2019 Ludovic Courtès <ludovic.courtes@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 jupyter kernel)
#:use-module (jupyter messages)
#:export (%language-info
%kernel-info-reply))
;;; Commentary:
;;;
;;; This contains stuff about the Guix kernel proper.
;;;
;;; Code:
(define %language-info
;; Language info for the Guix kernel.
(language-info
(name "guile")
(version (effective-version))
(mime-type "application/x-scheme")
(file-extension ".scm")
(pygments-lexer "scheme")
(codemirror-mode "scheme")))
(define %kernel-info-reply
;; Reply to "kernel_info_request" messages.
(kernel-info-reply
(implementation "Guix Jupyter Kernel")
(implementation-version "0.0.1")
(language-info %language-info)
(banner "Guix Kernel")
(help-links
'(("Inria GitLab" . "https://gitlab.inria.fr/guix-hpc/guix-kernel")
("GNU Guix" . "https://guix.gnu.org")))))
......@@ -18,6 +18,7 @@
(define-module (jupyter messages)
#:use-module (simple-zmq)
#:use-module (json)
#:use-module (jupyter json)
#:use-module (gcrypt hmac)
#:use-module (gcrypt base16)
#:use-module (rnrs bytevectors)
......@@ -49,7 +50,29 @@
header-date
header-type
header-version
header-sender))
header-sender
kernel-info-reply?
kernel-info-reply
kernel-info-reply->json
json->kernel-info-reply
kernel-info-reply-language-info
kernel-info-reply-status
kernel-info-reply-protocol-version
kernel-info-reply-implementation
kernel-info-reply-implementation-version
kernel-info-reply-language-info
kernel-info-reply-banner
kernel-info-reply-help-links
language-info?
language-info
language-info-name
language-info-version
language-info-mime-type
language-info-file-extension
language-info-pygments-lexer
language-info-codemirror-mode))
;;; Commentary:
;;;
......@@ -217,3 +240,52 @@ This is a low-level procedure for internal use."
content
#:parent-header (string->header parent-header)
#:metadata metadata))))
;;;
;;; Message types.
;;;
(define %current-protocol-version
;; Version of the Jupyter protocol implemented here.
"5.0.3")
;; Kernel info:
;; <https://jupyter-client.readthedocs.io/en/latest/messaging.html#kernel-info>.
(define-json-mapping <language-info> language-info make-language-info
language-info?
json->language-info <=> language-info->json
(name language-info-name)
(version language-info-version)
(mime-type language-info-mime-type
(json "mimetype"))
(file-extension language-info-file-extension
(json "file_extension"))
(pygments-lexer language-info-pygments-lexer
(json "pygments_lexer"))
(codemirror-mode language-info-codemirror-mode
(json "codemirror_mode")))
(define-json-mapping <kernel-info-reply> kernel-info-reply
make-kernel-info-reply
kernel-info-reply?
json->kernel-info-reply <=> kernel-info-reply->json
(status kernel-info-reply-status
(default "ok"))
(protocol-version kernel-info-reply-protocol-version
(json "protocol_version")
(default %current-protocol-version))
(implementation kernel-info-reply-implementation
(default "guile"))
(implementation-version kernel-info-reply-implementation-version
(json "implementation_version")
(default (version)))
(language-info kernel-info-reply-language-info
(json "language_info"
json->language-info
language-info->json))
(banner kernel-info-reply-banner
(default ""))
(help-links kernel-info-reply-help-links
(json "help_links")
(default '())))
......@@ -92,9 +92,10 @@
replies)))
(and (equal? (message-parent-header reply)
(message-header request))
(let* ((content (json-string->scm (message-content reply)))
(language (assoc-ref content "language_info")))
(assoc-ref language "name"))))))))
(let ((reply (json->kernel-info-reply
(message-content reply))))
(language-info-name
(kernel-info-reply-language-info reply)))))))))
(unless %kernel (test-skip 1))
(test-equal "execute_request"
......
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