Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

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

json: Rebase on top of 'define-record-type*'.

* jupyter/json.scm (json, <=>): New variables.
(define-json-reader): Adjust to the new syntax for SPEC.
(define-json-writer): Likewise.
(define-json-mapping): Rebase on top of 'define-record-type*'.  Move
JSON field spec under the 'json' keyword.
* jupyter/kernels.scm (<kernel-specs>, <connection>): Adjust
(find-kernel-specs, allocate-connection): Use new syntactic
parent c824394e
......@@ -16,8 +16,10 @@
(define-module (jupyter json)
#:use-module (json)
#:use-module (srfi srfi-9)
#:export (define-json-mapping))
#:use-module (guix records)
#:export (json
;;; Commentary:
......@@ -25,6 +27,10 @@
;;; Code:
;; Literals.
(define json 'json)
(define <=> '<=>)
(define-syntax-rule (define-json-reader json->record ctor spec ...)
"Define JSON->RECORD as a procedure that converts a JSON representation,
read from a port, string, or hash table, into a record created by CTOR and
......@@ -36,12 +42,15 @@ following SPEC, a series of field specifications."
(json-string->scm input))
((or (null? input) (pair? input))
(let-syntax ((extract-field (syntax-rules ()
((_ table (field key json->value))
(let-syntax ((extract-field (syntax-rules (json)
((_ table (field (json key json->value
_ (... ...))
_ (... ...)))
(json->value (assoc-ref table key)))
((_ table (field key))
((_ table (field (json key)
_ (... ...)))
(assoc-ref table key))
((_ table (field))
((_ table (field _ (... ...)))
(assoc-ref table
(symbol->string 'field))))))
(ctor (extract-field table spec) ...)))))
......@@ -51,15 +60,19 @@ following SPEC, a series of field specifications."
"Define RECORD->JSON as a procedure that returns an alist, the Guile-JSON
representation of the given record."
(define (record->json record)
(let-syntax ((field->alist (syntax-rules ()
((_ field getter)
(cons (symbol->string 'field)
(getter record)))
((_ field getter key _ value->json)
(let-syntax ((field->alist (syntax-rules (json)
((_ field getter
(json key json->value value->json)
_ (... ...))
(cons key
(value->json (getter record))))
((_ field getter key _ (... ...))
((_ field getter
(json key _ (... ...))
_ (... ...))
(cons key
(getter record)))
((_ field getter _ (... ...))
(cons (symbol->string 'field)
(getter record))))))
(list (field->alist field-spec ...) ...))))
......@@ -68,24 +81,36 @@ representation of the given record."
"Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
and define JSON->RECORD as a conversion from JSON to a record of this type.
Optionally, define RECORD->JSON as the conversion from a record of this type
to its JSON representation (an alist)."
((_ rtd ctor pred json->record <=> record->json
to its JSON representation (an alist).
This is layered on top of 'define-record-type*'. Here's an example:
(define-json-mapping <foo> foo make-foo
json->foo <=> foo->json
(a foo-a (json \"A\" string->number number->string)
(default 2))
(b foo-b))
((_ rtd ctor ctor-proc
pred json->record <=> record->json
(field getter spec ...) ...)
(define-json-mapping rtd ctor pred json->record
(define-json-mapping rtd ctor ctor-proc
pred json->record
(field getter spec ...) ...)
(define-json-writer record->json
(field getter spec ...) ...)))
((_ rtd ctor pred json->record
((_ rtd ctor ctor-proc pred json->record
(field getter spec ...) ...)
(define-record-type rtd
(ctor field ...)
(define-record-type* rtd ctor ctor-proc
(field getter) ...)
(field getter spec ...) ...)
(define-json-reader json->record ctor
(define-json-reader json->record ctor-proc
(field spec ...) ...)))))
(set! (@@ (json builder) json-build)
......@@ -111,11 +111,12 @@
;; Kernel metadata taken from a 'kernel.json' file.
;; <>
(define-json-mapping <kernel-specs>
kernel-specs kernel-specs?
kernel-specs make-kernel-specs kernel-specs?
(arguments kernel-specs-arguments "argv"
(display-name kernel-specs-display-name "display_name")
(arguments kernel-specs-arguments
(json "argv" vector->list))
(display-name kernel-specs-display-name
(json "display_name"))
(language kernel-specs-language))
(define* (kernel name pid #:key key control shell
......@@ -174,9 +175,10 @@ PATH."
(and ipython
(list ipython "kernel" "--quiet" "-f" "{connection_file}")
(arguments (list ipython "kernel" "--quiet"
"-f" "{connection_file}"))
(display-name "IPython")
(language "Python")))))
(let ((file (find-kernel-specs-file kernel)))
(and file (call-with-input-file file json->kernel-specs))))))
......@@ -201,31 +203,23 @@ could not be found."
;; <>.
;; Usually the client creates it, writes it to a "connection file", which it
;; passes to the kernel.
(define-json-mapping <connection> %connection connection?
(define-json-mapping <connection> connection make-connection connection?
json->connection <=> connection->json
(transport connection-transport) ;string
(ip connection-ip) ;string
(signature-scheme connection-signature-scheme) ;string
(signature-scheme connection-signature-scheme
(default "hmac-sha256")) ;string
(key connection-key) ;string
(control-port connection-control-port ;integer
(json "control_port"))
(shell-port connection-shell-port ;integer
(json "shell_port"))
(stdin-port connection-stdin-port ;integer
(json "stdin_port"))
(heartbeat-port connection-heartbeat-port ;integer
(json "hb_port"))
(iopub-port connection-iopub-port ;integer
(define* (connection transport ip
(signature-scheme "hmac-sha256")
key control-port shell-port stdin-port heartbeat-port
(%connection transport ip signature-scheme key
control-port shell-port stdin-port heartbeat-port
(json "iopub_port")))
(define (generate-key)
"Return a string usable as a shared secret key between a kernel server and
......@@ -284,13 +278,14 @@ be in use (but this is racy)."
(port-iosub (try-connect socket-iosub
(and first-port (+ 1 port-heartbeat))))
(connection (connection "tcp" ""
#:key key
#:control-port port-control
#:shell-port port-shell
#:heartbeat-port port-heartbeat
#:stdin-port port-stdin
#:iopub-port port-iosub))
(connection (connection
(transport transport) (ip ip)
(key key)
(control-port port-control)
(shell-port port-shell)
(heartbeat-port port-heartbeat)
(stdin-port port-stdin)
(iopub-port port-iosub)))
(kernel (kernel #f #f ;no name and PID yet
#:key key
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